diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,14 @@ +# 0.2 + +* Renamed `Annotated` to `WithSource`. + +* Renamed `commonmarkToAnnotatedNodes` to `commonmarkToNodesWithSource`. + +* Renamed `annSource` and `annValue` to `getSource` and `stripSource`. + +* Joined `preface`, `header`, `content` with their annotations (using a + tuple). + # 0.1.0.3 * Bumped hspec and cmark versions. @@ -10,6 +21,6 @@ * Bumped hspec version. -# 0.1.0.0 +# 0.1 First release. diff --git a/cmark-sections.cabal b/cmark-sections.cabal --- a/cmark-sections.cabal +++ b/cmark-sections.cabal @@ -1,5 +1,5 @@ name: cmark-sections -version: 0.1.0.3 +version: 0.2.0.0 synopsis: Represent cmark-parsed Markdown as a tree of sections description: Represent cmark-parsed Markdown as a tree of sections @@ -39,8 +39,8 @@ main-is: Main.hs type: exitcode-stdio-1.0 build-depends: QuickCheck >= 2.8 && < 3 - , base >=4.7 && <5 - , base-prelude == 1.* + , base + , base-prelude , cmark , cmark-sections , containers diff --git a/lib/CMark/Sections.hs b/lib/CMark/Sections.hs --- a/lib/CMark/Sections.hs +++ b/lib/CMark/Sections.hs @@ -1,5 +1,4 @@ {-# LANGUAGE -TemplateHaskell, RecordWildCards, DeriveFunctor, DeriveFoldable, @@ -9,8 +8,9 @@ #-} -{- | -This library lets you parse Markdown into a hierarchical structure (delimited by headings). For instance, let's say your document looks like this: +{- | 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. @@ -38,6 +38,7 @@ @ 'preface': "This is the preface." + 'sections': * 'heading': __"First chapter"__ 'content': "This chapter doesn't have sections." @@ -54,22 +55,26 @@ 'sections': [] @ -That's what this library does. Moreover, it lets you access the Markdown source of every node of the tree. +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'] +'nodesToDocument' . 'commonmarkToNodesWithSource' ['optSafe', 'optNormalize'] @ -You can preprocess parsed Markdown after doing 'commonmarkToAnnotatedNodes' as long as you don't add or remove any top-level nodes. +You can preprocess parsed Markdown after doing 'commonmarkToNodesWithSource' +as long as you don't add or remove any top-level nodes. -} module CMark.Sections ( -- * Parse Markdown to trees - commonmarkToAnnotatedNodes, + commonmarkToNodesWithSource, nodesToDocument, - Annotated(..), + WithSource(..), + getSource, + stripSource, Section(..), Document(..), @@ -97,67 +102,78 @@ 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”. +{- | A data type for annotating things with their source. In this library we +only use @WithSource [Node]@, which stands for “some Markdown nodes + source”. -} -data Annotated a = Ann { - annSource :: Text, - annValue :: a } +data WithSource a = WithSource Text 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) +-- | Extract source from 'WithSource' (it's stored there in a field). +getSource :: WithSource a -> Text +getSource (WithSource src _) = src -{- | -A section in the Markdown tree. Does not contain subsections (the tree is built using 'Tree.Forest' from "Data.Tree"). +-- | Extract data from 'WithSource'. +stripSource :: WithSource a -> a +stripSource (WithSource _ x) = x + +instance Monoid a => Monoid (WithSource a) where + mempty = WithSource "" mempty + WithSource s1 v1 `mappend` WithSource s2 v2 = + WithSource (s1 <> s2) (v1 <> v2) + +{- | A section in the Markdown tree. + +Sections do not contain subsections; i.e. `Section` isn't recursive and the +tree structure is provided by "Data.Tree". + +In a @Section a b@, the heading is coupled with a value of type @a@, and +content – with a value of type @b@. This is occasionally useful. -} data Section a b = Section { -- | Level (from 1 to 6). - level :: Int, - heading :: Annotated [Node], - headingAnn :: a, + level :: Int, + -- | Heading + heading :: (a, WithSource [Node]), -- | Text between the heading and the first subsection. Can be empty. - content :: Annotated [Node], - contentAnn :: b } + content :: (b, WithSource [Node]) + } 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). +{- | The whole parsed Markdown tree. In a @Document a b@, headings are +annotated with @a@ and content blocks – with @b@. -} data Document a b = Document { -- | Text before the first section. Can be empty. - preface :: Annotated [Node], - prefaceAnn :: b, - sections :: Tree.Forest (Section a b) } + preface :: (b, WithSource [Node]), + sections :: Tree.Forest (Section a b) } deriving (Eq, Show) -{- | -'commonmarkToAnnotatedNodes' parses Markdown with the given options and extracts nodes from the initial 'DOCUMENT' node. +{- | 'commonmarkToNodesWithSource' 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 +commonmarkToNodesWithSource :: [CMarkOption] -> Text -> WithSource [Node] +commonmarkToNodesWithSource opts src = WithSource src ns where - Node _ DOCUMENT ns = commonmarkToNode opts s + Node _ DOCUMENT ns = commonmarkToNode opts src {- | Break Markdown into pieces: @ - blah blah blah } - }----> init - blah blah blah } + blah blah blah }---- preface + }---- + blah blah blah }---- - # foo } - } - blah blah }----> (heading, blocks after) + # foo }---- heading } - blah blah } - - ## bar } - }----> (heading, blocks after) - blah blah } + blah blah }---- blocks after + }---- + blah blah }---- - ... + ## bar }---- heading + } + blah blah }---- blocks after + }---- + ... }---- @ -} breakAtHeadings @@ -181,40 +197,39 @@ cut :: Node -- ^ First node to include -> Node -- ^ First node to exclude - -> Text + -> Text -- ^ Source that was parsed -> Text cut a b = T.unlines . take (start b - start a) . drop (start a - 1) . T.lines cutTo - :: Node - -> Text + :: Node -- ^ First node to exclude + -> Text -- ^ Source that was parsed -> Text cutTo b = T.unlines . take (start b - 1) . T.lines cutFrom - :: Node - -> Text + :: Node -- ^ First node to include + -> Text -- ^ Source that was parsed -> Text cutFrom a = T.unlines . drop (start a - 1) . T.lines -{- | -Turn a list of Markdown nodes into a tree. +{- | Turn a list of Markdown nodes into a tree. -} -nodesToDocument :: Annotated [Node] -> Document () () -nodesToDocument (Ann src nodes) = do +nodesToDocument :: WithSource [Node] -> Document () () +nodesToDocument (WithSource 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] + let prefaceAnnotated :: WithSource [Node] prefaceAnnotated = case restNodes of - [] -> Ann src prefaceNodes - (x:_) -> Ann (cutTo (fst x) src) prefaceNodes + [] -> WithSource src prefaceNodes + (x:_) -> WithSource (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])] + let blocks :: [((Int, WithSource [Node]), WithSource [Node])] blocks = do ((heading, afterBlocks), mbNext) <- zip restNodes (tail (map Just restNodes ++ [Nothing])) @@ -227,40 +242,51 @@ ([], _) -> "" (x:_, Just (y, _)) -> cut x y src (x:_, Nothing) -> cutFrom x src - return ((hLevel, Ann hSrc hNodes), - Ann afterBlocksSrc afterBlocks) + return ((hLevel, WithSource hSrc hNodes), + WithSource 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 = (), - .. } + level = level, + heading = ((), heading), + content = ((), content) + } in Tree.Node section (makeTree nested) : makeTree others -- Return the result Document { - preface = prefaceAnnotated, - prefaceAnn = (), - sections = makeTree blocks } + preface = ((), prefaceAnnotated), + sections = makeTree blocks + } {- $monoid-note -Note that you can use ('<>') to combine 'Annotated' nodes together. +Note that you can use ('<>') to combine 'WithSource' nodes together. It will +concatenate sources and parsed Markdown. + +I'm not sure how valid this operation is for Markdown, but probably +more-or-less valid (when you exclude corner cases like missing newlines at +the end and duplicate links). Maybe cmark doesn't even allow duplicate links, +I don't know. -} -flattenDocument :: Document a b -> Annotated [Node] -flattenDocument Document{..} = preface <> flattenForest sections +-- | Turn the whole parsed-and-broken-down 'Document' into a list of nodes. +flattenDocument :: Document a b -> WithSource [Node] +flattenDocument Document{..} = snd preface <> flattenForest sections -flattenSection :: Section a b -> Annotated [Node] +-- | Turn a section into a list of nodes. +flattenSection :: Section a b -> WithSource [Node] flattenSection Section{..} = - Ann (annSource heading <> annSource content) - (headingNode : annValue content) + WithSource (getSource (snd heading) <> getSource (snd content)) + (headingNode : stripSource (snd content)) where - headingNode = Node Nothing (HEADING level) (annValue heading) + headingNode = Node Nothing (HEADING level) (stripSource (snd heading)) -flattenTree :: Tree.Tree (Section a b) -> Annotated [Node] +-- | Turn a "Data.Tree" 'Tree.Tree' into a list of nodes. +flattenTree :: Tree.Tree (Section a b) -> WithSource [Node] flattenTree (Tree.Node r f) = flattenSection r <> flattenForest f -flattenForest :: Tree.Forest (Section a b) -> Annotated [Node] +-- | Turn a "Data.Tree" 'Tree.Forest' into a list of nodes. +flattenForest :: Tree.Forest (Section a b) -> WithSource [Node] flattenForest = mconcat . map flattenSection . concatMap Tree.flatten diff --git a/tests/Main.hs b/tests/Main.hs --- a/tests/Main.hs +++ b/tests/Main.hs @@ -27,71 +27,66 @@ main :: IO () main = hspec $ do let mkSect level heading content ns = - Tree.Node Section{headingAnn = (),contentAnn = (),..} ns + Tree.Node + (Section level ((), heading) ((), content)) + ns describe "converting:" $ do it "empty document" $ do let src = "" - prefaceAnn = () - preface = mempty + preface = ((), mempty) sections = [] - nodesToDocument (commonmarkToAnnotatedNodes [] src) + nodesToDocument (commonmarkToNodesWithSource [] src) `shouldBe` Document{..} it "spaces" $ do let src = " \n\n \n" - prefaceAnn = () - preface = Ann " \n\n \n" [] + preface = ((), WithSource " \n\n \n" []) sections = [] - nodesToDocument (commonmarkToAnnotatedNodes [] src) + nodesToDocument (commonmarkToNodesWithSource [] src) `shouldBe` Document{..} it "paragraph" $ do let src = "x" - prefaceAnn = () - preface = Ann "x" [ - Node (Just (PosInfo 1 1 1 1)) PARAGRAPH [text "x"] ] + preface = ((), WithSource "x" [ + Node (Just (PosInfo 1 1 1 1)) PARAGRAPH [text "x"] ]) sections = [] - nodesToDocument (commonmarkToAnnotatedNodes [] src) + nodesToDocument (commonmarkToNodesWithSource [] 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" [ + preface = ((), WithSource "\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"] ] + Node (Just (PosInfo 7 1 7 1)) PARAGRAPH [text "z"] ]) sections = [] - nodesToDocument (commonmarkToAnnotatedNodes [] src) + nodesToDocument (commonmarkToNodesWithSource [] src) `shouldBe` Document{..} it "headers" $ do let src = T.unlines ["# 1", "", "## 2", "", "## 3"] - prefaceAnn = () - preface = mempty + 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) + mkSect 1 (WithSource "# 1\n\n" [text "1"]) mempty [ + mkSect 2 (WithSource "## 2\n\n" [text "2"]) mempty [], + mkSect 2 (WithSource "## 3\n" [text "3"]) mempty [] ] ] + nodesToDocument (commonmarkToNodesWithSource [] src) `shouldBe` Document{..} it "headers+content" $ do let src = T.unlines ["# 1", "", "## 2", "test", "## 3"] - prefaceAnn = () - preface = mempty + 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) + mkSect 1 (WithSource "# 1\n\n" [text "1"]) mempty [ + mkSect 2 (WithSource "## 2\n" [text "2"]) + (WithSource "test\n" [Node (Just (PosInfo 4 1 4 4)) PARAGRAPH + [text "test"]]) [], + mkSect 2 (WithSource "## 3\n" [text "3"]) mempty [] ] ] + nodesToDocument (commonmarkToNodesWithSource [] src) `shouldBe` Document{..} it "preface+headers" $ do let src = T.unlines ["blah", "# 1", "", "## 2", "", "## 3"] - prefaceAnn = () - preface = commonmarkToAnnotatedNodes [] "blah\n" + preface = ((), commonmarkToNodesWithSource [] "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) + mkSect 1 (WithSource "# 1\n\n" [text "1"]) mempty [ + mkSect 2 (WithSource "## 2\n\n" [text "2"]) mempty [], + mkSect 2 (WithSource "## 3\n" [text "3"]) mempty [] ] ] + nodesToDocument (commonmarkToNodesWithSource [] src) `shouldBe` Document{..} describe "reconstruction:" $ do @@ -110,7 +105,7 @@ modifyMaxSize (*20) $ modifyMaxSuccess (*10) $ prop "QuickCheck" $ forAllShrink mdGen shrinkMD $ \(T.concat -> src) -> - let md1 = commonmarkToAnnotatedNodes [] src + let md1 = commonmarkToNodesWithSource [] src md2 = flattenDocument . nodesToDocument $ md1 err = printf "%s: %s /= %s" (show src) (show md1) (show md2) in counterexample err (compareMD md1 md2) @@ -120,26 +115,26 @@ fromToDoc :: Text -> Expectation fromToDoc src = - flattenDocument (nodesToDocument (commonmarkToAnnotatedNodes [] src)) - `shouldBeMD` commonmarkToAnnotatedNodes [] src + flattenDocument (nodesToDocument (commonmarkToNodesWithSource [] src)) + `shouldBeMD` commonmarkToNodesWithSource [] src -shouldBeMD :: Annotated [Node] -> Annotated [Node] -> Expectation +shouldBeMD :: WithSource [Node] -> WithSource [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 :: WithSource [Node] -> WithSource [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) + map (\(Node _ a b) -> Node Nothing a b) (stripSource x) == + map (\(Node _ a b) -> Node Nothing a b) (stripSource 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)] ] + or [getSource x == getSource y, + and [not (T.isSuffixOf "\n" (getSource x)), + T.isSuffixOf "\n" (getSource y), + getSource x == T.init (getSource y)], + and [not (T.isSuffixOf "\n" (getSource y)), + T.isSuffixOf "\n" (getSource x), + getSource y == T.init (getSource x)] ] -- | Try to shrink Markdown. shrinkMD :: [Text] -> [[Text]]