diff --git a/examples/pdf-service.nrm b/examples/pdf-service.nrm
index d3c1451..ebf5ac9 100644
--- a/examples/pdf-service.nrm
+++ b/examples/pdf-service.nrm
@@ -1,4 +1,6 @@
+type html = text;
+
service pdf-service (
# A microservice which renders a PDF from the given URI or HTML.
@@ -9,6 +11,6 @@ service pdf-service (
binary render-html (
# Renders a PDF from the given HTML text.
- text html,
+ html html,
),
);
diff --git a/nirum.cabal b/nirum.cabal
index 6946b8c..5a02741 100644
--- a/nirum.cabal
+++ b/nirum.cabal
@@ -122,6 +122,7 @@ test-suite spec
, Nirum.PackageSpec
, Nirum.ParserSpec
, Nirum.Targets.PythonSpec
+ , Nirum.Targets.DocsSpec
, Nirum.TargetsSpec
, Nirum.VersionSpec
, Util
diff --git a/src/Nirum/Targets/Docs.hs b/src/Nirum/Targets/Docs.hs
index 91707a1..5b58884 100644
--- a/src/Nirum/Targets/Docs.hs
+++ b/src/Nirum/Targets/Docs.hs
@@ -10,7 +10,7 @@ import Data.Map.Strict (Map, union)
import qualified Data.Text as T
import Data.Text.Encoding (decodeUtf8)
import System.FilePath (())
-import Text.Blaze (preEscapedToMarkup)
+import Text.Blaze (ToMarkup (preEscapedToMarkup))
import Text.Blaze.Html.Renderer.Utf8 (renderHtml)
import Text.Hamlet (Html, shamlet)
@@ -25,7 +25,9 @@ import Nirum.Constructs.Identifier ( Identifier
import Nirum.Constructs.Module (Module (Module, docs))
import Nirum.Constructs.ModulePath (ModulePath)
import Nirum.Constructs.Name (Name (facialName))
+import qualified Nirum.Constructs.Service as S
import qualified Nirum.Constructs.TypeDeclaration as TD
+import qualified Nirum.Constructs.TypeExpression as TE
import Nirum.Docs ( Block (Heading)
, filterReferences
)
@@ -63,37 +65,49 @@ makeUri modulePath' =
T.intercalate "/" $
map toNormalizedText (toList modulePath') ++ ["index.html"]
-module' :: BoundModule Docs -> Html
-module' docsModule = [shamlet|
+layout :: ToMarkup m => Package Docs -> m -> Html -> Html
+layout Package { metadata = md } title body = [shamlet|
$doctype 5
- #{path}
+ <title>#{title}
<meta name="generator" content="Nirum #{versionText}">
$forall Author { name = name' } <- authors md
<meta name="author" content="#{name'}">
- <body>
- <h1>
- <code>#{path}
- $forall (ident, decl) <- types'
- <h2>#{showKind decl} <code>#{toNormalizedText ident}</code>
+ <body>#{body}
+|]
+
+typeExpression :: BoundModule Docs -> TE.TypeExpression -> Html
+typeExpression _ expr = [shamlet|<code>#{typeExpr expr}|]
+ where
+ typeExpr :: TE.TypeExpression -> Html
+ typeExpr expr' = [shamlet|
+$case expr'
+ $of TE.TypeIdentifier ident
+ #{toCode ident}
+ $of TE.OptionModifier type'
+ #{typeExpr type'}?
+ $of TE.SetModifier elementType
+ {#{typeExpr elementType}}
+ $of TE.ListModifier elementType
+ [#{typeExpr elementType}]
+ $of TE.MapModifier keyType valueType
+ {#{typeExpr keyType}: #{typeExpr valueType}}
+|]
+
+module' :: BoundModule Docs -> Html
+module' docsModule = layout pkg path $ [shamlet|
+ <h1><code>#{path}</code>
+ $forall (ident, decl) <- types'
+ <div class="#{showKind decl}" id="#{toNormalizedText ident}">
+ #{typeDecl docsModule ident decl}
|]
where
- md :: Metadata Docs
- md = metadata $ boundPackage docsModule
+ pkg :: Package Docs
+ pkg = boundPackage docsModule
path :: T.Text
path = toCode $ modulePath docsModule
- showKind :: TD.TypeDeclaration -> T.Text
- showKind TD.ServiceDeclaration {} = "service"
- showKind TD.TypeDeclaration { TD.type' = type'' } = case type'' of
- TD.Alias {} -> "alias"
- TD.UnboxedType {} -> "unboxed"
- TD.EnumType {} -> "enum"
- TD.RecordType {} -> "record"
- TD.UnionType {} -> "union"
- TD.PrimitiveType {} -> "primitive"
- showKind TD.Import {} = "import"
types' :: [(Identifier, TD.TypeDeclaration)]
types' = [ (facialName $ DE.name decl, decl)
| decl <- DES.toList $ types docsModule
@@ -102,40 +116,108 @@ $doctype 5
_ -> True
]
+typeDecl :: BoundModule Docs -> Identifier -> TD.TypeDeclaration -> Html
+typeDecl mod' ident
+ TD.TypeDeclaration { TD.type' = TD.Alias cname } = [shamlet|
+ <h2>type <code>#{toNormalizedText ident}</code>
+ <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>)
+|]
+typeDecl _ ident
+ TD.TypeDeclaration { TD.type' = TD.EnumType members } = [shamlet|
+ <h2>enum <code>#{toNormalizedText ident}</code>
+ <ul class="members">
+ $forall decl <- DES.toList members
+ <li class="member"><code>#{nameText $ DE.name decl}</code>
+|]
+typeDecl mod' ident
+ TD.TypeDeclaration { TD.type' = TD.RecordType fields } = [shamlet|
+ <h2>record <code>#{toNormalizedText ident}</code>
+ <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}
+|]
+typeDecl mod' ident
+ TD.TypeDeclaration { TD.type' = TD.UnionType tags } = [shamlet|
+ <h2>union <code>#{toNormalizedText ident}</code>
+ $forall tagDecl@(TD.Tag _ fields _) <- DES.toList tags
+ <h3 class="tag">
+ <code>#{nameText $ DE.name tagDecl}
+ <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}
+|]
+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}
+|]
+typeDecl _ _ TD.Import {} =
+ error ("It shouldn't happen; please report it to Nirum's bug tracker:\n" ++
+ "https://github.com/spoqa/nirum/issues")
+
+nameText :: Name -> T.Text
+nameText = toNormalizedText . facialName
+
+showKind :: TD.TypeDeclaration -> T.Text
+showKind TD.ServiceDeclaration {} = "service"
+showKind TD.TypeDeclaration { TD.type' = type'' } = case type'' of
+ TD.Alias {} -> "alias"
+ TD.UnboxedType {} -> "unboxed"
+ TD.EnumType {} -> "enum"
+ TD.RecordType {} -> "record"
+ TD.UnionType {} -> "union"
+ TD.PrimitiveType {} -> "primitive"
+showKind TD.Import {} = "import"
+
contents :: Package Docs -> Html
-contents Package { metadata = md, modules = ms } = [shamlet|
-$doctype 5
-<html>
- <head>
- <meta charset="utf-8">
- <title>Package docs
- <meta name="generator" content="Nirum #{versionText}">
- $forall Author { name = name' } <- authors md
- <meta name="author" content="#{name'}">
- <body>
- <h1>Modules
- <ul>
- $forall (modulePath', mod) <- MS.toAscList ms
- <li>
- <a href="#{makeUri modulePath'}">
- <code>#{toCode modulePath'} </code>
- $maybe tit <- moduleTitle mod
- — #{tit}
- <hr>
- <dl>
- <dt.author>
- $if 1 < length (authors md)
- Authors
- $else
- Author
- $forall Author { name = n, uri = u, email = e } <- authors md
- $maybe uri' <- u
- <dd.author><a href="#{show uri'}">#{n}</a>
- $nothing
- $maybe email' <- e
- <dd.author><a href="mailto:#{emailText email'}">#{n}</a>
- $nothing
- <dd.author>#{n}
+contents pkg@Package { metadata = md
+ , modules = ms
+ } = layout pkg ("Package docs" :: T.Text) [shamlet|
+<h1>Modules
+<ul>
+ $forall (modulePath', mod) <- MS.toAscList ms
+ <li>
+ <a href="#{makeUri modulePath'}">
+ <code>#{toCode modulePath'} </code>
+ $maybe tit <- moduleTitle mod
+ — #{tit}
+<hr>
+<dl>
+ <dt.author>
+ $if 1 < length (authors md)
+ Authors
+ $else
+ Author
+ $forall Author { name = n, uri = u, email = e } <- authors md
+ $maybe uri' <- u
+ <dd.author><a href="#{show uri'}">#{n}</a>
+ $nothing
+ $maybe email' <- e
+ <dd.author><a href="mailto:#{emailText email'}">#{n}</a>
+ $nothing
+ <dd.author>#{n}
|]
where
moduleTitle :: Module -> Maybe Html