{-|
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 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 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 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 (\([SubstitutionError]
errs, [Text]
_) -> ([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 Text
t) = Text -> SubM ()
tellSuccess Text
t

-- substituting a whole section (entails a focus shift)
substituteNode (Section DataIdentifier
Implicit 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 [Value]
parents focus :: Value
focus@(Array 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
$ \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 [Value]
_ (Object Object
_) -> STree -> SubM ()
substituteAST STree
secSTree
    Context [Value]
_ 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 [Text]
secName) 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 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 [Value]
parents 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
$ \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 Bool
False) -> () -> SubM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Just Value
Null         -> () -> SubM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Just (Lambda 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 Value
focus'       -> do
      Context [Value]
parents 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
    Maybe Value
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  DataIdentifier
Implicit STree
_) = SubstitutionError -> SubM ()
tellError SubstitutionError
InvertedImplicitSection
substituteNode (InvertedSection (NamedData [Text]
secName) 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 Bool
False) -> SubM ()
contents
    Just (Array Array
a)    | Array -> Bool
forall a. Vector a -> Bool
V.null Array
a -> SubM ()
contents
    Maybe Value
Nothing           -> SubM ()
contents
    Maybe Value
_                 -> () -> 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 Bool
_ DataIdentifier
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 Bool
escaped (NamedData [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 Maybe Text
indent 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
    Maybe Template
Nothing -> SubstitutionError -> SubM ()
tellError (SubstitutionError -> SubM ()) -> SubstitutionError -> SubM ()
forall a b. (a -> b) -> a -> b
$ String -> SubstitutionError
PartialNotFound String
pName
    Just 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 Value
Null       = String
"Null"
showValueType (Object Object
_) = String
"Object"
showValueType (Array Array
_)  = String
"Array"
showValueType (String Text
_) = String
"String"
showValueType (Lambda STree -> SubM STree
_) = String
"Lambda"
showValueType (Number Scientific
_) = String
"Number"
showValueType (Bool Bool
_)   = String
"Bool"


handleIndent :: Maybe Text -> STree -> STree
handleIndent :: Maybe Text -> STree -> STree
handleIndent Maybe Text
Nothing STree
ast' = STree
ast'
handleIndent (Just Text
indentation) 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 Text
t) = Text -> Node Text
forall α. α -> Node α
TextBlock (Text -> Node Text) -> Text -> Node Text
forall a b. (a -> b) -> a -> b
$
          if (Text
"\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 Node Text
a = Node Text
a

indentBy :: Text -> Node Text -> Node Text
indentBy :: Text -> Node Text -> Node Text
indentBy Text
indent p :: Node Text
p@(Partial (Just Text
indent') 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 Text
indent (Partial Maybe Text
Nothing 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 Text
indent (TextBlock 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 Text
"\n" (Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
indent) Text
t
indentBy Text
_ 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 Text
t) = Text -> SubM Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
t
toString (Number 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 STree -> SubM STree
l) = do
  ((), 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 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 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 r -> Text
conv 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 STree
lSTree 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 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)