-- | This library provides basic internationalization capabilities

module Text.I18N.GetText (
                          getText,
                          nGetText,
                          dGetText,
                          dnGetText,
                          dcGetText,
                          dcnGetText,
                          bindTextDomain,
                          textDomain
                         ) where

import           Data.Maybe              (fromMaybe)
import           Foreign.C.Error
import           Foreign.C.String
import           Foreign.C.Types
import           Foreign.Ptr
import           System.Locale.SetLocale


foreign import ccall unsafe "libintl.h gettext" c_gettext
    :: CString -> IO CString

foreign import ccall unsafe "libintl.h dgettext" c_dgettext
    :: CString -> CString -> IO CString

foreign import ccall unsafe "libintl.h dcgettext" c_dcgettext
    :: CString -> CString -> CInt -> IO CString

foreign import ccall unsafe "libintl.h ngettext" c_ngettext
    :: CString -> CString -> CULong -> IO CString

foreign import ccall unsafe "libintl.h dngettext" c_dngettext
    :: CString -> CString -> CString -> CULong -> IO CString

foreign import ccall unsafe "libintl.h dcngettext" c_dcngettext
    :: CString -> CString -> CString -> CULong -> CInt -> IO CString

foreign import ccall unsafe "libintl.h bindtextdomain" c_bindtextdomain
    :: CString -> CString -> IO CString

foreign import ccall unsafe "libintl.h textdomain" c_textdomain
    :: CString -> IO CString

fromCString :: CString -> IO (Maybe String)
fromCString :: CString -> IO (Maybe String)
fromCString CString
x | CString
x CString -> CString -> Bool
forall a. Eq a => a -> a -> Bool
== CString
forall a. Ptr a
nullPtr = Maybe String -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing
              | Bool
otherwise = CString -> IO String
peekCString CString
x IO String -> (String -> IO (Maybe String)) -> IO (Maybe String)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe String -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe String -> IO (Maybe String))
-> (String -> Maybe String) -> String -> IO (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe String
forall a. a -> Maybe a
Just

fromCStringError :: String -> CString -> IO String
fromCStringError :: String -> CString -> IO String
fromCStringError String
err CString
x | CString
x CString -> CString -> Bool
forall a. Eq a => a -> a -> Bool
== CString
forall a. Ptr a
nullPtr = String -> IO String
forall a. String -> IO a
throwErrno String
err
                       | Bool
otherwise = CString -> IO String
peekCString CString
x

fromCStringDefault :: String -> CString -> IO String
fromCStringDefault :: String -> CString -> IO String
fromCStringDefault String
d CString
x = CString -> IO (Maybe String)
fromCString CString
x IO (Maybe String) -> (Maybe String -> IO String) -> IO String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Maybe String
r -> String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
d Maybe String
r)

fromCStringPluralDefault :: (Eq a, Num a) => String -> String -> a -> CString -> IO String
fromCStringPluralDefault :: String -> String -> a -> CString -> IO String
fromCStringPluralDefault String
def String
def_plural a
n CString
s
    | a
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
1 = String -> CString -> IO String
fromCStringDefault String
def CString
s
    | Bool
otherwise = String -> CString -> IO String
fromCStringDefault String
def_plural CString
s


withCStringMaybe :: Maybe String -> (CString -> IO a) -> IO a
withCStringMaybe :: Maybe String -> (CString -> IO a) -> IO a
withCStringMaybe Maybe String
Nothing CString -> IO a
f    = CString -> IO a
f CString
forall a. Ptr a
nullPtr
withCStringMaybe (Just String
str) CString -> IO a
f = String -> (CString -> IO a) -> IO a
forall a. String -> (CString -> IO a) -> IO a
withCString String
str CString -> IO a
f

-- | 'getText' wraps GNU gettext@ function. It returns translated string for the
-- input messages. If translated string not found the input string will be
-- returned.
--
-- The most common usage of this function is to declare function @__@:
--
-- > __ = unsafePerformIO . getText
--
-- and wrap all text strings into this function, e.g.
--
-- > printHello = putStrLn (__ "Hello")
--
getText :: String -> IO String
getText :: String -> IO String
getText String
s =
    String -> (CString -> IO String) -> IO String
forall a. String -> (CString -> IO a) -> IO a
withCString String
s ((CString -> IO String) -> IO String)
-> (CString -> IO String) -> IO String
forall a b. (a -> b) -> a -> b
$ \CString
s' ->
        CString -> IO CString
c_gettext CString
s' IO CString -> (CString -> IO String) -> IO String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> CString -> IO String
fromCStringDefault String
s

-- | 'dGetText' wraps GNU dgettext function. It works similar to 'getText'
-- but also could take domain name.
--
dGetText :: Maybe String        -- ^ domain name, if 'Nothing' ---
                                -- default domain will be used
         -> String              -- ^ message id
         -> IO String           -- ^ return value
dGetText :: Maybe String -> String -> IO String
dGetText Maybe String
domainname String
msgid =
    Maybe String -> (CString -> IO String) -> IO String
forall a. Maybe String -> (CString -> IO a) -> IO a
withCStringMaybe Maybe String
domainname ((CString -> IO String) -> IO String)
-> (CString -> IO String) -> IO String
forall a b. (a -> b) -> a -> b
$ \CString
dn' ->
        String -> (CString -> IO String) -> IO String
forall a. String -> (CString -> IO a) -> IO a
withCString String
msgid ((CString -> IO String) -> IO String)
-> (CString -> IO String) -> IO String
forall a b. (a -> b) -> a -> b
$ \CString
msg' ->
            CString -> CString -> IO CString
c_dgettext CString
dn' CString
msg' IO CString -> (CString -> IO String) -> IO String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> CString -> IO String
fromCStringDefault String
msgid

-- | 'dcGetText' wraps GNU dcgettext function. It works similar to 'dGetText'
-- but also takes category id
dcGetText :: Maybe String       -- ^ domain name, if 'Nothing' ---
                                -- default domain will be used
          -> Category           -- ^ locale facet
          -> String             -- ^ message id
          -> IO String          -- ^ return value
dcGetText :: Maybe String -> Category -> String -> IO String
dcGetText Maybe String
domainname Category
cat String
msgid =
    Maybe String -> (CString -> IO String) -> IO String
forall a. Maybe String -> (CString -> IO a) -> IO a
withCStringMaybe Maybe String
domainname ((CString -> IO String) -> IO String)
-> (CString -> IO String) -> IO String
forall a b. (a -> b) -> a -> b
$ \CString
dn' ->
        String -> (CString -> IO String) -> IO String
forall a. String -> (CString -> IO a) -> IO a
withCString String
msgid ((CString -> IO String) -> IO String)
-> (CString -> IO String) -> IO String
forall a b. (a -> b) -> a -> b
$ \CString
msg' ->
            CString -> CString -> CInt -> IO CString
c_dcgettext CString
dn' CString
msg' (Category -> CInt
categoryToCInt Category
cat) IO CString -> (CString -> IO String) -> IO String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
            String -> CString -> IO String
fromCStringDefault String
msgid

-- | 'nGetText' wraps GNU ngettext function. It translates text string in the
-- user's native language, by lookilng up the approppiate plural form of the
-- message.
--
nGetText :: String              -- ^ msgid in singular form
         -> String              -- ^ msgid in plural form
         -> Integer             -- ^ number, used to choose appropriate form
         -> IO String           -- ^ result string, by default if number is 1 than
                                -- singular form of msgid is returned, otherwise ---
                                -- plural
nGetText :: String -> String -> Integer -> IO String
nGetText String
msgid String
msgid_plural Integer
n =
    String -> (CString -> IO String) -> IO String
forall a. String -> (CString -> IO a) -> IO a
withCString String
msgid ((CString -> IO String) -> IO String)
-> (CString -> IO String) -> IO String
forall a b. (a -> b) -> a -> b
$ \CString
msgid' ->
        String -> (CString -> IO String) -> IO String
forall a. String -> (CString -> IO a) -> IO a
withCString String
msgid_plural ((CString -> IO String) -> IO String)
-> (CString -> IO String) -> IO String
forall a b. (a -> b) -> a -> b
$ \CString
msgid_plural' ->
            CString -> CString -> CULong -> IO CString
c_ngettext CString
msgid' CString
msgid_plural' (Integer -> CULong
forall a. Num a => Integer -> a
fromInteger Integer
n) IO CString -> (CString -> IO String) -> IO String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
            String -> String -> Integer -> CString -> IO String
forall a.
(Eq a, Num a) =>
String -> String -> a -> CString -> IO String
fromCStringPluralDefault String
msgid String
msgid_plural Integer
n

-- | 'dnGetText' wraps GNU dngettext function. It works similar to 'nGetText' but
-- also takes domain name
--
dnGetText :: Maybe String       -- ^ domain name, if 'Nothing' ---
                                -- default domain will be used
          -> String             -- ^ msgid in singular form
          -> String             -- ^ msgid in plural form
          -> Integer            -- ^ number, used to choose appropriate form
          -> IO String          -- ^ result string, by default if number is 1 than
                                -- singular form of msgid is returned, otherwise ---
                                -- plural
dnGetText :: Maybe String -> String -> String -> Integer -> IO String
dnGetText Maybe String
domainname String
msgid String
msgid_plural Integer
n =
    Maybe String -> (CString -> IO String) -> IO String
forall a. Maybe String -> (CString -> IO a) -> IO a
withCStringMaybe Maybe String
domainname ((CString -> IO String) -> IO String)
-> (CString -> IO String) -> IO String
forall a b. (a -> b) -> a -> b
$ \CString
dn' ->
        String -> (CString -> IO String) -> IO String
forall a. String -> (CString -> IO a) -> IO a
withCString String
msgid ((CString -> IO String) -> IO String)
-> (CString -> IO String) -> IO String
forall a b. (a -> b) -> a -> b
$ \CString
msgid' ->
            String -> (CString -> IO String) -> IO String
forall a. String -> (CString -> IO a) -> IO a
withCString String
msgid_plural ((CString -> IO String) -> IO String)
-> (CString -> IO String) -> IO String
forall a b. (a -> b) -> a -> b
$ \CString
msgid_plural' ->
                CString -> CString -> CString -> CULong -> IO CString
c_dngettext CString
dn' CString
msgid' CString
msgid_plural' (Integer -> CULong
forall a. Num a => Integer -> a
fromInteger Integer
n) IO CString -> (CString -> IO String) -> IO String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                String -> String -> Integer -> CString -> IO String
forall a.
(Eq a, Num a) =>
String -> String -> a -> CString -> IO String
fromCStringPluralDefault String
msgid String
msgid_plural Integer
n

-- | 'dcnGetText' wraps GNU dcngettext function. It works similar to 'dnGetText' but
-- also takes category id
--
dcnGetText :: Maybe String      -- ^ domain name, if 'Nothing' ---
                                -- default domain will be used
          -> Category           -- ^ locale facet
          -> String             -- ^ msgid in singular form
          -> String             -- ^ msgid in plural form
          -> Integer            -- ^ number, used to choose appropriate form
          -> IO String          -- ^ result string, by default if number is 1 than
                                -- singular form of msgid is returned, otherwise ---
                                -- plural
dcnGetText :: Maybe String
-> Category -> String -> String -> Integer -> IO String
dcnGetText Maybe String
domainname Category
cat String
msgid String
msgid_plural Integer
n =
    Maybe String -> (CString -> IO String) -> IO String
forall a. Maybe String -> (CString -> IO a) -> IO a
withCStringMaybe Maybe String
domainname ((CString -> IO String) -> IO String)
-> (CString -> IO String) -> IO String
forall a b. (a -> b) -> a -> b
$ \CString
dn' ->
        String -> (CString -> IO String) -> IO String
forall a. String -> (CString -> IO a) -> IO a
withCString String
msgid ((CString -> IO String) -> IO String)
-> (CString -> IO String) -> IO String
forall a b. (a -> b) -> a -> b
$ \CString
msgid' ->
            String -> (CString -> IO String) -> IO String
forall a. String -> (CString -> IO a) -> IO a
withCString String
msgid_plural ((CString -> IO String) -> IO String)
-> (CString -> IO String) -> IO String
forall a b. (a -> b) -> a -> b
$ \CString
msgid_plural' ->
                CString -> CString -> CString -> CULong -> CInt -> IO CString
c_dcngettext CString
dn' CString
msgid' CString
msgid_plural'
                             (Integer -> CULong
forall a. Num a => Integer -> a
fromInteger Integer
n) (Category -> CInt
categoryToCInt Category
cat) IO CString -> (CString -> IO String) -> IO String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                String -> String -> Integer -> CString -> IO String
forall a.
(Eq a, Num a) =>
String -> String -> a -> CString -> IO String
fromCStringPluralDefault String
msgid String
msgid_plural Integer
n

-- | 'bindTextDomain' sets the base directory of the hierarchy
-- containing message catalogs for a given message domain.
--
-- Throws 'IOError' if fails
--
bindTextDomain :: String        -- ^ domain name
               -> Maybe String  -- ^ path to the locale folder or 'Nothing' to return
                                -- base directory for domain
               -> IO String     -- ^ return value
bindTextDomain :: String -> Maybe String -> IO String
bindTextDomain String
domainname Maybe String
dirname =
  String -> (CString -> IO String) -> IO String
forall a. String -> (CString -> IO a) -> IO a
withCString String
domainname ((CString -> IO String) -> IO String)
-> (CString -> IO String) -> IO String
forall a b. (a -> b) -> a -> b
$ \CString
domain ->
      Maybe String -> (CString -> IO String) -> IO String
forall a. Maybe String -> (CString -> IO a) -> IO a
withCStringMaybe Maybe String
dirname ((CString -> IO String) -> IO String)
-> (CString -> IO String) -> IO String
forall a b. (a -> b) -> a -> b
$ \CString
dir ->
          CString -> CString -> IO CString
c_bindtextdomain CString
domain CString
dir IO CString -> (CString -> IO String) -> IO String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> CString -> IO String
fromCStringError String
"bindTextDomain fails"

-- | 'textDomain' sets domain for future 'getText' call
--
-- Throws 'IOError' if fails
--
textDomain :: Maybe String      -- ^ domain name, if 'Nothing' than returns
                                -- current domain name
           -> IO String         -- ^ return value
textDomain :: Maybe String -> IO String
textDomain Maybe String
domainname =
    Maybe String -> (CString -> IO String) -> IO String
forall a. Maybe String -> (CString -> IO a) -> IO a
withCStringMaybe Maybe String
domainname ((CString -> IO String) -> IO String)
-> (CString -> IO String) -> IO String
forall a b. (a -> b) -> a -> b
$ \CString
domain ->
        CString -> IO CString
c_textdomain CString
domain IO CString -> (CString -> IO String) -> IO String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> CString -> IO String
fromCStringError String
"textDomain fails"