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 (warn)
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 (fromPackageName, matchFileGlob)
gettextDefaultMain :: IO ()
gettextDefaultMain :: IO ()
gettextDefaultMain = UserHooks -> IO ()
UserHooks -> IO ()
defaultMainWithHooks (UserHooks -> IO ()) -> UserHooks -> IO ()
forall a b. (a -> b) -> a -> b
$ UserHooks -> UserHooks
installGetTextHooks UserHooks
simpleUserHooks
installGetTextHooks :: UserHooks
-> UserHooks
installGetTextHooks :: UserHooks -> UserHooks
installGetTextHooks uh :: UserHooks
uh =
UserHooks
uh { confHook :: (GenericPackageDescription, HookedBuildInfo)
-> ConfigFlags -> IO LocalBuildInfo
confHook = \a :: (GenericPackageDescription, HookedBuildInfo)
a b :: ConfigFlags
b -> do
LocalBuildInfo
lbi <- (UserHooks
-> (GenericPackageDescription, HookedBuildInfo)
-> ConfigFlags
-> IO LocalBuildInfo
confHook UserHooks
uh) (GenericPackageDescription, HookedBuildInfo)
a ConfigFlags
b
LocalBuildInfo -> IO LocalBuildInfo
forall (m :: * -> *) a. Monad m => a -> m a
return (LocalBuildInfo -> LocalBuildInfo
updateLocalBuildInfo LocalBuildInfo
lbi)
, postInst :: Args
-> InstallFlags -> PackageDescription -> LocalBuildInfo -> IO ()
postInst = \args :: Args
args iflags :: InstallFlags
iflags pd :: PackageDescription
pd lbi :: LocalBuildInfo
lbi -> do
UserHooks
-> Args
-> InstallFlags
-> PackageDescription
-> LocalBuildInfo
-> IO ()
postInst UserHooks
uh Args
args InstallFlags
iflags PackageDescription
pd LocalBuildInfo
lbi
Verbosity -> LocalBuildInfo -> IO ()
installPOFiles (Verbosity -> Flag Verbosity -> Verbosity
forall a. a -> Flag a -> a
fromFlagOrDefault Verbosity
forall a. Bounded a => a
maxBound (InstallFlags -> Flag Verbosity
installVerbosity InstallFlags
iflags)) LocalBuildInfo
lbi
, postCopy :: Args -> CopyFlags -> PackageDescription -> LocalBuildInfo -> IO ()
postCopy = \args :: Args
args cflags :: CopyFlags
cflags pd :: PackageDescription
pd lbi :: LocalBuildInfo
lbi -> do
UserHooks
-> Args
-> CopyFlags
-> PackageDescription
-> LocalBuildInfo
-> IO ()
postCopy UserHooks
uh Args
args CopyFlags
cflags PackageDescription
pd LocalBuildInfo
lbi
Verbosity -> LocalBuildInfo -> IO ()
installPOFiles (Verbosity -> Flag Verbosity -> Verbosity
forall a. a -> Flag a -> a
fromFlagOrDefault Verbosity
forall a. Bounded a => a
maxBound (CopyFlags -> Flag Verbosity
copyVerbosity CopyFlags
cflags)) LocalBuildInfo
lbi
}
updateLocalBuildInfo :: LocalBuildInfo -> LocalBuildInfo
updateLocalBuildInfo :: LocalBuildInfo -> LocalBuildInfo
updateLocalBuildInfo l :: LocalBuildInfo
l =
let sMap :: [(String, String)]
sMap = LocalBuildInfo -> [(String, String)]
getCustomFields LocalBuildInfo
l
[domDef :: String
domDef, catDef :: String
catDef] = (([(String, String)] -> String) -> String)
-> [[(String, String)] -> String] -> Args
forall a b. (a -> b) -> [a] -> [b]
map (([(String, String)] -> String) -> [(String, String)] -> String
forall a b. (a -> b) -> a -> b
$ [(String, String)]
sMap) [[(String, String)] -> String
getDomainDefine, [(String, String)] -> String
getMsgCatalogDefine]
dom :: String
dom = [(String, String)] -> String -> String
getDomainNameDefault [(String, String)]
sMap (LocalBuildInfo -> String
getPackageName LocalBuildInfo
l)
tar :: String
tar = LocalBuildInfo -> String
targetDataDir LocalBuildInfo
l
[catMS :: String
catMS, domMS :: String
domMS] = ((String, String) -> String) -> [(String, String)] -> Args
forall a b. (a -> b) -> [a] -> [b]
map ((String -> String -> String) -> (String, String) -> String
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry String -> String -> String
forall a. Show a => String -> a -> String
formatMacro) [(String
domDef, String
dom), (String
catDef, String
tar)]
in (Args -> LocalBuildInfo -> LocalBuildInfo
appendCPPOptions [String
domMS,String
catMS] (LocalBuildInfo -> LocalBuildInfo)
-> (LocalBuildInfo -> LocalBuildInfo)
-> LocalBuildInfo
-> LocalBuildInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Extension] -> LocalBuildInfo -> LocalBuildInfo
appendExtension [KnownExtension -> Extension
EnableExtension KnownExtension
CPP]) LocalBuildInfo
l
installPOFiles :: Verbosity -> LocalBuildInfo -> IO ()
installPOFiles :: Verbosity -> LocalBuildInfo -> IO ()
installPOFiles verb :: Verbosity
verb l :: LocalBuildInfo
l =
let sMap :: [(String, String)]
sMap = LocalBuildInfo -> [(String, String)]
getCustomFields LocalBuildInfo
l
destDir :: String
destDir = LocalBuildInfo -> String
targetDataDir LocalBuildInfo
l
dom :: String
dom = [(String, String)] -> String -> String
getDomainNameDefault [(String, String)]
sMap (LocalBuildInfo -> String
getPackageName LocalBuildInfo
l)
installFile :: String -> IO ()
installFile file :: String
file = do
let fname :: String
fname = String -> String
takeFileName String
file
let bname :: String
bname = String -> String
takeBaseName String
fname
let targetDir :: String
targetDir = String
destDir String -> String -> String
</> String
bname String -> String -> String
</> "LC_MESSAGES"
Bool -> String -> IO ()
createDirectoryIfMissing Bool
True String
targetDir
ProcessHandle
ph <- String
-> Args
-> Maybe String
-> Maybe [(String, String)]
-> Maybe Handle
-> Maybe Handle
-> Maybe Handle
-> IO ProcessHandle
runProcess "msgfmt" [ "--output-file=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (String
targetDir String -> String -> String
</> String
dom String -> String -> String
<.> "mo"), String
file ]
Maybe String
forall a. Maybe a
Nothing Maybe [(String, String)]
forall a. Maybe a
Nothing Maybe Handle
forall a. Maybe a
Nothing Maybe Handle
forall a. Maybe a
Nothing Maybe Handle
forall a. Maybe a
Nothing
ExitCode
ec <- ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
ph
case ExitCode
ec of
ExitSuccess -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
ExitFailure n :: Int
n -> Verbosity -> String -> IO ()
warn Verbosity
verb ("'msgfmt' exited with non-zero status (rc = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ ")")
in do
Args
filelist <- [(String, String)] -> IO Args
getPoFilesDefault [(String, String)]
sMap
(String -> IO ()) -> Args -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> IO ()
installFile Args
filelist
forBuildInfo :: LocalBuildInfo -> (BuildInfo -> BuildInfo) -> LocalBuildInfo
forBuildInfo :: LocalBuildInfo -> (BuildInfo -> BuildInfo) -> LocalBuildInfo
forBuildInfo l :: LocalBuildInfo
l f :: BuildInfo -> BuildInfo
f =
let a :: LocalBuildInfo
a = LocalBuildInfo
l{localPkgDescr :: PackageDescription
localPkgDescr = PackageDescription -> PackageDescription
updPkgDescr (LocalBuildInfo -> PackageDescription
localPkgDescr LocalBuildInfo
l)}
updPkgDescr :: PackageDescription -> PackageDescription
updPkgDescr x :: PackageDescription
x = PackageDescription
x{library :: Maybe Library
library = Maybe Library -> Maybe Library
updLibrary (PackageDescription -> Maybe Library
library PackageDescription
x),
executables :: [Executable]
executables = [Executable] -> [Executable]
updExecs (PackageDescription -> [Executable]
executables PackageDescription
x)}
updLibrary :: Maybe Library -> Maybe Library
updLibrary Nothing = Maybe Library
forall a. Maybe a
Nothing
updLibrary (Just x :: Library
x) = Library -> Maybe Library
forall a. a -> Maybe a
Just (Library -> Maybe Library) -> Library -> Maybe Library
forall a b. (a -> b) -> a -> b
$ Library
x{libBuildInfo :: BuildInfo
libBuildInfo = BuildInfo -> BuildInfo
f (Library -> BuildInfo
libBuildInfo Library
x)}
updExecs :: [Executable] -> [Executable]
updExecs x :: [Executable]
x = (Executable -> Executable) -> [Executable] -> [Executable]
forall a b. (a -> b) -> [a] -> [b]
map Executable -> Executable
updExec [Executable]
x
updExec :: Executable -> Executable
updExec x :: Executable
x = Executable
x{buildInfo :: BuildInfo
buildInfo = BuildInfo -> BuildInfo
f (Executable -> BuildInfo
buildInfo Executable
x)}
in LocalBuildInfo
a
appendExtension :: [Extension] -> LocalBuildInfo -> LocalBuildInfo
appendExtension :: [Extension] -> LocalBuildInfo -> LocalBuildInfo
appendExtension exts :: [Extension]
exts l :: LocalBuildInfo
l =
LocalBuildInfo -> (BuildInfo -> BuildInfo) -> LocalBuildInfo
forBuildInfo LocalBuildInfo
l BuildInfo -> BuildInfo
updBuildInfo
where updBuildInfo :: BuildInfo -> BuildInfo
updBuildInfo x :: BuildInfo
x = BuildInfo
x{defaultExtensions :: [Extension]
defaultExtensions = [Extension] -> [Extension]
updExts (BuildInfo -> [Extension]
defaultExtensions BuildInfo
x)}
updExts :: [Extension] -> [Extension]
updExts s :: [Extension]
s = [Extension] -> [Extension]
forall a. Eq a => [a] -> [a]
nub ([Extension]
s [Extension] -> [Extension] -> [Extension]
forall a. [a] -> [a] -> [a]
++ [Extension]
exts)
appendCPPOptions :: [String] -> LocalBuildInfo -> LocalBuildInfo
appendCPPOptions :: Args -> LocalBuildInfo -> LocalBuildInfo
appendCPPOptions opts :: Args
opts l :: LocalBuildInfo
l =
LocalBuildInfo -> (BuildInfo -> BuildInfo) -> LocalBuildInfo
forBuildInfo LocalBuildInfo
l BuildInfo -> BuildInfo
updBuildInfo
where updBuildInfo :: BuildInfo -> BuildInfo
updBuildInfo x :: BuildInfo
x = BuildInfo
x{cppOptions :: Args
cppOptions = Args -> Args
updOpts (BuildInfo -> Args
cppOptions BuildInfo
x)}
updOpts :: Args -> Args
updOpts s :: Args
s = Args -> Args
forall a. Eq a => [a] -> [a]
nub (Args
s Args -> Args -> Args
forall a. [a] -> [a] -> [a]
++ Args
opts)
formatMacro :: Show a => [Char] -> a -> [Char]
formatMacro :: String -> a -> String
formatMacro name :: String
name value :: a
value = "-D" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ "=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (a -> String
forall a. Show a => a -> String
show a
value)
targetDataDir :: LocalBuildInfo -> FilePath
targetDataDir :: LocalBuildInfo -> String
targetDataDir l :: LocalBuildInfo
l =
let dirTmpls :: InstallDirTemplates
dirTmpls = LocalBuildInfo -> InstallDirTemplates
installDirTemplates LocalBuildInfo
l
prefix' :: PathTemplate
prefix' = InstallDirTemplates -> PathTemplate
forall dir. InstallDirs dir -> dir
prefix InstallDirTemplates
dirTmpls
data' :: PathTemplate
data' = InstallDirTemplates -> PathTemplate
forall dir. InstallDirs dir -> dir
datadir InstallDirTemplates
dirTmpls
dataEx :: String
dataEx = PathTemplate -> String
I.fromPathTemplate (PathTemplate -> String) -> PathTemplate -> String
forall a b. (a -> b) -> a -> b
$ PathTemplateEnv -> PathTemplate -> PathTemplate
I.substPathTemplate [(PathTemplateVariable
PrefixVar, PathTemplate
prefix')] PathTemplate
data'
in String
dataEx String -> String -> String
forall a. [a] -> [a] -> [a]
++ "/locale"
getPackageName :: LocalBuildInfo -> String
getPackageName :: LocalBuildInfo -> String
getPackageName = PackageName -> String
fromPackageName (PackageName -> String)
-> (LocalBuildInfo -> PackageName) -> LocalBuildInfo -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageDescription -> PackageName
forall pkg. Package pkg => pkg -> PackageName
packageName (PackageDescription -> PackageName)
-> (LocalBuildInfo -> PackageDescription)
-> LocalBuildInfo
-> PackageName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocalBuildInfo -> PackageDescription
localPkgDescr
getCustomFields :: LocalBuildInfo -> [(String, String)]
getCustomFields :: LocalBuildInfo -> [(String, String)]
getCustomFields = PackageDescription -> [(String, String)]
customFieldsPD (PackageDescription -> [(String, String)])
-> (LocalBuildInfo -> PackageDescription)
-> LocalBuildInfo
-> [(String, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocalBuildInfo -> PackageDescription
localPkgDescr
findInParametersDefault :: [(String, String)] -> String -> String -> String
findInParametersDefault :: [(String, String)] -> String -> String -> String
findInParametersDefault al :: [(String, String)]
al name :: String
name def :: String
def = (String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
def (Maybe String -> String)
-> ([(String, String)] -> Maybe String)
-> [(String, String)]
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
name) [(String, String)]
al
getDomainNameDefault :: [(String, String)] -> String -> String
getDomainNameDefault :: [(String, String)] -> String -> String
getDomainNameDefault al :: [(String, String)]
al d :: String
d = [(String, String)] -> String -> String -> String
findInParametersDefault [(String, String)]
al "x-gettext-domain-name" String
d
getDomainDefine :: [(String, String)] -> String
getDomainDefine :: [(String, String)] -> String
getDomainDefine al :: [(String, String)]
al = [(String, String)] -> String -> String -> String
findInParametersDefault [(String, String)]
al "x-gettext-domain-def" "__MESSAGE_CATALOG_DOMAIN__"
getMsgCatalogDefine :: [(String, String)] -> String
getMsgCatalogDefine :: [(String, String)] -> String
getMsgCatalogDefine al :: [(String, String)]
al = [(String, String)] -> String -> String -> String
findInParametersDefault [(String, String)]
al "x-gettext-msg-cat-def" "__MESSAGE_CATALOG_DIR__"
getPoFilesDefault :: [(String, String)] -> IO [String]
getPoFilesDefault :: [(String, String)] -> IO Args
getPoFilesDefault al :: [(String, String)]
al = String -> IO Args
toFileList (String -> IO Args) -> String -> IO Args
forall a b. (a -> b) -> a -> b
$ [(String, String)] -> String -> String -> String
findInParametersDefault [(String, String)]
al "x-gettext-po-files" ""
where toFileList :: String -> IO Args
toFileList "" = Args -> IO Args
forall (m :: * -> *) a. Monad m => a -> m a
return []
toFileList x :: String
x = ([Args] -> Args) -> IO [Args] -> IO Args
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [Args] -> Args
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (IO [Args] -> IO Args) -> IO [Args] -> IO Args
forall a b. (a -> b) -> a -> b
$ (String -> IO Args) -> Args -> IO [Args]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> IO Args
matchFileGlob (Args -> IO [Args]) -> Args -> IO [Args]
forall a b. (a -> b) -> a -> b
$ String -> Args
split' String
x
split' :: String -> Args
split' x :: String
x = (String -> Args) -> Args -> Args
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap String -> Args
lines (Args -> Args) -> Args -> Args
forall a b. (a -> b) -> a -> b
$ (String -> Args) -> Args -> Args
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap String -> Args
words (Args -> Args) -> Args -> Args
forall a b. (a -> b) -> a -> b
$ (String -> Maybe (String, String)) -> String -> Args
forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr (\b :: String
b -> (Char -> (String, String)) -> Maybe Char -> Maybe (String, String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((String, String) -> Char -> (String, String)
forall a b. a -> b -> a
const ((String, String) -> Char -> (String, String))
-> (String -> (String, String))
-> String
-> Char
-> (String, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String -> String) -> (String, String) -> (String, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ((String -> String) -> (String, String) -> (String, String))
-> (String -> String) -> (String, String) -> (String, String)
forall a b. (a -> b) -> a -> b
$ Int -> String -> String
forall a. Int -> [a] -> [a]
drop 1) ((String, String) -> (String, String))
-> (String -> (String, String)) -> String -> (String, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==',') (String -> Char -> (String, String))
-> String -> Char -> (String, String)
forall a b. (a -> b) -> a -> b
$ String
b) (Maybe Char -> Maybe (String, String))
-> (String -> Maybe Char) -> String -> Maybe (String, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe Char
forall a. [a] -> Maybe a
listToMaybe (String -> Maybe (String, String))
-> String -> Maybe (String, String)
forall a b. (a -> b) -> a -> b
$ String
b) String
x