i18n-0.1: Text/I18n.hs

{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Text.I18n
-- Copyright   :  (c) Eugene Grigoriev, 2008
-- License     :  BSD-style
-- 
-- Maintainer  :  eugene.grigoriev@gmail.com
-- Stability   :  experimental
-- Portability :  portable
--
-- Internationalization support for Haskell based on GNU gettext
--  (<http://www.gnu.org/software/gettext>).
--  Use Text.I18n.Po module.
--
--  Plural forms are not yet implemented.
--
-----------------------------------------------------------------------------
module Text.I18n (
        -- * Type Declarations
        Msgid(..), Msgstr, L10nMode(..), Locale(..), Context, I18n, L10n,
        -- * Internationalization Monad Functions
        gettext, localize, withContext, withLocale, localize'
    ) where

import Control.Monad.Reader
import Control.Monad.Trans
import Data.Maybe
import Text.I18n.Printf
import qualified Data.Map as Map

-------------------------------------------------------------------------------
-- Type declarations
-------------------------------------------------------------------------------
newtype Msgid = Msgid String deriving (Show,Eq,Ord)

type Msgstr = String

newtype Locale = Locale String deriving (Show,Eq,Ord)

-- | Localization mode. 'L10nMust' will throw an exception if unable to
-- translate whereas 'L10nMay' will just return the original 'Msgid' String.
-- 'L10nMay' is used by 'localize'.
data L10nMode = L10nMust | L10nMay

type Context = String

-- | The Internationalization monad allows the use of IO through 'liftIO'.
type I18n a = ReaderT (Locale, L10n, L10nMode, Maybe Context) IO a

-- | The Localization structure.
type L10n = Map.Map Locale
                    (Map.Map (Maybe Context)
                             (Map.Map Msgid
                                      [Msgstr]))

instance PrintfType (I18n String) where
    spr fmts args = return (uprintf fmts (reverse args))

-------------------------------------------------------------------------------
-- I18N Monad functions
-------------------------------------------------------------------------------
{-|
    The top level localization function.

    > import Text.I18n.Po
    > import qualified System.IO.UTF8 as Utf8
    >
    > main = do
    >   (l10n,errors) <- getL10n "dir/to/po"
    >   localize l10n (Locale "en") impl
-}
localize :: L10n    -- ^ Structure containing localization data
         -> Locale  -- ^ Locale to use
         -> I18n a  -- ^ Inernationalized action
         -> IO a    -- ^ Localized action
localize = flip localize' L10nMay

{-|
    The top level localization function with a mode parameter.

    > main2 = localize' (Text.I18n.Po.getL10n "dir/to/po")
    >                   L10nMust
    >                   (Locale "en")
    >                   impl
-}
localize' :: L10n     -- ^ Structure containing localization data
          -> L10nMode -- ^ Localization mode
          -> Locale   -- ^ Locale to use
          -> I18n a   -- ^ Inernationalized action
          -> IO a     -- ^ Localized action
localize' l10n mode loc action = runReaderT action (loc,l10n,mode,Nothing)

{-|
    The heart of I18n monad. Based on 'Text.Printf.printf'.

    > impl = do
    >       hello <- gettext "Hello, %s!"
    >       liftIO (Utf8.putStrLn (hello "Joe"))
-}
gettext :: PrintfType a => String -> I18n a
gettext msgid = do
    (loc, l10n, mode, ctxt) <- ask
    case localizeMsgid l10n loc ctxt (Msgid msgid) of
        Just msgstr -> return (printf msgstr)
        Nothing     -> case ctxt of
                            Just _  -> withContext Nothing (gettext msgid)
                            Nothing -> case mode of
                                L10nMay  -> return (printf msgid)
                                L10nMust -> fail
                                    ("Undefined localization: " ++
                                     show ((Msgid msgid),loc) )

{-|
    Sets a local 'Context' for an internationalized action.
    If there is no translation, then no context version is tried.

    > impl2 = withContext (Just "test") impl
-}
withContext :: Maybe Context -- ^ Context to use
            -> I18n a        -- ^ Internationalized action
            -> I18n a        -- ^ New internationalized action
withContext ctxt action = do
    (lang, l10n, mode, _) <- ask
    local (const (lang, l10n, mode, ctxt))
          action

{-|
    Sets a local 'Locale' for an internationalized action.

    > impl3 = withLocale (Locale "ru") impl2
-}
withLocale :: Locale    -- ^ Locale to use
           -> I18n a    -- ^ Internationalized action
           -> I18n a    -- ^ New internationalized action.
    -- Note: while this action is localy localized already, it is to be a part
    -- of another internationalized action.
    -- Therefore the final type is internationalized.
withLocale loc action = do
    (_, l10n, mode, ctxt) <- ask
    local (const (loc, l10n, mode, ctxt))
          action

localizeMsgid :: L10n -> Locale -> Maybe Context -> Msgid -> Maybe String
localizeMsgid l10n loc ctxt msgid = do
    local      <- Map.lookup loc  l10n
    contextual <- Map.lookup ctxt local
    msgstrs    <- Map.lookup msgid contextual
    listToMaybe msgstrs