1 module Text.Templating.Heist.Splices.Apply where
    2 
    3 ------------------------------------------------------------------------------
    4 import           Data.Maybe
    5 import           Data.Text (Text)
    6 import qualified Data.Text.Encoding as T
    7 import qualified Text.XmlHtml as X
    8 
    9 ------------------------------------------------------------------------------
   10 import           Text.Templating.Heist.Internal
   11 import           Text.Templating.Heist.Types
   12 
   13 ------------------------------------------------------------------------------
   14 -- | Default name for the apply splice.
   15 applyTag :: Text
   16 applyTag = "apply"
   17 
   18 
   19 ------------------------------------------------------------------------------
   20 -- | Default attribute name for the apply tag.
   21 applyAttr :: Text
   22 applyAttr = "template"
   23 
   24 
   25 ------------------------------------------------------------------------------
   26 -- | Raw core of apply functionality.  This is abstracted for use in other
   27 -- places like an enhanced (from the original) bind
   28 rawApply :: (Monad m)
   29          => [X.Node]
   30          -> TPath
   31          -> [X.Node]
   32          -> HeistT m Template
   33 rawApply calledNodes newContext paramNodes = do
   34     st <- getTS  -- Can't use localTS here because the modifier is not pure
   35     processedParams <- runNodeList paramNodes
   36     modifyTS (bindSplice "content" $ return processedParams)
   37     setContext newContext
   38     result <- runNodeList calledNodes
   39     restoreTS st
   40     return result
   41 
   42 
   43 ------------------------------------------------------------------------------
   44 -- | Applies a template as if the supplied nodes were the children of the
   45 -- <apply> tag.
   46 applyNodes :: Monad m => Template -> Text -> Splice m
   47 applyNodes nodes template = do
   48     st <- getTS
   49     maybe (return []) -- TODO: error handling
   50           (\(t,ctx) -> do
   51               addDoctype $ maybeToList $ X.docType $ dfDoc t
   52               rawApply (X.docContent $ dfDoc t) ctx nodes)
   53           (lookupTemplate (T.encodeUtf8 template) st)
   54 
   55 
   56 ------------------------------------------------------------------------------
   57 -- | Implementation of the apply splice.
   58 applyImpl :: Monad m => Splice m
   59 applyImpl = do
   60     node <- getParamNode
   61     case X.getAttribute applyAttr node of
   62         Nothing   -> return [] -- TODO: error handling
   63         Just template -> applyNodes (X.childNodes node) template
   64 
   65