packages feed

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
    )