{-# LANGUAGE OverloadedStrings #-}

-- |
-- Module      :  Text.Mustache.Render
-- Copyright   :  © 2016–present Stack Builders
-- License     :  BSD 3 clause
--
-- Maintainer  :  Mark Karpov <markkarpov92@gmail.com>
-- Stability   :  experimental
-- Portability :  portable
--
-- Functions for rendering Mustache templates. You don't usually need to
-- import the module, because "Text.Mustache" re-exports everything you may
-- need, import that module instead.
module Text.Mustache.Render
  ( renderMustache,
    renderMustacheW,
  )
where

import Control.Monad (forM_, unless, when)
import Control.Monad.Reader (MonadReader (local), ReaderT (runReaderT), asks)
import Control.Monad.State.Strict (State, execState, modify')
import Data.Aeson hiding (Key)
import qualified Data.Aeson.Key as Aeson.Key
import qualified Data.Aeson.KeyMap as Aeson.KeyMap
import Data.Foldable (asum)
import Data.List (tails)
import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.List.NonEmpty as NE
import qualified Data.Map as M
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Builder as B
import qualified Data.Text.Lazy.Encoding as TL
import qualified Data.Vector as V
import Text.Megaparsec.Pos (Pos, mkPos, unPos)
import Text.Mustache.Type

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

-- | Synonym for the monad we use for rendering. It allows us to share
-- context and accumulate the result as 'B.Builder' data which is then
-- turned into a lazy 'TL.Text'.
type Render a = ReaderT RenderContext (State S) a

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

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

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

-- | Render a Mustache 'Template' using Aeson's 'Value' to get actual values
-- for interpolation.
renderMustache :: Template -> Value -> TL.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 returns a collection of warnings.
--
-- @since 1.1.1
renderMustacheW :: Template -> Value -> ([MustacheWarning], TL.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 Pos -> (Node -> Render ()) -> Render ()
renderPartial (Template -> PName
templateActual Template
t) Maybe Pos
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 Pos
indent) =
  PName -> Maybe Pos -> (Node -> Render ()) -> Render ()
renderPartial PName
pname Maybe Pos
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], TL.Text)
runRender :: Render a -> Template -> Value -> ([MustacheWarning], Text)
runRender Render a
m Template
t Value
v = ([MustacheWarning] -> [MustacheWarning]
ws [], Builder -> Text
B.toLazyText Builder
b)
  where
    S [MustacheWarning] -> [MustacheWarning]
ws Builder
b = 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)
    rc :: RenderContext
rc =
      RenderContext :: Maybe Pos
-> NonEmpty Value -> Key -> Template -> Bool -> RenderContext
RenderContext
        { rcIndent :: Maybe Pos
rcIndent = Maybe Pos
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 Pos)
-> ReaderT RenderContext (State S) (Maybe Pos)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks RenderContext -> Maybe Pos
rcIndent ReaderT RenderContext (State S) (Maybe Pos)
-> (Maybe Pos -> Render ()) -> Render ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Render ()
outputRaw (Text -> Render ())
-> (Maybe Pos -> Text) -> Maybe Pos -> Render ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Pos -> Text
buildIndent
{-# INLINE outputIndent #-}

-- | Output piece of strict 'Text' with added indentation.
outputIndented :: Text -> Render ()
outputIndented :: Text -> Render ()
outputIndented Text
txt = do
  Maybe Pos
level <- (RenderContext -> Maybe Pos)
-> ReaderT RenderContext (State S) (Maybe Pos)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks RenderContext -> Maybe Pos
rcIndent
  Bool
lnode <- (RenderContext -> Bool) -> ReaderT RenderContext (State S) Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> 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 Pos -> Text
buildIndent Maybe Pos
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 ::
  -- | Name of partial to render
  PName ->
  -- | Indentation level to use
  Maybe Pos ->
  -- | How to render nodes in that partial
  (Node -> Render ()) ->
  Render ()
renderPartial :: PName -> Maybe Pos -> (Node -> Render ()) -> Render ()
renderPartial PName
pname Maybe Pos
i Node -> Render ()
f =
  (RenderContext -> RenderContext) -> Render () -> Render ()
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> 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 Pos
rcIndent = Maybe Pos -> Maybe Pos -> Maybe Pos
addIndents Maybe Pos
i (RenderContext -> Maybe Pos
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 r (m :: * -> *) a. MonadReader r m => (r -> a) -> 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
M.findWithDefault [] PName
actual Map PName [Node]
cache)
{-# INLINE getNodes #-}

-- | Render many nodes.
renderMany ::
  -- | How to render a node
  (Node -> Render ()) ->
  -- | The collection of nodes to render
  [Node] ->
  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 r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks RenderContext -> Bool
rcLastNode
  (RenderContext -> RenderContext) -> Render () -> Render ()
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> 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. MonadReader r m => (r -> r) -> m a -> 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 r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks RenderContext -> NonEmpty Value
rcContext
lookupKey Key
k = do
  NonEmpty Value
v <- (RenderContext -> NonEmpty Value)
-> ReaderT RenderContext (State S) (NonEmpty Value)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks RenderContext -> NonEmpty Value
rcContext
  Key
p <- (RenderContext -> Key) -> ReaderT RenderContext (State S) Key
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> 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 ->
      Value
Null Value -> Render () -> Render Value
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ MustacheWarning -> Render ()
tellWarning (Key -> MustacheWarning
MustacheVariableNotFound (Key
p Key -> Key -> Key
forall a. Semigroup a => a -> a -> a
<> Key
k))
    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 ::
  -- | 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.
  Bool ->
  -- | The key to lookup
  Key ->
  -- | Source value
  Value ->
  -- | Looked-up value
  Maybe 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) =
  case Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
Aeson.KeyMap.lookup (Text -> Key
Aeson.Key.fromText Text
k) Object
m of
    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. MonadReader r m => (r -> r) -> m a -> 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. MonadReader r m => (r -> r) -> m a -> 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

-- | Register a warning.
tellWarning :: MustacheWarning -> Render ()
tellWarning :: MustacheWarning -> Render ()
tellWarning MustacheWarning
w = (S -> S) -> Render ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ((S -> S) -> Render ()) -> (S -> S) -> Render ()
forall a b. (a -> b) -> a -> b
$ \(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
w MustacheWarning -> [MustacheWarning] -> [MustacheWarning]
forall a. a -> [a] -> [a]
:)) Builder
b

-- | Register a piece of output.
tellBuilder :: B.Builder -> Render ()
tellBuilder :: Builder -> Render ()
tellBuilder Builder
b' = (S -> S) -> Render ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ((S -> S) -> Render ()) -> (S -> S) -> Render ()
forall a b. (a -> b) -> a -> b
$ \(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')

-- | Add two @'Maybe' 'Pos'@ values together.
addIndents :: Maybe Pos -> Maybe Pos -> Maybe Pos
addIndents :: Maybe Pos -> Maybe Pos -> Maybe Pos
addIndents Maybe Pos
Nothing Maybe Pos
Nothing = Maybe Pos
forall a. Maybe a
Nothing
addIndents Maybe Pos
Nothing (Just Pos
x) = Pos -> Maybe Pos
forall a. a -> Maybe a
Just Pos
x
addIndents (Just Pos
x) Maybe Pos
Nothing = Pos -> Maybe Pos
forall a. a -> Maybe a
Just Pos
x
addIndents (Just Pos
x) (Just Pos
y) = Pos -> Maybe Pos
forall a. a -> Maybe a
Just (Int -> Pos
mkPos (Int -> Pos) -> Int -> Pos
forall a b. (a -> b) -> a -> b
$ Pos -> Int
unPos Pos
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Pos -> Int
unPos Pos
y Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
{-# INLINE addIndents #-}

-- | Build indentation of specified length by repeating the space character.
buildIndent :: Maybe Pos -> Text
buildIndent :: Maybe Pos -> Text
buildIndent Maybe Pos
Nothing = Text
""
buildIndent (Just Pos
p) = let n :: Int
n = Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Pos -> Int
unPos Pos
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
Aeson.KeyMap.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
TL.toStrict (Text -> Text) -> (Value -> Text) -> Value -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
TL.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
"&#39;"),
      (Text
"<", Text
"&lt;"),
      (Text
">", Text
"&gt;"),
      (Text
"&", Text
"&amp;")
    ]
{-# INLINE escapeHtml #-}