{-# LANGUAGE CPP #-}
{-# LANGUAGE BangPatterns        #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE FlexibleContexts #-}

module Heist.Splices.Json (
  bindJson
) where

------------------------------------------------------------------------------
import           Control.Monad.Reader
import           Data.Aeson
import qualified Data.ByteString.Char8       as S
import qualified Data.ByteString.Lazy.Char8  as L
#if MIN_VERSION_aeson(2,0,0)
import qualified Data.Aeson.KeyMap           as KM
import qualified Data.Aeson.Key              as K
import qualified Data.Foldable.WithIndex     as FI
#else
import qualified Data.HashMap.Strict         as Map
#endif
import           Data.Map.Syntax
import           Data.Maybe
import           Data.Text                   (Text)
import qualified Data.Text                   as T
import qualified Data.Text.Encoding          as T
import qualified Data.Vector                 as V
import           Text.Blaze.Html5            ((!))
import qualified Text.Blaze.Html5            as B
import           Text.Blaze.Renderer.XmlHtml
import           Text.XmlHtml
------------------------------------------------------------------------------
import           Heist.Interpreted.Internal
import           Heist.Internal.Types.HeistState
------------------------------------------------------------------------------

                                 ------------
                                 -- public --
                                 ------------

------------------------------------------------------------------------------
-- | This splice binds convenience tags for the given JSON (or
-- JSON-convertible) value and runs the tag's child nodes using the new
-- bindings.
--
-- /Tags bound when you pass in an object/
--
-- Tags bound for an object looking like this:
--
-- > { "k_1": v_1, ..., "k_N": v_N }
--
-- @\<value:{k_i}\>@    -- treats v_i as text
-- @\<snippet:{k_i}\>@  -- treats v_i as HTML
-- @\<with:{k_i}\>@     -- explodes v_i and runs its children
--
-- @\<value var=\"foo.bar.baz\"\/>@ -- walks the JSON tree to find
-- \"foo.bar.baz\", and interprets it as a string
-- @\<snippet var=\"foo.bar.baz\"\/\>@
-- @\<with var=\"foo.bar.baz\"\>...\<with\>@
--
-- /Tags bound when you pass in anything else/
--
-- @\<value\/\>@    --  the given JSON value, as a string
-- @\<snippet\/\>@  --  the given JSON value, parsed and spliced in as HTML
--
bindJson :: (ToJSON a, Monad n) => a -> Splice n
bindJson :: forall a (n :: * -> *). (ToJSON a, Monad n) => a -> Splice n
bindJson = ReaderT Value (HeistT n n) Template -> Value -> HeistT n n Template
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT Value (HeistT n n) Template
forall (n :: * -> *). Monad n => JsonMonad n n Template
explodeTag (Value -> HeistT n n Template)
-> (a -> Value) -> a -> HeistT n n Template
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Value
forall a. ToJSON a => a -> Value
toJSON


                                 -------------
                                 -- private --
                                 -------------

------------------------------------------------------------------------------
errorMessage :: String -> [Node]
errorMessage :: String -> Template
errorMessage String
s = Html -> Template
renderHtmlNodes (Html -> Template) -> Html -> Template
forall a b. (a -> b) -> a -> b
$
                     Html -> Html
B.strong (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! Tag -> AttributeValue -> Attribute
B.customAttribute Tag
"class" AttributeValue
"error" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$
                     String -> Html
forall a. ToMarkup a => a -> Html
B.toHtml String
s


------------------------------------------------------------------------------
type JsonMonad n m a = ReaderT Value (HeistT n m) a


------------------------------------------------------------------------------
withValue :: (Monad m) => Value -> JsonMonad n m a -> HeistT n m a
withValue :: forall (m :: * -> *) (n :: * -> *) a.
Monad m =>
Value -> JsonMonad n m a -> HeistT n m a
withValue = (JsonMonad n m a -> Value -> HeistT n m a)
-> Value -> JsonMonad n m a -> HeistT n m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip JsonMonad n m a -> Value -> HeistT n m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT


------------------------------------------------------------------------------
boolToText :: Bool -> Text
boolToText :: Bool -> Text
boolToText Bool
b = if Bool
b then Text
"true" else Text
"false"


------------------------------------------------------------------------------
numToText :: ToJSON a => a -> Text
numToText :: forall a. ToJSON a => a -> Text
numToText = ByteString -> Text
T.decodeUtf8 (ByteString -> Text) -> (a -> ByteString) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
S.concat ([ByteString] -> ByteString)
-> (a -> [ByteString]) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
L.toChunks (ByteString -> [ByteString])
-> (a -> ByteString) -> a -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ByteString
forall a. ToJSON a => a -> ByteString
encode

------------------------------------------------------------------------------
findExpr :: Text -> Value -> Maybe Value
findExpr :: Text -> Value -> Maybe Value
findExpr Text
t = [Text] -> Value -> Maybe Value
go ((Char -> Bool) -> Text -> [Text]
T.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'.') Text
t)
  where
    go :: [Text] -> Value -> Maybe Value
go [] !Value
value     = Value -> Maybe Value
forall a. a -> Maybe a
Just Value
value
    go (Text
x:[Text]
xs) !Value
value = Value -> Maybe Value
findIn Value
value Maybe Value -> (Value -> Maybe Value) -> Maybe Value
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Text] -> Value -> Maybe Value
go [Text]
xs
      where
#if MIN_VERSION_aeson(2,0,0)
        findIn :: Value -> Maybe Value
findIn (Object Object
obj) = Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KM.lookup (Text -> Key
K.fromText Text
x) Object
obj
#else
        findIn (Object obj) = Map.lookup x obj
#endif
        findIn (Array Array
arr)  = Maybe Int
forall {b}. Read b => Maybe b
tryReadIndex Maybe Int -> (Int -> Maybe Value) -> Maybe Value
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Int
i -> Array
arr Array -> Int -> Maybe Value
forall a. Vector a -> Int -> Maybe a
V.!? Int
i
        findIn Value
_            = Maybe Value
forall a. Maybe a
Nothing

        tryReadIndex :: Maybe b
tryReadIndex = ((b, String) -> b) -> Maybe (b, String) -> Maybe b
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (b, String) -> b
forall a b. (a, b) -> a
fst (Maybe (b, String) -> Maybe b)
-> (Text -> Maybe (b, String)) -> Text -> Maybe b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(b, String)] -> Maybe (b, String)
forall a. [a] -> Maybe a
listToMaybe ([(b, String)] -> Maybe (b, String))
-> (Text -> [(b, String)]) -> Text -> Maybe (b, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReadS b
forall a. Read a => ReadS a
reads ReadS b -> (Text -> String) -> Text -> [(b, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> Maybe b) -> Text -> Maybe b
forall a b. (a -> b) -> a -> b
$ Text
x


------------------------------------------------------------------------------
asHtml :: Monad m => Text -> m [Node]
asHtml :: forall (m :: * -> *). Monad m => Text -> m Template
asHtml Text
t =
    case (String -> ByteString -> Either String Document
parseHTML String
"" (ByteString -> Either String Document)
-> ByteString -> Either String Document
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
T.encodeUtf8 Text
t) of
      Left String
e  -> Template -> m Template
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Template -> m Template) -> Template -> m Template
forall a b. (a -> b) -> a -> b
$ String -> Template
errorMessage (String -> Template) -> String -> Template
forall a b. (a -> b) -> a -> b
$
                 String
"Template error turning JSON into HTML: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e
      Right Document
d -> Template -> m Template
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Template -> m Template) -> Template -> m Template
forall a b. (a -> b) -> a -> b
$! Document -> Template
docContent Document
d


------------------------------------------------------------------------------
snippetTag :: Monad m => JsonMonad n m [Node]
snippetTag :: forall (m :: * -> *) (n :: * -> *).
Monad m =>
JsonMonad n m Template
snippetTag = ReaderT Value (HeistT n m) Value
forall r (m :: * -> *). MonadReader r m => m r
ask ReaderT Value (HeistT n m) Value
-> (Value -> ReaderT Value (HeistT n m) Template)
-> ReaderT Value (HeistT n m) Template
forall a b.
ReaderT Value (HeistT n m) a
-> (a -> ReaderT Value (HeistT n m) b)
-> ReaderT Value (HeistT n m) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> ReaderT Value (HeistT n m) Template
forall {t :: (* -> *) -> * -> *} {m :: * -> *} {n :: * -> *}.
(MonadTrans t, Monad m) =>
Value -> t (HeistT n m) Template
snip
  where
    txt :: Text -> t m Template
txt Text
t = m Template -> t m Template
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Template -> t m Template) -> m Template -> t m Template
forall a b. (a -> b) -> a -> b
$ Text -> m Template
forall (m :: * -> *). Monad m => Text -> m Template
asHtml Text
t

    snip :: Value -> t (HeistT n m) Template
snip Value
Null       = Text -> t (HeistT n m) Template
forall {t :: (* -> *) -> * -> *} {m :: * -> *}.
(MonadTrans t, Monad m) =>
Text -> t m Template
txt Text
""
    snip (Bool Bool
b)   = Text -> t (HeistT n m) Template
forall {t :: (* -> *) -> * -> *} {m :: * -> *}.
(MonadTrans t, Monad m) =>
Text -> t m Template
txt (Text -> t (HeistT n m) Template)
-> Text -> t (HeistT n m) Template
forall a b. (a -> b) -> a -> b
$ Bool -> Text
boolToText Bool
b
    snip (Number Scientific
n) = Text -> t (HeistT n m) Template
forall {t :: (* -> *) -> * -> *} {m :: * -> *}.
(MonadTrans t, Monad m) =>
Text -> t m Template
txt (Text -> t (HeistT n m) Template)
-> Text -> t (HeistT n m) Template
forall a b. (a -> b) -> a -> b
$ Scientific -> Text
forall a. ToJSON a => a -> Text
numToText Scientific
n
    snip (String Text
t) = Text -> t (HeistT n m) Template
forall {t :: (* -> *) -> * -> *} {m :: * -> *}.
(MonadTrans t, Monad m) =>
Text -> t m Template
txt Text
t
    snip Value
_          = HeistT n m Template -> t (HeistT n m) Template
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (HeistT n m Template -> t (HeistT n m) Template)
-> HeistT n m Template -> t (HeistT n m) Template
forall a b. (a -> b) -> a -> b
$ do
        Node
node <- HeistT n m Node
forall (m :: * -> *) (n :: * -> *). Monad m => HeistT n m Node
getParamNode
        Template -> HeistT n m Template
forall a. a -> HeistT n m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Template -> HeistT n m Template)
-> Template -> HeistT n m Template
forall a b. (a -> b) -> a -> b
$ String -> Template
errorMessage (String -> Template) -> String -> Template
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [
                     String
"error processing tag <"
                   , Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"???" (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Node -> Maybe Text
tagName Node
node
                   , String
">: can't interpret JSON arrays or objects as HTML."
                   ]


------------------------------------------------------------------------------
valueTag :: Monad m => JsonMonad n m [Node]
valueTag :: forall (m :: * -> *) (n :: * -> *).
Monad m =>
JsonMonad n m Template
valueTag = ReaderT Value (HeistT n m) Value
forall r (m :: * -> *). MonadReader r m => m r
ask ReaderT Value (HeistT n m) Value
-> (Value -> ReaderT Value (HeistT n m) Template)
-> ReaderT Value (HeistT n m) Template
forall a b.
ReaderT Value (HeistT n m) a
-> (a -> ReaderT Value (HeistT n m) b)
-> ReaderT Value (HeistT n m) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> ReaderT Value (HeistT n m) Template
forall {t :: (* -> *) -> * -> *} {m :: * -> *} {n :: * -> *}.
(MonadTrans t, Monad m, Monad (t (HeistT n m))) =>
Value -> t (HeistT n m) Template
go
  where
    go :: Value -> t (HeistT n m) Template
go Value
Null       = Text -> t (HeistT n m) Template
forall (m :: * -> *). Monad m => Text -> m Template
txt Text
""
    go (Bool Bool
b)   = Text -> t (HeistT n m) Template
forall (m :: * -> *). Monad m => Text -> m Template
txt (Text -> t (HeistT n m) Template)
-> Text -> t (HeistT n m) Template
forall a b. (a -> b) -> a -> b
$ Bool -> Text
boolToText Bool
b
    go (Number Scientific
n) = Text -> t (HeistT n m) Template
forall (m :: * -> *). Monad m => Text -> m Template
txt (Text -> t (HeistT n m) Template)
-> Text -> t (HeistT n m) Template
forall a b. (a -> b) -> a -> b
$ Scientific -> Text
forall a. ToJSON a => a -> Text
numToText Scientific
n
    go (String Text
t) = Text -> t (HeistT n m) Template
forall (m :: * -> *). Monad m => Text -> m Template
txt Text
t
    go Value
_          = HeistT n m Template -> t (HeistT n m) Template
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (HeistT n m Template -> t (HeistT n m) Template)
-> HeistT n m Template -> t (HeistT n m) Template
forall a b. (a -> b) -> a -> b
$ do
        Node
node <- HeistT n m Node
forall (m :: * -> *) (n :: * -> *). Monad m => HeistT n m Node
getParamNode
        Template -> HeistT n m Template
forall a. a -> HeistT n m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Template -> HeistT n m Template)
-> Template -> HeistT n m Template
forall a b. (a -> b) -> a -> b
$ String -> Template
errorMessage (String -> Template) -> String -> Template
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [
                     String
"error processing tag <"
                   , Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"???" (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Node -> Maybe Text
tagName Node
node
                   , String
">: can't interpret JSON arrays or objects as text."
                   ]


    txt :: Text -> m Template
txt Text
t = Template -> m Template
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return [Text -> Node
TextNode Text
t]


------------------------------------------------------------------------------
explodeTag :: forall n. (Monad n) => JsonMonad n n [Node]
explodeTag :: forall (n :: * -> *). Monad n => JsonMonad n n Template
explodeTag = ReaderT Value (HeistT n n) Value
forall r (m :: * -> *). MonadReader r m => m r
ask ReaderT Value (HeistT n n) Value
-> (Value -> ReaderT Value (HeistT n n) Template)
-> ReaderT Value (HeistT n n) Template
forall a b.
ReaderT Value (HeistT n n) a
-> (a -> ReaderT Value (HeistT n n) b)
-> ReaderT Value (HeistT n n) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> ReaderT Value (HeistT n n) Template
go
  where
    --------------------------------------------------------------------------
    go :: Value -> ReaderT Value (HeistT n n) Template
go Value
Null       = Text -> ReaderT Value (HeistT n n) Template
forall {t :: (* -> *) -> * -> *} {n :: * -> *}.
(MonadTrans t, Monad n) =>
Text -> t (HeistT n n) Template
goText Text
""
    go (Bool Bool
b)   = Text -> ReaderT Value (HeistT n n) Template
forall {t :: (* -> *) -> * -> *} {n :: * -> *}.
(MonadTrans t, Monad n) =>
Text -> t (HeistT n n) Template
goText (Text -> ReaderT Value (HeistT n n) Template)
-> Text -> ReaderT Value (HeistT n n) Template
forall a b. (a -> b) -> a -> b
$ Bool -> Text
boolToText Bool
b
    go (Number Scientific
n) = Text -> ReaderT Value (HeistT n n) Template
forall {t :: (* -> *) -> * -> *} {n :: * -> *}.
(MonadTrans t, Monad n) =>
Text -> t (HeistT n n) Template
goText (Text -> ReaderT Value (HeistT n n) Template)
-> Text -> ReaderT Value (HeistT n n) Template
forall a b. (a -> b) -> a -> b
$ Scientific -> Text
forall a. ToJSON a => a -> Text
numToText Scientific
n
    go (String Text
t) = Text -> ReaderT Value (HeistT n n) Template
forall {t :: (* -> *) -> * -> *} {n :: * -> *}.
(MonadTrans t, Monad n) =>
Text -> t (HeistT n n) Template
goText Text
t
    go (Array Array
a)  = Array -> ReaderT Value (HeistT n n) Template
goArray Array
a
    go (Object Object
o) = Object -> ReaderT Value (HeistT n n) Template
forall {f :: * -> *}.
FoldableWithIndex Key f =>
f Value -> ReaderT Value (HeistT n n) Template
goObject Object
o

    --------------------------------------------------------------------------
    goText :: Text -> t (HeistT n n) Template
goText Text
t = Splice n -> t (HeistT n n) Template
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Splice n -> t (HeistT n n) Template)
-> Splice n -> t (HeistT n n) Template
forall a b. (a -> b) -> a -> b
$ Splices (Splice n) -> Splice n
forall (n :: * -> *). Monad n => Splices (Splice n) -> Splice n
runChildrenWith (Splices (Splice n) -> Splice n) -> Splices (Splice n) -> Splice n
forall a b. (a -> b) -> a -> b
$ do
        Text
"value"   Text -> Splice n -> Splices (Splice n)
forall k v. k -> v -> MapSyntax k v
## Template -> Splice n
forall a. a -> HeistT n n a
forall (m :: * -> *) a. Monad m => a -> m a
return [Text -> Node
TextNode Text
t]
        Text
"snippet" Text -> Splice n -> Splices (Splice n)
forall k v. k -> v -> MapSyntax k v
## Text -> Splice n
forall (m :: * -> *). Monad m => Text -> m Template
asHtml Text
t

    --------------------------------------------------------------------------
    goArray :: V.Vector Value -> JsonMonad n n [Node]
    goArray :: Array -> ReaderT Value (HeistT n n) Template
goArray Array
a = do
        HeistT n n () -> ReaderT Value (HeistT n n) ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT Value m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift HeistT n n ()
forall (m :: * -> *) (n :: * -> *). Monad m => HeistT n m ()
stopRecursion
        Template -> Template
dl <- ((Template -> Template)
 -> Value -> ReaderT Value (HeistT n n) (Template -> Template))
-> (Template -> Template)
-> Array
-> ReaderT Value (HeistT n n) (Template -> Template)
forall (m :: * -> *) a b.
Monad m =>
(a -> b -> m a) -> a -> Vector b -> m a
V.foldM (Template -> Template)
-> Value -> ReaderT Value (HeistT n n) (Template -> Template)
forall {c}.
(Template -> c)
-> Value -> ReaderT Value (HeistT n n) (Template -> c)
f Template -> Template
forall a. a -> a
id Array
a
        Template -> ReaderT Value (HeistT n n) Template
forall a. a -> ReaderT Value (HeistT n n) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Template -> ReaderT Value (HeistT n n) Template)
-> Template -> ReaderT Value (HeistT n n) Template
forall a b. (a -> b) -> a -> b
$! Template -> Template
dl []
      where
        f :: (Template -> c)
-> Value -> ReaderT Value (HeistT n n) (Template -> c)
f Template -> c
dl Value
jsonValue = do
            Template
tags <- Value -> ReaderT Value (HeistT n n) Template
go Value
jsonValue
            (Template -> c) -> ReaderT Value (HeistT n n) (Template -> c)
forall a. a -> ReaderT Value (HeistT n n) a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Template -> c) -> ReaderT Value (HeistT n n) (Template -> c))
-> (Template -> c) -> ReaderT Value (HeistT n n) (Template -> c)
forall a b. (a -> b) -> a -> b
$! Template -> c
dl (Template -> c) -> (Template -> Template) -> Template -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Template
tags Template -> Template -> Template
forall a. [a] -> [a] -> [a]
++)

    --------------------------------------------------------------------------
    -- search the param node for attribute \"var=expr\", search the given JSON
    -- object for the expression, and if it's found run the JsonMonad action m
    -- using the restricted JSON object.
    varAttrTag :: Value -> (JsonMonad n n [Node]) -> Splice n
    varAttrTag :: Value -> ReaderT Value (HeistT n n) Template -> Splice n
varAttrTag Value
v ReaderT Value (HeistT n n) Template
m = do
        Node
node <- HeistT n n Node
forall (m :: * -> *) (n :: * -> *). Monad m => HeistT n m Node
getParamNode
        Splice n -> (Text -> Splice n) -> Maybe Text -> Splice n
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Node -> Splice n
forall {m :: * -> *}. Monad m => Node -> m Template
noVar Node
node) (Node -> Text -> Splice n
hasVar Node
node) (Maybe Text -> Splice n) -> Maybe Text -> Splice n
forall a b. (a -> b) -> a -> b
$ Text -> Node -> Maybe Text
getAttribute Text
"var" Node
node
      where
        noVar :: Node -> m Template
noVar Node
node = Template -> m Template
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Template -> m Template) -> Template -> m Template
forall a b. (a -> b) -> a -> b
$ String -> Template
errorMessage (String -> Template) -> String -> Template
forall a b. (a -> b) -> a -> b
$
                     [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ String
"expression error: no var attribute in <"
                            , Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"???" (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Node -> Maybe Text
tagName Node
node
                            , String
"> tag"
                            ]

        hasVar :: Node -> Text -> Splice n
hasVar Node
node Text
expr = Splice n -> (Value -> Splice n) -> Maybe Value -> Splice n
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Template -> Splice n
forall a. a -> HeistT n n a
forall (m :: * -> *) a. Monad m => a -> m a
return (Template -> Splice n) -> Template -> Splice n
forall a b. (a -> b) -> a -> b
$ String -> Template
errorMessage (String -> Template) -> String -> Template
forall a b. (a -> b) -> a -> b
$
                                  [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [
                                    String
"expression error: can't find \""
                                  , Text -> String
T.unpack Text
expr
                                  , String
"\" in JSON object (<"
                                  , Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"???" (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Node -> Maybe Text
tagName Node
node
                                  , String
"> tag)"
                                  ])
                                 (ReaderT Value (HeistT n n) Template -> Value -> Splice n
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT Value (HeistT n n) Template
m)
                                 (Text -> Value -> Maybe Value
findExpr Text
expr Value
v)

    --------------------------------------------------------------------------
    genericBindings :: JsonMonad n n (Splices (Splice n))
    genericBindings :: JsonMonad n n (Splices (Splice n))
genericBindings = ReaderT Value (HeistT n n) Value
forall r (m :: * -> *). MonadReader r m => m r
ask ReaderT Value (HeistT n n) Value
-> (Value -> JsonMonad n n (Splices (Splice n)))
-> JsonMonad n n (Splices (Splice n))
forall a b.
ReaderT Value (HeistT n n) a
-> (a -> ReaderT Value (HeistT n n) b)
-> ReaderT Value (HeistT n n) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Value
v -> Splices (Splice n) -> JsonMonad n n (Splices (Splice n))
forall a. a -> ReaderT Value (HeistT n n) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Splices (Splice n) -> JsonMonad n n (Splices (Splice n)))
-> Splices (Splice n) -> JsonMonad n n (Splices (Splice n))
forall a b. (a -> b) -> a -> b
$ do
        Text
"with"     Text -> Splice n -> Splices (Splice n)
forall k v. k -> v -> MapSyntax k v
## Value -> ReaderT Value (HeistT n n) Template -> Splice n
varAttrTag Value
v ReaderT Value (HeistT n n) Template
forall (n :: * -> *). Monad n => JsonMonad n n Template
explodeTag
        Text
"snippet"  Text -> Splice n -> Splices (Splice n)
forall k v. k -> v -> MapSyntax k v
## Value -> ReaderT Value (HeistT n n) Template -> Splice n
varAttrTag Value
v ReaderT Value (HeistT n n) Template
forall (m :: * -> *) (n :: * -> *).
Monad m =>
JsonMonad n m Template
snippetTag
        Text
"value"    Text -> Splice n -> Splices (Splice n)
forall k v. k -> v -> MapSyntax k v
## Value -> ReaderT Value (HeistT n n) Template -> Splice n
varAttrTag Value
v ReaderT Value (HeistT n n) Template
forall (m :: * -> *) (n :: * -> *).
Monad m =>
JsonMonad n m Template
valueTag


    --------------------------------------------------------------------------
    goObject :: f Value -> ReaderT Value (HeistT n n) Template
goObject f Value
obj = do
        Splices (Splice n)
start <- JsonMonad n n (Splices (Splice n))
genericBindings
#if MIN_VERSION_aeson(2,0,0)
        let bindings :: Splices (Splice n)
bindings = (Key -> Splices (Splice n) -> Value -> Splices (Splice n))
-> Splices (Splice n) -> f Value -> Splices (Splice n)
forall b a. (Key -> b -> a -> b) -> b -> f a -> b
forall i (f :: * -> *) b a.
FoldableWithIndex i f =>
(i -> b -> a -> b) -> b -> f a -> b
FI.ifoldl' ((Splices (Splice n) -> Key -> Value -> Splices (Splice n))
-> Key -> Splices (Splice n) -> Value -> Splices (Splice n)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Splices (Splice n) -> Key -> Value -> Splices (Splice n)
forall {m :: * -> *} {a}.
Monad m =>
MapSyntaxM Text (HeistT m m Template) a
-> Key -> Value -> MapSyntaxM Text (HeistT m m Template) ()
bindKvp) Splices (Splice n)
start  f Value
obj
#else
        let bindings = Map.foldlWithKey' bindKvp start obj
#endif
        Splice n -> ReaderT Value (HeistT n n) Template
forall (m :: * -> *) a. Monad m => m a -> ReaderT Value m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Splice n -> ReaderT Value (HeistT n n) Template)
-> Splice n -> ReaderT Value (HeistT n n) Template
forall a b. (a -> b) -> a -> b
$ Splices (Splice n) -> Splice n
forall (n :: * -> *). Monad n => Splices (Splice n) -> Splice n
runChildrenWith Splices (Splice n)
bindings

    --------------------------------------------------------------------------
    
    bindKvp :: MapSyntaxM Text (HeistT m m Template) a
-> Key -> Value -> MapSyntaxM Text (HeistT m m Template) ()
bindKvp MapSyntaxM Text (HeistT m m Template) a
bindings Key
k Value
v =
#if MIN_VERSION_aeson(2,0,0)
        let k' :: Text
k' = Key -> Text
K.toText Key
k
#else
        let k' = k
#endif
            newBindings :: MapSyntaxM Text (HeistT m m Template) ()
newBindings = do
                Text -> Text -> Text
T.append Text
"with:" Text
k'    Text
-> HeistT m m Template -> MapSyntaxM Text (HeistT m m Template) ()
forall k v. k -> v -> MapSyntax k v
## Value -> JsonMonad m m Template -> HeistT m m Template
forall (m :: * -> *) (n :: * -> *) a.
Monad m =>
Value -> JsonMonad n m a -> HeistT n m a
withValue Value
v JsonMonad m m Template
forall (n :: * -> *). Monad n => JsonMonad n n Template
explodeTag
                Text -> Text -> Text
T.append Text
"snippet:" Text
k' Text
-> HeistT m m Template -> MapSyntaxM Text (HeistT m m Template) ()
forall k v. k -> v -> MapSyntax k v
## Value -> JsonMonad m m Template -> HeistT m m Template
forall (m :: * -> *) (n :: * -> *) a.
Monad m =>
Value -> JsonMonad n m a -> HeistT n m a
withValue Value
v JsonMonad m m Template
forall (m :: * -> *) (n :: * -> *).
Monad m =>
JsonMonad n m Template
snippetTag
                Text -> Text -> Text
T.append Text
"value:" Text
k'   Text
-> HeistT m m Template -> MapSyntaxM Text (HeistT m m Template) ()
forall k v. k -> v -> MapSyntax k v
## Value -> JsonMonad m m Template -> HeistT m m Template
forall (m :: * -> *) (n :: * -> *) a.
Monad m =>
Value -> JsonMonad n m a -> HeistT n m a
withValue Value
v JsonMonad m m Template
forall (m :: * -> *) (n :: * -> *).
Monad m =>
JsonMonad n m Template
valueTag
        in  MapSyntaxM Text (HeistT m m Template) a
bindings MapSyntaxM Text (HeistT m m Template) a
-> MapSyntaxM Text (HeistT m m Template) ()
-> MapSyntaxM Text (HeistT m m Template) ()
forall a b.
MapSyntaxM Text (HeistT m m Template) a
-> MapSyntaxM Text (HeistT m m Template) b
-> MapSyntaxM Text (HeistT m m Template) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MapSyntaxM Text (HeistT m m Template) ()
forall {m :: * -> *}.
Monad m =>
MapSyntaxM Text (HeistT m m Template) ()
newBindings