{-# 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(..) )
import           Headroom.Types                 ( ApplicationError(..)
                                                , TemplateError(..)
                                                )
import           RIO
import qualified RIO.Text                      as T
import qualified Text.Mustache                 as MU
import           Text.Mustache.Render           ( SubstitutionError(..) )


-- | The /Mustache/ template.
newtype Mustache = Mustache MU.Template 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 = "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 :: HashMap Text Text -> Mustache -> m Text
renderTemplate     = HashMap Text Text -> Mustache -> m Text
forall (m :: * -> *).
MonadThrow m =>
HashMap Text Text -> Mustache -> m Text
renderTemplate'


parseTemplate' :: MonadThrow m => Maybe Text -> Text -> m Mustache
parseTemplate' :: Maybe Text -> Text -> m Mustache
parseTemplate' name :: Maybe Text
name raw :: Text
raw = case String -> Text -> Either ParseError Template
MU.compileTemplate String
templateName Text
raw of
  Left  err :: ParseError
err -> ApplicationError -> m Mustache
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ApplicationError -> m Mustache) -> ApplicationError -> m Mustache
forall a b. (a -> b) -> a -> b
$ TemplateError -> ApplicationError
TemplateError (Text -> TemplateError
ParseError (String -> Text
T.pack (String -> Text) -> (ParseError -> String) -> ParseError -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseError -> String
forall a. Show a => a -> String
show (ParseError -> Text) -> ParseError -> Text
forall a b. (a -> b) -> a -> b
$ ParseError
err))
  Right res :: 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 -> Mustache
Mustache Template
res
  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 "" (Maybe Text -> String) -> Maybe Text -> String
forall a b. (a -> b) -> a -> b
$ Maybe Text
name


renderTemplate' :: MonadThrow m => HashMap Text Text -> Mustache -> m Text
renderTemplate' :: HashMap Text Text -> Mustache -> m Text
renderTemplate' variables :: HashMap Text Text
variables (Mustache t :: Template
t@(MU.Template name :: String
name _ _)) =
  case Template -> HashMap Text Text -> ([SubstitutionError], Text)
forall k.
ToMustache k =>
Template -> k -> ([SubstitutionError], Text)
MU.checkedSubstitute Template
t HashMap Text Text
variables of
    ([], rendered :: Text
rendered) -> Text -> m Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
rendered
    (errs :: [SubstitutionError]
errs, rendered :: Text
rendered) ->
      let errs' :: [Text]
errs' = [SubstitutionError] -> [Text]
missingVariables [SubstitutionError]
errs
      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 ApplicationError -> m Text
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ApplicationError -> m Text) -> ApplicationError -> m Text
forall a b. (a -> b) -> a -> b
$ TemplateError -> ApplicationError
TemplateError (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
 where
  missingVariables :: [SubstitutionError] -> [Text]
missingVariables = (SubstitutionError -> [Text]) -> [SubstitutionError] -> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
    (\case
      (VariableNotFound ps :: [Text]
ps) -> [Text]
ps
      _                     -> []
    )