diff --git a/Cabal/Cabal.cabal b/Cabal/Cabal.cabal index a686d441aff..ac5aca39b4a 100644 --- a/Cabal/Cabal.cabal +++ b/Cabal/Cabal.cabal @@ -291,7 +291,7 @@ library else build-depends: unix >= 2.6.0.0 && < 2.8 - ghc-options: -Wall -fno-ignore-asserts -fwarn-tabs + ghc-options: -Wall -fno-ignore-asserts -fwarn-tabs -fwarn-incomplete-uni-patterns if impl(ghc >= 8.0) ghc-options: -Wcompat -Wnoncanonical-monad-instances diff --git a/Cabal/Distribution/Backpack/Configure.hs b/Cabal/Distribution/Backpack/Configure.hs index 927570f82ea..78e393137b2 100644 --- a/Cabal/Distribution/Backpack/Configure.hs +++ b/Cabal/Distribution/Backpack/Configure.hs @@ -162,7 +162,8 @@ toComponentLocalBuildInfos . map Right $ graph combined_graph = Graph.unionRight external_graph internal_graph - Just local_graph = Graph.closure combined_graph (map nodeKey graph) + local_graph = fromMaybe (error "toComponentLocalBuildInfos: closure returned Nothing") + $ Graph.closure combined_graph (map nodeKey graph) -- The database of transitively reachable installed packages that the -- external components the package (as a whole) depends on. This will be -- used in several ways: diff --git a/Cabal/Distribution/Compat/Binary.hs b/Cabal/Distribution/Compat/Binary.hs index 5bd22dbc4b8..6f5d7feffe7 100644 --- a/Cabal/Distribution/Compat/Binary.hs +++ b/Cabal/Distribution/Compat/Binary.hs @@ -18,12 +18,7 @@ module Distribution.Compat.Binary #endif ) where -import Control.Exception (catch, evaluate) -#if __GLASGOW_HASKELL__ >= 711 -import Control.Exception (pattern ErrorCall) -#else -import Control.Exception (ErrorCall(..)) -#endif +import Control.Exception (ErrorCall (..), catch, evaluate) import Data.ByteString.Lazy (ByteString) #if __GLASGOW_HASKELL__ >= 708 || MIN_VERSION_binary(0,7,0) @@ -67,5 +62,10 @@ encodeFile f = BSL.writeFile f . encode decodeOrFailIO :: Binary a => ByteString -> IO (Either String a) decodeOrFailIO bs = - catch (evaluate (decode bs) >>= return . Right) - $ \(ErrorCall str) -> return $ Left str + catch (evaluate (decode bs) >>= return . Right) handler + where +#if MIN_VERSION_base(4,9,0) + handler (ErrorCallWithLocation str _) = return $ Left str +#else + handler (ErrorCall str) = return $ Left str +#endif diff --git a/Cabal/Distribution/Parsec.hs b/Cabal/Distribution/Parsec.hs index cd461a02b3f..28abf8d4d45 100644 --- a/Cabal/Distribution/Parsec.hs +++ b/Cabal/Distribution/Parsec.hs @@ -379,7 +379,9 @@ escapeCode = (charEsc <|> charNum <|> charAscii <|> charControl) P. "escape c nomore :: m () nomore = P.notFollowedBy anyd <|> toomuch - (low, ex : high) = splitAt bd dps + (low, ex, high) = case splitAt bd dps of + (low', ex' : high') -> (low', ex', high') + (_, _) -> error "escapeCode: Logic error" in ((:) <$> P.choice low <*> atMost (length bds) anyd) <* nomore <|> ((:) <$> ex <*> ([] <$ nomore <|> bounded'' dps bds)) <|> if not (null bds) diff --git a/Cabal/Distribution/Simple/Build/Macros.hs b/Cabal/Distribution/Simple/Build/Macros.hs index fa3ba3f5274..15c5b3d2fe4 100644 --- a/Cabal/Distribution/Simple/Build/Macros.hs +++ b/Cabal/Distribution/Simple/Build/Macros.hs @@ -109,9 +109,9 @@ generateToolVersionMacros progs = concat ++ generateMacros "TOOL_" progname version | prog <- progs , isJust . programVersion $ prog - , let progid = programId prog ++ "-" ++ prettyShow version - progname = map fixchar (programId prog) - Just version = programVersion prog + , let progid = programId prog ++ "-" ++ prettyShow version + progname = map fixchar (programId prog) + version = fromMaybe version0 (programVersion prog) ] -- | Common implementation of 'generatePackageVersionMacros' and @@ -131,7 +131,11 @@ generateMacros macro_prefix name version = ] ,"\n"] where - (major1:major2:minor:_) = map show (versionNumbers version ++ repeat 0) + (major1,major2,minor) = case map show (versionNumbers version) of + [] -> ("0", "0", "0") + [x] -> (x, "0", "0") + [x,y] -> (x, y, "0") + (x:y:z:_) -> (x, y, z) -- | Generate the @CURRENT_COMPONENT_ID@ definition for the component ID -- of the current package. diff --git a/Cabal/Distribution/Simple/BuildTarget.hs b/Cabal/Distribution/Simple/BuildTarget.hs index 8618f7b86b6..0b97bdbbb0d 100644 --- a/Cabal/Distribution/Simple/BuildTarget.hs +++ b/Cabal/Distribution/Simple/BuildTarget.hs @@ -58,6 +58,7 @@ import qualified Distribution.Compat.CharParsing as P import Control.Monad ( msum ) import Data.List ( stripPrefix, groupBy, partition ) +import qualified Data.List.NonEmpty as NE import Data.Either ( partitionEithers ) import System.FilePath as FilePath ( dropExtension, normalise, splitDirectories, joinPath, splitPath @@ -318,8 +319,9 @@ resolveBuildTarget pkg userTarget fexists = where classifyMatchErrors errs - | not (null expected) = let (things, got:_) = unzip expected in - BuildTargetExpected userTarget things got + | Just expected' <- NE.nonEmpty expected + = let (things, got:|_) = NE.unzip expected' in + BuildTargetExpected userTarget (NE.toList things) got | not (null nosuch) = BuildTargetNoSuch userTarget nosuch | otherwise = error $ "resolveBuildTarget: internal error in matching" where diff --git a/Cabal/Distribution/Simple/GHC.hs b/Cabal/Distribution/Simple/GHC.hs index fab5f4cfd90..95b936ccec8 100644 --- a/Cabal/Distribution/Simple/GHC.hs +++ b/Cabal/Distribution/Simple/GHC.hs @@ -317,7 +317,7 @@ guessRunghcFromGhcPath = guessToolFromGhcPath runghcProgram getGhcInfo :: Verbosity -> ConfiguredProgram -> IO [(String, String)] getGhcInfo verbosity ghcProg = Internal.getGhcInfo verbosity implInfo ghcProg where - Just version = programVersion ghcProg + version = fromMaybe (error "GHC.getGhcInfo: no ghc version") $ programVersion ghcProg implInfo = ghcVersionImplInfo version -- | Given a single package DB, return all installed packages. @@ -363,7 +363,7 @@ toPackageIndex verbosity pkgss progdb = do return $! mconcat indices where - Just ghcProg = lookupProgram ghcProgram progdb + ghcProg = fromMaybe (error "GHC.toPackageIndex: no ghc program") $ lookupProgram ghcProgram progdb getLibDir :: Verbosity -> LocalBuildInfo -> IO FilePath getLibDir verbosity lbi = @@ -396,7 +396,7 @@ getUserPackageDB _verbosity ghcProg platform = do platformAndVersion = Internal.ghcPlatformAndVersionString platform ghcVersion packageConfFileName = "package.conf.d" - Just ghcVersion = programVersion ghcProg + ghcVersion = fromMaybe (error "GHC.getUserPackageDB: no ghc version") $ programVersion ghcProg checkPackageDbEnvVar :: Verbosity -> IO () checkPackageDbEnvVar verbosity = @@ -475,7 +475,7 @@ getInstalledPackagesMonitorFiles verbosity platform progdb = if isFileStyle then return path else return (path "package.cache") - Just ghcProg = lookupProgram ghcProgram progdb + ghcProg = fromMaybe (error "GHC.toPackageIndex: no ghc program") $ lookupProgram ghcProgram progdb -- ----------------------------------------------------------------------------- @@ -2032,9 +2032,9 @@ hcPkgInfo progdb = HcPkg.HcPkgInfo , HcPkg.suppressFilesCheck = v >= [6,6] } where - v = versionNumbers ver - Just ghcPkgProg = lookupProgram ghcPkgProgram progdb - Just ver = programVersion ghcPkgProg + v = versionNumbers ver + ghcPkgProg = fromMaybe (error "GHC.hcPkgInfo: no ghc program") $ lookupProgram ghcPkgProgram progdb + ver = fromMaybe (error "GHC.hcPkgInfo: no ghc version") $ programVersion ghcPkgProg registerPackage :: Verbosity @@ -2051,7 +2051,7 @@ pkgRoot :: Verbosity -> LocalBuildInfo -> PackageDB -> IO FilePath pkgRoot verbosity lbi = pkgRoot' where pkgRoot' GlobalPackageDB = - let Just ghcProg = lookupProgram ghcProgram (withPrograms lbi) + let ghcProg = fromMaybe (error "GHC.pkgRoot: no ghc program") $ lookupProgram ghcProgram (withPrograms lbi) in fmap takeDirectory (getGlobalPackageDB verbosity ghcProg) pkgRoot' UserPackageDB = do appDir <- getAppUserDataDirectory "ghc" diff --git a/Cabal/Distribution/Simple/GHCJS.hs b/Cabal/Distribution/Simple/GHCJS.hs index d73aaae2d48..4ad5bb18cf0 100644 --- a/Cabal/Distribution/Simple/GHCJS.hs +++ b/Cabal/Distribution/Simple/GHCJS.hs @@ -241,7 +241,7 @@ guessToolFromGhcjsPath tool ghcjsProg verbosity searchpath getGhcInfo :: Verbosity -> ConfiguredProgram -> IO [(String, String)] getGhcInfo verbosity ghcjsProg = Internal.getGhcInfo verbosity implInfo ghcjsProg where - Just version = programVersion ghcjsProg + version = fromMaybe (error "GHCJS.getGhcInfo: no version") $ programVersion ghcjsProg implInfo = ghcVersionImplInfo version -- | Given a single package DB, return all installed packages. @@ -275,7 +275,7 @@ toPackageIndex verbosity pkgss progdb = do return $! (mconcat indices) where - Just ghcjsProg = lookupProgram ghcjsProgram progdb + ghcjsProg = fromMaybe (error "GHCJS.toPackageIndex no ghcjs program") $ lookupProgram ghcjsProgram progdb getLibDir :: Verbosity -> LocalBuildInfo -> IO FilePath getLibDir verbosity lbi = @@ -307,7 +307,7 @@ getUserPackageDB _verbosity ghcjsProg platform = do platformAndVersion = Internal.ghcPlatformAndVersionString platform ghcjsVersion packageConfFileName = "package.conf.d" - Just ghcjsVersion = programVersion ghcjsProg + ghcjsVersion = fromMaybe (error "GHCJS.getUserPackageDB: no version") $ programVersion ghcjsProg checkPackageDbEnvVar :: Verbosity -> IO () checkPackageDbEnvVar verbosity = @@ -360,7 +360,7 @@ getInstalledPackagesMonitorFiles verbosity platform progdb = if isFileStyle then return path else return (path "package.cache") - Just ghcjsProg = lookupProgram ghcjsProgram progdb + ghcjsProg = fromMaybe (error "GHCJS.toPackageIndex no ghcjs program") $ lookupProgram ghcjsProgram progdb toJSLibName :: String -> String @@ -1782,8 +1782,8 @@ hcPkgInfo progdb = HcPkg.HcPkgInfo { HcPkg.hcPkgProgram = ghcjsPkgProg } where v7_10 = mkVersion [7,10] - Just ghcjsPkgProg = lookupProgram ghcjsPkgProgram progdb - Just ver = programVersion ghcjsPkgProg + ghcjsPkgProg = fromMaybe (error "GHCJS.hcPkgInfo no ghcjs program") $ lookupProgram ghcjsPkgProgram progdb + ver = fromMaybe (error "GHCJS.hcPkgInfo no ghcjs version") $ programVersion ghcjsPkgProg registerPackage :: Verbosity @@ -1800,7 +1800,7 @@ pkgRoot :: Verbosity -> LocalBuildInfo -> PackageDB -> IO FilePath pkgRoot verbosity lbi = pkgRoot' where pkgRoot' GlobalPackageDB = - let Just ghcjsProg = lookupProgram ghcjsProgram (withPrograms lbi) + let ghcjsProg = fromMaybe (error "GHCJS.pkgRoot: no ghcjs program") $ lookupProgram ghcjsProgram (withPrograms lbi) in fmap takeDirectory (getGlobalPackageDB verbosity ghcjsProg) pkgRoot' UserPackageDB = do appDir <- getAppUserDataDirectory "ghcjs" @@ -1830,4 +1830,4 @@ runCmd progdb exe = ) where script = exe <.> "jsexe" "all" <.> "js" - Just ghcjsProg = lookupProgram ghcjsProgram progdb + ghcjsProg = fromMaybe (error "GHCJS.runCmd: no ghcjs program") $ lookupProgram ghcjsProgram progdb diff --git a/Cabal/Distribution/Simple/Haddock.hs b/Cabal/Distribution/Simple/Haddock.hs index 4701da889c9..41040e21f3b 100644 --- a/Cabal/Distribution/Simple/Haddock.hs +++ b/Cabal/Distribution/Simple/Haddock.hs @@ -525,7 +525,11 @@ getGhcCppOpts haddockVersion bi = haddockVersionMacro = "-D__HADDOCK_VERSION__=" ++ show (v1 * 1000 + v2 * 10 + v3) where - [v1, v2, v3] = take 3 $ versionNumbers haddockVersion ++ [0,0] + (v1, v2, v3) = case versionNumbers haddockVersion of + [] -> (0,0,0) + [x] -> (x,0,0) + [x,y] -> (x,y,0) + (x:y:z:_) -> (x,y,z) getGhcLibDir :: Verbosity -> LocalBuildInfo -> IO HaddockArgs diff --git a/Cabal/Distribution/Simple/ShowBuildInfo.hs b/Cabal/Distribution/Simple/ShowBuildInfo.hs index 2a41962fb6e..74f5de2d41b 100644 --- a/Cabal/Distribution/Simple/ShowBuildInfo.hs +++ b/Cabal/Distribution/Simple/ShowBuildInfo.hs @@ -56,6 +56,9 @@ module Distribution.Simple.ShowBuildInfo (mkBuildInfo) where +import Distribution.Compat.Prelude +import Prelude () + import qualified Distribution.Simple.GHC as GHC import qualified Distribution.Simple.Program.GHC as GHC @@ -122,7 +125,7 @@ mkBuildInfo pkg_descr lbi _flags targetsToBuild = info ] where bi = componentBuildInfo comp - Just comp = lookupComponent pkg_descr name + comp = fromMaybe (error $ "mkBuildInfo: no component " ++ prettyShow name) $ lookupComponent pkg_descr name compType = case comp of CLib _ -> "lib" CExe _ -> "exe" diff --git a/Cabal/Distribution/Simple/Test/LibV09.hs b/Cabal/Distribution/Simple/Test/LibV09.hs index 8f4978bc845..35dc367c85e 100644 --- a/Cabal/Distribution/Simple/Test/LibV09.hs +++ b/Cabal/Distribution/Simple/Test/LibV09.hs @@ -207,7 +207,9 @@ writeSimpleTestStub :: PD.TestSuite -- ^ library 'TestSuite' for which a stub writeSimpleTestStub t dir = do createDirectoryIfMissing True dir let filename = dir stubFilePath t - PD.TestSuiteLibV09 _ m = PD.testInterface t + m = case PD.testInterface t of + PD.TestSuiteLibV09 _ m' -> m' + _ -> error "writeSimpleTestStub: invalid TestSuite passed" writeFile filename $ simpleTestStub m -- | Source code for library test suite stub executable diff --git a/Cabal/Distribution/Simple/UHC.hs b/Cabal/Distribution/Simple/UHC.hs index 8ac068e6a00..903458adb86 100644 --- a/Cabal/Distribution/Simple/UHC.hs +++ b/Cabal/Distribution/Simple/UHC.hs @@ -116,9 +116,11 @@ getGlobalPackageDir :: Verbosity -> ProgramDb -> IO FilePath getGlobalPackageDir verbosity progdb = do output <- getDbProgramOutput verbosity uhcProgram progdb ["--meta-pkgdir-system"] - -- call to "lines" necessary, because pkgdir contains an extra newline at the end - let [pkgdir] = lines output + -- we need to trim because pkgdir contains an extra newline at the end + let pkgdir = trimEnd output return pkgdir + where + trimEnd = reverse . dropWhile isSpace . reverse getUserPackageDir :: NoCallStackIO FilePath getUserPackageDir = do diff --git a/Cabal/Distribution/Utils/Structured.hs b/Cabal/Distribution/Utils/Structured.hs index 9a00a272df5..66eb05c8c9e 100644 --- a/Cabal/Distribution/Utils/Structured.hs +++ b/Cabal/Distribution/Utils/Structured.hs @@ -79,12 +79,7 @@ import Data.Word (Word, Word16, Word32, Word64, Word8) import qualified Control.Monad.Trans.State.Strict as State -import Control.Exception (catch, evaluate) -#if __GLASGOW_HASKELL__ >= 711 -import Control.Exception (pattern ErrorCall) -#else -import Control.Exception (ErrorCall (..)) -#endif +import Control.Exception (ErrorCall (..), catch, evaluate) import GHC.Generics @@ -277,8 +272,13 @@ structuredDecode lbs = snd (Binary.decode lbs :: (Tag a, a)) structuredDecodeOrFailIO :: (Binary.Binary a, Structured a) => LBS.ByteString -> IO (Either String a) structuredDecodeOrFailIO bs = - catch (evaluate (structuredDecode bs) >>= return . Right) - $ \(ErrorCall str) -> return $ Left str + catch (evaluate (structuredDecode bs) >>= return . Right) handler + where +#if MIN_VERSION_base(4,9,0) + handler (ErrorCallWithLocation str _) = return $ Left str +#else + handler (ErrorCall str) = return $ Left str +#endif ------------------------------------------------------------------------------- -- Helper data diff --git a/cabal-install/Distribution/Client/BuildReports/Storage.hs b/cabal-install/Distribution/Client/BuildReports/Storage.hs index ae5e38ba68b..ead75d3a935 100644 --- a/cabal-install/Distribution/Client/BuildReports/Storage.hs +++ b/cabal-install/Distribution/Client/BuildReports/Storage.hs @@ -1,3 +1,5 @@ +-- TODO +{-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-} ----------------------------------------------------------------------------- -- | -- Module : Distribution.Client.Reporting diff --git a/cabal-install/Distribution/Client/CmdErrorMessages.hs b/cabal-install/Distribution/Client/CmdErrorMessages.hs index 6d15652190c..609c31be76c 100644 --- a/cabal-install/Distribution/Client/CmdErrorMessages.hs +++ b/cabal-install/Distribution/Client/CmdErrorMessages.hs @@ -7,6 +7,9 @@ module Distribution.Client.CmdErrorMessages ( module Distribution.Client.TargetSelector, ) where +import Distribution.Client.Compat.Prelude +import Prelude () + import Distribution.Client.ProjectOrchestration import Distribution.Client.TargetSelector ( ComponentKindFilter, componentKind, showTargetSelector ) @@ -22,8 +25,7 @@ import Distribution.Solver.Types.OptionalStanza import Distribution.Deprecated.Text ( display ) -import Data.Maybe (isNothing) -import Data.List (sortBy, groupBy, nub) +import qualified Data.List.NonEmpty as NE import Data.Function (on) @@ -77,8 +79,8 @@ renderListSemiAnd (x:xs) = x ++ "; " ++ renderListSemiAnd xs -- > | (pkgname, components) <- sortGroupOn packageName allcomponents ] -- sortGroupOn :: Ord b => (a -> b) -> [a] -> [(b, [a])] -sortGroupOn key = map (\xs@(x:_) -> (key x, xs)) - . groupBy ((==) `on` key) +sortGroupOn key = map (\(x:|xs) -> (key x, x:xs)) + . NE.groupBy ((==) `on` key) . sortBy (compare `on` key) diff --git a/cabal-install/Distribution/Client/CmdInstall.hs b/cabal-install/Distribution/Client/CmdInstall.hs index 375c142cb0c..ba3a5f2965b 100644 --- a/cabal-install/Distribution/Client/CmdInstall.hs +++ b/cabal-install/Distribution/Client/CmdInstall.hs @@ -125,7 +125,7 @@ import Distribution.Pretty import Control.Exception ( catch ) import Control.Monad - ( mapM, mapM_ ) + ( mapM, forM_ ) import qualified Data.ByteString.Lazy.Char8 as BS import Data.Either ( partitionEithers ) @@ -371,7 +371,7 @@ installAction ( configFlags, configExFlags, installFlags gatherTargets :: UnitId -> TargetSelector gatherTargets targetId = TargetPackageNamed pkgName targetFilter where - Just targetUnit = Map.lookup targetId planMap + targetUnit = Map.findWithDefault (error "cannot find target unit") targetId planMap PackageIdentifier{..} = packageId targetUnit targets' = fmap gatherTargets targetIds @@ -385,12 +385,11 @@ installAction ( configFlags, configExFlags, installFlags createDirectoryIfMissing True (distSdistDirectory localDistDirLayout) - unless (Map.null targets) $ - mapM_ - (\(SpecificSourcePackage pkg) -> packageToSdist verbosity + unless (Map.null targets) $ forM_ (localPackages localBaseCtx) $ \lpkg -> case lpkg of + SpecificSourcePackage pkg -> packageToSdist verbosity (distProjectRootDirectory localDistDirLayout) TarGzArchive (distSdistFile localDistDirLayout (packageId pkg)) pkg - ) (localPackages localBaseCtx) + NamedPackage pkgName _ -> error $ "Got NamedPackage " ++ prettyShow pkgName if null targets then return (hackagePkgs, hackageTargets) diff --git a/cabal-install/Distribution/Client/CmdRepl.hs b/cabal-install/Distribution/Client/CmdRepl.hs index 2249d0a0b7b..4a737b4ab9e 100644 --- a/cabal-install/Distribution/Client/CmdRepl.hs +++ b/cabal-install/Distribution/Client/CmdRepl.hs @@ -250,13 +250,14 @@ replAction ( configFlags, configExFlags, installFlags -- help us resolve the targets, but that isn't ideal for performance, -- especially in the no-project case. withInstallPlan (lessVerbose verbosity) baseCtx $ \elaboratedPlan _ -> do + -- targets should be non-empty map, but there's no NonEmptyMap yet. targets <- validatedTargets elaboratedPlan targetSelectors let - Just (unitId, _) = safeHead $ Map.toList targets + (unitId, _) = fromMaybe (error "panic: targets should be non-empty") $ safeHead $ Map.toList targets originalDeps = installedUnitId <$> InstallPlan.directDeps elaboratedPlan unitId oci = OriginalComponentInfo unitId originalDeps - Just pkgId = packageId <$> InstallPlan.lookup elaboratedPlan unitId + pkgId = fromMaybe (error $ "cannot find " ++ prettyShow unitId) $ packageId <$> InstallPlan.lookup elaboratedPlan unitId baseCtx' = addDepsToProjectTarget (envPackages envFlags) pkgId baseCtx return (Just oci, baseCtx') diff --git a/cabal-install/Distribution/Client/Compat/Semaphore.hs b/cabal-install/Distribution/Client/Compat/Semaphore.hs index 6bf09a60eb0..e4d04c0db79 100644 --- a/cabal-install/Distribution/Client/Compat/Semaphore.hs +++ b/cabal-install/Distribution/Client/Compat/Semaphore.hs @@ -12,6 +12,8 @@ import Control.Concurrent.STM (TVar, atomically, newTVar, readTVar, retry, import Control.Exception (mask_, onException) import Control.Monad (join, unless) import Data.Typeable (Typeable) +import Data.List.NonEmpty (NonEmpty (..)) +import qualified Data.List.NonEmpty as NE -- | 'QSem' is a quantity semaphore in which the resource is aqcuired -- and released in units of one. It provides guaranteed FIFO ordering @@ -97,8 +99,8 @@ signalQSem s@(QSem q b1 b2) = checkwake2 [] = do writeTVar q 1 return (return ()) - checkwake2 ys = do - let (z:zs) = reverse ys + checkwake2 (y:ys) = do + let (z:|zs) = NE.reverse (y:|ys) writeTVar b1 zs writeTVar b2 [] return (wake s z) diff --git a/cabal-install/Distribution/Client/Exec.hs b/cabal-install/Distribution/Client/Exec.hs index 6c768273071..a7767112de2 100644 --- a/cabal-install/Distribution/Client/Exec.hs +++ b/cabal-install/Distribution/Client/Exec.hs @@ -89,7 +89,7 @@ sandboxEnvironment verbosity sandboxDir comp platform programDb iEnv = Windows -> "PATH" _ -> "LD_LIBRARY_PATH" env getGlobalPackageDB hcProgram packagePathEnvVar = do - let Just program = lookupProgram hcProgram programDb + let program = fromMaybe (error "failed to find hcProgram") $ lookupProgram hcProgram programDb gDb <- getGlobalPackageDB verbosity program sandboxConfigFilePath <- getSandboxConfigFilePath mempty let sandboxPackagePath = sandboxPackageDBPath sandboxDir comp platform diff --git a/cabal-install/Distribution/Client/FileMonitor.hs b/cabal-install/Distribution/Client/FileMonitor.hs index 08ab9a29713..0606f64a21b 100644 --- a/cabal-install/Distribution/Client/FileMonitor.hs +++ b/cabal-install/Distribution/Client/FileMonitor.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveGeneric, DeriveFunctor, GeneralizedNewtypeDeriving, NamedFieldPuns, BangPatterns #-} {-# OPTIONS_GHC -fno-warn-orphans #-} @@ -1097,11 +1098,16 @@ checkDirectoryModificationTime dir mtime = then return Nothing else return (Just mtime') --- | Run an IO computation, returning @e@ if there is an 'error' +-- | Run an IO computation, returning the first argument @e@ if there is an 'error' -- call. ('ErrorCall') handleErrorCall :: a -> IO a -> IO a -handleErrorCall e = - handle (\(ErrorCall _) -> return e) +handleErrorCall e = handle handler where +#if MIN_VERSION_base(4,9,0) + handler (ErrorCallWithLocation _ _) = return e +#else + handler (ErrorCall _) = return e +#endif + -- | Run an IO computation, returning @e@ if there is any 'IOException'. -- diff --git a/cabal-install/Distribution/Client/Get.hs b/cabal-install/Distribution/Client/Get.hs index c70d0e7333a..71baf2696df 100644 --- a/cabal-install/Distribution/Client/Get.hs +++ b/cabal-install/Distribution/Client/Get.hs @@ -35,6 +35,7 @@ import Distribution.Simple.Utils ( notice, die', info, writeFileAtomic ) import Distribution.Verbosity ( Verbosity ) +import Distribution.Pretty (prettyShow) import Distribution.Deprecated.Text (display) import qualified Distribution.PackageDescription as PD import Distribution.Simple.Program @@ -273,7 +274,7 @@ clonePackagesFromSourceRepo verbosity destDirPrefix throwIO (ClonePackageFailedWithExitCode pkgid (srpToProxy repo) (programName (vcsProgram vcs)) exitcode) | (pkgid, repo, vcs, destDir) <- pkgrepos' - , let Just vcs' = Map.lookup (vcsRepoType vcs) vcss + , let vcs' = Map.findWithDefault (error $ "Cannot configure " ++ prettyShow (vcsRepoType vcs)) (vcsRepoType vcs) vcss ] where diff --git a/cabal-install/Distribution/Client/HttpUtils.hs b/cabal-install/Distribution/Client/HttpUtils.hs index 829b779f781..80a4b137672 100644 --- a/cabal-install/Distribution/Client/HttpUtils.hs +++ b/cabal-install/Distribution/Client/HttpUtils.hs @@ -282,7 +282,7 @@ configureTransport verbosity extraPath (Just name) = Just prog -> snd <$> requireProgram verbosity prog baseProgDb -- ^^ if it fails, it'll fail here - let Just transport = mkTrans progdb + let transport = fromMaybe (error "configureTransport: failed to make transport") $ mkTrans progdb return transport { transportManuallySelected = True } Nothing -> die' verbosity $ "Unknown HTTP transport specified: " ++ name @@ -645,9 +645,11 @@ powershellTransport prog = HdrIfModifiedSince -> "IfModifiedSince = " ++ escape value HdrReferer -> "Referer = " ++ escape value HdrTransferEncoding -> "TransferEncoding = " ++ escape value - HdrRange -> let (start, _:end) = + HdrRange -> let (start, end) = if "bytes=" `isPrefixOf` value - then break (== '-') value' + then case break (== '-') value' of + (start', '-':end') -> (start', end') + _ -> error $ "Could not decode range: " ++ value else error $ "Could not decode range: " ++ value value' = drop 6 value in "AddRange(\"bytes\", " ++ escape start ++ ", " ++ escape end ++ ");" diff --git a/cabal-install/Distribution/Client/Init.hs b/cabal-install/Distribution/Client/Init.hs index 9b196703630..f3530657ca2 100644 --- a/cabal-install/Distribution/Client/Init.hs +++ b/cabal-install/Distribution/Client/Init.hs @@ -951,7 +951,9 @@ createMainHs flags = _ -> writeMainHs flags mainFile else return () where - Flag mainFile = mainIs flags + mainFile = case mainIs flags of + Flag x -> x + NoFlag -> error "createMainHs: no mainIs" --- | Write a main file if it doesn't already exist. writeMainHs :: InitFlags -> FilePath -> IO () diff --git a/cabal-install/Distribution/Client/ProjectBuilding.hs b/cabal-install/Distribution/Client/ProjectBuilding.hs index 670c7835955..fd5544197ea 100644 --- a/cabal-install/Distribution/Client/ProjectBuilding.hs +++ b/cabal-install/Distribution/Client/ProjectBuilding.hs @@ -286,7 +286,7 @@ foldMInstallPlanDepOrder visit = -- we go in the right order so the results map has entries for all deps let depresults :: [b] depresults = - map (\ipkgid -> let Just result = Map.lookup ipkgid results + map (\ipkgid -> let result = Map.findWithDefault (error "foldMInstallPlanDepOrder") ipkgid results in result) (InstallPlan.depends pkg) result <- visit pkg depresults @@ -596,7 +596,7 @@ rebuildTargets verbosity handle (\(e :: BuildFailure) -> return (Left e)) $ fmap Right $ let uid = installedUnitId pkg - Just pkgBuildStatus = Map.lookup uid pkgsBuildStatus in + pkgBuildStatus = Map.findWithDefault (error "rebuildTargets") uid pkgsBuildStatus in rebuildTarget verbosity @@ -756,7 +756,7 @@ asyncDownloadPackages verbosity withRepoCtx installPlan pkgsBuildStatus body | InstallPlan.Configured elab <- InstallPlan.reverseTopologicalOrder installPlan , let uid = installedUnitId elab - Just pkgBuildStatus = Map.lookup uid pkgsBuildStatus + pkgBuildStatus = Map.findWithDefault (error "asyncDownloadPackages") uid pkgsBuildStatus , BuildStatusDownload <- [pkgBuildStatus] ] diff --git a/cabal-install/Distribution/Client/ProjectConfig.hs b/cabal-install/Distribution/Client/ProjectConfig.hs index 6dcdc1515dc..ec560b2ab05 100644 --- a/cabal-install/Distribution/Client/ProjectConfig.hs +++ b/cabal-install/Distribution/Client/ProjectConfig.hs @@ -100,7 +100,7 @@ import Distribution.PackageDescription.Parsec ( parseGenericPackageDescription ) import Distribution.Fields ( runParseResult, PError, PWarning, showPWarning) -import Distribution.Pretty () +import Distribution.Pretty (prettyShow) import Distribution.Types.SourceRepo ( RepoType(..) ) import Distribution.Client.SourceRepo @@ -1152,7 +1152,7 @@ syncAndReadSourcePackagesRemoteRepos verbosity --TODO: pass progPathExtra on to 'configureVCS' let _progPathExtra = fromNubList projectConfigProgPathExtra getConfiguredVCS <- delayInitSharedResources $ \repoType -> - let Just vcs = Map.lookup repoType knownVCSs in + let vcs = Map.findWithDefault (error $ "Unknown VCS: " ++ prettyShow repoType) repoType knownVCSs in configureVCS verbosity {-progPathExtra-} vcs concat <$> sequence diff --git a/cabal-install/Distribution/Client/ProjectPlanning.hs b/cabal-install/Distribution/Client/ProjectPlanning.hs index 286df6c0705..10b0556e455 100644 --- a/cabal-install/Distribution/Client/ProjectPlanning.hs +++ b/cabal-install/Distribution/Client/ProjectPlanning.hs @@ -166,6 +166,7 @@ import qualified Data.Traversable as T import Control.Monad.State as State import Control.Exception import Data.List (groupBy) +import qualified Data.List.NonEmpty as NE import Data.Either import Data.Function import System.FilePath @@ -877,8 +878,8 @@ getPackageSourceHashes verbosity withRepoCtx solverPlan = do return (pkgid, hashFromTUF hash) | pkgid <- pkgids ] | (repo, pkgids) <- - map (\grp@((_,repo):_) -> (repo, map fst grp)) - . groupBy ((==) `on` (remoteRepoName . repoRemote . snd)) + map (\grp@((_,repo):|_) -> (repo, map fst (NE.toList grp))) + . NE.groupBy ((==) `on` (remoteRepoName . repoRemote . snd)) . sortBy (compare `on` (remoteRepoName . repoRemote . snd)) $ repoTarballPkgsWithMetadata ] @@ -1714,12 +1715,12 @@ elaborateInstallPlan verbosity platform compiler compilerprogdb pkgConfigDB elabIsCanonical = True elabPkgSourceId = pkgid - elabPkgDescription = let Right (desc, _) = - PD.finalizePD + elabPkgDescription = case PD.finalizePD flags elabEnabledSpec (const True) platform (compilerInfo compiler) - [] gdesc - in desc + [] gdesc of + Right (desc, _) -> desc + Left _ -> error "Failed to finalizePD in elaborateSolverToCommon" elabFlagAssignment = flags elabFlagDefaults = PD.mkFlagAssignment [ (Cabal.flagName flag, Cabal.flagDefault flag) diff --git a/cabal-install/Distribution/Client/TargetSelector.hs b/cabal-install/Distribution/Client/TargetSelector.hs index 90cf33f75bf..23d92f580fd 100644 --- a/cabal-install/Distribution/Client/TargetSelector.hs +++ b/cabal-install/Distribution/Client/TargetSelector.hs @@ -1,5 +1,7 @@ {-# LANGUAGE CPP, DeriveGeneric, DeriveFunctor, RecordWildCards, NamedFieldPuns #-} +-- TODO +{-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-} ----------------------------------------------------------------------------- -- | -- Module : Distribution.Client.TargetSelector @@ -78,6 +80,7 @@ import Data.Function ( on ) import Data.List ( stripPrefix, partition, groupBy ) +import qualified Data.List.NonEmpty as NE import Data.Ord ( comparing ) import qualified Data.Map.Lazy as Map.Lazy @@ -503,9 +506,9 @@ resolveTargetSelector knowntargets@KnownTargets{..} mfilter targetStrStatus = projectIsEmpty = null knownPackagesAll classifyMatchErrors errs - | not (null expected) - = let (things, got:_) = unzip expected in - TargetSelectorExpected targetStr things got + | Just expectedNE <- NE.nonEmpty expected + = let (things, got:|_) = NE.unzip expectedNE in + TargetSelectorExpected targetStr (NE.toList things) got | not (null nosuch) = TargetSelectorNoSuch targetStr nosuch diff --git a/cabal-install/Distribution/Solver/Modular/ConfiguredConversion.hs b/cabal-install/Distribution/Solver/Modular/ConfiguredConversion.hs index e56e9bf8d5f..0e2e8ad5baa 100644 --- a/cabal-install/Distribution/Solver/Modular/ConfiguredConversion.hs +++ b/cabal-install/Distribution/Solver/Modular/ConfiguredConversion.hs @@ -45,7 +45,7 @@ convCP iidx sidx (CP qpi fa es ds) = solverPkgExeDeps = fmap snd ds' } where - Just srcpkg = CI.lookupPackageId sidx pi + srcpkg = fromMaybe (error "convCP: lookupPackageId failed") $ CI.lookupPackageId sidx pi where ds' :: ComponentDeps ([SolverId] {- lib -}, [SolverId] {- exe -}) ds' = fmap (partitionEithers . map convConfId) ds diff --git a/cabal-install/Distribution/Solver/Modular/Linking.hs b/cabal-install/Distribution/Solver/Modular/Linking.hs index 35f463734ae..60438e98af7 100644 --- a/cabal-install/Distribution/Solver/Modular/Linking.hs +++ b/cabal-install/Distribution/Solver/Modular/Linking.hs @@ -1,5 +1,8 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses #-} + +-- TODO: remove this +{-# OPTIONS -fno-warn-incomplete-uni-patterns #-} module Distribution.Solver.Modular.Linking ( validateLinking ) where diff --git a/cabal-install/cabal-install.cabal b/cabal-install/cabal-install.cabal index dff34085656..2e6c470a675 100644 --- a/cabal-install/cabal-install.cabal +++ b/cabal-install/cabal-install.cabal @@ -137,7 +137,7 @@ executable cabal main-is: Main.hs hs-source-dirs: main default-language: Haskell2010 - ghc-options: -Wall -fwarn-tabs + ghc-options: -Wall -fwarn-tabs -fwarn-incomplete-uni-patterns if impl(ghc >= 8.0) ghc-options: -Wcompat -Wnoncanonical-monad-instances diff --git a/cabal-install/cabal-install.cabal.pp b/cabal-install/cabal-install.cabal.pp index 33a34bcf69b..d082bdfa780 100644 --- a/cabal-install/cabal-install.cabal.pp +++ b/cabal-install/cabal-install.cabal.pp @@ -69,7 +69,7 @@ %enddef %def CABAL_COMPONENTCOMMON default-language: Haskell2010 - ghc-options: -Wall -fwarn-tabs + ghc-options: -Wall -fwarn-tabs -fwarn-incomplete-uni-patterns if impl(ghc >= 8.0) ghc-options: -Wcompat -Wnoncanonical-monad-instances @@ -527,7 +527,7 @@ type: exitcode-stdio-1.0 main-is: UnitTests.hs hs-source-dirs: tests - ghc-options: -Wall -fwarn-tabs -main-is UnitTests + ghc-options: -Wall -fwarn-tabs -fwarn-incomplete-uni-patterns -main-is UnitTests other-modules: UnitTests.Distribution.Client.ArbitraryInstances UnitTests.Distribution.Client.Targets @@ -591,7 +591,7 @@ type: exitcode-stdio-1.0 main-is: MemoryUsageTests.hs hs-source-dirs: tests - ghc-options: -Wall -fwarn-tabs "-with-rtsopts=-M4M -K1K" -main-is MemoryUsageTests + ghc-options: -Wall -fwarn-tabs -fwarn-incomplete-uni-patterns "-with-rtsopts=-M4M -K1K" -main-is MemoryUsageTests other-modules: UnitTests.Distribution.Solver.Modular.DSL.TestCaseUtils UnitTests.Distribution.Solver.Modular.MemoryUsage @@ -619,7 +619,7 @@ type: exitcode-stdio-1.0 main-is: SolverQuickCheck.hs hs-source-dirs: tests - ghc-options: -Wall -fwarn-tabs -main-is SolverQuickCheck + ghc-options: -Wall -fwarn-tabs -fwarn-incomplete-uni-patterns -main-is SolverQuickCheck other-modules: UnitTests.Distribution.Solver.Modular.QuickCheck UnitTests.Distribution.Solver.Modular.QuickCheck.Utils @@ -651,7 +651,7 @@ type: exitcode-stdio-1.0 main-is: IntegrationTests2.hs hs-source-dirs: tests - ghc-options: -Wall -fwarn-tabs -main-is IntegrationTests2 + ghc-options: -Wall -fwarn-tabs -fwarn-incomplete-uni-patterns -main-is IntegrationTests2 other-modules: build-depends: base, diff --git a/cabal-install/solver-dsl/UnitTests/Distribution/Solver/Modular/DSL.hs b/cabal-install/solver-dsl/UnitTests/Distribution/Solver/Modular/DSL.hs index 55522ab98bb..87d728e9544 100644 --- a/cabal-install/solver-dsl/UnitTests/Distribution/Solver/Modular/DSL.hs +++ b/cabal-install/solver-dsl/UnitTests/Distribution/Solver/Modular/DSL.hs @@ -587,7 +587,9 @@ exAvSrcPkg ex = -- custom-setup only supports simple dependencies mkSetupDeps :: [ExampleDependency] -> [C.Dependency] mkSetupDeps deps = - let (directDeps, []) = splitDeps deps in map mkDirect directDeps + case splitDeps deps of + (directDeps, []) -> map mkDirect directDeps + _ -> error "mkSetupDeps: custom setup has non-simple deps" mkSimpleVersion :: ExamplePkgVersion -> C.Version mkSimpleVersion n = C.mkVersion [n, 0, 0] diff --git a/cabal-install/tests/IntegrationTests2.hs b/cabal-install/tests/IntegrationTests2.hs index cd9e22b8a5c..a5b02040fbc 100644 --- a/cabal-install/tests/IntegrationTests2.hs +++ b/cabal-install/tests/IntegrationTests2.hs @@ -8,6 +8,9 @@ module IntegrationTests2 where +import Distribution.Client.Compat.Prelude +import Prelude () + import Distribution.Client.DistDirLayout import Distribution.Client.ProjectConfig import Distribution.Client.Config (getCabalDir) @@ -49,11 +52,6 @@ import Distribution.ModuleName (ModuleName) import Distribution.Verbosity import Distribution.Text -#if !MIN_VERSION_base(4,8,0) -import Data.Monoid (mempty, mappend) -#endif -import Data.List (sort) -import Data.String (IsString(..)) import qualified Data.Map as Map import qualified Data.Set as Set import Control.Monad @@ -65,8 +63,6 @@ import Test.Tasty import Test.Tasty.HUnit import Test.Tasty.Options import Data.Tagged (Tagged(..)) -import Data.Proxy (Proxy(..)) -import Data.Typeable (Typeable) #if !MIN_VERSION_directory(1,2,7) removePathForcibly :: FilePath -> IO () @@ -439,7 +435,7 @@ testTargetSelectorAmbiguous reportSubCase = do } } where - Just pkgid = simpleParse pkgidstr + pkgid = fromMaybe (error $ "failed to parse " ++ pkgidstr) $ simpleParse pkgidstr mkexe :: String -> Executable mkexe name = mempty { exeName = fromString name } @@ -474,7 +470,7 @@ mkTargetAllPackages = TargetAllPackages Nothing instance IsString PackageIdentifier where fromString pkgidstr = pkgid - where Just pkgid = simpleParse pkgidstr + where pkgid = fromMaybe (error $"fromString @PackageIdentifier " ++ show pkgidstr) $ simpleParse pkgidstr testTargetSelectorNoCurrentPackage :: Assertion @@ -492,7 +488,7 @@ testTargetSelectorNoCurrentPackage = do zipWithM_ (@?=) errs [ TargetSelectorNoCurrentPackage ts | target <- targets - , let Just ts = parseTargetString target + , let ts = fromMaybe (error $ "failed to parse target string " ++ target) $ parseTargetString target ] cleanProject testdir where diff --git a/cabal-install/tests/UnitTests/Distribution/Client/Tar.hs b/cabal-install/tests/UnitTests/Distribution/Client/Tar.hs index fc80ab43a53..8b70dd89e4c 100644 --- a/cabal-install/tests/UnitTests/Distribution/Client/Tar.hs +++ b/cabal-install/tests/UnitTests/Distribution/Client/Tar.hs @@ -30,8 +30,9 @@ filterTest :: Assertion filterTest = do let e1 = getFileEntry "file1" "x" e2 = getFileEntry "file2" "y" - p = (\e -> let (NormalFile dta _) = entryContent e - str = BS.Char8.unpack dta + p = (\e -> let str = BS.Char8.unpack $ case entryContent e of + NormalFile dta _ -> dta + _ -> error "Invalid entryContent" in str /= "y") assertEqual "Unexpected result for filter" "xz" $ entriesToString $ filterEntries p $ Next e1 $ Next e2 Done @@ -44,8 +45,9 @@ filterMTest :: Assertion filterMTest = do let e1 = getFileEntry "file1" "x" e2 = getFileEntry "file2" "y" - p = (\e -> let (NormalFile dta _) = entryContent e - str = BS.Char8.unpack dta + p = (\e -> let str = BS.Char8.unpack $ case entryContent e of + NormalFile dta _ -> dta + _ -> error "Invalid entryContent" in tell "t" >> return (str /= "y")) (r, w) <- runWriterT $ filterEntriesM p $ Next e1 $ Next e2 Done @@ -70,6 +72,7 @@ getFileEntry pth dta = entriesToString :: Entries String -> String entriesToString = - foldEntries (\e acc -> let (NormalFile dta _) = entryContent e - str = BS.Char8.unpack dta + foldEntries (\e acc -> let str = BS.Char8.unpack $ case entryContent e of + NormalFile dta _ -> dta + _ -> error "Invalid entryContent" in str ++ acc) "z" id diff --git a/cabal-install/tests/UnitTests/Distribution/Client/Targets.hs b/cabal-install/tests/UnitTests/Distribution/Client/Targets.hs index bb43ec36449..fd0fecc065e 100644 --- a/cabal-install/tests/UnitTests/Distribution/Client/Targets.hs +++ b/cabal-install/tests/UnitTests/Distribution/Client/Targets.hs @@ -88,8 +88,8 @@ readUserConstraintTest :: String -> UserConstraint -> Assertion readUserConstraintTest str uc = assertEqual ("Couldn't read constraint: '" ++ str ++ "'") expected actual where - expected = uc - actual = let Right r = readUserConstraint str in r + expected = Right uc + actual = readUserConstraint str parseUserConstraintTest :: String -> UserConstraint -> Assertion parseUserConstraintTest str uc = diff --git a/cabal-testsuite/Test/Cabal/Prelude.hs b/cabal-testsuite/Test/Cabal/Prelude.hs index b7a624983f2..2f24c69a0d4 100644 --- a/cabal-testsuite/Test/Cabal/Prelude.hs +++ b/cabal-testsuite/Test/Cabal/Prelude.hs @@ -42,22 +42,24 @@ import Distribution.Verbosity (normal) import Distribution.Compat.Stack -import Text.Regex.TDFA +import Text.Regex.TDFA ((=~)) -import Control.Concurrent.Async +import Control.Concurrent.Async (waitCatch, withAsync) import qualified Data.Aeson as JSON import qualified Data.ByteString.Lazy as BSL -import Control.Monad -import Control.Monad.Trans.Reader -import Control.Monad.IO.Class +import Control.Monad (unless, when, void, forM_, liftM2, liftM4) +import Control.Monad.Trans.Reader (withReaderT, runReaderT) +import Control.Monad.IO.Class (MonadIO (..)) import qualified Data.ByteString.Char8 as C -import Data.List -import Data.Maybe -import System.Exit -import System.FilePath +import Data.List (isInfixOf, stripPrefix, isPrefixOf, intercalate) +import Data.List.NonEmpty (NonEmpty (..)) +import qualified Data.List.NonEmpty as NE +import Data.Maybe (mapMaybe, fromMaybe) +import System.Exit (ExitCode (..)) +import System.FilePath ((), takeExtensions, takeDrive, takeDirectory, normalise, splitPath, joinPath, splitFileName, (<.>), dropTrailingPathSeparator) import Control.Concurrent (threadDelay) import qualified Data.Char as Char -import System.Directory +import System.Directory (getTemporaryDirectory, getCurrentDirectory, copyFile, removeFile, copyFile, doesFileExist, createDirectoryIfMissing, getDirectoryContents) #ifndef mingw32_HOST_OS import Control.Monad.Catch ( bracket_ ) @@ -157,7 +159,7 @@ setup'' prefix cmd args = do ++ args _ -> args let rel_dist_dir = definitelyMakeRelative (testCurrentDir env) (testDistDir env) - full_args = cmd : [marked_verbose, "--distdir", rel_dist_dir] ++ args' + full_args = cmd :| [marked_verbose, "--distdir", rel_dist_dir] ++ args' defaultRecordMode RecordMarked $ do recordHeader ["Setup", cmd] if testCabalInstallAsSetup env @@ -184,7 +186,7 @@ setup'' prefix cmd args = do , "reconfigure" , "doctest" ] - (a:as) = full_args + (a:|as) = full_args full_args' = if a `elem` legacyCmds then ("v1-" ++ a) : as else a:as in runProgramM cabalProgram full_args' else do @@ -192,14 +194,14 @@ setup'' prefix cmd args = do (testCurrentDir env prefix) pdesc <- liftIO $ readGenericPackageDescription (testVerbosity env) pdfile if buildType (packageDescription pdesc) == Simple - then runM (testSetupPath env) full_args + then runM (testSetupPath env) (NE.toList full_args) -- Run the Custom script! else do r <- liftIO $ runghc (testScriptEnv env) (Just (testCurrentDir env)) (testEnvironment env) (testCurrentDir env prefix "Setup.hs") - full_args + (NE.toList full_args) recordLog r requireSuccess r -- This code is very tempting (and in principle should be quick: diff --git a/cabal-testsuite/cabal-testsuite.cabal b/cabal-testsuite/cabal-testsuite.cabal index 74fa473afa2..706bfe6b07d 100644 --- a/cabal-testsuite/cabal-testsuite.cabal +++ b/cabal-testsuite/cabal-testsuite.cabal @@ -30,7 +30,8 @@ common shared -- this needs to match the in-tree lib:Cabal version , Cabal == 3.3.0.0 - ghc-options: -Wall -fwarn-tabs + ghc-options: -Wall -fwarn-tabs -fwarn-incomplete-uni-patterns + library import: shared @@ -70,6 +71,9 @@ library , text ^>= 1.2.3.1 , transformers ^>= 0.3.0.0 || ^>= 0.4.2.0 || ^>= 0.5.2.0 + if !impl(ghc >= 8.0) + build-depends: semigroups + if !os(windows) build-depends: , unix ^>= 2.6.0.0 || ^>= 2.7.0.0