haskell/stackage
1
0
Fork 0
mirror of https://github.com/commercialhaskell/stackage.git synced 2026-01-12 15:28:29 +01:00
Code Issues Actions 1 Packages Projects Releases Wiki Activity
b8ad29ef08
stackage/patching/patches/gitlib-3.0.2.patch
Michael Snoyman 44be73a24b New gitlib patches
2014-04-06 09:02:57 +03:00

192 lines
7.7 KiB
Diff
Raw Blame History

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
Reference in New Issue View Git Blame Copy Permalink