blob: b7cfa4b41d3699283766b5a495df5e8357406b74 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
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
|
