hgettext 0.1.30 → 0.1.31.0
raw patch · 7 files changed
+321/−212 lines, 7 filesdep +deepseqdep +hgettextdep ~Cabaldep ~basedep ~containersnew-uploaderPVP ok
version bump matches the API change (PVP)
Dependencies added: deepseq, hgettext
Dependency ranges changed: Cabal, base, containers, directory, filepath, haskell-src-exts, process, setlocale, uniplate
API changes (from Hackage documentation)
Files
- LICENSE +30/−0
- hgettext.cabal +61/−25
- src-exe/hgettext.hs +118/−0
- src/Distribution/Simple/I18N/GetText.hs +63/−53
- src/Internal.hs +12/−0
- src/Text/I18N/GetText.hs +37/−37
- src/hgettext.hs +0/−97
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2009, Vasyl Pasternak++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 Vasyl Pasternak 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.
hgettext.cabal view
@@ -1,31 +1,67 @@-Name: hgettext-Version: 0.1.30-Cabal-Version: >= 1.6+cabal-version: 1.14+name: hgettext+version: 0.1.31.0+build-type: Simple -License: BSD3+license: BSD3+license-file: LICENSE -Author: Vasyl Pasternak-Maintainer: vasyl.pasternak@gmail.com-Copyright: 2009 Vasyl Pasternak-Category: Text-Homepage: https://github.com/vasylp/hgettext+author: Vasyl Pasternak+maintainer: Herbert Valerio Riedel+copyright: 2009 Vasyl Pasternak+category: Text+bug-reports: https://github.com/hvr/hgettext/issues+synopsis: Bindings to libintl.h (gettext, bindtextdomain)+description: This package provides bindings to the @gettext@ internationalization and localization (i18n) library.+ .+ This package provides support for custom @Setup.hs@ scripts via the "Distribution.Simple.I18N.GetText" module.+ .+ A user-contributed tutorial can be found in the [Haskell Wiki](https://wiki.haskell.org/Internationalization_of_Haskell_programs_using_gettext). -Synopsis: Bindings to libintl.h (gettext, bindtextdomain)-Build-Type: Simple+tested-with: GHC==8.2.2, GHC==8.0.2, GHC==7.10.3, GHC==7.8.4, GHC==7.6.3, GHC==7.4.2 -Library- Exposed-Modules: Text.I18N.GetText,- Distribution.Simple.I18N.GetText- Extensions: ForeignFunctionInterface- Hs-Source-Dirs: src- Build-Depends: base>=3.0.3.0 && <5, process,- directory, filepath,- containers, Cabal>=1.10, setlocale+source-repository head+ type: git+ location: https://github.com/hvr/hgettext.git -Executable hgettext- Main-Is: hgettext.hs- Extensions: TemplateHaskell- Hs-Source-Dirs: src - Build-Depends: base>=3.0.3.0 && <5, uniplate, haskell-src-exts- Other-Modules: Paths_hgettext+library+ default-language: Haskell2010+ exposed-modules: Text.I18N.GetText,+ Distribution.Simple.I18N.GetText+ other-modules: Internal + hs-source-dirs: src+ build-depends: base >=4.5 && <4.11+ , Cabal >=1.14 && <1.25 || == 2.0.*+ , containers >=0.4.2 && <0.6+ , directory >=1.1 && <1.4+ , filepath >=1.3 && <1.5+ , process >=1.1 && <1.7+ , setlocale >=0.0.3 && <1.1++ ghc-options: -Wall++ -- temporary hack: https://github.com/haskell-hvr/hgettext/pull/3+ if os(windows)+ extra-libraries: libintl++executable hgettext+ default-language: Haskell2010++ main-is: hgettext.hs+ other-modules: Paths_hgettext++ hs-source-dirs: src-exe++ -- constraints inherited from lib:hgettext+ build-depends: hgettext+ , base+ , Cabal+ , containers+ , filepath++ build-depends: deepseq >=1.1 && <1.5+ , haskell-src-exts >=1.18 && <1.21+ , uniplate >=1.6.12 && <1.7++ ghc-options: -Wall
+ src-exe/hgettext.hs view
@@ -0,0 +1,118 @@+module Main (main) where++import Control.DeepSeq+import Control.Exception+import Control.Monad+import Data.Generics.Uniplate.Data+import qualified Data.Map as Map+import qualified Data.Set as Set+import Data.Version (showVersion)+import qualified Language.Haskell.Exts as H+import System.Console.GetOpt+import System.Environment+import System.Exit++import Paths_hgettext (version)++data Options = Options+ { outputFile :: FilePath+ , keyword :: 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 {keyword = d}) "WORD")+ "function name, in which wrapped searched words"+ , Option [] ["version"]+ (NoArg (\opts -> opts {printVersion = True}))+ "print version of hgettexts"+ ]++defaultOptions :: Options+defaultOptions = Options "messages.po" "__" 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.Module H.SrcSpanInfo -> [(Int, String)]+toTranslate f z = [ (H.srcSpanStartLine (H.srcInfoSpan loc), s)+ | H.App _ (H.Var _+ (H.UnQual _+ (H.Ident _ x)))+ (H.Lit _+ (H.String loc s _slit))+ <- universeBi z :: [H.Exp H.SrcSpanInfo]+ , x == f]++formatMessage :: String -> [(FilePath, Int)] -> String+formatMessage s locs = unlines $+ map (uncurry formatLoc) locs +++ [ "msgid " ++ (show s)+ , "msgstr \"\""+ , ""+ ]+ where+ formatLoc src l = "#: " ++ src ++ ":" ++ (show l)+++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 -> [FilePath] -> IO ()+process Options{printVersion = True} _ =+ putStrLn $ "hgettext, version " ++ (showVersion version)+process opts fl = do+ dat <- forM fl $ \fn -> do+ m <- readSource fn+ evaluate $ force [ (s,(fn,loc)) | (loc,s) <- toTranslate (keyword opts) m ]++ let entries = Map.fromListWith Set.union [ (s,Set.singleton (fn,loc)) | d <- dat, (s,(fn,loc)) <- d ]++ writeFile (outputFile opts) $ do+ writePOTFile [ formatMessage s (Set.toList locs) | (s,locs) <- Map.toList entries ]+ where+ readSource "-" = do+ c <- getContents+ case H.parseFileContents c of+ H.ParseFailed loc msg -> do+ putStrLn (concat [ "<stdin>:", show (H.srcLine loc), ":", show (H.srcColumn loc), ": error: ", msg ])+ exitFailure+ H.ParseOk m -> return m+ readSource f = do+ pm <- H.parseFile f+ case pm of+ H.ParseFailed loc msg -> do+ putStrLn (concat [ f, ":", show (H.srcLine loc), ":", show (H.srcColumn loc), ": error: ", msg ])+ exitFailure+ H.ParseOk m -> return m++main :: IO ()+main = getArgs >>= parseArgs >>= uncurry process
src/Distribution/Simple/I18N/GetText.hs view
@@ -24,13 +24,13 @@ -- -- The module defines following @.cabal@ fields: ----- [@x-gettext-domain-name@] Name of the domain. One ofmore+-- [@x-gettext-domain-name@] Name of the domain. One or more -- alphanumeric characters separated by hyphens or underlines. When -- not set, package name will be used. -- -- [@x-gettext-po-files@] List of files with translations. Could be--- used a limited form of wildcards, e.g.: @x-gettext-po-files:--- po/*.po@+-- used a limited form of wildcards, e.g.:+-- @x-gettext-po-files: po/*.po@ -- -- [@x-gettext-domain-def@] Name of the macro, in which domain name -- will be passed to the program. Default value is@@ -46,7 +46,7 @@ -- -- > ... -- > prepareI18N = do--- > setLocale LC_ALL (Just "") +-- > setLocale LC_ALL (Just "") -- > bindTextDomain __MESSAGE_CATALOG_DOMAIN__ (Just __MESSAGE_CATALOG_DIR__) -- > textDomain __MESSAGE_CATALOG_DOMAIN__ -- >@@ -57,66 +57,73 @@ -- > ... -- ----- /NOTE:/ files, passed in the @x-gettext-po-files@ are not+-- __NOTE:__ files, passed in the @x-gettext-po-files@ are not -- automatically added to the source distribution, so they should be -- also added to the @extra-source-files@ parameter, along with -- translation template file (usually @message.pot@) ----- /WARNING:/ sometimes, when only configuration targets changes, code+-- __WARNING:__ sometimes, when only configuration targets changes, code -- will not recompile, thus you should execute @cabal clean@ to -- cleanup the build and restart it again from the configuration. This -- is temporary bug, it will be fixed in next releases.--- +-- -module Distribution.Simple.I18N.GetText - (- installGetTextHooks,- gettextDefaultMain+module Distribution.Simple.I18N.GetText+ ( installGetTextHooks+ , gettextDefaultMain ) where -import Distribution.Simple-import Distribution.Simple.Setup as S-import Distribution.Simple.LocalBuildInfo-import Distribution.PackageDescription-import Distribution.Simple.Configure-import Distribution.Simple.InstallDirs as I-import Distribution.Simple.Utils+import Distribution.PackageDescription+import Distribution.Simple+import Distribution.Simple.InstallDirs as I+import Distribution.Simple.LocalBuildInfo+import Distribution.Simple.Setup+import Distribution.Simple.Utils+import Distribution.Verbosity -import Language.Haskell.Extension+import Control.Arrow (second)+import Control.Monad+import Data.List (nub, unfoldr)+import Data.Maybe (fromMaybe, listToMaybe)+import System.Directory+import System.Exit+import System.FilePath+import System.Process -import Control.Monad-import Control.Arrow (second)-import Data.Maybe (listToMaybe, maybeToList, fromMaybe)-import Data.List (unfoldr,nub,null)-import System.FilePath-import System.Directory-import System.Process+import Internal -- | Default main function, same as--- +-- -- > defaultMainWithHooks $ installGetTextHooks simpleUserHooks--- +-- gettextDefaultMain :: IO () gettextDefaultMain = defaultMainWithHooks $ installGetTextHooks simpleUserHooks -- | Installs hooks, used by GetText module to install--- PO files to the system. Previous won't be disabled+-- PO files to the system. --+-- Pre-existing hook handlers are executed before the GetText+-- handlers.+-- installGetTextHooks :: UserHooks -- ^ initial user hooks -> UserHooks -- ^ patched user hooks-installGetTextHooks uh = uh{- confHook = \a b -> - (confHook uh) a b >>= - return . updateLocalBuildInfo,+installGetTextHooks uh =+ uh { confHook = \a b -> do+ lbi <- (confHook uh) a b+ return (updateLocalBuildInfo lbi) - postInst = \a b c d -> - (postInst uh) a b c d >> - installPOFiles a b c d- }+ , postInst = \args iflags pd lbi -> do+ postInst uh args iflags pd lbi+ installPOFiles (fromFlagOrDefault maxBound (installVerbosity iflags)) lbi + , postCopy = \args cflags pd lbi -> do+ postCopy uh args cflags pd lbi+ installPOFiles (fromFlagOrDefault maxBound (copyVerbosity cflags)) lbi+ } + updateLocalBuildInfo :: LocalBuildInfo -> LocalBuildInfo-updateLocalBuildInfo l = +updateLocalBuildInfo l = let sMap = getCustomFields l [domDef, catDef] = map ($ sMap) [getDomainDefine, getMsgCatalogDefine] dom = getDomainNameDefault sMap (getPackageName l)@@ -124,8 +131,8 @@ [catMS, domMS] = map (uncurry formatMacro) [(domDef, dom), (catDef, tar)] in (appendCPPOptions [domMS,catMS] . appendExtension [EnableExtension CPP]) l -installPOFiles :: Args -> InstallFlags -> PackageDescription -> LocalBuildInfo -> IO ()-installPOFiles _ _ _ l = +installPOFiles :: Verbosity -> LocalBuildInfo -> IO ()+installPOFiles verb l = let sMap = getCustomFields l destDir = targetDataDir l dom = getDomainNameDefault sMap (getPackageName l)@@ -135,43 +142,48 @@ let targetDir = destDir </> bname </> "LC_MESSAGES" -- ensure we have directory destDir/{loc}/LC_MESSAGES createDirectoryIfMissing True targetDir- system $ "msgfmt --output-file=" ++ - (targetDir </> dom <.> "mo") ++ - " " ++ file+ ph <- runProcess "msgfmt" [ "--output-file=" ++ (targetDir </> dom <.> "mo"), file ]+ Nothing Nothing Nothing Nothing Nothing+ ec <- waitForProcess ph+ case ec of+ ExitSuccess -> return ()+ -- only warn for now, as the package may still be usable even if the msg catalogs are missing+ ExitFailure n -> warn verb ("'msgfmt' exited with non-zero status (rc = " ++ show n ++ ")") in do filelist <- getPoFilesDefault sMap -- copy all whose name is in the form of dir/{loc}.po to the -- destDir/{loc}/LC_MESSAGES/dom.mo -- with the 'msgfmt' tool- mapM_ installFile filelist + mapM_ installFile filelist forBuildInfo :: LocalBuildInfo -> (BuildInfo -> BuildInfo) -> LocalBuildInfo-forBuildInfo l f = +forBuildInfo l f = let a = l{localPkgDescr = updPkgDescr (localPkgDescr l)}- updPkgDescr x = x{library = updLibrary (library x), + updPkgDescr x = x{library = updLibrary (library x), executables = updExecs (executables x)}- updLibrary Nothing = Nothing+ updLibrary Nothing = Nothing updLibrary (Just x) = Just $ x{libBuildInfo = f (libBuildInfo x)} updExecs x = map updExec x updExec x = x{buildInfo = f (buildInfo x)} in a appendExtension :: [Extension] -> LocalBuildInfo -> LocalBuildInfo-appendExtension exts l = +appendExtension exts l = forBuildInfo l updBuildInfo where updBuildInfo x = x{defaultExtensions = updExts (defaultExtensions x)} updExts s = nub (s ++ exts) appendCPPOptions :: [String] -> LocalBuildInfo -> LocalBuildInfo-appendCPPOptions opts l = +appendCPPOptions opts l = forBuildInfo l updBuildInfo where updBuildInfo x = x{cppOptions = updOpts (cppOptions x)} updOpts s = nub (s ++ opts) +formatMacro :: Show a => [Char] -> a -> [Char] formatMacro name value = "-D" ++ name ++ "=" ++ (show value) targetDataDir :: LocalBuildInfo -> FilePath-targetDataDir l = +targetDataDir l = let dirTmpls = installDirTemplates l prefix' = prefix dirTmpls data' = datadir dirTmpls@@ -180,7 +192,6 @@ getPackageName :: LocalBuildInfo -> String getPackageName = fromPackageName . packageName . localPkgDescr- where fromPackageName (PackageName s) = s getCustomFields :: LocalBuildInfo -> [(String, String)] getCustomFields = customFieldsPD . localPkgDescr@@ -200,8 +211,7 @@ getPoFilesDefault :: [(String, String)] -> IO [String] getPoFilesDefault al = toFileList $ findInParametersDefault al "x-gettext-po-files" "" where toFileList "" = return []- toFileList x = liftM concat $ mapM matchFileGlob $ split' x+ toFileList x = liftM concat $ mapM matchFileGlob $ split' x -- from Blow your mind (HaskellWiki) -- splits string by newline, space and comma split' x = concatMap lines $ concatMap words $ unfoldr (\b -> fmap (const . (second $ drop 1) . break (==',') $ b) . listToMaybe $ b) x-
+ src/Internal.hs view
@@ -0,0 +1,12 @@+{-# LANGUAGE CPP #-}++module Internal where++import Distribution.Simple++fromPackageName :: PackageName -> String+#if MIN_VERSION_Cabal(2,0,0)+fromPackageName = unPackageName+#else+fromPackageName (PackageName s) = s+#endif
src/Text/I18N/GetText.hs view
@@ -11,12 +11,12 @@ textDomain ) where -import Foreign.C.Types-import Foreign.C.String-import Foreign.C.Error-import Foreign.Ptr-import Data.Maybe (fromMaybe)-import System.Locale.SetLocale+import Data.Maybe (fromMaybe)+import Foreign.C.Error+import Foreign.C.String+import Foreign.C.Types+import Foreign.Ptr+import System.Locale.SetLocale foreign import ccall unsafe "libintl.h gettext" c_gettext@@ -25,7 +25,7 @@ foreign import ccall unsafe "libintl.h dgettext" c_dgettext :: CString -> CString -> IO CString -foreign import ccall unsafe "libintl.h dcgettext" c_dcgettext +foreign import ccall unsafe "libintl.h dcgettext" c_dcgettext :: CString -> CString -> CInt -> IO CString foreign import ccall unsafe "libintl.h ngettext" c_ngettext@@ -58,55 +58,55 @@ fromCStringPluralDefault def def_plural n s | n == 1 = fromCStringDefault def s | otherwise = fromCStringDefault def_plural s- + withCStringMaybe :: Maybe String -> (CString -> IO a) -> IO a-withCStringMaybe Nothing f = f nullPtr+withCStringMaybe Nothing f = f nullPtr withCStringMaybe (Just str) f = withCString str f --- |getText wraps GNU gettext function. It returns translated string for the+-- | '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 __:--- +-- 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' -> +getText s =+ withCString s $ \s' -> c_gettext s' >>= fromCStringDefault s --- |dGetText wraps GNU dgettext function. It works similar to 'getText'+-- | 'dGetText' wraps GNU dgettext function. It works similar to 'getText' -- but also could take domain name. -- dGetText :: Maybe String -- ^ domain name, if 'Nothing' --- -- default domain will be used -> String -- ^ message id -> IO String -- ^ return value-dGetText domainname msgid = +dGetText domainname msgid = withCStringMaybe domainname $ \dn' -> withCString msgid $ \msg' -> c_dgettext dn' msg' >>= fromCStringDefault msgid --- |dcGetText wraps GNU dcgettext function. It works similar to 'dGetText'+-- | 'dcGetText' wraps GNU dcgettext function. It works similar to 'dGetText' -- but also takes category id dcGetText :: Maybe String -- ^ domain name, if 'Nothing' --- -- default domain will be used -> Category -- ^ locale facet -> String -- ^ message id -> IO String -- ^ return value-dcGetText domainname cat msgid = +dcGetText domainname cat msgid = withCStringMaybe domainname $ \dn' -> withCString msgid $ \msg' ->- c_dcgettext dn' msg' (categoryToCInt cat) >>= + c_dcgettext dn' msg' (categoryToCInt cat) >>= fromCStringDefault msgid- --- |nGetText wraps GNU ngettext function. It translates text string in the++-- | 'nGetText' wraps GNU ngettext function. It translates text string in the -- user's native language, by lookilng up the approppiate plural form of the -- message. --@@ -115,16 +115,16 @@ -> Integer -- ^ number, used to choose appropriate form -> IO String -- ^ result string, by default if number is 1 than -- singular form of msgid is returned, otherwise ---- -- plural + -- plural nGetText msgid msgid_plural n = withCString msgid $ \msgid' -> withCString msgid_plural $ \msgid_plural' -> c_ngettext msgid' msgid_plural' (fromInteger n) >>= fromCStringPluralDefault msgid msgid_plural n --- |dnGetText wraps GNU dngettext function. It works similar to 'nGetText' but+-- | 'dnGetText' wraps GNU dngettext function. It works similar to 'nGetText' but -- also takes domain name--- +-- dnGetText :: Maybe String -- ^ domain name, if 'Nothing' --- -- default domain will be used -> String -- ^ msgid in singular form@@ -132,7 +132,7 @@ -> Integer -- ^ number, used to choose appropriate form -> IO String -- ^ result string, by default if number is 1 than -- singular form of msgid is returned, otherwise ---- -- plural + -- plural dnGetText domainname msgid msgid_plural n = withCStringMaybe domainname $ \dn' -> withCString msgid $ \msgid' ->@@ -140,9 +140,9 @@ c_dngettext dn' msgid' msgid_plural' (fromInteger n) >>= fromCStringPluralDefault msgid msgid_plural n --- |dcnGetText wraps GNU dcngettext function. It works similar to 'dnGetText' but+-- | 'dcnGetText' wraps GNU dcngettext function. It works similar to 'dnGetText' but -- also takes category id--- +-- dcnGetText :: Maybe String -- ^ domain name, if 'Nothing' --- -- default domain will be used -> Category -- ^ locale facet@@ -151,16 +151,16 @@ -> Integer -- ^ number, used to choose appropriate form -> IO String -- ^ result string, by default if number is 1 than -- singular form of msgid is returned, otherwise ---- -- plural + -- plural dcnGetText domainname cat msgid msgid_plural n = withCStringMaybe domainname $ \dn' -> withCString msgid $ \msgid' -> withCString msgid_plural $ \msgid_plural' ->- c_dcngettext dn' msgid' msgid_plural' + c_dcngettext dn' msgid' msgid_plural' (fromInteger n) (categoryToCInt cat) >>= fromCStringPluralDefault msgid msgid_plural n --- |bindTextDomain sets the base directory of the hierarchy+-- | 'bindTextDomain' sets the base directory of the hierarchy -- containing message catalogs for a given message domain. -- -- Throws 'IOError' if fails@@ -169,18 +169,18 @@ -> Maybe String -- ^ path to the locale folder or 'Nothing' to return -- base directory for domain -> IO String -- ^ return value-bindTextDomain domainname dirname = - withCString domainname $ \domain -> +bindTextDomain domainname dirname =+ withCString domainname $ \domain -> withCStringMaybe dirname $ \dir -> c_bindtextdomain domain dir >>= fromCStringError "bindTextDomain fails" --- |textDomain sets domain for future 'getText' call+-- | 'textDomain' sets domain for future 'getText' call -- -- Throws 'IOError' if fails--- +-- textDomain :: Maybe String -- ^ domain name, if 'Nothing' than returns -- current domain name -> IO String -- ^ return value-textDomain domainname = +textDomain domainname = withCStringMaybe domainname $ \domain -> c_textdomain domain >>= fromCStringError "textDomain fails"
− src/hgettext.hs
@@ -1,97 +0,0 @@--import qualified Language.Haskell.Exts as H --import System.Environment-import System.Console.GetOpt--import Data.Generics.Uniplate.Data--import Distribution.Simple.PreProcess.Unlit--import Data.List-import Data.Char-import System.FilePath--import Paths_hgettext (version)-import Data.Version (showVersion)--data Options = Options {- outputFile :: String,- keyword :: 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 {keyword = d}) "WORD")- "function name, in which wrapped searched words",- Option [] ["version"]- (NoArg (\opts -> opts {printVersion = True}))- "print version of hgettexts"- ]---defaultOptions = Options "messages.po" "__" 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 -> [(Int, String)]-toTranslate f (H.ParseOk z) = nub [ (0, s) | H.App (H.Var (H.UnQual (H.Ident x))) (H.Lit (H.String 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 " ++ (show 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 Options{printVersion = True} _ = - putStrLn $ "hgettext, version " ++ (showVersion version)--process opts fl = do- t <- mapM read' fl- writeFile (outputFile opts) $ writePOTFile $ map (\(n,c) -> formatMessages n $ toTranslate (keyword opts) c) t- where read' "-" = getContents >>= \c -> return ("-", H.parseFileContents c)- read' f = H.parseFile f >>= \m -> return (f, m)--main = - getArgs >>= parseArgs >>= uncurry process-