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
86
|
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Issue
( Issue (..),
Provenance (..),
id,
internalTags,
replaceText,
)
where
import CMark qualified as D
import CMark.Extra ()
import Comment qualified as G
import Data.Binary (Binary (..))
import Data.List.NonEmpty (NonEmpty)
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 Git (Author (..), Commit (..))
import Issue.Provenance (Provenance (..))
import Issue.Tag (Tag (..))
import Prelude hiding (id)
data Issue = Issue
{ title :: T.Text,
description :: Maybe (NonEmpty D.Node),
file :: String,
provenance :: Provenance,
startPoint :: G.Point,
endPoint :: G.Point,
tags :: [Tag],
markers :: [T.Text],
rawText :: T.Text,
commentStyle :: G.CommentStyle,
comments :: Maybe (NonEmpty [D.Node]),
closed :: Bool
}
deriving (Show, Binary, Generic, Eq)
id :: Issue -> T.Text
id issue = toSpinalCase issue.title
where
toSpinalCase = T.replace " " "-" . T.filter keep . T.toLower
keep = (`elem` (concat [[' ', '-'], ['a' .. 'z'], ['0' .. '9']]))
internalTags :: Issue -> [Tag]
internalTags issue@(Issue {..}) =
concat
[ [ Tag "id" $ Just issue.id,
Tag "title" $ Just title,
Tag "rawText" $ Just rawText,
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,
Tag "state" $ Just $ if closed then "closed" else "open"
],
map (Tag "type" . Just) markers
]
instance HasField "internalTags" Issue [Tag] where
getField issue = internalTags issue
instance HasField "id" Issue T.Text where
getField issue = id issue
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.startPoint.column - 1) " " <>) . T.lines
replace s t = before <> s <> after
where
t' = T.lines t
before = T.intercalate "\n" (mapLast (T.take (issue.startPoint.column - 1)) (take issue.startPoint.row t'))
after = T.unlines (mapFirst (T.drop issue.endPoint.column) (drop (issue.endPoint.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
|
