{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PackageImports #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Heist.Interpreted.Internal where
import Blaze.ByteString.Builder
import Control.Monad
import Control.Monad.State.Strict
import qualified Data.Attoparsec.Text as AP
import Data.ByteString (ByteString)
import qualified Data.HashMap.Strict as Map
import qualified Data.HeterogeneousEnvironment as HE
import Data.Map.Syntax
import Data.Maybe
import Data.Text (Text)
import qualified Data.Text as T
import qualified Text.XmlHtml as X
import Heist.Common
import Heist.Internal.Types.HeistState
type Splice n = HeistT n n Template
bindSplice :: Text
-> Splice n
-> HeistState n
-> HeistState n
bindSplice :: Text -> Splice n -> HeistState n -> HeistState n
bindSplice Text
n Splice n
v HeistState n
hs = HeistState n
hs {_spliceMap :: HashMap Text (Splice n)
_spliceMap = Text
-> Splice n -> HashMap Text (Splice n) -> HashMap Text (Splice n)
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
Map.insert Text
n Splice n
v (HeistState n -> HashMap Text (Splice n)
forall (m :: * -> *).
HeistState m -> HashMap Text (HeistT m m Template)
_spliceMap HeistState n
hs)}
bindSplices :: Splices (Splice n)
-> HeistState n
-> HeistState n
bindSplices :: Splices (Splice n) -> HeistState n -> HeistState n
bindSplices Splices (Splice n)
ss HeistState n
hs =
HeistState n
hs { _spliceMap :: HashMap Text (Splice n)
_spliceMap = HeistState n
-> (HeistState n -> HashMap Text (Splice n))
-> Splices (Splice n)
-> HashMap Text (Splice n)
forall (n :: * -> *) v a.
HeistState n
-> (HeistState n -> HashMap Text v)
-> MapSyntaxM Text v a
-> HashMap Text v
applySpliceMap HeistState n
hs HeistState n -> HashMap Text (Splice n)
forall (m :: * -> *).
HeistState m -> HashMap Text (HeistT m m Template)
_spliceMap Splices (Splice n)
ss }
textSplice :: Monad m => Text -> HeistT n m Template
textSplice :: Text -> HeistT n m Template
textSplice Text
t = Template -> HeistT n m Template
forall (m :: * -> *) a. Monad m => a -> m a
return [Text -> Node
X.TextNode Text
t]
runChildren :: Monad n => Splice n
runChildren :: Splice n
runChildren = Template -> Splice n
forall (n :: * -> *). Monad n => Template -> Splice n
runNodeList (Template -> Splice n) -> (Node -> Template) -> Node -> Splice n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Node -> Template
X.childNodes (Node -> Splice n) -> HeistT n n Node -> Splice n
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< HeistT n n Node
forall (m :: * -> *) (n :: * -> *). Monad m => HeistT n m Node
getParamNode
runChildrenWith :: (Monad n)
=> Splices (Splice n)
-> Splice n
runChildrenWith :: Splices (Splice n) -> Splice n
runChildrenWith Splices (Splice n)
splices = (HeistState n -> HeistState n) -> Splice n -> Splice n
forall (m :: * -> *) (n :: * -> *) a.
Monad m =>
(HeistState n -> HeistState n) -> HeistT n m a -> HeistT n m a
localHS (Splices (Splice n) -> HeistState n -> HeistState n
forall (n :: * -> *).
Splices (Splice n) -> HeistState n -> HeistState n
bindSplices Splices (Splice n)
splices) Splice n
forall (n :: * -> *). Monad n => Splice n
runChildren
runChildrenWithTrans :: (Monad n)
=> (b -> Splice n)
-> Splices b
-> Splice n
runChildrenWithTrans :: (b -> Splice n) -> Splices b -> Splice n
runChildrenWithTrans b -> Splice n
f = Splices (Splice n) -> Splice n
forall (n :: * -> *). Monad n => Splices (Splice n) -> Splice n
runChildrenWith (Splices (Splice n) -> Splice n)
-> (Splices b -> Splices (Splice n)) -> Splices b -> Splice n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> Splice n) -> Splices b -> Splices (Splice n)
forall v1 v2 k a. (v1 -> v2) -> MapSyntaxM k v1 a -> MapSyntax k v2
mapV b -> Splice n
f
runChildrenWithTemplates :: (Monad n) => Splices Template -> Splice n
runChildrenWithTemplates :: Splices Template -> Splice n
runChildrenWithTemplates = (Template -> Splice n) -> Splices Template -> Splice n
forall (n :: * -> *) b.
Monad n =>
(b -> Splice n) -> Splices b -> Splice n
runChildrenWithTrans Template -> Splice n
forall (m :: * -> *) a. Monad m => a -> m a
return
runChildrenWithText :: (Monad n) => Splices Text -> Splice n
runChildrenWithText :: Splices Text -> Splice n
runChildrenWithText = (Text -> Splice n) -> Splices Text -> Splice n
forall (n :: * -> *) b.
Monad n =>
(b -> Splice n) -> Splices b -> Splice n
runChildrenWithTrans Text -> Splice n
forall (m :: * -> *) (n :: * -> *).
Monad m =>
Text -> HeistT n m Template
textSplice
lookupSplice :: Text
-> HeistState n
-> Maybe (Splice n)
lookupSplice :: Text -> HeistState n -> Maybe (Splice n)
lookupSplice Text
nm HeistState n
hs = Text -> HashMap Text (Splice n) -> Maybe (Splice n)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup Text
nm (HashMap Text (Splice n) -> Maybe (Splice n))
-> HashMap Text (Splice n) -> Maybe (Splice n)
forall a b. (a -> b) -> a -> b
$ HeistState n -> HashMap Text (Splice n)
forall (m :: * -> *).
HeistState m -> HashMap Text (HeistT m m Template)
_spliceMap HeistState n
hs
{-# INLINE lookupSplice #-}
addTemplate :: ByteString
-> Template
-> Maybe FilePath
-> HeistState n
-> HeistState n
addTemplate :: ByteString
-> Template -> Maybe FilePath -> HeistState n -> HeistState n
addTemplate ByteString
n Template
t Maybe FilePath
mfp HeistState n
st =
TPath -> DocumentFile -> HeistState n -> HeistState n
forall (n :: * -> *).
TPath -> DocumentFile -> HeistState n -> HeistState n
insertTemplate (ByteString -> TPath
splitTemplatePath ByteString
n) DocumentFile
doc HeistState n
st
where
doc :: DocumentFile
doc = Document -> Maybe FilePath -> DocumentFile
DocumentFile (Encoding -> Maybe DocType -> Template -> Document
X.HtmlDocument Encoding
X.UTF8 Maybe DocType
forall a. Maybe a
Nothing Template
t) Maybe FilePath
mfp
addXMLTemplate :: ByteString
-> Template
-> Maybe FilePath
-> HeistState n
-> HeistState n
addXMLTemplate :: ByteString
-> Template -> Maybe FilePath -> HeistState n -> HeistState n
addXMLTemplate ByteString
n Template
t Maybe FilePath
mfp HeistState n
st =
TPath -> DocumentFile -> HeistState n -> HeistState n
forall (n :: * -> *).
TPath -> DocumentFile -> HeistState n -> HeistState n
insertTemplate (ByteString -> TPath
splitTemplatePath ByteString
n) DocumentFile
doc HeistState n
st
where
doc :: DocumentFile
doc = Document -> Maybe FilePath -> DocumentFile
DocumentFile (Encoding -> Maybe DocType -> Template -> Document
X.XmlDocument Encoding
X.UTF8 Maybe DocType
forall a. Maybe a
Nothing Template
t) Maybe FilePath
mfp
stopRecursion :: Monad m => HeistT n m ()
stopRecursion :: HeistT n m ()
stopRecursion = (HeistState n -> HeistState n) -> HeistT n m ()
forall (m :: * -> *) (n :: * -> *).
Monad m =>
(HeistState n -> HeistState n) -> HeistT n m ()
modifyHS (\HeistState n
st -> HeistState n
st { _recurse :: Bool
_recurse = Bool
False })
runNode :: Monad n => X.Node -> Splice n
runNode :: Node -> Splice n
runNode (X.Element Text
nm [(Text, Text)]
at Template
ch) = do
[(Text, Text)]
newAtts <- [(Text, Text)] -> HeistT n n [(Text, Text)]
forall (n :: * -> *).
Monad n =>
[(Text, Text)] -> HeistT n n [(Text, Text)]
runAttributes [(Text, Text)]
at
let n :: Node
n = Text -> [(Text, Text)] -> Template -> Node
X.Element Text
nm [(Text, Text)]
newAtts Template
ch
Maybe (Splice n)
s <- (HeistState n -> Maybe (Splice n))
-> HeistT n n (HeistState n) -> HeistT n n (Maybe (Splice n))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Text -> HeistState n -> Maybe (Splice n)
forall (n :: * -> *). Text -> HeistState n -> Maybe (Splice n)
lookupSplice Text
nm) HeistT n n (HeistState n)
forall (m :: * -> *) (n :: * -> *).
Monad m =>
HeistT n m (HeistState n)
getHS
Splice n -> (Splice n -> Splice n) -> Maybe (Splice n) -> Splice n
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([(Text, Text)] -> Splice n
forall (n :: * -> *).
Monad n =>
[(Text, Text)] -> HeistT n n Template
runKids [(Text, Text)]
newAtts) (Node -> Splice n -> Splice n
forall (n :: * -> *). Monad n => Node -> Splice n -> Splice n
recurseSplice Node
n) Maybe (Splice n)
s
where
runKids :: [(Text, Text)] -> HeistT n n Template
runKids [(Text, Text)]
newAtts = do
Template
newKids <- Template -> HeistT n n Template
forall (n :: * -> *). Monad n => Template -> Splice n
runNodeList Template
ch
Template -> HeistT n n Template
forall (m :: * -> *) a. Monad m => a -> m a
return [Text -> [(Text, Text)] -> Template -> Node
X.Element Text
nm [(Text, Text)]
newAtts Template
newKids]
runNode Node
n = Template -> Splice n
forall (m :: * -> *) a. Monad m => a -> m a
return [Node
n]
runAttributes :: Monad n => [(Text, Text)] -> HeistT n n [(Text, Text)]
runAttributes :: [(Text, Text)] -> HeistT n n [(Text, Text)]
runAttributes [(Text, Text)]
attrs = ([(Text, Text)] -> HeistT n n [(Text, Text)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Text, Text)] -> HeistT n n [(Text, Text)])
-> ([[(Text, Text)]] -> [(Text, Text)])
-> [[(Text, Text)]]
-> HeistT n n [(Text, Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[(Text, Text)]] -> [(Text, Text)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat) ([[(Text, Text)]] -> HeistT n n [(Text, Text)])
-> HeistT n n [[(Text, Text)]] -> HeistT n n [(Text, Text)]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ((Text, Text) -> HeistT n n [(Text, Text)])
-> [(Text, Text)] -> HeistT n n [[(Text, Text)]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Text, Text) -> HeistT n n [(Text, Text)]
forall (n :: * -> *).
Monad n =>
(Text, Text) -> HeistT n n [(Text, Text)]
runAttrSplice [(Text, Text)]
attrs
runAttrSplice :: (Monad n) => (Text, Text) -> HeistT n n [(Text, Text)]
runAttrSplice :: (Text, Text) -> HeistT n n [(Text, Text)]
runAttrSplice a :: (Text, Text)
a@(Text
k,Text
v) = do
Maybe (AttrSplice n)
splice <- (HeistState n -> Maybe (AttrSplice n))
-> HeistT n n (Maybe (AttrSplice n))
forall (m :: * -> *) (n :: * -> *) r.
Monad m =>
(HeistState n -> r) -> HeistT n m r
getsHS (Text -> HashMap Text (AttrSplice n) -> Maybe (AttrSplice n)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup Text
k (HashMap Text (AttrSplice n) -> Maybe (AttrSplice n))
-> (HeistState n -> HashMap Text (AttrSplice n))
-> HeistState n
-> Maybe (AttrSplice n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HeistState n -> HashMap Text (AttrSplice n)
forall (m :: * -> *). HeistState m -> HashMap Text (AttrSplice m)
_attrSpliceMap)
HeistT n n [(Text, Text)]
-> (AttrSplice n -> HeistT n n [(Text, Text)])
-> Maybe (AttrSplice n)
-> HeistT n n [(Text, Text)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (((Text, Text) -> [(Text, Text)])
-> HeistT n n (Text, Text) -> HeistT n n [(Text, Text)]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ((Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
:[]) (HeistT n n (Text, Text) -> HeistT n n [(Text, Text)])
-> HeistT n n (Text, Text) -> HeistT n n [(Text, Text)]
forall a b. (a -> b) -> a -> b
$ (Text, Text) -> HeistT n n (Text, Text)
forall (n :: * -> *) t.
Monad n =>
(t, Text) -> HeistT n n (t, Text)
attSubst (Text, Text)
a)
(n [(Text, Text)] -> HeistT n n [(Text, Text)]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (n [(Text, Text)] -> HeistT n n [(Text, Text)])
-> (AttrSplice n -> n [(Text, Text)])
-> AttrSplice n
-> HeistT n n [(Text, Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StateT HeterogeneousEnvironment n [(Text, Text)]
-> HeterogeneousEnvironment -> n [(Text, Text)])
-> HeterogeneousEnvironment
-> StateT HeterogeneousEnvironment n [(Text, Text)]
-> n [(Text, Text)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT HeterogeneousEnvironment n [(Text, Text)]
-> HeterogeneousEnvironment -> n [(Text, Text)]
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT HeterogeneousEnvironment
HE.empty (StateT HeterogeneousEnvironment n [(Text, Text)]
-> n [(Text, Text)])
-> (AttrSplice n
-> StateT HeterogeneousEnvironment n [(Text, Text)])
-> AttrSplice n
-> n [(Text, Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RuntimeSplice n [(Text, Text)]
-> StateT HeterogeneousEnvironment n [(Text, Text)]
forall (m :: * -> *) a.
RuntimeSplice m a -> StateT HeterogeneousEnvironment m a
unRT (RuntimeSplice n [(Text, Text)]
-> StateT HeterogeneousEnvironment n [(Text, Text)])
-> (AttrSplice n -> RuntimeSplice n [(Text, Text)])
-> AttrSplice n
-> StateT HeterogeneousEnvironment n [(Text, Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AttrSplice n -> AttrSplice n
forall a b. (a -> b) -> a -> b
$Text
v)) Maybe (AttrSplice n)
splice
attSubst :: (Monad n) => (t, Text) -> HeistT n n (t, Text)
attSubst :: (t, Text) -> HeistT n n (t, Text)
attSubst (t
n,Text
v) = do
Text
v' <- Text -> HeistT n n Text
forall (n :: * -> *). Monad n => Text -> HeistT n n Text
parseAtt Text
v
(t, Text) -> HeistT n n (t, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (t
n,Text
v')
parseAtt :: (Monad n) => Text -> HeistT n n Text
parseAtt :: Text -> HeistT n n Text
parseAtt Text
bs = do
let ast :: [AttAST]
ast = case IResult Text [AttAST] -> Text -> IResult Text [AttAST]
forall i r. Monoid i => IResult i r -> i -> IResult i r
AP.feed (Parser [AttAST] -> Text -> IResult Text [AttAST]
forall a. Parser a -> Text -> Result a
AP.parse Parser [AttAST]
attParser Text
bs) Text
"" of
(AP.Done Text
_ [AttAST]
res) -> [AttAST]
res
(AP.Fail Text
_ [FilePath]
_ FilePath
_) -> []
(AP.Partial Text -> IResult Text [AttAST]
_) -> []
[Text]
chunks <- (AttAST -> HeistT n n Text) -> [AttAST] -> HeistT n n [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM AttAST -> HeistT n n Text
forall (m :: * -> *). Monad m => AttAST -> HeistT m m Text
cvt [AttAST]
ast
Text -> HeistT n n Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> HeistT n n Text) -> Text -> HeistT n n Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat [Text]
chunks
where
cvt :: AttAST -> HeistT m m Text
cvt (Literal Text
x) = Text -> HeistT m m Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
x
cvt (Ident Text
x) =
(Node -> Node) -> HeistT m m Text -> HeistT m m Text
forall (m :: * -> *) (n :: * -> *) a.
Monad m =>
(Node -> Node) -> HeistT n m a -> HeistT n m a
localParamNode (Node -> Node -> Node
forall a b. a -> b -> a
const (Node -> Node -> Node) -> Node -> Node -> Node
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> Template -> Node
X.Element Text
x [] []) (HeistT m m Text -> HeistT m m Text)
-> HeistT m m Text -> HeistT m m Text
forall a b. (a -> b) -> a -> b
$ Text -> HeistT m m Text
forall (n :: * -> *). Monad n => Text -> HeistT n n Text
getAttributeSplice Text
x
getAttributeSplice :: Monad n => Text -> HeistT n n Text
getAttributeSplice :: Text -> HeistT n n Text
getAttributeSplice Text
name = do
HeistState n
hs <- HeistT n n (HeistState n)
forall (m :: * -> *) (n :: * -> *).
Monad m =>
HeistT n m (HeistState n)
getHS
let noSplice :: m Text
noSplice = Text -> m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> m Text) -> Text -> m Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat [Text
"${", Text
name, Text
"}"]
s :: Maybe (Splice n)
s = Text -> HeistState n -> Maybe (Splice n)
forall (n :: * -> *). Text -> HeistState n -> Maybe (Splice n)
lookupSplice Text
name HeistState n
hs
HeistT n n Text
-> (Splice n -> HeistT n n Text)
-> Maybe (Splice n)
-> HeistT n n Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe HeistT n n Text
forall (m :: * -> *). Monad m => m Text
noSplice ((Template -> Text) -> Splice n -> HeistT n n Text
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ([Text] -> Text
T.concat ([Text] -> Text) -> (Template -> [Text]) -> Template -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Node -> Text) -> Template -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Node -> Text
X.nodeText)) Maybe (Splice n)
s
runNodeList :: Monad n => [X.Node] -> Splice n
runNodeList :: Template -> Splice n
runNodeList = (Node -> Splice n) -> Template -> Splice n
forall (m :: * -> *) b a.
(Monad m, Monoid b) =>
(a -> m b) -> [a] -> m b
mapSplices Node -> Splice n
forall (n :: * -> *). Monad n => Node -> Splice n
runNode
{-# INLINE runNodeList #-}
mAX_RECURSION_DEPTH :: Int
mAX_RECURSION_DEPTH :: Int
mAX_RECURSION_DEPTH = Int
50
recurseSplice :: Monad n => X.Node -> Splice n -> Splice n
recurseSplice :: Node -> Splice n -> Splice n
recurseSplice Node
node Splice n
splice = do
Template
result <- (Node -> Node) -> Splice n -> Splice n
forall (m :: * -> *) (n :: * -> *) a.
Monad m =>
(Node -> Node) -> HeistT n m a -> HeistT n m a
localParamNode (Node -> Node -> Node
forall a b. a -> b -> a
const Node
node) Splice n
splice
HeistState n
hs <- HeistT n n (HeistState n)
forall (m :: * -> *) (n :: * -> *).
Monad m =>
HeistT n m (HeistState n)
getHS
if HeistState n -> Bool
forall (m :: * -> *). HeistState m -> Bool
_recurse HeistState n
hs
then if HeistState n -> Int
forall (m :: * -> *). HeistState m -> Int
_recursionDepth HeistState n
hs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
mAX_RECURSION_DEPTH
then do (Int -> Int) -> HeistT n n ()
forall (m :: * -> *) (n :: * -> *).
Monad m =>
(Int -> Int) -> HeistT n m ()
modRecursionDepth (Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
Template
res <- Template -> Splice n
forall (n :: * -> *). Monad n => Template -> Splice n
runNodeList Template
result
HeistState n -> HeistT n n ()
forall (m :: * -> *) (n :: * -> *).
Monad m =>
HeistState n -> HeistT n m ()
restoreHS HeistState n
hs
Template -> Splice n
forall (m :: * -> *) a. Monad m => a -> m a
return Template
res
else Template -> Splice n
forall (m :: * -> *) a. Monad m => a -> m a
return Template
result Splice n -> FilePath -> Splice n
forall (m :: * -> *) (n :: * -> *) b.
Monad m =>
HeistT n m b -> FilePath -> HeistT n m b
`orError` FilePath
err
else do (HeistState n -> HeistState n) -> HeistT n n ()
forall (m :: * -> *) (n :: * -> *).
Monad m =>
(HeistState n -> HeistState n) -> HeistT n m ()
modifyHS (\HeistState n
st -> HeistState n
st { _recurse :: Bool
_recurse = Bool
True })
Template -> Splice n
forall (m :: * -> *) a. Monad m => a -> m a
return Template
result
where
err :: FilePath
err = [FilePath] -> FilePath
unwords
[FilePath
"Recursion limit reached in node"
,FilePath
"<"FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++(Text -> FilePath
T.unpack (Text -> FilePath) -> Text -> FilePath
forall a b. (a -> b) -> a -> b
$ Node -> Text
X.elementTag Node
node)FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
">. You"
,FilePath
"probably have infinite splice recursion!"
]
lookupAndRun :: Monad m
=> ByteString
-> ((DocumentFile, TPath) -> HeistT n m (Maybe a))
-> HeistT n m (Maybe a)
lookupAndRun :: ByteString
-> ((DocumentFile, TPath) -> HeistT n m (Maybe a))
-> HeistT n m (Maybe a)
lookupAndRun ByteString
name (DocumentFile, TPath) -> HeistT n m (Maybe a)
k = do
HeistState n
hs <- HeistT n m (HeistState n)
forall (m :: * -> *) (n :: * -> *).
Monad m =>
HeistT n m (HeistState n)
getHS
let mt :: Maybe (DocumentFile, TPath)
mt = ByteString
-> HeistState n
-> (HeistState n -> HashMap TPath DocumentFile)
-> Maybe (DocumentFile, TPath)
forall (n :: * -> *) t.
ByteString
-> HeistState n
-> (HeistState n -> HashMap TPath t)
-> Maybe (t, TPath)
lookupTemplate ByteString
name HeistState n
hs HeistState n -> HashMap TPath DocumentFile
forall (m :: * -> *). HeistState m -> HashMap TPath DocumentFile
_templateMap
let curPath :: Maybe FilePath
curPath = Maybe (Maybe FilePath) -> Maybe FilePath
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe (Maybe FilePath) -> Maybe FilePath)
-> Maybe (Maybe FilePath) -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$ ((DocumentFile, TPath) -> Maybe FilePath)
-> Maybe (DocumentFile, TPath) -> Maybe (Maybe FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (DocumentFile -> Maybe FilePath
dfFile (DocumentFile -> Maybe FilePath)
-> ((DocumentFile, TPath) -> DocumentFile)
-> (DocumentFile, TPath)
-> Maybe FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DocumentFile, TPath) -> DocumentFile
forall a b. (a, b) -> a
fst) Maybe (DocumentFile, TPath)
mt
(HeistState n -> HeistState n) -> HeistT n m ()
forall (m :: * -> *) (n :: * -> *).
Monad m =>
(HeistState n -> HeistState n) -> HeistT n m ()
modifyHS (Maybe FilePath -> HeistState n -> HeistState n
forall (n :: * -> *).
Maybe FilePath -> HeistState n -> HeistState n
setCurTemplateFile Maybe FilePath
curPath)
HeistT n m (Maybe a)
-> ((DocumentFile, TPath) -> HeistT n m (Maybe a))
-> Maybe (DocumentFile, TPath)
-> HeistT n m (Maybe a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe a -> HeistT n m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing) (DocumentFile, TPath) -> HeistT n m (Maybe a)
k Maybe (DocumentFile, TPath)
mt
evalTemplate :: Monad n
=> ByteString
-> HeistT n n (Maybe Template)
evalTemplate :: ByteString -> HeistT n n (Maybe Template)
evalTemplate ByteString
name = ByteString
-> ((DocumentFile, TPath) -> HeistT n n (Maybe Template))
-> HeistT n n (Maybe Template)
forall (m :: * -> *) (n :: * -> *) a.
Monad m =>
ByteString
-> ((DocumentFile, TPath) -> HeistT n m (Maybe a))
-> HeistT n m (Maybe a)
lookupAndRun ByteString
name
(\(DocumentFile
t,TPath
ctx) -> (HeistState n -> HeistState n)
-> HeistT n n (Maybe Template) -> HeistT n n (Maybe Template)
forall (m :: * -> *) (n :: * -> *) a.
Monad m =>
(HeistState n -> HeistState n) -> HeistT n m a -> HeistT n m a
localHS (\HeistState n
hs -> HeistState n
hs {_curContext :: TPath
_curContext = TPath
ctx})
((Template -> Maybe Template)
-> HeistT n n Template -> HeistT n n (Maybe Template)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Template -> Maybe Template
forall a. a -> Maybe a
Just (HeistT n n Template -> HeistT n n (Maybe Template))
-> HeistT n n Template -> HeistT n n (Maybe Template)
forall a b. (a -> b) -> a -> b
$ Template -> HeistT n n Template
forall (n :: * -> *). Monad n => Template -> Splice n
runNodeList (Template -> HeistT n n Template)
-> Template -> HeistT n n Template
forall a b. (a -> b) -> a -> b
$ Document -> Template
X.docContent (Document -> Template) -> Document -> Template
forall a b. (a -> b) -> a -> b
$ DocumentFile -> Document
dfDoc DocumentFile
t))
fixDocType :: Monad m => X.Document -> HeistT n m X.Document
fixDocType :: Document -> HeistT n m Document
fixDocType Document
d = do
[DocType]
dts <- (HeistState n -> [DocType]) -> HeistT n m [DocType]
forall (m :: * -> *) (n :: * -> *) r.
Monad m =>
(HeistState n -> r) -> HeistT n m r
getsHS HeistState n -> [DocType]
forall (m :: * -> *). HeistState m -> [DocType]
_doctypes
Document -> HeistT n m Document
forall (m :: * -> *) a. Monad m => a -> m a
return (Document -> HeistT n m Document)
-> Document -> HeistT n m Document
forall a b. (a -> b) -> a -> b
$ Document
d { docType :: Maybe DocType
X.docType = [DocType] -> Maybe DocType
forall a. [a] -> Maybe a
listToMaybe [DocType]
dts }
evalWithDoctypes :: Monad n
=> ByteString
-> HeistT n n (Maybe X.Document)
evalWithDoctypes :: ByteString -> HeistT n n (Maybe Document)
evalWithDoctypes ByteString
name = ByteString
-> ((DocumentFile, TPath) -> HeistT n n (Maybe Document))
-> HeistT n n (Maybe Document)
forall (m :: * -> *) (n :: * -> *) a.
Monad m =>
ByteString
-> ((DocumentFile, TPath) -> HeistT n m (Maybe a))
-> HeistT n m (Maybe a)
lookupAndRun ByteString
name (((DocumentFile, TPath) -> HeistT n n (Maybe Document))
-> HeistT n n (Maybe Document))
-> ((DocumentFile, TPath) -> HeistT n n (Maybe Document))
-> HeistT n n (Maybe Document)
forall a b. (a -> b) -> a -> b
$ \(DocumentFile
t,TPath
ctx) -> do
[DocType] -> HeistT n n ()
forall (m :: * -> *) (n :: * -> *).
Monad m =>
[DocType] -> HeistT n m ()
addDoctype ([DocType] -> HeistT n n ()) -> [DocType] -> HeistT n n ()
forall a b. (a -> b) -> a -> b
$ Maybe DocType -> [DocType]
forall a. Maybe a -> [a]
maybeToList (Maybe DocType -> [DocType]) -> Maybe DocType -> [DocType]
forall a b. (a -> b) -> a -> b
$ Document -> Maybe DocType
X.docType (Document -> Maybe DocType) -> Document -> Maybe DocType
forall a b. (a -> b) -> a -> b
$ DocumentFile -> Document
dfDoc DocumentFile
t
HeistState n
hs <- HeistT n n (HeistState n)
forall (m :: * -> *) (n :: * -> *).
Monad m =>
HeistT n m (HeistState n)
getHS
let nodes :: Template
nodes = Document -> Template
X.docContent (Document -> Template) -> Document -> Template
forall a b. (a -> b) -> a -> b
$ DocumentFile -> Document
dfDoc DocumentFile
t
HeistState n -> HeistT n n ()
forall (m :: * -> *) (n :: * -> *).
Monad m =>
HeistState n -> HeistT n m ()
putHS (HeistState n
hs {_curContext :: TPath
_curContext = TPath
ctx})
Template
newNodes <- Template -> Splice n
forall (n :: * -> *). Monad n => Template -> Splice n
runNodeList Template
nodes
HeistState n -> HeistT n n ()
forall (m :: * -> *) (n :: * -> *).
Monad m =>
HeistState n -> HeistT n m ()
restoreHS HeistState n
hs
Document
newDoc <- Document -> HeistT n n Document
forall (m :: * -> *) (n :: * -> *).
Monad m =>
Document -> HeistT n m Document
fixDocType (Document -> HeistT n n Document)
-> Document -> HeistT n n Document
forall a b. (a -> b) -> a -> b
$ (DocumentFile -> Document
dfDoc DocumentFile
t) { docContent :: Template
X.docContent = Template
newNodes }
Maybe Document -> HeistT n n (Maybe Document)
forall (m :: * -> *) a. Monad m => a -> m a
return (Document -> Maybe Document
forall a. a -> Maybe a
Just Document
newDoc)
bindStrings :: Monad n
=> Splices Text
-> HeistState n
-> HeistState n
bindStrings :: Splices Text -> HeistState n -> HeistState n
bindStrings Splices Text
splices = Splices (Splice n) -> HeistState n -> HeistState n
forall (n :: * -> *).
Splices (Splice n) -> HeistState n -> HeistState n
bindSplices ((Text -> Splice n) -> Splices Text -> Splices (Splice n)
forall v1 v2 k a. (v1 -> v2) -> MapSyntaxM k v1 a -> MapSyntax k v2
mapV Text -> Splice n
forall (m :: * -> *) (n :: * -> *).
Monad m =>
Text -> HeistT n m Template
textSplice Splices Text
splices)
bindString :: Monad n
=> Text
-> Text
-> HeistState n
-> HeistState n
bindString :: Text -> Text -> HeistState n -> HeistState n
bindString Text
n = Text -> Splice n -> HeistState n -> HeistState n
forall (n :: * -> *).
Text -> Splice n -> HeistState n -> HeistState n
bindSplice Text
n (Splice n -> HeistState n -> HeistState n)
-> (Text -> Splice n) -> Text -> HeistState n -> HeistState n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Splice n
forall (m :: * -> *) (n :: * -> *).
Monad m =>
Text -> HeistT n m Template
textSplice
callTemplate :: Monad n
=> ByteString
-> Splices (Splice n)
-> HeistT n n Template
callTemplate :: ByteString -> Splices (Splice n) -> Splice n
callTemplate ByteString
name Splices (Splice n)
splices = do
(HeistState n -> HeistState n) -> HeistT n n ()
forall (m :: * -> *) (n :: * -> *).
Monad m =>
(HeistState n -> HeistState n) -> HeistT n m ()
modifyHS ((HeistState n -> HeistState n) -> HeistT n n ())
-> (HeistState n -> HeistState n) -> HeistT n n ()
forall a b. (a -> b) -> a -> b
$ Splices (Splice n) -> HeistState n -> HeistState n
forall (n :: * -> *).
Splices (Splice n) -> HeistState n -> HeistState n
bindSplices Splices (Splice n)
splices
(Maybe Template -> Template)
-> HeistT n n (Maybe Template) -> Splice n
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Template -> (Template -> Template) -> Maybe Template -> Template
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Template -> Template
forall a. a -> a
id) (HeistT n n (Maybe Template) -> Splice n)
-> HeistT n n (Maybe Template) -> Splice n
forall a b. (a -> b) -> a -> b
$ ByteString -> HeistT n n (Maybe Template)
forall (n :: * -> *).
Monad n =>
ByteString -> HeistT n n (Maybe Template)
evalTemplate ByteString
name
callTemplateWithText :: Monad n
=> ByteString
-> Splices Text
-> HeistT n n Template
callTemplateWithText :: ByteString -> Splices Text -> HeistT n n Template
callTemplateWithText ByteString
name Splices Text
splices = ByteString -> Splices (HeistT n n Template) -> HeistT n n Template
forall (n :: * -> *).
Monad n =>
ByteString -> Splices (Splice n) -> Splice n
callTemplate ByteString
name (Splices (HeistT n n Template) -> HeistT n n Template)
-> Splices (HeistT n n Template) -> HeistT n n Template
forall a b. (a -> b) -> a -> b
$ (Text -> HeistT n n Template)
-> Splices Text -> Splices (HeistT n n Template)
forall v1 v2 k a. (v1 -> v2) -> MapSyntaxM k v1 a -> MapSyntax k v2
mapV Text -> HeistT n n Template
forall (m :: * -> *) (n :: * -> *).
Monad m =>
Text -> HeistT n m Template
textSplice Splices Text
splices
renderTemplate :: Monad n
=> HeistState n
-> ByteString
-> n (Maybe (Builder, MIMEType))
renderTemplate :: HeistState n -> ByteString -> n (Maybe (Builder, ByteString))
renderTemplate HeistState n
hs ByteString
name = HeistT n n (Maybe (Builder, ByteString))
-> Node -> HeistState n -> n (Maybe (Builder, ByteString))
forall (m :: * -> *) (n :: * -> *) a.
Monad m =>
HeistT n m a -> Node -> HeistState n -> m a
evalHeistT HeistT n n (Maybe (Builder, ByteString))
forall (n :: * -> *).
Monad n =>
HeistT n n (Maybe (Builder, ByteString))
tpl (Text -> Node
X.TextNode Text
"") HeistState n
hs
where tpl :: HeistT n n (Maybe (Builder, ByteString))
tpl = do Maybe Document
mt <- ByteString -> HeistT n n (Maybe Document)
forall (n :: * -> *).
Monad n =>
ByteString -> HeistT n n (Maybe Document)
evalWithDoctypes ByteString
name
case Maybe Document
mt of
Maybe Document
Nothing -> Maybe (Builder, ByteString)
-> HeistT n n (Maybe (Builder, ByteString))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Builder, ByteString)
forall a. Maybe a
Nothing
Just Document
doc -> Maybe (Builder, ByteString)
-> HeistT n n (Maybe (Builder, ByteString))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Builder, ByteString)
-> HeistT n n (Maybe (Builder, ByteString)))
-> Maybe (Builder, ByteString)
-> HeistT n n (Maybe (Builder, ByteString))
forall a b. (a -> b) -> a -> b
$ (Builder, ByteString) -> Maybe (Builder, ByteString)
forall a. a -> Maybe a
Just ((Builder, ByteString) -> Maybe (Builder, ByteString))
-> (Builder, ByteString) -> Maybe (Builder, ByteString)
forall a b. (a -> b) -> a -> b
$ (Document -> Builder
X.render Document
doc, Document -> ByteString
mimeType Document
doc)
renderWithArgs :: Monad n
=> Splices Text
-> HeistState n
-> ByteString
-> n (Maybe (Builder, MIMEType))
renderWithArgs :: Splices Text
-> HeistState n -> ByteString -> n (Maybe (Builder, ByteString))
renderWithArgs Splices Text
args HeistState n
hs = HeistState n -> ByteString -> n (Maybe (Builder, ByteString))
forall (n :: * -> *).
Monad n =>
HeistState n -> ByteString -> n (Maybe (Builder, ByteString))
renderTemplate (Splices Text -> HeistState n -> HeistState n
forall (n :: * -> *).
Monad n =>
Splices Text -> HeistState n -> HeistState n
bindStrings Splices Text
args HeistState n
hs)
renderTemplateToDoc :: Monad n
=> HeistState n
-> ByteString
-> n (Maybe X.Document)
renderTemplateToDoc :: HeistState n -> ByteString -> n (Maybe Document)
renderTemplateToDoc HeistState n
hs ByteString
name =
HeistT n n (Maybe Document)
-> Node -> HeistState n -> n (Maybe Document)
forall (m :: * -> *) (n :: * -> *) a.
Monad m =>
HeistT n m a -> Node -> HeistState n -> m a
evalHeistT (ByteString -> HeistT n n (Maybe Document)
forall (n :: * -> *).
Monad n =>
ByteString -> HeistT n n (Maybe Document)
evalWithDoctypes ByteString
name) (Text -> Node
X.TextNode Text
"") HeistState n
hs