i18n 0.3 → 0.4.0.0

raw patch · 9 files changed

+502/−576 lines, 9 filesdep +hspecdep +i18ndep +tastydep −arraydep −old-localedep −old-timedep ~basedep ~containersdep ~directorynew-uploaderPVP ok

version bump matches the API change (PVP)

Dependencies added: hspec, i18n, tasty, tasty-hspec, text, transformers

Dependencies removed: array, old-locale, old-time, utf8-string

Dependency ranges changed: base, containers, directory, filepath, mtl, parsec

API changes (from Hackage documentation)

Files

• LICENSE +1/−1
• Text/I18n.hs +0/−128
• Text/I18n/Po.hs +0/−188
• Text/I18n/Printf.hs +0/−243
• i18n.cabal +47/−16
• src/Data/Text/I18n.hs +105/−0
• src/Data/Text/I18n/Po.hs +242/−0
• src/Data/Text/I18n/Types.hs +62/−0
• test/Spec.hs +45/−0

@@ -1,4 +1,4 @@-Copyright (c) 2008, Eugene Grigoriev+Copyright (c) 2016, Eugene Grigoriev  All rights reserved. 

@@ -1,128 +0,0 @@-{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}--------------------------------------------------------------------------------- |--- Module      :  Text.I18n--- Copyright   :  (c) Eugene Grigoriev, 2008--- License     :  BSD3--- --- Maintainer  :  eugene.grigoriev@gmail.com--- Stability   :  experimental--- Portability :  portable------ Internationalization support for Haskell.---  Use Text.I18n.Po module.------  Plural forms are not yet implemented.----------------------------------------------------------------------------------module Text.I18n (-        -- * Type Declarations-        Msgid(..), Msgstr, Locale(..), Context, I18n, L10n,-        -- * Internationalization Monad Functions-        gettext, localize, withContext, withLocale-    ) where--import Control.Monad.Reader-import Control.Monad.Trans-import Control.Monad.Identity-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)--type Context = String---- | The Internationalization monad built using monad transformers.-type I18n a = ReaderT (Locale, L10n, Maybe Context) Identity 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 Prelude hiding (putStr,putStrLn)-    >-    > main = do-    >     (l10n,errors) <- getL10n "dir/to/po" -- directory containing PO files-    >     putStrLn $ localize l10n (Locale "en") (example "Joe")--}-localize :: L10n    -- ^ Structure containing localization data-         -> Locale  -- ^ Locale to use-         -> I18n a  -- ^ Inernationalized expression-         -> a       -- ^ Localized expression-localize l10n loc expression = runIdentity $ runReaderT expression (loc,l10n,Nothing)--{-|-    The heart of I18n monad. Based on 'Text.Printf.printf'.--    > example :: String -> I18n String-    > example name = do-    >     hello <- gettext "Hello, %s!"-    >     return (hello name)--}-gettext :: PrintfType a => String -> I18n a-gettext msgid = do-    (loc, l10n, 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 -> return (printf msgid)--{-|-    Sets a local 'Context' for an internationalized expression.-    If there is no translation, then no context version is tried.--    > example2 :: String -> I18n String-    > example2 = withContext (Just "test") . example--}-withContext :: Maybe Context -- ^ Context to use-            -> I18n a        -- ^ Internationalized expression-            -> I18n a        -- ^ New internationalized expression-withContext ctxt expression = do-    (lang, l10n, _) <- ask-    local (const (lang, l10n, ctxt))-          expression--{-|-    Sets a local 'Locale' for an internationalized expression.--    > example3 :: String -> I18n String-    > example3 = withLocale (Locale "ru") . example2--}-withLocale :: Locale    -- ^ Locale to use-           -> I18n a    -- ^ Internationalized expression-           -> I18n a    -- ^ New internationalized expression.-    -- Note: while this expression is localy localized already, it is to be a-    -- part of another internationalized expression.-    -- Therefore the final type is internationalized.-withLocale loc expression = do-    (_, l10n, ctxt) <- ask-    local (const (loc, l10n, ctxt))-          expression--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

@@ -1,188 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Text.I18n.Po--- Copyright   :  (c) Eugene Grigoriev, 2008--- License     :  BSD3--- --- Maintainer  :  eugene.grigoriev@gmail.com--- Stability   :  experimental--- Portability :  portable------ Internationalization support for Haskell. This module contains---  PO parser. PO files are assumed to be in UTF-8 encoding.------  Plural forms are not yet implemented.------  modules Text.I18n, Control.Monad.Trans, and function putStrLn and putStr---  from System.IO.UTF8 are exported for convenience.------ > import Prelude hiding (putStr,putStrLn)----------------------------------------------------------------------------------module Text.I18n.Po (-        -- * Type Declarations-        Msgid(..), Msgstr, Locale(..), Context, I18n, L10n,-        -- * PO parsing-        getL10n,-        -- * I18n Monad Functions-        localize, gettext, withContext, withLocale,-        -- * UTF-8 Output Functions-        Utf8.putStrLn, Utf8.putStr,-        module Control.Monad.Trans-    ) where--import Text.I18n-import Text.ParserCombinators.Parsec-import qualified Text.ParserCombinators.Parsec.Token as P-import Text.ParserCombinators.Parsec.Language-import Data.List-import qualified Data.Map as Map-import Data.Monoid-import Control.Monad.Trans-import Control.Arrow-import System.Directory-import System.FilePath-import qualified System.IO.UTF8 as Utf8------------------------------------------------------------------------------------ Type declarations---------------------------------------------------------------------------------data MsgDec = MsgDec (Maybe Context) Msgid [Msgstr]------------------------------------------------------------------------------------ Interface----------------------------------------------------------------------------------- | Builds 'L10n' structure by parsing / .po / files contained in a given--- directory. 'L10n' structure is to be passed to 'localize' function.--- 'L10n' structure is used internaly by the 'I18n' monad.-getL10n :: FilePath                 -- ^ Directory containing PO files.-        -> IO (L10n, [ParseError])  -- ^ Localization structure-            -- and a list of parse errors.-getL10n dir = do-    poFiles   <- poFiles dir-    locs      <- processPos (map (second parsePo) poFiles)-    (es,locs) <- return (separateEithers locs)-    return (Map.fromList locs, es)------------------------------------------------------------------------------------ Internal---------------------------------------------------------------------------------processPos :: [(Locale, IO (Either ParseError [MsgDec]))]-           -> IO [Either ParseError-                         (Locale, Map.Map (Maybe Context)-                                          (Map.Map Msgid-                                                   [Msgstr]))]-processPos rs = do-    rs <- mapM (\(a,m) -> m >>= \b -> return (a,b)) rs-    return $ map f rs-  where f (l, (Right msgdecs)) = Right (l, mkMsgs msgdecs)-        f (_, (Left  e))       = Left e--mkMsgs :: [MsgDec] -> Map.Map (Maybe Context) (Map.Map Msgid [Msgstr])-mkMsgs = foldl' f mempty-    where f m (MsgDec ctxt msgid msgstrs) = case Map.lookup ctxt m of-            Nothing -> f (Map.insert ctxt mempty m) (MsgDec ctxt msgid msgstrs)-            Just c  -> Map.insert ctxt (Map.insert msgid msgstrs c) m--poFiles :: FilePath -> IO [(Locale,FilePath)]-poFiles dir = do-    files <- getDirectoryContents dir-    return $ (map ((&&&) (Locale . (subtract 3 . length >>= take))-                         (intercalate [pathSeparator] . (dir :) . return))-              . filter (flip any [".po",".Po",".PO"] . flip isSuffixOf))-             files--parsePo :: FilePath -> IO (Either ParseError [MsgDec])-parsePo n = do-    contents <- Utf8.readFile n-    return $ parse po n contents------------------------------------------------------------------------------------ .po Parser---------------------------------------------------------------------------------{- EBNF-    PO            ::= msg*-    msg           ::= [msg-context] (msg-singular | msg-plural)-    msg-context   ::= "msgctxt" string*-    msg-singular  ::= msgid msgstr-    msg-plural    ::= msgid msgid-plural msgstr-plural*-    msgid         ::= "msgid"  string*-    msgid-plural  ::= "msgid_plural" string*-    msgstr        ::= "msgstr" string*-    msgstr-plural ::= "msgstr" form string*-    form          ::= "[" number "]"-    number        ::= (0-9)* | "N"-    string        ::= "\"" (char | escaped-char)* "\""-    escaped-char  ::= "\\" char-    char          ::= (any UTF8 character)--}-lexer = P.makeTokenParser (emptyDef {-    commentLine   = "#",-    reservedNames = ["msgctxt","msgid","msgid_plural","msgstr"] })--whiteSpace = P.whiteSpace lexer-lexeme     = P.lexeme     lexer-reserved   = P.reserved   lexer--po = do whiteSpace-        msgs <- many msg -        eof-        return msgs--msg = do ctxt      <- msg_context-         (id,strs) <- try msg_singular <|> msg_plural-         return (MsgDec ctxt id strs)--msg_context = try $ option Nothing $ do-    lexeme (reserved "msgctxt")-    strs <- many1 str-    return (Just (concat strs))--msg_singular = do id  <- lexeme msgid-                  str <- lexeme msgstr-                  return (Msgid id, [str])--msg_plural = do id    <- lexeme msgid-                idp   <- lexeme msgid_plural-                strps <- lexeme (many1 msgstr_plural)-                return (Msgid id, strps)--msgid = do lexeme (reserved "msgid")-           strs <- many1 str-           return (concat strs)--msgid_plural = do lexeme (reserved "msgid_plural")-                  strs <- many1 str-                  return (concat strs)--msgstr = do lexeme (reserved "msgstr")-            strs <- many1 str-            return (concat strs)--msgstr_plural = do lexeme (reserved "msgstr")-                   char '['-                   try (do c <- oneOf ['n','N']-                           return [c])-                       <|> many1 (oneOf ['0'..'9'])-                   char ']'-                   whiteSpace-                   strs <- many1 str-                   return (concat strs)--str = lexeme $ do char '"'-                  chs <- many ch-                  char '"'-                  return chs--ch = try escaped_ch <|> noneOf ['"']--escaped_ch = do e <- char '\\'-                c <- anyChar-                case reads ['\'',e,c,'\''] :: [(Char,String)] of-                    (c,s):[] -> return c-                    _        -> return c------------------------------------------------------------------------------------ Utilities---------------------------------------------------------------------------------separateEithers = foldr (either (first . (:)) (second . (:))) ([],[])

@@ -1,243 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Text.I18n.Printf--- Copyright   :  (c) Eugene Grigoriev, 2008--- License     :  BSD-style (see the file libraries/base/LICENSE)--- --- Maintainer  :  eugene.grigoriev@gmail.com--- Stability   :  provisional--- Portability :  portable------ A slightly modified version of Text.Printf module. (with permission)------ This module is internal to Text.I18n.----------------------------------------------------------------------------------module Text.I18n.Printf(-   printf, hPrintf,-   PrintfType, HPrintfType, PrintfArg, IsChar,-   spr, uprintf-) where--import Prelude-import Data.Char-import Data.Int-import Data.Word-import Numeric(showEFloat, showFFloat, showGFloat)-import System.IO--printf :: (PrintfType r) => String -> r-printf fmts = spr fmts []--hPrintf :: (HPrintfType r) => Handle -> String -> r-hPrintf hdl fmts = hspr hdl fmts []--class PrintfType t where-    spr :: String -> [UPrintf] -> t--class HPrintfType t where-    hspr :: Handle -> String -> [UPrintf] -> t--instance (IsChar c) => PrintfType [c] where-    spr fmts args = map fromChar (uprintf fmts (reverse args))--instance PrintfType (IO a) where-    spr fmts args = do-        putStr (uprintf fmts (reverse args))-        return undefined--instance HPrintfType (IO a) where-    hspr hdl fmts args = do-        hPutStr hdl (uprintf fmts (reverse args))-        return undefined--instance (PrintfArg a, PrintfType r) => PrintfType (a -> r) where-    spr fmts args = \ a -> spr fmts (toUPrintf a : args)--instance (PrintfArg a, HPrintfType r) => HPrintfType (a -> r) where-    hspr hdl fmts args = \ a -> hspr hdl fmts (toUPrintf a : args)--class PrintfArg a where-    toUPrintf :: a -> UPrintf--instance PrintfArg Char where-    toUPrintf c = UChar c--instance (IsChar c) => PrintfArg [c] where-    toUPrintf = UString . map toChar--instance PrintfArg Int where-    toUPrintf = uInteger--instance PrintfArg Int8 where-    toUPrintf = uInteger--instance PrintfArg Int16 where-    toUPrintf = uInteger--instance PrintfArg Int32 where-    toUPrintf = uInteger--instance PrintfArg Int64 where-    toUPrintf = uInteger---- if on NHC, exclure this declaration using CPP-instance PrintfArg Word where-    toUPrintf = uInteger--instance PrintfArg Word8 where-    toUPrintf = uInteger--instance PrintfArg Word16 where-    toUPrintf = uInteger--instance PrintfArg Word32 where-    toUPrintf = uInteger--instance PrintfArg Word64 where-    toUPrintf = uInteger--instance PrintfArg Integer where-    toUPrintf = UInteger 0--instance PrintfArg Float where-    toUPrintf = UFloat--instance PrintfArg Double where-    toUPrintf = UDouble--uInteger :: (Integral a, Bounded a) => a -> UPrintf-uInteger x = UInteger (toInteger $ minBound `asTypeOf` x) (toInteger x)--class IsChar c where-    toChar :: c -> Char-    fromChar :: Char -> c--instance IsChar Char where-    toChar c = c-    fromChar c = c-----------------------data UPrintf = UChar Char | UString String | UInteger Integer Integer | UFloat Float | UDouble Double--uprintf :: String -> [UPrintf] -> String-uprintf ""       []       = ""-uprintf ""       (_:_)    = fmterr-uprintf ('%':'%':cs) us   = '%':uprintf cs us-uprintf ('%':_)  []       = argerr-uprintf ('%':cs) us@(_:_) = fmt cs us-uprintf (c:cs)   us       = c:uprintf cs us--fmt :: String -> [UPrintf] -> String-fmt cs us =-    let (width, prec, ladj, zero, plus, cs', us') = getSpecs False False False cs us-        adjust (pre, str) = -            let lstr = length str-                lpre = length pre-                fill = if lstr+lpre < width then take (width-(lstr+lpre)) (repeat (if zero then '0' else ' ')) else ""-            in  if ladj then pre ++ str ++ fill else if zero then pre ++ fill ++ str else fill ++ pre ++ str-        adjust' ("", str) | plus = adjust ("+", str)-        adjust' ps = adjust ps-    in case cs' of-        []     -> fmterr-        c:cs'' -> case us' of-                    []     -> argerr-                    u:us'' -> (case c of-                                'c' -> adjust  ("", [toEnum (toint u)])-                                'd' -> adjust' (fmti u)-                                'i' -> adjust' (fmti u)-                                'x' -> adjust  ("", fmtu 16 u)-                                'X' -> adjust  ("", map toUpper $ fmtu 16 u)-                                'o' -> adjust  ("", fmtu 8  u)-                                'u' -> adjust  ("", fmtu 10 u)-                                'e' -> adjust' (dfmt' c prec u)-                                'E' -> adjust' (dfmt' c prec u)-                                'f' -> adjust' (dfmt' c prec u)-                                'g' -> adjust' (dfmt' c prec u)-                                'G' -> adjust' (dfmt' c prec u)-                                's' -> adjust  ("", tostr u)-                                _   -> perror ("bad formatting char " ++ [c])-                                ) ++ uprintf cs'' us''--fmti :: UPrintf -> (String, String)-fmti (UInteger _ i) = if i < 0 then ("-", show (-i)) else ("", show i)-fmti (UChar c)      = fmti (uInteger (fromEnum c))-fmti _          = baderr--fmtu :: Integer -> UPrintf -> String-fmtu b (UInteger l i) = itosb b (if i < 0 then -2*l + i else i)-fmtu b (UChar c)      = itosb b (toInteger (fromEnum c))-fmtu _ _              = baderr--toint :: UPrintf -> Int-toint (UInteger _ i) = fromInteger i-toint (UChar c)      = fromEnum c-toint _          = baderr--tostr :: UPrintf -> String-tostr (UString s) = s-tostr _       = baderr--itosb :: Integer -> Integer -> String-itosb b n = -    if n < b then -        [intToDigit $ fromInteger n]-    else-        let (q, r) = quotRem n b in-        itosb b q ++ [intToDigit $ fromInteger r]--stoi :: Int -> String -> (Int, String)-stoi a (c:cs) | isDigit c = stoi (a*10 + digitToInt c) cs-stoi a cs                 = (a, cs)--getSpecs :: Bool -> Bool -> Bool -> String -> [UPrintf] -> (Int, Int, Bool, Bool, Bool, String, [UPrintf])-getSpecs _ z s ('-':cs) us = getSpecs True z s cs us-getSpecs l z _ ('+':cs) us = getSpecs l z True cs us-getSpecs l _ s ('0':cs) us = getSpecs l True s cs us-getSpecs l z s ('*':cs) us = -        case us of-            [] -> argerr-            nu : us' ->-                let n = toint nu-                    (p, cs'', us'') =-                        case cs of-                            '.':'*':r -> case us' of { [] -> argerr; pu:us''' -> (toint pu, r, us''') }-                            '.':r     -> let (n', cs') = stoi 0 r in (n', cs', us')-                            _         -> (-1, cs, us')-                        in  (n, p, l, z, s, cs'', us'')-getSpecs l z s ('.':cs) us =-    let (p, cs') = stoi 0 cs-    in  (0, p, l, z, s, cs', us)-getSpecs l z s cs@(c:_) us | isDigit c =-    let (n, cs') = stoi 0 cs-        (p, cs'') = case cs' of-            '.':r -> stoi 0 r-            _     -> (-1, cs')-    in  (n, p, l, z, s, cs'', us)-getSpecs l z s cs       us = (0, -1, l, z, s, cs, us)--dfmt' :: Char -> Int -> UPrintf -> (String, String)-dfmt' c p (UDouble d) = dfmt c p d-dfmt' c p (UFloat f)  = dfmt c p f-dfmt' _ _ _           = baderr--dfmt :: (RealFloat a) => Char -> Int -> a -> (String, String)-dfmt c p d =-    case (if isUpper c then map toUpper else id) $-             (case toLower c of-                  'e' -> showEFloat-                  'f' -> showFFloat-                  'g' -> showGFloat-                  _   -> error "Printf.dfmt: impossible"-             )-               (if p < 0 then Nothing else Just p) d "" of-    '-':cs -> ("-", cs)-    cs     -> ("" , cs)--perror :: String -> a-perror s = error ("Printf.printf: "++s)-fmterr, argerr, baderr :: a-fmterr = perror "formatting string ended prematurely"-argerr = perror "argument list ended prematurely"-baderr = perror "bad argument"

@@ -1,18 +1,49 @@-Name:                i18n-Version:             0.3-Cabal-Version:       >= 1.2+name:                i18n+version:             0.4.0.0+description:         Internationalisation for Haskell+license-file:        LICENSE+license:             BSD3++author:              Eugene Grigoriev <eugene.grigoriev@gmail.com>+bug-reports:         https://github.com/filib/i18n/issues build-type:          Simple-Synopsis:            Internationalization for Haskell-Category:            Text-License:             BSD3-License-file:        LICENSE-Copyright:           (c) 2008 Eugene Grigoriev-Author:              Eugene Grigoriev <eugene.grigoriev@gmail.com>-Maintainer:          Eugene Grigoriev <eugene.grigoriev@gmail.com>-Stability:           experimental-Description:         Internationalization for Haskell+cabal-version:       >=1.10+category:            Text+copyright:           (c) 2008-2016 Eugene Grigoriev+homepage:            https://github.com/filib/i18n+maintainer:          Philip Cunningham <hello@filib.io>+stability:           experimental+synopsis:            Internationalization for Haskell -Library-    Build-Depends:   base, array, containers, old-locale, old-time, filepath,-                     directory, parsec, mtl, utf8-string-    Exposed-Modules: Text.I18n, Text.I18n.Po, Text.I18n.Printf+Source-repository head+  type: git+  location: https://github.com/filib/i18n++library+    hs-source-dirs:    src+    exposed-modules:   Data.Text.I18n+                     , Data.Text.I18n.Po+                     , Data.Text.I18n.Types+    build-depends:     base >= 4.7 && < 5+                     , containers >= 0.5.6.2+                     , filepath >= 1.4.0.0+                     , directory >= 1.2.0.0+                     , parsec >= 3.1.9+                     , mtl >= 2.2.1+                     , text >= 1.2.1.3+                     , transformers >= 0.4.2.0+    default-language:  Haskell2010++test-suite i18n-test+  type:                exitcode-stdio-1.0+  hs-source-dirs:      test+  main-is:             Spec.hs+  build-depends:       base+                     , containers+                     , hspec+                     , i18n+                     , tasty+                     , tasty-hspec+                     , text+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N -Wall+  default-language:    Haskell2010

@@ -0,0 +1,105 @@+{-# LANGUAGE FlexibleInstances    #-}+{-# LANGUAGE OverloadedStrings    #-}+{-# LANGUAGE TypeSynonymInstances #-}++-- |+-- Module:      Data.Text.I18n+-- Copyright:   (c) 2011-2016 Eugene Grigoriev+-- License:     BSD3+-- Maintainer:  Philip Cunningham <hello@filib.io>+-- Stability:   experimental+-- Portability: portable+--+-- Internationalisation support for Haskell.++module Data.Text.I18n (+    -- * Internationalisation Monad Functions+    gettext,+    localize,+    withContext,+    withLocale,+    -- * Re-exports+    module Data.Text.I18n.Types,+    ) where++import           Control.Monad.Identity+import           Control.Monad.Reader+import qualified Data.Map               as Map+import           Data.Maybe+import qualified Data.Text              as T+import           Data.Text.I18n.Types++-- $setup+-- >>> :set -XOverloadedStrings+-- >>> import qualified Data.Text.I18n    as I18n+-- >>> import qualified Data.Text.I18n.Po as I18n+-- >>> let example = I18n.gettext "Like tears in rain."+-- >>> (l10n, _) <- I18n.getL10n "./test/locale"+--+-- | The heart of I18n monad.+gettext :: T.Text -> I18n T.Text+gettext msgid = do+  (loc, l10n, ctxt) <- ask+  case localizeMsgid l10n loc ctxt (Msgid msgid) of+    Just msgstr -> return msgstr+    Nothing ->+      case ctxt of+        Just _  -> withContext Nothing (gettext msgid)+        Nothing -> return msgid++-- | Top level localization function.+--+-- Examples:+--+-- >>> I18n.localize l10n (I18n.Locale "cym") example+-- "Fel dagrau yn y glaw."+--+-- When the translation doesn't exist:+--+-- >>> I18n.localize l10n (I18n.Locale "ru") example+-- "Like tears in rain."+localize :: L10n    -- ^ Structure containing localization data+         -> Locale  -- ^ Locale to use+         -> I18n a  -- ^ Inernationalized expression+         -> a       -- ^ Localized expression+localize l10n loc expression = runIdentity $ runReaderT expression (loc, l10n, Nothing)++-- | Sets a local 'Context' for an internationalized expression. If there is no translation, then no+-- context version is tried.+--+-- Examples:+--+-- >>> let example2 = I18n.withContext (Just "Attack ships on fire off the shoulder of Orion.") example+-- >>> I18n.localize l10n (I18n.Locale "cym") example2+-- "Fel dagrau yn y glaw."+withContext :: Maybe Context -- ^ Context to use+            -> I18n a        -- ^ Internationalized expression+            -> I18n a        -- ^ New internationalized expression+withContext ctxt expression = do+  (lang, l10n, _) <- ask+  local (const (lang, l10n, ctxt)) expression++-- | Sets a local 'Locale' for an internationalized expression.+--+-- Examples:+--+-- >>> let example3 = I18n.withLocale (I18n.Locale "en") example+-- >>> I18n.localize l10n (I18n.Locale "cym") example3+-- "Like tears in rain."+withLocale :: Locale    -- ^ Locale to use+           -> I18n a    -- ^ Internationalized expression+           -> I18n a    -- ^ New internationalized expression.+withLocale loc expression = do+  (_, l10n, ctxt) <- ask+  local (const (loc, l10n, ctxt)) expression++-- | Internal lookup function.+localizeMsgid :: L10n -> Locale -> Maybe Context -> Msgid -> Maybe T.Text+localizeMsgid l10n loc ctxt msgid = do+  local' <- Map.lookup loc l10n+  contextual <- Map.lookup ctxt local'+  msgstrs <- Map.lookup msgid contextual+  case listToMaybe msgstrs of+    Nothing     -> Nothing+    Just ""     -> Nothing+    Just msgstr -> Just msgstr

@@ -0,0 +1,242 @@+{-# LANGUAGE OverloadedStrings #-}++-- |+-- Module:      Data.Text.I18n.Po+-- Copyright:   (c) 2011-2016 Eugene Grigoriev+-- License:     BSD3+-- Maintainer:  Philip Cunningham <hello@filib.io>+-- Stability:   experimental+-- Portability: portable+--+-- This module contains the PO parser. PO files are assumed to be in UTF-8+-- encoding. Plural forms are not yet implemented.++module Data.Text.I18n.Po (+    -- * PO parsing+    getL10n,+    -- * I18n Monad Functions+    localize,+    gettext,+    withContext,+    withLocale,+    -- * Parsing functions+    parsePo,+    ) where++import           Control.Applicative ((<$>))+import           Control.Arrow (second, (&&&))+import           Data.Either (partitionEithers)+import           Data.Functor.Identity (Identity)+import           Data.List (foldl', intercalate, isSuffixOf)+import qualified Data.Map as Map+import           Data.Monoid (mconcat, mempty)+import qualified Data.Text as T+import qualified Data.Text.IO as T+import           System.Directory (getDirectoryContents)+import           System.FilePath (pathSeparator)+import           Text.Parsec+import           Text.Parsec.Text+import           Text.ParserCombinators.Parsec.Language+import qualified Text.ParserCombinators.Parsec.Token as P++import           Data.Text.I18n++-- External functions++-- | Builds 'L10n' structure by parsing / .po / files contained in a given+-- directory. 'L10n' structure is to be passed to 'localize' function. 'L10n'+-- structure is used internaly by the 'I18n' monad.+getL10n :: FilePath+        -- ^ Directory containing PO files.+        -> IO (L10n, [ParseError])+        -- ^ Localization structure and a list of parse errors.+getL10n dir = do+  poFiles' <- poFiles dir+  locs <- processPos (map (second parsePo) poFiles')+  (es, locs') <- return $! partitionEithers locs+  return (Map.fromList locs', es)++-- Internal Fuctions++processPos :: [(Locale, IO (Either ParseError [MsgDec]))]+           -> IO [Either ParseError (Locale, CtxMap)]+processPos rs = do+  rs' <- mapM (\(a, m) -> m >>= \b -> return (a, b)) rs+  return $! map f rs'++  where+    f :: (a, Either b [MsgDec]) -> Either b (a, CtxMap)+    f (l, Right msgdecs) = Right (l, mkMsgs msgdecs)+    f (_, Left e) = Left e++mkMsgs :: [MsgDec] -> CtxMap+mkMsgs = foldl' f mempty+  where+    f :: CtxMap -> MsgDec -> CtxMap+    f m (MsgDec ctxt msgid' msgstrs) =+      case Map.lookup ctxt m of+        Nothing -> f (Map.insert ctxt mempty m) (MsgDec ctxt msgid' msgstrs)+        Just c  -> Map.insert ctxt (Map.insert msgid' msgstrs c) m++-- | Finds all .po files for a given directory. Works on the assumption that the characters before+-- the file extension are the locale name.+poFiles :: FilePath -> IO [(Locale, FilePath)]+poFiles dir = do+  files <- getDirectoryContents dir+  return $! fmap assocLocalesAndPaths <$> onlyPoFiles $ files++  where+    toAbsolutePath :: FilePath -> FilePath+    toAbsolutePath = intercalate [pathSeparator] . (dir :) . return++    isPoFile :: FilePath -> Bool+    isPoFile = flip any [".po", ".Po", ".PO"] . flip isSuffixOf++    onlyPoFiles :: [FilePath] -> [FilePath]+    onlyPoFiles = filter isPoFile++    assocLocalesAndPaths :: FilePath -> (Locale, FilePath)+    assocLocalesAndPaths = stripLocale &&& toAbsolutePath++    stripLocale :: FilePath -> Locale+    stripLocale path =+      let n = subtract 3 . length $ path+      in Locale . T.pack $! take n path++parsePo :: FilePath -> IO (Either ParseError [MsgDec])+parsePo path = do+  contents <- T.readFile path+  return $! parse po path contents++{- EBNF+    PO            ::= msg*+    msg           ::= [msg-context] (msg-singular | msg-plural)+    msg-context   ::= "msgctxt" string*+    msg-singular  ::= msgid msgstr+    msg-plural    ::= msgid msgid-plural msgstr-plural*+    msgid         ::= "msgid"  string*+    msgid-plural  ::= "msgid_plural" string*+    msgstr        ::= "msgstr" string*+    msgstr-plural ::= "msgstr" form string*+    form          ::= "[" number "]"+    number        ::= (0-9)* | "N"+    string        ::= "\"" (char | escaped-char)* "\""+    escaped-char  ::= "\\" char+    char          ::= (any UTF8 character)+-}+lexer :: P.GenTokenParser T.Text () Identity+lexer = P.makeTokenParser poLangDef+  where+    poLangDef :: GenLanguageDef T.Text st Identity+    poLangDef = LanguageDef+      { commentStart = ""+      , commentEnd = ""+      , commentLine = "#"+      , nestedComments = True+      , identStart = letter <|> char '_'+      , identLetter = alphaNum <|> oneOf "_'"+      , opStart = opLetter poLangDef+      , opLetter = oneOf ":!#$%&*+./<=>?@\\^|-~"+      , reservedOpNames = []+      , reservedNames = ["msgctxt", "msgid", "msgid_plural", "msgstr"]+      , caseSensitive = True+      }++whiteSpace :: Parser ()+whiteSpace = P.whiteSpace lexer++lexeme :: Parser a -> Parser a+lexeme = P.lexeme lexer++reserved :: String -> Parser ()+reserved = P.reserved lexer++po :: Parser [MsgDec]+po = do+  _ <- whiteSpace+  msgs <- many msg+  _ <- eof+  return $! msgs++msg :: Parser MsgDec+msg = do+  ctxt <- msgContext+  (id', strs) <- try msgSingular <|> msgPlural+  return $! MsgDec ctxt id' strs++msgContext :: Parser (Maybe Context)+msgContext = try $ option Nothing $ do+  _ <- lexeme (reserved "msgctxt")+  strs <- many1 str+  return (Just $! mconcat strs)++msgSingular :: Parser (Msgid, [Msgstr])+msgSingular = do+  id' <- lexeme msgid+  str' <- lexeme msgstr+  return (Msgid id', [str'])++msgPlural :: Parser (Msgid, [Msgstr])+msgPlural = do+  id' <- lexeme msgid+  _ <- lexeme msgidPlural+  strps <- lexeme (many1 msgstrPlural)+  return (Msgid id', strps)++msgid :: Parser T.Text+msgid = do+  _ <- lexeme (reserved "msgid")+  strs <- many1 str+  return $! mconcat strs++msgidPlural :: Parser Msgstr+msgidPlural = do+  _ <- lexeme (reserved "msgid_plural")+  strs <- many1 str+  return $! mconcat strs++msgstr :: Parser Msgstr+msgstr = do+  _ <- lexeme (reserved "msgstr")+  strs <- many1 str+  return $! mconcat strs++msgstrPlural :: Parser Msgstr+msgstrPlural = do+  _ <- lexeme (reserved "msgstr")+  _ <- char '['+  _ <- try indice+  _ <- char ']'+  _ <- whiteSpace+  strs <- many1 str+  return $! mconcat strs++  where+    caseN :: Parser String+    caseN = do+      c <- oneOf ['n', 'N']+      return [c]++    caseX :: Parser String+    caseX = many1 $ oneOf ['0' .. '9']++    indice :: Parser String+    indice = caseN <|> caseX++str :: Parser T.Text+str = lexeme $ do+  _ <- char '"'+  chs <- many char'+  _ <- char '"'+  return $! T.pack chs++char' :: Parser Char+char' = try escapedChar <|> noneOf ['"']++escapedChar :: Parser Char+escapedChar = do+  e <- char '\\'+  c <- anyChar+  case reads ['\'', e, c, '\''] :: [(Char, String)] of+    [(c', _)] -> return $! c'+    _         -> return $! c

@@ -0,0 +1,62 @@+-- |+-- Module:      Data.Text.I18n.Po+-- Copyright:   (c) 2011-2016 Eugene Grigoriev+-- License:     BSD3+-- Maintainer:  Philip Cunningham <hello@filib.io>+-- Stability:   experimental+-- Portability: portable+--+-- Internationalisation support for Haskell.++module Data.Text.I18n.Types (+    -- * Type Declarations+    Context,+    CtxMap,+    I18n,+    L10n,+    Locale(..),+    MsgDec(..),+    Msgid(..),+    Msgstr,+    ) where++import           Control.Monad.Identity (Identity)+import           Control.Monad.Reader   (ReaderT)+import qualified Data.Map.Strict        as Map+import qualified Data.Text              as T++-- $setup+-- >>> :set -XOverloadedStrings+--+-- | Local context.+type Context = T.Text++-- | Mapping from a contexts to translation mappings.+type CtxMap = Map.Map (Maybe Context) TranslationMap++-- | The Internationalization monad built using monad transformers.+type I18n a = ReaderT (Locale, L10n, Maybe Context) Identity a++-- | The Localization structure.+type L10n = Map.Map Locale (Map.Map (Maybe Context) (Map.Map Msgid [Msgstr]))++-- | Textual representation of a locale e.g.+-- >>> Locale "en_GB"+-- ...+newtype Locale = Locale T.Text+  deriving (Show, Eq, Ord)++-- | Message delcaration.+data MsgDec = MsgDec (Maybe Context) Msgid [Msgstr]++-- | Untranslated string.+-- >>> Msgid "hello there"+-- ...+newtype Msgid = Msgid T.Text+  deriving (Show, Eq, Ord)++-- | Translated string.+type Msgstr = T.Text++-- | Mapping from identifiers to translations.+type TranslationMap = Map.Map Msgid [Msgstr]

@@ -0,0 +1,45 @@+{-# LANGUAGE OverloadedStrings #-}++import Data.Text.I18n+import Data.Text.I18n.Po+import Test.Tasty+import Test.Tasty.Hspec++main :: IO ()+main = do+  a <- testSpec "Library Specs" librarySpecs+  defaultMain (tests $ testGroup "All specs" [a])++tests :: TestTree -> TestTree+tests specs = testGroup "i18n Tests" [specs]++librarySpecs :: Spec+librarySpecs = describe "localize" $ do+  let localeDir = "test/locale"++  context "when the translation does not exist" $ do+    it "should return the original" $ do+      (l10n, _) <- getL10n localeDir+      let subject = localize l10n (Locale "fr") (gettext "Like tears in rain.")+      let result = "Like tears in rain."+      subject `shouldBe` result++    it "should return the original" $ do+      (l10n, _) <- getL10n localeDir+      let subject = localize l10n (Locale "en") (gettext "Like tears in rain.")+      let result = "Like tears in rain."+      subject `shouldBe` result++  context "when the translation does exist" $ do+    it "should return the translation" $ do+      (l10n, _) <- getL10n localeDir+      let subject = localize l10n (Locale "cym") (gettext "Like tears in rain.")+      let result = "Fel dagrau yn y glaw."+      subject `shouldBe` result++    context "but it is an empty string" $ do+      it "should return the original" $ do+        (l10n, _) <- getL10n localeDir+        let subject = localize l10n (Locale "fr") (gettext "Like tears in rain.")+        let result = "Like tears in rain."+        subject `shouldBe` result