cmark-sections (empty) → 0.1.0.0
raw patch · 6 files changed
+536/−0 lines, 6 filesdep +QuickCheckdep +basedep +base-preludesetup-changed
Dependencies added: QuickCheck, base, base-prelude, cmark, cmark-sections, containers, hspec, microlens, split, text
Files
- CHANGELOG.md +3/−0
- LICENSE +30/−0
- Setup.hs +2/−0
- cmark-sections.cabal +51/−0
- lib/CMark/Sections.hs +266/−0
- tests/Main.hs +184/−0
+ CHANGELOG.md view
@@ -0,0 +1,3 @@+# 0.1.0.0++First release.
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2016, Artyom++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Artyom nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ cmark-sections.cabal view
@@ -0,0 +1,51 @@+name: cmark-sections+version: 0.1.0.0+synopsis: Represent cmark-parsed Markdown as a tree of sections+description:+ Represent cmark-parsed Markdown as a tree of sections+homepage: http://github.com/aelve/cmark-sections+bug-reports: http://github.com/aelve/cmark-sections/issues+license: BSD3+license-file: LICENSE+author: Artyom+maintainer: yom@artyom.me+-- copyright: +category: Text+tested-with: GHC == 7.8.4, GHC == 7.10.3, GHC == 8.0.1+build-type: Simple+extra-source-files: CHANGELOG.md+cabal-version: >=1.10++source-repository head+ type: git+ location: git://github.com/aelve/cmark-sections.git++library+ exposed-modules: CMark.Sections+ -- other-modules: + -- other-extensions: + build-depends: base >=4.7 && <5+ , base-prelude == 1.*+ , cmark >= 0.5 && < 0.5.4+ , containers+ , microlens == 0.4.*+ , split == 0.2.*+ , text+ ghc-options: -Wall -fno-warn-unused-do-bind+ hs-source-dirs: lib+ default-language: Haskell2010++test-suite tests+ main-is: Main.hs+ type: exitcode-stdio-1.0+ build-depends: QuickCheck >= 2.8 && < 3+ , base >=4.7 && <5+ , base-prelude == 1.*+ , cmark+ , cmark-sections+ , containers+ , hspec == 2.2.*+ , text+ ghc-options: -Wall -fno-warn-unused-do-bind+ hs-source-dirs: tests+ default-language: Haskell2010
+ lib/CMark/Sections.hs view
@@ -0,0 +1,266 @@+{-# LANGUAGE+TemplateHaskell,+RecordWildCards,+DeriveFunctor,+DeriveFoldable,+DeriveTraversable,+OverloadedStrings,+NoImplicitPrelude+ #-}+++{- |+This library lets you parse Markdown into a hierarchical structure (delimited by headings). For instance, let's say your document looks like this:++@+This is the preface.++First chapter+========================================++This chapter doesn't have sections.++Second chapter+========================================++First section+--------------------++Here's some text.++Second section+--------------------++And more text.+@++It can be represented as a tree:++@+'preface': "This is the preface."+'sections':+ * 'heading': __"First chapter"__+ 'content': "This chapter doesn't have sections."+ 'sections': []++ * 'heading': __"Second chapter"__+ 'sections':+ * 'heading': __"First section"__+ 'content': "Here's some text."+ 'sections': []++ * 'heading': __"Second section"__+ 'content': "And more text."+ 'sections': []+@++That's what this library does. Moreover, it lets you access the Markdown source of every node of the tree.++In most cases the only thing you need to do is something like this:++@+'nodesToDocument' . 'commonmarkToAnnotatedNodes' ['optSafe', 'optNormalize']+@++You can preprocess parsed Markdown after doing 'commonmarkToAnnotatedNodes' as long as you don't add or remove any top-level nodes.+-}+module CMark.Sections+(+ -- * Parse Markdown to trees+ commonmarkToAnnotatedNodes,+ nodesToDocument,+ Annotated(..),+ Section(..),+ Document(..),++ -- * Work with parsed trees+ -- $monoid-note+ flattenDocument,+ flattenSection,+ flattenTree,+ flattenForest,+)+where+++import BasePrelude+-- Lenses+import Lens.Micro hiding ((&))+-- Text+import qualified Data.Text as T+import Data.Text (Text)+-- Markdown+import CMark+-- Containers+import qualified Data.Tree as Tree+-- Lists+import Data.List.Split+++{- |+A data type for annotating things with their source. In this library we only use @Annotated [Node]@, which stands for “some Markdown nodes + source”.+-}+data Annotated a = Ann {+ annSource :: Text,+ annValue :: a }+ deriving (Eq, Show, Functor, Foldable, Traversable)++instance Monoid a => Monoid (Annotated a) where+ mempty = Ann "" mempty+ Ann s1 v1 `mappend` Ann s2 v2 = Ann (s1 <> s2) (v1 <> v2)++{- |+A section in the Markdown tree. Does not contain subsections (the tree is built using 'Tree.Forest' from "Data.Tree").+-}+data Section a b = Section {+ -- | Level (from 1 to 6).+ level :: Int,+ heading :: Annotated [Node],+ headingAnn :: a,+ -- | Text between the heading and the first subsection. Can be empty.+ content :: Annotated [Node],+ contentAnn :: b }+ deriving (Eq, Show)++{- |+The whole parsed Markdown tree. The first parameter is the type of annotations for headings (i.e. sections), the second – chunks of text (which are all associated with sections except for the preface).+-}+data Document a b = Document {+ -- | Text before the first section. Can be empty.+ preface :: Annotated [Node],+ prefaceAnn :: b,+ sections :: Tree.Forest (Section a b) }+ deriving (Eq, Show)++{- |+'commonmarkToAnnotatedNodes' parses Markdown with the given options and extracts nodes from the initial 'DOCUMENT' node.+-}+commonmarkToAnnotatedNodes :: [CMarkOption] -> Text -> Annotated [Node]+commonmarkToAnnotatedNodes opts s = Ann s ns+ where+ Node _ DOCUMENT ns = commonmarkToNode opts s++{- | Break Markdown into pieces:++@+ blah blah blah }+ }----> init+ blah blah blah }++ # foo }+ }+ blah blah }----> (heading, blocks after)+ }+ blah blah }++ ## bar }+ }----> (heading, blocks after)+ blah blah }++ ...+@+-}+breakAtHeadings+ :: [Node]+ -> ([Node], [(Node, [Node])]) -- ^ (blocks before the first heading,+ -- headings + blocks after)+breakAtHeadings nodes =+ let (init':rest') = split (keepDelimsL (whenElt isHeading)) nodes+ in (init', map (fromJust . uncons) rest')+ where+ isHeading (Node _ (HEADING _) _) = True+ isHeading _ = False++-- | Get start line of a node.+start :: Node -> Int+start (Node (Just p) _ _) = startLine p+start (Node Nothing _ _) =+ error "CMark.Sections.start: node doesn't have a position"++-- We assume here that two top-level blocks can't possibly be on the same line.+cut+ :: Node -- ^ First node to include+ -> Node -- ^ First node to exclude+ -> Text+ -> Text+cut a b = T.unlines . take (start b - start a) . drop (start a - 1) . T.lines++cutTo+ :: Node+ -> Text+ -> Text+cutTo b = T.unlines . take (start b - 1) . T.lines++cutFrom+ :: Node+ -> Text+ -> Text+cutFrom a = T.unlines . drop (start a - 1) . T.lines++{- |+Turn a list of Markdown nodes into a tree.+-}+nodesToDocument :: Annotated [Node] -> Document () ()+nodesToDocument (Ann src nodes) = do+ -- Break at headings+ let prefaceNodes :: [Node]+ restNodes :: [(Node, [Node])]+ (prefaceNodes, restNodes) = breakAtHeadings nodes+ -- Annotate the first block with the source. If there are no headings at+ -- all, we just copy everything; otherwise we cut until the first heading.+ let prefaceAnnotated :: Annotated [Node]+ prefaceAnnotated = case restNodes of+ [] -> Ann src prefaceNodes+ (x:_) -> Ann (cutTo (fst x) src) prefaceNodes+ -- Annotate other blocks with their sources by cutting until the position+ -- of the next block+ let blocks :: [((Int, Annotated [Node]), Annotated [Node])]+ blocks = do+ ((heading, afterBlocks), mbNext) <-+ zip restNodes (tail (map Just restNodes ++ [Nothing]))+ let Node _ (HEADING hLevel) hNodes = heading+ let hSrc = case (afterBlocks, mbNext) of+ (x:_, _) -> cut heading x src+ ([], Just (x, _)) -> cut heading x src+ ([], Nothing) -> cutFrom heading src+ let afterBlocksSrc = case (afterBlocks, mbNext) of+ ([], _) -> ""+ (x:_, Just (y, _)) -> cut x y src+ (x:_, Nothing) -> cutFrom x src+ return ((hLevel, Ann hSrc hNodes),+ Ann afterBlocksSrc afterBlocks)+ -- A function for turning blocks into a tree+ let makeTree [] = []+ makeTree (((level, heading), content) : xs) =+ let (nested, others) = span (\x -> x^._1._1 > level) xs+ section = Section {+ headingAnn = (),+ contentAnn = (),+ .. }+ in Tree.Node section (makeTree nested) : makeTree others+ -- Return the result+ Document {+ preface = prefaceAnnotated,+ prefaceAnn = (),+ sections = makeTree blocks }++{- $monoid-note++Note that you can use ('<>') to combine 'Annotated' nodes together.+-}++flattenDocument :: Document a b -> Annotated [Node]+flattenDocument Document{..} = preface <> flattenForest sections++flattenSection :: Section a b -> Annotated [Node]+flattenSection Section{..} =+ Ann (annSource heading <> annSource content)+ (headingNode : annValue content)+ where+ headingNode = Node Nothing (HEADING level) (annValue heading)++flattenTree :: Tree.Tree (Section a b) -> Annotated [Node]+flattenTree (Tree.Node r f) = flattenSection r <> flattenForest f++flattenForest :: Tree.Forest (Section a b) -> Annotated [Node]+flattenForest = mconcat . map flattenSection . concatMap Tree.flatten
+ tests/Main.hs view
@@ -0,0 +1,184 @@+{-# LANGUAGE+OverloadedStrings,+RecordWildCards,+ViewPatterns,+NoImplicitPrelude+ #-}+++module Main where+++import BasePrelude+-- Trees+import qualified Data.Tree as Tree+-- Text+import qualified Data.Text as T+import Data.Text (Text)+-- Tests+import Test.Hspec+import Test.QuickCheck+import Test.Hspec.QuickCheck+-- Markdown+import CMark+import CMark.Sections+++main :: IO ()+main = hspec $ do+ let mkSect level heading content ns =+ Tree.Node Section{headingAnn = (),contentAnn = (),..} ns+ describe "converting:" $ do+ it "empty document" $ do+ let src = ""+ prefaceAnn = ()+ preface = mempty+ sections = []+ nodesToDocument (commonmarkToAnnotatedNodes [] src)+ `shouldBe` Document{..}+ it "spaces" $ do+ let src = " \n\n \n"+ prefaceAnn = ()+ preface = Ann " \n\n \n" []+ sections = []+ nodesToDocument (commonmarkToAnnotatedNodes [] src)+ `shouldBe` Document{..}+ it "paragraph" $ do+ let src = "x"+ prefaceAnn = ()+ preface = Ann "x" [+ Node (Just (PosInfo 1 1 1 1)) PARAGRAPH [text "x"] ]+ sections = []+ nodesToDocument (commonmarkToAnnotatedNodes [] src)+ `shouldBe` Document{..}+ it "3 paragraphs" $ do+ let src = T.unlines ["","x","","","y","","z",""]+ prefaceAnn = ()+ preface = Ann "\nx\n\n\ny\n\nz\n\n" [+ Node (Just (PosInfo 2 1 2 1)) PARAGRAPH [text "x"],+ Node (Just (PosInfo 5 1 5 1)) PARAGRAPH [text "y"],+ Node (Just (PosInfo 7 1 7 1)) PARAGRAPH [text "z"] ]+ sections = []+ nodesToDocument (commonmarkToAnnotatedNodes [] src)+ `shouldBe` Document{..}+ it "headers" $ do+ let src = T.unlines ["# 1", "", "## 2", "", "## 3"]+ prefaceAnn = ()+ preface = mempty+ sections = [+ mkSect 1 (Ann "# 1\n\n" [text "1"]) mempty [+ mkSect 2 (Ann "## 2\n\n" [text "2"]) mempty [],+ mkSect 2 (Ann "## 3\n" [text "3"]) mempty [] ] ]+ nodesToDocument (commonmarkToAnnotatedNodes [] src)+ `shouldBe` Document{..}+ it "headers+content" $ do+ let src = T.unlines ["# 1", "", "## 2", "test", "## 3"]+ prefaceAnn = ()+ preface = mempty+ sections = [+ mkSect 1 (Ann "# 1\n\n" [text "1"]) mempty [+ mkSect 2 (Ann "## 2\n" [text "2"])+ (Ann "test\n" [Node (Just (PosInfo 4 1 4 4)) PARAGRAPH+ [text "test"]]) [],+ mkSect 2 (Ann "## 3\n" [text "3"]) mempty [] ] ]+ nodesToDocument (commonmarkToAnnotatedNodes [] src)+ `shouldBe` Document{..}+ it "preface+headers" $ do+ let src = T.unlines ["blah", "# 1", "", "## 2", "", "## 3"]+ prefaceAnn = ()+ preface = commonmarkToAnnotatedNodes [] "blah\n"+ sections = [+ mkSect 1 (Ann "# 1\n\n" [text "1"]) mempty [+ mkSect 2 (Ann "## 2\n\n" [text "2"]) mempty [],+ mkSect 2 (Ann "## 3\n" [text "3"]) mempty [] ] ]+ nodesToDocument (commonmarkToAnnotatedNodes [] src)+ `shouldBe` Document{..}++ describe "reconstruction:" $ do+ it "paragraph + ###-header" $+ fromToDoc "foo\n\n# bar\n"+ it "paragraph + ===-header" $+ fromToDoc "foo\n\nbar\n===\n"+ it "no blank line after header" $+ fromToDoc "# header\n# header\n"+ it "header + blockquote" $+ fromToDoc "# header\n\n> a blockquote\n"+ it "header + list" $+ fromToDoc "# header\n * item\n"+ it "blanks + header" $+ fromToDoc "\n\n\n# header\n"+ modifyMaxSize (*20) $ modifyMaxSuccess (*10) $+ prop "QuickCheck" $+ forAllShrink mdGen shrinkMD $ \(T.concat -> src) ->+ let md1 = commonmarkToAnnotatedNodes [] src+ md2 = flattenDocument . nodesToDocument $ md1+ err = printf "%s: %s /= %s" (show src) (show md1) (show md2)+ in counterexample err (compareMD md1 md2)++text :: Text -> Node+text t = Node Nothing (TEXT t) []++fromToDoc :: Text -> Expectation+fromToDoc src =+ flattenDocument (nodesToDocument (commonmarkToAnnotatedNodes [] src))+ `shouldBeMD` commonmarkToAnnotatedNodes [] src++shouldBeMD :: Annotated [Node] -> Annotated [Node] -> Expectation+shouldBeMD x y = x `shouldSatisfy` (compareMD y)++-- | Check that pieces of Markdown are equivalent (modulo trailing newline+-- and position info).+compareMD :: Annotated [Node] -> Annotated [Node] -> Bool+compareMD x y =+ map (\(Node _ a b) -> Node Nothing a b) (annValue x) ==+ map (\(Node _ a b) -> Node Nothing a b) (annValue y)+ &&+ or [annSource x == annSource y,+ and [not (T.isSuffixOf "\n" (annSource x)),+ T.isSuffixOf "\n" (annSource y),+ annSource x == T.init (annSource y)],+ and [not (T.isSuffixOf "\n" (annSource y)),+ T.isSuffixOf "\n" (annSource x),+ annSource y == T.init (annSource x)] ]++-- | Try to shrink Markdown.+shrinkMD :: [Text] -> [[Text]]+shrinkMD = shrinkList shrinkNothing++-- | Generate random Markdown.+mdGen :: Gen [Text]+mdGen = do+ ls <- listOf $ elements [+ -- ###-headers+ "# header 1\n", "# header 1 #\n",+ "## header 2\n",+ "### header 3\n",+ "#### header 4\n",+ "##### header 5\n",+ "###### header 6\n",+ " # header 1\n", " # header 1\n",+ " ## header 2\n", " ## header 2\n",+ -- ===-headers+ "header 1\n======\n", "header 2\n------\n",+ "multiline\nheader 1\n======\n", "multiline\nheader 2\n------\n",+ -- blocks with headers inside+ "> # header\n", "* # header\n",+ -- lists+ "* item\n", " * item\n",+ "+ item 1\n+ item 2\n",+ -- links and link references+ "[link][link]\n",+ "[link]: http://google.com\n",+ "> [link]: http://google.com\n",+ -- blockquotes+ "> blockquote\n> 1\n", ">> blockquote\n>> 2\n",+ -- other blocks+ " a *paragraph*\n",+ "*multiline*\nparagraph\n",+ "~~~\ncode block\n~~~\n", " code\n",+ "---\n", "* * *\n", " * * * \n",+ -- other things+ "", " ", " ", "\n", "\n\n",+ "`", "``", "```"]+ let randomNL = T.replicate <$> choose (0, 3) <*> pure "\n"+ concat <$> mapM (\x -> do nl <- randomNL; return [x, nl]) ls