module Data.Gettext
(
Catalog,
loadCatalog,
lookup,
gettext, cgettext,
ngettext, cngettext,
ngettext',
assocs,
getHeaders,
getPluralDefinition,
choosePluralForm,
parseGmo,
unpackGmoFile
) where
import Prelude hiding (lookup)
import Data.Binary
import Data.Binary.Get
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as L
import qualified Data.Text.Lazy as T
import qualified Data.Text.Lazy.Encoding as TLE
import qualified Data.Trie as Trie
import Text.Printf
import Data.Gettext.GmoFile
import Data.Gettext.Plural
import Data.Gettext.Parsers
data Catalog = Catalog {
gmoSize :: Word32,
gmoChoosePlural :: Int -> Int,
gmoData :: Trie.Trie [T.Text] }
instance Show Catalog where
show gmo = printf "<GetText data size=%d>" (gmoSize gmo)
loadCatalog :: FilePath -> IO Catalog
loadCatalog path = do
content <- L.readFile path
let gmoFile = (runGet parseGmo content) {fData = content}
return $ unpackGmoFile gmoFile
lookup :: B.ByteString -> Catalog -> Maybe [T.Text]
lookup key gmo = Trie.lookup key (gmoData gmo)
assocs :: Catalog -> [(B.ByteString, [T.Text])]
assocs = Trie.toList . gmoData
getHeaders :: Catalog -> Maybe Headers
getHeaders gmo = getHeaders' (gmoData gmo)
getHeaders' :: Trie.Trie [T.Text] -> Maybe Headers
getHeaders' trie =
case Trie.lookup "" trie of
Nothing -> Nothing
Just texts -> either error Just $ parseHeaders (head texts)
getPluralDefinition :: Catalog -> Maybe (Int, Expr)
getPluralDefinition gmo = getPluralDefinition' (gmoData gmo)
getPluralDefinition' :: Trie.Trie [T.Text] -> Maybe (Int, Expr)
getPluralDefinition' trie =
case getHeaders' trie of
Nothing -> Nothing
Just headers -> either error Just $ parsePlural headers
gettext :: Catalog
-> B.ByteString
-> T.Text
gettext gmo key =
case lookup key gmo of
Nothing -> TLE.decodeUtf8 $ L.fromStrict key
Just texts -> head texts
cgettext :: Catalog
-> B.ByteString
-> B.ByteString
-> T.Text
cgettext gmo context key = gettext gmo (context `B.append` "\4" `B.append` key)
ngettext :: Catalog
-> B.ByteString
-> B.ByteString
-> Int
-> T.Text
ngettext gmo single plural n = ngettext' gmo (single `B.append` "\0" `B.append` plural) n
cngettext :: Catalog
-> B.ByteString
-> B.ByteString
-> B.ByteString
-> Int
-> T.Text
cngettext gmo context single plural n =
ngettext' gmo (context `B.append` "\4" `B.append` single `B.append` "\0" `B.append` plural) n
ngettext' :: Catalog
-> B.ByteString
-> Int
-> T.Text
ngettext' gmo key n =
case lookup key gmo of
Nothing -> TLE.decodeUtf8 $ L.fromStrict key
Just texts ->
let plural = choosePluralForm gmo n
idx = if plural >= length texts
then 0
else plural
in texts !! idx
choosePluralForm :: Catalog -> Int -> Int
choosePluralForm gmo = gmoChoosePlural gmo
choosePluralForm' :: Trie.Trie [T.Text] -> Int -> Int
choosePluralForm' trie n =
case getPluralDefinition' trie of
Nothing -> if n == 1 then 0 else 1
Just (_, expr) -> eval expr n
unpackGmoFile :: GmoFile -> Catalog
unpackGmoFile (GmoFile {..}) = Catalog fSize choose trie
where
getOrig (len,offs) = L.take (fromIntegral len) $ L.drop (fromIntegral offs) fData
choose = choosePluralForm' trie
getTrans (len,offs) =
let bstr = getOrig (len,offs)
in if L.null bstr
then [T.empty]
else map TLE.decodeUtf8 $ L.split 0 bstr
originals = map L.toStrict $ map getOrig fOriginals
translations = map getTrans fTranslations
trie = Trie.fromList $ zip originals translations