{-# LANGUAGE OverloadedStrings, QuasiQuotes #-}
module Nirum.Docs.Html (render, renderInline, renderInlines, renderBlock) where
import qualified Data.Text as T
import Text.InterpolatedString.Perl6 (qq)
import Nirum.Docs
renderInline :: Inline -> Html
renderInline (Text t) = escape t
renderInline SoftLineBreak = "\n"
renderInline HardLineBreak = "
"
renderInline (HtmlInline html) = html
renderInline (Code code') = [qq|{escape code'}
|]
renderInline (Emphasis inlines) = [qq|{renderInlines inlines}|]
renderInline (Strong inlines) = [qq|{renderInlines inlines}|]
renderInline (Link url title inlines) =
let body = renderInlines inlines
in
if T.null title
then [qq|$body|]
else [qq|$body|]
renderInline (Image url title) =
if T.null title
then [qq||]
else [qq||]
escape :: T.Text -> Html
escape = T.concatMap escapeChar
escapeChar :: Char -> Html
escapeChar '&' = "&"
escapeChar '"' = """
escapeChar '<' = "<"
escapeChar '>' = ">"
escapeChar c = T.singleton c
renderInlines :: [Inline] -> Html
renderInlines = T.concat . map renderInline
renderBlock :: Block -> Html
renderBlock (Document blocks) = renderBlocks blocks `T.snoc` '\n'
renderBlock ThematicBreak = "
{renderInlines inlines}
|] renderBlock (BlockQuote blocks) = [qq|{renderBlocks blocks}|] renderBlock (HtmlBlock html) = html renderBlock (CodeBlock lang code') = if T.null lang then [qq||] else [qq|$code'
|] renderBlock (Heading level inlines) = let lv = headingLevelInt level in [qq|$code'
{renderInlines inlines} |] renderBlock (List listType itemList) = let liList = case itemList of TightItemList items -> [ [qq|{renderInlines item} |] | item <- items ] LooseItemList items -> [ [qq|{renderBlocks item} |] | item <- items ] tag = case listType of BulletList -> "ul" :: T.Text OrderedList { startNumber = 1 } -> "ol" OrderedList { startNumber = startNumber' } -> [qq|ol start="$startNumber'"|] nl = '\n' liListT = T.intercalate "\n" liList in [qq|<$tag>$nl$liListT$nl$tag>|] renderBlocks :: [Block] -> Html renderBlocks = T.intercalate "\n" . map renderBlock render :: Block -> Html render = renderBlock