From 0adf66f90ad0307d9db403a4f51b784ae4ffe07b Mon Sep 17 00:00:00 2001
From: Ahn Kiwook <ahnkiwook@gmail.com>
Date: Sat, 22 Jul 2017 15:31:16 +0900
Subject: [PATCH 1/2] Add documents for HTML target

---
 src/Nirum/Targets/Docs.hs | 77 +++++++++++++++++++++++++++------------
 1 file changed, 53 insertions(+), 24 deletions(-)

diff --git a/src/Nirum/Targets/Docs.hs b/src/Nirum/Targets/Docs.hs
index 0fa55c5..be3d4ec 100644
--- a/src/Nirum/Targets/Docs.hs
+++ b/src/Nirum/Targets/Docs.hs
@@ -15,6 +15,7 @@ import Text.Blaze.Html.Renderer.Utf8 (renderHtml)
 import Text.Hamlet (Html, shamlet)
 
 import Nirum.Constructs (Construct (toCode))
+import Nirum.Constructs.Declaration (Documented (docsBlock))
 import qualified Nirum.Constructs.Declaration as DE
 import qualified Nirum.Constructs.DeclarationSet as DES
 import qualified Nirum.Constructs.Docs as D
@@ -31,7 +32,7 @@ import qualified Nirum.Constructs.TypeExpression as TE
 import Nirum.Docs ( Block (Heading)
                   , filterReferences
                   )
-import Nirum.Docs.Html (renderInlines)
+import Nirum.Docs.Html (render, renderInlines)
 import Nirum.Package ( BoundModule (boundPackage, modulePath)
                      , Package (Package, metadata, modules)
                      , resolveBoundModule
@@ -128,60 +129,88 @@ module' docsModule = layout pkg path $ [shamlet|
 
 typeDecl :: BoundModule Docs -> Identifier -> TD.TypeDeclaration -> Html
 typeDecl mod' ident
-         TD.TypeDeclaration { TD.type' = TD.Alias cname } = [shamlet|
+         tc@TD.TypeDeclaration { TD.type' = TD.Alias cname } = [shamlet|
     <h2>type <code>#{toNormalizedText ident}</code>
+    $maybe d <- docsBlock tc
+        <p>#{preEscapedToMarkup $ render d}
     <p>= <span class="canonical-type">#{typeExpression mod' cname}</span>
 |]
 typeDecl mod' ident
-         TD.TypeDeclaration { TD.type' = TD.UnboxedType innerType } = [shamlet|
-    <h2>unboxed <code>#{toNormalizedText ident}</code>
-    <p>(<span class="inner-type">#{typeExpression mod' innerType}</span>)
-|]
+         tc@TD.TypeDeclaration { TD.type' = TD.UnboxedType innerType } =
+    [shamlet|
+        <h2>unboxed <code>#{toNormalizedText ident}</code>
+        $maybe d <- docsBlock tc
+            <p>#{preEscapedToMarkup $ render d}
+        <p>(<span class="inner-type">#{typeExpression mod' innerType}</span>)
+    |]
 typeDecl _ ident
-         TD.TypeDeclaration { TD.type' = TD.EnumType members } = [shamlet|
+         tc@TD.TypeDeclaration { TD.type' = TD.EnumType members } = [shamlet|
     <h2>enum <code>#{toNormalizedText ident}</code>
-    <ul class="members">
+    $maybe d <- docsBlock tc
+        <p>#{preEscapedToMarkup $ render d}
+    <dl class="members">
         $forall decl <- DES.toList members
-            <li class="member"><code>#{nameText $ DE.name decl}</code>
+            <dt class="member-name"><code>#{nameText $ DE.name decl}</code>
+                <dd class="member-doc">
+                    $maybe d <- docsBlock decl
+                        #{preEscapedToMarkup $ render d}
 |]
 typeDecl mod' ident
-         TD.TypeDeclaration { TD.type' = TD.RecordType fields } = [shamlet|
+         tc@TD.TypeDeclaration { TD.type' = TD.RecordType fields } = [shamlet|
     <h2>record <code>#{toNormalizedText ident}</code>
+    $maybe d <- docsBlock tc
+        <p>#{preEscapedToMarkup $ render d}
     <dl class="fields">
         $forall fieldDecl@(TD.Field _ fieldType _) <- DES.toList fields
             <dt class="field-name"><code>#{nameText $ DE.name fieldDecl}</code>
             <dd class="field-type">#{typeExpression mod' fieldType}
+            $maybe d <- docsBlock fieldDecl
+                <dd>#{preEscapedToMarkup $ render d}
 |]
 typeDecl mod' ident
-         TD.TypeDeclaration { TD.type' = TD.UnionType tags } = [shamlet|
+         tc@TD.TypeDeclaration { TD.type' = TD.UnionType tags } = [shamlet|
     <h2>union <code>#{toNormalizedText ident}</code>
+    $maybe d <- docsBlock tc
+        <p>#{preEscapedToMarkup $ render d}
     $forall tagDecl@(TD.Tag _ fields _) <- DES.toList tags
         <h3 class="tag">
             <code>#{nameText $ DE.name tagDecl}
+        $maybe d <- docsBlock tagDecl
+            <p>#{preEscapedToMarkup $ render d}
         <dl class="fields">
             $forall fieldDecl@(TD.Field _ fieldType _) <- DES.toList fields
                 <dt class="field-name">
                     <code>#{nameText $ DE.name fieldDecl}
                 <dd class="field-type">#{typeExpression mod' fieldType}
+                $maybe d <- docsBlock fieldDecl
+                    <dd>#{preEscapedToMarkup $ render d}
 |]
 typeDecl _ ident
          TD.TypeDeclaration { TD.type' = TD.PrimitiveType {} } = [shamlet|
     <h2>primitive <code>#{toNormalizedText ident}</code>
 |]
 typeDecl mod' ident
-         TD.ServiceDeclaration { TD.service = S.Service methods } = [shamlet|
-    <h2>service <code>#{toNormalizedText ident}</code>
-    $forall methodDecl@(S.Method _ params ret err _) <- DES.toList methods
-        <h3 class="method">
-            <code>#{nameText $ DE.name methodDecl}
-        <p class="return-type">#{typeExpression mod' ret}
-        $maybe errType <- err
-            <p class="error-type">#{typeExpression mod' errType}
-        <dl class="parameters">
-            $forall paramDecl@(S.Parameter _ paramType _) <- DES.toList params
-                <dt class="parameter-name">
-                    <code>#{nameText $ DE.name paramDecl}
-                <dd class="parameter-type">#{typeExpression mod' paramType}
+         tc@TD.ServiceDeclaration { TD.service = S.Service methods } =
+    [shamlet|
+        <h2>service <code>#{toNormalizedText ident}</code>
+        $maybe d <- docsBlock tc
+            <p>#{preEscapedToMarkup $ render d}
+        $forall methodDecl@(S.Method _ ps ret err _) <- DES.toList methods
+            <h3 class="method">
+                <code class="method-name">#{nameText $ DE.name methodDecl}()
+                &rarr;
+                <code class="return-type">#{typeExpression mod' ret}
+            $maybe d <- docsBlock methodDecl
+                <p>#{preEscapedToMarkup $ render d}
+            $maybe errType <- err
+                <p class="error-type">#{typeExpression mod' errType}
+            <dl class="parameters">
+                $forall paramDecl@(S.Parameter _ paramType _) <- DES.toList ps
+                    <dt class="parameter-name">
+                        <code>#{nameText $ DE.name paramDecl}
+                    <dd class="parameter-type">#{typeExpression mod' paramType}
+                    $maybe d <- docsBlock paramDecl
+                        <dd>#{preEscapedToMarkup $ render d}
 |]
 typeDecl _ _ TD.Import {} =
     error ("It shouldn't happen; please report it to Nirum's bug tracker:\n" ++

From d5006f0db5b7c17ef16d9cbb3f6e96e366b99a48 Mon Sep 17 00:00:00 2001
From: Ahn Kiwook <ahnkiwook@gmail.com>
Date: Sat, 22 Jul 2017 16:22:05 +0900
Subject: [PATCH 2/2] Fix redundancy and add test

---
 src/Nirum/Targets/Docs.hs      | 34 +++++++++++++++++++++-------------
 test/Nirum/Targets/DocsSpec.hs | 16 ++++++++++------
 2 files changed, 31 insertions(+), 19 deletions(-)

diff --git a/src/Nirum/Targets/Docs.hs b/src/Nirum/Targets/Docs.hs
index be3d4ec..0b22365 100644
--- a/src/Nirum/Targets/Docs.hs
+++ b/src/Nirum/Targets/Docs.hs
@@ -1,5 +1,10 @@
 {-# LANGUAGE OverloadedLists, QuasiQuotes, TypeFamilies #-}
-module Nirum.Targets.Docs (Docs, makeFilePath, makeUri, moduleTitle) where
+module Nirum.Targets.Docs ( Docs
+                          , blockToHtml
+                          , makeFilePath
+                          , makeUri
+                          , moduleTitle
+                          ) where
 
 import Data.Maybe (mapMaybe)
 import GHC.Exts (IsList (fromList, toList))
@@ -127,12 +132,15 @@ module' docsModule = layout pkg path $ [shamlet|
         m <- mod'
         moduleTitle m
 
+blockToHtml :: Block -> Html
+blockToHtml b = preEscapedToMarkup $ render b
+
 typeDecl :: BoundModule Docs -> Identifier -> TD.TypeDeclaration -> Html
 typeDecl mod' ident
          tc@TD.TypeDeclaration { TD.type' = TD.Alias cname } = [shamlet|
     <h2>type <code>#{toNormalizedText ident}</code>
     $maybe d <- docsBlock tc
-        <p>#{preEscapedToMarkup $ render d}
+        <p>#{blockToHtml d}
     <p>= <span class="canonical-type">#{typeExpression mod' cname}</span>
 |]
 typeDecl mod' ident
@@ -140,50 +148,50 @@ typeDecl mod' ident
     [shamlet|
         <h2>unboxed <code>#{toNormalizedText ident}</code>
         $maybe d <- docsBlock tc
-            <p>#{preEscapedToMarkup $ render d}
+            <p>#{blockToHtml d}
         <p>(<span class="inner-type">#{typeExpression mod' innerType}</span>)
     |]
 typeDecl _ ident
          tc@TD.TypeDeclaration { TD.type' = TD.EnumType members } = [shamlet|
     <h2>enum <code>#{toNormalizedText ident}</code>
     $maybe d <- docsBlock tc
-        <p>#{preEscapedToMarkup $ render d}
+        <p>#{blockToHtml d}
     <dl class="members">
         $forall decl <- DES.toList members
             <dt class="member-name"><code>#{nameText $ DE.name decl}</code>
                 <dd class="member-doc">
                     $maybe d <- docsBlock decl
-                        #{preEscapedToMarkup $ render d}
+                        #{blockToHtml d}
 |]
 typeDecl mod' ident
          tc@TD.TypeDeclaration { TD.type' = TD.RecordType fields } = [shamlet|
     <h2>record <code>#{toNormalizedText ident}</code>
     $maybe d <- docsBlock tc
-        <p>#{preEscapedToMarkup $ render d}
+        <p>#{blockToHtml d}
     <dl class="fields">
         $forall fieldDecl@(TD.Field _ fieldType _) <- DES.toList fields
             <dt class="field-name"><code>#{nameText $ DE.name fieldDecl}</code>
             <dd class="field-type">#{typeExpression mod' fieldType}
             $maybe d <- docsBlock fieldDecl
-                <dd>#{preEscapedToMarkup $ render d}
+                <dd>#{blockToHtml d}
 |]
 typeDecl mod' ident
          tc@TD.TypeDeclaration { TD.type' = TD.UnionType tags } = [shamlet|
     <h2>union <code>#{toNormalizedText ident}</code>
     $maybe d <- docsBlock tc
-        <p>#{preEscapedToMarkup $ render d}
+        <p>#{blockToHtml d}
     $forall tagDecl@(TD.Tag _ fields _) <- DES.toList tags
         <h3 class="tag">
             <code>#{nameText $ DE.name tagDecl}
         $maybe d <- docsBlock tagDecl
-            <p>#{preEscapedToMarkup $ render d}
+            <p>#{blockToHtml d}
         <dl class="fields">
             $forall fieldDecl@(TD.Field _ fieldType _) <- DES.toList fields
                 <dt class="field-name">
                     <code>#{nameText $ DE.name fieldDecl}
                 <dd class="field-type">#{typeExpression mod' fieldType}
                 $maybe d <- docsBlock fieldDecl
-                    <dd>#{preEscapedToMarkup $ render d}
+                    <dd>#{blockToHtml d}
 |]
 typeDecl _ ident
          TD.TypeDeclaration { TD.type' = TD.PrimitiveType {} } = [shamlet|
@@ -194,14 +202,14 @@ typeDecl mod' ident
     [shamlet|
         <h2>service <code>#{toNormalizedText ident}</code>
         $maybe d <- docsBlock tc
-            <p>#{preEscapedToMarkup $ render d}
+            <p>#{blockToHtml d}
         $forall methodDecl@(S.Method _ ps ret err _) <- DES.toList methods
             <h3 class="method">
                 <code class="method-name">#{nameText $ DE.name methodDecl}()
                 &rarr;
                 <code class="return-type">#{typeExpression mod' ret}
             $maybe d <- docsBlock methodDecl
-                <p>#{preEscapedToMarkup $ render d}
+                <p>#{blockToHtml d}
             $maybe errType <- err
                 <p class="error-type">#{typeExpression mod' errType}
             <dl class="parameters">
@@ -210,7 +218,7 @@ typeDecl mod' ident
                         <code>#{nameText $ DE.name paramDecl}
                     <dd class="parameter-type">#{typeExpression mod' paramType}
                     $maybe d <- docsBlock paramDecl
-                        <dd>#{preEscapedToMarkup $ render d}
+                        <dd>#{blockToHtml d}
 |]
 typeDecl _ _ TD.Import {} =
     error ("It shouldn't happen; please report it to Nirum's bug tracker:\n" ++
diff --git a/test/Nirum/Targets/DocsSpec.hs b/test/Nirum/Targets/DocsSpec.hs
index b5f479d..918e918 100644
--- a/test/Nirum/Targets/DocsSpec.hs
+++ b/test/Nirum/Targets/DocsSpec.hs
@@ -9,7 +9,8 @@ import Nirum.Constructs.Annotation (empty)
 import Nirum.Constructs.DeclarationSet (DeclarationSet)
 import Nirum.Constructs.Module (Module (..))
 import Nirum.Constructs.TypeDeclaration (TypeDeclaration (Import))
-import qualified Nirum.Targets.Docs as D
+import qualified Nirum.Docs as D
+import qualified Nirum.Targets.Docs as DT
 
 spec :: Spec
 spec = describe "Docs" $ do
@@ -18,12 +19,15 @@ spec = describe "Docs" $ do
         mod2 = Module decls $ Just "module level docs...\nblahblah"
         mod3 = Module decls $ Just "# One Spoqa Trinity Studio\nblahblah"
     specify "makeFilePath" $
-        D.makeFilePath ["foo", "bar", "baz"] `shouldBe`
+        DT.makeFilePath ["foo", "bar", "baz"] `shouldBe`
             "foo" </> "bar" </> "baz" </> "index.html"
     specify "makeUri" $
-        D.makeUri ["foo", "bar", "baz"] `shouldBe` "foo/bar/baz/index.html"
+        DT.makeUri ["foo", "bar", "baz"] `shouldBe` "foo/bar/baz/index.html"
     specify "moduleTitle" $ do
-        fmap renderHtml (D.moduleTitle mod1) `shouldBe` Nothing
-        fmap renderHtml (D.moduleTitle mod2) `shouldBe` Nothing
-        fmap renderHtml (D.moduleTitle mod3) `shouldBe`
+        fmap renderHtml (DT.moduleTitle mod1) `shouldBe` Nothing
+        fmap renderHtml (DT.moduleTitle mod2) `shouldBe` Nothing
+        fmap renderHtml (DT.moduleTitle mod3) `shouldBe`
             Just "One Spoqa Trinity Studio"
+    specify "blockToHtml" $ do
+        let h = D.Paragraph [D.Strong ["Hi!"]]
+        renderHtml (DT.blockToHtml h) `shouldBe` "<p><strong>Hi!</strong></p>"