{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, ExistentialQuantification, DeriveDataTypeable, OverloadedStrings, RecordWildCards #-}
module Text.Localize.Load
(
LocatePolicy (..), Facet,
loadTranslations, locateTranslations,
linuxLocation, localLocation
) where
import Control.Monad
import Control.Monad.Trans
import Data.Default
import qualified Data.Map as M
import qualified Data.Text.Lazy as T
import qualified Data.Gettext as Gettext
import Data.Text.Format.Heavy
import System.Directory
import System.FilePath
import System.FilePath.Glob
import Text.Localize.Types
loadTranslations :: [(LanguageId, FilePath)] -> IO Translations
loadTranslations :: [(LanguageId, LanguageId)] -> IO Translations
loadTranslations [(LanguageId, LanguageId)]
pairs = do
[(LanguageId, Catalog)]
res <- [(LanguageId, LanguageId)]
-> ((LanguageId, LanguageId) -> IO (LanguageId, Catalog))
-> IO [(LanguageId, Catalog)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(LanguageId, LanguageId)]
pairs (((LanguageId, LanguageId) -> IO (LanguageId, Catalog))
-> IO [(LanguageId, Catalog)])
-> ((LanguageId, LanguageId) -> IO (LanguageId, Catalog))
-> IO [(LanguageId, Catalog)]
forall a b. (a -> b) -> a -> b
$ \(LanguageId
lang, LanguageId
path) -> do
Catalog
gmo <- LanguageId -> IO Catalog
Gettext.loadCatalog LanguageId
path
(LanguageId, Catalog) -> IO (LanguageId, Catalog)
forall (m :: * -> *) a. Monad m => a -> m a
return (LanguageId
lang, Catalog
gmo)
Translations -> IO Translations
forall (m :: * -> *) a. Monad m => a -> m a
return (Translations -> IO Translations)
-> Translations -> IO Translations
forall a b. (a -> b) -> a -> b
$ Map LanguageId Catalog -> Translations
Translations (Map LanguageId Catalog -> Translations)
-> Map LanguageId Catalog -> Translations
forall a b. (a -> b) -> a -> b
$ [(LanguageId, Catalog)] -> Map LanguageId Catalog
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(LanguageId, Catalog)]
res
type Facet = String
data LocatePolicy = LocatePolicy {
LocatePolicy -> [LanguageId]
lcBasePaths :: [FilePath]
, LocatePolicy -> LanguageId
lcName :: String
, LocatePolicy -> LanguageId
lcFacet :: Facet
, LocatePolicy -> Format
lcFormat :: Format
}
deriving (Int -> LocatePolicy -> ShowS
[LocatePolicy] -> ShowS
LocatePolicy -> LanguageId
(Int -> LocatePolicy -> ShowS)
-> (LocatePolicy -> LanguageId)
-> ([LocatePolicy] -> ShowS)
-> Show LocatePolicy
forall a.
(Int -> a -> ShowS)
-> (a -> LanguageId) -> ([a] -> ShowS) -> Show a
showList :: [LocatePolicy] -> ShowS
$cshowList :: [LocatePolicy] -> ShowS
show :: LocatePolicy -> LanguageId
$cshow :: LocatePolicy -> LanguageId
showsPrec :: Int -> LocatePolicy -> ShowS
$cshowsPrec :: Int -> LocatePolicy -> ShowS
Show)
instance Default LocatePolicy where
def :: LocatePolicy
def = LocatePolicy :: [LanguageId] -> LanguageId -> LanguageId -> Format -> LocatePolicy
LocatePolicy {
lcBasePaths :: [LanguageId]
lcBasePaths = [LanguageId
"locale"],
lcName :: LanguageId
lcName = LanguageId
"messages",
lcFacet :: LanguageId
lcFacet = LanguageId
"LC_MESSAGES",
lcFormat :: Format
lcFormat = Format
"{base}/{language}/{facet}/{name}.mo"
}
linuxLocation :: String
-> LocatePolicy
linuxLocation :: LanguageId -> LocatePolicy
linuxLocation LanguageId
name = LocatePolicy
forall a. Default a => a
def {lcBasePaths :: [LanguageId]
lcBasePaths = [LanguageId
"/usr/share/locale", LanguageId
"/usr/local/share/locale"], lcName :: LanguageId
lcName = LanguageId
name}
localLocation :: FilePath
-> LocatePolicy
localLocation :: LanguageId -> LocatePolicy
localLocation LanguageId
base = LocatePolicy
forall a. Default a => a
def {lcBasePaths :: [LanguageId]
lcBasePaths = [LanguageId
base], lcFormat :: Format
lcFormat = Format
"{base}/{language}.mo"}
locateTranslations :: MonadIO m => LocatePolicy -> m Translations
locateTranslations :: LocatePolicy -> m Translations
locateTranslations (LocatePolicy {LanguageId
[LanguageId]
Format
lcFormat :: Format
lcFacet :: LanguageId
lcName :: LanguageId
lcBasePaths :: [LanguageId]
lcFormat :: LocatePolicy -> Format
lcFacet :: LocatePolicy -> LanguageId
lcName :: LocatePolicy -> LanguageId
lcBasePaths :: LocatePolicy -> [LanguageId]
..}) = IO Translations -> m Translations
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Translations -> m Translations)
-> IO Translations -> m Translations
forall a b. (a -> b) -> a -> b
$ do
[LanguageId]
basePaths <- (LanguageId -> IO LanguageId) -> [LanguageId] -> IO [LanguageId]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM LanguageId -> IO LanguageId
makeAbsolute [LanguageId]
lcBasePaths
[[(LanguageId, LanguageId)]]
pairs <- [LanguageId]
-> (LanguageId -> IO [(LanguageId, LanguageId)])
-> IO [[(LanguageId, LanguageId)]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [LanguageId]
basePaths ((LanguageId -> IO [(LanguageId, LanguageId)])
-> IO [[(LanguageId, LanguageId)]])
-> (LanguageId -> IO [(LanguageId, LanguageId)])
-> IO [[(LanguageId, LanguageId)]]
forall a b. (a -> b) -> a -> b
$ \LanguageId
basePath -> do
let vars :: Map Text LanguageId
vars = [(Text, LanguageId)] -> Map Text LanguageId
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Text, LanguageId)] -> Map Text LanguageId)
-> [(Text, LanguageId)] -> Map Text LanguageId
forall a b. (a -> b) -> a -> b
$
[(Text
"base", LanguageId
basePath),
(Text
"language", LanguageId
"*"),
(Text
"facet", LanguageId
lcFacet),
(Text
"name", LanguageId
lcName)] :: M.Map T.Text String
Format [FormatItem]
fmtItems = Format
lcFormat
([FormatItem]
fmtBase, [FormatItem]
fmtTail) = [FormatItem] -> ([FormatItem], [FormatItem])
breakFormat [FormatItem]
fmtItems
pathGlob :: LanguageId
pathGlob = Text -> LanguageId
T.unpack (Format -> Map Text LanguageId -> Text
forall vars. VarContainer vars => Format -> vars -> Text
format Format
lcFormat Map Text LanguageId
vars)
pathBaseLen :: Int
pathBaseLen = Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int) -> Int64 -> Int
forall a b. (a -> b) -> a -> b
$ Text -> Int64
T.length (Format -> Map Text LanguageId -> Text
forall vars. VarContainer vars => Format -> vars -> Text
format ([FormatItem] -> Format
Format [FormatItem]
fmtBase) Map Text LanguageId
vars)
pathTailLen :: Int
pathTailLen = Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int) -> Int64 -> Int
forall a b. (a -> b) -> a -> b
$ Text -> Int64
T.length (Format -> Map Text LanguageId -> Text
forall vars. VarContainer vars => Format -> vars -> Text
format ([FormatItem] -> Format
Format [FormatItem]
fmtTail) Map Text LanguageId
vars)
[LanguageId]
paths <- LanguageId -> IO [LanguageId]
glob LanguageId
pathGlob
[LanguageId]
-> (LanguageId -> IO (LanguageId, LanguageId))
-> IO [(LanguageId, LanguageId)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [LanguageId]
paths ((LanguageId -> IO (LanguageId, LanguageId))
-> IO [(LanguageId, LanguageId)])
-> (LanguageId -> IO (LanguageId, LanguageId))
-> IO [(LanguageId, LanguageId)]
forall a b. (a -> b) -> a -> b
$ \LanguageId
path -> do
let pathWithoutBase :: LanguageId
pathWithoutBase = Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
pathBaseLen LanguageId
path
languageLen :: Int
languageLen = LanguageId -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length LanguageId
pathWithoutBase Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
pathTailLen
language :: LanguageId
language = Int -> ShowS
forall a. Int -> [a] -> [a]
take Int
languageLen LanguageId
pathWithoutBase
(LanguageId, LanguageId) -> IO (LanguageId, LanguageId)
forall (m :: * -> *) a. Monad m => a -> m a
return (LanguageId
language, LanguageId
path)
[(LanguageId, LanguageId)] -> IO Translations
loadTranslations ([(LanguageId, LanguageId)] -> IO Translations)
-> [(LanguageId, LanguageId)] -> IO Translations
forall a b. (a -> b) -> a -> b
$ [[(LanguageId, LanguageId)]] -> [(LanguageId, LanguageId)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(LanguageId, LanguageId)]]
pairs
where
breakFormat :: [FormatItem] -> ([FormatItem], [FormatItem])
breakFormat [FormatItem]
items =
let ([FormatItem]
hd, [FormatItem]
tl) = (FormatItem -> Bool)
-> [FormatItem] -> ([FormatItem], [FormatItem])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break FormatItem -> Bool
isLanguage [FormatItem]
items
in case [FormatItem]
tl of
[] -> ([FormatItem]
hd, [])
[FormatItem]
_ -> ([FormatItem]
hd, [FormatItem] -> [FormatItem]
forall a. [a] -> [a]
tail [FormatItem]
tl)
isLanguage :: FormatItem -> Bool
isLanguage (FVariable Text
name VarFormat
_) = Text
name Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"language"
isLanguage FormatItem
_ = Bool
False