aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--app/History.hs2
-rw-r--r--app/History/CommitInfo.hs52
-rw-r--r--app/History/IssueEvent.hs11
-rw-r--r--app/History/PartialCommitInfo.hs10
-rw-r--r--app/Main.hs28
-rw-r--r--app/Parallel.hs7
6 files changed, 75 insertions, 35 deletions
diff --git a/app/History.hs b/app/History.hs
index 6247108..6a4ddbe 100644
--- a/app/History.hs
+++ b/app/History.hs
@@ -31,6 +31,6 @@ getHistory :: IO [(CommitHash, [IssueEvent], [Issue])]
getHistory = do
commitInfos <- fromPartialCommitInfos <$> getPartialCommitInfos
let commitHashes = map (.hash) commitInfos
- issueEventses = map (._2) $ issueEvents commitInfos
issueses = map (.issues) commitInfos
+ issueEventses <- map (._2) <$> issueEvents commitInfos
pure (zip3 commitHashes issueEventses issueses)
diff --git a/app/History/CommitInfo.hs b/app/History/CommitInfo.hs
index 56293b1..ad27d1c 100644
--- a/app/History/CommitInfo.hs
+++ b/app/History/CommitInfo.hs
@@ -7,16 +7,23 @@ module History.CommitInfo
where
import Data.Binary (Binary)
-import Data.Function (on)
+import Data.Function (on, (&))
import Data.List (deleteFirstsBy, find)
import Data.Maybe (isJust)
+import Data.Text.IO qualified as T
+import Data.Text.Lazy qualified as LT
+import Data.Text.Lazy.Encoding qualified as LT
import GHC.Generics (Generic)
import History.CommitHash (CommitHash)
import History.IssueEvent (IssueEvent (..))
import History.PartialCommitInfo (PartialCommitInfo (..))
import Issue (Issue (..))
import Issue.Provenance qualified as I
-import Prelude
+import Parallel (parSequence)
+import Process (sh)
+import System.FilePath ((</>))
+import System.IO.Temp (withSystemTempDirectory)
+import System.Process.Typed (setWorkingDir)
-- TODO Change `CommitInfo` -> `CommitIssuesAll`
data CommitInfo = CommitInfo
@@ -68,30 +75,39 @@ fromPartialCommitInfos (partialCommitInfo : partialCommitInfos) =
-- | We assume that [CommitInfo] is sorted starting with the oldest
-- commits.
-issueEvents :: [CommitInfo] -> [(CommitHash, [IssueEvent])]
-issueEvents xs = zip (map (.hash) xs) (zipWith diffCommitInfos predecessors xs)
+issueEvents :: [CommitInfo] -> IO [(CommitHash, [IssueEvent])]
+issueEvents xs = zip (map (.hash) xs) <$> parSequence (zipWith diffCommitInfos predecessors xs)
where
predecessors = Nothing : map Just xs
-diffCommitInfos :: Maybe CommitInfo -> CommitInfo -> [IssueEvent]
+diffCommitInfos :: Maybe CommitInfo -> CommitInfo -> IO [IssueEvent]
diffCommitInfos maybeOldInfo newInfo =
- concat
- [ [IssueCreated newHash issue | issue <- deleteFirstsBy eq newIssues oldIssues],
- [ IssueChanged newHash (last issues)
- | issues <- intersectBy' eq newIssues oldIssues,
- not (null [(x, y) | x <- issues, y <- issues, ((/=) `on` (.rawText)) x y])
- ],
- [IssueDeleted newHash issue | issue <- deleteFirstsBy eq oldIssues newIssues]
- ]
+ sequence $
+ concat
+ [ [IssueCreated newHash issue <$> patchCreated issue | issue <- deleteFirstsBy eq newIssues oldIssues],
+ [ IssueChanged newHash oldIssue newIssue <$> patchChanged oldIssue newIssue
+ | (newIssue : oldIssue : _) <- intersectBy' eq newIssues oldIssues,
+ neq newIssue oldIssue
+ ],
+ [IssueDeleted newHash issue <$> patchDeleted issue | issue <- deleteFirstsBy eq oldIssues newIssues]
+ ]
where
newHash = newInfo.hash
newIssues = newInfo.issues
- oldIssues =
- case maybeOldInfo of
- Nothing -> []
- Just oldInfo -> oldInfo.issues
+ oldIssues = maybe [] (.issues) maybeOldInfo
+
+ eq = (==) `on` (.id)
+ neq = (/=) `on` (.rawText)
+
+ patchCreated new = diff "" new.rawText
+ patchChanged old new = diff old.rawText new.rawText
+ patchDeleted old = diff old.rawText ""
- eq = (==) `on` id
+ diff old new = withSystemTempDirectory "diff" $ \tmp -> do
+ let cwd = tmp
+ T.writeFile (tmp </> "old") old
+ T.writeFile (tmp </> "new") new
+ LT.toStrict . LT.decodeUtf8 <$> sh ("git diff --no-index -- old new || :" & setWorkingDir cwd)
mergeListsBy :: (a -> a -> Bool) -> (a -> a -> b) -> (a -> b) -> (a -> b) -> [a] -> [a] -> [b]
mergeListsBy eq onBoth onLeft onRight lefts rights =
diff --git a/app/History/IssueEvent.hs b/app/History/IssueEvent.hs
index 88886dd..933b047 100644
--- a/app/History/IssueEvent.hs
+++ b/app/History/IssueEvent.hs
@@ -1,19 +1,24 @@
module History.IssueEvent (IssueEvent (..)) where
+import Data.Text qualified as T
import History.CommitHash (CommitHash)
import Issue (Issue)
data IssueEvent
= IssueCreated
{ hash :: CommitHash,
- issue :: Issue
+ issue :: Issue,
+ patch :: T.Text
}
| IssueChanged
{ hash :: CommitHash,
- issue :: Issue
+ oldIssue :: Issue,
+ issue :: Issue,
+ patch :: T.Text
}
| IssueDeleted
{ hash :: CommitHash,
- issue :: Issue
+ issue :: Issue,
+ patch :: T.Text
}
deriving (Show)
diff --git a/app/History/PartialCommitInfo.hs b/app/History/PartialCommitInfo.hs
index 48b631e..21a890a 100644
--- a/app/History/PartialCommitInfo.hs
+++ b/app/History/PartialCommitInfo.hs
@@ -47,20 +47,18 @@ getPartialCommitInfos = do
getCommitInfoOf :: CommitHash -> IO PartialCommitInfo
getCommitInfoOf WorkingTree = do
- (issuesWorkingTreeChanged, filesChanged) <- getIssuesAndFilesWorkingTreeChanged []
+ (issues, filesChanged) <- getIssuesAndFilesWorkingTreeChanged []
pure $
PartialCommitInfo
{ hash = WorkingTree,
- filesChanged = filesChanged,
- issues = issuesWorkingTreeChanged
+ ..
}
getCommitInfoOf (Commit hash) = cached (hash <> (T.pack ".changed")) $ \_ -> do
- (issuesCommitChanged, filesChanged) <- getIssuesAndFilesCommitChanged hash
+ (issues, filesChanged) <- getIssuesAndFilesCommitChanged hash
pure $
PartialCommitInfo
{ hash = Commit hash,
- filesChanged = filesChanged,
- issues = issuesCommitChanged
+ ..
}
-- | Given the hash of a commit, get all issues in the files which have
diff --git a/app/Main.hs b/app/Main.hs
index 737becc..6f96aa5 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -488,6 +488,8 @@ data Command
closed :: Bool
}
| Log
+ { patch :: Bool
+ }
| Show
{ id :: String,
edit :: Bool
@@ -519,7 +521,8 @@ listCmd =
logCmd :: O.Parser Command
logCmd =
- pure Log
+ Log
+ <$> patchFlag
showCmd :: O.Parser Command
showCmd =
@@ -556,6 +559,14 @@ editFlag =
<> O.help "Edit issue in $EDITOR."
)
+patchFlag :: O.Parser Bool
+patchFlag =
+ O.switch
+ ( O.short 'p'
+ <> O.long "patch"
+ <> O.help "Show patches."
+ )
+
die :: String -> IO a
die s = do
printf "error: %s\n" s
@@ -641,7 +652,7 @@ main = do
)
)
issues
- Options {colorize, noPager, width, command = Log} -> do
+ Options {colorize, noPager, width, command = Log {patch}} -> do
ess' <- map (\(commitHash, issueEvents, _) -> (commitHash, issueEvents)) <$> getHistory
putDoc colorize noPager width . P.vsep $
concatMap
@@ -651,10 +662,15 @@ main = do
( \e ->
let kwd = P.annotate (P.color P.Green) . P.pretty . T.pack
title issue = P.annotate (P.color P.Blue) . P.annotate P.bold $ P.pretty issue.title
- in case e of
- IssueCreated {issue} -> shortHash <+> kwd "created" <+> title issue
- IssueChanged {issue} -> shortHash <+> kwd "changed" <+> title issue
- IssueDeleted {issue} -> shortHash <+> kwd "deleted" <+> title issue
+ in ( case e of
+ IssueCreated {issue} ->
+ shortHash <+> kwd "created" <+> title issue
+ IssueChanged {issue} ->
+ shortHash <+> kwd "changed" <+> title issue
+ IssueDeleted {issue} ->
+ shortHash <+> kwd "deleted" <+> title issue
+ )
+ <+> if patch then P.pretty e.patch else P.emptyDoc
)
es'
)
diff --git a/app/Parallel.hs b/app/Parallel.hs
index 0b57545..1687364 100644
--- a/app/Parallel.hs
+++ b/app/Parallel.hs
@@ -1,4 +1,4 @@
-module Parallel (parMapM) where
+module Parallel (parMapM, parSequence) where
import Control.Concurrent.ParallelIO.Local (parallel, withPool)
import GHC.Conc (getNumProcessors)
@@ -7,3 +7,8 @@ parMapM :: (a -> IO b) -> [a] -> IO [b]
parMapM f xs = do
n <- getNumProcessors
withPool n $ \pool -> parallel pool (map f xs)
+
+parSequence :: [IO a] -> IO [a]
+parSequence xs = do
+ n <- getNumProcessors
+ withPool n $ \pool -> parallel pool xs
generated by cgit v1.2.3 (git 2.25.1) at 2025-01-23 21:39:54 +0000