{-|
Module      : $Header$
Description : Functions for rendering mustache templates.
Copyright   : (c) Justus Adam, 2015
License     : BSD3
Maintainer  : dev@justus.science
Stability   : experimental
Portability : POSIX
-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE TypeSynonymInstances       #-}
{-# OPTIONS_GHC -fno-warn-orphans  #-}
module Text.Mustache.Render
  (
  -- * Substitution
    substitute, substituteValue
  -- * Checked substitution
  , checkedSubstitute, checkedSubstituteValue, SubstitutionError(..)
  -- * Working with Context
  , Context(..), search, innerSearch, SubM, substituteNode, substituteAST, catchSubstitute
  -- * Util
  , toString
  ) where


import           Control.Arrow                (first, second)
import           Control.Monad

import           Data.Foldable                (for_)
import           Data.HashMap.Strict          as HM hiding (keys, map)
import           Data.Maybe                   (fromMaybe)

import           Data.Scientific              (floatingOrInteger)
import           Data.Text                    as T (Text, isSuffixOf, pack,
                                                    replace, stripSuffix)
import qualified Data.Vector                  as V
import           Prelude                      hiding (length, lines, unlines)

import           Control.Monad.Reader
import           Control.Monad.Writer
import qualified Data.Text                    as T
import qualified Data.Text.Lazy               as LT
import           Text.Mustache.Internal
import           Text.Mustache.Internal.Types
import           Text.Mustache.Types


{-|
  Substitutes all mustache defined tokens (or tags) for values found in the
  provided data structure.

  Equivalent to @substituteValue . toMustache@.
-}
substitute :: ToMustache k => Template -> k -> Text
substitute :: Template -> k -> Text
substitute t :: Template
t = Template -> Value -> Text
substituteValue Template
t (Value -> Text) -> (k -> Value) -> k -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k -> Value
forall ω. ToMustache ω => ω -> Value
toMustache


{-|
  Substitutes all mustache defined tokens (or tags) for values found in the
  provided data structure and report any errors and warnings encountered during
  substitution.

  This function always produces results, as in a fully substituted/rendered template,
  it never halts on errors. It simply reports them in the first part of the tuple.
  Sites with errors are usually substituted with empty string.

  The second value in the tuple is a template rendered with errors ignored.
  Therefore if you must enforce that there were no errors during substitution
  you must check that the error list in the first tuple value is empty.

  Equivalent to @checkedSubstituteValue . toMustache@.
-}
checkedSubstitute :: ToMustache k => Template -> k -> ([SubstitutionError], Text)
checkedSubstitute :: Template -> k -> ([SubstitutionError], Text)
checkedSubstitute t :: Template
t = Template -> Value -> ([SubstitutionError], Text)
checkedSubstituteValue Template
t (Value -> ([SubstitutionError], Text))
-> (k -> Value) -> k -> ([SubstitutionError], Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k -> Value
forall ω. ToMustache ω => ω -> Value
toMustache


{-|
  Substitutes all mustache defined tokens (or tags) for values found in the
  provided data structure.
-}
substituteValue :: Template -> Value -> Text
substituteValue :: Template -> Value -> Text
substituteValue = (([SubstitutionError], Text) -> Text
forall a b. (a, b) -> b
snd (([SubstitutionError], Text) -> Text)
-> (Value -> ([SubstitutionError], Text)) -> Value -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((Value -> ([SubstitutionError], Text)) -> Value -> Text)
-> (Template -> Value -> ([SubstitutionError], Text))
-> Template
-> Value
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Template -> Value -> ([SubstitutionError], Text)
checkedSubstituteValue


{-|
  Substitutes all mustache defined tokens (or tags) for values found in the
  provided data structure and report any errors and warnings encountered during
  substitution.

  This function always produces results, as in a fully substituted/rendered template,
  it never halts on errors. It simply reports them in the first part of the tuple.
  Sites with errors are usually substituted with empty string.

  The second value in the tuple is a template rendered with errors ignored.
  Therefore if you must enforce that there were no errors during substitution
  you must check that the error list in the first tuple value is empty.
-}
checkedSubstituteValue :: Template -> Value -> ([SubstitutionError], Text)
checkedSubstituteValue :: Template -> Value -> ([SubstitutionError], Text)
checkedSubstituteValue template :: Template
template dataStruct :: Value
dataStruct =
  ([Text] -> Text)
-> ([SubstitutionError], [Text]) -> ([SubstitutionError], Text)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second [Text] -> Text
T.concat (([SubstitutionError], [Text]) -> ([SubstitutionError], Text))
-> ([SubstitutionError], [Text]) -> ([SubstitutionError], Text)
forall a b. (a -> b) -> a -> b
$ SubM ()
-> Context Value -> TemplateCache -> ([SubstitutionError], [Text])
forall a.
SubM a
-> Context Value -> TemplateCache -> ([SubstitutionError], [Text])
runSubM (STree -> SubM ()
substituteAST (Template -> STree
ast Template
template)) ([Value] -> Value -> Context Value
forall α. [α] -> α -> Context α
Context [Value]
forall a. Monoid a => a
mempty Value
dataStruct) (Template -> TemplateCache
partials Template
template)

-- | Catch the results of running the inner substitution.
catchSubstitute :: SubM a -> SubM (a, Text)
catchSubstitute :: SubM a -> SubM (a, Text)
catchSubstitute = ((a, ([SubstitutionError], [Text])) -> (a, Text))
-> SubM (a, ([SubstitutionError], [Text])) -> SubM (a, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((([SubstitutionError], [Text]) -> Text)
-> (a, ([SubstitutionError], [Text])) -> (a, Text)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ([Text] -> Text
T.concat ([Text] -> Text)
-> (([SubstitutionError], [Text]) -> [Text])
-> ([SubstitutionError], [Text])
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([SubstitutionError], [Text]) -> [Text]
forall a b. (a, b) -> b
snd)) (SubM (a, ([SubstitutionError], [Text])) -> SubM (a, Text))
-> (SubM a -> SubM (a, ([SubstitutionError], [Text])))
-> SubM a
-> SubM (a, Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RWS
  (Context Value, TemplateCache)
  ([SubstitutionError], [Text])
  ()
  (a, ([SubstitutionError], [Text]))
-> SubM (a, ([SubstitutionError], [Text]))
forall a.
RWS
  (Context Value, TemplateCache) ([SubstitutionError], [Text]) () a
-> SubM a
SubM (RWS
   (Context Value, TemplateCache)
   ([SubstitutionError], [Text])
   ()
   (a, ([SubstitutionError], [Text]))
 -> SubM (a, ([SubstitutionError], [Text])))
-> (SubM a
    -> RWS
         (Context Value, TemplateCache)
         ([SubstitutionError], [Text])
         ()
         (a, ([SubstitutionError], [Text])))
-> SubM a
-> SubM (a, ([SubstitutionError], [Text]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RWS
  (Context Value, TemplateCache)
  ([SubstitutionError], [Text])
  ()
  (a, ([SubstitutionError], [Text]))
-> RWS
     (Context Value, TemplateCache)
     ([SubstitutionError], [Text])
     ()
     (a, ([SubstitutionError], [Text]))
forall a.
RWST
  (Context Value, TemplateCache)
  ([SubstitutionError], [Text])
  ()
  Identity
  a
-> RWST
     (Context Value, TemplateCache)
     ([SubstitutionError], [Text])
     ()
     Identity
     a
hideResults (RWS
   (Context Value, TemplateCache)
   ([SubstitutionError], [Text])
   ()
   (a, ([SubstitutionError], [Text]))
 -> RWS
      (Context Value, TemplateCache)
      ([SubstitutionError], [Text])
      ()
      (a, ([SubstitutionError], [Text])))
-> (SubM a
    -> RWS
         (Context Value, TemplateCache)
         ([SubstitutionError], [Text])
         ()
         (a, ([SubstitutionError], [Text])))
-> SubM a
-> RWS
     (Context Value, TemplateCache)
     ([SubstitutionError], [Text])
     ()
     (a, ([SubstitutionError], [Text]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RWST
  (Context Value, TemplateCache)
  ([SubstitutionError], [Text])
  ()
  Identity
  a
-> RWS
     (Context Value, TemplateCache)
     ([SubstitutionError], [Text])
     ()
     (a, ([SubstitutionError], [Text]))
forall w (m :: * -> *) a. MonadWriter w m => m a -> m (a, w)
listen (RWST
   (Context Value, TemplateCache)
   ([SubstitutionError], [Text])
   ()
   Identity
   a
 -> RWS
      (Context Value, TemplateCache)
      ([SubstitutionError], [Text])
      ()
      (a, ([SubstitutionError], [Text])))
-> (SubM a
    -> RWST
         (Context Value, TemplateCache)
         ([SubstitutionError], [Text])
         ()
         Identity
         a)
-> SubM a
-> RWS
     (Context Value, TemplateCache)
     ([SubstitutionError], [Text])
     ()
     (a, ([SubstitutionError], [Text]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SubM a
-> RWST
     (Context Value, TemplateCache)
     ([SubstitutionError], [Text])
     ()
     Identity
     a
forall a.
SubM a
-> RWS
     (Context Value, TemplateCache) ([SubstitutionError], [Text]) () a
runSubM'
  where
    hideResults :: RWST
  (Context Value, TemplateCache)
  ([SubstitutionError], [Text])
  ()
  Identity
  a
-> RWST
     (Context Value, TemplateCache)
     ([SubstitutionError], [Text])
     ()
     Identity
     a
hideResults = (([SubstitutionError], [Text]) -> ([SubstitutionError], [Text]))
-> RWST
     (Context Value, TemplateCache)
     ([SubstitutionError], [Text])
     ()
     Identity
     a
-> RWST
     (Context Value, TemplateCache)
     ([SubstitutionError], [Text])
     ()
     Identity
     a
forall w (m :: * -> *) a. MonadWriter w m => (w -> w) -> m a -> m a
censor (\(errs :: [SubstitutionError]
errs, _) -> ([SubstitutionError]
errs, []))

-- | Substitute an entire 'STree' rather than just a single 'Node'
substituteAST :: STree -> SubM ()
substituteAST :: STree -> SubM ()
substituteAST = (Node Text -> SubM ()) -> STree -> SubM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Node Text -> SubM ()
substituteNode


-- | Main substitution function
substituteNode :: Node Text -> SubM ()

-- subtituting text
substituteNode :: Node Text -> SubM ()
substituteNode (TextBlock t :: Text
t) = Text -> SubM ()
tellSuccess Text
t

-- substituting a whole section (entails a focus shift)
substituteNode (Section Implicit secSTree :: STree
secSTree) =
  ((Context Value, TemplateCache) -> Context Value)
-> SubM (Context Value)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Context Value, TemplateCache) -> Context Value
forall a b. (a, b) -> a
fst SubM (Context Value) -> (Context Value -> SubM ()) -> SubM ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Context parents :: [Value]
parents focus :: Value
focus@(Array a :: Array
a)
      | Array -> Bool
forall a. Vector a -> Bool
V.null Array
a  -> () -> SubM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      | Bool
otherwise -> Array -> (Value -> SubM ()) -> SubM ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Array
a ((Value -> SubM ()) -> SubM ()) -> (Value -> SubM ()) -> SubM ()
forall a b. (a -> b) -> a -> b
$ \focus' :: Value
focus' ->
        let newContext :: Context Value
newContext = [Value] -> Value -> Context Value
forall α. [α] -> α -> Context α
Context (Value
focusValue -> [Value] -> [Value]
forall a. a -> [a] -> [a]
:[Value]
parents) Value
focus'
        in Context Value -> SubM () -> SubM ()
forall a. Context Value -> SubM a -> SubM a
shiftContext Context Value
newContext (SubM () -> SubM ()) -> SubM () -> SubM ()
forall a b. (a -> b) -> a -> b
$ STree -> SubM ()
substituteAST STree
secSTree
    Context _ (Object _) -> STree -> SubM ()
substituteAST STree
secSTree
    Context _ v :: Value
v -> SubstitutionError -> SubM ()
tellError (SubstitutionError -> SubM ()) -> SubstitutionError -> SubM ()
forall a b. (a -> b) -> a -> b
$ String -> SubstitutionError
InvalidImplicitSectionContextType (String -> SubstitutionError) -> String -> SubstitutionError
forall a b. (a -> b) -> a -> b
$ Value -> String
showValueType Value
v

substituteNode (Section (NamedData secName :: [Text]
secName) secSTree :: STree
secSTree) =
  [Text] -> SubM (Maybe Value)
search [Text]
secName SubM (Maybe Value) -> (Maybe Value -> SubM ()) -> SubM ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just arr :: Value
arr@(Array arrCont :: Array
arrCont) ->
      if Array -> Bool
forall a. Vector a -> Bool
V.null Array
arrCont
        then () -> SubM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        else do
          Context parents :: [Value]
parents focus :: Value
focus <- ((Context Value, TemplateCache) -> Context Value)
-> SubM (Context Value)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Context Value, TemplateCache) -> Context Value
forall a b. (a, b) -> a
fst
          Array -> (Value -> SubM ()) -> SubM ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Array
arrCont ((Value -> SubM ()) -> SubM ()) -> (Value -> SubM ()) -> SubM ()
forall a b. (a -> b) -> a -> b
$ \focus' :: Value
focus' ->
            let newContext :: Context Value
newContext = [Value] -> Value -> Context Value
forall α. [α] -> α -> Context α
Context (Value
arrValue -> [Value] -> [Value]
forall a. a -> [a] -> [a]
:Value
focusValue -> [Value] -> [Value]
forall a. a -> [a] -> [a]
:[Value]
parents) Value
focus'
            in Context Value -> SubM () -> SubM ()
forall a. Context Value -> SubM a -> SubM a
shiftContext Context Value
newContext (SubM () -> SubM ()) -> SubM () -> SubM ()
forall a b. (a -> b) -> a -> b
$ STree -> SubM ()
substituteAST STree
secSTree
    Just (Bool False) -> () -> SubM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Just Null         -> () -> SubM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Just (Lambda l :: STree -> SubM STree
l)   -> STree -> SubM ()
substituteAST (STree -> SubM ()) -> SubM STree -> SubM ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< STree -> SubM STree
l STree
secSTree
    Just focus' :: Value
focus'       -> do
      Context parents :: [Value]
parents focus :: Value
focus <- ((Context Value, TemplateCache) -> Context Value)
-> SubM (Context Value)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Context Value, TemplateCache) -> Context Value
forall a b. (a, b) -> a
fst
      let newContext :: Context Value
newContext = [Value] -> Value -> Context Value
forall α. [α] -> α -> Context α
Context (Value
focusValue -> [Value] -> [Value]
forall a. a -> [a] -> [a]
:[Value]
parents) Value
focus'
      Context Value -> SubM () -> SubM ()
forall a. Context Value -> SubM a -> SubM a
shiftContext Context Value
newContext (SubM () -> SubM ()) -> SubM () -> SubM ()
forall a b. (a -> b) -> a -> b
$ STree -> SubM ()
substituteAST STree
secSTree
    Nothing -> SubstitutionError -> SubM ()
tellError (SubstitutionError -> SubM ()) -> SubstitutionError -> SubM ()
forall a b. (a -> b) -> a -> b
$ [Text] -> SubstitutionError
SectionTargetNotFound [Text]
secName

-- substituting an inverted section
substituteNode (InvertedSection  Implicit _) = SubstitutionError -> SubM ()
tellError SubstitutionError
InvertedImplicitSection
substituteNode (InvertedSection (NamedData secName :: [Text]
secName) invSecSTree :: STree
invSecSTree) =
  [Text] -> SubM (Maybe Value)
search [Text]
secName SubM (Maybe Value) -> (Maybe Value -> SubM ()) -> SubM ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just (Bool False) -> SubM ()
contents
    Just (Array a :: Array
a)    | Array -> Bool
forall a. Vector a -> Bool
V.null Array
a -> SubM ()
contents
    Nothing           -> SubM ()
contents
    _                 -> () -> SubM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  where
    contents :: SubM ()
contents = (Node Text -> SubM ()) -> STree -> SubM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Node Text -> SubM ()
substituteNode STree
invSecSTree

-- substituting a variable
substituteNode (Variable _ Implicit) = ((Context Value, TemplateCache) -> Value) -> SubM Value
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Context Value -> Value
forall α. Context α -> α
ctxtFocus (Context Value -> Value)
-> ((Context Value, TemplateCache) -> Context Value)
-> (Context Value, TemplateCache)
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Context Value, TemplateCache) -> Context Value
forall a b. (a, b) -> a
fst) SubM Value -> (Value -> SubM Text) -> SubM Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> SubM Text
toString SubM Text -> (Text -> SubM ()) -> SubM ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> SubM ()
tellSuccess
substituteNode (Variable escaped :: Bool
escaped (NamedData varName :: [Text]
varName)) =
  SubM () -> (Value -> SubM ()) -> Maybe Value -> SubM ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
    (SubstitutionError -> SubM ()
tellError (SubstitutionError -> SubM ()) -> SubstitutionError -> SubM ()
forall a b. (a -> b) -> a -> b
$ [Text] -> SubstitutionError
VariableNotFound [Text]
varName)
    (Value -> SubM Text
toString (Value -> SubM Text) -> (Text -> SubM ()) -> Value -> SubM ()
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Text -> SubM ()
tellSuccess (Text -> SubM ()) -> (Text -> Text) -> Text -> SubM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (if Bool
escaped then Text -> Text
escapeXMLText else Text -> Text
forall a. a -> a
id))
    (Maybe Value -> SubM ()) -> SubM (Maybe Value) -> SubM ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [Text] -> SubM (Maybe Value)
search [Text]
varName

-- substituting a partial
substituteNode (Partial indent :: Maybe Text
indent pName :: String
pName) = do
  TemplateCache
cPartials <- ((Context Value, TemplateCache) -> TemplateCache)
-> SubM TemplateCache
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Context Value, TemplateCache) -> TemplateCache
forall a b. (a, b) -> b
snd
  case String -> TemplateCache -> Maybe Template
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup String
pName TemplateCache
cPartials of
    Nothing -> SubstitutionError -> SubM ()
tellError (SubstitutionError -> SubM ()) -> SubstitutionError -> SubM ()
forall a b. (a -> b) -> a -> b
$ String -> SubstitutionError
PartialNotFound String
pName
    Just t :: Template
t ->
      let ast' :: STree
ast' = Maybe Text -> STree -> STree
handleIndent Maybe Text
indent (STree -> STree) -> STree -> STree
forall a b. (a -> b) -> a -> b
$ Template -> STree
ast Template
t
      in ((Context Value, TemplateCache) -> (Context Value, TemplateCache))
-> SubM () -> SubM ()
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local ((TemplateCache -> TemplateCache)
-> (Context Value, TemplateCache) -> (Context Value, TemplateCache)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (Template -> TemplateCache
partials Template
t TemplateCache -> TemplateCache -> TemplateCache
forall k v.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k v -> HashMap k v
`HM.union`)) (SubM () -> SubM ()) -> SubM () -> SubM ()
forall a b. (a -> b) -> a -> b
$ STree -> SubM ()
substituteAST STree
ast'


showValueType :: Value -> String
showValueType :: Value -> String
showValueType Null       = "Null"
showValueType (Object _) = "Object"
showValueType (Array _)  = "Array"
showValueType (String _) = "String"
showValueType (Lambda _) = "Lambda"
showValueType (Number _) = "Number"
showValueType (Bool _)   = "Bool"


handleIndent :: Maybe Text -> STree -> STree
handleIndent :: Maybe Text -> STree -> STree
handleIndent Nothing ast' :: STree
ast' = STree
ast'
handleIndent (Just indentation :: Text
indentation) ast' :: STree
ast' = STree
preface STree -> STree -> STree
forall a. Semigroup a => a -> a -> a
<> STree
content
  where
    preface :: STree
preface = if Text -> Bool
T.null Text
indentation then [] else [Text -> Node Text
forall α. α -> Node α
TextBlock Text
indentation]
    content :: STree
content = if Text -> Bool
T.null Text
indentation
      then STree
ast'
      else STree -> STree
forall a. [a] -> [a]
reverse (STree -> STree) -> STree -> STree
forall a b. (a -> b) -> a -> b
$ STree -> Maybe STree -> STree
forall a. a -> Maybe a -> a
fromMaybe [] ((Node Text -> STree -> STree) -> (Node Text, STree) -> STree
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (:) ((Node Text, STree) -> STree)
-> ((Node Text, STree) -> (Node Text, STree))
-> (Node Text, STree)
-> STree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Node Text -> Node Text)
-> (Node Text, STree) -> (Node Text, STree)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Node Text -> Node Text
dropper ((Node Text, STree) -> STree)
-> Maybe (Node Text, STree) -> Maybe STree
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> STree -> Maybe (Node Text, STree)
forall α. [α] -> Maybe (α, [α])
uncons (STree -> STree
forall a. [a] -> [a]
reverse STree
fullIndented))
      where
        fullIndented :: STree
fullIndented = (Node Text -> Node Text) -> STree -> STree
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Node Text -> Node Text
indentBy Text
indentation) STree
ast'
        dropper :: Node Text -> Node Text
dropper (TextBlock t :: Text
t) = Text -> Node Text
forall α. α -> Node α
TextBlock (Text -> Node Text) -> Text -> Node Text
forall a b. (a -> b) -> a -> b
$
          if ("\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
indentation) Text -> Text -> Bool
`isSuffixOf` Text
t
            then Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
t (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Maybe Text
stripSuffix Text
indentation Text
t
            else Text
t
        dropper a :: Node Text
a = Node Text
a

indentBy :: Text -> Node Text -> Node Text
indentBy :: Text -> Node Text -> Node Text
indentBy indent :: Text
indent p :: Node Text
p@(Partial (Just indent' :: Text
indent') name' :: String
name')
  | Text -> Bool
T.null Text
indent = Node Text
p
  | Bool
otherwise = Maybe Text -> String -> Node Text
forall α. Maybe α -> String -> Node α
Partial (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text
indent Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
indent')) String
name'
indentBy indent :: Text
indent (Partial Nothing name' :: String
name') = Maybe Text -> String -> Node Text
forall α. Maybe α -> String -> Node α
Partial (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
indent) String
name'
indentBy indent :: Text
indent (TextBlock t :: Text
t) = Text -> Node Text
forall α. α -> Node α
TextBlock (Text -> Node Text) -> Text -> Node Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> Text
replace "\n" ("\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
indent) Text
t
indentBy _ a :: Node Text
a = Node Text
a



-- | Converts values to Text as required by the mustache standard
toString :: Value -> SubM Text
toString :: Value -> SubM Text
toString (String t :: Text
t) = Text -> SubM Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
t
toString (Number n :: Scientific
n) = Text -> SubM Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> SubM Text) -> Text -> SubM Text
forall a b. (a -> b) -> a -> b
$ (Double -> Text)
-> (Integer -> Text) -> Either Double Integer -> Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Text
pack (String -> Text) -> (Double -> String) -> Double -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> String
forall a. Show a => a -> String
show) (String -> Text
pack (String -> Text) -> (Integer -> String) -> Integer -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> String
forall a. Show a => a -> String
show) (Scientific -> Either Double Integer
forall r i. (RealFloat r, Integral i) => Scientific -> Either r i
floatingOrInteger Scientific
n :: Either Double Integer)
toString (Lambda l :: STree -> SubM STree
l) = do
  ((), res :: Text
res) <- SubM () -> SubM ((), Text)
forall a. SubM a -> SubM (a, Text)
catchSubstitute (SubM () -> SubM ((), Text)) -> SubM () -> SubM ((), Text)
forall a b. (a -> b) -> a -> b
$ STree -> SubM ()
substituteAST (STree -> SubM ()) -> SubM STree -> SubM ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< STree -> SubM STree
l []
  Text -> SubM Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
res
toString e :: Value
e          = do
  SubstitutionError -> SubM ()
tellError (SubstitutionError -> SubM ()) -> SubstitutionError -> SubM ()
forall a b. (a -> b) -> a -> b
$ Value -> SubstitutionError
DirectlyRenderedValue Value
e
  Text -> SubM Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> SubM Text) -> Text -> SubM Text
forall a b. (a -> b) -> a -> b
$ String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Value -> String
forall a. Show a => a -> String
show Value
e


instance ToMustache (Context Value -> STree -> STree) where
  toMustache :: (Context Value -> STree -> STree) -> Value
toMustache f :: Context Value -> STree -> STree
f = (STree -> SubM STree) -> Value
Lambda ((STree -> SubM STree) -> Value) -> (STree -> SubM STree) -> Value
forall a b. (a -> b) -> a -> b
$ ((Context Value -> STree) -> SubM (Context Value) -> SubM STree
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SubM (Context Value)
askContext) ((Context Value -> STree) -> SubM STree)
-> (STree -> Context Value -> STree) -> STree -> SubM STree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Context Value -> STree -> STree)
-> STree -> Context Value -> STree
forall a b c. (a -> b -> c) -> b -> a -> c
flip Context Value -> STree -> STree
f

instance ToMustache (Context Value -> STree -> Text) where
  toMustache :: (Context Value -> STree -> Text) -> Value
toMustache = (Text -> Text) -> (Context Value -> STree -> Text) -> Value
forall r. (r -> Text) -> (Context Value -> STree -> r) -> Value
lambdaHelper Text -> Text
forall a. a -> a
id

instance ToMustache (Context Value -> STree -> LT.Text) where
  toMustache :: (Context Value -> STree -> Text) -> Value
toMustache = (Text -> Text) -> (Context Value -> STree -> Text) -> Value
forall r. (r -> Text) -> (Context Value -> STree -> r) -> Value
lambdaHelper Text -> Text
LT.toStrict

instance ToMustache (Context Value -> STree -> String) where
  toMustache :: (Context Value -> STree -> String) -> Value
toMustache = (String -> Text) -> (Context Value -> STree -> String) -> Value
forall r. (r -> Text) -> (Context Value -> STree -> r) -> Value
lambdaHelper String -> Text
pack

lambdaHelper :: (r -> Text) -> (Context Value -> STree -> r) -> Value
lambdaHelper :: (r -> Text) -> (Context Value -> STree -> r) -> Value
lambdaHelper conv :: r -> Text
conv f :: Context Value -> STree -> r
f = (STree -> SubM STree) -> Value
Lambda ((STree -> SubM STree) -> Value) -> (STree -> SubM STree) -> Value
forall a b. (a -> b) -> a -> b
$ ((Context Value -> STree) -> SubM (Context Value) -> SubM STree
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SubM (Context Value)
askContext) ((Context Value -> STree) -> SubM STree)
-> (STree -> Context Value -> STree) -> STree -> SubM STree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. STree -> Context Value -> STree
wrapper
  where
    wrapper ::  STree -> Context Value -> STree
    wrapper :: STree -> Context Value -> STree
wrapper lSTree :: STree
lSTree c :: Context Value
c = [Text -> Node Text
forall α. α -> Node α
TextBlock (Text -> Node Text) -> Text -> Node Text
forall a b. (a -> b) -> a -> b
$ r -> Text
conv (r -> Text) -> r -> Text
forall a b. (a -> b) -> a -> b
$ Context Value -> STree -> r
f Context Value
c STree
lSTree]

instance ToMustache (STree -> SubM Text) where
  toMustache :: (STree -> SubM Text) -> Value
toMustache f :: STree -> SubM Text
f = (STree -> SubM STree) -> Value
Lambda ((Text -> STree) -> SubM Text -> SubM STree
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Node Text -> STree
forall (m :: * -> *) a. Monad m => a -> m a
return (Node Text -> STree) -> (Text -> Node Text) -> Text -> STree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Node Text
forall α. α -> Node α
TextBlock) (SubM Text -> SubM STree)
-> (STree -> SubM Text) -> STree -> SubM STree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. STree -> SubM Text
f)