1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
|
From 2490fa65eeba52699a7c0e303aa5cb9b78c2b1cf Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Niklas=20Hamb=C3=BCchen?= <mail@nh2.me>
Date: Fri, 17 Apr 2020 20:49:23 +0200
Subject: [PATCH] Compile against GHC 8.8
---
Setup.hs | 15 ---------------
src/Darcs/Patch/Depends.hs | 2 +-
src/Darcs/Patch/Match.hs | 12 ++++++------
src/Darcs/Patch/PatchInfoAnd.hs | 2 +-
src/Darcs/Patch/Prim/V1/Apply.hs | 6 +++---
src/Darcs/Patch/Prim/V1/Commute.hs | 1 +
src/Darcs/Patch/ReadMonads.hs | 1 +
src/Darcs/Patch/V1/Commute.hs | 1 +
src/Darcs/Repository/Diff.hs | 2 +-
src/Darcs/Repository/Match.hs | 2 +-
src/Darcs/Util/Tree/Monad.hs | 4 ++--
12 files changed, 30 insertions(+), 42 deletions(-)
diff --git a/Setup.hs b/Setup.hs
index f5cc3e8..05caac4 100644
--- a/Setup.hs
+++ b/Setup.hs
@@ -75,21 +75,6 @@
postInst = \ _ flags pkg lbi ->
installManpage pkg lbi (fromFlag $ installVerbosity flags) NoCopyDest,
- sDistHook = \ pkg lbi hooks flags -> do
- let pkgVer = packageVersion pkg
- verb = fromFlag $ sDistVerbosity flags
- x <- versionPatches verb pkgVer
- y <- context verb
- rewriteFileEx silent "release/distributed-version" $ show x
- rewriteFileEx silent "release/distributed-context" $ show y
- putStrLn "about to hand over"
- let pkg' = pkg { library = sanity (library pkg) }
- sanity (Just lib) = Just $ lib { libBuildInfo = sanity' $ libBuildInfo lib }
- sanity _ = error "eh"
- sanity' bi = bi { otherModules = [ m | m <- otherModules bi, toFilePath m /= "Version" ] }
-
- sDistHook simpleUserHooks pkg' lbi hooks flags
- ,
postConf = \_ _ _ _ -> return () --- Usually this checked for external C
--- dependencies, but we already have performed such
--- check in the confHook
--- a/darcs.cabal 1970-01-01 01:00:01.000000000 +0100
+++ b/darcs.cabal 2020-04-18 10:26:07.605129733 +0200
@@ -1,6 +1,5 @@
Name: darcs
version: 2.14.2
-x-revision: 1
License: GPL-2
License-file: COPYING
Author: David Roundy <droundy@darcs.net>, <darcs-devel@darcs.net>
@@ -75,7 +74,7 @@
description: Use libcurl for HTTP support.
-- in future this could extend to any other external libraries,
--- e.g. libiconv
+-- e.g. libiconv
flag pkgconfig
description: Use pkgconfig to configure libcurl
default: False
@@ -113,7 +112,7 @@
-- ----------------------------------------------------------------------
custom-setup
- setup-depends: base >= 4.9 && < 4.13,
+ setup-depends: base >= 4.9 && <5,
Cabal >= 1.24,
process >= 1.2.3.0 && < 1.7,
filepath >= 1.4.1 && < 1.5.0.0,
@@ -381,7 +380,7 @@
else
build-depends: unix >= 2.7.1.0 && < 2.8
- build-depends: base >= 4.9 && < 4.13,
+ build-depends: base >= 4.9 && <5,
stm >= 2.1 && < 2.6,
binary >= 0.5 && < 0.10,
containers >= 0.5.6.2 && < 0.7,
@@ -402,19 +401,19 @@
tar >= 0.5 && < 0.6,
data-ordlist == 0.4.*,
attoparsec >= 0.13.0.1 && < 0.14,
- zip-archive >= 0.3 && < 0.5,
+ zip-archive >= 0.3 && <1,
async >= 2.0.2 && < 2.3,
- sandi >= 0.4 && < 0.6,
+ sandi >= 0.4 && <1,
unix-compat >= 0.4.2 && < 0.6,
bytestring >= 0.10.6 && < 0.11,
old-time >= 1.1.0.3 && < 1.2,
time >= 1.5.0.1 && < 1.10,
- text >= 1.2.1.3 && < 1.3,
+ text >= 1.2.1.3 && <2,
directory >= 1.2.6.2 && < 1.4,
process >= 1.2.3.0 && < 1.7,
array >= 0.5.1.0 && < 0.6,
random >= 1.1 && < 1.2,
- hashable >= 1.2.3.3 && < 1.3,
+ hashable >= 1.2.3.3 && <2,
mmap >= 0.5.9 && < 0.6,
zlib >= 0.6.1.2 && < 0.7.0.0,
network-uri == 2.6.*,
@@ -443,7 +442,7 @@
-- The terminfo package cannot be built on Windows.
if flag(terminfo) && !os(windows)
- build-depends: terminfo >= 0.4.0.2 && < 0.5
+ build-depends: terminfo >= 0.4.0.2 && <1
cpp-options: -DHAVE_TERMINFO
default-extensions:
@@ -500,7 +499,7 @@
cc-options: -D_REENTRANT
build-depends: darcs,
- base >= 4.9 && < 4.13
+ base >= 4.9 && <5
-- ----------------------------------------------------------------------
-- unit test driver
@@ -518,7 +517,7 @@
build-depends: Win32 >= 2.3.1 && < 2.4
build-depends: darcs,
- base >= 4.9 && < 4.13,
+ base >= 4.9 && <5,
array >= 0.5.1.0 && < 0.6,
bytestring >= 0.10.6 && < 0.11,
cmdargs >= 0.10.10 && < 0.11,
@@ -527,15 +526,15 @@
mtl >= 2.2.1 && < 2.3,
shelly >= 1.6.8 && < 1.9,
split >= 0.2.2 && < 0.3,
- text >= 1.2.1.3 && < 1.3,
+ text >= 1.2.1.3 && <2,
directory >= 1.2.6.2 && < 1.4,
FindBin >= 0.0.5 && < 0.1,
- QuickCheck >= 2.8.2 && < 2.13,
+ QuickCheck >= 2.8.2 && <3,
HUnit >= 1.3 && < 1.7,
test-framework >= 0.8.1.1 && < 0.9,
test-framework-hunit >= 0.3.0.2 && < 0.4,
test-framework-quickcheck2 >= 0.3.0.3 && < 0.4,
- zip-archive >= 0.3 && < 0.5
+ zip-archive >= 0.3 && <1
-- https://github.com/yesodweb/Shelly.hs/issues/177
if os(windows)
diff --git a/src/Darcs/Patch/Depends.hs b/src/Darcs/Patch/Depends.hs
index 8531294..a4c71cb 100644
--- a/src/Darcs/Patch/Depends.hs
+++ b/src/Darcs/Patch/Depends.hs
@@ -251,7 +251,7 @@ splitOnTag _ (PatchSet NilRL NilRL) = Nothing
unwrapOneTagged :: (Monad m) => PatchSet rt p wX wY -> m (PatchSet rt p wX wY)
unwrapOneTagged (PatchSet (ts :<: Tagged t _ tps) ps) =
return $ PatchSet ts (tps :<: t +<+ ps)
-unwrapOneTagged _ = fail "called unwrapOneTagged with no Tagged's in the set"
+unwrapOneTagged _ = error "called unwrapOneTagged with no Tagged's in the set"
-- | @getUncovered ps@ returns the 'PatchInfo' for all the patches in
-- @ps@ that are not depended on by anything else *through explicit
diff --git a/src/Darcs/Patch/Match.hs b/src/Darcs/Patch/Match.hs
index aba6c7a..2b6f53a 100644
--- a/src/Darcs/Patch/Match.hs
+++ b/src/Darcs/Patch/Match.hs
@@ -421,7 +421,7 @@ getNonrangeMatchS fs repo =
Just m -> if nonrangeMatcherIsTag fs
then getTagS m repo
else getMatcherS Exclusive m repo
- Nothing -> fail "Pattern not specified in getNonrangeMatch."
+ Nothing -> error "Pattern not specified in getNonrangeMatch."
-- | @firstMatch fs@ tells whether @fs@ implies a "first match", that
-- is if we match against patches from a point in the past on, rather
@@ -441,7 +441,7 @@ getFirstMatchS fs repo =
Just (_,b) -> unpullLastN repo b -- b is chronologically earlier than a
Nothing ->
case firstMatcher fs of
- Nothing -> fail "Pattern not specified in getFirstMatchS."
+ Nothing -> error "Pattern not specified in getFirstMatchS."
Just m -> if firstMatcherIsTag fs
then getTagS m repo
else getMatcherS Inclusive m repo
@@ -462,7 +462,7 @@ checkMatchSyntax :: [MatchFlag] -> IO ()
checkMatchSyntax opts =
case getMatchPattern opts of
Nothing -> return ()
- Just p -> either fail (const $ return ()) (parseMatch p::Either String (MatchFun rt DummyPatch))
+ Just p -> either error (const $ return ()) (parseMatch p::Either String (MatchFun rt DummyPatch))
getMatchPattern :: [MatchFlag] -> Maybe String
getMatchPattern [] = Nothing
@@ -718,7 +718,7 @@ getMatcherS :: (ApplyMonad (ApplyState p) m, Matchable p) =>
getMatcherS ioe m repo =
if matchExists m repo
then applyInvToMatcher ioe m repo
- else fail $ "Couldn't match pattern "++ show m
+ else error $ "Couldn't match pattern "++ show m
getTagS :: (ApplyMonad (ApplyState p) m, MonadProgress m, Matchable p) =>
Matcher rt p -> PatchSet rt p Origin wX -> m ()
diff --git a/src/Darcs/Patch/PatchInfoAnd.hs b/src/Darcs/Patch/PatchInfoAnd.hs
index 2da7ec8..1147410 100644
--- a/src/Darcs/Patch/PatchInfoAnd.hs
+++ b/src/Darcs/Patch/PatchInfoAnd.hs
@@ -167,7 +167,7 @@ conscientiously er (PIAP pinf hp) =
-- | @hopefullyM@ is a version of @hopefully@ which calls @fail@ in a
-- monad instead of erroring.
-hopefullyM :: Monad m => PatchInfoAnd rt p wA wB -> m (WrappedNamed rt p wA wB)
+hopefullyM :: MonadFail m => PatchInfoAnd rt p wA wB -> m (WrappedNamed rt p wA wB)
hopefullyM (PIAP pinf hp) = case hopefully2either hp of
Right p -> return p
Left e -> fail $ renderString
diff --git a/src/Darcs/Patch/Prim/V1/Apply.hs b/src/Darcs/Patch/Prim/V1/Apply.hs
index bea7e41..7984d21 100644
--- a/src/Darcs/Patch/Prim/V1/Apply.hs
+++ b/src/Darcs/Patch/Prim/V1/Apply.hs
@@ -41,13 +41,13 @@ instance Apply Prim where
apply (FP f (TokReplace t o n)) = mModifyFilePS f doreplace
where doreplace fc =
case tryTokReplace t (BC.pack o) (BC.pack n) fc of
- Nothing -> fail $ "replace patch to " ++ fn2fp f
+ Nothing -> error $ "replace patch to " ++ fn2fp f
++ " couldn't apply."
Just fc' -> return fc'
apply (FP f (Binary o n)) = mModifyFilePS f doapply
where doapply oldf = if o == oldf
then return n
- else fail $ "binary patch to " ++ fn2fp f
+ else error $ "binary patch to " ++ fn2fp f
++ " couldn't apply."
apply (DP d AddDir) = mCreateDirectory d
apply (DP d RmDir) = mRemoveDirectory d
@@ -115,7 +115,7 @@ applyHunk f h fc =
case applyHunkLines h fc of
Right fc' -> return fc'
Left msg ->
- fail $
+ error $
"### Error applying:\n" ++ renderHunk h ++
"\n### to file " ++ fn2fp f ++ ":\n" ++ BC.unpack fc ++
"### Reason: " ++ msg
diff --git a/src/Darcs/Patch/Prim/V1/Commute.hs b/src/Darcs/Patch/Prim/V1/Commute.hs
index 7639dbd..e1432e6 100644
--- a/src/Darcs/Patch/Prim/V1/Commute.hs
+++ b/src/Darcs/Patch/Prim/V1/Commute.hs
@@ -58,6 +58,7 @@ instance Monad Perhaps where
Failed >>= _ = Failed
Unknown >>= _ = Unknown
return = Succeeded
+instance MonadFail Perhaps where
fail _ = Unknown
instance Alternative Perhaps where
diff --git a/src/Darcs/Patch/ReadMonads.hs b/src/Darcs/Patch/ReadMonads.hs
index 62a4f81..e1cb149 100644
--- a/src/Darcs/Patch/ReadMonads.hs
+++ b/src/Darcs/Patch/ReadMonads.hs
@@ -237,6 +237,7 @@ failSM _ = SM (\_ -> Nothing)
instance Monad SM where
(>>=) = bindSM
return = returnSM
+instance MonadFail SM where
fail = failSM
instance ParserM SM where
diff --git a/src/Darcs/Patch/V1/Commute.hs b/src/Darcs/Patch/V1/Commute.hs
index 0bb41a3..c6c3382 100644
--- a/src/Darcs/Patch/V1/Commute.hs
+++ b/src/Darcs/Patch/V1/Commute.hs
@@ -93,6 +93,7 @@ instance Monad Perhaps where
Failed >>= _ = Failed
Unknown >>= _ = Unknown
return = Succeeded
+instance MonadFail Perhaps where
fail _ = Unknown
instance Alternative Perhaps where
diff --git a/src/Darcs/Repository/Diff.hs b/src/Darcs/Repository/Diff.hs
index 8078d49..e0e2341 100644
--- a/src/Darcs/Repository/Diff.hs
+++ b/src/Darcs/Repository/Diff.hs
@@ -138,7 +138,7 @@ treeDiff da ft t1 t2 = do
do rmDirP <- diff p (Removed subtree)
addFileP <- diff p (Changed (File emptyBlob) b')
return $ joinGap (+>+) rmDirP addFileP
- diff p _ = fail $ "Missing case at path " ++ show p
+ diff p _ = error $ "Missing case at path " ++ show p
text_diff p a b
| BL.null a && BL.null b = emptyGap NilFL
diff --git a/src/Darcs/Repository/Match.hs b/src/Darcs/Repository/Match.hs
index 08c9f13..f33cabe 100644
--- a/src/Darcs/Repository/Match.hs
+++ b/src/Darcs/Repository/Match.hs
@@ -60,7 +60,7 @@ getNonrangeMatch :: (ApplyMonad (ApplyState p) DefaultIO, IsRepoType rt, RepoPat
getNonrangeMatch r = withRecordedMatch r . getMatch where
getMatch fs = case hasIndexRange fs of
Just (n, m) | n == m -> applyNInv (n-1)
- | otherwise -> fail "Index range is not allowed for this command."
+ | otherwise -> error "Index range is not allowed for this command."
_ -> getNonrangeMatchS fs
getOnePatchset :: (IsRepoType rt, RepoPatch p)
diff --git a/src/Darcs/Util/Tree/Monad.hs b/src/Darcs/Util/Tree/Monad.hs
index 0e01d9b..296fdc4 100644
--- a/src/Darcs/Util/Tree/Monad.hs
+++ b/src/Darcs/Util/Tree/Monad.hs
@@ -216,7 +216,7 @@ instance (Monad m) => TreeRO (TreeMonad m) where
t <- gets tree
let f = findFile t p'
case f of
- Nothing -> fail $ "No such file " ++ show p'
+ Nothing -> error $ "No such file " ++ show p'
Just x -> lift (readBlob x)
currentDirectory = ask
@@ -251,7 +251,7 @@ instance (Monad m) => TreeRW (TreeMonad m) where
let item = find tr from'
found_to = find tr to'
unless (isNothing found_to) $
- fail $ "Error renaming: destination " ++ show to ++ " exists."
+ error $ "Error renaming: destination " ++ show to ++ " exists."
unless (isNothing item) $ do
modifyItem from Nothing
modifyItem to item
--
2.23.1
|
