aboutsummaryrefslogtreecommitdiffstats
path: root/app/Issue.hs
blob: 124b0d73aece990058c0cc958d3f918212966db4 (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
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