Implement low-level commit graph loading
This commit is contained in:
parent
40b4f4e475
commit
0c8d5c973c
1 changed files with 64 additions and 0 deletions
64
src/Data/Git/Local.hs
Normal file
64
src/Data/Git/Local.hs
Normal file
|
@ -0,0 +1,64 @@
|
|||
{- This file is part of Vervis.
|
||||
-
|
||||
- Written in 2016 by fr33domlover <fr33domlover@riseup.net>.
|
||||
-
|
||||
- ♡ Copying is an act of love. Please copy, reuse and share.
|
||||
-
|
||||
- The author(s) have dedicated all copyright and related and neighboring
|
||||
- rights to this software to the public domain worldwide. This software is
|
||||
- distributed without any warranty.
|
||||
-
|
||||
- You should have received a copy of the CC0 Public Domain Dedication along
|
||||
- with this software. If not, see
|
||||
- <http://creativecommons.org/publicdomain/zero/1.0/>.
|
||||
-}
|
||||
|
||||
-- | Git repo tools using the @hit@ package.
|
||||
module Data.Git.Local
|
||||
(
|
||||
)
|
||||
where
|
||||
|
||||
import Prelude
|
||||
|
||||
import Control.Monad.IO.Class
|
||||
import Data.Foldable (foldlM)
|
||||
import Data.Git.Ref (Ref)
|
||||
import Data.Git.Repository (getCommit)
|
||||
import Data.Git.Storage (Git)
|
||||
import Data.Git.Types (Commit (..))
|
||||
|
||||
-- | Load the entire graph of commits which are ancestors of the given ref
|
||||
-- (and that ref itself). Fold the commit structure into a value of type @a@
|
||||
-- inside monad @m@.
|
||||
--
|
||||
-- This is a low-level function which operates on a commit tree, i.e. the same
|
||||
-- ref may be visited more than once (if it has more than one child commit).
|
||||
-- You can use the provided flexibility to implement graph algorithms over the
|
||||
-- commits, or build a graph using some graph library and use that library's
|
||||
-- tools for further processing.
|
||||
loadCommits
|
||||
:: MonadIO m
|
||||
=> Git
|
||||
-- ^ Open git repository context
|
||||
-> ((Ref, Commit) -> (Ref, Commit) -> a -> m a)
|
||||
-- ^ Given a child commit, one of its parent commits and an @a@ value,
|
||||
-- generate an updated @a@ value
|
||||
-> a
|
||||
-- ^ Initial value
|
||||
-> Ref
|
||||
-- ^ Hash of the commit whose ancestor graph should be loaded
|
||||
-> m a
|
||||
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
|
Loading…
Reference in a new issue