module Text.XHtmlCombinators.Render
( render, renderPretty
, renderT, renderPrettyT
) where
import Control.Applicative hiding (empty)
import Data.Foldable
import Data.Functor.Identity
import qualified Data.Sequence as Seq
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.IO as T
import qualified Text.XML.Light as XML
import Text.XHtmlCombinators.Internal
lt = T.singleton '<'
gt = T.singleton '>'
space = T.singleton ' '
lts = T.pack "</"
nl = T.singleton '\n'
renderAttrs :: Attrs -> Text
renderAttrs [] = T.empty
renderAttrs attrs = T.concat (space : fmap renderAttr attrs)
where renderAttr (Attr name val) =
T.concat [name, T.pack "=\"", val, T.pack "\""]
renderNode (TextNode t) = t
renderNode (Node name rattrs attrs c)
| Seq.null c = T.concat [lt, name, a, b, gt, lts, name, gt]
| otherwise = T.concat
[lt, name, a, b, gt, fold (fmap renderNode c), lts, name, gt]
where a = renderAttrs rattrs
b = renderAttrs attrs
renderT :: (Functor t, Monad t, Content c) => XHtmlT t c -> t Text
renderT page = do
content <- execXHtml page
return (fold $ renderNode . toContent <$> content)
renderPrettyT :: (Functor t, Monad t, Content c) => XHtmlT t c -> t Text
renderPrettyT page = do
content <- renderT page
return (T.pack . unlines . fmap XML.ppContent . XML.parseXML . T.unpack $ content)
render :: Content c => XHtml c -> Text
render = runIdentity . renderT
renderPretty :: Content c => XHtml c -> Text
renderPretty = runIdentity . renderPrettyT