GetText.hs

-- | This library provides basic internationalization capabilities

module Text.I18N.GetText (
                          getText,
                          bindTextDomain,
                          textDomain
                         ) where

import Foreign.C.Types
import Foreign.C.String
import Foreign.Ptr
import Data.Maybe (fromMaybe)

foreign import ccall unsafe "libintl.h gettext" c_gettext :: CString -> 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 x | x == nullPtr = return Nothing
              | otherwise = peekCString x >>= return . Just

fromCStringDefault :: String -> CString -> IO String
fromCStringDefault d x = fromCString x >>= \r -> return (fromMaybe d r)

-- |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 s = 
    withCString s $ \s' -> 
        c_gettext s' >>= fromCStringDefault s

-- |bindTextDomain sets the base directory of the hierarchy
-- containing message catalogs for a given message domain.
--
bindTextDomain :: String        -- ^ domain name
               -> String        -- ^ path to the locale folder
               -> IO (Maybe String) -- ^ return value
bindTextDomain domainname dirname = 
  withCString domainname $ \domain -> 
      withCString dirname $ \dir ->
          c_bindtextdomain domain dir >>= fromCString


-- |textDomain sets domain for future 'getText' call
textDomain :: String            -- ^ domain name
           -> IO (Maybe String) -- ^ return value
textDomain domainname = 
    withCString domainname $ \domain ->
        c_textdomain domain >>= fromCString