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 = "
" +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 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:

    + +

    Loose list:

    +
      +
    1. a

    2. +
    3. b

    4. +
    +

    A complex link.

    +|] + +spec :: Spec +spec = + describe "Docs.Html" $ + specify "render" $ + render sampleDocument `shouldBe` expectedHtml