From 44be73a24b70334a9c3f5b7565f47aa893083261 Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Sun, 6 Apr 2014 09:02:57 +0300 Subject: [PATCH] New gitlib patches --- 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 ++++++++++++++++++ ...b-s3-3.0.1.patch => gitlib-s3-3.0.2.patch} | 107 +++++-- ...st-3.0.0.patch => gitlib-test-3.0.1.patch} | 4 +- 8 files changed, 591 insertions(+), 95 deletions(-) delete mode 100644 patching/patches/gitlib-3.0.0.patch create mode 100644 patching/patches/gitlib-3.0.2.patch delete mode 100644 patching/patches/gitlib-cmdline-3.0.0.patch create mode 100644 patching/patches/gitlib-cmdline-3.0.1.patch delete mode 100644 patching/patches/gitlib-libgit2-3.0.0.patch create mode 100644 patching/patches/gitlib-libgit2-3.0.1.patch rename patching/patches/{gitlib-s3-3.0.1.patch => gitlib-s3-3.0.2.patch} (76%) rename patching/patches/{gitlib-test-3.0.0.patch => gitlib-test-3.0.1.patch} (70%) diff --git a/patching/patches/gitlib-3.0.0.patch b/patching/patches/gitlib-3.0.0.patch deleted file mode 100644 index be51848e..00000000 --- a/patching/patches/gitlib-3.0.0.patch +++ /dev/null @@ -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 diff --git a/patching/patches/gitlib-3.0.2.patch b/patching/patches/gitlib-3.0.2.patch new file mode 100644 index 00000000..1e6f8f71 --- /dev/null +++ b/patching/patches/gitlib-3.0.2.patch @@ -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 diff --git a/patching/patches/gitlib-cmdline-3.0.0.patch b/patching/patches/gitlib-cmdline-3.0.0.patch deleted file mode 100644 index adbef905..00000000 --- a/patching/patches/gitlib-cmdline-3.0.0.patch +++ /dev/null @@ -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 diff --git a/patching/patches/gitlib-cmdline-3.0.1.patch b/patching/patches/gitlib-cmdline-3.0.1.patch new file mode 100644 index 00000000..4dc4b16e --- /dev/null +++ b/patching/patches/gitlib-cmdline-3.0.1.patch @@ -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 + diff --git a/patching/patches/gitlib-libgit2-3.0.0.patch b/patching/patches/gitlib-libgit2-3.0.0.patch deleted file mode 100644 index 40ee1f08..00000000 --- a/patching/patches/gitlib-libgit2-3.0.0.patch +++ /dev/null @@ -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 = diff --git a/patching/patches/gitlib-libgit2-3.0.1.patch b/patching/patches/gitlib-libgit2-3.0.1.patch new file mode 100644 index 00000000..2dc8376a --- /dev/null +++ b/patching/patches/gitlib-libgit2-3.0.1.patch @@ -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 diff --git a/patching/patches/gitlib-s3-3.0.1.patch b/patching/patches/gitlib-s3-3.0.2.patch similarity index 76% rename from patching/patches/gitlib-s3-3.0.1.patch rename to patching/patches/gitlib-s3-3.0.2.patch index 1b1c09a7..26aedd9f 100644 --- a/patching/patches/gitlib-s3-3.0.1.patch +++ b/patching/patches/gitlib-s3-3.0.2.patch @@ -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 -> diff --git a/patching/patches/gitlib-test-3.0.0.patch b/patching/patches/gitlib-test-3.0.1.patch similarity index 70% rename from patching/patches/gitlib-test-3.0.0.patch rename to patching/patches/gitlib-test-3.0.1.patch index 41bc42d1..e825eb66 100644 --- a/patching/patches/gitlib-test-3.0.0.patch +++ b/patching/patches/gitlib-test-3.0.1.patch @@ -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