aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--anissue.cabal1
-rw-r--r--app/Comment.hs28
-rw-r--r--app/Git.hs20
-rw-r--r--app/History.hs20
-rw-r--r--app/Issue.hs55
-rw-r--r--app/Issue/Render.hs12
-rw-r--r--app/IssueEvent.hs7
-rw-r--r--app/Main.hs2
8 files changed, 102 insertions, 43 deletions
diff --git a/anissue.cabal b/anissue.cabal
index 5ebda20..74c1478 100644
--- a/anissue.cabal
+++ b/anissue.cabal
@@ -119,6 +119,7 @@ executable anissue
prettyprinter,
prettyprinter-ansi-terminal,
regex,
+ SHA,
temporary,
terminal-size,
text,
diff --git a/app/Comment.hs b/app/Comment.hs
index 5d1c1ef..c834509 100644
--- a/app/Comment.hs
+++ b/app/Comment.hs
@@ -15,13 +15,13 @@ import Control.Exception (catch)
import Control.Monad
import Data.Binary (Binary)
import Data.ByteString qualified as B
+import Data.ByteString.Lazy qualified as LB
import Data.List (find, sortBy)
import Data.List.NonEmpty qualified as N
import Data.Maybe (fromMaybe)
import Data.Ord (comparing)
import Data.Text qualified as T
import Data.Text.Encoding qualified as T
-import Data.Text.Lazy qualified as LT
import Exception qualified as E
import Foreign.C.String
import Foreign.Marshal.Alloc (malloc)
@@ -29,6 +29,7 @@ import Foreign.Marshal.Array (mallocArray, peekArray)
import Foreign.Ptr (nullPtr)
import Foreign.Storable
import GHC.Generics (Generic)
+import GHC.Int (Int64)
import Git qualified
import System.FilePath (takeExtension)
import TreeSitter.Node qualified as S
@@ -38,8 +39,8 @@ import TreeSitter.Tree qualified as S
data Comment = Comment
{ text :: T.Text,
language :: Language,
- start :: Int,
- end :: Int,
+ startByte :: Int64,
+ endByte :: Int64,
startPoint :: Point,
endPoint :: Point,
filePath :: FilePath
@@ -55,10 +56,9 @@ data Point = Point
getComments :: Git.CommitHash -> FilePath -> IO [Comment]
getComments commitHash filePath =
fmap mergeLineComments
- . extractComments filePath language
- . (T.encodeUtf8 . LT.toStrict)
+ . (extractComments filePath language . LB.toStrict)
=<< catch
- (Git.readTextFileOf commitHash filePath)
+ (Git.readTextFileOfBS commitHash filePath)
(\(_ :: E.CannotReadFile) -> pure "")
where
language = fromExtension (takeExtension filePath)
@@ -67,14 +67,14 @@ getComments commitHash filePath =
mergeLineComments =
map mergeGroup
. chainsBy (\a b -> a.endPoint.row + 1 == b.startPoint.row)
- . sortBy (comparing (liftA2 (,) (.start) (.end)))
+ . sortBy (comparing (liftA2 (,) (.startByte) (.endByte)))
mergeGroup :: N.NonEmpty Comment -> Comment
mergeGroup css@(c N.:| cs) =
c
{ text = T.unlines (map (.text) (c : cs)),
- start = first.start,
- end = last.end,
+ startByte = first.startByte,
+ endByte = last.endByte,
startPoint = first.startPoint,
endPoint = last.endPoint
}
@@ -100,9 +100,13 @@ extractComments filePath language str' = do
S.withRootNode tree $ \node -> do
map
( \n' ->
- let start = fromIntegral $ S.nodeStartByte n'
- end = fromIntegral $ S.nodeEndByte n'
- text = T.decodeUtf8 . B.take (end - start) . B.drop start $ str'
+ let startByte = fromIntegral $ S.nodeStartByte n'
+ endByte = fromIntegral $ S.nodeEndByte n'
+ text =
+ T.decodeUtf8
+ . B.take (fromIntegral endByte - fromIntegral startByte)
+ . B.drop (fromIntegral startByte)
+ $ str'
startPoint = fromTSPoint (S.nodeStartPoint n')
endPoint = fromTSPoint (S.nodeEndPoint n')
diff --git a/app/Git.hs b/app/Git.hs
index be95f61..6431259 100644
--- a/app/Git.hs
+++ b/app/Git.hs
@@ -6,7 +6,8 @@ module Git
Commit (..),
Author (..),
getCommitOf,
- readTextFileOf,
+ readTextFileOfText,
+ readTextFileOfBS,
)
where
@@ -28,7 +29,6 @@ import GHC.Generics (Generic)
import Git.CommitHash
import Process (proc, sh)
import Text.Printf (printf)
-import Prelude hiding (lines)
getCommitHashes :: IO (NonEmpty T.Text)
getCommitHashes = fromMaybe (throw E.NoCommits) . N.nonEmpty . reverse . T.lines . T.decodeUtf8 . LB.toStrict <$> sh "git log --format=%H"
@@ -87,12 +87,18 @@ getCommitOf commitHash@(Commit hash) = do
}
_ -> throwIO E.NoCommits
-readTextFileOf :: CommitHash -> FilePath -> IO LT.Text
-readTextFileOf WorkingTree filePath =
+readTextFileOfText :: CommitHash -> FilePath -> IO LT.Text
+readTextFileOfText = readTextFileOf LT.readFile LT.decodeUtf8
+
+readTextFileOfBS :: CommitHash -> FilePath -> IO LB.ByteString
+readTextFileOfBS = readTextFileOf LB.readFile (\x->x)
+
+readTextFileOf :: (FilePath -> IO a) -> (LB.ByteString -> a) -> CommitHash -> FilePath -> IO a
+readTextFileOf readFile _ WorkingTree filePath =
catch
- (LT.readFile filePath)
+ (readFile filePath)
(\(_ :: IOException) -> throwIO (E.CannotReadFile filePath))
-readTextFileOf (Commit hash) filePath =
+readTextFileOf _ decode (Commit hash) filePath =
catch
- (LT.decodeUtf8 <$> sh (proc "git show %:%" hash filePath))
+ (decode <$> sh (proc "git show %:%" hash filePath))
(\(_ :: E.ProcessException) -> throwIO (E.CannotReadFile (printf "%s:%s" hash filePath)))
diff --git a/app/History.hs b/app/History.hs
index 31651bd..0e498b7 100644
--- a/app/History.hs
+++ b/app/History.hs
@@ -12,12 +12,14 @@ import Control.Arrow (first)
import Control.Exception (catch, handle, try)
import Data.Binary (Binary)
import Data.ByteString.Lazy qualified as LB
+import Data.Digest.Pure.SHA qualified as S
import Data.Function (on)
-import Data.List.NonEmpty qualified as N
import Data.Map qualified as M
import Data.Maybe (catMaybes)
import Data.Text qualified as T
import Data.Text.Encoding qualified as T
+import Data.Text.Lazy qualified as LT
+import Data.Text.Lazy.Encoding qualified as LT
import Die (die)
import Exception qualified as E
import GHC.Generics (Generic)
@@ -123,17 +125,19 @@ fromComment commitHash comment = do
let (markers, title) =
I.stripIssueMarkers (T.pack (show (P.render parseResult.heading)))
in I.Issue
- { title = title,
- description = N.nonEmpty parseResult.paragraphs,
+ { commitHash = commitHash,
+ language = comment.language,
+ rawTextHash = S.sha1 (LT.encodeUtf8 (LT.fromStrict rawText)),
+ title = title,
file = comment.filePath,
provenance = provenance,
+ startByte = comment.startByte,
+ endByte = comment.endByte,
startPoint = comment.startPoint,
endPoint = comment.endPoint,
tags = I.extractTags parseResult.tags,
markers = markers,
- rawText = rawText,
commentStyle = commentStyle,
- comments = N.nonEmpty parseResult.comments,
closed = False
}
)
@@ -159,7 +163,7 @@ propagateIssues oldIssues scramble =
I.Provenance
{ first = old.provenance.first,
last =
- if ((/=) `on` (.rawText)) old new
+ if ((/=) `on` (.rawTextHash)) old new
then new.provenance.last
else old.provenance.last
},
@@ -190,7 +194,7 @@ newIssueEvents oldIssues' commitHash issues' =
],
[ IssueChanged commitHash oldIssue newIssue
| (newIssue, oldIssue) <- M.elems (M.intersectionWith (,) issues oldIssues),
- newIssue `neq` oldIssue
+ ((/=) `on` (.rawTextHash)) newIssue oldIssue
],
[ IssueDeleted commitHash issue {I.closed = True}
| issue <- M.elems (oldIssues `M.difference` issues)
@@ -200,8 +204,6 @@ newIssueEvents oldIssues' commitHash issues' =
issues = M.filter (not . (.closed)) issues'
oldIssues = M.filter (not . (.closed)) oldIssues'
- neq = (/=) `on` (.rawText)
-
unsafeAssume :: CommitHash -> Scramble -> History
unsafeAssume commitHash scramble =
History
diff --git a/app/Issue.hs b/app/Issue.hs
index 124b0d7..27f6801 100644
--- a/app/Issue.hs
+++ b/app/Issue.hs
@@ -12,34 +12,67 @@ where
import CMark qualified as D
import CMark.Extra ()
import Comment qualified as G
+import Comment.Language qualified as G
import Data.Binary (Binary (..))
+import Data.ByteString.Lazy qualified as LB
+import Data.Digest.Pure.SHA qualified as S
import Data.List.NonEmpty (NonEmpty)
+import Data.List.NonEmpty qualified as N
import Data.Text qualified as T
+import Data.Text.Encoding qualified as T
import Data.Text.IO qualified as T
import Data.Time.Clock (UTCTime (utctDay))
import GHC.Generics (Generic)
+import GHC.Int (Int64)
import GHC.Records (HasField (..))
import Git (Author (..), Commit (..))
+import Git qualified as Git
+import Issue.Parser qualified as I
import Issue.Provenance (Provenance (..))
import Issue.Tag (Tag (..))
+import Issue.Text qualified as I
import Prelude hiding (id)
data Issue = Issue
- { title :: T.Text,
- description :: Maybe (NonEmpty D.Node),
- file :: String,
+ { commitHash :: Git.CommitHash,
+ language :: G.Language,
+ rawTextHash :: S.Digest S.SHA1State,
+ title :: T.Text,
+ file :: FilePath,
provenance :: Provenance,
+ startByte :: Int64,
+ endByte :: Int64,
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)
+instance HasField "description" Issue (IO (Maybe (NonEmpty D.Node))) where
+ getField issue = do
+ rawText <- issue.rawText
+ let node = D.commonmarkToNode [] rawText
+ case I.parse I.issueMarkers node of
+ Just parseResult -> pure (N.nonEmpty parseResult.paragraphs)
+ Nothing -> pure Nothing
+
+instance HasField "rawText" Issue (IO T.Text) where
+ getField issue = do
+ text <- getText issue
+ let (_, rawText) = G.uncomment issue.language text
+ pure rawText
+
+instance HasField "comments" Issue (IO (Maybe (NonEmpty [D.Node]))) where
+ getField issue = do
+ rawText <- issue.rawText
+ let node = D.commonmarkToNode [] rawText
+ case I.parse I.issueMarkers node of
+ Just parseResult -> pure (N.nonEmpty parseResult.comments)
+ Nothing -> pure Nothing
+
id :: Issue -> T.Text
id issue = toSpinalCase issue.title
where
@@ -51,7 +84,9 @@ internalTags issue@(Issue {..}) =
concat
[ [ Tag "id" $ Just issue.id,
Tag "title" $ Just title,
- Tag "rawText" $ Just rawText,
+ -- TODO Remove @rawText internal tag
+ --
+ -- 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,
@@ -67,8 +102,14 @@ instance HasField "internalTags" Issue [Tag] where
instance HasField "id" Issue T.Text where
getField issue = id issue
+getText :: Issue -> IO T.Text
+getText (Issue {..}) =
+ T.decodeUtf8 . LB.toStrict . LB.take (endByte - startByte) . LB.drop startByte
+ <$> Git.readTextFileOfBS commitHash file
+
replaceText :: Issue -> T.Text -> IO ()
-replaceText issue s' = T.writeFile issue.file . replace (indent (comment s')) =<< T.readFile issue.file
+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
diff --git a/app/Issue/Render.hs b/app/Issue/Render.hs
index c8a913b..aca8134 100644
--- a/app/Issue/Render.hs
+++ b/app/Issue/Render.hs
@@ -42,8 +42,10 @@ newtype IssueDescription = IssueDescription {unIssueDescription :: Issue}
instance P.Render IssueDescription where
render (IssueDescription issue) =
- maybe P.emptyDoc (P.render . N.toList) $
- issue.description
+ P.render
+ ( maybe P.emptyDoc (P.render . N.toList)
+ <$> issue.description
+ )
instance P.Render (P.Linked Issue) where
render (P.Linked issue)
@@ -71,8 +73,10 @@ newtype IssueComments = IssueComments {unIssueComments :: Issue}
instance P.Render IssueComments where
render (IssueComments issue) =
- maybe P.emptyDoc (P.vsep . map P.render . N.toList) $
- issue.comments
+ P.render
+ ( maybe P.emptyDoc (P.vsep . map P.render . N.toList)
+ <$> issue.comments
+ )
newtype IssueOpenedBy = IssueOpenedBy {unIssueOpenedBy :: Issue}
diff --git a/app/IssueEvent.hs b/app/IssueEvent.hs
index c82dba5..0c641ad 100644
--- a/app/IssueEvent.hs
+++ b/app/IssueEvent.hs
@@ -5,6 +5,7 @@ module IssueEvent
)
where
+import Control.Monad (join)
import Data.Binary (Binary (..))
import Data.Function ((&))
import Data.Text qualified as T
@@ -42,9 +43,9 @@ data IssueEvent
deriving (Show, Generic, Binary)
instance HasField "patch" IssueEvent (IO Patch) where
- getField (IssueCreated {..}) = diff "" issue.rawText
- getField (IssueChanged {..}) = diff oldIssue.rawText issue.rawText
- getField (IssueDeleted {..}) = diff issue.rawText ""
+ getField (IssueCreated {..}) = join $ (diff "" <$> issue.rawText)
+ getField (IssueChanged {..}) = join $ (diff <$> oldIssue.rawText <*> issue.rawText)
+ getField (IssueDeleted {..}) = join $ (flip diff "" <$> issue.rawText)
diff :: T.Text -> T.Text -> IO A.Patch
diff old new = withSystemTempDirectory "diff" $ \tmp -> do
diff --git a/app/Main.hs b/app/Main.hs
index 6ccc29a..603ab2a 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -626,7 +626,7 @@ editIssues issues = withSystemTempDirectory "anissue-edit" (go issues)
where
go :: [Issue] -> FilePath -> IO ()
go issues cwd = do
- mapM_ (\issue -> T.writeFile (fp issue) issue.rawText) issues
+ mapM_ (\issue -> T.writeFile (fp issue) =<< issue.rawText) issues
sh_ (proc "${EDITOR-vi} -- %" (map fp issues))
replaceTexts issues
where
generated by cgit v1.2.3 (git 2.25.1) at 2025-01-23 04:55:04 +0000