chore: compute patches only when displayed

1 files changed, 34 insertions, 48 deletions

diff --git a/app/History.hs b/app/History.hs
index 57cb53c..31651bd 100644
--- a/app/History.hs
+++ b/app/History.hs
@@ -12,15 +12,12 @@ import Control.Arrow (first)
 import Control.Exception (catch, handle, try)
 import Data.Binary (Binary)
 import Data.ByteString.Lazy qualified as LB
-import Data.Function (on, (&))
+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.IO 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)
@@ -32,13 +29,9 @@ import Issue.Parser qualified as I
 import Issue.Tag qualified as I
 import Issue.Text qualified as I
 import IssueEvent (IssueEvent (..))
-import Parallel (parMapM, parSequence)
-import Patch qualified as A
+import Parallel (parMapM)
 import Process (proc, sh)
 import Render qualified as P
-import System.FilePath ((</>))
-import System.IO.Temp (withSystemTempDirectory)
-import System.Process.Typed (setWorkingDir)
 import Tuple ()
 
 -- TODO Reduce cached data size
@@ -71,11 +64,11 @@ getHistoryOf :: CommitHash -> IO History
 getHistoryOf commitHash = cachedMaybe (C.toText commitHash) do
   maybeParentCommitHash <- getParentCommitHashOf commitHash
   case maybeParentCommitHash of
-    Just parentCommitHash -> do
-      parentHistory <- getHistoryOf parentCommitHash
-      scramble <- getScrambleOf commitHash
-      propagate commitHash parentHistory scramble
-    Nothing -> unsafeAssume commitHash =<< getScrambleOf commitHash
+    Just parentCommitHash ->
+      propagate commitHash
+        <$> (getHistoryOf parentCommitHash)
+        <*> (getScrambleOf commitHash)
+    Nothing -> unsafeAssume commitHash <$> getScrambleOf commitHash
 
 getParentCommitHashOf :: CommitHash -> IO (Maybe CommitHash)
 getParentCommitHashOf commitHash =
@@ -148,11 +141,13 @@ fromComment commitHash comment = do
   where
     (commentStyle, rawText) = G.uncomment comment.language comment.text
 
-propagate :: CommitHash -> History -> Scramble -> IO History
-propagate commitHash oldHistory scramble = do
+propagate :: CommitHash -> History -> Scramble -> History
+propagate commitHash oldHistory scramble =
   let issues = propagateIssues oldHistory.issues scramble
-  issueEvents <- propagateIssueEvents oldHistory.issueEvents oldHistory.issues commitHash issues
-  pure $ History {..}
+   in History
+        { issueEvents = propagateIssueEvents oldHistory.issueEvents oldHistory.issues commitHash issues,
+          ..
+        }
 
 propagateIssues :: M.Map T.Text I.Issue -> Scramble -> M.Map T.Text I.Issue
 propagateIssues oldIssues scramble =
@@ -183,43 +178,34 @@ propagateIssues oldIssues scramble =
     oldIssues
     scramble.issues
 
-propagateIssueEvents :: [IssueEvent] -> M.Map T.Text I.Issue -> CommitHash -> M.Map T.Text I.Issue -> IO [IssueEvent]
+propagateIssueEvents :: [IssueEvent] -> M.Map T.Text I.Issue -> CommitHash -> M.Map T.Text I.Issue -> [IssueEvent]
 propagateIssueEvents oldIssueEvents oldIssues commitHash issues =
-  fmap (oldIssueEvents ++) $ newIssueEvents oldIssues commitHash issues
+  oldIssueEvents ++ newIssueEvents oldIssues commitHash issues
 
-newIssueEvents :: M.Map T.Text I.Issue -> CommitHash -> M.Map T.Text I.Issue -> IO [IssueEvent]
+newIssueEvents :: M.Map T.Text I.Issue -> CommitHash -> M.Map T.Text I.Issue -> [IssueEvent]
 newIssueEvents oldIssues' commitHash issues' =
-  parSequence $
-    concat
-      [ [ IssueCreated commitHash issue <$> patchCreated issue
-          | issue <- M.elems (issues `M.difference` oldIssues)
-        ],
-        [ IssueChanged commitHash oldIssue newIssue <$> patchChanged oldIssue newIssue
-          | (newIssue, oldIssue) <- M.elems (M.intersectionWith (,) issues oldIssues),
-            newIssue `neq` oldIssue
-        ],
-        [ IssueDeleted commitHash issue {I.closed = True} <$> patchDeleted issue
-          | issue <- M.elems (oldIssues `M.difference` issues)
-        ]
+  concat
+    [ [ IssueCreated commitHash issue
+        | issue <- M.elems (issues `M.difference` oldIssues)
+      ],
+      [ IssueChanged commitHash oldIssue newIssue
+        | (newIssue, oldIssue) <- M.elems (M.intersectionWith (,) issues oldIssues),
+          newIssue `neq` oldIssue
+      ],
+      [ IssueDeleted commitHash issue {I.closed = True}
+        | issue <- M.elems (oldIssues `M.difference` issues)
       ]
+    ]
   where
     issues = M.filter (not . (.closed)) issues'
     oldIssues = M.filter (not . (.closed)) oldIssues'
 
-    patchCreated new = diff "" new.rawText
-    patchChanged old new = diff old.rawText new.rawText
-    patchDeleted old = diff old.rawText ""
-
-    diff old new = withSystemTempDirectory "diff" $ \tmp -> do
-      let cwd = tmp
-      T.writeFile (tmp </> "old") old
-      T.writeFile (tmp </> "new") new
-      A.parse . LT.toStrict . LT.decodeUtf8 <$> sh ("git diff --no-index -- old new || :" & setWorkingDir cwd)
-
     neq = (/=) `on` (.rawText)
 
-unsafeAssume :: CommitHash -> Scramble -> IO History
-unsafeAssume commitHash scramble = do
-  let issues = scramble.issues
-  issueEvents <- propagateIssueEvents [] M.empty commitHash issues
-  pure $ History {..}
+unsafeAssume :: CommitHash -> Scramble -> History
+unsafeAssume commitHash scramble =
+  History
+    { issues = scramble.issues,
+      issueEvents = propagateIssueEvents [] M.empty commitHash scramble.issues,
+      ..
+    }