haskell/stackage
1
0
Fork 0
mirror of https://github.com/commercialhaskell/stackage.git synced 2026-01-17 09:48:31 +01:00
Code Issues Actions 1 Packages Projects Releases Wiki Activity

New gitlib patches

Browse Source
This commit is contained in:
Michael Snoyman 2014-04-06 09:02:57 +03:00
parent 59ab7c4d50
commit 44be73a24b
8 changed files with 591 additions and 95 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
patching/patches/gitlib-3.0.0.patch
View File

@ -1,22 +0,0 @@
diff -ru orig/Git/Repository.hs new/Git/Repository.hs
--- orig/Git/Repository.hs 2014-04-03 09:46:22.102281090 +0300
+++ new/Git/Repository.hs 2014-04-03 09:46:21.000000000 +0300
@@ -3,6 +3,7 @@
import Control.Exception.Lifted
import Control.Monad
import Control.Monad.IO.Class
+import Control.Monad.Trans.Control (MonadBaseControl)
import Data.Conduit
import Git.Types
import System.Directory
diff -ru orig/gitlib.cabal new/gitlib.cabal
--- orig/gitlib.cabal 2014-04-03 09:46:22.102281090 +0300
+++ new/gitlib.cabal 2014-04-03 09:46:21.000000000 +0300
@@ -43,6 +43,7 @@
, base16-bytestring >= 0.1.1.5
, bytestring >= 0.9.2.1
, conduit >= 1.0.0
+ , conduit-extra >= 1.0.0
, containers >= 0.4.2.1
, directory >= 1.1.0.2
, failure >= 0.2.0.1

191
patching/patches/gitlib-3.0.2.patch Normal file
View File

@ -0,0 +1,191 @@
diff -ru orig/Git/Commit/Push.hs new/Git/Commit/Push.hs
--- orig/Git/Commit/Push.hs 2014-04-06 09:02:45.571789820 +0300
+++ new/Git/Commit/Push.hs 2014-04-06 09:02:45.000000000 +0300
@@ -1,11 +1,11 @@
module Git.Commit.Push where
import Control.Applicative
-import Control.Failure
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Trans.Class
import Control.Monad.Trans.Control
+import Control.Monad.Trans.Resource
import Data.Function
import qualified Data.HashSet as HashSet
import Data.List
@@ -33,14 +33,14 @@
mrref' <- for mrref $ \rref ->
if rref `elem` commits
then lift $ copyCommitOid rref
- else failure $ PushNotFastForward
+ else throwM $ PushNotFastForward
$ "SHA " <> renderObjOid rref
<> " not found in remote"
objs <- lift $ listAllObjects mrref' coid
let shas = HashSet.fromList $ map (renderOid . untagObjOid) objs
(cref,_) <- copyCommit coid Nothing shas
unless (renderObjOid coid == renderObjOid cref) $
- failure $ BackendError $ "Error copying commit: "
+ throwM $ BackendError $ "Error copying commit: "
<> renderObjOid coid <> " /= " <> renderObjOid cref
-- jww (2013-04-18): This is something the user must decide to do
-- updateReference_ remoteRefName (RefObj cref)
@@ -79,6 +79,6 @@
mref <- fmap renderOid <$> resolveReference refName
unless (maybe False (renderObjOid coid ==) mref) $
- failure (BackendError $
+ throwM (BackendError $
"Could not resolve destination reference '"
<> refName <> "'in project")
diff -ru orig/Git/Commit.hs new/Git/Commit.hs
--- orig/Git/Commit.hs 2014-04-06 09:02:45.571789820 +0300
+++ new/Git/Commit.hs 2014-04-06 09:02:45.000000000 +0300
@@ -1,8 +1,8 @@
module Git.Commit where
-import Control.Failure
import Control.Monad
import Control.Monad.Trans.Class
+import Control.Monad.Trans.Resource
import Data.Conduit
import qualified Data.Conduit.List as CL
import Data.Function
@@ -41,7 +41,7 @@
(parentRefs,needed') <- foldM copyParent ([],needed) parents
(tr,needed'') <- copyTree (commitTree commit) needed'
unless (renderObjOid (commitTree commit) == renderObjOid tr) $
- failure $ BackendError $ "Error copying tree: "
+ throwM $ BackendError $ "Error copying tree: "
<> renderObjOid (commitTree commit)
<> " /= " <> renderObjOid tr
@@ -60,7 +60,7 @@
copyParent (prefs,needed') cref = do
(cref2,needed'') <- copyCommit cref Nothing needed'
unless (renderObjOid cref == renderObjOid cref2) $
- failure $ BackendError $ "Error copying commit: "
+ throwM $ BackendError $ "Error copying commit: "
<> renderObjOid cref <> " /= " <> renderObjOid cref2
let x = cref2 `seq` (cref2:prefs)
return $ x `seq` needed'' `seq` (x,needed'')
diff -ru orig/Git/Repository.hs new/Git/Repository.hs
--- orig/Git/Repository.hs 2014-04-06 09:02:45.571789820 +0300
+++ new/Git/Repository.hs 2014-04-06 09:02:45.000000000 +0300
@@ -6,6 +6,7 @@
import Data.Conduit
import Git.Types
import System.Directory
+import Control.Monad.Trans.Control (MonadBaseControl)
withNewRepository :: (MonadGit r n, MonadBaseControl IO n, MonadIO m)
=> RepositoryFactory n m r
diff -ru orig/Git/Tree/Builder.hs new/Git/Tree/Builder.hs
--- orig/Git/Tree/Builder.hs 2014-04-06 09:02:45.571789820 +0300
+++ new/Git/Tree/Builder.hs 2014-04-06 09:02:45.000000000 +0300
@@ -25,12 +25,12 @@
) where
import Control.Applicative
-import Control.Failure
import Control.Monad
import Control.Monad.Fix
import Control.Monad.Logger
import Control.Monad.IO.Class
import Control.Monad.Trans.Class
+import Control.Monad.Trans.Resource
import Control.Monad.Trans.State
import qualified Data.ByteString as B
import Data.Char
@@ -143,9 +143,9 @@
update bm _ _ (Right Nothing) = return (bm, TreeEntryNotFound)
update _ _ _ (Right (Just BlobEntry {})) =
- failure TreeCannotTraverseBlob
+ throwM TreeCannotTraverseBlob
update _ _ _ (Right (Just CommitEntry {})) =
- failure TreeCannotTraverseCommit
+ throwM TreeCannotTraverseCommit
update bm name names arg = do
sbm <- case arg of
diff -ru orig/Git/Tree.hs new/Git/Tree.hs
--- orig/Git/Tree.hs 2014-04-06 09:02:45.571789820 +0300
+++ new/Git/Tree.hs 2014-04-06 09:02:45.000000000 +0300
@@ -1,8 +1,8 @@
module Git.Tree where
-import Control.Failure
import Control.Monad
import Control.Monad.Trans.Class
+import Control.Monad.Trans.Resource
import Data.Conduit
import qualified Data.Conduit.List as CL
import Data.HashSet (HashSet)
@@ -22,7 +22,7 @@
copyTreeEntry (BlobEntry oid kind) needed = do
(b,needed') <- copyBlob oid needed
unless (renderObjOid oid == renderObjOid b) $
- failure $ BackendError $ "Error copying blob: "
+ throwM $ BackendError $ "Error copying blob: "
<> renderObjOid oid <> " /= " <> renderObjOid b
return (BlobEntry b kind, needed')
copyTreeEntry (CommitEntry oid) needed = do
diff -ru orig/Git/Types.hs new/Git/Types.hs
--- orig/Git/Types.hs 2014-04-06 09:02:45.571789820 +0300
+++ new/Git/Types.hs 2014-04-06 09:02:45.000000000 +0300
@@ -2,9 +2,9 @@
import Control.Applicative
import qualified Control.Exception.Lifted as Exc
-import Control.Failure
import Control.Monad
import Control.Monad.Trans.Class
+import Control.Monad.Trans.Resource
import Data.ByteString (ByteString)
import qualified Data.ByteString.Base16 as B16
import qualified Data.ByteString.Lazy as BL
@@ -35,7 +35,7 @@
-- | 'Repository' is the central point of contact between user code and Git
-- data objects. Every object must belong to some repository.
-class (Applicative m, Monad m, Failure GitException m,
+class (Applicative m, Monad m, MonadThrow m,
IsOid (Oid r), Show (Oid r), Eq (Oid r), Ord (Oid r))
=> MonadGit r m | m -> r where
type Oid r :: *
diff -ru orig/Git/Working.hs new/Git/Working.hs
--- orig/Git/Working.hs 2014-04-06 09:02:45.571789820 +0300
+++ new/Git/Working.hs 2014-04-06 09:02:45.000000000 +0300
@@ -3,7 +3,6 @@
module Git.Working where
import Control.Applicative
-import Control.Failure
import Control.Monad.IO.Class
import Control.Monad.Trans.Resource
import Data.Conduit
@@ -39,7 +38,7 @@
| cloneSubmodules -> cloneSubmodule oid fullPath
| otherwise -> liftIO $ createDirectory fullPath
where
- decodeError path e = failure $ PathEncodingError $
+ decodeError path e = throwM $ PathEncodingError $
"Could not decode path " <> T.pack (show path) <> ":" <> T.pack e
checkoutBlob oid kind fullPath = do
diff -ru orig/gitlib.cabal new/gitlib.cabal
--- orig/gitlib.cabal 2014-04-06 09:02:45.575789820 +0300
+++ new/gitlib.cabal 2014-04-06 09:02:45.000000000 +0300
@@ -43,9 +43,9 @@
, base16-bytestring >= 0.1.1.5
, bytestring >= 0.9.2.1
, conduit >= 1.0.0
+ , conduit-extra >= 1.0.0
, containers >= 0.4.2.1
, directory >= 1.1.0.2
- , failure >= 0.2.0.1
, filepath >= 1.3.0.0
, hashable >= 1.1.2.5
, lifted-base >= 0.2

12
patching/patches/gitlib-cmdline-3.0.0.patch
View File

@ -1,12 +0,0 @@
diff -ru orig/Git/CmdLine.hs new/Git/CmdLine.hs
--- orig/Git/CmdLine.hs 2014-04-04 10:18:25.564401057 +0300
+++ new/Git/CmdLine.hs 2014-04-04 10:18:25.000000000 +0300
@@ -24,7 +24,7 @@
import Control.Monad.Trans.Class
import Control.Monad.Trans.Reader (ReaderT, runReaderT)
import qualified Data.ByteString as B
-import Data.Conduit hiding (MonadBaseControl)
+import Data.Conduit
import qualified Data.Conduit.List as CL
import Data.Foldable (for_)
import Data.Function

40
patching/patches/gitlib-cmdline-3.0.1.patch Normal file
View File

@ -0,0 +1,40 @@
diff -ru orig/Git/CmdLine.hs new/Git/CmdLine.hs
--- orig/Git/CmdLine.hs 2014-04-06 09:02:46.027789820 +0300
+++ new/Git/CmdLine.hs 2014-04-06 09:02:45.000000000 +0300
@@ -23,6 +23,7 @@
import Control.Monad.Reader.Class
import Control.Monad.Trans.Class
import Control.Monad.Trans.Reader (ReaderT, runReaderT)
+import Control.Monad.Trans.Resource (MonadThrow (..))
import qualified Data.ByteString as B
import Data.Conduit hiding (MonadBaseControl)
import qualified Data.Conduit.List as CL
@@ -88,7 +89,7 @@
-- instance HasCliRepo (env, CliRepo) where
-- getCliRepo = snd
-instance (Applicative m, Failure GitException m, MonadIO m)
+instance (Applicative m, Failure GitException m, MonadIO m, MonadThrow m)
=> MonadGit CliRepo (ReaderT CliRepo m) where
type Oid CliRepo = SHA
data Tree CliRepo = CmdLineTree (TreeOid CliRepo)
@@ -127,7 +128,7 @@
diffContentsWithTree = error "Not defined cliDiffContentsWithTree"
-type MonadCli m = (Applicative m, Failure GitException m, MonadIO m)
+type MonadCli m = (Applicative m, Failure GitException m, MonadIO m, MonadThrow m)
mkOid :: MonadCli m => forall o. TL.Text -> ReaderT CliRepo m (Tagged o SHA)
mkOid = fmap Tagged <$> textToSha . toStrict
diff -ru orig/gitlib-cmdline.cabal new/gitlib-cmdline.cabal
--- orig/gitlib-cmdline.cabal 2014-04-06 09:02:46.031789820 +0300
+++ new/gitlib-cmdline.cabal 2014-04-06 09:02:45.000000000 +0300
@@ -39,6 +39,7 @@
, transformers >= 0.2.2
, transformers-base >= 0.4.1
, unordered-containers >= 0.2.3.0
+ , resourcet
exposed-modules:
Git.CmdLine

30
patching/patches/gitlib-libgit2-3.0.0.patch
View File

@ -1,30 +0,0 @@
diff -ru orig/Git/Libgit2.hs new/Git/Libgit2.hs
--- orig/Git/Libgit2.hs 2014-04-03 19:25:38.109541281 +0300
+++ new/Git/Libgit2.hs 2014-04-03 19:25:37.000000000 +0300
@@ -1341,7 +1341,7 @@
lgLoadPackFileInMemory
:: (MonadBaseControl IO m, MonadIO m, Failure Git.GitException m,
- MonadUnsafeIO m, MonadThrow m, MonadLogger m)
+ MonadThrow m, MonadLogger m)
=> FilePath
-> Ptr (Ptr C'git_odb_backend)
-> Ptr (Ptr C'git_odb)
@@ -1373,7 +1373,7 @@
return odbPtr
lgWithPackFile :: (MonadBaseControl IO m, MonadIO m, Failure Git.GitException m,
- MonadUnsafeIO m, MonadThrow m, MonadLogger m)
+ MonadThrow m, MonadLogger m)
=> FilePath -> (Ptr C'git_odb -> ResourceT m a) -> m a
lgWithPackFile idxPath f = control $ \run ->
alloca $ \odbPtrPtr ->
@@ -1381,7 +1381,7 @@
f =<< lgLoadPackFileInMemory idxPath backendPtrPtr odbPtrPtr
lgReadFromPack :: (MonadBaseControl IO m, MonadIO m, Failure Git.GitException m,
- MonadUnsafeIO m, MonadThrow m, MonadLogger m)
+ MonadThrow m, MonadLogger m)
=> FilePath -> Git.SHA -> Bool
-> m (Maybe (C'git_otype, CSize, ByteString))
lgReadFromPack idxPath sha metadataOnly =

280
patching/patches/gitlib-libgit2-3.0.1.patch Normal file
View File

@ -0,0 +1,280 @@
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

107
patching/patches/gitlib-s3-3.0.1.patch → patching/patches/gitlib-s3-3.0.2.patch
View File

@ -1,7 +1,24 @@
diff -ru orig/Git/S3.hs new/Git/S3.hs
--- orig/Git/S3.hs 2014-04-04 10:00:47.080423588 +0300
+++ new/Git/S3.hs 2014-04-04 10:00:46.000000000 +0300
@@ -467,7 +467,10 @@
--- orig/Git/S3.hs 2014-04-06 09:02:47.247789820 +0300
+++ new/Git/S3.hs 2014-04-06 09:02:47.000000000 +0300
@@ -42,7 +42,6 @@
import Control.Monad.Trans.Resource
import Control.Retry
import Data.Aeson as A
-import Data.Attempt
import Data.Bifunctor
import Data.Binary as Bin
import Data.ByteString (ByteString)
@@ -141,7 +140,7 @@
}
deriving (Eq, Show, Generic)
-type MonadS3 m = (Failure Git.GitException m,
+type MonadS3 m = (MonadThrow m,
MonadIO m, MonadBaseControl IO m, MonadLogger m)
data BackendCallbacks = BackendCallbacks
@@ -478,7 +477,10 @@
-> ResourceT m (Response (ResponseMetadata a) a)
awsRetry cfg svcfg mgr r =
transResourceT liftIO $
@ -13,7 +30,16 @@ diff -ru orig/Git/S3.hs new/Git/S3.hs
listBucketS3 :: MonadS3 m => OdbS3Details -> ResourceT m [Text]
listBucketS3 dets = do
@@ -623,7 +626,7 @@
@@ -622,7 +624,7 @@
sha <- oidToSha oid
modifyIORef mshas (sha:)
return c'GIT_OK
- checkResult r "lgForEachObject failed"
+ either throwM return $ checkResult r "lgForEachObject failed"
-- Update the known objects map with the fact that we've got a local cache
-- of the pack file.
@@ -637,7 +639,7 @@
++ show (Prelude.length shas) ++ " objects"
return shas
@ -22,7 +48,7 @@ diff -ru orig/Git/S3.hs new/Git/S3.hs
=> OdbS3Details -> Text -> FilePath -> m [SHA]
catalogPackFile dets packSha idxPath = do
-- Load the pack file, and iterate over the objects within it to determine
@@ -687,7 +690,7 @@
@@ -710,7 +712,7 @@
lgDebug $ "cacheUpdateEntry " ++ show (shaToText sha) ++ " " ++ show ce
liftIO $ atomically $ modifyTVar (knownObjects dets) $ M.insert sha ce
@ -31,7 +57,7 @@ diff -ru orig/Git/S3.hs new/Git/S3.hs
=> OdbS3Details -> SHA -> CacheEntry -> Bool
-> m (Maybe ObjectInfo)
cacheLoadObject dets sha ce metadataOnly = do
@@ -931,7 +934,7 @@
@@ -958,7 +960,7 @@
remoteStoreObject _ _ _ =
throw (Git.BackendError "remoteStoreObject was not given any data")
@ -40,7 +66,7 @@ diff -ru orig/Git/S3.hs new/Git/S3.hs
=> OdbS3Details -> ResourceT m ()
remoteCatalogContents dets = do
lgDebug "remoteCatalogContents"
@@ -955,7 +958,7 @@
@@ -982,7 +984,7 @@
| otherwise -> return ()
@ -49,7 +75,7 @@ diff -ru orig/Git/S3.hs new/Git/S3.hs
=> OdbS3Details -> SHA -> Bool -> m (Maybe CacheEntry)
accessObject dets sha checkRemote = do
mentry <- cacheLookupEntry dets sha
@@ -1000,19 +1003,19 @@
@@ -1032,19 +1034,19 @@
-- cache and with the callback interface. This is to avoid recataloging
-- in the future.
@ -72,7 +98,7 @@ diff -ru orig/Git/S3.hs new/Git/S3.hs
=> OdbS3Details -> SHA -> m (Maybe ObjectInfo)
readObjectMetadata dets sha = readObject dets sha True
@@ -1022,7 +1025,7 @@
@@ -1054,7 +1056,7 @@
callbackRegisterObject dets sha info
cacheStoreObject dets sha info
@ -81,7 +107,7 @@ diff -ru orig/Git/S3.hs new/Git/S3.hs
=> OdbS3Details -> BL.ByteString -> m ()
writePackFile dets bytes = do
let dir = tempDirectory dets
@@ -1041,7 +1044,7 @@
@@ -1073,7 +1075,7 @@
shas <- catalogPackFile dets packSha idxPath
callbackRegisterPackFile dets packSha shas
@ -90,7 +116,7 @@ diff -ru orig/Git/S3.hs new/Git/S3.hs
=> Ptr (Ptr ())
-> Ptr CSize
-> Ptr C'git_otype
@@ -1072,7 +1075,7 @@
@@ -1104,7 +1106,7 @@
BU.unsafeUseAsCString chunk $ copyBytes p ?? len
return $ p `plusPtr` len
@ -99,7 +125,7 @@ diff -ru orig/Git/S3.hs new/Git/S3.hs
=> Ptr C'git_oid
-> Ptr (Ptr ())
-> Ptr CSize
@@ -1108,7 +1111,7 @@
@@ -1140,7 +1142,7 @@
go dets sha False
| otherwise = return Nothing
@ -108,7 +134,7 @@ diff -ru orig/Git/S3.hs new/Git/S3.hs
=> Ptr CSize
-> Ptr C'git_otype
-> Ptr C'git_odb_backend
@@ -1126,7 +1129,7 @@
@@ -1158,7 +1160,7 @@
poke len_p (toLength len)
poke type_p (toType typ)
@ -117,7 +143,7 @@ diff -ru orig/Git/S3.hs new/Git/S3.hs
=> Ptr C'git_oid
-> Ptr C'git_odb_backend
-> Ptr ()
@@ -1152,7 +1155,7 @@
@@ -1184,7 +1186,7 @@
(ObjectInfo (fromLength len) (fromType obj_type)
Nothing (Just (BL.fromChunks [bytes])))
@ -126,7 +152,7 @@ diff -ru orig/Git/S3.hs new/Git/S3.hs
=> Ptr C'git_odb_backend -> Ptr C'git_oid -> CInt -> m CInt
existsCallback be oid confirmNotExists = do
(dets, sha) <- liftIO $ unpackDetails be oid
@@ -1162,18 +1165,18 @@
@@ -1194,18 +1196,18 @@
return $ if ce == DoesNotExist then 0 else 1)
(return c'GIT_ERROR)
@ -148,7 +174,7 @@ diff -ru orig/Git/S3.hs new/Git/S3.hs
=> Ptr (Ptr C'git_odb_writepack)
-> Ptr C'git_odb_backend
-> C'git_transfer_progress_callback
@@ -1214,7 +1217,7 @@
@@ -1248,7 +1250,7 @@
foreign import ccall "&freeCallback"
freeCallbackPtr :: FunPtr F'git_odb_backend_free_callback
@ -157,7 +183,7 @@ diff -ru orig/Git/S3.hs new/Git/S3.hs
=> Ptr C'git_odb_writepack
-> Ptr ()
-> CSize
@@ -1233,7 +1236,7 @@
@@ -1267,7 +1269,7 @@
(castPtr dataPtr) (fromIntegral len)
writePackFile dets (BL.fromChunks [bytes])
@ -166,7 +192,7 @@ diff -ru orig/Git/S3.hs new/Git/S3.hs
=> Ptr C'git_odb_writepack -> Ptr C'git_transfer_progress
-> m CInt
packCommitCallback _wp _progress =
@@ -1346,7 +1349,7 @@
@@ -1380,7 +1382,7 @@
liftIO $ writeIORef result res
readIORef result
@ -175,7 +201,7 @@ diff -ru orig/Git/S3.hs new/Git/S3.hs
=> Aws.S3Configuration NormalQuery
-> Configuration
-> Manager
@@ -1439,7 +1442,7 @@
@@ -1475,7 +1477,7 @@
-- | Given a repository object obtained from Libgit2, add an S3 backend to it,
-- making it the primary store for objects associated with that repository.
@ -184,7 +210,7 @@ diff -ru orig/Git/S3.hs new/Git/S3.hs
=> LgRepo
-> Text -- ^ bucket
-> Text -- ^ prefix
@@ -1469,7 +1472,7 @@
@@ -1505,7 +1507,7 @@
void $ liftIO $ odbBackendAdd repo odbS3 100
return repo
@ -193,7 +219,7 @@ diff -ru orig/Git/S3.hs new/Git/S3.hs
=> Maybe Text -> Text -> Text -> FilePath -> BackendCallbacks
-> Git.RepositoryFactory (ReaderT LgRepo (NoLoggingT m)) m LgRepo
s3Factory bucket accessKey secretKey dir callbacks = lgFactory
@@ -1492,7 +1495,7 @@
@@ -1528,7 +1530,7 @@
dir
callbacks
@ -203,9 +229,23 @@ diff -ru orig/Git/S3.hs new/Git/S3.hs
-> Git.RepositoryFactory (ReaderT LgRepo m) m LgRepo
s3FactoryLogger bucket accessKey secretKey dir callbacks = lgFactoryLogger
diff -ru orig/gitlib-s3.cabal new/gitlib-s3.cabal
--- orig/gitlib-s3.cabal 2014-04-04 10:00:47.084423588 +0300
+++ new/gitlib-s3.cabal 2014-04-04 10:00:46.000000000 +0300
@@ -58,6 +58,7 @@
--- orig/gitlib-s3.cabal 2014-04-06 09:02:47.247789820 +0300
+++ new/gitlib-s3.cabal 2014-04-06 09:02:47.000000000 +0300
@@ -33,7 +33,6 @@
, hspec-expectations >= 0.3
, data-default >= 0.5.1
, directory >= 1.1.0.2
- , failure >= 0.2.0.1
, filepath >= 1.3.0
, monad-logger >= 0.3.1.1
, resourcet >= 0.4.6
@@ -52,12 +51,12 @@
, ghc-prim
, hlibgit2 >= 0.18.0.11
, aeson >= 0.6.1.0
- , attempt >= 0.4.0
, aws >= 0.7.5
, bifunctors >= 3.2.0.1
, binary >= 0.5.1.0
, bytestring >= 0.9.2.1
, conduit >= 0.5.5
@ -214,14 +254,23 @@ diff -ru orig/gitlib-s3.cabal new/gitlib-s3.cabal
, directory >= 1.1.0.2
, filepath >= 1.3.0
diff -ru orig/test/Smoke.hs new/test/Smoke.hs
--- orig/test/Smoke.hs 2014-04-04 10:00:47.080423588 +0300
+++ new/test/Smoke.hs 2014-04-04 10:00:46.000000000 +0300
@@ -31,7 +31,7 @@
--- orig/test/Smoke.hs 2014-04-06 09:02:47.247789820 +0300
+++ new/test/Smoke.hs 2014-04-06 09:02:47.000000000 +0300
@@ -11,7 +11,6 @@
import Aws
import Control.Applicative
-import Control.Failure
import Control.Monad.IO.Class
import Control.Monad.Logger
import Control.Monad.Trans.Reader
@@ -30,8 +29,7 @@
import Test.Hspec.Runner
s3Factory
:: (Failure Git.GitException m, MonadIO m, MonadBaseControl IO m,
- :: (Failure Git.GitException m, MonadIO m, MonadBaseControl IO m,
- MonadUnsafeIO m, MonadThrow m)
+ MonadThrow m)
+ :: (MonadThrow m, MonadIO m, MonadBaseControl IO m)
=> Git.RepositoryFactory (ReaderT Lg.LgRepo (NoLoggingT m)) m Lg.LgRepo
s3Factory = Lg.lgFactory
{ Git.runRepository = \ctxt m ->

4
patching/patches/gitlib-test-3.0.0.patch → patching/patches/gitlib-test-3.0.1.patch
View File

@ -1,6 +1,6 @@
diff -ru orig/gitlib-test.cabal new/gitlib-test.cabal
--- orig/gitlib-test.cabal 2014-04-04 06:49:19.204668116 +0300
+++ new/gitlib-test.cabal 2014-04-04 06:49:19.000000000 +0300
--- orig/gitlib-test.cabal 2014-04-06 09:02:47.671789820 +0300
+++ new/gitlib-test.cabal 2014-04-06 09:02:47.000000000 +0300
@@ -28,6 +28,7 @@
, bytestring
, failure >= 0.2.0