module Text.StringTemplates.TemplatesLoader ( Templates
, GlobalTemplates
, localizedVersion
, readGlobalTemplates
, renderTemplateMain
, getTemplatesModTime
) where
import Prelude hiding (fail)
import Data.List (isSuffixOf,find)
import Data.Maybe (fromMaybe)
import Text.StringTemplate
import Control.Monad hiding (fail)
import Control.Monad.Fail (MonadFail(..))
import Control.Monad.IO.Class
import qualified Data.Map as Map
import Text.Html (stringToHtmlString)
import Data.Time.Clock
import Text.StringTemplates.Files
import Text.StringTemplates.TextTemplates
import Text.StringTemplates.Utils
type Templates = STGroup String
type GlobalTemplates = Map.Map String Templates
localizedVersion :: String -> GlobalTemplates -> Templates
localizedVersion col mtemplates = fromMaybe (error $ "localizedVersion: undefined language: " ++ show col) $ Map.lookup col mtemplates
readGlobalTemplates :: (MonadIO m, MonadFail m) =>
FilePath
-> FilePath
-> String
-> m GlobalTemplates
readGlobalTemplates textTemplatesFilePath templatesDirPath defaultLang = do
files <- liftIO $ directoryFilesRecursive templatesDirPath
let templatesFilePaths = filter (".st" `isSuffixOf`) files
ts <- liftIO $ mapM getTemplates templatesFilePaths
tts <- liftIO $ getTextTemplates textTemplatesFilePath
let defaultLangTemplates = case (find (\l -> defaultLang == fst l) $ Map.toList tts) of
Just (_,t) -> t
Nothing -> error $ "Default language " ++ defaultLang ++ " is not defined."
liftM Map.fromList $ forM (Map.toList tts) $ \(col,t) -> do
let t' = fixTT t defaultLangTemplates
checked <- mapM newCheckedTemplate $ (concat ts) ++ t'
return ((col, groupStringTemplates checked)::(String, Templates))
fixTT:: [(String, String)] -> [(String, String)] -> [(String, String)]
fixTT [] d = d
fixTT ((n,""):r) d = case find (\x -> n == fst x) d of
Just t -> t : fixTT r (filter (\x -> n /= fst x) d)
Nothing -> (n,"") : fixTT r d
fixTT ((n,v):r) d = (n,v) : fixTT r (filter (\x -> n /= fst x) d)
newCheckedTemplate :: (Monad m, MonadFail m) => (String, String) -> m (String, StringTemplate String)
newCheckedTemplate (n,v) = do
let t = newSTMP v
(errors, _, _) = checkTemplate t
maybe (return ()) (\e -> fail $ "newCheckedTemplate: problem with template " ++ show n ++ ": " ++ e) errors
return (n,t)
getTemplatesModTime :: FilePath
-> FilePath
-> IO UTCTime
getTemplatesModTime textTemplatesDir templatesDirPath = do
mt1 <- getRecursiveMTime templatesDirPath
mt2 <- getRecursiveMTime textTemplatesDir
return $ maximum $ [mt1,mt2]
renderTemplateMain :: ToSElem a =>
Templates
-> String
-> [(String, a)]
-> (StringTemplate String -> StringTemplate String)
-> String
renderTemplateMain ts name params f = case mt of
Just t -> render $ f (setManyAttrib params t)
Nothing -> error $ "No template named " ++ name
where
ts' = setEncoderGroup stringToHtmlString ts
noescape = groupStringTemplates [("noescape", newSTMP "$it$" :: StringTemplate String)]
mt = getStringTemplate name $ mergeSTGroups noescape ts'