{-|
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 (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)

-- | 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 (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

{-| Options to control how @'renderFileTemplate'@ is run.
-}
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)

-- | Default @'RenderTemplateOpts'@
defaultRenderTemplateOpts :: RenderTemplateOpts
defaultRenderTemplateOpts :: RenderTemplateOpts
defaultRenderTemplateOpts = MkRenderTemplateOpts {
  handleWarnings :: RenderWarnHandling
handleWarnings = RenderWarnHandling
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 :: 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)

  -- handle warnings, if any
  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))

{-|
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 :: 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


{-|
Utility for writing the results for @'renderProjectTemplate'@ to files.
-}
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
    )