From 2490fa65eeba52699a7c0e303aa5cb9b78c2b1cf Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Niklas=20Hamb=C3=BCchen?= 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 , @@ -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