{-# 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.Reader
import Control.Monad.State.Strict (State, execState, modify')
import Data.Aeson
import Data.Foldable (asum)
import qualified Data.HashMap.Strict as H
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 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 Text -> Object -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
H.lookup 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 k v. HashMap k v -> Bool
H.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 #-}