Make it possible to skip subtrees in the commit loading loop
This commit is contained in:
parent
0c8d5c973c
commit
4882ddb092
1 changed files with 18 additions and 12 deletions
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue