1
0
Fork 0
mirror of https://code.sup39.dev/repos/Wqawg synced 2024-12-27 18:04:53 +09:00

Make it possible to skip subtrees in the commit loading loop

This commit is contained in:
fr33domlover 2016-02-29 14:25:14 +00:00
parent 0c8d5c973c
commit 4882ddb092

View file

@ -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