{-# LANGUAGE OverloadedStrings #-}
module ProjectForge.Render (
renderFileTemplate
, renderProjectTemplate
, writeTemplateResult
, RenderTemplateOpts(..)
, RenderWarnHandling(..)
, RenderException
, defaultRenderTemplateOpts
) where
import Blammo.Logging.Simple
import Control.Exception
import Control.Monad
import Control.Monad.IO.Class
import qualified Data.Aeson as AE
import Data.Bifunctor
import qualified Data.Set as Set
import Data.Text
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Encoding as TL
import qualified Data.Text.Lazy.IO as TL
import ProjectForge.ProjectTemplate
import System.Directory
import System.FilePath
import Text.Mustache.Render
import Text.Mustache.Type
data RenderWarnHandling =
WarningAsError
| Ignore
deriving (RenderWarnHandling -> RenderWarnHandling -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RenderWarnHandling -> RenderWarnHandling -> Bool
$c/= :: RenderWarnHandling -> RenderWarnHandling -> Bool
== :: RenderWarnHandling -> RenderWarnHandling -> Bool
$c== :: RenderWarnHandling -> RenderWarnHandling -> Bool
Eq, Int -> RenderWarnHandling -> ShowS
[RenderWarnHandling] -> ShowS
RenderWarnHandling -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RenderWarnHandling] -> ShowS
$cshowList :: [RenderWarnHandling] -> ShowS
show :: RenderWarnHandling -> String
$cshow :: RenderWarnHandling -> String
showsPrec :: Int -> RenderWarnHandling -> ShowS
$cshowsPrec :: Int -> RenderWarnHandling -> ShowS
Show)
newtype RenderException = MkRenderException [MustacheWarning]
deriving (RenderException -> RenderException -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RenderException -> RenderException -> Bool
$c/= :: RenderException -> RenderException -> Bool
== :: RenderException -> RenderException -> Bool
$c== :: RenderException -> RenderException -> Bool
Eq, Int -> RenderException -> ShowS
[RenderException] -> ShowS
RenderException -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RenderException] -> ShowS
$cshowList :: [RenderException] -> ShowS
show :: RenderException -> String
$cshow :: RenderException -> String
showsPrec :: Int -> RenderException -> ShowS
$cshowsPrec :: Int -> RenderException -> ShowS
Show)
instance Exception RenderException
newtype RenderTemplateOpts =
MkRenderTemplateOpts { RenderTemplateOpts -> RenderWarnHandling
handleWarnings :: RenderWarnHandling }
deriving (RenderTemplateOpts -> RenderTemplateOpts -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RenderTemplateOpts -> RenderTemplateOpts -> Bool
$c/= :: RenderTemplateOpts -> RenderTemplateOpts -> Bool
== :: RenderTemplateOpts -> RenderTemplateOpts -> Bool
$c== :: RenderTemplateOpts -> RenderTemplateOpts -> Bool
Eq, Int -> RenderTemplateOpts -> ShowS
[RenderTemplateOpts] -> ShowS
RenderTemplateOpts -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RenderTemplateOpts] -> ShowS
$cshowList :: [RenderTemplateOpts] -> ShowS
show :: RenderTemplateOpts -> String
$cshow :: RenderTemplateOpts -> String
showsPrec :: Int -> RenderTemplateOpts -> ShowS
$cshowsPrec :: Int -> RenderTemplateOpts -> ShowS
Show)
defaultRenderTemplateOpts :: RenderTemplateOpts
defaultRenderTemplateOpts :: RenderTemplateOpts
defaultRenderTemplateOpts = MkRenderTemplateOpts {
handleWarnings :: RenderWarnHandling
handleWarnings = RenderWarnHandling
Ignore
}
renderFileTemplate :: (MonadLogger m, MonadIO m) =>
RenderTemplateOpts
-> FileTemplate
-> AE.Value
-> m (FilePath, TL.Text)
renderFileTemplate :: forall (m :: * -> *).
(MonadLogger m, MonadIO m) =>
RenderTemplateOpts -> FileTemplate -> Value -> m (String, Text)
renderFileTemplate RenderTemplateOpts
opts (MkFileTemplate String
ofn Template
fn Template
ct) Value
v = do
forall (m :: * -> *).
(HasCallStack, MonadLogger m) =>
Message -> m ()
logInfo forall a b. (a -> b) -> a -> b
$ Text
"Rendering template" Text -> [SeriesElem] -> Message
:# [ Key
"templatePath" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= String
ofn ]
let rendered :: ([MustacheWarning], (String, Text))
rendered = forall {a} {b}. (([a], Text), ([a], b)) -> ([a], (String, b))
reshape forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Template -> ([MustacheWarning], Text)
render Template -> ([MustacheWarning], Text)
render (Template
fn, Template
ct)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null (forall a b. (a, b) -> a
fst ([MustacheWarning], (String, Text))
rendered) )
(do
let logWarnWhere :: Message -> m ()
logWarnWhere = case RenderTemplateOpts -> RenderWarnHandling
handleWarnings RenderTemplateOpts
opts of
RenderWarnHandling
WarningAsError -> forall (m :: * -> *).
(HasCallStack, MonadLogger m) =>
Message -> m ()
logError
RenderWarnHandling
Ignore -> forall (m :: * -> *).
(HasCallStack, MonadLogger m) =>
Message -> m ()
logWarn
Message -> m ()
logWarnWhere forall a b. (a -> b) -> a -> b
$ Text
"Rendering resulted in warnings" Text -> [SeriesElem] -> Message
:#
[ Key
"fileNameTemplate" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a b. (a, b) -> a
fst (forall a b. (a, b) -> b
snd ([MustacheWarning], (String, Text))
rendered)
, Key
"warnings" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=
Text -> [Text] -> Text
intercalate Text
"\n" (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. MustacheWarning -> String
displayMustacheWarning) (forall a b. (a, b) -> a
fst ([MustacheWarning], (String, Text))
rendered)) ]
case RenderTemplateOpts -> RenderWarnHandling
handleWarnings RenderTemplateOpts
opts of
RenderWarnHandling
WarningAsError -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => e -> IO a
throwIO ([MustacheWarning] -> RenderException
MkRenderException (forall a b. (a, b) -> a
fst ([MustacheWarning], (String, Text))
rendered))
RenderWarnHandling
Ignore -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. (a, b) -> b
snd ([MustacheWarning], (String, Text))
rendered)
where render :: Template -> ([MustacheWarning], Text)
render = forall a b c. (a -> b -> c) -> b -> a -> c
flip Template -> Value -> ([MustacheWarning], Text)
renderMustacheW Value
v
reshape :: (([a], Text), ([a], b)) -> ([a], (String, b))
reshape (([a], Text)
x, ([a], b)
y) =
( forall a b. (a, b) -> a
fst ([a], Text)
x forall a. [a] -> [a] -> [a]
++ forall a b. (a, b) -> a
fst ([a], b)
y
, (( Text -> String
unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
TL.toStrict ) forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> b
snd ([a], Text)
x, forall a b. (a, b) -> b
snd ([a], b)
y))
renderProjectTemplate :: (MonadIO m, MonadLogger m) =>
RenderTemplateOpts
-> ProjectTemplate
-> AE.Value
-> m [(FilePath, TL.Text)]
renderProjectTemplate :: forall (m :: * -> *).
(MonadIO m, MonadLogger m) =>
RenderTemplateOpts
-> ProjectTemplate -> Value -> m [(String, Text)]
renderProjectTemplate RenderTemplateOpts
opts (MkProjectTemplate Set FileTemplate
t) Value
v =
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (FileTemplate -> Value -> m (String, Text)
`f` Value
v) (forall a. Set a -> [a]
Set.toList Set FileTemplate
t)
where f :: FileTemplate -> Value -> m (String, Text)
f = forall (m :: * -> *).
(MonadLogger m, MonadIO m) =>
RenderTemplateOpts -> FileTemplate -> Value -> m (String, Text)
renderFileTemplate RenderTemplateOpts
opts
writeTemplateResult :: (MonadLogger m, MonadIO m) => [(FilePath, TL.Text)] -> m ()
writeTemplateResult :: forall (m :: * -> *).
(MonadLogger m, MonadIO m) =>
[(String, Text)] -> m ()
writeTemplateResult =
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(String
fn, Text
cnts) -> do
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Bool -> String -> IO ()
createDirectoryIfMissing Bool
True (ShowS
takeDirectory String
fn)
forall (m :: * -> *).
(HasCallStack, MonadLogger m) =>
Message -> m ()
logDebug forall a b. (a -> b) -> a -> b
$ Text
"Writing template result to file" Text -> [SeriesElem] -> Message
:# [ Key
"path" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= String
fn ]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> Text -> IO ()
TL.writeFile String
fn Text
cnts
)