Docs HTML renderer

nirum.cabal

@@ -40,6 +40,7 @@ library
                  ,     Nirum.Constructs.TypeDeclaration
                  ,     Nirum.Constructs.TypeExpression
                  ,     Nirum.Docs
+                 ,     Nirum.Docs.Html
                  ,     Nirum.Package
                  ,     Nirum.Package.Metadata
                  ,     Nirum.Package.ModuleSet
@@ -115,6 +116,7 @@ test-suite spec
                ,       Nirum.Constructs.TypeDeclarationSpec
                ,       Nirum.Constructs.TypeExpressionSpec
                ,       Nirum.DocsSpec
+               ,       Nirum.Docs.HtmlSpec
                ,       Nirum.Package.MetadataSpec
                ,       Nirum.Package.ModuleSetSpec
                ,       Nirum.PackageSpec

src/Nirum/Docs.hs

@@ -34,6 +34,7 @@ module Nirum.Docs ( Block ( BlockQuote
                   , Title
                   , Url
                   , headingLevelFromInt
+                  , headingLevelInt
                   , parse
                   ) where
 
@@ -57,6 +58,14 @@ headingLevelFromInt 4 = H4
 headingLevelFromInt 5 = H5
 headingLevelFromInt i = if i > 5 then H6 else H1
 
+headingLevelInt :: HeadingLevel -> Int
+headingLevelInt H1 = 1
+headingLevelInt H2 = 2
+headingLevelInt H3 = 3
+headingLevelInt H4 = 4
+headingLevelInt H5 = 5
+headingLevelInt H6 = 6
+
 -- | Whether a list is a bullet list or an ordered list.
 -- See also: http://spec.commonmark.org/0.25/#of-the-same-type
 data ListType = BulletList

src/Nirum/Docs/Html.hs

@@ -0,0 +1,78 @@
+{-# 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 = "<br>"
+renderInline (HtmlInline html) = html
+renderInline (Code code') = [qq|<code>{escape code'}</code>|]
+renderInline (Emphasis inlines) = [qq|<em>{renderInlines inlines}</em>|]
+renderInline (Strong inlines) = [qq|<strong>{renderInlines inlines}</strong>|]
+renderInline (Link url title inlines) =
+    let body = renderInlines inlines
+    in
+        if T.null title
+            then [qq|<a href="{escape url}">$body</a>|]
+            else [qq|<a href="{escape url}" title="{escape title}">$body</a>|]
+renderInline (Image url title) =
+    if T.null title
+        then [qq|<img src="{escape url}">|]
+        else [qq|<img src="{escape url}" title="{escape title}">|]
+
+escape :: T.Text -> Html
+escape = T.concatMap escapeChar
+
+escapeChar :: Char -> Html
+escapeChar '&' = "&amp;"
+escapeChar '"' = "&quot;"
+escapeChar '<' = "&lt;"
+escapeChar '>' = "&gt;"
+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 = "<hr>"
+renderBlock (Paragraph inlines) = [qq|<p>{renderInlines inlines}</p>|]
+renderBlock (BlockQuote blocks) =
+    [qq|<blockquote>{renderBlocks blocks}</blockquotes>|]
+renderBlock (HtmlBlock html) = html
+renderBlock (CodeBlock lang code') =
+    if T.null lang
+    then [qq|<pre><code>$code'</code></pre>|]
+    else [qq|<pre><code class="language-$lang">$code'</code></pre>|]
+renderBlock (Heading level inlines) =
+    let lv = headingLevelInt level
+    in [qq|<h$lv>{renderInlines inlines}</h$lv>|]
+renderBlock (List listType itemList) =
+    let liList = case itemList of
+                     TightItemList items ->
+                         [ [qq|<li>{renderInlines item}</li>|]
+                         | item <- items
+                         ]
+                     LooseItemList items ->
+                         [ [qq|<li>{renderBlocks item}</li>|]
+                         | 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

test/Nirum/Docs/HtmlSpec.hs

@@ -0,0 +1,30 @@
+{-# LANGUAGE QuasiQuotes #-}
+module Nirum.Docs.HtmlSpec where
+
+import Test.Hspec.Meta
+import Text.InterpolatedString.Perl6 (q)
+
+import Nirum.Docs (Html)
+import Nirum.Docs.Html (render)
+import Nirum.DocsSpec (sampleDocument)
+
+expectedHtml :: Html
+expectedHtml = [q|<h1>Hello</h1>
+<p>Tight list:</p>
+<ul>
+<li>List test</li>
+<li>test2</li>
+</ul>
+<p>Loose list:</p>
+<ol>
+<li><p>a</p></li>
+<li><p>b</p></li>
+</ol>
+<p>A <a href="http://nirum.org/" title="Nirum">complex <em>link</em></a>.</p>
+|]
+
+spec :: Spec
+spec =
+    describe "Docs.Html" $
+        specify "render" $
+            render sampleDocument `shouldBe` expectedHtml