-- | 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