nirum 0.4.2 → 0.5.0
raw patch · 24 files changed
+986/−195 lines, 24 filesdep +cmark-gfmdep −cmarkdep ~fsnotifydep ~hlintdep ~megaparsec
Dependencies added: cmark-gfm
Dependencies removed: cmark
Dependency ranges changed: fsnotify, hlint, megaparsec, temporary
Files
- CHANGES.md +76/−0
- README.md +3/−4
- nirum.cabal +11/−11
- src/Nirum/Cli.hs +7/−6
- src/Nirum/Constructs/Module.hs +0/−2
- src/Nirum/Docs.hs +111/−32
- src/Nirum/Docs/Html.hs +58/−8
- src/Nirum/Docs/ReStructuredText.hs +89/−4
- src/Nirum/Package.hs +36/−5
- src/Nirum/Package/Metadata.hs +9/−5
- src/Nirum/Targets.hs +36/−27
- src/Nirum/Targets/Docs.hs +328/−51
- src/Nirum/Targets/Python.hs +24/−3
- src/Nirum/Targets/Python/Deserializers.hs +3/−3
- test/Nirum/CodeBuilderSpec.hs +1/−0
- test/Nirum/Constructs/DocsSpec.hs +4/−3
- test/Nirum/Docs/HtmlSpec.hs +32/−0
- test/Nirum/Docs/ReStructuredTextSpec.hs +24/−0
- test/Nirum/DocsSpec.hs +41/−5
- test/Nirum/PackageSpec.hs +32/−13
- test/Nirum/Targets/Python/CodeGenSpec.hs +1/−0
- test/Nirum/Targets/PythonSpec.hs +49/−5
- test/Nirum/TargetsSpec.hs +10/−7
- test/Nirum/VersionSpec.hs +1/−1
CHANGES.md view
@@ -1,6 +1,82 @@ Nirum changelog =============== +Version 0.5.0+-------------++Released on August 24, 2018.++### Language++ - The `uri` type has completly gone; use `url` instead.+ [[#126], [#281] by Jonghun Park]+ - Added [`@numeric-constraints`](docs/annotation.md#numeric-constraints)+ annotation to constraint the range of unboxed types' values.+ [[#206], [#271] by Seunghun Lee]++### Docs target++ - Docs target became to support manual pages besides reference docs extracted+ from Nirum source codes. It scans all CommonMark (i.e., _*.md_) files and+ transforms them to HTML pages.+ - [CommonMark] in docstrings became to support [table syntax extension].+ - [CommonMark] in docstrings became to have a limited subset of+ [special attributes extension]. It's only allowed to heading elements and+ only anchor identifiers are supported (e.g., `{#header-id}`).+ - `style`, `header`, and `footer` options were added. These options purpose+ to customize the look and feel of the result pages.+ - Fixed an incorrect processing of [CommonMark] thight list items: it had+ crashed when a thight list item contains blocks other than paragraphs.+ - Package's version became shown on the generated docs.+ [[#297], [#304] by Jeong Ukjae]+ - Added `opengraphs` option for [OpenGraph] objects on docs.+ [[#283], [#305] by GyuYong Jung]+ - Added syntax highlighting including Nirum.+ [[#310], [#311], [#313], [#324] by MinJune Kim]+ - Added anchor links to types.+ [[#225], [#321] by Park Hyunwoo]++### Python target++ - Python 3.7 support. [[#298], [#300] by Alan D.J. Synn]+ - Fixed a bug that an uncaught `NameError` raises (instead of following+ the standardized way to handle validation errors through `on_error`)+ when a serialized value of a mapping lacks `"key"` or `"value"`+ field and a type/union tag/service named `key-error` is defined in the same+ module at the same time. [[#318] by Dongwook Kim]+ - Fixed a bug that an uncaught `NameError` raises (instead of following+ the standardized way to handle validation errors through `on_error`)+ when a serialized value of a `bigint` is not an integral decimal string+ and a type/union tag/service named `value-error` is defined in the same+ module at the same time. [[#318] by Dongwook Kim]++### Et cetera++ - Dropped 32-bit Windows support.++[#126]: https://github.com/nirum-lang/nirum/issues/126+[#206]: https://github.com/nirum-lang/nirum/issues/206+[#225]: https://github.com/nirum-lang/nirum/issues/225+[#271]: https://github.com/nirum-lang/nirum/pull/271+[#281]: https://github.com/nirum-lang/nirum/pull/281+[#283]: https://github.com/spoqa/nirum/pull/283+[#297]: https://github.com/nirum-lang/nirum/issues/297+[#298]: https://github.com/nirum-lang/nirum/issues/298+[#300]: https://github.com/nirum-lang/nirum/pull/300+[#304]: https://github.com/nirum-lang/nirum/pull/304+[#305]: https://github.com/nirum-lang/nirum/pull/305+[#310]: https://github.com/nirum-lang/nirum/issues/310+[#311]: https://github.com/nirum-lang/nirum/pull/311+[#313]: https://github.com/nirum-lang/nirum/issues/313+[#318]: https://github.com/nirum-lang/nirum/pull/318+[#321]: https://github.com/nirum-lang/nirum/pull/321+[#324]: https://github.com/nirum-lang/nirum/pull/324+[CommonMark]: http://commonmark.org/+[table syntax extension]: https://github.github.com/gfm/#tables-extension-+[special attributes extension]: https://michelf.ca/projects/php-markdown/extra/#spe-attr+[OpenGraph]: http://ogp.me/++ Version 0.4.2 -------------
README.md view
@@ -50,7 +50,7 @@ ### Released builds You can download executable binaries for Linux (x86_64), macOS (x86_64), or-Windows (x64 or x86) from the [latest release note][latest-release].+Windows (x64) from the [latest release note][latest-release]. You should give it appropriate permissions (e.g., `+x`) depending on your platform. @@ -72,7 +72,6 @@ - [Linux (x86_64)](https://nightly-builds.nirum.org/travis-builds/nirum-linux-x86_64) - [macOS (x86_64)](https://nightly-builds.nirum.org/travis-builds/nirum-darwin-x86_64) - [Windows (x64)](https://ci.appveyor.com/api/projects/dahlia/nirum-k5n5y/artifacts/nirum-win-x64.exe?job=Platform%3A%20x64&branch=master)-- [Windows (x86)](https://ci.appveyor.com/api/projects/dahlia/nirum-k5n5y/artifacts/nirum-win-x86.exe?job=Platform%3A%20x86&branch=master) - [Docker (`nirumlang/nirum:latest`)][docker] Although we call it "nightly build," technically it is not built every night,@@ -87,13 +86,13 @@ $ mkdir out/ # directory to place generated Python files $ nirum -t python -o out/ examples/ -For more infomration, use `--help` option:+For more information, use `--help` option: $ nirum --help Nirum: The IDL compiler and RPC/distributed object framework Usage: nirum [-v|--version] (-o|--output-dir DIR) (-t|--target TARGET) DIR- Nirum compiler 0.4.2+ Nirum compiler 0.5.0 Available options: -h,--help Show this help text
nirum.cabal view
@@ -2,10 +2,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 5f111a8eea54d08aac4e2c80499e06c720220a0675b48cc03b2d3dd80dfbb54d+-- hash: 9b24a2149554f25fc47a3443f1389e7c3c376430cc9dc80746b6df69302a7976 name: nirum-version: 0.4.2+version: 0.5.0 synopsis: IDL compiler and RPC/distributed object framework for microservices description: Nirum is an IDL compiler and RPC/distributed object framework for microservices, built on top of the modern Web server technologies such as RESTful HTTP and JSON.@@ -82,16 +82,16 @@ , blaze-html >=0.9.0.1 && <0.10 , blaze-markup >=0.8.0.0 && <0.9 , bytestring- , cmark >=0.5 && <0.6+ , cmark-gfm >=0.1.3 && <0.2 , containers >=0.5.6.2 && <0.6 , directory >=1.2.5 && <1.4 , email-validate >=2.0.0 && <3.0.0 , filepath >=1.4 && <1.5- , fsnotify >=0.2.1 && <0.3.0+ , fsnotify >=0.3.0.1 && <0.4.0.0 , heterocephalus >=1.0.5 && <1.1.0 , htoml >=1.0.0.0 && <1.1.0.0 , interpolatedstring-perl6 >=1.0.0 && <1.1.0- , megaparsec >=6.4 && <6.5+ , megaparsec >=6.5 && <6.6 , mtl >=2.2.1 && <3 , optparse-applicative >=0.14 && <0.15 , parsec@@ -126,7 +126,7 @@ , filepath >=1.4 && <1.5 , htoml >=1.0.0.0 && <1.1.0.0 , interpolatedstring-perl6 >=1.0.0 && <1.1.0- , megaparsec >=6.4 && <6.5+ , megaparsec >=6.5 && <6.6 , mtl >=2.2.1 && <3 , nirum , parsec@@ -161,10 +161,10 @@ , directory >=1.2.5 && <1.4 , email-validate >=2.0.0 && <3.0.0 , filepath >=1.4 && <1.5- , hlint >=2.1.6 && <2.2+ , hlint >=2.1.7 && <2.2 , htoml >=1.0.0.0 && <1.1.0.0 , interpolatedstring-perl6 >=1.0.0 && <1.1.0- , megaparsec >=6.4 && <6.5+ , megaparsec >=6.5 && <6.6 , mtl >=2.2.1 && <3 , parsec , pretty >=1.1.3 && <2@@ -229,7 +229,7 @@ , htoml >=1.0.0.0 && <1.1.0.0 , hxt >=9.3.1.16 && <9.4.0.0 , interpolatedstring-perl6 >=1.0.0 && <1.1.0- , megaparsec >=6.4 && <6.5+ , megaparsec >=6.5 && <6.6 , mtl >=2.2.1 && <3 , nirum , parsec@@ -238,7 +238,7 @@ , semigroups , semver >=0.3.0 && <1.0 , string-qq >=0.0.2 && <0.1.0- , temporary >=1.2 && <1.3+ , temporary >=1.2 && <1.4 , text >=0.9.1.0 && <1.3 , unordered-containers if os(darwin)@@ -265,7 +265,7 @@ , filepath >=1.4 && <1.5 , htoml >=1.0.0.0 && <1.1.0.0 , interpolatedstring-perl6 >=1.0.0 && <1.1.0- , megaparsec >=6.4 && <6.5+ , megaparsec >=6.5 && <6.6 , mtl >=2.2.1 && <3 , parsec , pretty >=1.1.3 && <2
src/Nirum/Cli.hs view
@@ -37,11 +37,12 @@ , MissingModulePathError ) )-import Nirum.Targets ( BuildError (CompileError, PackageError, TargetNameError)- , BuildResult- , buildPackage- , targetNames- )+import Nirum.Targets+ ( BuildError (..)+ , BuildResult+ , buildPackageFromFilePath+ , targetNames+ ) import Nirum.Version (versionString) type TFlag = TVar Bool@@ -136,7 +137,7 @@ , outputPath = outDir , targetLanguage = target } = do- result <- buildPackage target src+ result <- buildPackageFromFilePath target src case result of Left (TargetNameError targetName') -> tryDie' [qq|Couldn't find "$targetName'" target.
src/Nirum/Constructs/Module.hs view
@@ -113,8 +113,6 @@ , decl' "bool" Bool Boolean , decl' "uuid" Uuid String , decl' "url" Url String- -- FIXME: deprecated- , decl' "uri" Url String ] where decl' name prim json =
src/Nirum/Docs.hs view
@@ -1,14 +1,5 @@-module Nirum.Docs ( Block ( BlockQuote- , CodeBlock- , Document- , Heading- , HtmlBlock- , List- , Paragraph- , ThematicBreak- , infoString- , code- )+{-# LANGUAGE LambdaCase #-}+module Nirum.Docs ( Block (..) , HeadingLevel (H1, H2, H3, H4, H5, H6) , Html , Inline ( Code@@ -29,25 +20,31 @@ , ItemList (LooseItemList, TightItemList) , ListType (BulletList, OrderedList, startNumber, delimiter) , ListDelimiter (Parenthesis, Period)- , LooseItem- , TightItem- , Title+ , ListItem+ , TableCell+ , TableColumn (..)+ , TableRow , Url+ , extractTitle , filterReferences , headingLevelFromInt , headingLevelInt , parse+ , transformReferences , trimTitle ) where +import Data.Char+import Data.List.NonEmpty import Data.String (IsString (fromString)) -import qualified CMark as M+import qualified CMarkGFM as M import qualified Data.Text as T type Url = T.Text type Title = T.Text type Html = T.Text+type AnchorId = T.Text -- | The level of heading. -- See also: http://spec.commonmark.org/0.25/#atx-heading@@ -87,18 +84,29 @@ | BlockQuote [Block] | HtmlBlock Html | CodeBlock { infoString :: T.Text, code :: T.Text }- | Heading HeadingLevel [Inline]+ | Heading HeadingLevel [Inline] (Maybe AnchorId) | List ListType ItemList+ | Table (NonEmpty TableColumn) (NonEmpty TableRow) deriving (Eq, Ord, Show) -data ItemList = LooseItemList [LooseItem]- | TightItemList [TightItem]- deriving (Eq, Ord, Show)+data ItemList+ = LooseItemList [ListItem]+ | TightItemList [ListItem]+ deriving (Eq, Ord, Show) -type LooseItem = [Block]+type ListItem = [Block] -type TightItem = [Inline]+data TableColumn+ = NotAligned+ | LeftAligned+ | CenterAligned+ | RightAligned+ deriving (Eq, Ord, Show) +type TableRow = NonEmpty TableCell++type TableCell = [Inline]+ data Inline = Text T.Text | SoftLineBreak -- | See also:@@ -113,6 +121,11 @@ | Image { imageUrl :: Url, imageTitle :: Title } deriving (Eq, Ord, Show) +-- | Extract the top-level first heading from the block, if it exists.+extractTitle :: Block -> Maybe (HeadingLevel, [Inline])+extractTitle (Document (Heading lv inlines _ : _)) = Just (lv, inlines)+extractTitle _ = Nothing+ -- | Trim the top-level first heading from the block, if it exists. trimTitle :: Block -> Block trimTitle block =@@ -122,7 +135,7 @@ parse :: T.Text -> Block parse =- transBlock . M.commonmarkToNode [M.optNormalize, M.optSmart]+ transBlock . M.commonmarkToNode [M.optSmart] [M.extTable] where transBlock :: M.Node -> Block transBlock n@(M.Node _ nodeType children) =@@ -134,7 +147,14 @@ M.HTML_BLOCK rawHtml -> HtmlBlock rawHtml M.CUSTOM_BLOCK _ _ -> error $ "custom block is unsupported: " ++ n' M.CODE_BLOCK info codeText -> CodeBlock info codeText- M.HEADING lv -> Heading (headingLevelFromInt lv) inlineChildren+ M.HEADING lv -> case extractAnchorId (last' children) of+ Nothing ->+ Heading (headingLevelFromInt lv) inlineChildren Nothing+ Just (initial, anchorId) ->+ Heading+ (headingLevelFromInt lv)+ (Prelude.init (fmap transInline children) ++ initial)+ (Just anchorId) M.LIST (M.ListAttributes listType' tight start delim) -> List (case listType' of M.BULLET_LIST -> BulletList@@ -144,20 +164,20 @@ M.PERIOD_DELIM -> Period M.PAREN_DELIM -> Parenthesis ) $- if tight- then TightItemList $ map stripParagraph listItems- else LooseItemList $ map (map transBlock) listItems+ (if tight then TightItemList else LooseItemList) $+ fmap (fmap transBlock) listItems+ M.TABLE cellAligns ->+ Table+ (fromList $ fmap toTableColumn cellAligns)+ (fromList $ fmap transRow children) _ -> error $ "expected block, but got inline: " ++ n' where blockChildren :: [Block]- blockChildren = map transBlock children+ blockChildren = fmap transBlock children inlineChildren :: [Inline]- inlineChildren = map transInline children+ inlineChildren = fmap transInline children listItems :: [[M.Node]] listItems = [nodes | (M.Node _ M.ITEM nodes) <- children]- stripParagraph :: [M.Node] -> [Inline]- stripParagraph [M.Node _ M.PARAGRAPH nodes] = map transInline nodes- stripParagraph ns = error $ "expected a paragraph, but got " ++ show ns n' :: String n' = show n transInline :: M.Node -> Inline@@ -175,7 +195,39 @@ _ -> error $ "expected inline, but got block: " ++ show n where children :: [Inline]- children = map transInline childNodes+ children = fmap transInline childNodes+ toTableColumn :: M.TableCellAlignment -> TableColumn+ toTableColumn M.NoAlignment = NotAligned+ toTableColumn M.LeftAligned = LeftAligned+ toTableColumn M.CenterAligned = CenterAligned+ toTableColumn M.RightAligned = RightAligned+ transRow :: M.Node -> TableRow+ transRow (M.Node _ M.TABLE_ROW nodes) = fromList (fmap transCell nodes)+ transRow node = error $ "expected a table row, but got " ++ show node+ transCell :: M.Node -> TableCell+ transCell (M.Node _ M.TABLE_CELL nodes) = fmap transInline nodes+ transCell node = error $ "expected a table cell, but got " ++ show node+ extractAnchorId :: Maybe M.Node -> Maybe ([Inline], AnchorId)+ extractAnchorId (Just (M.Node _ (M.TEXT text) []))+ | T.null tail' = Nothing+ | T.last tail' /= '}' = Nothing+ | T.length tail' < 2 = Nothing+ | otherwise =+ let+ aid = T.init tail'+ in+ if isValidId aid+ then Just ([Text $ T.stripEnd $ T.dropEnd 3 head'], aid)+ else Nothing+ where+ (head', tail') = T.breakOnEnd " {#" text+ isValidId :: T.Text -> Bool+ isValidId = T.all $ \ c ->+ isAscii c && isAlphaNum c || c `elem` ['-', '_', '.']+ extractAnchorId _ = Nothing+ last' :: [a] -> Maybe a+ last' [] = Nothing+ last' l = Just $ Prelude.last l instance IsString Block where fromString = parse . T.pack@@ -190,3 +242,30 @@ filterReferences (Link { linkContents = children } : ix) = children ++ filterReferences ix filterReferences (i : ix) = i : filterReferences ix++transformReferences :: (Url -> Url) -> Block -> Block+transformReferences replace = \ case+ Document blocks ->+ Document (transformReferences replace <$> blocks)+ Paragraph inlines ->+ Paragraph (transformInline <$> inlines)+ BlockQuote blocks ->+ BlockQuote (transformReferences replace <$> blocks)+ Heading lv inlines anchorId ->+ Heading lv (transformInline <$> inlines) anchorId+ List lt (LooseItemList items) ->+ List lt $ LooseItemList (fmap (transformReferences replace) <$> items)+ List lt (TightItemList items) ->+ List lt $ TightItemList (fmap (transformReferences replace) <$> items)+ Table cols rows ->+ Table cols (fmap (fmap transformInline) <$> rows)+ block ->+ block+ where+ transformInline :: Inline -> Inline+ transformInline (Emphasis inlines) = Emphasis (transformInline <$> inlines)+ transformInline (Strong inlines) = Strong (transformInline <$> inlines)+ transformInline (Link url title inlines) =+ Link (replace url) title (transformInline <$> inlines)+ transformInline (Image url title) = Image (replace url) title+ transformInline inline = inline
src/Nirum/Docs/Html.hs view
@@ -1,6 +1,15 @@ {-# LANGUAGE OverloadedStrings, QuasiQuotes #-}-module Nirum.Docs.Html (render, renderInline, renderInlines, renderBlock) where+module Nirum.Docs.Html+ ( render+ , renderBlock+ , renderInline+ , renderInlines+ , renderLinklessInlines+ ) where +import Data.List.NonEmpty+import Prelude hiding (head, zip)+ import qualified Data.Text as T import Text.InterpolatedString.Perl6 (qq) @@ -36,8 +45,16 @@ escapeChar c = T.singleton c renderInlines :: [Inline] -> Html-renderInlines = T.concat . map renderInline+renderInlines = T.concat . fmap renderInline +renderLinklessInlines :: [Inline] -> Html+renderLinklessInlines inlines = T.concat+ [ case i of+ Link _ _ inlines' -> renderInlines inlines'+ i' -> renderInline i'+ | i <- inlines+ ]+ renderBlock :: Block -> Html renderBlock (Document blocks) = renderBlocks blocks `T.snoc` '\n' renderBlock ThematicBreak = "<hr>"@@ -47,15 +64,21 @@ renderBlock (HtmlBlock html) = html renderBlock (CodeBlock lang code') = if T.null lang- then [qq|<pre><code>$code'</code></pre>|]- else [qq|<pre><code class="language-$lang">$code'</code></pre>|]-renderBlock (Heading level inlines) =+ then [qq|<pre><code>$escapedCode</code></pre>|]+ else [qq|<pre><code class="language-$lang">$escapedCode</code></pre>|]+ where+ escapedCode :: Html+ escapedCode = escape code'+renderBlock (Heading level inlines anchorId) = let lv = headingLevelInt level- in [qq|<h$lv>{renderInlines inlines}</h$lv>|]+ id' = case anchorId of+ Nothing -> ""+ Just aid -> [qq| id="$aid"|] :: T.Text+ in [qq|<h$lv$id'>{renderInlines inlines}</h$lv>|] renderBlock (List listType itemList) = let liList = case itemList of TightItemList items ->- [ [qq|<li>{renderInlines item}</li>|]+ [ [qq|<li>{renderTightBlocks item}</li>|] | item <- items ] LooseItemList items ->@@ -70,9 +93,36 @@ nl = '\n' liListT = T.intercalate "\n" liList in [qq|<$tag>$nl$liListT$nl</$tag>|]+renderBlock (Table columns rows) =+ [qq|<table>$lf<thead>$lf<tr>+{T.concat (toList $ fmap th $ zip columns (head rows))}+</tr>$lf</thead>+<tbody>{T.concat (fmap tr $ Data.List.NonEmpty.tail rows)}</tbody></table>|]+ where+ lf :: Char+ lf = '\n'+ th :: (TableColumn, TableCell) -> Html+ th (col, cell) = [qq|$lf<th{align col}>{renderInlines cell}</th>|]+ align :: TableColumn -> Html+ align NotAligned = ""+ align LeftAligned = " align=\"left\""+ align CenterAligned = " align=\"center\""+ align RightAligned = " align=\"right\""+ tr :: TableRow -> Html+ tr cells = [qq|$lf<tr>{T.concat (toList $ fmap td cells)}</tr>|]+ td :: TableCell -> Html+ td inlines = [qq|$lf<td>{renderInlines inlines}</td>|] renderBlocks :: [Block] -> Html-renderBlocks = T.intercalate "\n" . map renderBlock+renderBlocks = T.intercalate "\n" . fmap renderBlock++renderTightBlocks :: [Block] -> Html+renderTightBlocks blocks = T.intercalate "\n"+ [ case b of+ Paragraph inlines -> renderInlines inlines+ b' -> renderBlock b'+ | b <- blocks+ ] render :: Block -> Html render = renderBlock
src/Nirum/Docs/ReStructuredText.hs view
@@ -1,6 +1,10 @@ {-# LANGUAGE OverloadedStrings, QuasiQuotes #-} module Nirum.Docs.ReStructuredText (ReStructuredText, render) where +import qualified Data.List.NonEmpty+import Data.List.NonEmpty (NonEmpty (..), toList, (<|))+import Data.Maybe+ import qualified Data.Text as T import Text.InterpolatedString.Perl6 (qq) @@ -99,9 +103,13 @@ , "\n\n" , indent3 code' ]-renderBlock (Heading level inlines) =- T.concat [text, "\n", T.pack [hChar | _ <- [1 .. (T.length text)]]]+renderBlock (Heading level inlines anchorId) =+ T.concat [ref, text, "\n", T.pack [hChar | _ <- [1 .. (T.length text)]]] where+ ref :: ReStructuredText+ ref = case anchorId of+ Nothing -> ""+ Just id' -> T.concat ["\n.. _", id', ":\n\n"] text :: ReStructuredText text = renderInlines inlines hChar :: Char@@ -113,26 +121,103 @@ H5 -> '.' H6 -> '\'' renderBlock (List BulletList (TightItemList items)) =- T.intercalate "\n" [[qq|- {renderInlines i}|] | i <- items]+ T.intercalate "\n" [ [qq|- {T.drop 2 $ indent2 $ renderTightBlocks i}|]+ | i <- items+ ] renderBlock (List BulletList (LooseItemList items)) = T.intercalate "\n\n" [ [qq|- {T.drop 2 $ indent2 $ renderBlocks i}|] | i <- items ] renderBlock (List (OrderedList startNum _) (TightItemList items)) =- T.intercalate "\n" [ [qq|$n. {renderInlines i}|]+ T.intercalate "\n" [ [qq|$n. {T.drop 3 $ indent3 $ renderTightBlocks i}|] | (n, i) <- indexed startNum items ] renderBlock (List (OrderedList startNum _) (LooseItemList items)) = T.intercalate "\n\n" [ [qq|$n. {T.drop 3 $ indent3 $ renderBlocks i}|] | (n, i) <- indexed startNum items ]+renderBlock (Table _ allRows@(header :| rows)) = T.concat $+ ["\n", hline "-", row header, hline "="] +++ [row cells `T.append` hline "-" | cells <- rows] +++ ["\n"]+ where+ widths :: NonEmpty Int+ widths = columnWidths allRows+ hline :: T.Text -> ReStructuredText+ hline c = T.concat+ [ "+"+ , T.intercalate "+" [T.replicate (w + 2) c | w <- toList widths]+ , "+\n"+ ]+ row :: TableRow -> ReStructuredText+ row cells = T.concat+ [ T.concat+ [ "|"+ , T.intercalate "|"+ [ T.concat+ [ " "+ , T.justifyLeft w ' ' $ case drop lineIdx lines' of+ line' : _ -> line'+ [] -> ""+ , " "+ ]+ | (lines', w) <- cells'+ ]+ , "|\n"+ ]+ | lineIdx <- [0 .. (rowHeight cells - 1)]+ ]+ where+ cells' :: [([ReStructuredText], Int)]+ cells' =+ [ (T.lines $ renderInlines cell, w)+ | (cell, w) <- toList $ Data.List.NonEmpty.zip cells widths+ ] +cellWidthHeight :: TableCell -> (Int, Int)+cellWidthHeight inlines =+ case T.lines $ renderInlines inlines of+ [] -> (0, 0)+ lines' -> (maximum (map T.length lines'), length lines')++columnWidths :: NonEmpty TableRow -> NonEmpty Int+columnWidths =+ widths . fmap Just+ where+ cellWidths :: NonEmpty (Maybe TableRow) -> NonEmpty Int+ cellWidths =+ fmap (maybe 0 (fst . cellWidthHeight . Data.List.NonEmpty.head))+ restCols :: NonEmpty (Maybe TableRow) -> NonEmpty (Maybe TableRow)+ restCols = fmap $ maybe Nothing+ (Data.List.NonEmpty.nonEmpty . Data.List.NonEmpty.tail)+ widths :: NonEmpty (Maybe TableRow) -> NonEmpty Int+ widths rows =+ let+ restCols' = restCols rows+ maxWidth = maximum (cellWidths rows)+ in+ if any isJust restCols'+ then maxWidth <| widths restCols'+ else maxWidth :| []++rowHeight :: TableRow -> Int+rowHeight =+ maximum . fmap (snd . cellWidthHeight)+ indexed :: Enum i => i -> [a] -> [(i, a)] indexed _ [] = [] indexed start (x : xs) = (start, x) : indexed (succ start) xs renderBlocks :: [Block] -> ReStructuredText renderBlocks = T.intercalate "\n\n" . map renderBlock++renderTightBlocks :: [Block] -> ReStructuredText+renderTightBlocks blocks = T.intercalate "\n\n"+ [ case b of+ Paragraph inlines -> renderInlines inlines+ b' -> renderBlock b'+ | b <- blocks+ ] render :: Block -> ReStructuredText render = renderBlock
src/Nirum/Package.hs view
@@ -4,11 +4,15 @@ , ParseError , docs , resolveModule+ , scanDocuments , scanModules , scanPackage , target ) where +import Data.Char+import Data.List (isSuffixOf)+import System.IO import System.IO.Error (catchIOError) import Control.Monad.Except ( ExceptT@@ -18,13 +22,15 @@ ) import qualified Data.Map.Strict as M import qualified Data.Set as S+import Data.Text.IO import System.Directory (doesDirectoryExist, listDirectory) import System.FilePath ((</>)) +import Nirum.Constructs.Docs import Nirum.Constructs.Module import Nirum.Constructs.ModulePath (ModulePath, fromFilePath) import Nirum.Package.Metadata ( MetadataError- , Package (Package, metadata, modules)+ , Package (..) , Target , metadataPath , packageTarget@@ -55,9 +61,10 @@ Left e -> throwError $ MetadataError e modulePaths <- liftIO $ scanModules packagePath modules' <- mapM (\ p -> catch (parseFile p) $ ScanError p) modulePaths+ documents' <- liftIO $ scanDocuments packagePath case M.foldrWithKey excludeFailedParse (Right M.empty) modules' of Right parsedModules -> case MS.fromMap parsedModules of- Right ms -> return $ Package metadata' ms+ Right ms -> return $ Package metadata' ms documents' Left errors -> throwError $ ImportError errors Left error' -> throwError error' where@@ -84,9 +91,6 @@ files <- scanFiles "" return $ M.fromList files where- isNotHidden :: FilePath -> Bool- isNotHidden ('.' : _) = False- isNotHidden _ = True scanFiles :: FilePath -> IO [(ModulePath, FilePath)] scanFiles path = do dir <- doesDirectoryExist realPath@@ -103,3 +107,30 @@ realPath = case path of [] -> packagePath p -> packagePath </> p++scanDocuments :: FilePath -> IO (M.Map FilePath Docs)+scanDocuments =+ (`scan'` "")+ where+ scan' :: FilePath -> FilePath -> IO (M.Map FilePath Docs)+ scan' basePath path = do+ subpaths <- listDirectory (basePath </> path)+ maps <- sequence $ (<$> filter isNotHidden subpaths) $ \ name -> do+ let subpath = path </> name+ dir <- doesDirectoryExist (basePath </> subpath)+ if dir+ then scan' basePath subpath+ else+ if ".md" `isSuffixOf` map toLower name+ then do+ code <- withFile (basePath </> subpath) ReadMode $ \ h -> do+ hSetEncoding h utf8_bom+ Data.Text.IO.hGetContents h+ return $ M.singleton subpath $ Docs code+ else+ return M.empty+ return $ M.unions maps++isNotHidden :: FilePath -> Bool+isNotHidden ('.' : _) = False+isNotHidden _ = True
src/Nirum/Package/Metadata.hs view
@@ -25,7 +25,7 @@ , VTable , VTArray )- , Package (Package, metadata, modules)+ , Package (..) , Table , Target ( CompileError , CompileResult@@ -40,6 +40,7 @@ , fieldType , metadataFilename , metadataPath+ , optional , parseMetadata , packageTarget , prependMetadataErrorField@@ -47,6 +48,7 @@ , readMetadata , stringField , tableField+ , tableArrayField , textArrayField , versionField ) where@@ -84,6 +86,7 @@ ) import Text.URI (URI, parseURI) +import Nirum.Constructs.Docs (Docs) import Nirum.Package.ModuleSet (ModuleSet) -- | The filename of Nirum package metadata.@@ -91,10 +94,11 @@ metadataFilename = "package.toml" -- | Represents a package which consists of modules.-data Package t =- Package { metadata :: (Eq t, Ord t, Show t, Target t) => Metadata t- , modules :: ModuleSet- }+data Package t = Package+ { metadata :: (Eq t, Ord t, Show t, Target t) => Metadata t+ , modules :: ModuleSet+ , documents :: Map FilePath Docs+ } deriving instance (Eq t, Target t) => Eq (Package t) deriving instance (Ord t, Target t) => Ord (Package t)
src/Nirum/Targets.hs view
@@ -1,11 +1,13 @@ {-# LANGUAGE QuasiQuotes, ScopedTypeVariables, TemplateHaskell #-}-module Nirum.Targets ( BuildError (CompileError, PackageError, TargetNameError)- , BuildResult- , Target (..)- , TargetName- , buildPackage- , targetNames- ) where+module Nirum.Targets+ ( BuildError (..)+ , BuildResult+ , Target (..)+ , TargetName+ , buildPackage+ , buildPackageFromFilePath+ , targetNames+ ) where import Data.Either (partitionEithers) import Data.Maybe (fromMaybe)@@ -48,34 +50,41 @@ packageBuilders :: M.Map TargetName (FilePath -> IO (Either BuildError BuildResult))-packageBuilders = M.fromList $(targetProxyMapQ [e|buildPackage'|])+packageBuilders = M.fromList $(targetProxyMapQ [e|buildPackageFromFilePath'|]) targetNames :: Set TargetName targetNames = M.keysSet packageBuilders -buildPackage :: TargetName -> FilePath -> IO (Either BuildError BuildResult)-buildPackage targetName' =+buildPackage :: forall t. Target t => Package t -> Either BuildError BuildResult+buildPackage pkg@Package { metadata = Metadata { target = target' } } =+ case partitionEithers eithers of+ (errors@(_ : _), _) ->+ Left $ CompileError $ M.fromList errors+ ([], outs) -> Right $ M.fromList outs+ where+ results :: [(FilePath, Either (CompileError t) (CompileResult t))]+ results = M.toList $ compilePackage pkg+ eithers :: [Either (FilePath, Text) (FilePath, ByteString)]+ eithers = [ case result of+ Left e -> Left (f, showCompileError target' e)+ Right r -> Right (f, toByteString target' r)+ | (f, result) <- results+ ]++buildPackageFromFilePath :: TargetName+ -> FilePath+ -> IO (Either BuildError BuildResult)+buildPackageFromFilePath targetName' = fromMaybe (\ _ -> return $ Left $ TargetNameError targetName') $ M.lookup targetName' packageBuilders -buildPackage' :: forall t. Target t- => Proxy t- -> FilePath- -> IO (Either BuildError BuildResult)-buildPackage' _ packagePath = do+buildPackageFromFilePath' :: forall t. Target t+ => Proxy t+ -> FilePath+ -> IO (Either BuildError BuildResult)+buildPackageFromFilePath' _ packagePath = do scanResult <- scanPackage packagePath return $ case scanResult of Left e -> Left $ PackageError e Right (pkg :: Package t) ->- let Package { metadata = Metadata { target = target' } } = pkg- results = M.toList $ compilePackage pkg- eithers = [ case result of- Left e -> Left (f, showCompileError target' e)- Right r -> Right (f, toByteString target' r)- | (f, result) <- results- ] :: [Either (FilePath, Text) (FilePath, ByteString)]- in- case partitionEithers eithers of- (errors@(_ : _), _) ->- Left $ CompileError $ M.fromList errors- ([], outs) -> Right $ M.fromList outs+ buildPackage pkg
src/Nirum/Targets/Docs.hs view
@@ -1,26 +1,31 @@ {-# LANGUAGE QuasiQuotes, TypeFamilies #-}-module Nirum.Targets.Docs ( Docs+module Nirum.Targets.Docs ( Docs (..) , blockToHtml , makeFilePath , makeUri , moduleTitle ) where -import Data.Maybe (mapMaybe)+import Data.Char+import qualified Data.List+import Data.Maybe import GHC.Exts (IsList (fromList, toList)) import qualified Data.ByteString as BS import Data.ByteString.Lazy (toStrict) import qualified Text.Email.Parser as E-import Data.Map.Strict (Map, union)+import Data.Map.Strict (Map, mapKeys, mapWithKey, unions) import qualified Data.Text as T import qualified Data.Text.Lazy as TL import Data.Text.Encoding (decodeUtf8, encodeUtf8)-import System.FilePath ((</>))+import qualified Data.SemVer+import System.FilePath import Text.Blaze (ToMarkup (preEscapedToMarkup)) import Text.Blaze.Html.Renderer.Utf8 (renderHtml) import Text.Cassius import Text.Hamlet (Html, shamlet)+import Text.InterpolatedString.Perl6 (q)+import Text.Julius import Nirum.Constructs (Construct (toCode)) import Nirum.Constructs.Declaration (Documented (docsBlock))@@ -37,30 +42,26 @@ 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)+import Nirum.Docs ( Block (..)+ , Inline (..)+ , extractTitle , filterReferences+ , transformReferences , trimTitle )-import Nirum.Docs.Html (render, renderInlines)+import Nirum.Docs.Html (render, renderInlines, renderLinklessInlines) import Nirum.Package-import Nirum.Package.Metadata ( Author (Author, email, name, uri)- , Metadata (authors)- , Target ( CompileError- , CompileResult- , compilePackage- , parseTarget- , showCompileError- , targetName- , toByteString- )- , stringField- )+import Nirum.Package.Metadata hiding (target) import qualified Nirum.Package.ModuleSet as MS import Nirum.TypeInstance.BoundModule import Nirum.Version (versionText) -newtype Docs = Docs+data Docs = Docs { docsTitle :: T.Text+ , docsOpenGraph :: [OpenGraph]+ , docsStyle :: T.Text+ , docsHeader :: T.Text+ , docsFooter :: T.Text } deriving (Eq, Ord, Show) type Error = T.Text@@ -68,8 +69,14 @@ data CurrentPage = IndexPage | ModulePage ModulePath+ | DocumentPage FilePath deriving (Eq, Show) +data OpenGraph = OpenGraph+ { ogTag :: T.Text+ , ogContent :: T.Text+ } deriving (Eq, Ord, Show)+ makeFilePath :: ModulePath -> FilePath makeFilePath modulePath' = foldl (</>) "" $ map toNormalizedString (toList modulePath') ++ ["index.html"]@@ -80,15 +87,14 @@ T.intercalate "/" $ map toNormalizedText (toList modulePath') ++ ["index.html"] -layout :: ToMarkup m => Package Docs -> Int -> CurrentPage -> m -> Html -> Html+layout :: Package Docs -> Int -> CurrentPage -> T.Text -> Html -> Html layout pkg dirDepth currentPage title body = layout' pkg dirDepth currentPage title body Nothing -layout' :: ToMarkup m- => Package Docs+layout' :: Package Docs -> Int -> CurrentPage- -> m+ -> T.Text -> Html -> Maybe Html -> Html@@ -98,24 +104,50 @@ <html> <head> <meta charset="utf-8">- <title>#{title}+ <title>+ $if (title == docsTitle (target pkg))+ #{title}+ $else+ #{title} — #{docsTitle (target pkg)} <meta name="generator" content="Nirum #{versionText}"> $forall Author { name = name' } <- authors md <meta name="author" content="#{name'}">+ $forall OpenGraph { ogTag, ogContent } <- docsOpenGraph $ target pkg+ <meta property="#{ogTag}" content="#{ogContent}"> <link rel="stylesheet" href="#{root}style.css">+ <link rel="stylesheet" href="#{hljsCss}">+ <script src="#{root}nirum.js"></script>+ <script src="#{hljsJs}"></script>+ <script src="#{root}nirumHighlight.js"></script> <body>+ #{preEscapedToMarkup $ docsHeader $ target pkg} <nav> $if currentPage == IndexPage <a class="index selected" href="#{root}index.html"> <strong> #{docsTitle $ target pkg}+ <small.version>#{Data.SemVer.toText $ version md} $else <a class="index" href="#{root}index.html">- #{docsTitle $ target pkg}- <ul class="toc">- $forall (modulePath', mod) <- MS.toAscList ms+ <span>+ #{docsTitle $ target pkg}+ <small.version>#{Data.SemVer.toText $ version md}+ $if not (null documentPairs)+ <ul.manuals.toc>+ $forall (docPath, doc) <- documentPairs+ $if currentPage == DocumentPage docPath+ <li.selected>+ <a href="#{root}#{documentHtmlPath docPath}">+ <strong>+ #{renderDocumentTitle docPath doc}+ $else+ <li>+ <a href="#{root}#{documentHtmlPath docPath}">+ #{renderDocumentTitle docPath doc}+ <ul.modules.toc>+ $forall (modulePath', mod) <- modulePairs $if currentPage == ModulePage modulePath'- <li class="selected">+ <li.selected> <a href="#{root}#{makeUri modulePath'}"> <strong> <code>#{toCode modulePath'}</code>@@ -130,10 +162,27 @@ <article>#{body} $maybe f <- footer <footer>#{f}+ #{preEscapedToMarkup $ docsFooter $ target pkg} |] where root :: T.Text root = T.replicate dirDepth "../"+ modulePairs :: [(ModulePath, Module)]+ modulePairs = MS.toAscList ms+ documentPairs :: [(FilePath, D.Docs)]+ documentPairs = Data.List.sortOn+ documentSortKey+ (toList $ fst $ listDocuments pkg)+ documentSortKey :: (FilePath, D.Docs) -> (Bool, Int, FilePath)+ documentSortKey ("", _) = (False, 0, "")+ documentSortKey (fp@(fp1 : _), _) =+ (isUpper fp1, length (filter (== pathSeparator) fp), fp)+ hljsBase :: T.Text+ hljsBase = "https://cdnjs.cloudflare.com/ajax/libs/highlight.js/9.12.0/"+ hljsCss :: T.Text+ hljsCss = T.concat [hljsBase, "styles/github.min.css"]+ hljsJs :: T.Text+ hljsJs = T.concat [hljsBase, "highlight.min.js"] typeExpression :: BoundModule Docs -> TE.TypeExpression -> Html typeExpression _ expr = [shamlet|#{typeExpr expr}|]@@ -155,7 +204,7 @@ module' :: BoundModule Docs -> Html module' docsModule =- layout pkg depth (ModulePage docsModulePath) title [shamlet|+ layout pkg depth (ModulePage docsModulePath) path [shamlet| $maybe tit <- headingTitle <h1> <dfn><code>#{path}</code>@@ -176,8 +225,6 @@ pkg = boundPackage docsModule path :: T.Text path = toCode docsModulePath- title :: T.Text- title = T.concat [path, " \8212 ", docsTitle $ target pkg] types' :: [(Identifier, TD.TypeDeclaration)] types' = [ (facialName $ DE.name decl, decl) | decl <- DES.toList $ boundTypes docsModule@@ -195,12 +242,29 @@ depth = length $ toList docsModulePath blockToHtml :: Block -> Html-blockToHtml b = preEscapedToMarkup $ render b+blockToHtml =+ preEscapedToMarkup . render . transformReferences replaceUrl+ where+ replaceUrl :: T.Text -> T.Text+ replaceUrl url+ | isAbsoluteUrl url = url+ | otherwise =+ let (path, frag) = T.break (== '#') url+ in T.pack (documentHtmlPath $ T.unpack path) `T.append` frag+ isAbsoluteUrl :: T.Text -> Bool+ isAbsoluteUrl url+ | T.null rest = False+ | T.null scheme = True+ | otherwise = T.all testChar scheme && isAlpha (T.head scheme)+ where+ (scheme, rest) = T.break (== ':') url+ testChar :: Char -> Bool+ testChar c = (isAscii c && isAlphaNum c) || c == '.' || c == '-' typeDecl :: BoundModule Docs -> Identifier -> TD.TypeDeclaration -> Html typeDecl mod' ident tc@TD.TypeDeclaration { TD.type' = TD.Alias cname } = [shamlet|- <h2>+ <h2 id="#{toNormalizedText ident}"> type <dfn><code>#{toNormalizedText ident}</code></dfn> = # <code.type>#{typeExpression mod' cname}</code> $maybe d <- docsBlock tc@@ -209,7 +273,7 @@ typeDecl mod' ident tc@TD.TypeDeclaration { TD.type' = TD.UnboxedType innerType } = [shamlet|- <h2>+ <h2 id="#{toNormalizedText ident}"> unboxed <dfn><code>#{toNormalizedText ident}</code> (<code>#{typeExpression mod' innerType}</code>)@@ -218,7 +282,8 @@ |] typeDecl _ ident tc@TD.TypeDeclaration { TD.type' = TD.EnumType members } = [shamlet|- <h2>enum <dfn><code>#{toNormalizedText ident}</code></dfn>+ <h2 id="#{toNormalizedText ident}">+ enum <dfn><code>#{toNormalizedText ident}</code></dfn> $maybe d <- docsBlock tc #{blockToHtml d} <dl class="members">@@ -231,7 +296,8 @@ |] typeDecl mod' ident tc@TD.TypeDeclaration { TD.type' = TD.RecordType fields } = [shamlet|- <h2>record <dfn><code>#{toNormalizedText ident}</code></dfn>+ <h2 id="#{toNormalizedText ident}">+ record <dfn><code>#{toNormalizedText ident}</code></dfn> $maybe d <- docsBlock tc #{blockToHtml d} <dl.fields>@@ -250,7 +316,8 @@ } } = [shamlet|- <h2>union <dfn><code>#{toNormalizedText ident}</code></dfn>+ <h2 id="#{toNormalizedText ident}">+ union <dfn><code>#{toNormalizedText ident}</code></dfn> $maybe d <- docsBlock tc #{blockToHtml d} $forall (default_, tagDecl@(TD.Tag _ fields _)) <- tagList@@ -279,12 +346,14 @@ ] typeDecl _ ident TD.TypeDeclaration { TD.type' = TD.PrimitiveType {} } = [shamlet|- <h2>primitive <code>#{toNormalizedText ident}</code>+ <h2 id="#{toNormalizedText ident}">+ primitive <code>#{toNormalizedText ident}</code> |] typeDecl mod' ident tc@TD.ServiceDeclaration { TD.service = S.Service methods } = [shamlet|- <h2>service <dfn><code>#{toNormalizedText ident}</code></dfn>+ <h2 id="#{toNormalizedText ident}">+ service <dfn><code>#{toNormalizedText ident}</code></dfn> $maybe d <- docsBlock tc #{blockToHtml d} $forall md@(S.Method _ ps ret err _) <- DES.toList methods@@ -329,6 +398,56 @@ TD.PrimitiveType {} -> "primitive" showKind TD.Import {} = "import" +readmePage :: Package Docs -> D.Docs -> Html+readmePage pkg docs' =+ layout pkg 0 IndexPage (docsTitle $ target pkg) content+ where+ content :: Html+ content = blockToHtml $ D.toBlock docs'++documentPage :: Package Docs -> FilePath -> D.Docs -> Html+documentPage pkg filePath docs' =+ layout pkg depth (DocumentPage filePath) title' content+ where+ title' :: T.Text+ title' = documentTitleText filePath docs'+ content :: Html+ content = blockToHtml $ D.toBlock docs'+ depth :: Int+ depth = length (splitPath (documentHtmlPath filePath)) - 1++documentHtmlPath :: FilePath -> FilePath+documentHtmlPath = (-<.> "html")++documentTitle :: FilePath -> D.Docs -> [Inline]+documentTitle filePath document =+ case extractTitle $ D.toBlock document of+ Just (_, inlines) -> inlines+ Nothing -> [Text $ T.pack filePath]++renderDocumentTitle :: FilePath -> D.Docs -> Html+renderDocumentTitle filePath =+ preEscapedToMarkup . renderLinklessInlines . documentTitle filePath++documentTitleText :: FilePath -> D.Docs -> T.Text+documentTitleText filePath =+ renderInlines' . documentTitle filePath+ where+ renderInline :: Inline -> T.Text+ renderInline (Text t) = t+ renderInline SoftLineBreak = "\n"+ renderInline HardLineBreak = "\n"+ renderInline (HtmlInline _) = ""+ renderInline (Code code') = code'+ renderInline (Emphasis inlines) = renderInlines inlines+ renderInline (Strong inlines) = renderInlines inlines+ renderInline (Link _ _ inlines) = renderInlines inlines+ renderInline (Image _ title)+ | T.null title = ""+ | otherwise = title+ renderInlines' :: [Inline] -> T.Text+ renderInlines' = T.concat . fmap renderInline+ contents :: Package Docs -> Html contents pkg@Package { metadata = md , modules = ms@@ -374,7 +493,7 @@ d <- docs' t <- D.title d nodes <- case t of- Heading _ inlines ->+ Heading _ inlines _ -> Just $ filterReferences inlines _ -> Nothing return $ preEscapedToMarkup $ renderInlines nodes@@ -387,6 +506,8 @@ margin: 0 font-family: Source Sans Pro color: #{gray8}+article+ line-height: 1.3 code font-family: Source Code Pro font-weight: 300@@ -396,7 +517,7 @@ pre padding: 16px 10px background-color: #{gray1}- code+ code, code.hljs background: none div border-top: 1px solid #{gray3}@@ -407,6 +528,11 @@ font-weight: bold code font-weight: 400+h2 a.pilcrow+ visibility: hidden+ margin-left: 10px+h2:hover a.pilcrow+ visibility: visible a text-decoration: none a:link@@ -440,6 +566,20 @@ color: #{gray8} .selected > a, a.selected color: #{indigo8} !important+ a.index+ text-decoration: none+ .version+ margin-left: 0.2em+ color: #{gray5}+ .version:before+ content: '('+ .version:after+ content: ')'+ a.index.selected .version+ color: #{indigo3}+ a.index:hover+ span, strong+ text-decoration: underline ul.toc margin: 0 padding: 0@@ -470,38 +610,175 @@ gray2 = Color 0xe9 0xec 0xef gray3 :: Color gray3 = Color 0xde 0xe2 0xe6+ gray5 :: Color+ gray5 = Color 0xad 0xb5 0xbd gray8 :: Color gray8 = Color 0x34 0x3a 0x40 graph8 :: Color graph8 = Color 0x9c 0x36 0xb5+ indigo3 :: Color+ indigo3 = Color 0x91 0xa7 0xff indigo8 :: Color indigo8 = Color 0x3b 0x5b 0xdb navWidth :: PixelSize navWidth = PixelSize 300 +javascript :: T.Text+javascript = [q|+window.addEventListener('load', function () {+ document.querySelectorAll('h2[id]').forEach(function(node) {+ var anchor = document.createElement("a");+ anchor.className = "pilcrow";+ anchor.text = "\xb6";+ anchor.href = "#" + node.id;+ node.appendChild(anchor);+ });+});+|]++nirumHighlightJavascript :: TL.Text+nirumHighlightJavascript = renderJavascript ([julius|+hljs.registerLanguage('nirum', function(hljs) {+ // Unfortunately CDN for highlight.js does not deliver+ // non-bundled unminified source, so we minify it by hand.+ // See also:+ // https://github.com/highlightjs/highlight.js/blob/master/tools/utility.js+ var begin = 'b';+ var beginKeywords = 'bK';+ var className = 'cN';+ var contains = 'c';+ var end = 'e';+ var excludeEnd = 'eE';+ var keywords = 'k';+ var relevance = 'r';+ var C_LINE_COMMENT_MODE = hljs.CLCM;+ var HASH_COMMENT_MODE = hljs.HCM;+ var APOS_STRING_MODE = hljs.ASM;+ var QUOTE_STRING_MODE = hljs.QSM;+ var NUMBER_MODE = hljs.NM;++ var NIRUM_IDENTIFIER_RE = '(`)?[a-zA-Z][a-zA-Z0-9\\-_]*\\1';+ var NIRUM_IDENTIFIER_MODE = {+ [className]: 'title',+ [begin]: NIRUM_IDENTIFIER_RE,+ [relevance]: 0,+ };++ return {+ [keywords]: {+ keyword: 'record enum unboxed type union service' ++ ' import throws as default',+ built_in: 'bigint decimal int32 int64 float32 float64' ++ ' text binary datetime date bool uuid uri',+ },+ [contains]: [+ // comments+ C_LINE_COMMENT_MODE,+ HASH_COMMENT_MODE,+ // string literals+ APOS_STRING_MODE,+ QUOTE_STRING_MODE,+ // number literals+ NUMBER_MODE,+ // annotations+ {+ [className]: 'meta',+ [begin]: '@\\\s*' + NIRUM_IDENTIFIER_RE,+ },+ // typedefs+ {+ [className]: 'class',+ [beginKeywords]: 'enum record union service',+ [end]: '[\\(=]',+ [excludeEnd]: true,+ [contains]: [+ C_LINE_COMMENT_MODE,+ HASH_COMMENT_MODE,+ NIRUM_IDENTIFIER_MODE,+ ]+ },+ ],+ }+});+hljs.initHighlightingOnLoad();+|] undefined :: Javascript)+ compilePackage' :: Package Docs -> Map FilePath (Either Error BS.ByteString)-compilePackage' pkg =- fromList [ ("style.css", Right $ encodeUtf8 $ TL.toStrict stylesheet)- , ("index.html", Right $ toStrict $ renderHtml $ contents pkg)- ] `union`- (fromList [ ( makeFilePath $ modulePath m- , Right $ toStrict $ renderHtml $ module' m- )- | m <- modules'- ] :: Map FilePath (Either Error BS.ByteString))+compilePackage' pkg = unions+ [ fromList+ [ ("style.css", Right $ encodeUtf8 css)+ , ("nirum.js", Right $ encodeUtf8 javascript)+ , ( "nirumHighlight.js"+ , Right $ encodeUtf8 $ TL.toStrict nirumHighlightJavascript+ )+ , ( "index.html"+ , Right $ toStrict $ renderHtml $ case readme of+ Nothing -> contents pkg+ Just readme' -> readmePage pkg readme'+ )+ ]+ , fromList+ [ ( makeFilePath $ modulePath m+ , Right $ toStrict $ renderHtml $ module' m+ )+ | m <- modules'+ ]+ , mapKeys documentHtmlPath $+ fmap+ (Right . toStrict . renderHtml)+ (mapWithKey (documentPage pkg) documents')+ ] where paths' :: [ModulePath] paths' = MS.keys $ modules pkg modules' :: [BoundModule Docs] modules' = mapMaybe (`resolveBoundModule` pkg) paths'+ css = T.concat [TL.toStrict stylesheet, "\n\n", docsStyle $ target pkg]+ (documents', readme) = listDocuments pkg +listDocuments :: Package Docs -> (Map FilePath D.Docs, Maybe D.Docs)+listDocuments Package { documents = documents' } =+ case Data.List.break (isReadme . fst) pairs of+ (a, (_, readme) : b) -> (fromList (a ++ b), Just readme)+ (a, []) -> (fromList a, Nothing)+ where+ isReadme :: FilePath -> Bool+ isReadme fp = "readme.md" == map toLower (takeFileName fp)+ pairs :: [(FilePath, D.Docs)]+ pairs = toList documents'+ instance Target Docs where type CompileResult Docs = BS.ByteString type CompileError Docs = Error targetName _ = "docs" parseTarget table = do title <- stringField "title" table- return Docs { docsTitle = title }+ opengraphs <- optional $ opengraphsField "opengraphs" table+ style <- optional $ stringField "style" table+ header <- optional $ stringField "header" table+ footer <- optional $ stringField "footer" table+ return Docs+ { docsTitle = title+ , docsOpenGraph = fromMaybe [] opengraphs+ , docsStyle = fromMaybe "" style+ , docsHeader = fromMaybe "" header+ , docsFooter = fromMaybe "" footer+ } compilePackage = compilePackage' showCompileError _ = id toByteString _ = id++opengraphsField :: MetadataField -> Table -> Either MetadataError [OpenGraph]+opengraphsField field' table = do+ array <- tableArrayField field' table+ opengraphs' <- mapM parseOpenGraph array+ return $ toList opengraphs'+ where+ parseOpenGraph :: Table -> Either MetadataError OpenGraph+ parseOpenGraph t = do+ tag' <- stringField "tag" t+ content' <- stringField "content" t+ return OpenGraph+ { ogTag = tag'+ , ogContent = content'+ }
src/Nirum/Targets/Python.hs view
@@ -18,7 +18,7 @@ import Control.Monad (forM) import Control.Monad.State (modify) import qualified Data.List as L-import Data.Maybe (catMaybes, fromMaybe)+import Data.Maybe (catMaybes, fromMaybe, isJust) import GHC.Exts (IsList (toList)) import qualified Data.ByteString.Lazy@@ -104,7 +104,7 @@ } deriving (Eq, Ord, Show) sourceImportPath :: Source -> T.Text-sourceImportPath (Source (Package MD.Metadata { MD.target = t } _) bm) =+sourceImportPath (Source (Package MD.Metadata { MD.target = t } _ _) bm) = toImportPath t (BM.modulePath bm) sourceDirectory :: PythonVersion -> T.Text@@ -685,12 +685,33 @@ |] compileTypeDeclaration src d@TypeDeclaration { typename = typename' , type' = UnboxedType itype+ , typeAnnotations = annots } = do let className = toClassName' typename' itypeExpr <- compileTypeExpression' src (Just itype) insertStandardImport "typing" pyVer <- getPythonVersion- Validator typePred valueValidators' <- compileValidator' src itype "value"+ Validator typePred valueValidatorsProto <-+ compileValidator' src itype "value"+ valueValidators' <- case A.lookup "numeric-constraints" annots of+ Just A.Annotation { A.arguments = args } -> do+ let constraintValidators =+ [ case (name', value) of+ ("min", Integer v) ->+ Just $ ValueValidator+ [qq|value >= ($v)|]+ [qq|value is less than $v|]+ ("max", Integer v) ->+ Just $ ValueValidator+ [qq|value <= ($v)|]+ [qq|value is greater than $v|]+ _ -> Nothing+ | (name', value) <- toList args+ ]+ if all isJust constraintValidators+ then return $ catMaybes constraintValidators+ else fail "Unsupported arguments on @numeric-constraints"+ Nothing -> return valueValidatorsProto deserializer <- compileDeserializer' src itype "value" "rv" "on_error" defaultErrorHandler <- defaultDeserializerErrorHandler return [compileText|
src/Nirum/Targets/Python/Deserializers.hs view
@@ -200,7 +200,7 @@ if #{builtins}.isinstance(#{pairInput}, #{mAbc}.Mapping): try: (#{keyInput}) = #{pairInput}['key']- except KeyError:+ except #{builtins}.KeyError: (#{vError})( '[{0}].key'.format(#{pairIndex}), 'Expected to exist.' )@@ -209,7 +209,7 @@ #{indent " " keyDeserializer} try: (#{valueInput}) = #{pairInput}['value']- except KeyError:+ except #{builtins}.KeyError: (#{vError})( '[{0}].value'.format(#{pairIndex}), 'Expected to exist.' )@@ -288,7 +288,7 @@ if #{builtins}.isinstance(#{vInput}, #{baseString}): try: #{vOutput} = #{builtins}.int(#{vInput})- except ValueError:+ except #{builtins}.ValueError: #{vError}( '', 'Expected a string of decimal digits, '
test/Nirum/CodeBuilderSpec.hs view
@@ -44,6 +44,7 @@ , target = DummyTarget } , modules = modules'+ , documents = M.empty } run :: CodeBuilder DummyTarget () a -> L.Text
test/Nirum/Constructs/DocsSpec.hs view
@@ -29,12 +29,13 @@ `shouldBe` Nothing it "returns Just Heading if its first block is a heading" $ do title (Docs "# H1\n\nis its first block!") `shouldBe`- Just (Heading H1 [Text "H1"])+ Just (Heading H1 [Text "H1"] Nothing) title (Docs "## Not have to be H1\n\nAny lebel can be a title.")- `shouldBe` Just (Heading H2 [Text "Not have to be H1"])+ `shouldBe`+ Just (Heading H2 [Text "Not have to be H1"] Nothing) specify "title block can other Inlines than Text" $ title (Docs "# `<code>`\n\nThe title can consist of.")- `shouldBe` Just (Heading H1 [Code "<code>"])+ `shouldBe` Just (Heading H1 [Code "<code>"] Nothing) context "toCode" $ do it "has leading sharps every line" $ do toCode (Docs "test") `shouldBe` "# test"
test/Nirum/Docs/HtmlSpec.hs view
@@ -21,6 +21,38 @@ <li><p>b</p></li> </ol> <p>A <a href="http://nirum.org/" title="Nirum">complex <em>link</em></a>.</p>+<h2 id="table-section">Table example</h2>+<table>+<thead>+<tr>++<th>A</th>+<th align="left">B</th>+<th align="center">C</th>+<th align="right">D</th>+</tr>+</thead>+<tbody>+<tr>+<td>foo</td>+<td>bar</td>+<td>baz</td>+<td>bim</td></tr>+<tr>+<td>qux</td>+<td>quux</td>+<td><img src="img.jpg"></td>+<td>quuz</td></tr>+<tr>+<td>corge</td>+<td>grault</td>+<td>garply</td>+<td>waldo</td></tr>+<tr>+<td>ga</td>+<td>na</td>+<td>da</td>+<td>ra</td></tr></tbody></table> |] spec :: Spec
test/Nirum/Docs/ReStructuredTextSpec.hs view
@@ -23,6 +23,30 @@ 2. b A `complex link <http://nirum.org/>`_\.+++.. _table-section:++Table example+-------------++++-------+--------+--------------------+-------++| A | B | C | D |++=======+========+====================+=======++| foo | bar | baz | bim |++-------+--------+--------------------+-------++| qux | quux | | quuz |+| | | | |+| | | .. image:: img.jpg | |+| | | | |++-------+--------+--------------------+-------++| corge | grault | garply | waldo |++-------+--------+--------------------+-------++| ga | na | da | ra |++-------+--------+--------------------+-------+++ |] spec :: Spec
test/Nirum/DocsSpec.hs view
@@ -1,7 +1,9 @@ {-# LANGUAGE ExtendedDefaultRules, OverloadedStrings, QuasiQuotes #-} module Nirum.DocsSpec where -import Data.Text (Text)+import Data.List.NonEmpty (NonEmpty ((:|)))++import Data.Text (Text, snoc) import Test.Hspec.Meta import Text.InterpolatedString.Perl6 (q) @@ -25,13 +27,23 @@ A [complex *link*][1]. +Table example {#table-section}+-------------++| A | B | C | D |+| ----- | :----- | :----------: | ----: |+| foo | bar | baz | bim |+| qux | quux |  | quuz |+| corge | grault | garply | waldo |+| ga | na | da | ra |+ [1]: http://nirum.org/ "Nirum" |] sampleHeading :: Block sampleHeading =- Heading H1 ["Hello"]+ Heading H1 ["Hello"] Nothing sampleDocument :: Block sampleDocument =@@ -39,10 +51,14 @@ sampleDocument' :: ([Block] -> [Block]) -> Block sampleDocument' adjust =+ sampleDocument_ adjust "http://nirum.org/" (Image "img.jpg" "")++sampleDocument_ :: ([Block] -> [Block]) -> Url -> Inline -> Block+sampleDocument_ adjust url img = (Document . adjust) [ Paragraph ["Tight list:"]- , List BulletList $ TightItemList [ ["List test"]- , ["test2"]+ , List BulletList $ TightItemList [ [Paragraph ["List test"]]+ , [Paragraph ["test2"]] ] , Paragraph ["Loose list:"] , List (OrderedList 1 Period) $@@ -51,10 +67,20 @@ ] , Paragraph [ "A "- , Link "http://nirum.org/" "Nirum"+ , Link url "Nirum" ["complex ", Emphasis ["link"]] , "." ]+ , Heading H2 ["Table example"] (Just "table-section")+ , Table+ (NotAligned :| [LeftAligned, CenterAligned, RightAligned])+ ( (["A"] :| [["B"], ["C"], ["D"]])+ :| [ ["foo"] :| [["bar"], ["baz"], ["bim"]]+ , ["qux"] :| [["quux"], [img], ["quuz"]]+ , ["corge"] :| [["grault"], ["garply"], ["waldo"]]+ , ["ga"] :| [["na"], ["da"], ["ra"]]+ ]+ ) ] spec :: Spec@@ -89,8 +115,18 @@ , "image" , "." ]+ specify "extractTitle" $ do+ let Heading lv inlines _ = sampleHeading+ extractTitle sampleDocument `shouldBe` Just (lv, inlines)+ extractTitle (sampleDocument' id) `shouldBe` Nothing specify "trimTitle" $ do -- Remove the top-level heading if it exists: trimTitle sampleDocument `shouldBe` sampleDocument' id -- No-op if there is no top-level heading: trimTitle (sampleDocument' id) `shouldBe` sampleDocument' id+ specify "transformReferences" $+ transformReferences (`snoc` '?') sampleDocument `shouldBe`+ sampleDocument_+ (sampleHeading :)+ "http://nirum.org/?"+ (Image "img.jpg?" "")
test/Nirum/PackageSpec.hs view
@@ -7,6 +7,7 @@ import Data.Text import System.IO.Error (isDoesNotExistError) +import Data.Map.Strict (Map) import qualified Data.SemVer as SV import System.FilePath ((</>)) import Test.Hspec.Meta@@ -14,6 +15,7 @@ import qualified Text.Parsec.Error as PE import Text.Parsec.Pos (sourceColumn, sourceLine) +import Nirum.Constructs.Docs import Nirum.Constructs.Module import Nirum.Constructs.ModulePath (ModulePath) import Nirum.Package hiding (modules, target)@@ -37,20 +39,29 @@ import Nirum.Targets.Python (Python (Python)) import Nirum.Targets.Python.CodeGen (minimumRuntime) -createPackage :: Metadata t -> [(ModulePath, Module)] -> Package t-createPackage metadata' modules' =+createPackage :: Target t+ => Metadata t+ -> [(ModulePath, Module)]+ -> Map FilePath Docs+ -> Package t+createPackage metadata' modules' documents' = case fromList modules' of- Right ms -> Package metadata' ms+ Right ms -> Package metadata' ms documents' Left e -> error $ "errored: " ++ show e -createValidPackage :: t -> Package t-createValidPackage t = createPackage Metadata { version = SV.initial- , authors = []- , description = Nothing- , license = Nothing- , keywords = []- , target = t- } validModules+createValidPackage :: forall t . Target t => t -> Package t+createValidPackage t =+ createPackage metadata' validModules []+ where+ metadata' :: Metadata t+ metadata' = Metadata+ { version = SV.initial+ , authors = []+ , description = Nothing+ , license = Nothing+ , keywords = []+ , target = t+ } spec :: Spec spec = do@@ -100,15 +111,23 @@ , (["address"], addressM) , (["pdf-service"], pdfServiceM) ] :: [(ModulePath, Module)]- metadata' = Metadata { version = SV.version 0 3 0 [] []+ let metadata' = Metadata { version = SV.version 0 3 0 [] [] , authors = [] , description = Nothing , license = Nothing , keywords = [] , target = target' }+ let documents' =+ [ ( "README.md"+ , Docs $ Data.Text.concat+ [ "# Nirum examples\n\nThis directory "+ , "contains a sample Nirum package.\n"+ ]+ )+ ] metadata package `shouldBe` metadata'- package `shouldBe` createPackage metadata' modules+ package `shouldBe` createPackage metadata' modules documents' let testDir = "." </> "test" it "returns ScanError if the directory lacks package.toml" $ do scanResult <- scanPackage' $ testDir </> "scan_error"
test/Nirum/Targets/Python/CodeGenSpec.hs view
@@ -74,6 +74,7 @@ Nothing ) ]+ [] makeDummySource :: Module -> Source makeDummySource m = makeDummySource' [] m []
test/Nirum/Targets/PythonSpec.hs view
@@ -3,11 +3,15 @@ module Nirum.Targets.PythonSpec where import qualified Data.Map.Strict as M+import Data.Either import System.FilePath ((</>)) import Test.Hspec.Meta +import Nirum.Constructs.Annotation hiding (null)+import Nirum.Constructs.Annotation.Internal import Nirum.Constructs.Module (Module (Module))-import Nirum.Package.Metadata (Target (compilePackage))+import Nirum.Constructs.TypeDeclaration hiding (Text)+import qualified Nirum.Package.Metadata as M import Nirum.Targets.Python ( Source (Source) , parseModulePath@@ -19,7 +23,7 @@ describe "compilePackage" $ do it "returns a Map of file paths and their contents to generate" $ do let (Source pkg _) = makeDummySource $ Module [] Nothing- files = compilePackage pkg+ files = M.compilePackage pkg directoryStructure = [ "src-py2" </> "foo" </> "__init__.py" , "src-py2" </> "foo" </> "bar" </> "__init__.py"@@ -34,7 +38,7 @@ it "creates an emtpy Python package directory if necessary" $ do let (Source pkg _) = makeDummySource' ["test"] (Module [] Nothing) []- files = compilePackage pkg+ files = M.compilePackage pkg directoryStructure = [ "src-py2" </> "test" </> "__init__.py" , "src-py2" </> "test" </> "foo" </> "__init__.py"@@ -51,7 +55,7 @@ it "generates renamed package dirs if renames are configured" $ do let (Source pkg _) = makeDummySource' [] (Module [] Nothing) [(["foo"], ["quz"])]- files = compilePackage pkg+ files = M.compilePackage pkg directoryStructure = [ "src-py2" </> "quz" </> "__init__.py" , "src-py2" </> "quz" </> "bar" </> "__init__.py"@@ -65,7 +69,7 @@ M.keysSet files `shouldBe` directoryStructure let (Source pkg' _) = makeDummySource' [] (Module [] Nothing) [(["foo", "bar"], ["bar"])]- files' = compilePackage pkg'+ files' = M.compilePackage pkg' directoryStructure' = [ "src-py2" </> "foo" </> "__init__.py" , "src-py2" </> "bar" </> "__init__.py"@@ -90,3 +94,43 @@ parseModulePath "foo..bar" `shouldBe` Nothing parseModulePath "foo.bar>" `shouldBe` Nothing parseModulePath "foo.bar-" `shouldBe` Nothing++ describe "@numeric-constraints" $ do+ it "fails if unsupported arguments are present" $ do+ let Right annots = fromList+ [ Annotation+ "numeric-constraints"+ [("min", Integer 1), ("unsupported", Integer 2)]+ ]+ compareErrorMessage annots++ it "fails if unsupported arguments type is given" $ do+ let Right annots = fromList+ [ Annotation+ "numeric-constraints"+ [("min", Integer 1), ("max", Text "2")]+ ]+ compareErrorMessage annots++ it "success" $ do+ let Right annots = fromList+ [ Annotation+ "numeric-constraints"+ [("min", Integer 1), ("max", Integer 2)]+ ]+ let Just result = getResult annots+ isRight result `shouldBe` True+ where+ compareErrorMessage annots = do+ let Just result = getResult annots+ let Left errorMessage = result+ errorMessage `shouldBe`+ "Unsupported arguments on @numeric-constraints"++ getResult annots =+ let+ unboxed = TypeDeclaration "foo" (UnboxedType "int32") annots+ (Source pkg _) = makeDummySource $ Module [unboxed] Nothing+ files = M.compilePackage pkg+ in+ M.lookup ("src" </> "foo" </> "__init__.py") files
test/Nirum/TargetsSpec.hs view
@@ -14,39 +14,42 @@ import Nirum.Package.Metadata (MetadataError (FormatError)) import Nirum.Package.ModuleSet (ImportError (MissingModulePathError)) import Nirum.Targets ( BuildError (PackageError, TargetNameError)- , buildPackage+ , buildPackageFromFilePath ) spec :: Spec spec = describe "Targets" $- describe "buildPackage" $ do+ describe "buildPackageFromFilePath" $ do it "returns Left TargetNameError if there's no such target" $ do let path = "." </> "examples"- result <- buildPackage "unregisteredtarget" path+ result <- buildPackageFromFilePath "unregisteredtarget" path result `shouldBe` Left (TargetNameError "unregisteredtarget") it "returns Left PackageError if the given package is invalid" $ do let testDir = "." </> "test" -- ScanError- result <- buildPackage "python" $ testDir </> "scan_error"+ result <- buildPackageFromFilePath "python" $+ testDir </> "scan_error" result `shouldSatisfy` isLeft let Left (PackageError (ScanError filePath ioError')) = result filePath `shouldBe` testDir </> "scan_error" </> "package.toml" ioError' `shouldSatisfy` isDoesNotExistError -- MetadataError- result2 <- buildPackage "python" $ testDir </> "metadata_error"+ result2 <- buildPackageFromFilePath "python" $+ testDir </> "metadata_error" result2 `shouldSatisfy` isLeft let Left (PackageError (MetadataError (FormatError e))) = result2 sourceLine (PE.errorPos e) `shouldBe` 3 sourceColumn (PE.errorPos e) `shouldBe` 14 -- ImportError- result3 <- buildPackage "python" $ testDir </> "import_error"+ result3 <- buildPackageFromFilePath "python" $+ testDir </> "import_error" result3 `shouldSatisfy` isLeft let Left (PackageError (ImportError l)) = result3 l `shouldBe` [MissingModulePathError ["import_error"] ["foo"]] it "returns Right BuildResult" $ do- result <- buildPackage "python" $ "." </> "examples"+ result <- buildPackageFromFilePath "python" $ "." </> "examples" result `shouldSatisfy` isRight let Right buildResult = result M.keysSet buildResult `shouldBe`
test/Nirum/VersionSpec.hs view
@@ -17,7 +17,7 @@ version `shouldSatisfy` SV.isDevelopment it "is the proper version" $ -- is it a necessary test?- version `shouldBe` SV.version 0 4 2 [] []+ version `shouldBe` SV.version 0 5 0 [] [] describe "versionText" $ do it "is equivalent to version" $ versionText `shouldBe` SV.toText version