feat: add -p|--patch to log command

1 files changed, 34 insertions, 18 deletions

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 =