aboutsummaryrefslogtreecommitdiffstats
path: root/app/Issue.hs
blob: 0d9f6ad3c61f12e4d64743e954162c3b4eec043d (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
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DisambiguateRecordFields #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-}

module Issue (Issue (..), fromMatch) where

import Data.List (find)
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import Data.Text qualified as T
import Issue.Tag (Tag)
import Issue.Tag qualified as I
import TreeGrepper.FileType qualified as G
import TreeGrepper.Match (Match (..))
import TreeGrepper.Match qualified as G
import TreeGrepper.Result (Result (..))
import TreeGrepper.Result qualified as G

data Issue = Issue
  { title :: Text,
    description :: Text,
    start :: G.Position,
    end :: G.Position,
    tags :: [Tag]
  }

fromMatch :: G.Result -> G.Match -> Maybe Issue
fromMatch result match =
  if T.isPrefixOf marker (T.unlines (take 1 lns))
    then
      Just
        Issue
          { title = stripMarker (T.strip (T.unlines title)),
            description = stripTags (T.strip (T.unlines description)),
            start = match.start,
            end = match.end,
            tags = I.extract text
          }
    else Nothing
  where
    text = stripComments result.file_type (T.strip match.text)
    lns = T.lines text
    title = takeWhile (not . isEmpty) lns
    description = drop (length title + 1) lns
    isEmpty = T.null . T.strip

marker :: Text
marker = "TODO"

stripTags :: Text -> Text
stripTags text =
  T.strip (T.unlines (filter (not . T.isPrefixOf "@") (T.lines text)))

stripMarker :: Text -> Text
stripMarker text = maybe text T.stripStart (T.stripPrefix marker text)

stripComments :: G.FileType -> Text -> Text
stripComments fileType text =
  maybe
    (stripLineComments (G.info fileType).lineStart text)
    ( \(blockInfo, blockStart) ->
        stripBlockComment blockStart blockInfo.blockEnd text
    )
    $ do
      blockInfo <- (G.info fileType).block
      (,) blockInfo <$> find (`T.isPrefixOf` text) blockInfo.blockStart

stripLineComments :: Text -> Text -> Text
stripLineComments lineStart text =
  onLines
    ( \line ->
        fromMaybe line . fmap T.stripStart $
          T.stripPrefix lineStart line
    )
    text
  where
    onLines f = T.unlines . map f . T.lines

stripBlockComment :: Text -> Text -> Text -> Text
stripBlockComment blockStart blockEnd text =
  T.strip
    . (fromMaybe text . T.stripSuffix blockEnd)
    . (fromMaybe text . T.stripPrefix blockStart)
    $ text