-- | Module for reading templates from files
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

-- | Group of string templates
type Templates = STGroup String
-- | Global map of templates (for a project),
--   indexed by a language name (for text string templates, see TextTemplates for doc)
type GlobalTemplates = Map.Map String Templates

-- | Retrieve templates for specified language name
localizedVersion :: String -> GlobalTemplates -> Templates
localizedVersion :: String -> GlobalTemplates -> Templates
localizedVersion String
col GlobalTemplates
mtemplates = Templates -> Maybe Templates -> Templates
forall a. a -> Maybe a -> a
fromMaybe (String -> Templates
forall a. HasCallStack => String -> a
error (String -> Templates) -> String -> Templates
forall a b. (a -> b) -> a -> b
$ String
"localizedVersion: undefined language: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
col) (Maybe Templates -> Templates) -> Maybe Templates -> Templates
forall a b. (a -> b) -> a -> b
$ String -> GlobalTemplates -> Maybe Templates
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
col GlobalTemplates
mtemplates

-- Fixme: Make this do only one read of all files !!
-- | Reads text templates and templates from files (see TextTemplates and Files modules docs respectively).
readGlobalTemplates :: (MonadIO m, MonadFail m) =>
                      FilePath   -- ^ dir path to recursively scan for .json files containing text templates
                    -> FilePath  -- ^ dir path to recursively scan for .st files containing string templates
                    -> String    -- ^ default language. We can guarantee that empty language texts will be replaced
                    -> m GlobalTemplates
readGlobalTemplates :: forall (m :: * -> *).
(MonadIO m, MonadFail m) =>
String -> String -> String -> m GlobalTemplates
readGlobalTemplates String
textTemplatesFilePath String
templatesDirPath  String
defaultLang = do
  [String]
files <- IO [String] -> m [String]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [String] -> m [String]) -> IO [String] -> m [String]
forall a b. (a -> b) -> a -> b
$ String -> IO [String]
directoryFilesRecursive String
templatesDirPath
  let templatesFilePaths :: [String]
templatesFilePaths = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String
".st" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf`) [String]
files
  [[(String, String)]]
ts <- IO [[(String, String)]] -> m [[(String, String)]]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [[(String, String)]] -> m [[(String, String)]])
-> IO [[(String, String)]] -> m [[(String, String)]]
forall a b. (a -> b) -> a -> b
$ (String -> IO [(String, String)])
-> [String] -> IO [[(String, String)]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM String -> IO [(String, String)]
getTemplates [String]
templatesFilePaths
  Map String [(String, String)]
tts <- IO (Map String [(String, String)])
-> m (Map String [(String, String)])
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Map String [(String, String)])
 -> m (Map String [(String, String)]))
-> IO (Map String [(String, String)])
-> m (Map String [(String, String)])
forall a b. (a -> b) -> a -> b
$ String -> IO (Map String [(String, String)])
getTextTemplates String
textTemplatesFilePath
  let defaultLangTemplates :: [(String, String)]
defaultLangTemplates = case (((String, [(String, String)]) -> Bool)
-> [(String, [(String, String)])]
-> Maybe (String, [(String, String)])
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(String, [(String, String)])
l -> String
defaultLang String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== (String, [(String, String)]) -> String
forall a b. (a, b) -> a
fst (String, [(String, String)])
l) ([(String, [(String, String)])]
 -> Maybe (String, [(String, String)]))
-> [(String, [(String, String)])]
-> Maybe (String, [(String, String)])
forall a b. (a -> b) -> a -> b
$ Map String [(String, String)] -> [(String, [(String, String)])]
forall k a. Map k a -> [(k, a)]
Map.toList Map String [(String, String)]
tts) of
                               Just (String
_,[(String, String)]
t) -> [(String, String)]
t
                               Maybe (String, [(String, String)])
Nothing -> String -> [(String, String)]
forall a. HasCallStack => String -> a
error (String -> [(String, String)]) -> String -> [(String, String)]
forall a b. (a -> b) -> a -> b
$ String
"Default language " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
defaultLang String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" is not defined."
  ([(String, Templates)] -> GlobalTemplates)
-> m [(String, Templates)] -> m GlobalTemplates
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [(String, Templates)] -> GlobalTemplates
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (m [(String, Templates)] -> m GlobalTemplates)
-> m [(String, Templates)] -> m GlobalTemplates
forall a b. (a -> b) -> a -> b
$ [(String, [(String, String)])]
-> ((String, [(String, String)]) -> m (String, Templates))
-> m [(String, Templates)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (Map String [(String, String)] -> [(String, [(String, String)])]
forall k a. Map k a -> [(k, a)]
Map.toList Map String [(String, String)]
tts) (((String, [(String, String)]) -> m (String, Templates))
 -> m [(String, Templates)])
-> ((String, [(String, String)]) -> m (String, Templates))
-> m [(String, Templates)]
forall a b. (a -> b) -> a -> b
$ \(String
col,[(String, String)]
t) -> do
    let  t' :: [(String, String)]
t' =  [(String, String)] -> [(String, String)] -> [(String, String)]
fixTT [(String, String)]
t [(String, String)]
defaultLangTemplates
    [(String, StringTemplate String)]
checked <- ((String, String) -> m (String, StringTemplate String))
-> [(String, String)] -> m [(String, StringTemplate String)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (String, String) -> m (String, StringTemplate String)
forall (m :: * -> *).
(Monad m, MonadFail m) =>
(String, String) -> m (String, StringTemplate String)
newCheckedTemplate ([(String, String)] -> m [(String, StringTemplate String)])
-> [(String, String)] -> m [(String, StringTemplate String)]
forall a b. (a -> b) -> a -> b
$ ([[(String, String)]] -> [(String, String)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(String, String)]]
ts) [(String, String)] -> [(String, String)] -> [(String, String)]
forall a. [a] -> [a] -> [a]
++ [(String, String)]
t'
    (String, Templates) -> m (String, Templates)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((String
col, [(String, StringTemplate String)] -> Templates
forall a. [(String, StringTemplate a)] -> STGroup a
groupStringTemplates [(String, StringTemplate String)]
checked)::(String, Templates))

-- All empty templates will be replaced by values from default lang.
-- Missing templates from defaul lang will be added
fixTT:: [(String, String)] -> [(String, String)] -> [(String, String)]
fixTT :: [(String, String)] -> [(String, String)] -> [(String, String)]
fixTT [] [(String, String)]
d = [(String, String)]
d
fixTT ((String
n,String
""):[(String, String)]
r) [(String, String)]
d = case ((String, String) -> Bool)
-> [(String, String)] -> Maybe (String, String)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(String, String)
x -> String
n String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== (String, String) -> String
forall a b. (a, b) -> a
fst (String, String)
x) [(String, String)]
d of
                          Just (String, String)
t -> (String, String)
t (String, String) -> [(String, String)] -> [(String, String)]
forall a. a -> [a] -> [a]
:  [(String, String)] -> [(String, String)] -> [(String, String)]
fixTT [(String, String)]
r (((String, String) -> Bool)
-> [(String, String)] -> [(String, String)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(String, String)
x -> String
n String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= (String, String) -> String
forall a b. (a, b) -> a
fst (String, String)
x) [(String, String)]
d)
                          Maybe (String, String)
Nothing -> (String
n,String
"") (String, String) -> [(String, String)] -> [(String, String)]
forall a. a -> [a] -> [a]
: [(String, String)] -> [(String, String)] -> [(String, String)]
fixTT [(String, String)]
r [(String, String)]
d
fixTT ((String
n,String
v):[(String, String)]
r) [(String, String)]
d = (String
n,String
v) (String, String) -> [(String, String)] -> [(String, String)]
forall a. a -> [a] -> [a]
:  [(String, String)] -> [(String, String)] -> [(String, String)]
fixTT [(String, String)]
r (((String, String) -> Bool)
-> [(String, String)] -> [(String, String)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(String, String)
x -> String
n String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= (String, String) -> String
forall a b. (a, b) -> a
fst (String, String)
x) [(String, String)]
d)



newCheckedTemplate :: (Monad m, MonadFail m) => (String, String) -> m (String, StringTemplate String)
newCheckedTemplate :: forall (m :: * -> *).
(Monad m, MonadFail m) =>
(String, String) -> m (String, StringTemplate String)
newCheckedTemplate (String
n,String
v) = do
  let t :: StringTemplate String
t = String -> StringTemplate String
forall a. Stringable a => String -> StringTemplate a
newSTMP String
v
      (Maybe String
errors, Maybe [String]
_, Maybe [String]
_) = StringTemplate String
-> (Maybe String, Maybe [String], Maybe [String])
forall a.
Stringable a =>
StringTemplate a -> (Maybe String, Maybe [String], Maybe [String])
checkTemplate StringTemplate String
t
  m () -> (String -> m ()) -> Maybe String -> m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (\String
e -> String -> m ()
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"newCheckedTemplate: problem with template " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e) Maybe String
errors
  (String, StringTemplate String)
-> m (String, StringTemplate String)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (String
n,StringTemplate String
t)

-- | Returns the latest modification time across all template files
getTemplatesModTime :: FilePath   -- ^ path to dir containing .csv files with template files
                    -> FilePath -- ^ dir path to recursively scan for .st files containing string templates
                    -> IO UTCTime
getTemplatesModTime :: String -> String -> IO UTCTime
getTemplatesModTime String
textTemplatesDir String
templatesDirPath = do
    UTCTime
mt1 <- String -> IO UTCTime
getRecursiveMTime String
templatesDirPath
    UTCTime
mt2 <- String -> IO UTCTime
getRecursiveMTime String
textTemplatesDir
    UTCTime -> IO UTCTime
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (UTCTime -> IO UTCTime) -> UTCTime -> IO UTCTime
forall a b. (a -> b) -> a -> b
$ [UTCTime] -> UTCTime
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([UTCTime] -> UTCTime) -> [UTCTime] -> UTCTime
forall a b. (a -> b) -> a -> b
$ [UTCTime
mt1,UTCTime
mt2]

-- | main template rendering function.
--   renders template by name (it's an error to render template that's not present in templates group),
--   and using list of named template params. simple 'noescape' template is added for convenience
renderTemplateMain :: ToSElem a =>
                     Templates     -- ^ group of templates
                   -> String        -- ^ template name
                   -> [(String, a)] -- ^ named template params
                   -> (StringTemplate String -> StringTemplate String) -- ^ additional template altering function
                   -> String -- ^ rendered template
renderTemplateMain :: forall a.
ToSElem a =>
Templates
-> String
-> [(String, a)]
-> (StringTemplate String -> StringTemplate String)
-> String
renderTemplateMain Templates
ts String
name [(String, a)]
params StringTemplate String -> StringTemplate String
f = case Maybe (StringTemplate String)
mt of
  Just StringTemplate String
t  -> StringTemplate String -> String
forall a. Stringable a => StringTemplate a -> a
render (StringTemplate String -> String)
-> StringTemplate String -> String
forall a b. (a -> b) -> a -> b
$ StringTemplate String -> StringTemplate String
f ([(String, a)] -> StringTemplate String -> StringTemplate String
forall a b.
(ToSElem a, Stringable b) =>
[(String, a)] -> StringTemplate b -> StringTemplate b
setManyAttrib [(String, a)]
params StringTemplate String
t)
  Maybe (StringTemplate String)
Nothing -> String -> String
forall a. HasCallStack => String -> a
error  (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
"No template named " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name
  where
    ts' :: Templates
ts' = (String -> String) -> Templates -> Templates
forall a. Stringable a => (a -> a) -> STGroup a -> STGroup a
setEncoderGroup String -> String
stringToHtmlString Templates
ts
    noescape :: Templates
noescape = [(String, StringTemplate String)] -> Templates
forall a. [(String, StringTemplate a)] -> STGroup a
groupStringTemplates [(String
"noescape", String -> StringTemplate String
forall a. Stringable a => String -> StringTemplate a
newSTMP String
"$it$" :: StringTemplate String)]
    mt :: Maybe (StringTemplate String)
mt = String -> Templates -> Maybe (StringTemplate String)
forall a.
Stringable a =>
String -> STGroup a -> Maybe (StringTemplate a)
getStringTemplate String
name (Templates -> Maybe (StringTemplate String))
-> Templates -> Maybe (StringTemplate String)
forall a b. (a -> b) -> a -> b
$ Templates -> Templates -> Templates
forall a. STGroup a -> STGroup a -> STGroup a
mergeSTGroups Templates
noescape Templates
ts'