hgettext (empty) → 0.1.2

raw patch · 4 files changed

+173/−0 lines, 4 filesdep +basedep +haskell-srcdep +uniplatesetup-changed

Dependencies added: base, haskell-src, uniplate

Files

• Setup.hs +3/−0
• hgettext.cabal +26/−0
• src/Text/I18N/GetText.hs +60/−0
• src/hgettext.hs +84/−0

@@ -0,0 +1,3 @@++import Distribution.Simple+main = defaultMain

@@ -0,0 +1,26 @@+Name:                   hgettext+Version:                0.1.2+Cabal-Version:          >= 1.6++License:                BSD3++Author:                 Vasyl Pasternak+Maintainer:             vasyl.pasternak@gmail.com+Copyright:              2009 Vasyl Pasternak+Category:               Text++Synopsis:               Bindings to libintl.h (gettext, bindtextdomain)+Build-Type:             Simple++Library+        Exposed-Modules:        Text.I18N.GetText+        Extensions:             ForeignFunctionInterface+        Hs-Source-Dirs:         src+        Build-Depends:          base++Executable hgettext+        Main-Is:                hgettext.hs+        Extensions:             TemplateHaskell+        Hs-Source-Dirs:         src        +        Build-Depends:          base>=3.0.3.0, uniplate, haskell-src+

@@ -0,0 +1,60 @@+-- | This library provides basic internationalization capabilities++module Text.I18N.GetText (+                          getText,+                          bindTextDomain,+                          textDomain+                         ) where++import Foreign.C.Types+import Foreign.C.String+import Foreign.Ptr+import Data.Maybe (fromMaybe)++foreign import ccall unsafe "libintl.h gettext" c_gettext :: CString -> IO CString+foreign import ccall unsafe "libintl.h bindtextdomain" c_bindtextdomain :: +    CString -> CString -> IO CString+foreign import ccall unsafe "libintl.h textdomain" c_textdomain :: CString -> IO CString++fromCString :: CString -> IO (Maybe String)+fromCString x | x == nullPtr = return Nothing+              | otherwise = peekCString x >>= return . Just++fromCStringDefault :: String -> CString -> IO String+fromCStringDefault d x = fromCString x >>= \r -> return (fromMaybe d r)++-- |getText wraps GNU gettext function. It returns translated string for the+-- input messages. If translated string not found the input string will be+-- returned.+--+-- The most common usage of this function is to declare function __:+-- +-- > __ = unsafePerformIO . getText+--+-- and wrap all text strings into this function, e.g.+-- +-- > printHello = putStrLn (__ "Hello")+-- +getText :: String -> IO String+getText s = +    withCString s $ \s' -> +        c_gettext s' >>= fromCStringDefault s++-- |bindTextDomain sets the base directory of the hierarchy+-- containing message catalogs for a given message domain.+--+bindTextDomain :: String        -- ^ domain name+               -> String        -- ^ path to the locale folder+               -> IO (Maybe String) -- ^ return value+bindTextDomain domainname dirname = +  withCString domainname $ \domain -> +      withCString dirname $ \dir ->+          c_bindtextdomain domain dir >>= fromCString+++-- |textDomain sets domain for future 'getText' call+textDomain :: String            -- ^ domain name+           -> IO (Maybe String) -- ^ return value+textDomain domainname = +    withCString domainname $ \domain ->+        c_textdomain domain >>= fromCString

@@ -0,0 +1,84 @@++import Language.Haskell.Parser+import Language.Haskell.Syntax++import System.Environment+import System.Console.GetOpt++import Data.Generics.PlateData++import Data.List++data Options = Options {+      outputFile :: String,+      keyword :: String+    } 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 {keyword = d}) "WORD")+            "function name, in which wrapped searched words"+    ]+++defaultOptions = Options "messages.po" "__"++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 -> ParseResult HsModule -> [(Int, String)]+toTranslate f (ParseOk z) = nub [ (0, s) | HsApp (HsVar (UnQual (HsIdent x))) (HsLit (HsString s)) <- universeBi z, x == f]+toTranslate _ _ = []++-- Create list of messages from a single file+formatMessages :: String -> [(Int, String)] -> String+formatMessages src l = concat $ map potEntry l+    where potEntry (l, s) = unlines [+                             "#: " ++ src ++ ":" ++ (show l),+                             "msgid \"" ++ s ++ "\"",+                             "msgstr \"\"",+                             ""+                            ]+++writePOTFile :: [String] -> String+writePOTFile l = concat $ [potHeader] ++ l+    where potHeader = unlines ["# Translation file",+                               "",+                               "msgid \"\"",+                               "msgstr \"\"",+                               "",+                               "\"Project-Id-Version: PACKAGE VERSION\\n\"",+                               "\"Report-Msgid-Bugs-To: \\n\"",+                               "\"POT-Creation-Date: 2009-01-13 06:05-0800\\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 opts fl = do+  t <- mapM read' fl+  writeFile (outputFile opts) $ writePOTFile $ map (\(n,c) -> formatMessages n $ toTranslate (keyword opts) $ parseModule c) t+    where read' "-" = getContents >>= \s -> return ("-", s)+          read' s = readFile s >>= \c -> return (s, c)++main = +    getArgs >>= parseArgs >>= uncurry process+