{-# 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 n :: Text
n v :: Splice n
v hs :: 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 ss :: Splices (Splice n)
ss hs :: 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 t :: 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 :: 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 f :: 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 nm :: Text
nm hs :: 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 n :: ByteString
n t :: Template
t mfp :: Maybe FilePath
mfp st :: 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 n :: ByteString
n t :: Template
t mfp :: Maybe FilePath
mfp st :: 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 (\st :: 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 nm :: Text
nm at :: [(Text, Text)]
at ch :: 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 newAtts :: [(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 n :: 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 attrs :: [(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@(k :: Text
k,v :: 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 (n :: t
n,v :: 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 bs :: 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) "" of
(AP.Done _ res :: [AttAST]
res) -> [AttAST]
res
(AP.Fail _ _ _) -> []
(AP.Partial _) -> []
[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 x :: Text
x) = Text -> HeistT m m Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
x
cvt (Ident x :: 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 name :: 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
name, "}"]
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 = 50
recurseSplice :: Monad n => X.Node -> Splice n -> Splice n
recurseSplice :: Node -> Splice n -> Splice n
recurseSplice node :: Node
node splice :: 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
+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 (\st :: 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
["Recursion limit reached in node"
,"<"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]
++">. You"
,"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 name :: ByteString
name k :: (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 name :: 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
(\(t :: DocumentFile
t,ctx :: 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 (\hs :: 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 d :: 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 name :: 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
$ \(t :: DocumentFile
t,ctx :: 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 :: 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 n :: 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 name :: ByteString
name splices :: 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 name :: ByteString
name splices :: 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 hs :: HeistState n
hs name :: 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 "") 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
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 doc :: 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 args :: Splices Text
args hs :: 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 hs :: HeistState n
hs name :: 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 "") HeistState n
hs