1{-# LANGUAGE ForeignFunctionInterface #-}
2{-# LANGUAGE DeriveDataTypeable #-}
3
4{-
5This file is copied from the setlocale-0.0.3 package. Its author is Lukas Mai
6and it is placed in the Public Domain.
7-}
8
9module System.Locale.SetLocale (
10    Category(..),
11    categoryToCInt,
12    setLocale
13) where
14
15import Foreign.Ptr
16import Foreign.C.Types
17import Foreign.C.String
18
19import Data.Typeable
20
21-- | A type representing the various locale categories. See @man 7 locale@.
22data 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.
36categoryToCInt :: Category -> CInt
37categoryToCInt LC_ALL = #const LC_ALL
38categoryToCInt LC_COLLATE = #const LC_COLLATE
39categoryToCInt LC_CTYPE = #const LC_CTYPE
40categoryToCInt LC_MESSAGES = #const LC_MESSAGES
41categoryToCInt LC_MONETARY = #const LC_MONETARY
42categoryToCInt LC_NUMERIC = #const LC_NUMERIC
43categoryToCInt LC_TIME = #const LC_TIME
44
45ptr2str :: Ptr CChar -> IO (Maybe String)
46ptr2str p
47    | p == nullPtr = return Nothing
48    | otherwise = fmap Just $ peekCString p
49
50str2ptr :: Maybe String -> (Ptr CChar -> IO a) -> IO a
51str2ptr Nothing  f = f nullPtr
52str2ptr (Just s) f = withCString s f
53
54foreign 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@.
57setLocale :: Category -> Maybe String -> IO (Maybe String)
58setLocale cat str =
59    str2ptr str $ \p -> c_setlocale (categoryToCInt cat) p >>= ptr2str
60