aboutsummaryrefslogtreecommitdiffstats
path: root/app/Issue/Text.hs
blob: cb4ae47b3125f26532763d3edd57bcb27d5eff1b (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
62
module Issue.Text
  ( extractText,
    stripIssueMarkers,
    issueMarkers,
    extractComments,
  )
where

import CMark qualified as D
import Control.Arrow (first, second, (***))
import Data.Text (Text)
import Data.Text qualified as T

extractText :: Text -> (Text, Maybe Text)
extractText text = (title, description)
  where
    (title, description') = second T.stripStart $ T.breakOn "\n" text
    description
      | T.null description' = Nothing
      | otherwise = Just description'

issueMarkers :: [T.Text]
issueMarkers =
  [ "TODO",
    "FIXME",
    "QUESTION"
  ]

stripIssueMarkers :: T.Text -> ([T.Text], T.Text)
stripIssueMarkers text =
  case [marker | marker <- issueMarkers, T.isPrefixOf marker text] of
    (marker : _) ->
      first (marker :) . stripIssueMarkers $
        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