haskell-gettext (empty) → 0.1.0.0
raw patch · 8 files changed
+488/−0 lines, 8 filesdep +basedep +binarydep +bytestringsetup-changed
Dependencies added: base, binary, bytestring, bytestring-trie, containers, filepath, haskell-src-exts, mtl, old-locale, parsec, text, time, transformers, uniplate
Files
- Data/Gettext.hs +209/−0
- LICENSE +30/−0
- README.md +25/−0
- Setup.hs +2/−0
- examples/gmodump.hs +22/−0
- examples/gmotest.hs +21/−0
- haskell-gettext.cabal +67/−0
- hgettext.hs +112/−0
+ Data/Gettext.hs view
@@ -0,0 +1,209 @@+{-# LANGUAGE RecordWildCards, OverloadedStrings #-}++module Data.Gettext+ ( -- * Data structures+ GmoFile (..),+ Catalog,+ -- * Loading and using translations+ loadCatalog,+ lookup,+ gettext, ngettext, ngettext',+ assocs,+ -- * Utilities for plural forms+ getHeaders,+ getPluralDefinition,+ choosePluralForm,+ -- * Utilities for custom parsers implementation+ parseGmo,+ unpackGmoFile+ ) 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.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,+ gmoChoosePlural :: Int -> Int,+ gmoData :: Trie.Trie [T.Text] }++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+ content <- L.readFile path+ 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)++-- | Get all translation pairs+assocs :: Catalog -> [(B.ByteString, [T.Text])]+assocs = Trie.toList . gmoData++-- | Obtain headers of the catalog.+-- Headers are defined as a translation for empty string.+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)++-- | Get plural forms selection definition.+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++-- | Translate a string.+-- Original message must be defined in @po@ file in @msgid@ line.+gettext :: Catalog -> B.ByteString -> T.Text+gettext gmo key =+ case lookup key gmo of+ Nothing -> TLE.decodeUtf8 $ L.fromStrict key+ Just texts -> head texts++-- | 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+ -> Int -- ^ Number+ -> B.ByteString -- ^ Single form in original language+ -> B.ByteString -- ^ Plural form in original language+ -> T.Text+ngettext gmo n single plural = ngettext' gmo n $ single `B.append` "\0" `B.append` plural++-- | 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+ -> T.Text+ngettext' gmo n key =+ 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 -- if there are not enough plural forms defined, always use the first,+ -- it is probably the most correct+ else plural+ in texts !! idx++-- | Choose plural form index by number+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 -- 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)++ 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+
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2013, IlyaPortnov++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of IlyaPortnov nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,25 @@+haskell-gettext README+======================++This package is pure Haskell implementation of GetText library runtime.+It allows you to:++* Load GNU Gettext binary catalog files (`.mo`, `.gmo`).+* Execute lookups for messages in catalog (gettext and ngettext functions).++Support for plural form selection expressions is fully implemented.++This package is however relatively low-level and may be not very nice to+use in applications. So it can be used as a backend for some more user-friendly+"translation framework".++This package has the following advantages comparing to hgettext:++* It is easier to build it on different platforms, since it has no dependency on + C code;+* It does not depend on additional C libraries in runtime;+* And probably the most important: this library does not use global process-level+ variables to store "current catalog" (current locale), the catalog should be+ specified for each call of translation function. So it can be much simpler to+ use this library for example in web applications.+
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ examples/gmodump.hs view
@@ -0,0 +1,22 @@++import Data.Gettext++import Control.Monad+import qualified Data.Trie as T+import qualified Data.ByteString.Char8 as B8+import qualified Data.ByteString.Lazy.Char8 as L8+import qualified Data.Text.Lazy.IO as TLIO+import System.Environment++main = do+ [file] <- getArgs+ catalog <- loadCatalog file+ case getPluralDefinition catalog of+ Nothing -> putStrLn "No plural forms selection expression provided."+ Just (_,expr) -> putStrLn $ "Plural forms selection: " ++ show expr+ forM_ (assocs catalog) $ \(orig,trans) -> do+ putStr "Original: "+ B8.putStrLn orig+ forM_ (zip [0..] trans) $ \(i,tran) -> do+ putStr $ "Translation #" ++ show i ++ ": "+ TLIO.putStrLn tran
+ examples/gmotest.hs view
@@ -0,0 +1,21 @@+{-# LANGUAGE OverloadedStrings #-}++import Control.Monad+import System.FilePath+import qualified Data.Text.Lazy as T+import qualified Data.Text.Lazy.IO as TLIO+import System.IO+import System.Environment+import Text.Printf++import Data.Gettext++main :: IO ()+main = do+ [file, ns] <- getArgs+ let n = read ns+ catalog <- loadCatalog file+ let localizedTemplate = ngettext catalog n "There is %d file" "There are %d files"+ TLIO.putStrLn localizedTemplate+ printf (T.unpack localizedTemplate) n+
+ haskell-gettext.cabal view
@@ -0,0 +1,67 @@+name: haskell-gettext+version: 0.1.0.0+synopsis: GetText runtime library implementation in pure Haskell+description: This package is pure Haskell implementation of GetText library runtime.+ It allows you to:+ .+ * Load GNU Gettext binary catalog files (`.mo`, `.gmo`).+ .+ * Execute lookups for messages in catalog (gettext and ngettext functions).+ .+ Support for plural form selection expressions is fully implemented.+ .+ This package is however relatively low-level and may be not very nice to+ use in applications. So it can be used as a backend for some more user-friendly+ \"translation framework\".+ .+ This package has the following advantages comparing to hgettext:+ .+ * It is easier to build it on different platforms, since it has no dependency on + C code;+ .+ * It does not depend on additional C libraries in runtime;+ .+ * And probably the most important: this library does not use global process-level+ variables to store "current catalog" (current locale), the catalog should be+ specified for each call of translation function. So it can be much simpler to+ use this library for example in web applications.+ +license: BSD3+license-file: LICENSE+author: IlyaPortnov+maintainer: portnov84@rambler.ru+-- copyright: +category: Text+build-type: Simple+cabal-version: >=1.8++extra-source-files: README.md+ examples/gmodump.hs+ examples/gmotest.hs++library+ exposed-modules: Data.Gettext+ build-depends: base > 4 && < 5,+ binary >=0.7,+ bytestring >=0.10,+ text >= 1.2,+ bytestring-trie >=0.2,+ containers >=0.5,+ time >=1.4,+ mtl >= 2.2.1,+ transformers >=0.3,+ parsec >= 3.1.11++executable hgettext+ main-is: hgettext.hs+ build-depends: base > 4 && < 5,+ haskell-src-exts >= 1.19.1,+ uniplate >= 1.6.12,+ time >= 1.5.0,+ old-locale >= 1.0,+ filepath >= 1.4++source-repository head+ type: git+ location: https://github.com/portnov/haskell-gettext.git+
+ hgettext.hs view
@@ -0,0 +1,112 @@+-- (C) vasylp https://github.com/vasylp/hgettext/blob/master/src/hgettext.hs++import qualified Language.Haskell.Exts as H ++import System.Environment+import System.Console.GetOpt+import Data.Time+import System.Locale hiding (defaultTimeLocale)++import Data.Generics.Uniplate.Data++-- import Distribution.Simple.PreProcess.Unlit++import Data.List+import Data.Char+import Data.Ord+import Data.Function (on)+import System.FilePath++import Data.Version (showVersion)+version = undefined+-- import Paths_haskell_gettext (version)++data Options = Options {+ outputFile :: String,+ keywords :: [String],+ printVersion :: Bool+ } deriving Show++options :: [OptDescr (Options->Options)]+options = + [+ Option ['o'] ["output"] + (ReqArg (\o opts -> opts {outputFile = o}) "FILE") + "write output to specified file",+ Option ['d'] ["default-domain"] + (ReqArg (\d opts -> opts {outputFile = d ++ ".po"}) "NAME")+ "use NAME.po instead of messages.po",+ Option ['k'] ["keyword"] + (ReqArg (\d opts -> opts {keywords = d: keywords opts}) "WORD")+ "function names, in which searched words are wrapped. Can be used multiple times, for multiple funcitons",+ Option [] ["version"]+ (NoArg (\opts -> opts {printVersion = True}))+ "print version of hgettexts"+ ]+++defaultOptions = Options "messages.po" ["__", "lprintf"] False++parseArgs :: [String] -> IO (Options, [String])+parseArgs args = + case getOpt Permute options args of+ (o, n, []) -> return (foldl (flip id) defaultOptions o, n)+ (_, _, errs) -> ioError (userError (concat errs ++ usageInfo header options))+ where header = "Usage: hgettext [OPTION] [INPUTFILE] ..."+++toTranslate :: [String] -> H.ParseResult (H.Module H.SrcSpanInfo) -> [(H.SrcSpanInfo, String)]+toTranslate f (H.ParseOk z) = nub [ (loc, s) | H.App _ (H.Var _ (H.UnQual _ (H.Ident _ x))) (H.Lit _ (H.String loc s _)) <- universeBi z, x `elem` f]+toTranslate _ _ = []++-- Create list of messages from a single file+formatMessages :: String -> [(H.SrcSpanInfo, String)] -> String+formatMessages path l = concat $ map potEntry $ nubBy ((==) `on` snd) $ sortBy (comparing snd) l+ where potEntry (l, s) = unlines [+ "#: " ++ showSrc l,+ "msgid " ++ (show s),+ "msgstr \"\"",+ ""+ ]+ showSrc l = path ++ ":" ++ show (H.srcSpanStartLine (H.srcInfoSpan l)) ++ ":" ++ show (H.srcSpanStartColumn (H.srcInfoSpan l))+++formatPotFile :: [String] -> IO String+formatPotFile lines = do+ time <- getZonedTime+ let timeStr = formatTime defaultTimeLocale "%F %R%z" time+ let header = formatPotHeader timeStr+ return $ concat $ header: lines+ where+ formatPotHeader timeStr =+ unlines ["# Translation file",+ "",+ "msgid \"\"",+ "msgstr \"\"",+ "",+ "\"Project-Id-Version: PACKAGE VERSION\\n\"",+ "\"Report-Msgid-Bugs-To: \\n\"",+ "\"POT-Creation-Date: " ++ timeStr ++ "\\n\"",+ "\"PO-Revision-Date: YEAR-MO-DA HO:MI+ZONE\\n\"",+ "\"Last-Translator: FULL NAME <EMAIL@ADDRESS>\\n\"",+ "\"Language-Team: LANGUAGE <LL@li.org>\\n\"",+ "\"MIME-Version: 1.0\\n\"",+ "\"Content-Type: text/plain; charset=UTF-8\\n\"",+ "\"Content-Transfer-Encoding: 8bit\\n\"",+ ""]++process :: Options -> [String] -> IO ()+process Options{printVersion = True} _ = + putStrLn $ "hgettext, version " ++ (showVersion version)++process opts fl = do+ t <- mapM read' fl+ pot <- formatPotFile $ map (\(n,c) -> formatMessages n $ toTranslate (keywords opts) c) t+ writeFile (outputFile opts) pot+ where read' "-" = getContents >>= \c -> return ("-", H.parseFileContents c)+ read' f = H.parseFile f >>= \m -> return (f, m)++main = + getArgs >>= parseArgs >>= uncurry process++