support comments

4 files changed, 37 insertions, 17 deletions

diff --git a/app/History/PartialCommitInfo.hs b/app/History/PartialCommitInfo.hs
index 7497f38..f973938 100644
--- a/app/History/PartialCommitInfo.hs
+++ b/app/History/PartialCommitInfo.hs
@@ -4,6 +4,7 @@ module History.PartialCommitInfo
   )
 where
 
+import Control.Arrow (second)
 import Control.Exception (catch, handle)
 import Data.Binary (Binary)
 import Data.ByteString.Lazy.Char8 qualified as LB8
@@ -100,14 +101,16 @@ fromComment cwd comment = do
                 tags = maybe [] I.extractTags description,
                 markers = markers,
                 rawText = rawText,
-                commentStyle = commentStyle
+                commentStyle = commentStyle,
+                comments = comments
               }
         else Nothing
     )
   where
     (commentStyle, rawText) = G.uncomment comment.file_type comment.text
-    (title', description) = I.extractText rawText
+    (title', description') = I.extractText rawText
     (markers, title) = I.stripIssueMarkers title'
+    (comments, description) = maybe ([], Nothing) (second Just . I.extractComments) description'
 
 dieOfInvalidTreeGrepperResult :: E.InvalidTreeGrepperResult -> IO a
 dieOfInvalidTreeGrepperResult (E.InvalidTreeGrepperResult e) =
diff --git a/app/Issue.hs b/app/Issue.hs
index 73122ef..f8bf0ec 100644
--- a/app/Issue.hs
+++ b/app/Issue.hs
@@ -30,7 +30,8 @@ data Issue = Issue
     tags :: [Tag],
     markers :: [T.Text],
     rawText :: T.Text,
-    commentStyle :: G.CommentStyle
+    commentStyle :: G.CommentStyle,
+    comments :: [T.Text]
   }
   deriving (Show, Binary, Generic, Eq)
 
diff --git a/app/Issue/Text.hs b/app/Issue/Text.hs
index 4cfc5f7..cb4ae47 100644
--- a/app/Issue/Text.hs
+++ b/app/Issue/Text.hs
@@ -2,10 +2,12 @@ module Issue.Text
   ( extractText,
     stripIssueMarkers,
     issueMarkers,
+    extractComments,
   )
 where
 
-import Control.Arrow (first, second)
+import CMark qualified as D
+import Control.Arrow (first, second, (***))
 import Data.Text (Text)
 import Data.Text qualified as T
 
@@ -32,3 +34,29 @@ stripIssueMarkers text =
         T.stripStart (T.drop (T.length marker) text)
     [] ->
       ([], text)
+
+extractComments :: T.Text -> ([T.Text], T.Text)
+extractComments text = collect (D.commonmarkToNode [] text)
+  where
+    collect :: D.Node -> ([T.Text], T.Text)
+    collect (D.Node _ D.DOCUMENT ns) =
+      (map (toText . reverse) . reverse)
+        *** (toText . reverse)
+        $ collect' ([], []) ns
+    collect _ = error "commonmarkToNode: no document"
+
+    collect' :: ([[D.Node]], [D.Node]) -> [D.Node] -> ([[D.Node]], [D.Node])
+    collect' (as, rs) [] = (as, rs)
+    collect' ([], rs) (n@(D.Node _ D.PARAGRAPH (n' : _)) : ns)
+      | D.Node _ (D.TEXT s) _ <- n',
+        T.isPrefixOf "COMMENT" s =
+          collect' ([[n]], rs) ns
+      | otherwise = collect' ([], n : rs) ns
+    collect' (ass@(a : as), rs) (n@(D.Node _ D.PARAGRAPH (n' : _)) : ns)
+      | D.Node _ (D.TEXT s) _ <- n',
+        T.isPrefixOf "COMMENT" s =
+          collect' (([n] : ass), rs) ns
+      | otherwise = collect' (((n : a) : as), rs) ns
+    collect' (as, rs) (_ : ns) = collect' (as, rs) ns
+
+    toText = D.nodeToCommonmark [] Nothing . D.Node Nothing D.DOCUMENT
diff --git a/app/Main.hs b/app/Main.hs
index f798d33..c163d40 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -295,19 +295,6 @@
 -- allow that). The first marker should have priority in case we have to pick
 -- one.
 
--- TODO Support issue comments
---
--- Currently, comments do not get picked up in issue descriptions; see the
--- issue below.
---
--- I would like to parse comments (much like issues), and associate them with
--- the preceding issue.
---
--- `anissue show` should then show all comments below the current output.
---
--- @priority high
--- @assigned Alexander Foremny
-
 -- TODO Add command for (re)generating the cache
 --
 -- When running `anissue cache generate`, we will only generated the
@@ -667,6 +654,7 @@ main = do
       let s =
             (LT.fromStrict (T.intercalate " " issue.markers) <> " " <> LT.fromStrict issue.title)
               <> maybe "" (("\n\n" <>) . LT.fromStrict) issue.description
+              <> LT.intercalate "\n" (map ((("***\n" :: LT.Text) <>) . LT.fromStrict) issue.comments)
       if edit
         then do
           withSystemTempFile (printf "%s.md" id) $ \fp h -> do