{-# 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 = "
" renderBlock (Paragraph inlines) = [qq|

{renderInlines inlines}

|] renderBlock (BlockQuote blocks) = [qq|
{renderBlocks blocks}|] renderBlock (HtmlBlock html) = html renderBlock (CodeBlock lang code') = if T.null lang then [qq|
$code'
|] else [qq|
$code'
|] renderBlock (Heading level inlines) = let lv = headingLevelInt level in [qq|{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|] renderBlocks :: [Block] -> Html renderBlocks = T.intercalate "\n" . map renderBlock render :: Block -> Html render = renderBlock