gitlib-libgit2 3.1.1 → 3.1.2

raw patch · 4 files changed

+117/−101 lines, 4 filesdep +unliftiodep +unliftio-coredep −lifted-asyncdep −lifted-basedep −monad-controldep ~gitlib-libgit2dep ~hlibgit2PVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: unliftio, unliftio-core

Dependencies removed: lifted-async, lifted-base, monad-control

Dependency ranges changed: gitlib-libgit2, hlibgit2

API changes (from Hackage documentation)

Files

• Git/Libgit2.hs +106/−88
• Git/Libgit2/Internal.hs +4/−4
• Git/Libgit2/Types.hs +2/−3
• gitlib-libgit2.cabal +5/−6

@@ -21,6 +21,7 @@ --   queried as needed. module Git.Libgit2        ( MonadLg+       , HasLgRepo(..)        , LgRepo(..)        , BlobOid()        , Commit()@@ -58,16 +59,15 @@ import           Conduit import           Control.Applicative import           Control.Concurrent (threadDelay)-import           Control.Concurrent.Async.Lifted import           Control.Concurrent.STM---import           Control.Exception.Lifted+import           UnliftIO.Async import           Control.Monad hiding (forM, forM_, mapM, mapM_, sequence) import           Control.Monad.Catch import           Control.Monad.Loops import           Control.Monad.Reader.Class-import           Control.Monad.Trans.Control import           Control.Monad.Trans.Reader (ReaderT, runReaderT) import           Control.Monad.Trans.Resource+import           Control.Monad.IO.Unlift import           Data.Bits ((.|.), (.&.)) import           Data.ByteString (ByteString) import qualified Data.ByteString as B@@ -174,10 +174,15 @@  instance Eq OidPtr where     oid1 == oid2 = oid1 `compare` oid2 == EQ--instance (Applicative m, MonadExcept m,-          MonadBaseControl IO m, MonadIO m)-         => Git.MonadGit LgRepo (ReaderT LgRepo m) where++class HasLgRepo m where+  getRepository :: m LgRepo++instance Monad m => HasLgRepo (ReaderT LgRepo m) where+  getRepository = ask++instance (Applicative m, MonadExcept m, MonadUnliftIO m, HasLgRepo m)+         => Git.MonadGit LgRepo m where     type Oid LgRepo = OidPtr     data Tree LgRepo =         LgTree { lgTreePtr :: Maybe (ForeignPtr C'git_tree) }@@ -185,7 +190,7 @@      facts = return Git.RepositoryFacts { Git.hasSymbolicReferences = True } -    getRepository    = ask+    getRepository    = getRepository     closeRepository  = return ()     deleteRepository =         Git.getRepository >>= liftIO . removeDirectoryRecursive . lgRepoPath@@ -202,6 +207,7 @@     lookupBlob        = lgLookupBlob     lookupTag         = error "Not implemented: LgRepository.lookupTag"     readIndex         = lgReadIndex+    writeIndex        = error "Not implemented: LgRepository.writeIndex"     lookupObject      = lgLookupObject     existsObject      = lgExistsObject     sourceObjects     = lgSourceObjects@@ -223,19 +229,20 @@      -- remoteFetch     = lgRemoteFetch -lgExcTrap :: MonadLg m => ReaderT LgRepo m (IORef (Maybe Git.GitException))-lgExcTrap = repoExcTrap `liftM` Git.getRepository+lgExcTrap :: (MonadLg m, HasLgRepo m)+          => m (IORef (Maybe Git.GitException))+lgExcTrap = repoExcTrap `liftM` getRepository -lgWrap :: MonadLg m => ReaderT LgRepo m a -> ReaderT LgRepo m a+lgWrap :: (MonadLg m, HasLgRepo m) => m a -> m a lgWrap f = f `catch` \e -> do     etrap <- lgExcTrap     mexc  <- liftIO $ readIORef etrap     liftIO $ writeIORef etrap Nothing     maybe (throwM (e :: SomeException)) throwM mexc -lgHashContents :: MonadLg m-               => Git.BlobContents (ReaderT LgRepo m)-               -> ReaderT LgRepo m BlobOid+lgHashContents :: (MonadLg m, HasLgRepo m)+               => Git.BlobContents m+               -> m BlobOid lgHashContents b = do     ptr <- liftIO mallocForeignPtr     r   <- Git.blobContentsToByteString b >>= \bs ->@@ -250,11 +257,11 @@ -- --   Note that since empty blobs cannot exist in Git, no means is provided for --   creating one; if the given string is 'empty', it is an error.-lgCreateBlob :: MonadLg m-             => Git.BlobContents (ReaderT LgRepo m)-             -> ReaderT LgRepo m BlobOid+lgCreateBlob :: (MonadLg m, HasLgRepo m)+             => Git.BlobContents m+             -> m BlobOid lgCreateBlob b = do-    repo <- Git.getRepository+    repo <- getRepository     ptr  <- liftIO mallocForeignPtr -- freed automatically if GC'd     r <- case b of         Git.BlobString bs         -> createBlob repo ptr bs@@ -305,7 +312,7 @@ lgObjToBlob :: MonadLg m             => BlobOid             -> ForeignPtr C'git_blob-            -> ReaderT LgRepo m (Git.Blob LgRepo (ReaderT LgRepo m))+            -> m (Git.Blob LgRepo m) lgObjToBlob oid fptr = do     bs <- liftIO $ withForeignPtr fptr $ \ptr -> do         size <- c'git_blob_rawsize ptr@@ -313,16 +320,16 @@         B.packCStringLen (castPtr buf, fromIntegral size)     return $ Git.Blob oid $ Git.BlobString bs -lgLookupBlob :: MonadLg m+lgLookupBlob :: (MonadLg m, HasLgRepo m)              => BlobOid-             -> ReaderT LgRepo m (Git.Blob LgRepo (ReaderT LgRepo m))+             -> m (Git.Blob LgRepo m) lgLookupBlob oid =     lookupObject' (getOid (untag oid)) (getOidLen (untag oid))         c'git_blob_lookup c'git_blob_lookup_prefix         $ \boid obj _ -> lgObjToBlob (Tagged (mkOid boid)) obj -lgTreeEntry :: MonadLg m-            => Tree -> Git.TreeFilePath -> ReaderT LgRepo m (Maybe TreeEntry)+lgTreeEntry :: (MonadLg m, HasLgRepo m)+            => Tree -> Git.TreeFilePath -> m (Maybe TreeEntry) lgTreeEntry (LgTree Nothing) _ = return Nothing lgTreeEntry (LgTree (Just tree)) fp = liftIO $ alloca $ \entryPtr ->     withFilePath fp $ \pathStr ->@@ -332,7 +339,7 @@                 then return Nothing                 else Just <$> (entryToTreeEntry =<< peek entryPtr) -lgTreeOid :: MonadLg m => Tree -> ReaderT LgRepo m TreeOid+lgTreeOid :: (MonadLg m, HasLgRepo m) => Tree -> m TreeOid lgTreeOid (LgTree Nothing) =     liftIO $ Tagged . fromJust <$> lgParseOidIO Git.emptyTreeId 40 lgTreeOid (LgTree (Just tree)) = liftIO $ do@@ -340,14 +347,14 @@     ftoid <- coidPtrToOid toid     return $ Tagged (mkOid ftoid) -gatherFrom' :: (MonadIO m, MonadBaseControl IO m, MonadExcept m)+gatherFrom' :: (MonadExcept m, MonadUnliftIO m)            => Int                -- ^ Size of the queue to create            -> (TBQueue o -> m ()) -- ^ Action that generates output values            -> Producer m o gatherFrom' size scatter = do     chan   <- liftIO $ newTBQueueIO size     worker <- lift $ async (scatter chan)-    lift . restoreM =<< gather worker chan+    gather worker chan   where     gather worker chan = do         (xs, mres) <- liftIO $ atomically $ do@@ -361,9 +368,9 @@             Nothing        -> gather worker chan  lgSourceTreeEntries-    :: MonadLg m+    :: (MonadLg m, HasLgRepo m)     => Tree-    -> Producer (ReaderT LgRepo m) (Git.TreeFilePath, TreeEntry)+    -> Producer m (Git.TreeFilePath, TreeEntry) lgSourceTreeEntries (LgTree Nothing) = return () lgSourceTreeEntries (LgTree (Just tree)) = gatherFrom' 16 $ \queue -> do     liftIO $ withForeignPtr tree $ \tr -> do@@ -383,8 +390,8 @@             writeTBQueue queue $ name `seq` entry `seq` (name,entry)         return 0 -lgMakeBuilder :: MonadLg m-              => ForeignPtr C'git_treebuilder -> TreeBuilder (ReaderT LgRepo m)+lgMakeBuilder :: (MonadLg m, HasLgRepo m)+              => ForeignPtr C'git_treebuilder -> TreeBuilder m lgMakeBuilder builder = Git.TreeBuilder     { Git.mtbBaseTreeOid    = Nothing     , Git.mtbPendingUpdates = mempty@@ -403,9 +410,9 @@ -- --   Since empty trees cannot exist in Git, attempting to write out an empty --   tree is a no-op.-lgNewTreeBuilder :: MonadLg m+lgNewTreeBuilder :: (MonadLg m, HasLgRepo m)                  => Maybe Tree-                 -> ReaderT LgRepo m (TreeBuilder (ReaderT LgRepo m))+                 -> m (TreeBuilder m) lgNewTreeBuilder mtree = do     mfptr <- liftIO $ alloca $ \pptr -> do         r <- case mtree of@@ -431,7 +438,7 @@  lgPutEntry :: MonadLg m            => ForeignPtr C'git_treebuilder -> Git.TreeFilePath -> TreeEntry-           -> ReaderT LgRepo m ()+           -> m () lgPutEntry builder key (treeEntryToOid -> (oid, mode)) = do     r2 <- liftIO $ withForeignPtr (getOid oid) $ \coid ->         withForeignPtr builder $ \ptr ->@@ -453,7 +460,7 @@  lgDropEntry :: MonadLg m             => ForeignPtr C'git_treebuilder -> Git.TreeFilePath-            -> ReaderT LgRepo m ()+            -> m () lgDropEntry builder key =     void $ liftIO $ withForeignPtr builder $ \ptr ->         withFilePath key $ c'git_treebuilder_remove ptr@@ -461,7 +468,7 @@ lgLookupBuilderEntry :: MonadLg m                      => ForeignPtr C'git_treebuilder                      -> Git.TreeFilePath-                     -> ReaderT LgRepo m (Maybe TreeEntry)+                     -> m (Maybe TreeEntry) lgLookupBuilderEntry builderPtr name = do     entry <- liftIO $ withForeignPtr builderPtr $ \builder ->         withFilePath name $ c'git_treebuilder_get builder@@ -470,7 +477,7 @@         else Just <$> liftIO (entryToTreeEntry entry)  lgBuilderEntryCount :: MonadLg m-                    => ForeignPtr C'git_treebuilder -> ReaderT LgRepo m Int+                    => ForeignPtr C'git_treebuilder -> m Int lgBuilderEntryCount tb =     fromIntegral <$> liftIO (withForeignPtr tb c'git_treebuilder_entrycount) @@ -479,10 +486,10 @@ lgTreeEntryCount (LgTree (Just tree)) =     fromIntegral <$> liftIO (withForeignPtr tree c'git_tree_entrycount) -lgWriteBuilder :: MonadLg m-               => ForeignPtr C'git_treebuilder -> ReaderT LgRepo m TreeOid+lgWriteBuilder :: (MonadLg m, HasLgRepo m)+               => ForeignPtr C'git_treebuilder -> m TreeOid lgWriteBuilder tb = do-    repo <- Git.getRepository+    repo <- getRepository     (r3,coid) <- liftIO $ do         coid <- mallocForeignPtr         withForeignPtr coid $ \coid' ->@@ -522,7 +529,7 @@             throwM (Git.BackendError "Could not insert entry in treebuilder")         return 0 -lgLookupTree :: MonadLg m => TreeOid -> ReaderT LgRepo m Tree+lgLookupTree :: (MonadLg m, HasLgRepo m) => TreeOid -> m Tree lgLookupTree (untag -> oid)     | show oid == unpack Git.emptyTreeId = return $ LgTree Nothing     | otherwise = do@@ -586,16 +593,16 @@         , Git.commitEncoding  = "utf-8"         } -lgLookupCommit :: MonadLg m => CommitOid -> ReaderT LgRepo m Commit+lgLookupCommit :: (MonadLg m, HasLgRepo m) => CommitOid -> m Commit lgLookupCommit oid =   lookupObject' (getOid (untag oid)) (getOidLen (untag oid))       c'git_commit_lookup c'git_commit_lookup_prefix       $ \coid obj _ -> liftIO $ withForeignPtr obj $           lgObjToCommit (Tagged (mkOid coid)) -lgReadIndex :: MonadLg m => Git.TreeT LgRepo (ReaderT LgRepo m) ()+lgReadIndex :: (MonadLg m, HasLgRepo m) => Git.TreeT LgRepo m () lgReadIndex = do-  repo <- lift Git.getRepository+  repo <- lift getRepository   xs <- liftIO $ withForeignPtr (repoObj repo) $ \repoPtr ->     alloca $ \indexPp -> do       r <- c'git_repository_index indexPp repoPtr@@ -634,10 +641,11 @@                | CommitPtr (ForeignPtr C'git_commit)                | TagPtr (ForeignPtr C'git_tag) -lgLookupObject :: MonadLg m+lgLookupObject :: (MonadLg m, HasLgRepo m)                => Oid-               -> ReaderT LgRepo m (Git.Object LgRepo (ReaderT LgRepo m))+               -> m (Git.Object LgRepo m) lgLookupObject oid = do+    repo <- getRepository     (oid', typ, fptr) <-         lookupObject' (getOid oid) (getOidLen oid)             (\x y z   -> c'git_object_lookup x y z c'GIT_OBJ_ANY)@@ -656,12 +664,22 @@                 Git.CommitObj <$>                 liftIO (withForeignPtr fptr $ \y ->                          lgObjToCommit (Tagged oid') (castPtr y))-           | typ == c'GIT_OBJ_TAG -> error "jww (2013-07-08): NYI"+           | typ == c'GIT_OBJ_TAG -> do+                commit <- liftIO (withForeignPtr (repoObj repo) $ \repoPtr ->+                     liftIO (withForeignPtr fptr $ \y ->+                           do oid'' <- c'git_tag_target_id (castPtr y)+                              alloca $ \pptr -> do+                                  _ <- c'git_commit_lookup pptr repoPtr oid''+                                  ptr <- peek pptr+                                  coid <- coidPtrToOid oid''+                                  lgObjToCommit (Tagged . mkOid $ coid) ptr+                        ))+                Git.CommitObj <$> (pure commit)            | otherwise -> error $ "Unknown object type: " ++ show typ -lgExistsObject :: MonadLg m => Oid -> ReaderT LgRepo m Bool+lgExistsObject :: (MonadLg m, HasLgRepo m) => Oid -> m Bool lgExistsObject oid = do-    repo <- Git.getRepository+    repo <- getRepository     result <- liftIO $ withForeignPtr (repoObj repo) $ \repoPtr ->         alloca $ \pptr -> do             r <- c'git_repository_odb pptr repoPtr@@ -687,11 +705,11 @@         freeHaskellFunPtr         (flip (c'git_odb_foreach odbPtr) payload) -lgSourceObjects :: MonadLg m+lgSourceObjects :: (MonadLg m, HasLgRepo m)                 => Maybe CommitOid -> CommitOid -> Bool-                -> Producer (ReaderT LgRepo m) ObjectOid+                -> Producer m ObjectOid lgSourceObjects mhave need alsoTrees = do-    repo   <- lift Git.getRepository+    repo   <- lift getRepository     walker <- liftIO $ alloca $ \pptr -> do         r <- withForeignPtr (repoObj repo) $ \repoPtr ->                 c'git_revwalk_new pptr repoPtr@@ -735,16 +753,16 @@  -- | Write out a commit to its repository.  If it has already been written, --   nothing will happen.-lgCreateCommit :: MonadLg m+lgCreateCommit :: (MonadLg m, HasLgRepo m)                => [CommitOid]                -> TreeOid                -> Git.Signature                -> Git.Signature                -> Git.CommitMessage                -> Maybe Git.RefName-               -> ReaderT LgRepo m Commit+               -> m Commit lgCreateCommit pptrs tree author committer logText ref = do-    repo <- Git.getRepository+    repo <- getRepository     let toid  = getOid . untag $ tree     coid <- liftIO $ withForeignPtr (repoObj repo) $ \repoPtr -> do         coid <- mallocForeignPtr@@ -791,9 +809,9 @@     mapM_ touchForeignPtr fos     return r -lgLookupRef :: MonadLg m => Git.RefName -> ReaderT LgRepo m (Maybe RefTarget)+lgLookupRef :: (MonadLg m, HasLgRepo m) => Git.RefName -> m (Maybe RefTarget) lgLookupRef name = do-    repo <- Git.getRepository+    repo <- getRepository     liftIO $ alloca $ \ptr -> do         r <- withForeignPtr (repoObj repo) $ \repoPtr ->               withCString (unpack name) $ \namePtr ->@@ -813,10 +831,10 @@             c'git_reference_free ref             return (Just targ) -lgUpdateRef :: MonadLg m-            => Git.RefName -> Git.RefTarget LgRepo -> ReaderT LgRepo m ()+lgUpdateRef :: (MonadLg m, HasLgRepo m)+            => Git.RefName -> Git.RefTarget LgRepo -> m () lgUpdateRef name refTarg = do-    repo <- Git.getRepository+    repo <- getRepository     r <- liftIO $ alloca $ \ptr ->         withForeignPtr (repoObj repo) $ \repoPtr ->         withCString (unpack name) $ \namePtr ->@@ -837,7 +855,7 @@  lgResolveRef :: MonadLg m => Git.RefName -> ReaderT LgRepo m (Maybe CommitOid) lgResolveRef name = do-    repo <- Git.getRepository+    repo <- getRepository     oid <- liftIO $ alloca $ \ptr ->         withCString (unpack name) $ \namePtr ->         withForeignPtr (repoObj repo) $ \repoPtr -> do@@ -852,9 +870,9 @@  --renameRef = c'git_reference_rename -lgDeleteRef :: MonadLg m => Git.RefName -> ReaderT LgRepo m ()+lgDeleteRef :: (MonadLg m, HasLgRepo m) => Git.RefName -> m () lgDeleteRef name = do-    repo <- Git.getRepository+    repo <- getRepository     r <- liftIO $ alloca $ \ptr ->         withCString (unpack name) $ \namePtr ->         withForeignPtr (repoObj repo) $ \repoPtr -> do@@ -920,10 +938,11 @@                  + (if listFlagPacked flags   then 4 else 0)                  + (if listFlagHasPeel flags  then 8 else 0) -lgSourceRefs :: MonadLg m => Producer (ReaderT LgRepo m) Git.RefName++lgSourceRefs :: (MonadLg m, HasLgRepo m) => Producer m Git.RefName lgSourceRefs =     gatherFrom' 16 $ \queue -> do-        repo <- Git.getRepository+        repo <- getRepository         r <- liftIO $ bracket             (mk'git_reference_foreach_cb (callback queue))             freeHaskellFunPtr@@ -1022,7 +1041,7 @@         Git.DiffTreeToIndexFailed "Cannot diff against an empty tree"  lgDiffContentsWithTree contents tree = do-    repo <- lift Git.getRepository+    repo <- lift getRepository     gatherFrom' 16 $ generateDiff repo   where     -- generateDiff :: MonadLg m => LgRepo -> TBQueue ByteString -> m ()@@ -1223,7 +1242,7 @@                 => FilePath -> [Either CommitOid TreeOid]                 -> ReaderT LgRepo m FilePath lgBuildPackFile dir oids = do-    repo <- Git.getRepository+    repo <- getRepository     liftIO $ do         (filePath, fHandle) <- openBinaryTempFile dir "pack"         hClose fHandle@@ -1273,14 +1292,14 @@ lift_ :: (Monad m, Functor (t m), MonadTrans t) => m a -> t m () lift_ = void . lift -lgBuildPackIndex :: (MonadIO m, MonadBaseControl IO m)+lgBuildPackIndex :: MonadUnliftIO m                  => FilePath -> BL.ByteString -> m (Text, FilePath, FilePath) lgBuildPackIndex dir bytes = do     sha <- go dir bytes     return (sha, dir </> ("pack-" <> unpack sha <> ".pack"),                  dir </> ("pack-" <> unpack sha <> ".idx"))   where-    go dir bytes = control $ \run -> alloca $ \idxPtrPtr -> runResourceT $ do+    go dir bytes = withRunInIO $ \run -> alloca $ \idxPtrPtr -> runResourceT $ do         lift_ . run $ lgDebug "Allocate a new indexer stream"         (_,idxPtr) <- flip allocate c'git_indexer_stream_free $             withCString dir $ \dirStr -> do@@ -1342,8 +1361,8 @@     -- yet because it only calls into the Libgit2 backend, which doesn't know     -- anything about the S3 backend.  As far as Libgit2 is concerned, the S3     -- backend is just a black box with no special properties.-    repo <- Git.getRepository-    control $ \run -> withForeignPtr (repoObj repo) $ \repoPtr ->+    repo <- getRepository+    withRunInIO $ \run -> withForeignPtr (repoObj repo) $ \repoPtr ->         alloca $ \odbPtrPtr ->         alloca $ \statsPtr ->         alloca $ \writepackPtrPtr -> do@@ -1385,7 +1404,7 @@         checkResult r "c'git_odb_writepack'commit failed"  lgLoadPackFileInMemory-    :: (MonadBaseControl IO m, MonadIO m, MonadExcept m)+    :: (MonadIO m, MonadExcept m)     => FilePath     -> Ptr (Ptr C'git_odb_backend)     -> Ptr (Ptr C'git_odb)@@ -1416,22 +1435,22 @@      return odbPtr -lgOpenPackFile :: (MonadBaseControl IO m, MonadIO m, MonadExcept m)+lgOpenPackFile :: (MonadExcept m, MonadUnliftIO m)                => FilePath -> m (Ptr C'git_odb)-lgOpenPackFile idxPath = control $ \run ->+lgOpenPackFile idxPath = withRunInIO $ \run ->     alloca $ \odbPtrPtr ->     alloca $ \backendPtrPtr -> run $         lgLoadPackFileInMemory idxPath backendPtrPtr odbPtrPtr -lgClosePackFile :: (MonadBaseControl IO m, MonadIO m, MonadExcept m)+lgClosePackFile :: (MonadIO m, MonadExcept m)                => Ptr C'git_odb -> m () lgClosePackFile = liftIO . c'git_odb_free -lgWithPackFile :: (MonadBaseControl IO m, MonadIO m, MonadExcept m)+lgWithPackFile :: (MonadExcept m, MonadUnliftIO m)                => FilePath -> (Ptr C'git_odb -> m a) -> m a lgWithPackFile idxPath = bracket (lgOpenPackFile idxPath) lgClosePackFile -lgReadFromPack :: (MonadBaseControl IO m, MonadIO m, MonadExcept m)+lgReadFromPack :: (MonadIO m, MonadExcept m)                => Ptr C'git_odb -> Git.SHA -> Bool                -> m (Maybe (C'git_otype, CSize, ByteString)) lgReadFromPack odbPtr sha metadataOnly = liftIO $ do@@ -1472,7 +1491,7 @@  lgRemoteFetch :: MonadLg m => Text -> Text -> ReaderT LgRepo m () lgRemoteFetch uri fetchSpec = do-    xferRepo <- Git.getRepository+    xferRepo <- getRepository     liftIO $ withForeignPtr (repoObj xferRepo) $ \repoPtr ->         withCString (unpack uri) $ \uriStr ->         withCString (unpack fetchSpec) $ \fetchStr ->@@ -1492,7 +1511,7 @@         r2 <- liftIO $ c'git_remote_download remotePtr nullFunPtr nullPtr         checkResult r2 "c'git_remote_download failed" -lgFactory :: MonadIO m+lgFactory :: (MonadIO m, MonadMask m)           => Git.RepositoryFactory (ReaderT LgRepo m) m LgRepo lgFactory = Git.RepositoryFactory     { Git.openRepository = openLgRepository@@ -1502,26 +1521,25 @@ runLgRepository :: LgRepo -> ReaderT LgRepo m a -> m a runLgRepository = flip runReaderT -openLgRepository :: MonadIO m => Git.RepositoryOptions -> m LgRepo+openLgRepository :: (MonadIO m, MonadMask m) => Git.RepositoryOptions -> m LgRepo openLgRepository opts = do     startupLgBackend     let path = Git.repoPath opts     p <- liftIO $ doesDirectoryExist path-    liftIO $ openRepositoryWith path $+    openRepositoryWith path $         if not (Git.repoAutoCreate opts) || p         then c'git_repository_open         else \x y -> c'git_repository_init x y                          (fromBool (Git.repoIsBare opts))   where     openRepositoryWith path fn = do-        fptr <- alloca $ \ptr ->-            withCString path $ \str -> do-                r <- fn ptr str-                when (r < 0) $-                    error $ "Could not open repository " ++ show path-                ptr' <- peek ptr-                FC.newForeignPtr ptr' (c'git_repository_free ptr')-        excTrap <- newIORef Nothing+        ptr <- liftIO malloc+        r <- liftIO $ withCString path $ fn ptr+        when (r < 0) $ lgThrow Git.RepositoryCannotAccess+        excTrap <- liftIO $ newIORef Nothing+        fptr <- liftIO $ do+            ptr' <- peek ptr+            FC.newForeignPtr ptr' (c'git_repository_free ptr')         return LgRepo             { repoOptions = opts             , repoObj     = fptr

@@ -10,7 +10,7 @@ import           Control.Applicative import           Control.Monad import           Control.Monad.Catch-import           Control.Monad.Trans.Control+import           Control.Monad.IO.Unlift import           Data.ByteString import qualified Data.Text as T import qualified Data.Text.ICU.Convert as U@@ -51,7 +51,7 @@     return fptr  lookupObject'-  :: (Git.MonadGit LgRepo m, MonadBaseControl IO m)+  :: (Git.MonadGit LgRepo m, MonadUnliftIO m)   => ForeignPtr C'git_oid -> Int   -> (Ptr (Ptr a) -> Ptr C'git_repository -> Ptr C'git_oid -> IO CInt)   -> (Ptr (Ptr a) -> Ptr C'git_repository -> Ptr C'git_oid -> CSize -> IO CInt)@@ -59,7 +59,7 @@   -> m b lookupObject' oid len lookupFn lookupPrefixFn createFn = do     repo <- Git.getRepository-    result <- liftBaseWith $ \run -> alloca $ \ptr -> do+    result <- withRunInIO $ \run -> alloca $ \ptr -> do         r <- withForeignPtr (repoObj repo) $ \repoPtr ->             withForeignPtr oid $ \oidPtr ->                 if len == 40@@ -85,7 +85,7 @@               let p = castPtr ptr'               fptr <- FC.newForeignPtr p (c'git_object_free p)               Right <$> run (createFn coidCopy (castForeignPtr fptr) ptr')-    either (throwM . Git.BackendError) restoreM result+    either (throwM . Git.BackendError) pure result  -- lgLookupObject :: Text -> LgRepository Dynamic -- lgLookupObject str

@@ -12,7 +12,7 @@ import           Control.Applicative import           Control.Monad.Catch import           Control.Monad.IO.Class-import           Control.Monad.Trans.Control+import           Control.Monad.IO.Unlift import           Data.IORef import           Foreign.ForeignPtr import qualified Git@@ -53,7 +53,6 @@  type MonadExcept m = (MonadThrow m, MonadCatch m, MonadMask m) -type MonadLg m = (Applicative m, MonadExcept m,-                  MonadIO m, MonadBaseControl IO m)+type MonadLg m = (Applicative m, MonadExcept m, MonadUnliftIO m)  -- Types.hs

@@ -1,5 +1,5 @@ Name:                gitlib-libgit2-Version:       3.1.1+Version:             3.1.2 Synopsis:            Libgit2 backend for gitlib License-file:        LICENSE License:             MIT@@ -21,11 +21,11 @@     Type: exitcode-stdio-1.0     Main-is: Smoke.hs     Hs-source-dirs: test-    Build-depends: +    Build-depends:           base >=3         , gitlib             >= 3.1.1         , gitlib-test        >= 3.0.0-        , gitlib-libgit2     >= 3.1.1+        , gitlib-libgit2         , HUnit              >= 1.2.5         , hspec              >= 1.4.4         , hspec-expectations >= 0.3@@ -48,10 +48,7 @@         , exceptions           >= 0.6         , fast-logger         , filepath             >= 1.3.0-        , lifted-async         >= 0.1.0-        , lifted-base          >= 0.2.0.2         , mmorph               >= 1.0.0-        , monad-control        >= 1.0         , monad-loops          >= 0.3.3.0         , mtl                  >= 2.1.2         , resourcet            >= 1.1.0@@ -64,6 +61,8 @@         , time                 >= 1.4         , transformers         >= 0.3.0.0         , transformers-base    >= 0.4.1+        , unliftio-core        >= 0.1.1+        , unliftio     exposed-modules:         Git.Libgit2         Git.Libgit2.Backend