    {-# 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 :: Text
    applyTag = Text
    "apply"

    ------------------------------------------------------------------------------
    -- | Default attribute name for the apply tag.
    applyAttr :: Text
    applyAttr :: Text
    applyAttr = Text
    "template"

    ------------------------------------------------------------------------------
    -- |
    rawApply :: (Monad n)
             => Text
             -> [X.Node]
             -> Maybe FilePath
             -> TPath
             -> [X.Node]
             -> Splice n
    rawApply :: forall (n :: * -> *).
    Monad n =>
    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  -- Can't use localHS here because the modifier is not pure
        [Node]
    processedParams <- [Node] -> Splice n
    forall (n :: * -> *). Monad n => [Node] -> Splice n
    runNodeList [Node]
    paramNodes

        -- apply should do a bottom-up traversal, so we run the called nodes
        -- before doing <content/> substitution.
        (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 a. a -> HeistT n n a
    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 a. a -> HeistT n n a
    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]

    ------------------------------------------------------------------------------
    -- | Applies a template as if the supplied nodes were the children of the
    -- <apply> tag.
    applyNodes :: Monad n => Template -> Text -> Splice n
    applyNodes :: forall (n :: * -> *). Monad n => [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 a. a -> HeistT n n a
    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
    "\""

    ------------------------------------------------------------------------------
    -- | Implementation of the apply splice.
    applyImpl :: Monad n => Splice n
    applyImpl :: forall (n :: * -> *). Monad n => 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 a. a -> HeistT n n a
    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

    ------------------------------------------------------------------------------
    -- | 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 :: forall (n :: * -> *). Monad n => Splice n
    deprecatedContentCheck =
        [Node] -> HeistT m m [Node]
    forall a. a -> HeistT m m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [] HeistT m m [Node] -> FilePath -> HeistT m m [Node]
    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>"
          ]