Implement low-level commit graph loading

src/Data/Git/Local.hs

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