{-# 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