gitlib 2.0.0.0 → 2.0.1.0

raw patch · 7 files changed

+73/−61 lines, 7 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• Git.hs +1/−0
• Git/Blob.hs +5/−6
• Git/Commit.hs +6/−2
• Git/Commit/Push.hs +3/−3
• Git/Object.hs +34/−20
• Git/Types.hs +23/−29
• gitlib.cabal +1/−1

@@ -5,6 +5,7 @@  import Git.Blob as X import Git.Commit as X+import Git.Commit.Push as X import Git.Object as X import Git.Reference as X import Git.Repository as X

@@ -1,5 +1,6 @@ module Git.Blob where +import           Control.Applicative import           Control.Monad import           Control.Monad.Trans.Class import           Data.ByteString as B@@ -24,12 +25,10 @@  blobContentsToByteString :: Repository m => BlobContents m -> m ByteString blobContentsToByteString (BlobString bs) = return bs-blobContentsToByteString (BlobStream bs) = do-    strs <- bs $$ CList.consume-    return (B.concat strs)-blobContentsToByteString (BlobSizedStream bs _) = do-    strs <- bs $$ CList.consume-    return (B.concat strs)+blobContentsToByteString (BlobStream bs) =+    B.concat <$> (bs $$ CList.consume)+blobContentsToByteString (BlobSizedStream bs _) =+    B.concat <$> (bs $$ CList.consume)  blobToByteString :: Repository m => Blob m -> m ByteString blobToByteString (Blob _ contents) = blobContentsToByteString contents

@@ -2,6 +2,8 @@  import           Control.Monad import           Control.Monad.Trans.Class+import           Data.Conduit+import qualified Data.Conduit.List as CL import           Data.Function import           Data.HashSet (HashSet) import qualified Data.HashSet as HashSet@@ -59,8 +61,10 @@             => Maybe (CommitOid m) -- ^ A commit we may already have             -> CommitOid m         -- ^ The commit we need             -> m [CommitOid m]     -- ^ All the objects in between-listCommits have need =-    mapM (\(CommitObjOid c) -> return c) =<< listObjects have need False+listCommits mhave need =+    sourceObjects mhave need False+        $= CL.mapM (\(CommitObjOid c) -> return c)+        $$ CL.consume  traverseCommits :: Repository m => (CommitOid m -> m a) -> CommitOid m -> m [a] traverseCommits f need = mapM f =<< listCommits Nothing need

@@ -19,9 +19,9 @@ --   copy.  This can be extremely slow, but always works no matter which two --   backends are being used.  It should be considered a matter of last --   resort, or for objects sets that are known to be small.-genericPushCommit :: (Repository m, Repository (t m), MonadTrans t)-                  => CommitOid m -> Text -> t m (CommitOid (t m))-genericPushCommit coid remoteRefName = do+pushCommit :: (Repository m, Repository (t m), MonadTrans t)+           => CommitOid m -> Text -> t m (CommitOid (t m))+pushCommit coid remoteRefName = do     mrref <- resolveReference remoteRefName     commits1 <- mapM copyCommitOid =<< lift (listCommits Nothing coid)     fastForward <- case mrref of

@@ -1,12 +1,22 @@ module Git.Object where -import Control.Monad-import Data.Function-import Data.List-import Data.Maybe-import Git.Types-import Prelude hiding (FilePath)+import           Control.Monad+import           Control.Monad.Trans.Class+import           Data.Conduit+import qualified Data.Conduit.List as CL+import           Data.Function+import           Data.Maybe+import           Git.Types+import           Prelude hiding (FilePath) +listObjects :: Repository m+            => Maybe (CommitOid m) -- ^ A commit we may already have+            -> CommitOid m         -- ^ The commit we need+            -> Bool                -- ^ Include commit trees also?+            -> m [ObjectOid m]     -- ^ All the objects in between+listObjects mhave need alsoTrees =+    sourceObjects mhave need alsoTrees $$ CL.consume+ traverseObjects :: Repository m => (ObjectOid m -> m a) -> CommitOid m -> m [a] traverseObjects f need = mapM f =<< listObjects Nothing need False @@ -16,21 +26,25 @@ -- | Given a list of objects (commit and top-level trees) return by --   'listObjects', expand it to include all subtrees and blobs as well. --   Ordering is preserved.-expandTreeObjects :: Repository m => [ObjectOid m] -> m [ObjectOid m]-expandTreeObjects objs =-    fmap concat . forM objs $ \obj -> case obj of-        TreeObjOid toid -> do-            tr <- lookupTree toid-            entries <- listTreeEntries tr-            let subobjss = foldr f [] entries-            return (obj:subobjss)-        _ -> return [obj]+expandTreeObjects :: Repository m => Conduit (ObjectOid m) m (ObjectOid m)+expandTreeObjects = whileJust_ await $ \obj -> case obj of+    TreeObjOid toid -> do+        yield $ TreeObjOid toid+        tr <- lift $ lookupTree toid+        ents <- lift $ listTreeEntries tr+        forM_ ents $ \ent -> case ent of+            (_, BlobEntry oid _) -> yield $ BlobObjOid oid+            (_, TreeEntry oid)   -> yield $ TreeObjOid oid+            _ -> return ()+    _ -> yield obj   where-    f (_, ent) rest = case ent of-        BlobEntry oid _ -> BlobObjOid oid : rest-        TreeEntry oid   -> TreeObjOid oid : rest-        _ -> rest+    whileJust_ p f = do+        x <- p+        case x of+            Nothing -> return ()+            Just x' -> f x' >> whileJust_ p f  listAllObjects :: Repository m                => Maybe (CommitOid m) -> CommitOid m -> m [ObjectOid m]-listAllObjects have need = expandTreeObjects =<< listObjects have need True+listAllObjects mhave need =+    sourceObjects mhave need True $= expandTreeObjects $$ CL.consume

@@ -5,7 +5,6 @@ import           Control.Failure import           Control.Monad import           Control.Monad.IO.Class-import           Control.Monad.Trans.Class import qualified Data.Binary as Bin import           Data.ByteString (ByteString) import qualified Data.ByteString as B@@ -55,16 +54,16 @@     listReferences  :: m [Text]      -- Object lookup-    lookupCommit :: CommitOid m -> m (Commit m)-    lookupTree   :: TreeOid m -> m (Tree m)-    lookupBlob   :: BlobOid m -> m (Blob m)-    lookupTag    :: TagOid m -> m (Tag m)-    lookupObject :: Oid m -> m (Object m)-    existsObject :: Oid m -> m Bool-    listObjects  :: Maybe (CommitOid m) -- ^ A commit we may already have-                 -> CommitOid m         -- ^ The commit we need-                 -> Bool                -- ^ Include commit trees also?-                 -> m [ObjectOid m]     -- ^ All the objects in between+    lookupCommit  :: CommitOid m -> m (Commit m)+    lookupTree    :: TreeOid m   -> m (Tree m)+    lookupBlob    :: BlobOid m   -> m (Blob m)+    lookupTag     :: TagOid m    -> m (Tag m)+    lookupObject  :: Oid m       -> m (Object m)+    existsObject  :: Oid m       -> m Bool+    sourceObjects :: Maybe (CommitOid m)    -- ^ A commit we may already have+                  -> CommitOid m            -- ^ The commit we need+                  -> Bool                   -- ^ Include commit trees also?+                  -> Source m (ObjectOid m) -- ^ All the objects in between      -- Working with trees     newTreeBuilder :: Maybe (Tree m) -> m (TreeBuilder m)@@ -80,27 +79,22 @@                  -> Signature -> Signature -> Text -> Maybe Text -> m (Commit m)     createTag :: CommitOid m -> Signature -> Text -> Text -> m (Tag m) -    -- Pushing and pulling-    pushCommit :: (MonadTrans t, MonadGit m, MonadGit (t m),-                   Repository m, Repository (t m))-               => CommitOid m -> Maybe Text -> Text -> t m (CommitOid (t m))--    -- Pack files-    buildPackFile :: FilePath -> [Either (CommitOid m) (TreeOid m)]-                  -> m FilePath-    buildPackFile _ _ =-        failure (BackendError "Backend does not support building pack files")+    -- -- Pack files+    -- buildPackFile :: FilePath -> [Either (CommitOid m) (TreeOid m)]+    --               -> m FilePath+    -- buildPackFile _ _ =+    --     failure (BackendError "Backend does not support building pack files") -    buildPackIndex :: FilePath -> ByteString -> m (Text, FilePath, FilePath)-    buildPackIndex _ _ =-        failure (BackendError "Backend does not support building pack indexes")+    -- buildPackIndex :: FilePath -> ByteString -> m (Text, FilePath, FilePath)+    -- buildPackIndex _ _ =+    --     failure (BackendError "Backend does not support building pack indexes") -    writePackFile :: FilePath -> m ()-    writePackFile _ =-        failure (BackendError "Backend does not support writing  pack files")+    -- writePackFile :: FilePath -> m ()+    -- writePackFile _ =+    --     failure (BackendError "Backend does not support writing  pack files") -    -- Git remotes-    remoteFetch :: Text {- URI -} -> Text {- fetch spec -} -> m ()+    -- -- Git remotes+    -- remoteFetch :: Text {- URI -} -> Text {- fetch spec -} -> m ()  data RepositoryOptions = RepositoryOptions     { repoPath       :: !FilePath

@@ -1,5 +1,5 @@ Name:                gitlib-Version:             2.0.0.0+Version:             2.0.1.0 Synopsis:            API library for working with Git repositories License-file:        LICENSE License:             MIT