Merge pull request #152 from AiOO/improve/make-document-complete-again

Add documents for HTML target
nirum-lang · Jul 22, 2017 · 22947ef · 22947ef
2 parents c59b7ff + d5006f0
commit 22947ef
Show file tree

Hide file tree

Showing 2 changed files with 72 additions and 31 deletions.
diff --git 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))
@@ -15,6 +20,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 +37,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
@@ -126,62 +132,93 @@ 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
-         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>#{blockToHtml 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>#{blockToHtml 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>#{blockToHtml 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
+                        #{blockToHtml 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>#{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>#{blockToHtml 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>#{blockToHtml d}
     $forall tagDecl@(TD.Tag _ fields _) <- DES.toList tags
         <h3 class="tag">
             <code>#{nameText $ DE.name tagDecl}
+        $maybe d <- docsBlock tagDecl
+            <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>#{blockToHtml 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>#{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>#{blockToHtml 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>#{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
@@ -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>"