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