From f4a44493e21abd1ed2e34eff52f5bcac518a6dd0 Mon Sep 17 00:00:00 2001 From: Hong Minhee Date: Mon, 16 May 2016 04:01:40 +0900 Subject: [PATCH] CommonMark-based docs --- nirum.cabal | 3 + src/Nirum/Docs.hs | 165 +++++++++++++++++++++++++++++++++++++++++ test/Nirum/DocsSpec.hs | 57 ++++++++++++++ 3 files changed, 225 insertions(+) create mode 100644 src/Nirum/Docs.hs create mode 100644 test/Nirum/DocsSpec.hs diff --git a/nirum.cabal b/nirum.cabal index 95eb894..fe30ddf 100644 --- a/nirum.cabal +++ b/nirum.cabal @@ -32,11 +32,13 @@ library , Nirum.Constructs.Service , Nirum.Constructs.TypeDeclaration , Nirum.Constructs.TypeExpression + , Nirum.Docs , Nirum.Package , Nirum.Parser , Nirum.Targets.Python , Nirum.Version build-depends: base >=4.7 && <5 + , cmark >=0.5 && <0.6 , containers >=0.5.6.2 && <0.6 , cmdargs >=0.10.14 && <0.11 , directory >=1.2.5 && <1.3 @@ -82,6 +84,7 @@ test-suite spec , Nirum.Constructs.ServiceSpec , Nirum.Constructs.TypeDeclarationSpec , Nirum.Constructs.TypeExpressionSpec + , Nirum.DocsSpec , Nirum.PackageSpec , Nirum.ParserSpec , Nirum.Targets.PythonSpec diff --git a/src/Nirum/Docs.hs b/src/Nirum/Docs.hs new file mode 100644 index 0000000..ae6021f --- /dev/null +++ b/src/Nirum/Docs.hs @@ -0,0 +1,165 @@ +module Nirum.Docs ( Block ( BlockQuote + , CodeBlock + , Document + , Heading + , HtmlBlock + , List + , Paragraph + , ThematicBreak + , infoString + , code + ) + , HeadingLevel(H1, H2, H3, H4, H5, H6) + , Html + , Inline ( Code + , Emphasis + , HardLineBreak + , HtmlInline + , Image + , Link + , SoftLineBreak + , Strong + , Text + , imageTitle + , imageUrl + , linkTitle + , linkUrl + ) + , ItemList(LooseItemList, TightItemList) + , ListType(BulletList, OrderedList, startNumber, delimiter) + , ListDelimiter(Parenthesis, Period) + , LooseItem + , TightItem + , Title + , Url + , headingLevelFromInt + , parse + ) where + +import Data.String (IsString(fromString)) + +import qualified CMark as M +import qualified Data.Text as T + +type Url = T.Text +type Title = T.Text +type Html = T.Text + +-- | The level of heading. +-- See also: http://spec.commonmark.org/0.25/#atx-heading +data HeadingLevel = H1 | H2 | H3 | H4 | H5 | H6 deriving (Eq, Ord, Show) + +headingLevelFromInt :: Int -> HeadingLevel +headingLevelFromInt 2 = H2 +headingLevelFromInt 3 = H3 +headingLevelFromInt 4 = H4 +headingLevelFromInt 5 = H5 +headingLevelFromInt i = if i > 5 then H6 else H1 + +-- | Whether a list is a bullet list or an ordered list. +-- See also: http://spec.commonmark.org/0.25/#of-the-same-type +data ListType = BulletList + | OrderedList { startNumber :: Int + , delimiter :: ListDelimiter + } + deriving (Eq, Ord, Show) + +-- | Whether ordered list markers are followed by period (@.@) or +-- parenthesis (@)@). +-- See also: http://spec.commonmark.org/0.25/#ordered-list-marker +data ListDelimiter = Period | Parenthesis deriving (Eq, Ord, Show) + +data Block = Document [Block] + | ThematicBreak + | Paragraph [Inline] + | BlockQuote [Block] + | HtmlBlock Html + | CodeBlock { infoString :: T.Text, code :: T.Text } + | Heading HeadingLevel [Inline] + | List ListType ItemList + deriving (Eq, Ord, Show) + +data ItemList = LooseItemList [LooseItem] + | TightItemList [TightItem] + deriving (Eq, Ord, Show) + +type LooseItem = [Block] + +type TightItem = [Inline] + +data Inline + = Text T.Text + | SoftLineBreak -- | See also: + -- http://spec.commonmark.org/0.25/#soft-line-breaks + | HardLineBreak -- | See also: + -- http://spec.commonmark.org/0.25/#hard-line-breaks + | HtmlInline Html + | Code T.Text + | Emphasis [Inline] + | Strong [Inline] + | Link { linkUrl :: Url, linkTitle :: Title } + | Image { imageUrl :: Url, imageTitle :: Title } + deriving (Eq, Ord, Show) + +parse :: T.Text -> Block +parse = + transBlock . M.commonmarkToNode [M.optNormalize, M.optSmart] + where + transBlock :: M.Node -> Block + transBlock n@(M.Node _ nodeType children) = + case nodeType of + M.DOCUMENT -> Document blockChildren + M.THEMATIC_BREAK -> ThematicBreak + M.PARAGRAPH -> Paragraph inlineChildren + M.BLOCK_QUOTE -> BlockQuote blockChildren + 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.LIST (M.ListAttributes listType' tight start delim) -> + List (case listType' of + M.BULLET_LIST -> BulletList + M.ORDERED_LIST -> + OrderedList start $ + case delim of + M.PERIOD_DELIM -> Period + M.PAREN_DELIM -> Parenthesis + ) $ + if tight + then TightItemList $ map stripParagraph listItems + else LooseItemList $ map (map transBlock) listItems + _ -> error $ "expected block, but got inline: " ++ n' + where + blockChildren :: [Block] + blockChildren = map transBlock children + inlineChildren :: [Inline] + inlineChildren = map 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 + transInline n@(M.Node _ nodeType childNodes) = + case nodeType of + M.TEXT text -> Text text + M.SOFTBREAK -> SoftLineBreak + M.LINEBREAK -> HardLineBreak + M.HTML_INLINE rawHtml -> HtmlInline rawHtml + M.CODE code' -> Code code' + M.EMPH -> Emphasis children + M.STRONG -> Strong children + M.LINK url title -> Link url title + M.IMAGE url title -> Image url title + _ -> error $ "expected inline, but got block: " ++ show n + where + children :: [Inline] + children = map transInline childNodes + +instance IsString Block where + fromString = parse . T.pack + +instance IsString Inline where + fromString = Text . T.pack diff --git a/test/Nirum/DocsSpec.hs b/test/Nirum/DocsSpec.hs new file mode 100644 index 0000000..6256b7e --- /dev/null +++ b/test/Nirum/DocsSpec.hs @@ -0,0 +1,57 @@ +{-# LANGUAGE ExtendedDefaultRules, OverloadedStrings, QuasiQuotes #-} +module Nirum.DocsSpec where + +import Test.Hspec.Meta +import Text.InterpolatedString.Perl6 (q) + +import Nirum.Docs ( Block(..) + , HeadingLevel(..) + , ItemList(..) + , ListDelimiter(..) + , ListType(..) + , headingLevelFromInt + , parse + ) + +spec :: Spec +spec = do + describe "HeadingLevel" $ + specify "headingLevelFromInt" $ do + headingLevelFromInt (-1) `shouldBe` H1 + headingLevelFromInt 0 `shouldBe` H1 + headingLevelFromInt 1 `shouldBe` H1 + headingLevelFromInt 2 `shouldBe` H2 + headingLevelFromInt 3 `shouldBe` H3 + headingLevelFromInt 4 `shouldBe` H4 + headingLevelFromInt 5 `shouldBe` H5 + headingLevelFromInt 6 `shouldBe` H6 + headingLevelFromInt 7 `shouldBe` H6 + headingLevelFromInt 99 `shouldBe` H6 + specify "parse" $ + parse [q| +Hello +===== + +Tight list: + +- List test +- test2 + +Loose list: + +1. a + +2. b + +|] `shouldBe` + Document [ Heading H1 ["Hello"] + , Paragraph ["Tight list:"] + , List BulletList $ TightItemList [ ["List test"] + , ["test2"] + ] + , Paragraph ["Loose list:"] + , List (OrderedList 1 Period) $ + LooseItemList [ [Paragraph ["a"]] + , [Paragraph ["b"]] + ] + ]