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