haskell-gettext 0.1.0.0 → 0.1.1.0
raw patch · 6 files changed
+389/−93 lines, 6 filesdep ~haskell-src-exts
Dependency ranges changed: haskell-src-exts
Files
- Data/Gettext.hs +71/−90
- Data/Gettext/GmoFile.hs +75/−0
- Data/Gettext/Parsers.hs +156/−0
- Data/Gettext/Plural.hs +80/−0
- examples/gmotest.hs +1/−1
- haskell-gettext.cabal +6/−2
Data/Gettext.hs view
@@ -1,13 +1,39 @@ {-# LANGUAGE RecordWildCards, OverloadedStrings #-}-+-- | This is the main module of @haskell-gettext@ package.+-- For most cases, it is enough to import only this module. +-- Other modules of the package might be useful for other libraries+-- working with gettext's files.+--+-- Simple example of usage of this module is:+--+-- @+-- {-\# LANGUAGE OverloadedStrings #\-}+-- module Main where+--+-- import qualified Data.Text.Lazy as T+-- import qualified Text.Lazy.IO as TLIO+-- import Text.Printf+--+-- import Data.Gettext+--+-- main :: IO ()+-- main = do+-- catalog <- loadCatalog "locale\/ru\/messages.mo"+-- TLIO.putStrLn $ gettext catalog "Simple translated message"+-- let n = 78+-- let template = ngettext catalog "There is %d file" "There are %d files" n+-- printf (T.unpack template) n+-- @+-- module Data.Gettext ( -- * Data structures- GmoFile (..), Catalog, -- * Loading and using translations loadCatalog, lookup,- gettext, ngettext, ngettext',+ gettext, cgettext,+ ngettext, cngettext,+ ngettext', assocs, -- * Utilities for plural forms getHeaders,@@ -19,42 +45,19 @@ ) where import Prelude hiding (lookup)-import Control.Monad-import Data.Either 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.Encoding as TE import qualified Data.Text.Lazy.Encoding as TLE import qualified Data.Trie as Trie-import Data.Word import Text.Printf +import Data.Gettext.GmoFile import Data.Gettext.Plural import Data.Gettext.Parsers --- import Debug.Trace---- | This structure describes the binary structure of Gettext @.mo/.gmo@ file.-data GmoFile = GmoFile {- fMagic :: Word32 -- ^ Magic number (must be @0x950412de@ or @0xde120495@)- , fRevision :: Word32 -- ^ File revision- , fSize :: Word32 -- ^ Number of text pairs in the file- , fOriginalOffset :: Word32 -- ^ Offset of original strings- , fTranslationOffset :: Word32 -- ^ Offset of translations- , fHashtableSize :: Word32 -- ^ Size of hash table- , fHashtableOffset :: Word32 -- ^ Offset of hash table- , fOriginals :: [(Word32, Word32)] -- ^ Original strings - sizes and offsets- , fTranslations :: [(Word32, Word32)] -- ^ Translations - sizes and offsets- , fData :: L.ByteString -- ^ All file data - used to access strings by offsets- }- deriving (Eq)--instance Show GmoFile where- show f = printf "<GetText file size=%d>" (fSize f)- -- | This structure describes data in Gettext's @.mo/.gmo@ file in ready-to-use format. data Catalog = Catalog { gmoSize :: Word32,@@ -64,25 +67,6 @@ instance Show Catalog where show gmo = printf "<GetText data size=%d>" (gmoSize gmo) --- | Prepare the data parsed from file for lookups.-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- -- | Load gettext file loadCatalog :: FilePath -> IO Catalog loadCatalog path = do@@ -90,7 +74,6 @@ let gmoFile = (runGet parseGmo content) {fData = content} return $ unpackGmoFile gmoFile - -- | Look up for string translation lookup :: B.ByteString -> Catalog -> Maybe [T.Text] lookup key gmo = Trie.lookup key (gmoData gmo)@@ -122,29 +105,50 @@ -- | Translate a string. -- Original message must be defined in @po@ file in @msgid@ line.-gettext :: Catalog -> B.ByteString -> T.Text+gettext :: Catalog+ -> B.ByteString -- ^ Original string+ -> T.Text gettext gmo key = case lookup key gmo of Nothing -> TLE.decodeUtf8 $ L.fromStrict key Just texts -> head texts +-- | Translate a string within specific context.+cgettext :: Catalog+ -> B.ByteString -- ^ Message context (@msgctxt@ line in @po@ file)+ -> B.ByteString -- ^ Original string+ -> T.Text+cgettext gmo context key = gettext gmo (context `B.append` "\4" `B.append` key)+ -- | Translate a string and select correct plural form. -- Original single form must be defined in @po@ file in @msgid@ line. -- Original plural form must be defined in @po@ file in @msgid_plural@ line. ngettext :: Catalog+ -> B.ByteString -- ^ Single form in original language+ -> B.ByteString -- ^ Plural form in original language -> Int -- ^ Number+ -> T.Text+ngettext gmo single plural n = ngettext' gmo (single `B.append` "\0" `B.append` plural) n++-- | Translate a string and select correct plural form, within specific context+-- Original single form must be defined in @po@ file in @msgid@ line.+-- Original plural form must be defined in @po@ file in @msgid_plural@ line.+cngettext :: Catalog+ -> B.ByteString -- ^ Message context (@msgctxt@ line in @po@ file) -> B.ByteString -- ^ Single form in original language -> B.ByteString -- ^ Plural form in original language+ -> Int -- ^ Number -> T.Text-ngettext gmo n single plural = ngettext' gmo n $ single `B.append` "\0" `B.append` plural+cngettext gmo context single plural n =+ ngettext' gmo (context `B.append` "\4" `B.append` single `B.append` "\0" `B.append` plural) n -- | Variant of @ngettext@ for case when for some reason there is only -- @msgid@ defined in @po@ file, and no @msgid_plural@, but there are some @msgstr[n]@. ngettext' :: Catalog- -> Int -- ^ Number -> B.ByteString -- ^ Single form in original language+ -> Int -- ^ Number -> T.Text-ngettext' gmo n key =+ngettext' gmo key n = case lookup key gmo of Nothing -> TLE.decodeUtf8 $ L.fromStrict key Just texts ->@@ -165,45 +169,22 @@ Nothing -> if n == 1 then 0 else 1 -- from GNU gettext implementation, known as 'germanic plural form' Just (_, expr) -> eval expr n --- | Data.Binary parser for GmoFile structure-parseGmo :: Get GmoFile-parseGmo = do- magic <- getWord32host- getWord32 <- case magic of- 0x950412de -> return getWord32le- 0xde120495 -> return getWord32be- _ -> fail "Invalid magic number"- - let getPair :: Get (Word32, Word32)- getPair = do- x <- getWord32- y <- getWord32- return (x,y)+-- | Prepare the data parsed from file for lookups.+unpackGmoFile :: GmoFile -> Catalog+unpackGmoFile (GmoFile {..}) = Catalog fSize choose trie+ where+ getOrig (len,offs) = L.take (fromIntegral len) $ L.drop (fromIntegral offs) fData - revision <- getWord32- size <- getWord32- origOffs <- getWord32- transOffs <- getWord32- hashSz <- getWord32- hashOffs <- getWord32- origs <- replicateM (fromIntegral size) getPair- trans <- replicateM (fromIntegral size) getPair- return $ GmoFile {- fMagic = magic,- fRevision = revision,- fSize = size,- fOriginalOffset = origOffs,- fTranslationOffset = transOffs,- fHashtableSize = hashSz,- fHashtableOffset = hashOffs,- fOriginals = origs,- fTranslations = trans,- fData = undefined }+ 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 -withGmoFile :: FilePath -> (GmoFile -> IO a) -> IO a-withGmoFile path go = do- content <- L.readFile path- let gmo = (runGet parseGmo content) {fData = content}- result <- go gmo- return result+ originals = map L.toStrict $ map getOrig fOriginals+ translations = map getTrans fTranslations++ trie = Trie.fromList $ zip originals translations
+ Data/Gettext/GmoFile.hs view
@@ -0,0 +1,75 @@+{-# LANGUAGE RecordWildCards, OverloadedStrings #-}++module Data.Gettext.GmoFile+ ( -- * Data structures+ GmoFile (..),+ -- * Parsing+ parseGmo+ ) where++import Control.Monad+import Data.Binary+import Data.Binary.Get+import qualified Data.ByteString.Lazy as L+import Text.Printf++-- | This structure describes the binary structure of Gettext @.mo/.gmo@ file.+data GmoFile = GmoFile {+ fMagic :: Word32 -- ^ Magic number (must be @0x950412de@ or @0xde120495@)+ , fRevision :: Word32 -- ^ File revision+ , fSize :: Word32 -- ^ Number of text pairs in the file+ , fOriginalOffset :: Word32 -- ^ Offset of original strings+ , fTranslationOffset :: Word32 -- ^ Offset of translations+ , fHashtableSize :: Word32 -- ^ Size of hash table+ , fHashtableOffset :: Word32 -- ^ Offset of hash table+ , fOriginals :: [(Word32, Word32)] -- ^ Original strings - sizes and offsets+ , fTranslations :: [(Word32, Word32)] -- ^ Translations - sizes and offsets+ , fData :: L.ByteString -- ^ All file data - used to access strings by offsets+ }+ deriving (Eq)++instance Show GmoFile where+ show f = printf "<GetText file size=%d>" (fSize f)++-- | Data.Binary parser for GmoFile structure+parseGmo :: Get GmoFile+parseGmo = do+ magic <- getWord32host+ getWord32 <- case magic of+ 0x950412de -> return getWord32le+ 0xde120495 -> return getWord32be+ _ -> fail "Invalid magic number"+ + let getPair :: Get (Word32, Word32)+ getPair = do+ x <- getWord32+ y <- getWord32+ return (x,y)++ revision <- getWord32+ size <- getWord32+ origOffs <- getWord32+ transOffs <- getWord32+ hashSz <- getWord32+ hashOffs <- getWord32+ origs <- replicateM (fromIntegral size) getPair+ trans <- replicateM (fromIntegral size) getPair+ return $ GmoFile {+ fMagic = magic,+ fRevision = revision,+ fSize = size,+ fOriginalOffset = origOffs,+ fTranslationOffset = transOffs,+ fHashtableSize = hashSz,+ fHashtableOffset = hashOffs,+ fOriginals = origs,+ fTranslations = trans,+ fData = undefined }++withGmoFile :: FilePath -> (GmoFile -> IO a) -> IO a+withGmoFile path go = do+ content <- L.readFile path+ let gmo = (runGet parseGmo content) {fData = content}+ result <- go gmo+ return result+
+ Data/Gettext/Parsers.hs view
@@ -0,0 +1,156 @@+{-# LANGUAGE OverloadedStrings #-}+-- | This module contains parsers for:+--+-- * Catalog headers (@Name: Value@ lines, that are specified as translation for empty string in @po@ file);+-- * Plural form selection expressions (specified in @Plural-Forms@ header).+--+-- These parsers are already used by main module; but they can be useful for other libraries working with+-- gettext's files.+--+module Data.Gettext.Parsers+ ( -- * Types+ Header, Headers,+ -- * Parsing functions+ parseHeaders,+ parsePlural,+ -- * Parsec parsers+ pHeaders,+ pExpr,+ pPlural+ ) where++import Control.Monad+import Control.Monad.Identity+import qualified Data.Text.Lazy as T+import Text.Parsec+import Text.Parsec.Text.Lazy+import Text.Parsec.Language+import qualified Text.Parsec.Token as Token+import Text.Parsec.Expr++import Data.Gettext.Plural++-- | Catalog header, i.e. one @Name: Value@ line in @po@ file+type Header = (T.Text, T.Text)+-- | List of catalog headers+type Headers = [Header]++pHeader :: Parser Header+pHeader = do+ name <- (many1 $ alphaNum <|> char '-') <?> "Header name"+ char ':'+ many $ oneOf " \t"+ value <- many $ noneOf "\r\n"+ return (T.pack name, T.pack value)++-- | Parsec parser for catalog headers+pHeaders :: Parser Headers+pHeaders = pHeader `sepEndBy` newline++-- | Parse catalog headers.+-- NB: for now this function does not use Parsec.+parseHeaders :: T.Text -> Either String Headers+parseHeaders t = do+ let lines = filter (not . T.null) $ T.splitOn "\n" t+ forM lines $ \line ->+ case T.splitOn ": " line of+ [name, value] -> return (name, value)+ (name:values) -> return (name, T.intercalate ": " values)+ _ -> Left $ "Invalid gettext file header: " ++ T.unpack line++pSimpleExpr :: Parser Expr+pSimpleExpr = buildExpressionParser table term <?> "simple expression"+ where+ term = parens pExpr <|> (symbol "n" >> return N) <|> (Literal `fmap` natural)++ table = + [ [prefix "-" Negate, prefix "!" Not],+ [binary "*" Multiply AssocLeft, binary "/" Divide AssocLeft, binary "%" Mod AssocLeft],+ [binary "+" Plus AssocLeft, binary "-" Minus AssocLeft],+ [binary "==" Equals AssocLeft, binary "!=" NotEquals AssocLeft,+ binary ">" Greater AssocLeft, binary "<=" NotGreater AssocLeft,+ binary "<" Less AssocLeft, binary ">=" NotLess AssocLeft],+ [binary "&&" And AssocLeft, binary "||" Or AssocLeft, binary "^" Xor AssocLeft]+ ]++ binary name fun assoc = Infix (do{ reservedOp name; return (Binary fun) }) assoc+ prefix name fun = Prefix (do{ reservedOp name; return fun })+ -- postfix name fun = Postfix (do{ reservedOp name; return fun })++-- | Parse plural form selection expression.+-- Note: this parses only part which goes after @plural=@.+pExpr :: Parser Expr+pExpr = do+ expr <- pSimpleExpr+ mbCont <- optionMaybe pTernary+ case mbCont of+ Nothing -> return expr+ Just (true, false) -> return $ If expr true false++pTernary :: Parser (Expr, Expr)+pTernary = do+ reservedOp "?"+ true <- pExpr+ colon+ false <- pExpr+ return (true, false)++-- | Parse plural form selection definition.+-- This parses the whole value of @Plural-Forms@ header,+-- starting from @nplurals=@.+pPlural :: Parser (Int, Expr)+pPlural = do+ symbol "nplurals"+ reservedOp "="+ n <- natural+ semi+ symbol "plural"+ reservedOp "="+ expr <- pExpr+ return (n, expr)++cStyle :: GenLanguageDef T.Text () Identity+cStyle = Token.LanguageDef+ { Token.commentStart = "/*"+ , Token.commentEnd = "*/"+ , Token.commentLine = "//"+ , Token.nestedComments = True+ , Token.identStart = letter+ , Token.identLetter = alphaNum <|> oneOf "_'"+ , Token.opStart = Token.opLetter cStyle+ , Token.opLetter = oneOf ":!#$%&*+./<=>?@\\^|-~"+ , Token.reservedNames = []+ , Token.reservedOpNames= []+ , Token.caseSensitive = True+ }++lexer :: Token.GenTokenParser T.Text () Identity+lexer = Token.makeTokenParser cStyle++natural :: Parser Int+natural = fromIntegral `fmap` Token.natural lexer++reservedOp :: String -> Parser ()+reservedOp = Token.reservedOp lexer++symbol :: String -> Parser String+symbol = Token.symbol lexer++parens :: Parser a -> Parser a+parens = Token.parens lexer++semi :: Parser String+semi = Token.semi lexer++colon :: Parser String+colon = Token.colon lexer++-- | Parse plural form selection definition.+-- Return value is (number of possible plural forms; selection expression).+parsePlural :: Headers -> Either String (Int, Expr)+parsePlural headers =+ case lookup (T.pack "Plural-Forms") headers of+ Nothing -> Left $ "Plural-Forms header not found: " ++ show headers+ Just str -> either (Left . show) Right $ parse pPlural "<plural form selection expression>" str++
+ Data/Gettext/Plural.hs view
@@ -0,0 +1,80 @@+-- | This module contains definitions for plural form selection expressions AST,+-- and an evaluator function for such expressions.+--+module Data.Gettext.Plural+ (+ -- * Data types+ BinOp (..), Expr (..),+ -- * Expressions+ eval+ ) where++import Data.Bits (xor)++-- | Supported binary operations+data BinOp =+ Equals+ | NotEquals+ | Greater+ | NotGreater+ | Less+ | NotLess+ | And+ | Or+ | Xor+ | Mod+ | Plus+ | Minus+ | Multiply+ | Divide+ deriving (Eq, Show)++-- | Plural form selection expression AST+data Expr =+ N -- ^ The @n@ variable+ | Literal Int -- ^ Literal number+ | If Expr Expr Expr -- ^ Ternary operator (... ? ... : ...)+ | Negate Expr -- ^ Unary arithmetic negation (as in @-1@).+ | Not Expr -- ^ Unary logic negation (as in @! (n == 1)@)+ | Binary BinOp Expr Expr -- ^ Binary operation+ deriving (Eq, Show)++order :: (Int -> Int -> Bool) -> (Int -> Int -> Int)+order op x y = if op x y then 1 else 0++logic :: (Bool -> Bool -> Bool) -> (Int -> Int -> Int)+logic op x y = if op (x /= 0) (y /= 0) then 1 else 0++evalOp :: BinOp -> (Int -> Int -> Int)+evalOp Equals = order (==)+evalOp NotEquals = order (/=)+evalOp Greater = order (>)+evalOp NotGreater = order (<=)+evalOp Less = order (<)+evalOp NotLess = order (>=)+evalOp And = logic (&&)+evalOp Or = logic (||)+evalOp Xor = logic xor+evalOp Mod = mod+evalOp Plus = (+)+evalOp Minus = (-)+evalOp Multiply = (*)+evalOp Divide = \x y ->+ if y == 0+ then error "Division by zero in plural form selection expression"+ else x `div` y++-- | Evaluate the expression+eval :: Expr -- ^ Expression+ -> Int -- ^ Number+ -> Int -- ^ Plural form index defined by expression+eval N n = n+eval (Literal x) _ = x+eval (If cond true false) n =+ if eval cond n /= 0+ then eval true n+ else eval false n+eval (Binary op x y) n =+ evalOp op (eval x n) (eval y n)+eval (Negate x) n = negate $ eval x n+
examples/gmotest.hs view
@@ -15,7 +15,7 @@ [file, ns] <- getArgs let n = read ns catalog <- loadCatalog file- let localizedTemplate = ngettext catalog n "There is %d file" "There are %d files"+ let localizedTemplate = ngettext catalog "There is %d file" "There are %d files" n TLIO.putStrLn localizedTemplate printf (T.unpack localizedTemplate) n
haskell-gettext.cabal view
@@ -1,5 +1,5 @@ name: haskell-gettext-version: 0.1.0.0+version: 0.1.1.0 synopsis: GetText runtime library implementation in pure Haskell description: This package is pure Haskell implementation of GetText library runtime. It allows you to:@@ -41,6 +41,9 @@ library exposed-modules: Data.Gettext+ Data.Gettext.GmoFile+ Data.Gettext.Parsers+ Data.Gettext.Plural build-depends: base > 4 && < 5, binary >=0.7, bytestring >=0.10,@@ -51,11 +54,12 @@ mtl >= 2.2.1, transformers >=0.3, parsec >= 3.1.11+ ghc-options: -fwarn-unused-imports executable hgettext main-is: hgettext.hs build-depends: base > 4 && < 5,- haskell-src-exts >= 1.19.1,+ haskell-src-exts >= 1.18, uniplate >= 1.6.12, time >= 1.5.0, old-locale >= 1.0,