{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
module Shpadoinkle.Backend.Static ( renderStatic ) where
import Control.Compactable
import Data.Monoid ((<>))
import Data.Text
import Shpadoinkle hiding (name, props, text)
renderStatic :: Html m a -> Text
renderStatic = cataH renderTag (const mempty) id
renderTag :: Text -> [(Text, Prop m a)] -> [Text] -> Text
renderTag tag props cs
| isSelfClosing tag = renderSelfClosing tag props
| otherwise = renderWrapping tag props cs
isSelfClosing :: Text -> Bool
isSelfClosing = flip elem
[ "area", "base", "br", "embed", "hr", "iframe"
, "img", "input", "link", "meta", "param", "source", "track" ]
renderWrapping :: Text -> [(Text, Prop m a)] -> [Text] -> Text
renderWrapping tag props cs = renderOpening tag props <> ">"
<> mconcat cs <> "</" <> tag <> ">"
renderSelfClosing :: Text -> [(Text, Prop m a)] -> Text
renderSelfClosing tag props = renderOpening tag props <> " />"
renderOpening :: Text -> [(Text, Prop m a)] -> Text
renderOpening tag props = let ps = renderProps props in
"<" <> tag <> (if Data.Text.null ps then mempty else " " <> ps)
renderProps :: [(Text, Prop m a)] -> Text
renderProps = Data.Text.unwords . fmapMaybe (uncurry renderProp)
renderProp :: Text -> Prop m a -> Maybe Text
renderProp name = cataProp renderTextProp renderListener renderFlag
where renderTextProp t = Just $ lice name <> "=\"" <> t <> "\""
renderListener _ = Nothing
renderFlag True = Just name
renderFlag False = Nothing
lice = \case
"className" -> "class"
x -> x