{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE OverloadedStrings #-}
module Heist.Splices.Apply where
import Data.Maybe
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Text.XmlHtml as X
import Heist.Common
import Heist.Interpreted.Internal
import Heist.Internal.Types.HeistState
applyTag :: Text
applyTag :: Text
applyTag = Text
"apply"
applyAttr :: Text
applyAttr :: Text
applyAttr = Text
"template"
rawApply :: (Monad n)
=> Text
-> [X.Node]
-> Maybe FilePath
-> TPath
-> [X.Node]
-> Splice n
rawApply :: Text -> [Node] -> Maybe FilePath -> TPath -> [Node] -> Splice n
rawApply Text
paramTag [Node]
calledNodes Maybe FilePath
templateFile TPath
newContext [Node]
paramNodes = do
HeistState n
hs <- HeistT n n (HeistState n)
forall (m :: * -> *) (n :: * -> *).
Monad m =>
HeistT n m (HeistState n)
getHS
[Node]
processedParams <- [Node] -> Splice n
forall (n :: * -> *). Monad n => [Node] -> Splice n
runNodeList [Node]
paramNodes
(HeistState n -> HeistState n) -> HeistT n n ()
forall (m :: * -> *) (n :: * -> *).
Monad m =>
(HeistState n -> HeistState n) -> HeistT n m ()
modifyHS (TPath -> HeistState n -> HeistState n
forall (n :: * -> *). TPath -> HeistState n -> HeistState n
setCurContext TPath
newContext (HeistState n -> HeistState n)
-> (HeistState n -> HeistState n) -> HeistState n -> HeistState n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe FilePath -> HeistState n -> HeistState n
forall (n :: * -> *).
Maybe FilePath -> HeistState n -> HeistState n
setCurTemplateFile Maybe FilePath
templateFile)
let process :: t Node -> [Node]
process = (Node -> [Node]) -> t Node -> [Node]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([Node] -> Node -> [Node]
treeMap [Node]
processedParams)
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)
[Node]
res <- [Node] -> Splice n
forall (n :: * -> *). Monad n => [Node] -> Splice n
runNodeList [Node]
calledNodes
HeistState n -> HeistT n n ()
forall (m :: * -> *) (n :: * -> *).
Monad m =>
HeistState n -> HeistT n m ()
restoreHS HeistState n
hs
[Node] -> Splice n
forall (m :: * -> *) a. Monad m => a -> m a
return ([Node] -> Splice n) -> [Node] -> Splice n
forall a b. (a -> b) -> a -> b
$! [Node] -> [Node]
forall (t :: * -> *). Foldable t => t Node -> [Node]
process [Node]
res
else do HeistState n -> HeistT n n ()
forall (m :: * -> *) (n :: * -> *).
Monad m =>
HeistState n -> HeistT n m ()
restoreHS HeistState n
hs
([Node] -> Splice n
forall (m :: * -> *) a. Monad m => a -> m a
return []) Splice n -> FilePath -> Splice n
forall (m :: * -> *) (n :: * -> *) b.
Monad m =>
HeistT n m b -> FilePath -> HeistT n m b
`orError` FilePath
err
where
err :: FilePath
err = FilePath
"template recursion exceeded max depth, "FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
FilePath
"you probably have infinite splice recursion!" :: String
treeMap :: [X.Node] -> X.Node -> [X.Node]
treeMap :: [Node] -> Node -> [Node]
treeMap [Node]
ns n :: Node
n@(X.Element Text
nm [(Text, Text)]
_ [Node]
cs)
| Text
nm Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
paramTag = [Node]
ns
| Bool
otherwise = [Node
n { elementChildren :: [Node]
X.elementChildren = [Node]
cs' }]
where
!cs' :: [Node]
cs' = (Node -> [Node]) -> [Node] -> [Node]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([Node] -> Node -> [Node]
treeMap [Node]
ns) [Node]
cs
treeMap [Node]
_ Node
n = [Node
n]
applyNodes :: Monad n => Template -> Text -> Splice n
applyNodes :: [Node] -> Text -> Splice n
applyNodes [Node]
nodes Text
template = do
HeistState n
hs <- HeistT n n (HeistState n)
forall (m :: * -> *) (n :: * -> *).
Monad m =>
HeistT n m (HeistState n)
getHS
Splice n
-> ((DocumentFile, TPath) -> Splice n)
-> Maybe (DocumentFile, TPath)
-> Splice n
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Node] -> Splice n
forall (m :: * -> *) a. Monad m => a -> m a
return [] Splice n -> FilePath -> Splice n
forall (m :: * -> *) (n :: * -> *) b.
Monad m =>
HeistT n m b -> FilePath -> HeistT n m b
`orError` FilePath
err)
(\(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
Text -> [Node] -> Maybe FilePath -> TPath -> [Node] -> Splice n
forall (n :: * -> *).
Monad n =>
Text -> [Node] -> Maybe FilePath -> TPath -> [Node] -> Splice n
rawApply Text
"apply-content" (Document -> [Node]
X.docContent (Document -> [Node]) -> Document -> [Node]
forall a b. (a -> b) -> a -> b
$ DocumentFile -> Document
dfDoc DocumentFile
t)
(DocumentFile -> Maybe FilePath
dfFile DocumentFile
t) TPath
ctx [Node]
nodes)
(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 (Text -> ByteString
T.encodeUtf8 Text
template) HeistState n
hs HeistState n -> HashMap TPath DocumentFile
forall (m :: * -> *). HeistState m -> HashMap TPath DocumentFile
_templateMap)
where
err :: FilePath
err = FilePath
"apply tag cannot find template \""FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++(Text -> FilePath
T.unpack Text
template)FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
"\""
applyImpl :: Monad n => Splice n
applyImpl :: Splice n
applyImpl = do
Node
node <- HeistT n n Node
forall (m :: * -> *) (n :: * -> *). Monad m => HeistT n m Node
getParamNode
let err :: FilePath
err = FilePath
"must supply \"" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Text -> FilePath
T.unpack Text
applyAttr FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
FilePath
"\" attribute in <" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Text -> FilePath
T.unpack (Node -> Text
X.elementTag Node
node) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
">"
case Text -> Node -> Maybe Text
X.getAttribute Text
applyAttr Node
node of
Maybe Text
Nothing -> [Node] -> Splice n
forall (m :: * -> *) a. Monad m => a -> m a
return [] Splice n -> FilePath -> Splice n
forall (m :: * -> *) (n :: * -> *) b.
Monad m =>
HeistT n m b -> FilePath -> HeistT n m b
`orError` FilePath
err
Just Text
template -> [Node] -> Text -> Splice n
forall (n :: * -> *). Monad n => [Node] -> Text -> Splice n
applyNodes (Node -> [Node]
X.childNodes Node
node) Text
template
deprecatedContentCheck :: Monad m => Splice m
deprecatedContentCheck :: Splice m
deprecatedContentCheck =
[Node] -> Splice m
forall (m :: * -> *) a. Monad m => a -> m a
return [] Splice m -> FilePath -> Splice m
forall (m :: * -> *) (n :: * -> *) b.
Monad m =>
HeistT n m b -> FilePath -> HeistT n m b
`orError` [FilePath] -> FilePath
unwords
[FilePath
"<content> tag deprecated. Use"
,FilePath
"<apply-content> or <bind-content>"
]