    {-# LINE 1 "System/Locale/SetLocale.hsc" #-}
    {-# LANGUAGE DeriveDataTypeable
               , ForeignFunctionInterface #-}

    -- Copyright (c) 2014, Sven Bartscher
    -- Look the file LICENSE.txt in the toplevel directory of the source tree for
    -- more information.

    module System.Locale.SetLocale ( Category(..)
                                   , categoryToCInt
                                   , setLocale
                                   )
        where

    import Data.Typeable (Typeable)
    import Foreign.C ( peekCString
                     , CString
                     , withCString
                     , CInt(CInt) -- Newtypes are only allowed in foreign
                     )            -- declarations if their constructor is
                                  -- in scope.
    import Foreign.Ptr (nullPtr)

    data Category = LC_ALL
                  | LC_COLLATE
                  | LC_CTYPE
                  | LC_MESSAGES
                  | LC_MONETARY
                  | LC_NUMERIC
                  | LC_TIME
                    deriving (Category
    Category -> Category -> Bounded Category
    forall a. a -> a -> Bounded a
    $cminBound :: Category
    minBound :: Category
    $cmaxBound :: Category
    maxBound :: Category
    Bounded, Int -> Category
    Category -> Int
    Category -> [Category]
    Category -> Category
    Category -> Category -> [Category]
    Category -> Category -> Category -> [Category]
    (Category -> Category)
    -> (Category -> Category)
    -> (Int -> Category)
    -> (Category -> Int)
    -> (Category -> [Category])
    -> (Category -> Category -> [Category])
    -> (Category -> Category -> [Category])
    -> (Category -> Category -> Category -> [Category])
    -> Enum Category
    forall a.
    (a -> a)
    -> (a -> a)
    -> (Int -> a)
    -> (a -> Int)
    -> (a -> [a])
    -> (a -> a -> [a])
    -> (a -> a -> [a])
    -> (a -> a -> a -> [a])
    -> Enum a
    $csucc :: Category -> Category
    succ :: Category -> Category
    $cpred :: Category -> Category
    pred :: Category -> Category
    $ctoEnum :: Int -> Category
    toEnum :: Int -> Category
    $cfromEnum :: Category -> Int
    fromEnum :: Category -> Int
    $cenumFrom :: Category -> [Category]
    enumFrom :: Category -> [Category]
    $cenumFromThen :: Category -> Category -> [Category]
    enumFromThen :: Category -> Category -> [Category]
    $cenumFromTo :: Category -> Category -> [Category]
    enumFromTo :: Category -> Category -> [Category]
    $cenumFromThenTo :: Category -> Category -> Category -> [Category]
    enumFromThenTo :: Category -> Category -> Category -> [Category]
    Enum, Category -> Category -> Bool
    (Category -> Category -> Bool)
    -> (Category -> Category -> Bool) -> Eq Category
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Category -> Category -> Bool
    == :: Category -> Category -> Bool
    $c/= :: Category -> Category -> Bool
    /= :: Category -> Category -> Bool
    Eq, Eq Category
    Eq Category =>
    (Category -> Category -> Ordering)
    -> (Category -> Category -> Bool)
    -> (Category -> Category -> Bool)
    -> (Category -> Category -> Bool)
    -> (Category -> Category -> Bool)
    -> (Category -> Category -> Category)
    -> (Category -> Category -> Category)
    -> Ord Category
    Category -> Category -> Bool
    Category -> Category -> Ordering
    Category -> Category -> Category
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    $ccompare :: Category -> Category -> Ordering
    compare :: Category -> Category -> Ordering
    $c< :: Category -> Category -> Bool
    < :: Category -> Category -> Bool
    $c<= :: Category -> Category -> Bool
    <= :: Category -> Category -> Bool
    $c> :: Category -> Category -> Bool
    > :: Category -> Category -> Bool
    $c>= :: Category -> Category -> Bool
    >= :: Category -> Category -> Bool
    $cmax :: Category -> Category -> Category
    max :: Category -> Category -> Category
    $cmin :: Category -> Category -> Category
    min :: Category -> Category -> Category
    Ord, ReadPrec [Category]
    ReadPrec Category
    Int -> ReadS Category
    ReadS [Category]
    (Int -> ReadS Category)
    -> ReadS [Category]
    -> ReadPrec Category
    -> ReadPrec [Category]
    -> Read Category
    forall a.
    (Int -> ReadS a)
    -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
    $creadsPrec :: Int -> ReadS Category
    readsPrec :: Int -> ReadS Category
    $creadList :: ReadS [Category]
    readList :: ReadS [Category]
    $creadPrec :: ReadPrec Category
    readPrec :: ReadPrec Category
    $creadListPrec :: ReadPrec [Category]
    readListPrec :: ReadPrec [Category]
    Read, Int -> Category -> ShowS
    [Category] -> ShowS
    Category -> String
    (Int -> Category -> ShowS)
    -> (Category -> String) -> ([Category] -> ShowS) -> Show Category
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Category -> ShowS
    showsPrec :: Int -> Category -> ShowS
    $cshow :: Category -> String
    show :: Category -> String
    $cshowList :: [Category] -> ShowS
    showList :: [Category] -> ShowS
    Show, Typeable)

    categoryToCInt :: Category -> CInt
    categoryToCInt :: Category -> CInt
    categoryToCInt Category
    LC_ALL = CInt
    6
    {-# LINE 36 "System/Locale/SetLocale.hsc" #-}
    categoryToCInt LC_COLLATE = 3
    {-# LINE 37 "System/Locale/SetLocale.hsc" #-}
    categoryToCInt LC_CTYPE = 0
    {-# LINE 38 "System/Locale/SetLocale.hsc" #-}

    {-# LINE 39 "System/Locale/SetLocale.hsc" #-}
    categoryToCInt LC_MESSAGES = 5
    {-# LINE 40 "System/Locale/SetLocale.hsc" #-}

    {-# LINE 43 "System/Locale/SetLocale.hsc" #-}
    categoryToCInt Category
    LC_MONETARY = CInt
    4
    {-# LINE 44 "System/Locale/SetLocale.hsc" #-}
    categoryToCInt LC_NUMERIC = 1
    {-# LINE 45 "System/Locale/SetLocale.hsc" #-}
    categoryToCInt LC_TIME = 2
    {-# LINE 46 "System/Locale/SetLocale.hsc" #-}

    foreign import ccall "locale.h setlocale" c_setlocale :: CInt -> CString -> IO CString

    setLocale :: Category -> Maybe String -> IO (Maybe String)

    {-# LINE 53 "System/Locale/SetLocale.hsc" #-}
    setLocale :: Category -> Maybe String -> IO (Maybe String)
    setLocale Category
    c Maybe String
    Nothing = CInt -> CString -> IO CString
    c_setlocale (Category -> CInt
    categoryToCInt Category
    c) CString
    forall a. Ptr a
    nullPtr IO CString -> (CString -> IO (Maybe String)) -> IO (Maybe String)
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= CString -> IO (Maybe String)
    checkReturn
    setLocale Category
    c (Just String
    locale) = (String -> (CString -> IO CString) -> IO CString
    forall a. String -> (CString -> IO a) -> IO a
    withCString String
    locale ((CString -> IO CString) -> IO CString)
    -> (CString -> IO CString) -> IO CString
    forall a b. (a -> b) -> a -> b
    $ CInt -> CString -> IO CString
    c_setlocale (CInt -> CString -> IO CString) -> CInt -> CString -> IO CString
    forall a b. (a -> b) -> a -> b
    $ Category -> CInt
    categoryToCInt Category
    c)
                                IO CString -> (CString -> IO (Maybe String)) -> IO (Maybe String)
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= CString -> IO (Maybe String)
    checkReturn

    checkReturn :: CString -> IO (Maybe String)
    checkReturn :: CString -> IO (Maybe String)
    checkReturn CString
    r
        | CString
    r CString -> CString -> Bool
    forall a. Eq a => a -> a -> Bool
    == CString
    forall a. Ptr a
    nullPtr = Maybe String -> IO (Maybe String)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe String
    forall a. Maybe a
    Nothing
        | Bool
    otherwise = (String -> Maybe String) -> IO String -> IO (Maybe String)
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap String -> Maybe String
    forall a. a -> Maybe a
    Just (IO String -> IO (Maybe String)) -> IO String -> IO (Maybe String)
    forall a b. (a -> b) -> a -> b
    $ CString -> IO String
    peekCString CString
    r