Skip to content

Add documents for HTML target #152

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 2 commits into from
Jul 22, 2017
Merged

Add documents for HTML target #152

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
0adf66f
Add documents for HTML target
AiOO Jul 22, 2017
d5006f0
Fix redundancy and add test
AiOO Jul 22, 2017
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
87 changes: 62 additions & 25 deletions src/Nirum/Targets/Docs.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -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))
Expand All @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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>)
|]
[email protected] { 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}
[email protected] { 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" ++
Expand Down
16 changes: 10 additions & 6 deletions test/Nirum/Targets/DocsSpec.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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>"