git.iko.soy/stackage
on 62064dc help sign in
stackage/patching/patches/gitlib-libgit2-3.0.1.patch
280 lines 12 kB history raw
1diff -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
22 -- lgLookupObject :: Text -> LgRepository Dynamic
23 -- lgLookupObject str
24diff -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 @@
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
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)
47 -- Types.hs
48diff -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 @@
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
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)
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
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
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)
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")
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")
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)
170 -- int git_reference_packall(git_repository *repo)
172@@ -957,7 +956,7 @@
174 --compareRef = c'git_reference_cmp
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))
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
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)
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
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)
229 lgBuildPackFile :: MonadLg m
230 => FilePath -> [Either CommitOid TreeOid]
231@@ -1353,7 +1352,7 @@
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
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
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
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
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
270diff -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