diff --git a/src/Data/Git/Local.hs b/src/Data/Git/Local.hs index 67f68fc..49c9f4b 100644 --- a/src/Data/Git/Local.hs +++ b/src/Data/Git/Local.hs @@ -15,18 +15,27 @@ -- | Git repo tools using the @hit@ package. module Data.Git.Local - ( + ( loadCommits + , loadCommitGraphByRef ) where import Prelude import Control.Monad.IO.Class -import Data.Foldable (foldlM) -import Data.Git.Ref (Ref) +import Data.Foldable (foldl', foldlM) +import Data.Git.Ref (Ref, toBinary) import Data.Git.Repository (getCommit) import Data.Git.Storage (Git) import Data.Git.Types (Commit (..)) +import Data.Graph.Inductive.Graph (Graph (mkGraph)) +import Data.Hashable (Hashable (..)) + +import qualified Data.HashMap.Strict as M + +instance Hashable Ref where + hashWithSalt salt = hashWithSalt salt . toBinary + hash = hash . toBinary -- | 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@ @@ -52,10 +61,15 @@ loadCommits -- ^ Initial value -> Ref -- ^ Hash of the commit whose ancestor graph should be loaded + -> Maybe Commit + -- ^ If you already read the commit for the ref passed as the previous + -- parameter, pass the commit here to avoid repeated loading of it. + -- Otherwise, pass 'Nothing' and it will be read from the repo. -> m a -loadCommits git func val ref = readCommit ref >>= go val ref +loadCommits git func val ref mcmt = readCommitMaybe ref mcmt >>= go val ref where readCommit = liftIO . getCommit git + readCommitMaybe r = maybe (readCommit r) return --readRefCommit r = do -- c <- readCommit r -- return (r, c) @@ -68,3 +82,32 @@ loadCommits git func val ref = readCommit ref >>= go val ref --let rs = commitParents c --ps <- mapM readRefCommit rs --foldlM (step (r, c)) v rs + +type NodeLabel = (Ref, Commit) + +type EdgeLabel = () + +type CommitGraph g = g NodeLabel EdgeLabel + +-- | Use 'loadCommits' to build a directed acyclic graph of commits. There is a +-- single root node, which is the ref passed to this function. +loadCommitGraphByRef :: Graph g => Git -> Ref -> IO (CommitGraph g) +loadCommitGraphByRef git ref = do + let rootN = 1 + visit (_rChild, _cChild) rParent v@(nextNode, commits) = + if rParent `M.member` commits + then return (v, Nothing) + else do + cParent <- getCommit git rParent + let commits' = M.insert rParent (cParent, nextNode) commits + return ((nextNode + 1, commits'), Just cParent) + cmt <- getCommit git ref + (_, commits) <- loadCommits git visit (rootN + 1, M.empty) ref (Just cmt) + let commits' = M.insert ref (cmt, rootN) commits + nodeOf r = maybe (error "ref has no node") snd $ M.lookup r commits' + mkNode l r (c, n) = (n, (r, c)) : l + nodes = M.foldlWithKey' mkNode [] commits' + mkEdge n l r = (n, nodeOf r, ()) : l + mkEdges l (c, n) = foldl' (mkEdge n) l $ commitParents c + edges = M.foldl' mkEdges [] commits' + return $ mkGraph nodes edges diff --git a/vervis.cabal b/vervis.cabal index f057cfe..78217e1 100644 --- a/vervis.cabal +++ b/vervis.cabal @@ -102,6 +102,7 @@ library , fgl , file-embed , filepath + , hashable , hit , hjsmin >= 0.1 && < 0.2 , hourglass @@ -119,7 +120,7 @@ library , time , transformers , unordered-containers - , vector + --, vector , wai , wai-extra >= 3.0 && < 3.1 , wai-logger >= 2.2 && < 2.3