project-forge-0.2.0.0: src/ProjectForge/Render.hs
{-|
Functions for rendering Project and File Templates.
Rendering a @'Template'@ interpolates the partial values in a @Template@
with values from a @'Data.Aeson.Value'@.
-}
{-# LANGUAGE OverloadedStrings #-}
module ProjectForge.Render (
-- * Rendering templates
renderFileTemplate
, renderProjectTemplate
, writeTemplateResult
-- ** Rendering Options and Exception Handling
, 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
{-| Flag for how to handle any '@Text.Stache.Type.MustacheWarning'@s
that may result from @'renderFileTemplate'@.
-}
data RenderWarnHandling =
-- | lift mustache warnings to errors
WarningAsError
-- | Ignore warnings
| Ignore
deriving (Eq, Show)
-- | New type wrapper for a list of '@Text.Stache.Type.MustacheWarning'@s
-- so that it can be made an instance of @'Control.Exception.Exception'@.
newtype RenderException = MkRenderException [MustacheWarning]
deriving (Eq, Show)
instance Exception RenderException
{-| Options to control how @'renderFileTemplate'@ is run.
-}
newtype RenderTemplateOpts =
MkRenderTemplateOpts { handleWarnings :: RenderWarnHandling }
deriving (Eq, Show)
-- | Default @'RenderTemplateOpts'@
defaultRenderTemplateOpts :: RenderTemplateOpts
defaultRenderTemplateOpts = MkRenderTemplateOpts {
handleWarnings = Ignore
}
{-|
Renders a @'FileTemplate'@ using @'Text.Mustache.renderMustache'@.
Values to be input into the template are presented
via a @'Data.Aeson.Value'@ representation.
>>> import Data.Aeson (toJSON, object, (.=))
>>> import ProjectForge.Compile
>>> import Blammo.Logging.Simple
>>> let settings = toJSON (object [ "prjId" .= "P0000"])
>>> let exampleTemplate = compileFileTemplate ("{{prjId}}.md", "This is {{prjId}}")
>>> runSimpleLoggingT . (\x -> renderFileTemplate defaultRenderTemplateOpts x settings) =<< exampleTemplate
([],("P0000.md","This is P0000"))
-}
renderFileTemplate :: (MonadLogger m, MonadIO m) =>
RenderTemplateOpts
-> FileTemplate
-> AE.Value -- ^ values to interpolate into the template
-> m (FilePath, TL.Text)
renderFileTemplate opts (MkFileTemplate ofn fn ct) v = do
logInfo $ "Rendering template" :# [ "templatePath" .= ofn ]
let rendered = reshape $ bimap render render (fn, ct)
-- handle warnings, if any
unless (Prelude.null (fst rendered) )
(do
let logWarnWhere = case handleWarnings opts of
WarningAsError -> logError
Ignore -> logWarn
logWarnWhere $ "Rendering resulted in warnings" :#
[ "fileNameTemplate" .= fst (snd rendered)
, "warnings" .=
intercalate "\n" (fmap (pack . displayMustacheWarning) (fst rendered)) ]
case handleWarnings opts of
WarningAsError -> liftIO $ throwIO (MkRenderException (fst rendered))
Ignore -> pure ()
)
pure (snd rendered)
where render = flip renderMustacheW v
reshape (x, y) =
( fst x ++ fst y
, (( unpack . TL.toStrict ) $ snd x, snd y))
{-|
Renders a @'ProjectTemplate'@,
returning a list of filepaths and file contents
that may be written to files.
-}
renderProjectTemplate :: (MonadIO m, MonadLogger m) =>
RenderTemplateOpts
-> ProjectTemplate
-- | values to interpolate into each @'FileTemplate'@
-- of the @'ProjectTemplate'@
-> AE.Value
-> m [(FilePath, TL.Text)]
renderProjectTemplate opts (MkProjectTemplate t) v =
traverse (`f` v) (Set.toList t)
where f = renderFileTemplate opts
{-|
Utility for writing the results for @'renderProjectTemplate'@ to files.
-}
writeTemplateResult :: (MonadLogger m, MonadIO m) => [(FilePath, TL.Text)] -> m ()
writeTemplateResult =
mapM_ (\(fn, cnts) -> do
liftIO $ createDirectoryIfMissing True (takeDirectory fn)
logDebug $ "Writing template result to file" :# [ "path" .= fn ]
liftIO $ TL.writeFile fn cnts
)