333 lines
14 KiB
Diff
333 lines
14 KiB
Diff
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
|
|
|