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
87
88
89
90
91
92
93
|
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Issue
( Issue (..),
Provenance (..),
id,
internalTags,
replaceText,
)
where
import CMark qualified as D
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 Render qualified as P
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)
-- TODO Resolve Binary D.Node instance
--
-- @related reduce-cached-data-size
instance Binary D.Node where
put = put . T.pack . show . P.render
get = D.commonmarkToNode [] <$> get
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
|
