From ea1236f2cf6d3ef4b739b2ca28f47a3bbed42295 Mon Sep 17 00:00:00 2001
From: Alexander Foremny <aforemny@posteo.de>
Date: Tue, 17 Oct 2023 14:14:48 +0200
Subject: refactor history

---
 app/History/PartialCommitInfo.hs | 97 ++++++++++++++++++++++++++++++++++++++++
 1 file changed, 97 insertions(+)
 create mode 100644 app/History/PartialCommitInfo.hs

(limited to 'app/History/PartialCommitInfo.hs')

diff --git a/app/History/PartialCommitInfo.hs b/app/History/PartialCommitInfo.hs
new file mode 100644
index 0000000..fb53fbf
--- /dev/null
+++ b/app/History/PartialCommitInfo.hs
@@ -0,0 +1,97 @@
+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.
+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
+      )
-- 
cgit v1.2.3