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 :: 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 (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)