content: {-# 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
  
  
  ------------------------------------------------------------------------------
  -- | Default name for the apply splice.
  applyTag :: Text
  applyTag = "apply"
  
  
  ------------------------------------------------------------------------------
  -- | Default attribute name for the apply tag.
  applyAttr :: Text
  applyAttr = "template"
  
  
  ------------------------------------------------------------------------------
  -- | 
  rawApply :: (Monad n)
           => Text
           -> [X.Node]
           -> Maybe FilePath
           -> TPath
           -> [X.Node]
           -> Splice n
  rawApply paramTag calledNodes templateFile newContext paramNodes = do
      hs <- getHS  -- Can't use localHS here because the modifier is not pure
      processedParams <- runNodeList paramNodes
  
      -- apply should do a bottom-up traversal, so we run the called nodes
      -- before doing <content/> substitution.
      modifyHS (setCurContext newContext . setCurTemplateFile templateFile)
  
      let process = concatMap (treeMap processedParams)
      if _recursionDepth hs < mAX_RECURSION_DEPTH
        then do modRecursionDepth (+1)
                res <- runNodeList calledNodes
                restoreHS hs
                return $! process res
        else do restoreHS hs
                (return []) `orError` err
    where
      err = "template recursion exceeded max depth, "++
            "you probably have infinite splice recursion!" :: String
      treeMap :: [X.Node] -> X.Node -> [X.Node]
      treeMap ns n@(X.Element nm _ cs)
        | nm == paramTag = ns
        | otherwise = [n { X.elementChildren = cs' }]
        where
          !cs' = concatMap (treeMap ns) cs
      treeMap _ n = [n]
  
  
  ------------------------------------------------------------------------------
  -- | Applies a template as if the supplied nodes were the children of the
  -- <apply> tag.
  applyNodes :: Monad n => Template -> Text -> Splice n
  applyNodes nodes template = do
      hs <- getHS
      maybe (return [] `orError` err)
            (\(t,ctx) -> do
                addDoctype $ maybeToList $ X.docType $ dfDoc t
                rawApply "apply-content" (X.docContent $ dfDoc t)
                         (dfFile t) ctx nodes)
            (lookupTemplate (T.encodeUtf8 template) hs _templateMap)
    where
      err = "apply tag cannot find template \""++(T.unpack template)++"\""
  
  
  ------------------------------------------------------------------------------
  -- | Implementation of the apply splice.
  applyImpl :: Monad n => Splice n
  applyImpl = do
      node <- getParamNode
      let err = "must supply \"" ++ T.unpack applyAttr ++
                "\" attribute in <" ++ T.unpack (X.elementTag node) ++ ">"
      case X.getAttribute applyAttr node of
          Nothing   -> return [] `orError` err
          Just template -> applyNodes (X.childNodes node) template
  
  
  ------------------------------------------------------------------------------
  -- | This splice crashes with an error message.  Its purpose is to provide a
  -- load-time warning to anyone still using the old content tag in their
  -- templates.  In Heist 0.10, tho content tag was replaced by two separate
  -- apply-content and bind-content tags used by the apply and bind splices
  -- respectively.
  deprecatedContentCheck :: Monad m => Splice m
  deprecatedContentCheck =
      return [] `orError` unwords
        ["<content> tag deprecated.  Use"
        ,"<apply-content> or <bind-content>"
        ]
  
  