From c314330e14fd658c75210a4e773bf9849847ff7d Mon Sep 17 00:00:00 2001
From: Timothy Clem <timothy.clem@gmail.com>
Date: Tue, 11 Jul 2017 09:37:24 -0700
Subject: [PATCH] Handle === style markdown headings

---
 src/Data/Syntax/Markup.hs                | 2 +-
 src/Language/Markdown/Syntax.hs          | 2 +-
 src/Renderer/TOC.hs                      | 9 +++++----
 test/TOCSpec.hs                          | 2 +-
 test/fixtures/toc/markdown/headings.B.md | 5 +++++
 5 files changed, 13 insertions(+), 7 deletions(-)

diff --git a/src/Data/Syntax/Markup.hs b/src/Data/Syntax/Markup.hs
index 80fad22e3..458551cf0 100644
--- a/src/Data/Syntax/Markup.hs
+++ b/src/Data/Syntax/Markup.hs
@@ -23,7 +23,7 @@ newtype Paragraph a = Paragraph [a]
 instance Eq1 Paragraph where liftEq = genericLiftEq
 instance Show1 Paragraph where liftShowsPrec = genericLiftShowsPrec
 
-data Section a = Section { sectionHeading :: a, sectionContent :: [a] }
+data Section a = Section { sectionLevel :: Int, sectionHeading :: a, sectionContent :: [a] }
   deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 Section where liftEq = genericLiftEq
diff --git a/src/Language/Markdown/Syntax.hs b/src/Language/Markdown/Syntax.hs
index e4d788691..852b6fed3 100644
--- a/src/Language/Markdown/Syntax.hs
+++ b/src/Language/Markdown/Syntax.hs
@@ -70,7 +70,7 @@ item :: Assignment
 item = makeTerm <$> symbol Item <*> children (many blockElement)
 
 section :: Assignment
-section = makeTerm <$> symbol Heading <*> (heading >>= \ headingTerm -> Markup.Section headingTerm <$> while (((<) `on` level) headingTerm) blockElement)
+section = makeTerm <$> symbol Heading <*> (heading >>= \ headingTerm -> Markup.Section (level headingTerm) headingTerm <$> while (((<) `on` level) headingTerm) blockElement)
   where heading = makeTerm <$> symbol Heading <*> (project (\ ((CMark.HEADING level :. _) :< _) -> Markup.Heading level) <*> children (many inlineElement))
         level term = case term of
           _ | Just section <- prj (unwrap term) -> level (Markup.sectionHeading section)
diff --git a/src/Renderer/TOC.hs b/src/Renderer/TOC.hs
index c2ae4dbd4..f80bb1b78 100644
--- a/src/Renderer/TOC.hs
+++ b/src/Renderer/TOC.hs
@@ -80,7 +80,7 @@ isValidSummary _ = True
 data Declaration
   = MethodDeclaration   { declarationIdentifier :: Text }
   | FunctionDeclaration { declarationIdentifier :: Text }
-  | SectionDeclaration  { declarationIdentifier :: Text }
+  | SectionDeclaration  { declarationIdentifier :: Text, declarationLevel :: Int }
   | ErrorDeclaration    { declarationIdentifier :: Text }
   deriving (Eq, Generic, NFData, Show)
 
@@ -123,10 +123,11 @@ markupSectionAlgebra :: (Markup.Section :< fs, Syntax.Error error :< fs, HasFiel
                      -> Source
                      -> RAlgebra (TermF (Union fs) (Record fields)) (Term (Union fs) (Record fields)) (Maybe Declaration)
 markupSectionAlgebra proxy source r
-  | Just (Markup.Section (heading, _) _) <- prj (tailF r) = Just $ SectionDeclaration (maybe (getSource heading) (toText . flip Source.slice source . sconcat) (nonEmpty (byteRange . extract <$> toList (unwrap heading))))
+  | Just (Markup.Section level (heading, _) _) <- prj (tailF r) = Just $ SectionDeclaration (maybe (getSource heading) (firstLine . toText . flip Source.slice source . sconcat) (nonEmpty (byteRange . extract <$> toList (unwrap heading)))) level
   | Just (Syntax.Error err) <- prj (tailF r) = Just $ ErrorDeclaration (show (err `asProxyTypeOf` proxy))
   | otherwise = Nothing
-  where getSource = toText . flip Source.slice source . byteRange . extract
+  where getSource = firstLine . toText . flip Source.slice source . byteRange . extract
+        firstLine = T.takeWhile (/= '\n')
 
 
 -- | An entry in a table of contents.
@@ -214,7 +215,7 @@ toCategoryName :: Declaration -> Text
 toCategoryName declaration = case declaration of
   FunctionDeclaration _ -> "Function"
   MethodDeclaration _ -> "Method"
-  SectionDeclaration x -> "Heading " <> show (T.length (T.takeWhile (== '#') x))
+  SectionDeclaration _ l -> "Heading " <> show l
   ErrorDeclaration _ -> "ParseError"
 
 instance Listable Declaration where
diff --git a/test/TOCSpec.hs b/test/TOCSpec.hs
index af3f9ef62..caecace4d 100644
--- a/test/TOCSpec.hs
+++ b/test/TOCSpec.hs
@@ -152,7 +152,7 @@ spec = parallel $ do
     it "summarizes Markdown headings" $ do
       blobs <- blobsForPaths (both "markdown/headings.A.md" "markdown/headings.B.md")
       output <- runTask (diffBlobPair ToCDiffRenderer blobs)
-      toS output `shouldBe` ("{\"changes\":{\"test/fixtures/toc/markdown/headings.A.md -> test/fixtures/toc/markdown/headings.B.md\":[{\"span\":{\"start\":[5,1],\"end\":[5,7]},\"category\":\"Heading 2\",\"term\":\"## Two\",\"changeType\":\"added\"}]},\"errors\":{}}\n" :: ByteString)
+      toS output `shouldBe` ("{\"changes\":{\"test/fixtures/toc/markdown/headings.A.md -> test/fixtures/toc/markdown/headings.B.md\":[{\"span\":{\"start\":[5,1],\"end\":[5,7]},\"category\":\"Heading 2\",\"term\":\"## Two\",\"changeType\":\"added\"},{\"span\":{\"start\":[9,1],\"end\":[10,4]},\"category\":\"Heading 1\",\"term\":\"Final\",\"changeType\":\"added\"}]},\"errors\":{}}\n" :: ByteString)
 
 
 type Diff' = SyntaxDiff Text (Maybe Declaration ': DefaultFields)
diff --git a/test/fixtures/toc/markdown/headings.B.md b/test/fixtures/toc/markdown/headings.B.md
index 5e657695c..2fec8a7c0 100644
--- a/test/fixtures/toc/markdown/headings.B.md
+++ b/test/fixtures/toc/markdown/headings.B.md
@@ -3,3 +3,8 @@
 Just some text
 
 ## Two
+
+more text
+
+Final
+===