Update for ghc-7.8 since `myTycon` has been removed.
[darcs-mirror-arbtt.git] / src / System / Locale / SetLocale.hsc
1 {-# LANGUAGE ForeignFunctionInterface #-}
2 {-# LANGUAGE DeriveDataTypeable #-}
3
4 {-
5 This file is copied from the setlocale-0.0.3 package. Its author is Lukas Mai
6 and it is placed in the Public Domain.
7 -}
8
9 module System.Locale.SetLocale (
10     Category(..),
11     categoryToCInt,
12     setLocale
13 ) where
14
15 import Foreign.Ptr
16 import Foreign.C.Types
17 import Foreign.C.String
18
19 import Data.Typeable
20
21 -- | A type representing the various locale categories. See @man 7 locale@.
22 data Category
23     = LC_ALL
24     | LC_COLLATE
25     | LC_CTYPE
26     | LC_MESSAGES
27     | LC_MONETARY
28     | LC_NUMERIC
29     | LC_TIME
30     deriving (Eq, Ord, Read, Show, Enum, Bounded, Typeable)
31
32 #include <locale.h>
33
34 -- | Convert a 'Category' to the corresponding system-specific @LC_*@ code.
35 -- You probably don't need this function.
36 categoryToCInt :: Category -> CInt
37 categoryToCInt LC_ALL = #const LC_ALL
38 categoryToCInt LC_COLLATE = #const LC_COLLATE
39 categoryToCInt LC_CTYPE = #const LC_CTYPE
40 categoryToCInt LC_MESSAGES = #const LC_MESSAGES
41 categoryToCInt LC_MONETARY = #const LC_MONETARY
42 categoryToCInt LC_NUMERIC = #const LC_NUMERIC
43 categoryToCInt LC_TIME = #const LC_TIME
44
45 ptr2str :: Ptr CChar -> IO (Maybe String)
46 ptr2str p
47     | p == nullPtr = return Nothing
48     | otherwise = fmap Just $ peekCString p
49
50 str2ptr :: Maybe String -> (Ptr CChar -> IO a) -> IO a
51 str2ptr Nothing  f = f nullPtr
52 str2ptr (Just s) f = withCString s f
53
54 foreign import ccall unsafe "locale.h setlocale" c_setlocale :: CInt -> Ptr CChar -> IO (Ptr CChar)
55
56 -- | A Haskell version of @setlocale()@. See @man 3 setlocale@.
57 setLocale :: Category -> Maybe String -> IO (Maybe String)
58 setLocale cat str =
59     str2ptr str $ \p -> c_setlocale (categoryToCInt cat) p >>= ptr2str