git.iko.soy/stackage
on 2adf607 help sign in
stackage/patching/patches/gitlib-3.0.2.patch
191 lines 7.9 kB history raw
1diff -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 @@
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")
42diff -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
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
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'')
73diff -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)
82 withNewRepository :: (MonadGit r n, MonadBaseControl IO n, MonadIO m)
83 => RepositoryFactory n m r
84diff -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
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 @@
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
111 update bm name names arg = do
112 sbm <- case arg of
113diff -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
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
135diff -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 @@
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 @@
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 :: *
158diff -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
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
177 checkoutBlob oid kind fullPath = do
178diff -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