{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}

{-|
Module      : Headroom.Template.Mustache
Description : Implementation of /Mustache/ template support
Copyright   : (c) 2019-2020 Vaclav Svejcar
License     : BSD-3-Clause
Maintainer  : vaclav.svejcar@gmail.com
Stability   : experimental
Portability : POSIX

This module provides support for <https://mustache.github.io Mustache> templates.
-}

module Headroom.Template.Mustache
  ( Mustache(..)
  )
where

import           Headroom.Template              ( Template(..)
                                                , TemplateError(..)
                                                )
import           Headroom.Variables.Types       ( Variables(..) )
import           RIO
import qualified RIO.Text                      as T
import qualified Text.Mustache                 as MU
import           Text.Mustache.Render           ( SubstitutionError(..) )


-- | The /Mustache/ template.
data Mustache = Mustache MU.Template Text
  deriving Int -> Mustache -> ShowS
[Mustache] -> ShowS
Mustache -> String
(Int -> Mustache -> ShowS)
-> (Mustache -> String) -> ([Mustache] -> ShowS) -> Show Mustache
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Mustache] -> ShowS
$cshowList :: [Mustache] -> ShowS
show :: Mustache -> String
$cshow :: Mustache -> String
showsPrec :: Int -> Mustache -> ShowS
$cshowsPrec :: Int -> Mustache -> ShowS
Show


-- | Support for /Mustache/ templates.
instance Template Mustache where
  templateExtensions :: NonEmpty Text
templateExtensions = Text
"mustache" Text -> [Text] -> NonEmpty Text
forall a. a -> [a] -> NonEmpty a
:| []
  parseTemplate :: Maybe Text -> Text -> m Mustache
parseTemplate      = Maybe Text -> Text -> m Mustache
forall (m :: * -> *).
MonadThrow m =>
Maybe Text -> Text -> m Mustache
parseTemplate'
  renderTemplate :: Variables -> Mustache -> m Text
renderTemplate     = Variables -> Mustache -> m Text
forall (m :: * -> *).
MonadThrow m =>
Variables -> Mustache -> m Text
renderTemplate'
  rawTemplate :: Mustache -> Text
rawTemplate        = Mustache -> Text
rawTemplate'


parseTemplate' :: MonadThrow m => Maybe Text -> Text -> m Mustache
parseTemplate' :: Maybe Text -> Text -> m Mustache
parseTemplate' Maybe Text
name Text
raw = case String -> Text -> Either ParseError Template
MU.compileTemplate String
templateName Text
raw of
  Left  ParseError
err -> TemplateError -> m Mustache
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (TemplateError -> m Mustache)
-> (Text -> TemplateError) -> Text -> m Mustache
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> TemplateError
ParseError (Text -> m Mustache) -> Text -> m Mustache
forall a b. (a -> b) -> a -> b
$ ParseError -> Text
forall a. Show a => a -> Text
tshow ParseError
err
  Right Template
res -> Mustache -> m Mustache
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Mustache -> m Mustache) -> Mustache -> m Mustache
forall a b. (a -> b) -> a -> b
$ Template -> Text -> Mustache
Mustache Template
res Text
raw
  where templateName :: String
templateName = Text -> String
T.unpack (Text -> String) -> (Maybe Text -> Text) -> Maybe Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" (Maybe Text -> String) -> Maybe Text -> String
forall a b. (a -> b) -> a -> b
$ Maybe Text
name


renderTemplate' :: MonadThrow m => Variables -> Mustache -> m Text
renderTemplate' :: Variables -> Mustache -> m Text
renderTemplate' (Variables HashMap Text Text
variables) (Mustache t :: Template
t@(MU.Template String
name STree
_ TemplateCache
_) Text
_) =
  case Template -> HashMap Text Text -> ([SubstitutionError], Text)
forall k.
ToMustache k =>
Template -> k -> ([SubstitutionError], Text)
MU.checkedSubstitute Template
t HashMap Text Text
variables of
    ([], Text
rendered) -> Text -> m Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
rendered
    ([SubstitutionError]
errs, Text
rendered) ->
      let errs' :: [Text]
errs'            = [SubstitutionError] -> [Text]
missingVariables [SubstitutionError]
errs
          missingVariables :: [SubstitutionError] -> [Text]
missingVariables = (SubstitutionError -> [Text]) -> [SubstitutionError] -> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((SubstitutionError -> [Text]) -> [SubstitutionError] -> [Text])
-> (SubstitutionError -> [Text]) -> [SubstitutionError] -> [Text]
forall a b. (a -> b) -> a -> b
$ \case
            (VariableNotFound [Text]
ps) -> [Text]
ps
            SubstitutionError
_                     -> []
      in  if [SubstitutionError] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [SubstitutionError]
errs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
errs'
            then TemplateError -> m Text
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (TemplateError -> m Text) -> TemplateError -> m Text
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> TemplateError
MissingVariables (String -> Text
T.pack String
name) [Text]
errs'
            else Text -> m Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
rendered


rawTemplate' :: Mustache -> Text
rawTemplate' :: Mustache -> Text
rawTemplate' (Mustache Template
_ Text
raw) = Text
raw