gitlib-libgit2 2.0.0.0 → 2.0.1.0

raw patch · 2 files changed

+76/−81 lines, 2 filesdep ~gitlibdep ~gitlib-libgit2PVP ok

version bump matches the API change (PVP)

Dependency ranges changed: gitlib, gitlib-libgit2

API changes (from Hackage documentation)

Files

• Git/Libgit2.hs +72/−77
• gitlib-libgit2.cabal +4/−4

@@ -36,8 +36,11 @@        , lgGet        , lgExcTrap        , lgLoadPackFileInMemory+       , lgBuildPackFile        , lgReadFromPack        , lgWithPackFile+       , lgWritePackFile+       , lgWrap        , oidToSha        , shaToOid        , openLgRepository@@ -54,11 +57,13 @@ import           Control.Monad import           Control.Monad.IO.Class import           Control.Monad.Loops+import           Control.Monad.Trans.Class import           Control.Monad.Trans.Reader import           Control.Monad.Trans.Resource import           Data.Bits ((.|.)) import qualified Data.ByteString as B import qualified Data.ByteString.Unsafe as BU+import           Data.Conduit import           Data.IORef import           Data.List as L import           Data.Maybe@@ -83,7 +88,6 @@ import           Foreign.Ptr import           Foreign.Storable import qualified Git-import qualified Git.Commit.Push as Git import           Git.Libgit2.Internal import           Git.Libgit2.Types import           Prelude hiding (FilePath)@@ -93,8 +97,8 @@ import           Unsafe.Coerce  debug :: MonadIO m => String -> m ()---debug = liftIO . putStrLn-debug = const (return ())+debug = liftIO . putStrLn+--debug = const (return ())  type Oid = OidPtr @@ -161,36 +165,35 @@      parseOid = lgParseOid -    lookupReference = lgLookupRef-    createReference = lgUpdateRef-    updateReference = lgUpdateRef-    deleteReference = lgDeleteRef-    listReferences  = lgListRefs-    lookupCommit    = lgLookupCommit 40-    lookupTree      = lgLookupTree 40-    lookupBlob      = lgLookupBlob-    lookupTag       = error "Not implemented: LgRepository.lookupTag"-    lookupObject    = lgLookupObject-    existsObject    = lgExistsObject-    pushCommit      = \name _ rrefname -> Git.genericPushCommit name rrefname-    listObjects     = lgListObjects-    newTreeBuilder  = lgNewTreeBuilder-    treeEntry       = lgTreeEntry-    treeOid         = lgTreeOid-    listTreeEntries = lgListTreeEntries-    hashContents    = lgHashContents-    createBlob      = lgWrap . lgCreateBlob-    createTag       = error "Not implemented: LgRepository.createTag"+    lookupReference   = lgLookupRef+    createReference   = lgUpdateRef+    updateReference   = lgUpdateRef+    deleteReference   = lgDeleteRef+    listReferences    = lgListRefs+    lookupCommit      = lgLookupCommit 40+    lookupTree        = lgLookupTree 40+    lookupBlob        = lgLookupBlob+    lookupTag         = error "Not implemented: LgRepository.lookupTag"+    lookupObject      = lgLookupObject+    existsObject      = lgExistsObject+    sourceObjects     = lgSourceObjects+    newTreeBuilder    = lgNewTreeBuilder+    treeEntry         = lgTreeEntry+    treeOid           = lgTreeOid+    listTreeEntries   = lgListTreeEntries+    hashContents      = lgHashContents+    createBlob        = lgWrap . lgCreateBlob+    createTag         = error "Not implemented: LgRepository.createTag"      createCommit p t a c l r = lgWrap $ lgCreateCommit p t a c l r      deleteRepository = lgGet >>= liftIO . removeTree . repoPath -    buildPackFile   = lgBuildPackFile-    buildPackIndex  = lgBuildPackIndexWrapper-    writePackFile   = lgWrap . lgWritePackFile+    -- buildPackFile   = lgBuildPackFile+    -- buildPackIndex  = lgBuildPackIndexWrapper+    -- writePackFile   = lgWrap . lgWritePackFile -    remoteFetch     = lgRemoteFetch+    -- remoteFetch     = lgRemoteFetch  lgWrap :: (MonadIO m, MonadBaseControl IO m)        => LgRepository m a -> LgRepository m a@@ -224,7 +227,8 @@     repo <- lgGet     ptr  <- liftIO mallocForeignPtr     r    <- Git.blobContentsToByteString b-            >>= \bs -> liftIO $ createBlobFromByteString repo ptr bs+            >>= \bs -> liftIO $ evaluate+                       =<< createBlobFromByteString repo ptr bs     when (r < 0) $ failure Git.BlobCreateFailed     return (Tagged (mkOid ptr)) @@ -433,7 +437,7 @@             (mk'git_treebuilder_filter_cb (callback builder'))             freeHaskellFunPtr             (flip (c'git_treebuilder_filter builder) nullPtr)-        FC.newForeignPtr builder'(c'git_treebuilder_free builder')+        FC.newForeignPtr builder' (c'git_treebuilder_free builder')   where     callback builder te _ = do         cname <- c'git_tree_entry_name te@@ -606,56 +610,47 @@         freeHaskellFunPtr         (flip (c'git_odb_foreach odbPtr) payload) -lgListObjects :: Git.MonadGit m-              => Maybe (CommitOid m) -> CommitOid m -> Bool-              -> LgRepository m [ObjectOid m]-lgListObjects mhave need alsoTrees = do-    repo <- lgGet-    refs <- liftIO $ withForeignPtr (repoObj repo) $ \repoPtr ->-        alloca $ \pptr ->-            Exc.bracket-                (do r <- c'git_revwalk_new pptr repoPtr-                    when (r < 0) $-                        failure (Git.BackendError "Could not create revwalker")-                    peek pptr)-                c'git_revwalk_free-                (lgRevWalker need mhave)-    concat <$> mapM getCommitContents refs-  where-    getCommitContents cref-        | alsoTrees = do-            c <- lgLookupCommit 40 cref-            return [Git.CommitObjOid cref, Git.TreeObjOid (Git.commitTree c)]-        | otherwise = return [Git.CommitObjOid cref]+lgSourceObjects+    :: Git.MonadGit m+    => Maybe (CommitOid m) -> CommitOid m -> Bool+    -> Source (LgRepository m) (ObjectOid m)+lgSourceObjects mhave need alsoTrees = do+    repo   <- lift $ lgGet+    walker <- liftIO $ alloca $ \pptr -> do+        r <- withForeignPtr (repoObj repo) $ \repoPtr ->+                c'git_revwalk_new pptr repoPtr+        when (r < 0) $+            failure (Git.BackendError "Could not create revwalker")+        ptr <- peek pptr+        newForeignPtr p'git_revwalk_free ptr -    lgRevWalker coid moid walker = do-        pushOid (getOid (untag coid))-        case moid of-            Nothing -> return ()-            Just oid ->-                withForeignPtr (getOid (untag oid)) $ \coid -> do-                    r2 <- c'git_revwalk_hide walker coid-                    when (r2 < 0) $-                        failure (Git.BackendError-                                 "Could not hide commit on revwalker")-        alloca $ \coidPtr -> do-            c'git_revwalk_sorting walker-                (fromIntegral ((1 :: Int) .|. (4 :: Int)))-            whileM ((==) <$> pure 0-                         <*> c'git_revwalk_next coidPtr walker)-                (Tagged . mkOid <$> coidPtrToOid coidPtr)-      where-        pushOid oid =-            withForeignPtr oid $ \coid -> do-                r2 <- c'git_revwalk_push walker coid-                when (r2 < 0) $-                    failure (Git.BackendError "Could not push oid on revwalker")+    liftIO $ withForeignPtr (getOid (untag need)) $ \coid -> do+        r2 <- withForeignPtr walker $ flip c'git_revwalk_push coid+        when (r2 < 0) $+            failure (Git.BackendError "Could not push oid on revwalker") -        pushRef refName =-            withCString refName $ \namePtr -> do-                r2 <- c'git_revwalk_push_ref walker namePtr-                when (r2 < 0) $-                    failure (Git.BackendError "Could not push ref on revwalker")+    case mhave of+        Nothing   -> return ()+        Just have -> liftIO $ withForeignPtr (getOid (untag have)) $ \coid -> do+            r2 <- withForeignPtr walker $ flip c'git_revwalk_hide coid+            when (r2 < 0) $+                failure (Git.BackendError "Could not hide commit on revwalker")++    liftIO $ withForeignPtr walker $ flip c'git_revwalk_sorting+        (fromIntegral ((1 :: Int) .|. (4 :: Int)))++    coidPtr <- liftIO mallocForeignPtr+    whileM_ ((==) <$> pure 0+                  <*> liftIO (withForeignPtr walker $ \walker' ->+                              withForeignPtr coidPtr $ \coidPtr' ->+                                  c'git_revwalk_next coidPtr' walker')) $ do+        oidPtr <- liftIO $ withForeignPtr coidPtr coidPtrToOid+        do+            let coid = Tagged (mkOid oidPtr)+            yield $ Git.CommitObjOid coid+            when alsoTrees $ do+                c <- lift $ lgLookupCommit 40 coid+                yield $ Git.TreeObjOid (Git.commitTree c)  -- | Write out a commit to its repository.  If it has already been written, --   nothing will happen.

@@ -1,5 +1,5 @@ Name:                gitlib-libgit2-Version:             2.0.0.0+Version:             2.0.1.0 Synopsis:            Libgit2 backend for gitlib License-file:        LICENSE License:             MIT@@ -23,9 +23,9 @@     Hs-source-dirs: test     Build-depends:            base >=3-        , gitlib             >= 2.0.0.0+        , gitlib             >= 2.0.1.0         , gitlib-test        >= 2.0.0.0-        , gitlib-libgit2     >= 2.0.0.0+        , gitlib-libgit2     >= 2.0.1.0         , HUnit              >= 1.2.5         , hspec              >= 1.4.4         , hspec-expectations >= 0.3@@ -36,7 +36,7 @@     ghc-options: -Wall     build-depends:           base                 >= 3 && < 5-        , gitlib               >= 2.0.0.0+        , gitlib               >= 2.0.1.0         , hlibgit2             >= 0.18.0.7         , attempt              >= 0.4.0         , binary               >= 0.5.1.0