From 4882ddb0922fc7cc3e896a0728b96acc4397c87a Mon Sep 17 00:00:00 2001
From: fr33domlover <fr33domlover@rel4tion.org>
Date: Mon, 29 Feb 2016 14:25:14 +0000
Subject: [PATCH] Make it possible to skip subtrees in the commit loading loop

---
 src/Data/Git/Local.hs | 30 ++++++++++++++++++------------
 1 file changed, 18 insertions(+), 12 deletions(-)

diff --git a/src/Data/Git/Local.hs b/src/Data/Git/Local.hs
index 67573b1..67f68fc 100644
--- a/src/Data/Git/Local.hs
+++ b/src/Data/Git/Local.hs
@@ -41,9 +41,13 @@ loadCommits
     :: MonadIO m
     => Git
     -- ^ Open git repository context
-    -> ((Ref, Commit) -> (Ref, Commit) -> a -> m a)
+    -> ((Ref, Commit) -> Ref -> a -> m (a, Maybe Commit))
     -- ^ Given a child commit, one of its parent commits and an @a@ value,
-    -- generate an updated @a@ value
+    -- generate an updated @a@ value. The second returned value determines
+    -- whether traversal should proceed to the parent of the parent commit. If
+    -- you return 'Nothing', it won't. If you load the parent commit (e.g. with
+    -- 'getCommit') and return 'Just' it, traversal will proceed to its
+    -- parents.
     -> a
     -- ^ Initial value
     -> Ref
@@ -52,13 +56,15 @@ loadCommits
 loadCommits git func val ref = readCommit ref >>= go val ref
     where
     readCommit = liftIO . getCommit git
-    readRefCommit r = do
-        c <- readCommit r
-        return (r, c)
-    step p1 v p2@(r, c) = do
-        v' <- func p1 p2 v
-        go v' r c
-    go v r c = do
-        let rs = commitParents c
-        ps <- mapM readRefCommit rs
-        foldlM (step (r, c)) v ps
+    --readRefCommit r = do
+    --    c <- readCommit r
+    --    return (r, c)
+    step p v r = do
+        (v', mc) <- func p r v
+        case mc of
+            Nothing -> return v'
+            Just c  -> go v' r c
+    go v r c = foldlM (step (r, c)) v $ commitParents c
+        --let rs = commitParents c
+        --ps <- mapM readRefCommit rs
+        --foldlM (step (r, c)) v rs