Skip to content

Commit

Permalink
Merge pull request #116 from dahlia/docs
Browse files Browse the repository at this point in the history
Docs target now shows more details
  • Loading branch information
dahlia authored Mar 14, 2017
2 parents 7efc37d + 3dc587c commit c57e8ba
Show file tree
Hide file tree
Showing 3 changed files with 140 additions and 55 deletions.
4 changes: 3 additions & 1 deletion examples/pdf-service.nrm
Original file line number Diff line number Diff line change
@@ -1,4 +1,6 @@

type html = text;

service pdf-service (
# A microservice which renders a PDF from the given URI or HTML.

Expand All @@ -9,6 +11,6 @@ service pdf-service (

binary render-html (
# Renders a PDF from the given HTML text.
text html,
html html,
),
);
1 change: 1 addition & 0 deletions nirum.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -122,6 +122,7 @@ test-suite spec
, Nirum.PackageSpec
, Nirum.ParserSpec
, Nirum.Targets.PythonSpec
, Nirum.Targets.DocsSpec
, Nirum.TargetsSpec
, Nirum.VersionSpec
, Util
Expand Down
190 changes: 136 additions & 54 deletions src/Nirum/Targets/Docs.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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)

Expand All @@ -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
)
Expand Down Expand Up @@ -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
<html>
<head>
<meta charset="utf-8">
<title>#{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
Expand All @@ -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
&mdash; #{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
&mdash; #{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
Expand Down

0 comments on commit c57e8ba

Please sign in to comment.