mirror of
https://code.sup39.dev/repos/Wqawg
synced 2024-12-28 10:54:54 +09:00
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
|
:: MonadIO m
|
||||||
=> Git
|
=> Git
|
||||||
-- ^ Open git repository context
|
-- ^ 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,
|
-- ^ 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
|
-> a
|
||||||
-- ^ Initial value
|
-- ^ Initial value
|
||||||
-> Ref
|
-> Ref
|
||||||
|
@ -52,13 +56,15 @@ loadCommits
|
||||||
loadCommits git func val ref = readCommit ref >>= go val ref
|
loadCommits git func val ref = readCommit ref >>= go val ref
|
||||||
where
|
where
|
||||||
readCommit = liftIO . getCommit git
|
readCommit = liftIO . getCommit git
|
||||||
readRefCommit r = do
|
--readRefCommit r = do
|
||||||
c <- readCommit r
|
-- c <- readCommit r
|
||||||
return (r, c)
|
-- return (r, c)
|
||||||
step p1 v p2@(r, c) = do
|
step p v r = do
|
||||||
v' <- func p1 p2 v
|
(v', mc) <- func p r v
|
||||||
go v' r c
|
case mc of
|
||||||
go v r c = do
|
Nothing -> return v'
|
||||||
let rs = commitParents c
|
Just c -> go v' r c
|
||||||
ps <- mapM readRefCommit rs
|
go v r c = foldlM (step (r, c)) v $ commitParents c
|
||||||
foldlM (step (r, c)) v ps
|
--let rs = commitParents c
|
||||||
|
--ps <- mapM readRefCommit rs
|
||||||
|
--foldlM (step (r, c)) v rs
|
||||||
|
|
Loading…
Reference in a new issue