{-# 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 (Bounded, Enum, Eq, Ord, Read, Show, Typeable)

categoryToCInt :: Category -> CInt
categoryToCInt LC_ALL = 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 LC_MONETARY = 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 c Nothing = c_setlocale (categoryToCInt c) nullPtr >>= checkReturn
setLocale c (Just locale) = (withCString locale $ c_setlocale $ categoryToCInt c)
                            >>= checkReturn

checkReturn :: CString -> IO (Maybe String)
checkReturn r
    | r == nullPtr = return Nothing
    | otherwise = fmap Just $ peekCString r