{-# language OverloadedStrings #-}
{-# language FlexibleContexts #-}
{-# language ViewPatterns #-}
module SitePipe.Templating
  ( renderTemplate
  ) where

import qualified Text.Mustache as M
import qualified Data.Text as T
import Data.Text.Lens
import Control.Lens
import Data.Aeson.Lens
import Data.Aeson.Types
import SitePipe.Types
import Control.Monad.Writer
import Control.Monad.Reader
import qualified Text.Mustache.Types as MT

-- | Given a template, produces a function compatible with 'SitePipe.Files.writeWith'
-- which writes resources using the template.
renderTemplate :: (ToJSON env) => M.Template -> env -> SiteM String
renderTemplate :: Template -> env -> SiteM String
renderTemplate Template
template (env -> Value
forall a. ToJSON a => a -> Value
toJSON -> Value
env) = do
  Value
gContext <- (Settings -> Value) -> ReaderT Settings (WriterT [String] IO) Value
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Settings -> Value
globalContext
  let fullContext :: Value
fullContext = Value -> Value -> Value
addContext Value
gContext (Value -> Value
forall ω. ToMustache ω => ω -> Value
MT.toMustache Value
env)
  case Template -> Value -> ([SubstitutionError], Text)
forall k.
ToMustache k =>
Template -> k -> ([SubstitutionError], Text)
M.checkedSubstitute Template
template Value
fullContext of
    ([], Text
result) -> String -> SiteM String
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> String
T.unpack Text
result)
    ([SubstitutionError]
errs, Text
r) -> do
      [String] -> ReaderT Settings (WriterT [String] IO) ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell ([String] -> ReaderT Settings (WriterT [String] IO) ())
-> [String] -> ReaderT Settings (WriterT [String] IO) ()
forall a b. (a -> b) -> a -> b
$ [String
"*** Warnings rendering " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
path String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"***"] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ ((SubstitutionError -> String) -> [SubstitutionError] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SubstitutionError -> String
forall a. Show a => a -> String
show [SubstitutionError]
errs) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"------"]
      String -> SiteM String
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> String
T.unpack Text
r)
  where
    path :: String
path = Value
env Value -> Getting String Value String -> String
forall s a. s -> Getting a s a -> a
^. Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"filepath" ((Value -> Const String Value) -> Value -> Const String Value)
-> Getting String Value String -> Getting String Value String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const String Text) -> Value -> Const String Value
forall t. AsPrimitive t => Prism' t Text
_String ((Text -> Const String Text) -> Value -> Const String Value)
-> ((String -> Const String String) -> Text -> Const String Text)
-> Getting String Value String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Const String String) -> Text -> Const String Text
forall t. IsText t => Iso' t String
unpacked
    addContext :: Value -> Value -> Value
addContext (MT.Object Object
context) (MT.Object Object
e) = Object -> Value
MT.Object (Object
context Object -> Object -> Object
forall a. Semigroup a => a -> a -> a
<> Object
e)
    addContext Value
_ Value
e = Value
e