module Anansi.Loom.HTML (loomHTML) where
import Control.Monad (forM_)
import Control.Monad.Reader (asks)
import Control.Monad.Writer (tell)
import Data.ByteString (ByteString)
import Data.Monoid (mconcat)
import qualified Data.Text
import Data.Text (Text)
import Data.Text.Encoding (encodeUtf8)
import Anansi.Types
loomHTML :: Loom
loomHTML = mapM_ putBlock . documentBlocks where
putBlock b = case b of
BlockText text -> tell (encodeUtf8 text)
BlockFile path content -> do
epath <- escape path
let label = mconcat ["<b>» ", epath, "</b>"]
putContent label content
BlockDefine name content -> do
ename <- escape name
let label = mconcat ["<b>«", ename, "»</b>"]
putContent label content
putContent label cs = do
tell "<pre>"
tell label
tell "\n"
forM_ cs $ \c -> case c of
ContentText _ text -> do
tell =<< escape text
tell "\n"
ContentMacro _ indent name -> tell =<< formatMacro indent name
tell "</pre>"
formatMacro :: Text -> Text -> LoomM ByteString
formatMacro indent name = do
ename <- escape name
return $ mconcat
[ encodeUtf8 indent
, "<i>«"
, ename
, "»</i>\n"
]
escape :: Text -> LoomM ByteString
escape txt = do
tabSize <- asks loomOptionTabSize
return $ encodeUtf8 $ Data.Text.concatMap (\c -> case c of
'\t' -> Data.Text.replicate (fromInteger tabSize) " "
'&' -> "&"
'<' -> "<"
'>' -> ">"
'"' -> """
'\'' -> "'"
_ -> Data.Text.singleton c) txt