yogsototh/stackage
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions
stackage/patching/patches/gitlib-libgit2-3.0.1.patch
Michael Snoyman 44be73a24b New gitlib patches
2014-04-06 09:02:57 +03:00

280 lines
11 KiB
Diff
Raw Permalink Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

diff -ru orig/Git/Libgit2/Internal.hs new/Git/Libgit2/Internal.hs
--- orig/Git/Libgit2/Internal.hs 2014-04-06 09:02:46.523789820 +0300
+++ new/Git/Libgit2/Internal.hs 2014-04-06 09:02:46.000000000 +0300
@@ -8,9 +8,9 @@
import Bindings.Libgit2
import Control.Applicative
-import Control.Failure
import Control.Monad
import Control.Monad.Trans.Control
+import Control.Monad.Trans.Resource
import Data.ByteString
import qualified Data.Text as T
import qualified Data.Text.ICU.Convert as U
@@ -85,7 +85,7 @@
let p = castPtr ptr'
fptr <- FC.newForeignPtr p (c'git_object_free p)
run $ Right <$> createFn coidCopy (castForeignPtr fptr) ptr'
- either (failure . Git.BackendError) return result
+ either (throwM . Git.BackendError) return result
-- lgLookupObject :: Text -> LgRepository Dynamic
-- lgLookupObject str
diff -ru orig/Git/Libgit2/Types.hs new/Git/Libgit2/Types.hs
--- orig/Git/Libgit2/Types.hs 2014-04-06 09:02:46.523789820 +0300
+++ new/Git/Libgit2/Types.hs 2014-04-06 09:02:46.000000000 +0300
@@ -10,10 +10,10 @@
import Bindings.Libgit2
import Control.Applicative
-import Control.Failure
import Control.Monad.IO.Class
import Control.Monad.Logger
import Control.Monad.Trans.Control
+import Control.Monad.Trans.Resource
import Data.IORef
import Foreign.ForeignPtr
import qualified Git
@@ -52,7 +52,7 @@
type TreeBuilder = Git.TreeBuilder LgRepo
type Options = Git.Options LgRepo
-type MonadLg m = (Applicative m, Failure Git.GitException m,
+type MonadLg m = (Applicative m, MonadThrow m,
MonadIO m, MonadBaseControl IO m, MonadLogger m)
-- Types.hs
diff -ru orig/Git/Libgit2.hs new/Git/Libgit2.hs
--- orig/Git/Libgit2.hs 2014-04-06 09:02:46.523789820 +0300
+++ new/Git/Libgit2.hs 2014-04-06 09:02:46.000000000 +0300
@@ -60,7 +60,6 @@
import Control.Concurrent.Async.Lifted
import Control.Concurrent.STM
import Control.Exception.Lifted
-import Control.Failure
import Control.Monad hiding (forM, forM_, mapM, mapM_, sequence)
import Control.Monad.IO.Class
import Control.Monad.Logger
@@ -154,11 +153,11 @@
lgParseOid :: MonadLg m => Text -> m Oid
lgParseOid str
- | len > 40 = failure (Git.OidParseFailed str)
+ | len > 40 = throwM (Git.OidParseFailed str)
| otherwise = do
moid <- liftIO $ lgParseOidIO str len
case moid of
- Nothing -> failure (Git.OidParseFailed str)
+ Nothing -> throwM (Git.OidParseFailed str)
Just oid -> return oid
where
len = T.length str
@@ -179,7 +178,7 @@
instance Eq OidPtr where
oid1 == oid2 = oid1 `compare` oid2 == EQ
-instance (Applicative m, Failure Git.GitException m,
+instance (Applicative m, MonadThrow m,
MonadBaseControl IO m, MonadIO m, MonadLogger m)
=> Git.MonadGit LgRepo (ReaderT LgRepo m) where
type Oid LgRepo = OidPtr
@@ -427,7 +426,7 @@
return $ Just fptr
case mfptr of
Nothing ->
- failure (Git.TreeCreateFailed "Failed to create new tree builder")
+ throwM (Git.TreeCreateFailed "Failed to create new tree builder")
Just fptr -> do
toid <- mapM Git.treeOid mtree
return (lgMakeBuilder fptr) { Git.mtbBaseTreeOid = toid }
@@ -441,7 +440,7 @@
withFilePath key $ \name ->
c'git_treebuilder_insert nullPtr ptr name coid
(fromIntegral mode)
- when (r2 < 0) $ failure (Git.TreeBuilderInsertFailed key)
+ when (r2 < 0) $ throwM (Git.TreeBuilderInsertFailed key)
treeEntryToOid :: TreeEntry -> (Oid, CUInt)
treeEntryToOid (Git.BlobEntry oid kind) =
@@ -503,7 +502,7 @@
liftIO $ withForeignPtr fptr $ \builder -> alloca $ \pptr -> do
r <- c'git_treebuilder_create pptr nullPtr
when (r < 0) $
- failure (Git.BackendError "Could not create new treebuilder")
+ throwM (Git.BackendError "Could not create new treebuilder")
builder' <- peek pptr
bracket
(mk'git_treebuilder_filter_cb (callback builder'))
@@ -522,7 +521,7 @@
coid
fmode
when (r < 0) $
- failure (Git.BackendError "Could not insert entry in treebuilder")
+ throwM (Git.BackendError "Could not insert entry in treebuilder")
return 0
lgLookupTree :: MonadLg m => TreeOid -> ReaderT LgRepo m Tree
@@ -547,7 +546,7 @@
0o100644 -> return Git.PlainBlob
0o100755 -> return Git.ExecutableBlob
0o120000 -> return Git.SymlinkBlob
- _ -> failure $ Git.BackendError $
+ _ -> throwM $ Git.BackendError $
"Unknown blob mode: " <> T.pack (show mode)
| typ == c'GIT_OBJ_TREE ->
return $ Git.TreeEntry (Tagged (mkOid oid))
@@ -642,7 +641,7 @@
r1 <- c'git_odb_exists ptr coid 0
c'git_odb_free ptr
return (Just (r1 == 0))
- maybe (failure Git.RepositoryInvalid) return result
+ maybe (throwM Git.RepositoryInvalid) return result
lgForEachObject :: Ptr C'git_odb
-> (Ptr C'git_oid -> Ptr () -> IO CInt)
@@ -663,7 +662,7 @@
r <- withForeignPtr (repoObj repo) $ \repoPtr ->
c'git_revwalk_new pptr repoPtr
when (r < 0) $
- failure (Git.BackendError "Could not create revwalker")
+ throwM (Git.BackendError "Could not create revwalker")
ptr <- peek pptr
FC.newForeignPtr ptr (c'git_revwalk_free ptr)
@@ -673,7 +672,7 @@
liftIO $ withForeignPtr (getOid oid) $ \coid -> do
r2 <- withForeignPtr walker $ flip c'git_revwalk_push coid
when (r2 < 0) $
- failure (Git.BackendError $ "Could not push oid "
+ throwM (Git.BackendError $ "Could not push oid "
<> pack (show oid) <> " onto revwalker")
case mhave of
@@ -681,7 +680,7 @@
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 "
+ throwM (Git.BackendError $ "Could not hide commit "
<> pack (show (untag have)) <> " from revwalker")
liftIO $ withForeignPtr walker $ flip c'git_revwalk_sorting
@@ -831,7 +830,7 @@
else do
ref <- peek ptr
c'git_reference_delete ref
- when (r < 0) $ failure (Git.ReferenceDeleteFailed name)
+ when (r < 0) $ throwM (Git.ReferenceDeleteFailed name)
-- int git_reference_packall(git_repository *repo)
@@ -957,7 +956,7 @@
--compareRef = c'git_reference_cmp
-lgThrow :: (MonadIO m, Failure e m) => (Text -> e) -> m ()
+lgThrow :: (Exception e, MonadIO m, MonadThrow m) => (Text -> e) -> m ()
lgThrow f = do
errStr <- liftIO $ do
errPtr <- c'giterr_last
@@ -966,7 +965,7 @@
else do
err <- peek errPtr
peekCString (c'git_error'message err)
- failure (f (pack errStr))
+ throwM (f (pack errStr))
-- withLgTempRepo :: MonadLg m => ReaderT LgRepo m a -> m a
-- withLgTempRepo f = withTempDir $ \dir -> do
@@ -1048,13 +1047,13 @@
-- (Either Git.SHA ByteString)) m
-- (Git.TreeFilePath, Either Git.SHA ByteString)
handlePath (Right _) =
- lift $ failure $ Git.DiffTreeToIndexFailed
+ lift $ throwM $ Git.DiffTreeToIndexFailed
"Received a Right value when a Left RawFilePath was expected"
handlePath (Left path) = do
mcontent <- await
case mcontent of
Nothing ->
- lift $ failure $ Git.DiffTreeToIndexFailed $
+ lift $ throwM $ Git.DiffTreeToIndexFailed $
"Content not provided for " <> T.pack (show path)
Just x -> handleContent path x
@@ -1064,11 +1063,11 @@
-- (Either Git.SHA ByteString)) m
-- (Git.TreeFilePath, Either Git.SHA ByteString)
handleContent _path (Left _) =
- lift $ failure $ Git.DiffTreeToIndexFailed
+ lift $ throwM $ Git.DiffTreeToIndexFailed
"Received a Left value when a Right ByteString was expected"
handleContent path (Right content) = return (path, content)
- -- diffBlob :: Failure Git.GitException m
+ -- diffBlob :: MonadThrow m
-- => Git.TreeFilePath
-- -> Maybe (Either Git.SHA ByteString)
-- -> Maybe (ForeignPtr C'git_oid)
@@ -1183,8 +1182,8 @@
B.cons (fromIntegral lineOrigin) bs
return 0
-checkResult :: (Eq a, Num a, Failure Git.GitException m) => a -> Text -> m ()
-checkResult r why = when (r /= 0) $ failure (Git.BackendError why)
+checkResult :: (Eq a, Num a, MonadThrow m) => a -> Text -> m ()
+checkResult r why = when (r /= 0) $ throwM (Git.BackendError why)
lgBuildPackFile :: MonadLg m
=> FilePath -> [Either CommitOid TreeOid]
@@ -1353,7 +1352,7 @@
lgLoadPackFileInMemory
:: (MonadBaseControl IO m, MonadIO m, MonadLogger m,
- Failure Git.GitException m)
+ MonadThrow m)
=> FilePath
-> Ptr (Ptr C'git_odb_backend)
-> Ptr (Ptr C'git_odb)
@@ -1385,7 +1384,7 @@
return odbPtr
lgOpenPackFile :: (MonadBaseControl IO m, MonadIO m, MonadLogger m,
- Failure Git.GitException m)
+ MonadThrow m)
=> FilePath -> m (Ptr C'git_odb)
lgOpenPackFile idxPath = control $ \run ->
alloca $ \odbPtrPtr ->
@@ -1393,17 +1392,17 @@
lgLoadPackFileInMemory idxPath backendPtrPtr odbPtrPtr
lgClosePackFile :: (MonadBaseControl IO m, MonadIO m, MonadLogger m,
- Failure Git.GitException m)
+ MonadThrow m)
=> Ptr C'git_odb -> m ()
lgClosePackFile = liftIO . c'git_odb_free
lgWithPackFile :: (MonadBaseControl IO m, MonadIO m, MonadLogger m,
- Failure Git.GitException m)
+ MonadThrow m)
=> FilePath -> (Ptr C'git_odb -> m a) -> m a
lgWithPackFile idxPath = bracket (lgOpenPackFile idxPath) lgClosePackFile
lgReadFromPack :: (MonadBaseControl IO m, MonadIO m, MonadLogger m,
- Failure Git.GitException m)
+ MonadThrow m)
=> Ptr C'git_odb -> Git.SHA -> Bool
-> m (Maybe (C'git_otype, CSize, ByteString))
lgReadFromPack odbPtr sha metadataOnly = liftIO $ do
diff -ru orig/gitlib-libgit2.cabal new/gitlib-libgit2.cabal
--- orig/gitlib-libgit2.cabal 2014-04-06 09:02:46.527789820 +0300
+++ new/gitlib-libgit2.cabal 2014-04-06 09:02:46.000000000 +0300
@@ -42,7 +42,6 @@
, conduit >= 0.5.5
, containers >= 0.4.2.1
, directory >= 1.1.0.2
- , failure >= 0.2.0.1
, fast-logger
, filepath >= 1.3.0
, lifted-async >= 0.1.0
Reference in a new issue View git blame Copy permalink