aboutsummaryrefslogtreecommitdiffstats
path: root/app/Issue.hs
blob: f8bf0ec31725308a9d4b46e84d56bf831f0dfeb0 (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
module Issue
  ( Issue (..),
    Provenance (..),
    id,
    internalTags,
    replaceText,
  )
where

import Data.Binary (Binary)
import Data.List (find)
import Data.Text qualified as T
import Data.Text.IO qualified as T
import Data.Time.Clock (UTCTime (utctDay))
import GHC.Generics (Generic)
import GHC.Records (HasField (..))
import Issue.Provenance (Author (..), Commit (..), Provenance (..))
import Issue.Tag (Tag (..))
import TreeGrepper.Comment qualified as G
import TreeGrepper.Match qualified as G
import Prelude hiding (id)

data Issue = Issue
  { title :: T.Text,
    description :: Maybe T.Text,
    file :: String,
    provenance :: Provenance,
    start :: G.Position,
    end :: G.Position,
    tags :: [Tag],
    markers :: [T.Text],
    rawText :: T.Text,
    commentStyle :: G.CommentStyle,
    comments :: [T.Text]
  }
  deriving (Show, Binary, Generic, Eq)

id :: Issue -> Maybe String
id issue =
  (\(Tag _ v) -> T.unpack <$> v)
    =<< find (\(Tag k _) -> k == "id") (issue.tags ++ issue.internalTags)

internalTags :: Issue -> [Tag]
internalTags (Issue {..}) =
  concat
    [ [ Tag "id" $ Just $ toSpinalCase title,
        Tag "title" $ Just $ title,
        Tag "createdAt" $ Just $ T.pack $ show $ utctDay provenance.first.date,
        Tag "modifiedAt" $ Just $ T.pack $ show $ utctDay provenance.last.date,
        Tag "author" $ Just $ provenance.first.author.name,
        Tag "editor" $ Just $ provenance.last.author.name
      ],
      map (Tag "type" . Just) markers
    ]

instance HasField "internalTags" Issue [Tag] where
  getField issue = internalTags issue

toSpinalCase :: T.Text -> T.Text
toSpinalCase = T.replace " " "-" . T.filter keep . T.toLower
  where
    keep = (`elem` (concat [[' ', '-'], ['a' .. 'z'], ['0' .. '9']]))

replaceText :: Issue -> T.Text -> IO ()
replaceText issue s' = T.writeFile issue.file . replace (indent (comment s')) =<< T.readFile issue.file
  where
    comment = T.intercalate "\n" . map T.strip . T.lines . G.comment issue.commentStyle
    indent = T.intercalate "\n" . mapButFirst (T.replicate (issue.start.column - 1) " " <>) . T.lines
    replace s t = before <> s <> after
      where
        t' = T.lines t
        before = T.intercalate "\n" (mapLast (T.take (issue.start.column - 1)) (take issue.start.row t'))
        after = T.unlines (mapFirst (T.drop issue.end.column) (drop (issue.end.row - 1) t'))
    mapFirst _ [] = []
    mapFirst f (x : xs) = f x : xs
    mapLast _ [] = []
    mapLast f [x] = [f x]
    mapLast f (x : xs) = x : mapLast f xs
    mapButFirst _ [] = []
    mapButFirst f (x : xs) = x : map f xs