module Text.Tamper.Render.Html
( htmlReducer
, htmlEncode
)
where
import Text.Tamper
import Data.Monoid
import Data.String
import qualified Text.Tamper.DOM as DOM
import qualified Data.Text as Text
import qualified Data.Text.Lazy as LText
class Encode t where
encode :: (Char -> t) -> t -> t
instance Encode String where
encode = concatMap
instance Encode Text.Text where
encode f = mconcat . map f . Text.unpack
instance Encode LText.Text where
encode f = mconcat . map f . LText.unpack
htmlEncode :: (Encode t, IsString t) => t -> t
htmlEncode = encode htmlEncodeChar
htmlEncodeChar :: IsString t => Char -> t
htmlEncodeChar '<' = "<"
htmlEncodeChar '>' = ">"
htmlEncodeChar '&' = "&"
htmlEncodeChar '"' = """
htmlEncodeChar '\'' = "'"
htmlEncodeChar c = fromString [c]
htmlReducer :: (Monoid t, Encode t, IsString t) => DOM.NodeList t -> t
htmlReducer = nodeListToHtml
nodeListToHtml :: (Monoid t, Encode t, IsString t) => DOM.NodeList t -> t
nodeListToHtml nodeList =
mconcat $ map nodeToHtml $ DOM.unNodeList nodeList
nodeToHtml :: (Monoid t, Encode t, IsString t) => DOM.Node t -> t
nodeToHtml (DOM.Document children) = "<!DOCTYPE html>\n" <> nodeListToHtml children
nodeToHtml (DOM.Element name attribs children DOM.AutoClosingElement)
| null (DOM.unNodeList children) = nodeToHtml (DOM.Element name attribs children DOM.SingletonElement)
| otherwise = nodeToHtml (DOM.Element name attribs children DOM.ElaborateElement)
nodeToHtml (DOM.Element name attribs children DOM.SingletonElement) =
"<" <> name <> attribsToHtml attribs <> ">"
nodeToHtml (DOM.Element name attribs children DOM.ElaborateElement) =
"<" <> name <> attribsToHtml attribs <> ">" <> nodeListToHtml children <> "</" <> name <> ">"
nodeToHtml (DOM.TextNode text) = htmlEncode text
nodeToHtml (DOM.CDataSection cdata) = "<[!CDATA[" <> cdata <> "]]>"
nodeToHtml (DOM.Comment comment) = "<!-- " <> comment <> " -->"
nodeToHtml (DOM.RawHtml html) = html
attribsToHtml :: (Monoid t, Encode t, IsString t) => DOM.AttribList t -> t
attribsToHtml attribs =
mconcat
[ " " <> attribToHtml name value
| (name, value)
<- DOM.attribItems attribs
]
attribToHtml :: (Monoid t, Encode t, IsString t) => t -> t -> t
attribToHtml name value =
htmlEncode name <> "=\"" <> htmlEncode value <> "\""