From 23bacb83e6ea67ffdd62be630626ab50ff665abf Mon Sep 17 00:00:00 2001
From: Alexander Foremny <aforemny@posteo.de>
Date: Tue, 5 Dec 2023 10:11:54 +0100
Subject: feat: parse issues as markdown

---
 app/Issue/Parser.hs | 61 +++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 61 insertions(+)
 create mode 100644 app/Issue/Parser.hs

(limited to 'app/Issue/Parser.hs')

diff --git a/app/Issue/Parser.hs b/app/Issue/Parser.hs
new file mode 100644
index 0000000..b7cfa4b
--- /dev/null
+++ b/app/Issue/Parser.hs
@@ -0,0 +1,61 @@
+module Issue.Parser
+  ( ParseResult (..),
+    parse,
+  )
+where
+
+import CMark qualified as D
+import Control.Exception (throw)
+import Control.Monad (liftM2)
+import Data.Text qualified as T
+import Data.Void (Void)
+import Exception qualified as E
+import Text.Megaparsec qualified as P
+
+data ParseResult = ParseResult
+  { heading :: D.Node,
+    paragraphs :: [D.Node],
+    tags :: [D.Node],
+    comments :: [[D.Node]]
+  }
+  deriving (Show)
+
+parse :: [T.Text] -> D.Node -> Maybe ParseResult
+parse markers (D.Node _ D.DOCUMENT ns) =
+  either (throw . E.InvalidIssue) id $
+    P.parse (parser markers) "" ns
+parse _ _ = error "parse: input is no markdown document"
+
+parser :: [T.Text] -> P.Parsec Void [D.Node] (Maybe ParseResult)
+parser markers =
+  P.optional (P.satisfy (isMarkerNode markers)) >>= \case
+    Just heading ->
+      Just
+        <$> ( ParseResult heading
+                <$> P.takeWhileP
+                  Nothing
+                  (not . liftM2 (||) isCommentNode isTagNode)
+                <*> P.takeWhileP Nothing isTagNode
+                <*> P.many
+                  ( (:)
+                      <$> P.satisfy isCommentNode
+                      <*> P.takeWhileP Nothing (not . isCommentNode)
+                  )
+                <* P.eof
+            )
+    Nothing -> pure Nothing
+
+isCommentNode :: D.Node -> Bool
+isCommentNode (D.Node _ D.PARAGRAPH (D.Node _ (D.TEXT s) _ : _)) =
+  "COMMENT" `T.isPrefixOf` s
+isCommentNode _ = False
+
+isTagNode :: D.Node -> Bool
+isTagNode (D.Node _ D.PARAGRAPH (D.Node _ (D.TEXT s) _ : _)) =
+  "@" `T.isPrefixOf` s
+isTagNode _ = False
+
+isMarkerNode :: [T.Text] -> D.Node -> Bool
+isMarkerNode markers (D.Node _ D.PARAGRAPH (D.Node _ (D.TEXT s) _ : _)) =
+  any (`T.isPrefixOf` s) markers
+isMarkerNode _ _ = False
-- 
cgit v1.2.3