diff --git a/nirum.cabal b/nirum.cabal
index 233825c..922d4e1 100644
--- a/nirum.cabal
+++ b/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
diff --git a/src/Nirum/Docs.hs b/src/Nirum/Docs.hs
index ee68eab..441ba70 100644
--- a/src/Nirum/Docs.hs
+++ b/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
diff --git a/src/Nirum/Docs/Html.hs b/src/Nirum/Docs/Html.hs
new file mode 100644
index 0000000..651d272
--- /dev/null
+++ b/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 = "
"
+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 diff --git a/test/Nirum/Docs/HtmlSpec.hs b/test/Nirum/Docs/HtmlSpec.hs new file mode 100644 index 0000000..d62099c --- /dev/null +++ b/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|Hello
+Tight list:
++
+- List test
+- test2
+Loose list:
++
+- +
a
- +
b
A complex link.
+|] + +spec :: Spec +spec = + describe "Docs.Html" $ + specify "render" $ + render sampleDocument `shouldBe` expectedHtml