{-# LANGUAGE OverloadedStrings, QuasiQuotes #-}
module Nirum.Docs.Html
( render
, renderBlock
, renderInline
, renderInlines
, renderLinklessInlines
) where
import Data.List.NonEmpty
import Prelude hiding (head, zip)
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 . fmap renderInline
renderLinklessInlines :: [Inline] -> Html
renderLinklessInlines inlines = T.concat
[ case i of
Link _ _ inlines' -> renderInlines inlines'
i' -> renderInline i'
| i <- inlines
]
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|$escapedCode
|] where escapedCode :: Html escapedCode = escape code' renderBlock (Heading level inlines anchorId) = let lv = headingLevelInt level id' = case anchorId of Nothing -> "" Just aid -> [qq| id="$aid"|] :: T.Text in [qq|$escapedCode
{renderInlines inlines} |] renderBlock (List listType itemList) = let liList = case itemList of TightItemList items -> [ [qq|{renderTightBlocks 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>|] renderBlock (Table columns rows) = [qq|$lf$lf
|] where lf :: Char lf = '\n' th :: (TableColumn, TableCell) -> Html th (col, cell) = [qq|$lf{T.concat (toList $ fmap th $ zip columns (head rows))} $lf {T.concat (fmap tr $ Data.List.NonEmpty.tail rows)}{renderInlines cell} |] align :: TableColumn -> Html align NotAligned = "" align LeftAligned = " align=\"left\"" align CenterAligned = " align=\"center\"" align RightAligned = " align=\"right\"" tr :: TableRow -> Html tr cells = [qq|$lf{T.concat (toList $ fmap td cells)} |] td :: TableCell -> Html td inlines = [qq|$lf{renderInlines inlines} |] renderBlocks :: [Block] -> Html renderBlocks = T.intercalate "\n" . fmap renderBlock renderTightBlocks :: [Block] -> Html renderTightBlocks blocks = T.intercalate "\n" [ case b of Paragraph inlines -> renderInlines inlines b' -> renderBlock b' | b <- blocks ] render :: Block -> Html render = renderBlock