-- |
-- Module      :  Text.Microstache.Render
-- Copyright   :  © 2016–2017 Stack Builders
-- License     :  BSD 3 clause
--
-- Maintainer  :  Mark Karpov <markkarpov@openmailbox.org>
-- Stability   :  experimental
-- Portability :  portable
--
-- Functions for rendering Mustache templates. You don't usually need to
-- import the module, because "Text.Microstache" re-exports everything you may
-- need, import that module instead.

{-# LANGUAGE CPP               #-}
{-# LANGUAGE OverloadedStrings #-}
module Text.Microstache.Render
  ( renderMustache, renderMustacheW )
where

import Control.Monad              (forM_, unless, when)
import Control.Monad.Trans.Class  (lift)
import Control.Monad.Trans.Reader (ReaderT (..), asks, local)
import Data.Aeson                 (Value (..), encode)
import Data.Foldable              (asum)
import Data.List                  (tails)
import Data.List.NonEmpty         (NonEmpty (..))
import Data.Monoid                (mempty)
import Data.Semigroup             ((<>))
import Data.Text                  (Text)
import Data.Word                  (Word)
import Text.Microstache.Type

import qualified Data.List.NonEmpty      as NE
import qualified Data.Map                as Map
import qualified Data.Text               as T
import qualified Data.Text.Lazy          as LT
import qualified Data.Text.Lazy.Builder  as B
import qualified Data.Text.Lazy.Encoding as LTE
import qualified Data.Vector             as V

#if MIN_VERSION_aeson(2,0,0)
import qualified Data.Aeson.KeyMap as KM
import qualified Data.Aeson.Key as Key
#else
import qualified Data.HashMap.Strict as KM
#endif

#if MIN_VERSION_transformers(0,4,0)
import Control.Monad.Trans.State.Strict (State, execState, modify')
#else
import Control.Monad.Trans.State.Strict (State, execState, get, put)
#endif

#if !MIN_VERSION_base(4,8,0)
import Control.Applicative
#endif

#if !(MIN_VERSION_transformers(0,4,0))
modify' :: (s -> s) -> State s ()
modify' f = do
    s <- get
    put $! f s
#endif

----------------------------------------------------------------------------
-- The rendering monad

-- | Synonym for the monad we use for rendering. It allows to share context
-- and accumulate the result as 'B.Builder' data which is then turned into
-- lazy 'LT.Text'.

type Render a = ReaderT RenderContext (State S) a

data S = S ([MustacheWarning] -> [MustacheWarning]) B.Builder

tellWarning :: MustacheWarning -> Render ()
tellWarning :: MustacheWarning -> Render ()
tellWarning MustacheWarning
w = StateT S Identity () -> Render ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ((S -> S) -> StateT S Identity ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify' S -> S
f) where
    f :: S -> S
f (S [MustacheWarning] -> [MustacheWarning]
ws Builder
b) = ([MustacheWarning] -> [MustacheWarning]) -> Builder -> S
S ([MustacheWarning] -> [MustacheWarning]
ws ([MustacheWarning] -> [MustacheWarning])
-> ([MustacheWarning] -> [MustacheWarning])
-> [MustacheWarning]
-> [MustacheWarning]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MustacheWarning
wMustacheWarning -> [MustacheWarning] -> [MustacheWarning]
forall a. a -> [a] -> [a]
:)) Builder
b

tellBuilder :: B.Builder -> Render ()
tellBuilder :: Builder -> Render ()
tellBuilder Builder
b' = StateT S Identity () -> Render ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ((S -> S) -> StateT S Identity ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify' S -> S
f) where
    f :: S -> S
f (S [MustacheWarning] -> [MustacheWarning]
ws Builder
b) = ([MustacheWarning] -> [MustacheWarning]) -> Builder -> S
S [MustacheWarning] -> [MustacheWarning]
ws (Builder
b Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
b')

-- | The render monad context.
data RenderContext = RenderContext
  { RenderContext -> Maybe Word
rcIndent   :: Maybe Word     -- ^ Actual indentation level
  , RenderContext -> NonEmpty Value
rcContext  :: NonEmpty Value -- ^ The context stack
  , RenderContext -> Key
rcPrefix   :: Key            -- ^ Prefix accumulated by entering sections
  , RenderContext -> Template
rcTemplate :: Template       -- ^ The template to render
  , RenderContext -> Bool
rcLastNode :: Bool           -- ^ Is this last node in this partial?
  }

----------------------------------------------------------------------------
-- High-level interface

-- | Render a Mustache 'Template' using Aeson's 'Value' to get actual values
-- for interpolation.
renderMustache :: Template -> Value -> LT.Text
renderMustache :: Template -> Value -> Text
renderMustache Template
t = ([MustacheWarning], Text) -> Text
forall a b. (a, b) -> b
snd (([MustacheWarning], Text) -> Text)
-> (Value -> ([MustacheWarning], Text)) -> Value -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Template -> Value -> ([MustacheWarning], Text)
renderMustacheW Template
t

-- | Like 'renderMustache' but also return a list of warnings.
--
-- @since 1.0.1
renderMustacheW :: Template -> Value -> ([MustacheWarning], LT.Text)
renderMustacheW :: Template -> Value -> ([MustacheWarning], Text)
renderMustacheW Template
t =
  Render () -> Template -> Value -> ([MustacheWarning], Text)
forall a.
Render a -> Template -> Value -> ([MustacheWarning], Text)
runRender (PName -> Maybe Word -> (Node -> Render ()) -> Render ()
renderPartial (Template -> PName
templateActual Template
t) Maybe Word
forall a. Maybe a
Nothing Node -> Render ()
renderNode) Template
t

-- | Render a single 'Node'.

renderNode :: Node -> Render ()
renderNode :: Node -> Render ()
renderNode (TextBlock Text
txt) = Text -> Render ()
outputIndented Text
txt
renderNode (EscapedVar Key
k) =
  Key -> Render Value
lookupKey Key
k Render Value
-> (Value -> ReaderT RenderContext (State S) Text)
-> ReaderT RenderContext (State S) Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Key -> Value -> ReaderT RenderContext (State S) Text
renderValue Key
k ReaderT RenderContext (State S) Text
-> (Text -> Render ()) -> Render ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Render ()
outputRaw (Text -> Render ()) -> (Text -> Text) -> Text -> Render ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
escapeHtml
renderNode (UnescapedVar Key
k) =
  Key -> Render Value
lookupKey Key
k Render Value
-> (Value -> ReaderT RenderContext (State S) Text)
-> ReaderT RenderContext (State S) Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Key -> Value -> ReaderT RenderContext (State S) Text
renderValue Key
k ReaderT RenderContext (State S) Text
-> (Text -> Render ()) -> Render ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Render ()
outputRaw
renderNode (Section Key
k [Node]
ns) = do
  Value
val <- Key -> Render Value
lookupKey Key
k
  Key -> Render () -> Render ()
forall a. Key -> Render a -> Render a
enterSection Key
k (Render () -> Render ()) -> Render () -> Render ()
forall a b. (a -> b) -> a -> b
$
    Bool -> Render () -> Render ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Value -> Bool
isBlank Value
val) (Render () -> Render ()) -> Render () -> Render ()
forall a b. (a -> b) -> a -> b
$
      case Value
val of
        Array Array
xs ->
          [Value] -> (Value -> Render ()) -> Render ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Array -> [Value]
forall a. Vector a -> [a]
V.toList Array
xs) ((Value -> Render ()) -> Render ())
-> (Value -> Render ()) -> Render ()
forall a b. (a -> b) -> a -> b
$ \Value
x ->
            Value -> Render () -> Render ()
forall a. Value -> Render a -> Render a
addToLocalContext Value
x ((Node -> Render ()) -> [Node] -> Render ()
renderMany Node -> Render ()
renderNode [Node]
ns)
        Value
_ ->
          Value -> Render () -> Render ()
forall a. Value -> Render a -> Render a
addToLocalContext Value
val ((Node -> Render ()) -> [Node] -> Render ()
renderMany Node -> Render ()
renderNode [Node]
ns)
renderNode (InvertedSection Key
k [Node]
ns) = do
  Value
val <- Key -> Render Value
lookupKey Key
k
  Bool -> Render () -> Render ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Value -> Bool
isBlank Value
val) (Render () -> Render ()) -> Render () -> Render ()
forall a b. (a -> b) -> a -> b
$
    (Node -> Render ()) -> [Node] -> Render ()
renderMany Node -> Render ()
renderNode [Node]
ns
renderNode (Partial PName
pname Maybe Word
indent) =
  PName -> Maybe Word -> (Node -> Render ()) -> Render ()
renderPartial PName
pname Maybe Word
indent Node -> Render ()
renderNode

----------------------------------------------------------------------------
-- The rendering monad vocabulary

-- | Run 'Render' monad given template to render and a 'Value' to take
-- values from.

runRender :: Render a -> Template -> Value -> ([MustacheWarning], LT.Text)
runRender :: Render a -> Template -> Value -> ([MustacheWarning], Text)
runRender Render a
m Template
t Value
v = case State S a -> S -> S
forall s a. State s a -> s -> s
execState (Render a -> RenderContext -> State S a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT Render a
m RenderContext
rc) (([MustacheWarning] -> [MustacheWarning]) -> Builder -> S
S [MustacheWarning] -> [MustacheWarning]
forall a. a -> a
id Builder
forall a. Monoid a => a
mempty) of
    S [MustacheWarning] -> [MustacheWarning]
ws Builder
b -> ([MustacheWarning] -> [MustacheWarning]
ws [], Builder -> Text
B.toLazyText Builder
b)
  where
    rc :: RenderContext
rc = RenderContext :: Maybe Word
-> NonEmpty Value -> Key -> Template -> Bool -> RenderContext
RenderContext
      { rcIndent :: Maybe Word
rcIndent   = Maybe Word
forall a. Maybe a
Nothing
      , rcContext :: NonEmpty Value
rcContext  = Value
v Value -> [Value] -> NonEmpty Value
forall a. a -> [a] -> NonEmpty a
:| []
      , rcPrefix :: Key
rcPrefix   = Key
forall a. Monoid a => a
mempty
      , rcTemplate :: Template
rcTemplate = Template
t
      , rcLastNode :: Bool
rcLastNode = Bool
True
      }
{-# INLINE runRender #-}

-- | Output a piece of strict 'Text'.

outputRaw :: Text -> Render ()
outputRaw :: Text -> Render ()
outputRaw = Builder -> Render ()
tellBuilder (Builder -> Render ()) -> (Text -> Builder) -> Text -> Render ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Builder
B.fromText
{-# INLINE outputRaw #-}

-- | Output indentation consisting of appropriate number of spaces.

outputIndent :: Render ()
outputIndent :: Render ()
outputIndent = (RenderContext -> Maybe Word)
-> ReaderT RenderContext (State S) (Maybe Word)
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks RenderContext -> Maybe Word
rcIndent ReaderT RenderContext (State S) (Maybe Word)
-> (Maybe Word -> Render ()) -> Render ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Render ()
outputRaw (Text -> Render ())
-> (Maybe Word -> Text) -> Maybe Word -> Render ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Word -> Text
buildIndent
{-# INLINE outputIndent #-}

-- | Output piece of strict 'Text' with added indentation.

outputIndented :: Text -> Render ()
outputIndented :: Text -> Render ()
outputIndented Text
txt = do
  Maybe Word
level <- (RenderContext -> Maybe Word)
-> ReaderT RenderContext (State S) (Maybe Word)
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks RenderContext -> Maybe Word
rcIndent
  Bool
lnode <- (RenderContext -> Bool) -> ReaderT RenderContext (State S) Bool
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks RenderContext -> Bool
rcLastNode
  let f :: Text -> Render ()
f Text
x = Text -> Render ()
outputRaw (Text -> Text -> Text -> Text
T.replace Text
"\n" (Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Maybe Word -> Text
buildIndent Maybe Word
level) Text
x)
  if Bool
lnode Bool -> Bool -> Bool
&& Text -> Text -> Bool
T.isSuffixOf Text
"\n" Text
txt
    then Text -> Render ()
f (Text -> Text
T.init Text
txt) Render () -> Render () -> Render ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> Render ()
outputRaw Text
"\n"
    else Text -> Render ()
f Text
txt
{-# INLINE outputIndented #-}

-- | Render a partial.

renderPartial
  :: PName             -- ^ Name of partial to render
  -> Maybe Word         -- ^ Indentation level to use
  -> (Node -> Render ()) -- ^ How to render nodes in that partial
  -> Render ()
renderPartial :: PName -> Maybe Word -> (Node -> Render ()) -> Render ()
renderPartial PName
pname Maybe Word
i Node -> Render ()
f =
  (RenderContext -> RenderContext) -> Render () -> Render ()
forall r (m :: * -> *) a.
(r -> r) -> ReaderT r m a -> ReaderT r m a
local RenderContext -> RenderContext
u (Render ()
outputIndent Render ()
-> ReaderT RenderContext (State S) [Node]
-> ReaderT RenderContext (State S) [Node]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ReaderT RenderContext (State S) [Node]
getNodes ReaderT RenderContext (State S) [Node]
-> ([Node] -> Render ()) -> Render ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Node -> Render ()) -> [Node] -> Render ()
renderMany Node -> Render ()
f)
  where
    u :: RenderContext -> RenderContext
u RenderContext
rc = RenderContext
rc
      { rcIndent :: Maybe Word
rcIndent   = Maybe Word -> Maybe Word -> Maybe Word
addIndents Maybe Word
i (RenderContext -> Maybe Word
rcIndent RenderContext
rc)
      , rcPrefix :: Key
rcPrefix   = Key
forall a. Monoid a => a
mempty
      , rcTemplate :: Template
rcTemplate = (RenderContext -> Template
rcTemplate RenderContext
rc) { templateActual :: PName
templateActual = PName
pname }
      , rcLastNode :: Bool
rcLastNode = Bool
True }
{-# INLINE renderPartial #-}

-- | Get collection of 'Node's for actual template.

getNodes :: Render [Node]
getNodes :: ReaderT RenderContext (State S) [Node]
getNodes = do
  Template PName
actual Map PName [Node]
cache <- (RenderContext -> Template)
-> ReaderT RenderContext (State S) Template
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks RenderContext -> Template
rcTemplate
  [Node] -> ReaderT RenderContext (State S) [Node]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Node] -> PName -> Map PName [Node] -> [Node]
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault [] PName
actual Map PName [Node]
cache)
{-# INLINE getNodes #-}

-- | Render many nodes.

renderMany
  :: (Node -> Render ()) -- ^ How to render a node
  -> [Node]            -- ^ The collection of nodes to render
  -> Render ()
renderMany :: (Node -> Render ()) -> [Node] -> Render ()
renderMany Node -> Render ()
_ [] = () -> Render ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
renderMany Node -> Render ()
f [Node
n] = do
  Bool
ln <- (RenderContext -> Bool) -> ReaderT RenderContext (State S) Bool
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks RenderContext -> Bool
rcLastNode
  (RenderContext -> RenderContext) -> Render () -> Render ()
forall r (m :: * -> *) a.
(r -> r) -> ReaderT r m a -> ReaderT r m a
local (\RenderContext
rc -> RenderContext
rc { rcLastNode :: Bool
rcLastNode = Bool
ln Bool -> Bool -> Bool
&& RenderContext -> Bool
rcLastNode RenderContext
rc }) (Node -> Render ()
f Node
n)
renderMany Node -> Render ()
f (Node
n:[Node]
ns) = do
  (RenderContext -> RenderContext) -> Render () -> Render ()
forall r (m :: * -> *) a.
(r -> r) -> ReaderT r m a -> ReaderT r m a
local (\RenderContext
rc -> RenderContext
rc { rcLastNode :: Bool
rcLastNode = Bool
False }) (Node -> Render ()
f Node
n)
  (Node -> Render ()) -> [Node] -> Render ()
renderMany Node -> Render ()
f [Node]
ns

-- | Lookup a 'Value' by its 'Key'.

lookupKey :: Key -> Render Value
lookupKey :: Key -> Render Value
lookupKey (Key []) = NonEmpty Value -> Value
forall a. NonEmpty a -> a
NE.head (NonEmpty Value -> Value)
-> ReaderT RenderContext (State S) (NonEmpty Value) -> Render Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (RenderContext -> NonEmpty Value)
-> ReaderT RenderContext (State S) (NonEmpty Value)
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks RenderContext -> NonEmpty Value
rcContext
lookupKey Key
k = do
  NonEmpty Value
v     <- (RenderContext -> NonEmpty Value)
-> ReaderT RenderContext (State S) (NonEmpty Value)
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks RenderContext -> NonEmpty Value
rcContext
  Key
p     <- (RenderContext -> Key) -> ReaderT RenderContext (State S) Key
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks RenderContext -> Key
rcPrefix
  let f :: Key -> Maybe Value
f Key
x = NonEmpty (Maybe Value) -> Maybe Value
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum (Bool -> Key -> Value -> Maybe Value
simpleLookup Bool
False (Key
x Key -> Key -> Key
forall a. Semigroup a => a -> a -> a
<> Key
k) (Value -> Maybe Value) -> NonEmpty Value -> NonEmpty (Maybe Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty Value
v)
  case [Maybe Value] -> Maybe Value
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum (([Text] -> Maybe Value) -> [[Text]] -> [Maybe Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Key -> Maybe Value
f (Key -> Maybe Value) -> ([Text] -> Key) -> [Text] -> Maybe Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Key
Key) ([[Text]] -> [Maybe Value])
-> ([Text] -> [[Text]]) -> [Text] -> [Maybe Value]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Text]] -> [[Text]]
forall a. [a] -> [a]
reverse ([[Text]] -> [[Text]])
-> ([Text] -> [[Text]]) -> [Text] -> [[Text]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [[Text]]
forall a. [a] -> [[a]]
tails ([Text] -> [Maybe Value]) -> [Text] -> [Maybe Value]
forall a b. (a -> b) -> a -> b
$ Key -> [Text]
unKey Key
p) of
    Maybe Value
Nothing -> do
        -- Context Misses: Failed context lookups should be considered falsey.
        MustacheWarning -> Render ()
tellWarning (MustacheWarning -> Render ()) -> MustacheWarning -> Render ()
forall a b. (a -> b) -> a -> b
$ Key -> MustacheWarning
MustacheVariableNotFound (Key
p Key -> Key -> Key
forall a. Semigroup a => a -> a -> a
<> Key
k)
        Value -> Render Value
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Value
String Text
"")
    Just  Value
r -> Value -> Render Value
forall (m :: * -> *) a. Monad m => a -> m a
return Value
r

-- | Lookup a 'Value' by traversing another 'Value' using given 'Key' as
-- “path”.

simpleLookup
  :: Bool
     -- ^ At least one part of the path matched, in this case we are
     -- “committed” to this lookup and cannot say “there is nothing, try
     -- other level”. This is necessary to pass the “Dotted Names — Context
     -- Precedence” test from the “interpolation.yml” spec.
  -> Key               -- ^ The key to lookup
  -> Value             -- ^ Source value
  -> Maybe Value       -- ^ Looked-up value
simpleLookup :: Bool -> Key -> Value -> Maybe Value
simpleLookup Bool
_ (Key [])     Value
obj        = Value -> Maybe Value
forall (m :: * -> *) a. Monad m => a -> m a
return Value
obj
simpleLookup Bool
c (Key (Text
k:[Text]
ks)) (Object Object
m) =
#if MIN_VERSION_aeson(2,0,0)
  case Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KM.lookup (Text -> Key
Key.fromText Text
k) Object
m of
#else
  case KM.lookup k m of
#endif
    Maybe Value
Nothing -> if Bool
c then Value -> Maybe Value
forall a. a -> Maybe a
Just Value
Null else Maybe Value
forall a. Maybe a
Nothing
    Just  Value
v -> Bool -> Key -> Value -> Maybe Value
simpleLookup Bool
True ([Text] -> Key
Key [Text]
ks) Value
v
simpleLookup Bool
_ Key
_ Value
_ = Maybe Value
forall a. Maybe a
Nothing
{-# INLINE simpleLookup #-}

-- | Enter the section by adding given 'Key' prefix to current prefix.

enterSection :: Key -> Render a -> Render a
enterSection :: Key -> Render a -> Render a
enterSection Key
p =
  (RenderContext -> RenderContext) -> Render a -> Render a
forall r (m :: * -> *) a.
(r -> r) -> ReaderT r m a -> ReaderT r m a
local (\RenderContext
rc -> RenderContext
rc { rcPrefix :: Key
rcPrefix = Key
p Key -> Key -> Key
forall a. Semigroup a => a -> a -> a
<> RenderContext -> Key
rcPrefix RenderContext
rc })
{-# INLINE enterSection #-}

-- | Add new value on the top of context. The new value has the highest
-- priority when lookup takes place.

addToLocalContext :: Value -> Render a -> Render a
addToLocalContext :: Value -> Render a -> Render a
addToLocalContext Value
v =
  (RenderContext -> RenderContext) -> Render a -> Render a
forall r (m :: * -> *) a.
(r -> r) -> ReaderT r m a -> ReaderT r m a
local (\RenderContext
rc -> RenderContext
rc { rcContext :: NonEmpty Value
rcContext = Value -> NonEmpty Value -> NonEmpty Value
forall a. a -> NonEmpty a -> NonEmpty a
NE.cons Value
v (RenderContext -> NonEmpty Value
rcContext RenderContext
rc) })
{-# INLINE addToLocalContext #-}

----------------------------------------------------------------------------
-- Helpers

-- | Add two 'Maybe' 'Word' values together.

addIndents :: Maybe Word -> Maybe Word -> Maybe Word
addIndents :: Maybe Word -> Maybe Word -> Maybe Word
addIndents Maybe Word
Nothing  Maybe Word
Nothing  = Maybe Word
forall a. Maybe a
Nothing
addIndents Maybe Word
Nothing  (Just Word
x) = Word -> Maybe Word
forall a. a -> Maybe a
Just Word
x
addIndents (Just Word
x) Maybe Word
Nothing  = Word -> Maybe Word
forall a. a -> Maybe a
Just Word
x
addIndents (Just Word
x) (Just Word
y) = Word -> Maybe Word
forall a. a -> Maybe a
Just (Word
x Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
y)
{-# INLINE addIndents #-}

-- | Build intentation of specified length by repeating the space character.

buildIndent :: Maybe Word -> Text
buildIndent :: Maybe Word -> Text
buildIndent Maybe Word
Nothing = Text
""
buildIndent (Just Word
p) = let n :: Int
n = Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
p Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 in Int -> Text -> Text
T.replicate Int
n Text
" "
{-# INLINE buildIndent #-}

-- | Select invisible values.

isBlank :: Value -> Bool
isBlank :: Value -> Bool
isBlank Value
Null         = Bool
True
isBlank (Bool Bool
False) = Bool
True
isBlank (Object   Object
m) = Object -> Bool
forall v. KeyMap v -> Bool
KM.null Object
m
isBlank (Array    Array
a) = Array -> Bool
forall a. Vector a -> Bool
V.null Array
a
isBlank (String   Text
s) = Text -> Bool
T.null Text
s
isBlank Value
_            = Bool
False
{-# INLINE isBlank #-}

-- | Render Aeson's 'Value' /without/ HTML escaping.

renderValue :: Key -> Value -> Render Text
renderValue :: Key -> Value -> ReaderT RenderContext (State S) Text
renderValue Key
k Value
v = case Value
v of
    Value
Null       -> Text -> ReaderT RenderContext (State S) Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
""
    String Text
str -> Text -> ReaderT RenderContext (State S) Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
str
    Object Object
_   -> do
        MustacheWarning -> Render ()
tellWarning (Key -> MustacheWarning
MustacheDirectlyRenderedValue Key
k)
        Value -> ReaderT RenderContext (State S) Text
render Value
v
    Array Array
_    -> do
        MustacheWarning -> Render ()
tellWarning (Key -> MustacheWarning
MustacheDirectlyRenderedValue Key
k)
        Value -> ReaderT RenderContext (State S) Text
render Value
v
    Value
_          -> Value -> ReaderT RenderContext (State S) Text
render Value
v
  where
    render :: Value -> ReaderT RenderContext (State S) Text
render = Text -> ReaderT RenderContext (State S) Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ReaderT RenderContext (State S) Text)
-> (Value -> Text) -> Value -> ReaderT RenderContext (State S) Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
LT.toStrict (Text -> Text) -> (Value -> Text) -> Value -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
LTE.decodeUtf8 (ByteString -> Text) -> (Value -> ByteString) -> Value -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode
{-# INLINE renderValue #-}

-- | Escape HTML represented as strict 'Text'.

escapeHtml :: Text -> Text
escapeHtml :: Text -> Text
escapeHtml Text
txt = ((Text, Text) -> Text -> Text) -> Text -> [(Text, Text)] -> Text
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((Text -> Text -> Text -> Text) -> (Text, Text) -> Text -> Text
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> Text -> Text -> Text
T.replace) Text
txt
  [ (Text
"\"", Text
"&quot;")
  , (Text
"<",  Text
"&lt;")
  , (Text
">",  Text
"&gt;")
  , (Text
"&",  Text
"&amp;") ]
{-# INLINE escapeHtml #-}