on master help sign in
New gitlib patches
commit44be73a24b70334a9c3f5b7565f47aa893083261 authorMichael Snoyman <michael@snoyman.com> dateSun 6 Apr 2014, 09:02 (13 years ago) parent59ab7c4
8 files changed+591−95
patching/patches/gitlib-3.0.0.patch−22 patching/patches/gitlib-3.0.2.patch+191 patching/patches/gitlib-cmdline-3.0.0.patch−12 patching/patches/gitlib-cmdline-3.0.1.patch+40 patching/patches/gitlib-libgit2-3.0.0.patch−30 patching/patches/gitlib-libgit2-3.0.1.patch+280 patching/patches/gitlib-s3-3.0.1.patch → patching/patches/gitlib-s3-3.0.2.patch+78−29 patching/patches/gitlib-test-3.0.0.patch → patching/patches/gitlib-test-3.0.1.patch+2−2
patching/patches/gitlib-3.0.0.patchdeleted−22
@@ -1,22 +0,0 @@
1−diff -ru orig/Git/Repository.hs new/Git/Repository.hs
2−--- orig/Git/Repository.hs 2014-04-03 09:46:22.102281090 +0300
3−+++ new/Git/Repository.hs 2014-04-03 09:46:21.000000000 +0300
4−@@ -3,6 +3,7 @@
5− import Control.Exception.Lifted
6− import Control.Monad
7− import Control.Monad.IO.Class
8−+import Control.Monad.Trans.Control (MonadBaseControl)
9− import Data.Conduit
10− import Git.Types
11− import System.Directory
12−diff -ru orig/gitlib.cabal new/gitlib.cabal
13−--- orig/gitlib.cabal 2014-04-03 09:46:22.102281090 +0300
14−+++ new/gitlib.cabal 2014-04-03 09:46:21.000000000 +0300
15−@@ -43,6 +43,7 @@
16− , base16-bytestring >= 0.1.1.5
17− , bytestring >= 0.9.2.1
18− , conduit >= 1.0.0
19−+ , conduit-extra >= 1.0.0
20− , containers >= 0.4.2.1
21− , directory >= 1.1.0.2
22− , failure >= 0.2.0.1
patching/patches/gitlib-3.0.2.patchnew file+191
@@ -0,0 +1,191 @@
1+diff -ru orig/Git/Commit/Push.hs new/Git/Commit/Push.hs
2+--- orig/Git/Commit/Push.hs 2014-04-06 09:02:45.571789820 +0300
3++++ new/Git/Commit/Push.hs 2014-04-06 09:02:45.000000000 +0300
4+@@ -1,11 +1,11 @@
5+ module Git.Commit.Push where
6+
7+ import Control.Applicative
8+-import Control.Failure
9+ import Control.Monad
10+ import Control.Monad.IO.Class
11+ import Control.Monad.Trans.Class
12+ import Control.Monad.Trans.Control
13++import Control.Monad.Trans.Resource
14+ import Data.Function
15+ import qualified Data.HashSet as HashSet
16+ import Data.List
17+@@ -33,14 +33,14 @@
18+ mrref' <- for mrref $ \rref ->
19+ if rref `elem` commits
20+ then lift $ copyCommitOid rref
21+- else failure $ PushNotFastForward
22++ else throwM $ PushNotFastForward
23+ $ "SHA " <> renderObjOid rref
24+ <> " not found in remote"
25+ objs <- lift $ listAllObjects mrref' coid
26+ let shas = HashSet.fromList $ map (renderOid . untagObjOid) objs
27+ (cref,_) <- copyCommit coid Nothing shas
28+ unless (renderObjOid coid == renderObjOid cref) $
29+- failure $ BackendError $ "Error copying commit: "
30++ throwM $ BackendError $ "Error copying commit: "
31+ <> renderObjOid coid <> " /= " <> renderObjOid cref
32+ -- jww (2013-04-18): This is something the user must decide to do
33+ -- updateReference_ remoteRefName (RefObj cref)
34+@@ -79,6 +79,6 @@
35+
36+ mref <- fmap renderOid <$> resolveReference refName
37+ unless (maybe False (renderObjOid coid ==) mref) $
38+- failure (BackendError $
39++ throwM (BackendError $
40+ "Could not resolve destination reference '"
41+ <> refName <> "'in project")
42+diff -ru orig/Git/Commit.hs new/Git/Commit.hs
43+--- orig/Git/Commit.hs 2014-04-06 09:02:45.571789820 +0300
44++++ new/Git/Commit.hs 2014-04-06 09:02:45.000000000 +0300
45+@@ -1,8 +1,8 @@
46+ module Git.Commit where
47+
48+-import Control.Failure
49+ import Control.Monad
50+ import Control.Monad.Trans.Class
51++import Control.Monad.Trans.Resource
52+ import Data.Conduit
53+ import qualified Data.Conduit.List as CL
54+ import Data.Function
55+@@ -41,7 +41,7 @@
56+ (parentRefs,needed') <- foldM copyParent ([],needed) parents
57+ (tr,needed'') <- copyTree (commitTree commit) needed'
58+ unless (renderObjOid (commitTree commit) == renderObjOid tr) $
59+- failure $ BackendError $ "Error copying tree: "
60++ throwM $ BackendError $ "Error copying tree: "
61+ <> renderObjOid (commitTree commit)
62+ <> " /= " <> renderObjOid tr
63+
64+@@ -60,7 +60,7 @@
65+ copyParent (prefs,needed') cref = do
66+ (cref2,needed'') <- copyCommit cref Nothing needed'
67+ unless (renderObjOid cref == renderObjOid cref2) $
68+- failure $ BackendError $ "Error copying commit: "
69++ throwM $ BackendError $ "Error copying commit: "
70+ <> renderObjOid cref <> " /= " <> renderObjOid cref2
71+ let x = cref2 `seq` (cref2:prefs)
72+ return $ x `seq` needed'' `seq` (x,needed'')
73+diff -ru orig/Git/Repository.hs new/Git/Repository.hs
74+--- orig/Git/Repository.hs 2014-04-06 09:02:45.571789820 +0300
75++++ new/Git/Repository.hs 2014-04-06 09:02:45.000000000 +0300
76+@@ -6,6 +6,7 @@
77+ import Data.Conduit
78+ import Git.Types
79+ import System.Directory
80++import Control.Monad.Trans.Control (MonadBaseControl)
81+
82+ withNewRepository :: (MonadGit r n, MonadBaseControl IO n, MonadIO m)
83+ => RepositoryFactory n m r
84+diff -ru orig/Git/Tree/Builder.hs new/Git/Tree/Builder.hs
85+--- orig/Git/Tree/Builder.hs 2014-04-06 09:02:45.571789820 +0300
86++++ new/Git/Tree/Builder.hs 2014-04-06 09:02:45.000000000 +0300
87+@@ -25,12 +25,12 @@
88+ ) where
89+
90+ import Control.Applicative
91+-import Control.Failure
92+ import Control.Monad
93+ import Control.Monad.Fix
94+ import Control.Monad.Logger
95+ import Control.Monad.IO.Class
96+ import Control.Monad.Trans.Class
97++import Control.Monad.Trans.Resource
98+ import Control.Monad.Trans.State
99+ import qualified Data.ByteString as B
100+ import Data.Char
101+@@ -143,9 +143,9 @@
102+
103+ update bm _ _ (Right Nothing) = return (bm, TreeEntryNotFound)
104+ update _ _ _ (Right (Just BlobEntry {})) =
105+- failure TreeCannotTraverseBlob
106++ throwM TreeCannotTraverseBlob
107+ update _ _ _ (Right (Just CommitEntry {})) =
108+- failure TreeCannotTraverseCommit
109++ throwM TreeCannotTraverseCommit
110+
111+ update bm name names arg = do
112+ sbm <- case arg of
113+diff -ru orig/Git/Tree.hs new/Git/Tree.hs
114+--- orig/Git/Tree.hs 2014-04-06 09:02:45.571789820 +0300
115++++ new/Git/Tree.hs 2014-04-06 09:02:45.000000000 +0300
116+@@ -1,8 +1,8 @@
117+ module Git.Tree where
118+
119+-import Control.Failure
120+ import Control.Monad
121+ import Control.Monad.Trans.Class
122++import Control.Monad.Trans.Resource
123+ import Data.Conduit
124+ import qualified Data.Conduit.List as CL
125+ import Data.HashSet (HashSet)
126+@@ -22,7 +22,7 @@
127+ copyTreeEntry (BlobEntry oid kind) needed = do
128+ (b,needed') <- copyBlob oid needed
129+ unless (renderObjOid oid == renderObjOid b) $
130+- failure $ BackendError $ "Error copying blob: "
131++ throwM $ BackendError $ "Error copying blob: "
132+ <> renderObjOid oid <> " /= " <> renderObjOid b
133+ return (BlobEntry b kind, needed')
134+ copyTreeEntry (CommitEntry oid) needed = do
135+diff -ru orig/Git/Types.hs new/Git/Types.hs
136+--- orig/Git/Types.hs 2014-04-06 09:02:45.571789820 +0300
137++++ new/Git/Types.hs 2014-04-06 09:02:45.000000000 +0300
138+@@ -2,9 +2,9 @@
139+
140+ import Control.Applicative
141+ import qualified Control.Exception.Lifted as Exc
142+-import Control.Failure
143+ import Control.Monad
144+ import Control.Monad.Trans.Class
145++import Control.Monad.Trans.Resource
146+ import Data.ByteString (ByteString)
147+ import qualified Data.ByteString.Base16 as B16
148+ import qualified Data.ByteString.Lazy as BL
149+@@ -35,7 +35,7 @@
150+
151+ -- | 'Repository' is the central point of contact between user code and Git
152+ -- data objects. Every object must belong to some repository.
153+-class (Applicative m, Monad m, Failure GitException m,
154++class (Applicative m, Monad m, MonadThrow m,
155+ IsOid (Oid r), Show (Oid r), Eq (Oid r), Ord (Oid r))
156+ => MonadGit r m | m -> r where
157+ type Oid r :: *
158+diff -ru orig/Git/Working.hs new/Git/Working.hs
159+--- orig/Git/Working.hs 2014-04-06 09:02:45.571789820 +0300
160++++ new/Git/Working.hs 2014-04-06 09:02:45.000000000 +0300
161+@@ -3,7 +3,6 @@
162+ module Git.Working where
163+
164+ import Control.Applicative
165+-import Control.Failure
166+ import Control.Monad.IO.Class
167+ import Control.Monad.Trans.Resource
168+ import Data.Conduit
169+@@ -39,7 +38,7 @@
170+ | cloneSubmodules -> cloneSubmodule oid fullPath
171+ | otherwise -> liftIO $ createDirectory fullPath
172+ where
173+- decodeError path e = failure $ PathEncodingError $
174++ decodeError path e = throwM $ PathEncodingError $
175+ "Could not decode path " <> T.pack (show path) <> ":" <> T.pack e
176+
177+ checkoutBlob oid kind fullPath = do
178+diff -ru orig/gitlib.cabal new/gitlib.cabal
179+--- orig/gitlib.cabal 2014-04-06 09:02:45.575789820 +0300
180++++ new/gitlib.cabal 2014-04-06 09:02:45.000000000 +0300
181+@@ -43,9 +43,9 @@
182+ , base16-bytestring >= 0.1.1.5
183+ , bytestring >= 0.9.2.1
184+ , conduit >= 1.0.0
185++ , conduit-extra >= 1.0.0
186+ , containers >= 0.4.2.1
187+ , directory >= 1.1.0.2
188+- , failure >= 0.2.0.1
189+ , filepath >= 1.3.0.0
190+ , hashable >= 1.1.2.5
191+ , lifted-base >= 0.2
patching/patches/gitlib-cmdline-3.0.0.patchdeleted−12
@@ -1,12 +0,0 @@
1−diff -ru orig/Git/CmdLine.hs new/Git/CmdLine.hs
2−--- orig/Git/CmdLine.hs 2014-04-04 10:18:25.564401057 +0300
3−+++ new/Git/CmdLine.hs 2014-04-04 10:18:25.000000000 +0300
4−@@ -24,7 +24,7 @@
5− import Control.Monad.Trans.Class
6− import Control.Monad.Trans.Reader (ReaderT, runReaderT)
7− import qualified Data.ByteString as B
8−-import Data.Conduit hiding (MonadBaseControl)
9−+import Data.Conduit
10− import qualified Data.Conduit.List as CL
11− import Data.Foldable (for_)
12− import Data.Function
patching/patches/gitlib-cmdline-3.0.1.patchnew file+40
@@ -0,0 +1,40 @@
1+diff -ru orig/Git/CmdLine.hs new/Git/CmdLine.hs
2+--- orig/Git/CmdLine.hs 2014-04-06 09:02:46.027789820 +0300
3++++ new/Git/CmdLine.hs 2014-04-06 09:02:45.000000000 +0300
4+@@ -23,6 +23,7 @@
5+ import Control.Monad.Reader.Class
6+ import Control.Monad.Trans.Class
7+ import Control.Monad.Trans.Reader (ReaderT, runReaderT)
8++import Control.Monad.Trans.Resource (MonadThrow (..))
9+ import qualified Data.ByteString as B
10+ import Data.Conduit hiding (MonadBaseControl)
11+ import qualified Data.Conduit.List as CL
12+@@ -88,7 +89,7 @@
13+ -- instance HasCliRepo (env, CliRepo) where
14+ -- getCliRepo = snd
15+
16+-instance (Applicative m, Failure GitException m, MonadIO m)
17++instance (Applicative m, Failure GitException m, MonadIO m, MonadThrow m)
18+ => MonadGit CliRepo (ReaderT CliRepo m) where
19+ type Oid CliRepo = SHA
20+ data Tree CliRepo = CmdLineTree (TreeOid CliRepo)
21+@@ -127,7 +128,7 @@
22+
23+ diffContentsWithTree = error "Not defined cliDiffContentsWithTree"
24+
25+-type MonadCli m = (Applicative m, Failure GitException m, MonadIO m)
26++type MonadCli m = (Applicative m, Failure GitException m, MonadIO m, MonadThrow m)
27+
28+ mkOid :: MonadCli m => forall o. TL.Text -> ReaderT CliRepo m (Tagged o SHA)
29+ mkOid = fmap Tagged <$> textToSha . toStrict
30+diff -ru orig/gitlib-cmdline.cabal new/gitlib-cmdline.cabal
31+--- orig/gitlib-cmdline.cabal 2014-04-06 09:02:46.031789820 +0300
32++++ new/gitlib-cmdline.cabal 2014-04-06 09:02:45.000000000 +0300
33+@@ -39,6 +39,7 @@
34+ , transformers >= 0.2.2
35+ , transformers-base >= 0.4.1
36+ , unordered-containers >= 0.2.3.0
37++ , resourcet
38+ exposed-modules:
39+ Git.CmdLine
40+
patching/patches/gitlib-libgit2-3.0.0.patchdeleted−30
@@ -1,30 +0,0 @@
1−diff -ru orig/Git/Libgit2.hs new/Git/Libgit2.hs
2−--- orig/Git/Libgit2.hs 2014-04-03 19:25:38.109541281 +0300
3−+++ new/Git/Libgit2.hs 2014-04-03 19:25:37.000000000 +0300
4−@@ -1341,7 +1341,7 @@
5−
6− lgLoadPackFileInMemory
7− :: (MonadBaseControl IO m, MonadIO m, Failure Git.GitException m,
8−- MonadUnsafeIO m, MonadThrow m, MonadLogger m)
9−+ MonadThrow m, MonadLogger m)
10− => FilePath
11− -> Ptr (Ptr C'git_odb_backend)
12− -> Ptr (Ptr C'git_odb)
13−@@ -1373,7 +1373,7 @@
14− return odbPtr
15−
16− lgWithPackFile :: (MonadBaseControl IO m, MonadIO m, Failure Git.GitException m,
17−- MonadUnsafeIO m, MonadThrow m, MonadLogger m)
18−+ MonadThrow m, MonadLogger m)
19− => FilePath -> (Ptr C'git_odb -> ResourceT m a) -> m a
20− lgWithPackFile idxPath f = control $ \run ->
21− alloca $ \odbPtrPtr ->
22−@@ -1381,7 +1381,7 @@
23− f =<< lgLoadPackFileInMemory idxPath backendPtrPtr odbPtrPtr
24−
25− lgReadFromPack :: (MonadBaseControl IO m, MonadIO m, Failure Git.GitException m,
26−- MonadUnsafeIO m, MonadThrow m, MonadLogger m)
27−+ MonadThrow m, MonadLogger m)
28− => FilePath -> Git.SHA -> Bool
29− -> m (Maybe (C'git_otype, CSize, ByteString))
30− lgReadFromPack idxPath sha metadataOnly =
patching/patches/gitlib-libgit2-3.0.1.patchnew file+280
@@ -0,0 +1,280 @@
1+diff -ru orig/Git/Libgit2/Internal.hs new/Git/Libgit2/Internal.hs
2+--- orig/Git/Libgit2/Internal.hs 2014-04-06 09:02:46.523789820 +0300
3++++ new/Git/Libgit2/Internal.hs 2014-04-06 09:02:46.000000000 +0300
4+@@ -8,9 +8,9 @@
5+
6+ import Bindings.Libgit2
7+ import Control.Applicative
8+-import Control.Failure
9+ import Control.Monad
10+ import Control.Monad.Trans.Control
11++import Control.Monad.Trans.Resource
12+ import Data.ByteString
13+ import qualified Data.Text as T
14+ import qualified Data.Text.ICU.Convert as U
15+@@ -85,7 +85,7 @@
16+ let p = castPtr ptr'
17+ fptr <- FC.newForeignPtr p (c'git_object_free p)
18+ run $ Right <$> createFn coidCopy (castForeignPtr fptr) ptr'
19+- either (failure . Git.BackendError) return result
20++ either (throwM . Git.BackendError) return result
21+
22+ -- lgLookupObject :: Text -> LgRepository Dynamic
23+ -- lgLookupObject str
24+diff -ru orig/Git/Libgit2/Types.hs new/Git/Libgit2/Types.hs
25+--- orig/Git/Libgit2/Types.hs 2014-04-06 09:02:46.523789820 +0300
26++++ new/Git/Libgit2/Types.hs 2014-04-06 09:02:46.000000000 +0300
27+@@ -10,10 +10,10 @@
28+
29+ import Bindings.Libgit2
30+ import Control.Applicative
31+-import Control.Failure
32+ import Control.Monad.IO.Class
33+ import Control.Monad.Logger
34+ import Control.Monad.Trans.Control
35++import Control.Monad.Trans.Resource
36+ import Data.IORef
37+ import Foreign.ForeignPtr
38+ import qualified Git
39+@@ -52,7 +52,7 @@
40+ type TreeBuilder = Git.TreeBuilder LgRepo
41+ type Options = Git.Options LgRepo
42+
43+-type MonadLg m = (Applicative m, Failure Git.GitException m,
44++type MonadLg m = (Applicative m, MonadThrow m,
45+ MonadIO m, MonadBaseControl IO m, MonadLogger m)
46+
47+ -- Types.hs
48+diff -ru orig/Git/Libgit2.hs new/Git/Libgit2.hs
49+--- orig/Git/Libgit2.hs 2014-04-06 09:02:46.523789820 +0300
50++++ new/Git/Libgit2.hs 2014-04-06 09:02:46.000000000 +0300
51+@@ -60,7 +60,6 @@
52+ import Control.Concurrent.Async.Lifted
53+ import Control.Concurrent.STM
54+ import Control.Exception.Lifted
55+-import Control.Failure
56+ import Control.Monad hiding (forM, forM_, mapM, mapM_, sequence)
57+ import Control.Monad.IO.Class
58+ import Control.Monad.Logger
59+@@ -154,11 +153,11 @@
60+
61+ lgParseOid :: MonadLg m => Text -> m Oid
62+ lgParseOid str
63+- | len > 40 = failure (Git.OidParseFailed str)
64++ | len > 40 = throwM (Git.OidParseFailed str)
65+ | otherwise = do
66+ moid <- liftIO $ lgParseOidIO str len
67+ case moid of
68+- Nothing -> failure (Git.OidParseFailed str)
69++ Nothing -> throwM (Git.OidParseFailed str)
70+ Just oid -> return oid
71+ where
72+ len = T.length str
73+@@ -179,7 +178,7 @@
74+ instance Eq OidPtr where
75+ oid1 == oid2 = oid1 `compare` oid2 == EQ
76+
77+-instance (Applicative m, Failure Git.GitException m,
78++instance (Applicative m, MonadThrow m,
79+ MonadBaseControl IO m, MonadIO m, MonadLogger m)
80+ => Git.MonadGit LgRepo (ReaderT LgRepo m) where
81+ type Oid LgRepo = OidPtr
82+@@ -427,7 +426,7 @@
83+ return $ Just fptr
84+ case mfptr of
85+ Nothing ->
86+- failure (Git.TreeCreateFailed "Failed to create new tree builder")
87++ throwM (Git.TreeCreateFailed "Failed to create new tree builder")
88+ Just fptr -> do
89+ toid <- mapM Git.treeOid mtree
90+ return (lgMakeBuilder fptr) { Git.mtbBaseTreeOid = toid }
91+@@ -441,7 +440,7 @@
92+ withFilePath key $ \name ->
93+ c'git_treebuilder_insert nullPtr ptr name coid
94+ (fromIntegral mode)
95+- when (r2 < 0) $ failure (Git.TreeBuilderInsertFailed key)
96++ when (r2 < 0) $ throwM (Git.TreeBuilderInsertFailed key)
97+
98+ treeEntryToOid :: TreeEntry -> (Oid, CUInt)
99+ treeEntryToOid (Git.BlobEntry oid kind) =
100+@@ -503,7 +502,7 @@
101+ liftIO $ withForeignPtr fptr $ \builder -> alloca $ \pptr -> do
102+ r <- c'git_treebuilder_create pptr nullPtr
103+ when (r < 0) $
104+- failure (Git.BackendError "Could not create new treebuilder")
105++ throwM (Git.BackendError "Could not create new treebuilder")
106+ builder' <- peek pptr
107+ bracket
108+ (mk'git_treebuilder_filter_cb (callback builder'))
109+@@ -522,7 +521,7 @@
110+ coid
111+ fmode
112+ when (r < 0) $
113+- failure (Git.BackendError "Could not insert entry in treebuilder")
114++ throwM (Git.BackendError "Could not insert entry in treebuilder")
115+ return 0
116+
117+ lgLookupTree :: MonadLg m => TreeOid -> ReaderT LgRepo m Tree
118+@@ -547,7 +546,7 @@
119+ 0o100644 -> return Git.PlainBlob
120+ 0o100755 -> return Git.ExecutableBlob
121+ 0o120000 -> return Git.SymlinkBlob
122+- _ -> failure $ Git.BackendError $
123++ _ -> throwM $ Git.BackendError $
124+ "Unknown blob mode: " <> T.pack (show mode)
125+ | typ == c'GIT_OBJ_TREE ->
126+ return $ Git.TreeEntry (Tagged (mkOid oid))
127+@@ -642,7 +641,7 @@
128+ r1 <- c'git_odb_exists ptr coid 0
129+ c'git_odb_free ptr
130+ return (Just (r1 == 0))
131+- maybe (failure Git.RepositoryInvalid) return result
132++ maybe (throwM Git.RepositoryInvalid) return result
133+
134+ lgForEachObject :: Ptr C'git_odb
135+ -> (Ptr C'git_oid -> Ptr () -> IO CInt)
136+@@ -663,7 +662,7 @@
137+ r <- withForeignPtr (repoObj repo) $ \repoPtr ->
138+ c'git_revwalk_new pptr repoPtr
139+ when (r < 0) $
140+- failure (Git.BackendError "Could not create revwalker")
141++ throwM (Git.BackendError "Could not create revwalker")
142+ ptr <- peek pptr
143+ FC.newForeignPtr ptr (c'git_revwalk_free ptr)
144+
145+@@ -673,7 +672,7 @@
146+ liftIO $ withForeignPtr (getOid oid) $ \coid -> do
147+ r2 <- withForeignPtr walker $ flip c'git_revwalk_push coid
148+ when (r2 < 0) $
149+- failure (Git.BackendError $ "Could not push oid "
150++ throwM (Git.BackendError $ "Could not push oid "
151+ <> pack (show oid) <> " onto revwalker")
152+
153+ case mhave of
154+@@ -681,7 +680,7 @@
155+ Just have -> liftIO $ withForeignPtr (getOid (untag have)) $ \coid -> do
156+ r2 <- withForeignPtr walker $ flip c'git_revwalk_hide coid
157+ when (r2 < 0) $
158+- failure (Git.BackendError $ "Could not hide commit "
159++ throwM (Git.BackendError $ "Could not hide commit "
160+ <> pack (show (untag have)) <> " from revwalker")
161+
162+ liftIO $ withForeignPtr walker $ flip c'git_revwalk_sorting
163+@@ -831,7 +830,7 @@
164+ else do
165+ ref <- peek ptr
166+ c'git_reference_delete ref
167+- when (r < 0) $ failure (Git.ReferenceDeleteFailed name)
168++ when (r < 0) $ throwM (Git.ReferenceDeleteFailed name)
169+
170+ -- int git_reference_packall(git_repository *repo)
171+
172+@@ -957,7 +956,7 @@
173+
174+ --compareRef = c'git_reference_cmp
175+
176+-lgThrow :: (MonadIO m, Failure e m) => (Text -> e) -> m ()
177++lgThrow :: (Exception e, MonadIO m, MonadThrow m) => (Text -> e) -> m ()
178+ lgThrow f = do
179+ errStr <- liftIO $ do
180+ errPtr <- c'giterr_last
181+@@ -966,7 +965,7 @@
182+ else do
183+ err <- peek errPtr
184+ peekCString (c'git_error'message err)
185+- failure (f (pack errStr))
186++ throwM (f (pack errStr))
187+
188+ -- withLgTempRepo :: MonadLg m => ReaderT LgRepo m a -> m a
189+ -- withLgTempRepo f = withTempDir $ \dir -> do
190+@@ -1048,13 +1047,13 @@
191+ -- (Either Git.SHA ByteString)) m
192+ -- (Git.TreeFilePath, Either Git.SHA ByteString)
193+ handlePath (Right _) =
194+- lift $ failure $ Git.DiffTreeToIndexFailed
195++ lift $ throwM $ Git.DiffTreeToIndexFailed
196+ "Received a Right value when a Left RawFilePath was expected"
197+ handlePath (Left path) = do
198+ mcontent <- await
199+ case mcontent of
200+ Nothing ->
201+- lift $ failure $ Git.DiffTreeToIndexFailed $
202++ lift $ throwM $ Git.DiffTreeToIndexFailed $
203+ "Content not provided for " <> T.pack (show path)
204+ Just x -> handleContent path x
205+
206+@@ -1064,11 +1063,11 @@
207+ -- (Either Git.SHA ByteString)) m
208+ -- (Git.TreeFilePath, Either Git.SHA ByteString)
209+ handleContent _path (Left _) =
210+- lift $ failure $ Git.DiffTreeToIndexFailed
211++ lift $ throwM $ Git.DiffTreeToIndexFailed
212+ "Received a Left value when a Right ByteString was expected"
213+ handleContent path (Right content) = return (path, content)
214+
215+- -- diffBlob :: Failure Git.GitException m
216++ -- diffBlob :: MonadThrow m
217+ -- => Git.TreeFilePath
218+ -- -> Maybe (Either Git.SHA ByteString)
219+ -- -> Maybe (ForeignPtr C'git_oid)
220+@@ -1183,8 +1182,8 @@
221+ B.cons (fromIntegral lineOrigin) bs
222+ return 0
223+
224+-checkResult :: (Eq a, Num a, Failure Git.GitException m) => a -> Text -> m ()
225+-checkResult r why = when (r /= 0) $ failure (Git.BackendError why)
226++checkResult :: (Eq a, Num a, MonadThrow m) => a -> Text -> m ()
227++checkResult r why = when (r /= 0) $ throwM (Git.BackendError why)
228+
229+ lgBuildPackFile :: MonadLg m
230+ => FilePath -> [Either CommitOid TreeOid]
231+@@ -1353,7 +1352,7 @@
232+
233+ lgLoadPackFileInMemory
234+ :: (MonadBaseControl IO m, MonadIO m, MonadLogger m,
235+- Failure Git.GitException m)
236++ MonadThrow m)
237+ => FilePath
238+ -> Ptr (Ptr C'git_odb_backend)
239+ -> Ptr (Ptr C'git_odb)
240+@@ -1385,7 +1384,7 @@
241+ return odbPtr
242+
243+ lgOpenPackFile :: (MonadBaseControl IO m, MonadIO m, MonadLogger m,
244+- Failure Git.GitException m)
245++ MonadThrow m)
246+ => FilePath -> m (Ptr C'git_odb)
247+ lgOpenPackFile idxPath = control $ \run ->
248+ alloca $ \odbPtrPtr ->
249+@@ -1393,17 +1392,17 @@
250+ lgLoadPackFileInMemory idxPath backendPtrPtr odbPtrPtr
251+
252+ lgClosePackFile :: (MonadBaseControl IO m, MonadIO m, MonadLogger m,
253+- Failure Git.GitException m)
254++ MonadThrow m)
255+ => Ptr C'git_odb -> m ()
256+ lgClosePackFile = liftIO . c'git_odb_free
257+
258+ lgWithPackFile :: (MonadBaseControl IO m, MonadIO m, MonadLogger m,
259+- Failure Git.GitException m)
260++ MonadThrow m)
261+ => FilePath -> (Ptr C'git_odb -> m a) -> m a
262+ lgWithPackFile idxPath = bracket (lgOpenPackFile idxPath) lgClosePackFile
263+
264+ lgReadFromPack :: (MonadBaseControl IO m, MonadIO m, MonadLogger m,
265+- Failure Git.GitException m)
266++ MonadThrow m)
267+ => Ptr C'git_odb -> Git.SHA -> Bool
268+ -> m (Maybe (C'git_otype, CSize, ByteString))
269+ lgReadFromPack odbPtr sha metadataOnly = liftIO $ do
270+diff -ru orig/gitlib-libgit2.cabal new/gitlib-libgit2.cabal
271+--- orig/gitlib-libgit2.cabal 2014-04-06 09:02:46.527789820 +0300
272++++ new/gitlib-libgit2.cabal 2014-04-06 09:02:46.000000000 +0300
273+@@ -42,7 +42,6 @@
274+ , conduit >= 0.5.5
275+ , containers >= 0.4.2.1
276+ , directory >= 1.1.0.2
277+- , failure >= 0.2.0.1
278+ , fast-logger
279+ , filepath >= 1.3.0
280+ , lifted-async >= 0.1.0
patching/patches/gitlib-s3-3.0.1.patch → patching/patches/gitlib-s3-3.0.2.patchrenamed+78−29
@@ -1,7 +1,24 @@
11diff -ru orig/Git/S3.hs new/Git/S3.hs
2−--- orig/Git/S3.hs 2014-04-04 10:00:47.080423588 +0300
3−+++ new/Git/S3.hs 2014-04-04 10:00:46.000000000 +0300
4−@@ -467,7 +467,10 @@
2+--- orig/Git/S3.hs 2014-04-06 09:02:47.247789820 +0300
3++++ new/Git/S3.hs 2014-04-06 09:02:47.000000000 +0300
4+@@ -42,7 +42,6 @@
5+ import Control.Monad.Trans.Resource
6+ import Control.Retry
7+ import Data.Aeson as A
8+-import Data.Attempt
9+ import Data.Bifunctor
10+ import Data.Binary as Bin
11+ import Data.ByteString (ByteString)
12+@@ -141,7 +140,7 @@
13+ }
14+ deriving (Eq, Show, Generic)
15+
16+-type MonadS3 m = (Failure Git.GitException m,
17++type MonadS3 m = (MonadThrow m,
18+ MonadIO m, MonadBaseControl IO m, MonadLogger m)
19+
20+ data BackendCallbacks = BackendCallbacks
21+@@ -478,7 +477,10 @@
522 -> ResourceT m (Response (ResponseMetadata a) a)
623 awsRetry cfg svcfg mgr r =
724 transResourceT liftIO $
@@ -13,7 +30,16 @@ diff -ru orig/Git/S3.hs new/Git/S3.hs
1330
1431 listBucketS3 :: MonadS3 m => OdbS3Details -> ResourceT m [Text]
1532 listBucketS3 dets = do
16−@@ -623,7 +626,7 @@
33+@@ -622,7 +624,7 @@
34+ sha <- oidToSha oid
35+ modifyIORef mshas (sha:)
36+ return c'GIT_OK
37+- checkResult r "lgForEachObject failed"
38++ either throwM return $ checkResult r "lgForEachObject failed"
39+
40+ -- Update the known objects map with the fact that we've got a local cache
41+ -- of the pack file.
42+@@ -637,7 +639,7 @@
1743 ++ show (Prelude.length shas) ++ " objects"
1844 return shas
1945
@@ -22,7 +48,7 @@ diff -ru orig/Git/S3.hs new/Git/S3.hs
2248 => OdbS3Details -> Text -> FilePath -> m [SHA]
2349 catalogPackFile dets packSha idxPath = do
2450 -- Load the pack file, and iterate over the objects within it to determine
25−@@ -687,7 +690,7 @@
51+@@ -710,7 +712,7 @@
2652 lgDebug $ "cacheUpdateEntry " ++ show (shaToText sha) ++ " " ++ show ce
2753 liftIO $ atomically $ modifyTVar (knownObjects dets) $ M.insert sha ce
2854
@@ -31,7 +57,7 @@ diff -ru orig/Git/S3.hs new/Git/S3.hs
3157 => OdbS3Details -> SHA -> CacheEntry -> Bool
3258 -> m (Maybe ObjectInfo)
3359 cacheLoadObject dets sha ce metadataOnly = do
34−@@ -931,7 +934,7 @@
60+@@ -958,7 +960,7 @@
3561 remoteStoreObject _ _ _ =
3662 throw (Git.BackendError "remoteStoreObject was not given any data")
3763
@@ -40,7 +66,7 @@ diff -ru orig/Git/S3.hs new/Git/S3.hs
4066 => OdbS3Details -> ResourceT m ()
4167 remoteCatalogContents dets = do
4268 lgDebug "remoteCatalogContents"
43−@@ -955,7 +958,7 @@
69+@@ -982,7 +984,7 @@
4470
4571 | otherwise -> return ()
4672
@@ -49,7 +75,7 @@ diff -ru orig/Git/S3.hs new/Git/S3.hs
4975 => OdbS3Details -> SHA -> Bool -> m (Maybe CacheEntry)
5076 accessObject dets sha checkRemote = do
5177 mentry <- cacheLookupEntry dets sha
52−@@ -1000,19 +1003,19 @@
78+@@ -1032,19 +1034,19 @@
5379 -- cache and with the callback interface. This is to avoid recataloging
5480 -- in the future.
5581
@@ -72,7 +98,7 @@ diff -ru orig/Git/S3.hs new/Git/S3.hs
7298 => OdbS3Details -> SHA -> m (Maybe ObjectInfo)
7399 readObjectMetadata dets sha = readObject dets sha True
74100
75−@@ -1022,7 +1025,7 @@
101+@@ -1054,7 +1056,7 @@
76102 callbackRegisterObject dets sha info
77103 cacheStoreObject dets sha info
78104
@@ -81,7 +107,7 @@ diff -ru orig/Git/S3.hs new/Git/S3.hs
81107 => OdbS3Details -> BL.ByteString -> m ()
82108 writePackFile dets bytes = do
83109 let dir = tempDirectory dets
84−@@ -1041,7 +1044,7 @@
110+@@ -1073,7 +1075,7 @@
85111 shas <- catalogPackFile dets packSha idxPath
86112 callbackRegisterPackFile dets packSha shas
87113
@@ -90,7 +116,7 @@ diff -ru orig/Git/S3.hs new/Git/S3.hs
90116 => Ptr (Ptr ())
91117 -> Ptr CSize
92118 -> Ptr C'git_otype
93−@@ -1072,7 +1075,7 @@
119+@@ -1104,7 +1106,7 @@
94120 BU.unsafeUseAsCString chunk $ copyBytes p ?? len
95121 return $ p `plusPtr` len
96122
@@ -99,7 +125,7 @@ diff -ru orig/Git/S3.hs new/Git/S3.hs
99125 => Ptr C'git_oid
100126 -> Ptr (Ptr ())
101127 -> Ptr CSize
102−@@ -1108,7 +1111,7 @@
128+@@ -1140,7 +1142,7 @@
103129 go dets sha False
104130 | otherwise = return Nothing
105131
@@ -108,7 +134,7 @@ diff -ru orig/Git/S3.hs new/Git/S3.hs
108134 => Ptr CSize
109135 -> Ptr C'git_otype
110136 -> Ptr C'git_odb_backend
111−@@ -1126,7 +1129,7 @@
137+@@ -1158,7 +1160,7 @@
112138 poke len_p (toLength len)
113139 poke type_p (toType typ)
114140
@@ -117,7 +143,7 @@ diff -ru orig/Git/S3.hs new/Git/S3.hs
117143 => Ptr C'git_oid
118144 -> Ptr C'git_odb_backend
119145 -> Ptr ()
120−@@ -1152,7 +1155,7 @@
146+@@ -1184,7 +1186,7 @@
121147 (ObjectInfo (fromLength len) (fromType obj_type)
122148 Nothing (Just (BL.fromChunks [bytes])))
123149
@@ -126,7 +152,7 @@ diff -ru orig/Git/S3.hs new/Git/S3.hs
126152 => Ptr C'git_odb_backend -> Ptr C'git_oid -> CInt -> m CInt
127153 existsCallback be oid confirmNotExists = do
128154 (dets, sha) <- liftIO $ unpackDetails be oid
129−@@ -1162,18 +1165,18 @@
155+@@ -1194,18 +1196,18 @@
130156 return $ if ce == DoesNotExist then 0 else 1)
131157 (return c'GIT_ERROR)
132158
@@ -148,7 +174,7 @@ diff -ru orig/Git/S3.hs new/Git/S3.hs
148174 => Ptr (Ptr C'git_odb_writepack)
149175 -> Ptr C'git_odb_backend
150176 -> C'git_transfer_progress_callback
151−@@ -1214,7 +1217,7 @@
177+@@ -1248,7 +1250,7 @@
152178 foreign import ccall "&freeCallback"
153179 freeCallbackPtr :: FunPtr F'git_odb_backend_free_callback
154180
@@ -157,7 +183,7 @@ diff -ru orig/Git/S3.hs new/Git/S3.hs
157183 => Ptr C'git_odb_writepack
158184 -> Ptr ()
159185 -> CSize
160−@@ -1233,7 +1236,7 @@
186+@@ -1267,7 +1269,7 @@
161187 (castPtr dataPtr) (fromIntegral len)
162188 writePackFile dets (BL.fromChunks [bytes])
163189
@@ -166,7 +192,7 @@ diff -ru orig/Git/S3.hs new/Git/S3.hs
166192 => Ptr C'git_odb_writepack -> Ptr C'git_transfer_progress
167193 -> m CInt
168194 packCommitCallback _wp _progress =
169−@@ -1346,7 +1349,7 @@
195+@@ -1380,7 +1382,7 @@
170196 liftIO $ writeIORef result res
171197 readIORef result
172198
@@ -175,7 +201,7 @@ diff -ru orig/Git/S3.hs new/Git/S3.hs
175201 => Aws.S3Configuration NormalQuery
176202 -> Configuration
177203 -> Manager
178−@@ -1439,7 +1442,7 @@
204+@@ -1475,7 +1477,7 @@
179205
180206 -- | Given a repository object obtained from Libgit2, add an S3 backend to it,
181207 -- 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
184210 => LgRepo
185211 -> Text -- ^ bucket
186212 -> Text -- ^ prefix
187−@@ -1469,7 +1472,7 @@
213+@@ -1505,7 +1507,7 @@
188214 void $ liftIO $ odbBackendAdd repo odbS3 100
189215 return repo
190216
@@ -193,7 +219,7 @@ diff -ru orig/Git/S3.hs new/Git/S3.hs
193219 => Maybe Text -> Text -> Text -> FilePath -> BackendCallbacks
194220 -> Git.RepositoryFactory (ReaderT LgRepo (NoLoggingT m)) m LgRepo
195221 s3Factory bucket accessKey secretKey dir callbacks = lgFactory
196−@@ -1492,7 +1495,7 @@
222+@@ -1528,7 +1530,7 @@
197223 dir
198224 callbacks
199225
@@ -203,9 +229,23 @@ diff -ru orig/Git/S3.hs new/Git/S3.hs
203229 -> Git.RepositoryFactory (ReaderT LgRepo m) m LgRepo
204230 s3FactoryLogger bucket accessKey secretKey dir callbacks = lgFactoryLogger
205231diff -ru orig/gitlib-s3.cabal new/gitlib-s3.cabal
206−--- orig/gitlib-s3.cabal 2014-04-04 10:00:47.084423588 +0300
207−+++ new/gitlib-s3.cabal 2014-04-04 10:00:46.000000000 +0300
208−@@ -58,6 +58,7 @@
232+--- orig/gitlib-s3.cabal 2014-04-06 09:02:47.247789820 +0300
233++++ new/gitlib-s3.cabal 2014-04-06 09:02:47.000000000 +0300
234+@@ -33,7 +33,6 @@
235+ , hspec-expectations >= 0.3
236+ , data-default >= 0.5.1
237+ , directory >= 1.1.0.2
238+- , failure >= 0.2.0.1
239+ , filepath >= 1.3.0
240+ , monad-logger >= 0.3.1.1
241+ , resourcet >= 0.4.6
242+@@ -52,12 +51,12 @@
243+ , ghc-prim
244+ , hlibgit2 >= 0.18.0.11
245+ , aeson >= 0.6.1.0
246+- , attempt >= 0.4.0
247+ , aws >= 0.7.5
248+ , bifunctors >= 3.2.0.1
209249 , binary >= 0.5.1.0
210250 , bytestring >= 0.9.2.1
211251 , conduit >= 0.5.5
@@ -214,14 +254,23 @@ diff -ru orig/gitlib-s3.cabal new/gitlib-s3.cabal
214254 , directory >= 1.1.0.2
215255 , filepath >= 1.3.0
216256diff -ru orig/test/Smoke.hs new/test/Smoke.hs
217−--- orig/test/Smoke.hs 2014-04-04 10:00:47.080423588 +0300
218−+++ new/test/Smoke.hs 2014-04-04 10:00:46.000000000 +0300
219−@@ -31,7 +31,7 @@
257+--- orig/test/Smoke.hs 2014-04-06 09:02:47.247789820 +0300
258++++ new/test/Smoke.hs 2014-04-06 09:02:47.000000000 +0300
259+@@ -11,7 +11,6 @@
260+
261+ import Aws
262+ import Control.Applicative
263+-import Control.Failure
264+ import Control.Monad.IO.Class
265+ import Control.Monad.Logger
266+ import Control.Monad.Trans.Reader
267+@@ -30,8 +29,7 @@
268+ import Test.Hspec.Runner
220269
221270 s3Factory
222− :: (Failure Git.GitException m, MonadIO m, MonadBaseControl IO m,
271+- :: (Failure Git.GitException m, MonadIO m, MonadBaseControl IO m,
223272- MonadUnsafeIO m, MonadThrow m)
224−+ MonadThrow m)
273++ :: (MonadThrow m, MonadIO m, MonadBaseControl IO m)
225274 => Git.RepositoryFactory (ReaderT Lg.LgRepo (NoLoggingT m)) m Lg.LgRepo
226275 s3Factory = Lg.lgFactory
227276 { Git.runRepository = \ctxt m ->
patching/patches/gitlib-test-3.0.0.patch → patching/patches/gitlib-test-3.0.1.patchrenamed+2−2
@@ -1,6 +1,6 @@
11diff -ru orig/gitlib-test.cabal new/gitlib-test.cabal
2−--- orig/gitlib-test.cabal 2014-04-04 06:49:19.204668116 +0300
3−+++ new/gitlib-test.cabal 2014-04-04 06:49:19.000000000 +0300
2+--- orig/gitlib-test.cabal 2014-04-06 09:02:47.671789820 +0300
3++++ new/gitlib-test.cabal 2014-04-06 09:02:47.000000000 +0300
44@@ -28,6 +28,7 @@
55 , bytestring
66 , failure >= 0.2.0