mirror of
https://code.naskya.net/repos/ndqEd
synced 2025-01-11 11:56:46 +09:00
64 lines
2 KiB
Haskell
64 lines
2 KiB
Haskell
{- 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
|