hgettext-0.1.31.0/0000755000000000000000000000000013221542576011763 5ustar0000000000000000hgettext-0.1.31.0/LICENSE0000644000000000000000000000277013221542576012776 0ustar0000000000000000Copyright (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-0.1.31.0/Setup.hs0000644000000000000000000000005713221542576013421 0ustar0000000000000000 import Distribution.Simple main = defaultMain hgettext-0.1.31.0/hgettext.cabal0000644000000000000000000000451613221542576014611 0ustar0000000000000000cabal-version: 1.14 name: hgettext version: 0.1.31.0 build-type: Simple license: BSD3 license-file: LICENSE 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). 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 source-repository head type: git location: https://github.com/hvr/hgettext.git 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 hgettext-0.1.31.0/src/0000755000000000000000000000000013221542576012552 5ustar0000000000000000hgettext-0.1.31.0/src/Internal.hs0000644000000000000000000000035213221542576014662 0ustar0000000000000000{-# 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 hgettext-0.1.31.0/src/Text/0000755000000000000000000000000013221542576013476 5ustar0000000000000000hgettext-0.1.31.0/src/Text/I18N/0000755000000000000000000000000013221542576014155 5ustar0000000000000000hgettext-0.1.31.0/src/Text/I18N/GetText.hs0000644000000000000000000001721113221542576016077 0ustar0000000000000000-- | This library provides basic internationalization capabilities module Text.I18N.GetText ( getText, nGetText, dGetText, dnGetText, dcGetText, dcnGetText, bindTextDomain, textDomain ) where 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 :: CString -> IO CString foreign import ccall unsafe "libintl.h dgettext" c_dgettext :: CString -> CString -> IO CString foreign import ccall unsafe "libintl.h dcgettext" c_dcgettext :: CString -> CString -> CInt -> IO CString foreign import ccall unsafe "libintl.h ngettext" c_ngettext :: CString -> CString -> CULong -> IO CString foreign import ccall unsafe "libintl.h dngettext" c_dngettext :: CString -> CString -> CString -> CULong -> IO CString foreign import ccall unsafe "libintl.h dcngettext" c_dcngettext :: CString -> CString -> CString -> CULong -> CInt -> 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 fromCStringError :: String -> CString -> IO String fromCStringError err x | x == nullPtr = throwErrno err | otherwise = peekCString x fromCStringDefault :: String -> CString -> IO String fromCStringDefault d x = fromCString x >>= \r -> return (fromMaybe d r) fromCStringPluralDefault :: (Eq a, Num a) => String -> String -> a -> CString -> IO String 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 (Just str) f = withCString str f -- | '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 -- | '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 = withCStringMaybe domainname $ \dn' -> withCString msgid $ \msg' -> c_dgettext dn' msg' >>= fromCStringDefault msgid -- | '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 = withCStringMaybe domainname $ \dn' -> withCString msgid $ \msg' -> c_dcgettext dn' msg' (categoryToCInt cat) >>= fromCStringDefault msgid -- | '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. -- nGetText :: String -- ^ msgid in singular form -> String -- ^ msgid in plural form -> 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 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 -- also takes domain name -- dnGetText :: Maybe String -- ^ domain name, if 'Nothing' --- -- default domain will be used -> String -- ^ msgid in singular form -> String -- ^ msgid in plural form -> 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 dnGetText domainname msgid msgid_plural n = withCStringMaybe domainname $ \dn' -> withCString msgid $ \msgid' -> withCString msgid_plural $ \msgid_plural' -> c_dngettext dn' msgid' msgid_plural' (fromInteger n) >>= fromCStringPluralDefault msgid msgid_plural n -- | '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 -> String -- ^ msgid in singular form -> String -- ^ msgid in plural form -> 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 dcnGetText domainname cat msgid msgid_plural n = withCStringMaybe domainname $ \dn' -> withCString msgid $ \msgid' -> withCString msgid_plural $ \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 -- containing message catalogs for a given message domain. -- -- Throws 'IOError' if fails -- bindTextDomain :: String -- ^ domain name -> 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 -> withCStringMaybe dirname $ \dir -> c_bindtextdomain domain dir >>= fromCStringError "bindTextDomain fails" -- | '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 = withCStringMaybe domainname $ \domain -> c_textdomain domain >>= fromCStringError "textDomain fails" hgettext-0.1.31.0/src/Distribution/0000755000000000000000000000000013221542576015231 5ustar0000000000000000hgettext-0.1.31.0/src/Distribution/Simple/0000755000000000000000000000000013221542576016462 5ustar0000000000000000hgettext-0.1.31.0/src/Distribution/Simple/I18N/0000755000000000000000000000000013221542576017141 5ustar0000000000000000hgettext-0.1.31.0/src/Distribution/Simple/I18N/GetText.hs0000644000000000000000000002076013221542576021066 0ustar0000000000000000-- | This library extends the Distribution with internationalization support. -- -- It performs two functions: -- -- * compiles and installs PO files to the specified directory -- -- * tells the application where files were installed to make it able -- to bind them to the code -- -- Each PO file will be placed to the -- @{datadir}\/locale\/{loc}\/LC_MESSAGES\/{domain}.mo@ where: -- -- [@datadir@] Usually @prefix/share@ but could be different, depends -- on system. -- -- [@loc@] Locale name (language code, two characters). This module -- supposes, that each PO file has a base name set to the proper -- locale, e.g. @de.po@ is the German translation of the program, so -- this file will be placed under @{datadir}\/locale\/de@ directory -- -- [@domain@] Program domain. A unique identifier of single -- translational unit (program). By default domain will be set to the -- package name, but its name could be configured in the @.cabal@ file. -- -- The module defines following @.cabal@ fields: -- -- [@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@ -- -- [@x-gettext-domain-def@] Name of the macro, in which domain name -- will be passed to the program. Default value is -- @__MESSAGE_CATALOG_DOMAIN__@ -- -- [@x-gettext-msg-cat-def@] Name of the macro, in which path to the -- message catalog will be passed to the program. Default value is -- @__MESSAGE_CATALOG_DIR__@ -- -- The last two parameters are used to send configuration data to the -- code during its compilation. The most common usage example is: -- -- -- > ... -- > prepareI18N = do -- > setLocale LC_ALL (Just "") -- > bindTextDomain __MESSAGE_CATALOG_DOMAIN__ (Just __MESSAGE_CATALOG_DIR__) -- > textDomain __MESSAGE_CATALOG_DOMAIN__ -- > -- > main = do -- > prepareI18N -- > ... -- > -- > ... -- -- -- __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 -- 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 ) where 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 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 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. -- -- 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 -> do lbi <- (confHook uh) a b return (updateLocalBuildInfo lbi) , 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 = let sMap = getCustomFields l [domDef, catDef] = map ($ sMap) [getDomainDefine, getMsgCatalogDefine] dom = getDomainNameDefault sMap (getPackageName l) tar = targetDataDir l [catMS, domMS] = map (uncurry formatMacro) [(domDef, dom), (catDef, tar)] in (appendCPPOptions [domMS,catMS] . appendExtension [EnableExtension CPP]) l installPOFiles :: Verbosity -> LocalBuildInfo -> IO () installPOFiles verb l = let sMap = getCustomFields l destDir = targetDataDir l dom = getDomainNameDefault sMap (getPackageName l) installFile file = do let fname = takeFileName file let bname = takeBaseName fname let targetDir = destDir bname "LC_MESSAGES" -- ensure we have directory destDir/{loc}/LC_MESSAGES createDirectoryIfMissing True targetDir 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 forBuildInfo :: LocalBuildInfo -> (BuildInfo -> BuildInfo) -> LocalBuildInfo forBuildInfo l f = let a = l{localPkgDescr = updPkgDescr (localPkgDescr l)} updPkgDescr x = x{library = updLibrary (library x), executables = updExecs (executables x)} 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 = forBuildInfo l updBuildInfo where updBuildInfo x = x{defaultExtensions = updExts (defaultExtensions x)} updExts s = nub (s ++ exts) appendCPPOptions :: [String] -> LocalBuildInfo -> LocalBuildInfo 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 = let dirTmpls = installDirTemplates l prefix' = prefix dirTmpls data' = datadir dirTmpls dataEx = I.fromPathTemplate $ I.substPathTemplate [(PrefixVar, prefix')] data' in dataEx ++ "/locale" getPackageName :: LocalBuildInfo -> String getPackageName = fromPackageName . packageName . localPkgDescr getCustomFields :: LocalBuildInfo -> [(String, String)] getCustomFields = customFieldsPD . localPkgDescr findInParametersDefault :: [(String, String)] -> String -> String -> String findInParametersDefault al name def = (fromMaybe def . lookup name) al getDomainNameDefault :: [(String, String)] -> String -> String getDomainNameDefault al d = findInParametersDefault al "x-gettext-domain-name" d getDomainDefine :: [(String, String)] -> String getDomainDefine al = findInParametersDefault al "x-gettext-domain-def" "__MESSAGE_CATALOG_DOMAIN__" getMsgCatalogDefine :: [(String, String)] -> String getMsgCatalogDefine al = findInParametersDefault al "x-gettext-msg-cat-def" "__MESSAGE_CATALOG_DIR__" 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 -- 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 hgettext-0.1.31.0/src-exe/0000755000000000000000000000000013221542576013331 5ustar0000000000000000hgettext-0.1.31.0/src-exe/hgettext.hs0000644000000000000000000001102313221542576015516 0ustar0000000000000000module 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 \\n\"", "\"Language-Team: LANGUAGE \\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 [ ":", 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