    module Heist.Splices.Html where

    ------------------------------------------------------------------------------
    import           Data.Maybe
    import           Data.Text (Text)
    import qualified Text.XmlHtml as X

    ------------------------------------------------------------------------------
    import           Heist.Interpreted.Internal
    import           Heist.Internal.Types.HeistState

    ------------------------------------------------------------------------------
    -- | Name for the html splice.
    htmlTag :: Text
    htmlTag :: Text
    htmlTag = Text
    "html"

    ------------------------------------------------------------------------------
    -- | The html splice runs all children and then traverses the returned node
    -- forest removing all head nodes.  Then it merges them all and prepends it to
    -- the html tag's child list.
    htmlImpl :: Monad n => Splice n
    htmlImpl :: forall (n :: * -> *). Monad n => Splice n
    htmlImpl = do
        Node
    node <- HeistT n n Node
    forall (m :: * -> *) (n :: * -> *). Monad m => HeistT n m Node
    getParamNode
        Template
    children <- Template -> Splice n
    forall (n :: * -> *). Monad n => Template -> Splice n
    runNodeList (Template -> Splice n) -> Template -> Splice n
    forall a b. (a -> b) -> a -> b
    $ Node -> Template
    X.childNodes Node
    node
        let (Template
    heads, Maybe Node
    mnode) = Node -> (Template, Maybe Node)
    extractHeads (Node -> (Template, Maybe Node)) -> Node -> (Template, Maybe Node)
    forall a b. (a -> b) -> a -> b
    $ Node
    node { elementChildren :: Template
    X.elementChildren = Template
    children }
            new :: Node -> Node
    new (X.Element Text
    t [(Text, Text)]
    a Template
    c) = Text -> [(Text, Text)] -> Template -> Node
    X.Element Text
    t [(Text, Text)]
    a (Template -> Node) -> Template -> Node
    forall a b. (a -> b) -> a -> b
    $
                Text -> [(Text, Text)] -> Template -> Node
    X.Element Text
    "head" [] Template
    heads Node -> Template -> Template
    forall a. a -> [a] -> [a]
    : Template
    c
            new Node
    n = Node
    n
        HeistT n n ()
    forall (m :: * -> *) (n :: * -> *). Monad m => HeistT n m ()
    stopRecursion
        Template -> Splice n
    forall a. a -> HeistT n n a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [Node -> (Node -> Node) -> Maybe Node -> Node
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Node
    node Node -> Node
    new Maybe Node
    mnode]

    ------------------------------------------------------------------------------
    -- | Extracts all heads from a node tree.
    extractHeads :: X.Node
                 -- ^ The root (html) node
                 -> ([X.Node], Maybe X.Node)
                 -- ^ A tuple of a list of head nodes and the original tree with
                 --   heads removed.
    extractHeads :: Node -> (Template, Maybe Node)
    extractHeads (X.Element Text
    t [(Text, Text)]
    a Template
    c)
      | Text
    t Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    "head" = (Template
    c, Maybe Node
    forall a. Maybe a
    Nothing)
      | Bool
    otherwise   = ([Template] -> Template
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [Template]
    heads, Node -> Maybe Node
    forall a. a -> Maybe a
    Just (Node -> Maybe Node) -> Node -> Maybe Node
    forall a b. (a -> b) -> a -> b
    $ Text -> [(Text, Text)] -> Template -> Node
    X.Element Text
    t [(Text, Text)]
    a ([Maybe Node] -> Template
    forall a. [Maybe a] -> [a]
    catMaybes [Maybe Node]
    mcs))
      where
        ([Template]
    heads, [Maybe Node]
    mcs) = [(Template, Maybe Node)] -> ([Template], [Maybe Node])
    forall a b. [(a, b)] -> ([a], [b])
    unzip ([(Template, Maybe Node)] -> ([Template], [Maybe Node]))
    -> [(Template, Maybe Node)] -> ([Template], [Maybe Node])
    forall a b. (a -> b) -> a -> b
    $ (Node -> (Template, Maybe Node))
    -> Template -> [(Template, Maybe Node)]
    forall a b. (a -> b) -> [a] -> [b]
    map Node -> (Template, Maybe Node)
    extractHeads Template
    c
    extractHeads Node
    n = ([], Node -> Maybe Node
    forall a. a -> Maybe a
    Just Node
    n)