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
94
95
96
97
98
|
module History.PartialCommitInfo
( PartialCommitInfo (..),
getPartialCommitInfos,
)
where
import Control.Exception (catch)
import Data.Binary (Binary)
import Data.ByteString.Lazy.Char8 qualified as LB8
import Data.Function ((&))
import Data.Text qualified as T
import Die (die)
import Exception qualified as E
import GHC.Generics (Generic)
import Git qualified
import History.Cache (cached)
import History.CommitHash (CommitHash (..))
import Issue (Issue, getIssuesPar)
import Process (proc, sh)
import System.Directory (getCurrentDirectory)
import System.FilePath ((</>))
import System.IO.Temp (withSystemTempDirectory)
import System.Process.Typed (setWorkingDir)
-- | `PartialCommitInfo` records the complete issues ONLY in files that have
-- been changed in the commit.
-- TODO Change `PartialCommitInfo` -> `CommitIssuesChanged`
data PartialCommitInfo = PartialCommitInfo
{ hash :: CommitHash,
filesChanged :: [FilePath],
issues :: [Issue]
}
deriving (Show, Binary, Generic)
getPartialCommitInfos :: IO [PartialCommitInfo]
getPartialCommitInfos = do
-- TODO Revise `getCommitHashes`
--
-- - Should throw if no commits.
-- - Should always be reversed?
commitHashes <- reverse <$> Git.getCommitHashes
mapM getCommitInfoOf (map Commit commitHashes ++ [WorkingTree])
getCommitInfoOf :: CommitHash -> IO PartialCommitInfo
getCommitInfoOf WorkingTree = do
(issuesWorkingTreeChanged, filesChanged) <- getIssuesAndFilesWorkingTreeChanged []
pure $
PartialCommitInfo
{ hash = WorkingTree,
filesChanged = filesChanged,
issues = issuesWorkingTreeChanged
}
getCommitInfoOf (Commit hash) = cached (hash <> (T.pack ".changed")) $ \_ -> do
(issuesCommitChanged, 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
-- been changed by this commit, as well as all changed files.
getIssuesAndFilesCommitChanged :: T.Text -> IO ([Issue], [FilePath])
getIssuesAndFilesCommitChanged hash = do
withSystemTempDirectory "history" $ \tmp -> do
let cwd = tmp </> T.unpack hash
Git.withWorkingTree cwd hash do
files <- gitShowChanged cwd
issues <- concat <$> catch (getIssuesPar cwd files) dieOfInvalidTreeGrepperResult
pure (issues, files)
dieOfInvalidTreeGrepperResult :: E.InvalidTreeGrepperResult -> IO a
dieOfInvalidTreeGrepperResult (E.InvalidTreeGrepperResult e) =
die e
-- | Gets issues in all files which have been changed in your current
-- [working
-- - tree](https://git-scm.com/docs/gitglossary#Documentation/gitglossary.txt-aiddefworkingtreeaworkingtree)
getIssuesAndFilesWorkingTreeChanged :: [FilePath] -> IO ([Issue], [FilePath])
getIssuesAndFilesWorkingTreeChanged paths = do
cwd <- getCurrentDirectory
files <- gitLsFilesModifiedIn cwd paths
issues <- concat <$> catch (getIssuesPar cwd files) dieOfInvalidTreeGrepperResult
pure (issues, files)
gitShowChanged :: FilePath -> IO [FilePath]
gitShowChanged cwd =
Prelude.lines . LB8.unpack
<$> sh ("git show -p --name-only --format=''" & setWorkingDir cwd)
gitLsFilesModifiedIn :: FilePath -> [FilePath] -> IO [FilePath]
gitLsFilesModifiedIn cwd paths =
Prelude.lines . LB8.unpack
<$> sh
( proc "git ls-files --modified %" ("--" : paths)
& setWorkingDir cwd
)
|
