diff --git a/ChangeLog.md b/ChangeLog.md index 0da18a1c11..aaf04d0ea7 100644 --- a/ChangeLog.md +++ b/ChangeLog.md @@ -11,6 +11,7 @@ Major changes: details, please see [the writeup on these changes](https://www.fpcomplete.com/blog/2017/07/stacks-new-extensible-snapshots). [PR #3249](https://github.com/commercialhaskell/stack/pull/3249), see the PR description for a number of related issues. +* Upgraded to version 2.0 of the Cabal library. Behavior changes: diff --git a/Setup.hs b/Setup.hs index 179845c1dd..6bae7f52c3 100644 --- a/Setup.hs +++ b/Setup.hs @@ -3,8 +3,7 @@ module Main (main) where import Data.List ( nub, sortBy ) import Data.Ord ( comparing ) -import Data.Version ( showVersion ) -import Distribution.Package ( PackageName(PackageName), PackageId, InstalledPackageId, packageVersion, packageName ) +import Distribution.Package ( PackageId, InstalledPackageId, packageVersion, packageName ) import Distribution.PackageDescription ( PackageDescription(), Executable(..) ) import Distribution.InstalledPackageInfo (sourcePackageId, installedPackageId) import Distribution.Simple ( defaultMainWithHooks, UserHooks(..), simpleUserHooks ) @@ -13,7 +12,10 @@ import Distribution.Simple.BuildPaths ( autogenModulesDir ) import Distribution.Simple.PackageIndex (allPackages, dependencyClosure) import Distribution.Simple.Setup ( BuildFlags(buildVerbosity), fromFlag ) import Distribution.Simple.LocalBuildInfo ( installedPkgs, withLibLBI, withExeLBI, LocalBuildInfo(), ComponentLocalBuildInfo(componentPackageDeps) ) +import Distribution.Types.PackageName (PackageName, unPackageName) +import Distribution.Types.UnqualComponentName (unUnqualComponentName) import Distribution.Verbosity ( Verbosity ) +import Distribution.Version ( showVersion ) import System.FilePath ( () ) main :: IO () @@ -29,27 +31,28 @@ generateBuildModule verbosity pkg lbi = do createDirectoryIfMissingVerbose verbosity True dir withLibLBI pkg lbi $ \_ libcfg -> do withExeLBI pkg lbi $ \exe clbi -> - rewriteFile (dir "Build_" ++ exeName exe ++ ".hs") $ unlines - [ "module Build_" ++ exeName exe ++ " where" + rewriteFile (dir "Build_" ++ exeName' exe ++ ".hs") $ unlines + [ "module Build_" ++ exeName' exe ++ " where" , "" , "deps :: [String]" , "deps = " ++ (show $ formatdeps (transDeps libcfg clbi)) ] where + exeName' = unUnqualComponentName . exeName formatdeps = map formatone . sortBy (comparing unPackageName') formatone p = unPackageName' p ++ "-" ++ showVersion (packageVersion p) - unPackageName' p = case packageName p of PackageName n -> n + unPackageName' = unPackageName . packageName transDeps xs ys = either (map sourcePackageId . allPackages) handleDepClosureFailure $ dependencyClosure allInstPkgsIdx availInstPkgIds where allInstPkgsIdx = installedPkgs lbi allInstPkgIds = map installedPackageId $ allPackages allInstPkgsIdx -- instPkgIds includes `stack-X.X.X`, which is not a depedency hence is missing from allInstPkgsIdx. Filter that out. - availInstPkgIds = filter (`elem` allInstPkgIds) . map fst $ testDeps xs ys + availInstPkgIds = filter (`elem` allInstPkgIds) $ testDeps xs ys handleDepClosureFailure unsatisfied = error $ "Computation of transitive dependencies failed." ++ if null unsatisfied then "" else " Unresolved dependencies: " ++ show unsatisfied -testDeps :: ComponentLocalBuildInfo -> ComponentLocalBuildInfo -> [(InstalledPackageId, PackageId)] -testDeps xs ys = nub $ componentPackageDeps xs ++ componentPackageDeps ys +testDeps :: ComponentLocalBuildInfo -> ComponentLocalBuildInfo -> [InstalledPackageId] +testDeps xs ys = map fst $ nub $ componentPackageDeps xs ++ componentPackageDeps ys diff --git a/src/Stack/Build/ConstructPlan.hs b/src/Stack/Build/ConstructPlan.hs index d8de1e0873..9f95b75419 100644 --- a/src/Stack/Build/ConstructPlan.hs +++ b/src/Stack/Build/ConstructPlan.hs @@ -790,7 +790,7 @@ packageDepsWithTools p = do ctx <- ask -- TODO: it would be cool to defer these warnings until there's an -- actual issue building the package. - let toEither (Cabal.Dependency (Cabal.PackageName name) _) mp = + let toEither (Cabal.Dependency (Cabal.unPackageName -> name) _) mp = case Map.toList mp of [] -> Left (NoToolFound name (packageName p)) [_] -> Right mp diff --git a/src/Stack/BuildPlan.hs b/src/Stack/BuildPlan.hs index b3aeeea7dd..7e44b5aab3 100644 --- a/src/Stack/BuildPlan.hs +++ b/src/Stack/BuildPlan.hs @@ -44,6 +44,7 @@ import Distribution.PackageDescription (GenericPackageDescription, flagName, genPackageFlags, condExecutables) import qualified Distribution.PackageDescription as C +import qualified Distribution.Types.UnqualComponentName as C import Distribution.System (Platform) import Distribution.Text (display) import qualified Distribution.Version as C @@ -186,7 +187,7 @@ getToolMap ls locals = -- worse case scenario is we build an extra package that wasn't -- strictly needed. gpdExes :: GenericPackageDescription -> [Text] - gpdExes = map (T.pack . fst) . condExecutables + gpdExes = map (T.pack . C.unUnqualComponentName . fst) . condExecutables gpdPackages :: [GenericPackageDescription] -> Map PackageName Version gpdPackages gpds = Map.fromList $ diff --git a/src/Stack/Config.hs b/src/Stack/Config.hs index 1db1ff97e3..580e54c7c3 100644 --- a/src/Stack/Config.hs +++ b/src/Stack/Config.hs @@ -58,9 +58,10 @@ import qualified Data.Text as T import Data.Text.Encoding (encodeUtf8) import qualified Data.Yaml as Yaml import qualified Distribution.PackageDescription as C +import qualified Distribution.Types.UnqualComponentName as C import Distribution.System (OS (..), Platform (..), buildPlatform, Arch(OtherArch)) import qualified Distribution.Text -import Distribution.Version (simplifyVersionRange) +import Distribution.Version (simplifyVersionRange, mkVersion') import GHC.Conc (getNumProcessors) import Lens.Micro (lens) import Network.HTTP.Client (parseUrlThrow) @@ -471,7 +472,7 @@ loadConfigMaybeProject configArgs mresolver mproject = do LCSNoConfig _ -> configNoLocalConfig stackRoot mresolver configArgs LCSProject project -> loadHelper $ Just project LCSNoProject -> loadHelper Nothing - unless (fromCabalVersion Meta.version `withinRange` configRequireStackVersion config) + unless (fromCabalVersion (mkVersion' Meta.version) `withinRange` configRequireStackVersion config) (throwM (BadStackVersionException (configRequireStackVersion config))) let mprojectRoot = fmap (\(_, fp, _) -> parent fp) mproject @@ -687,9 +688,9 @@ getLocalPackages = do ] where go :: (T.Text -> NamedComponent) - -> (C.GenericPackageDescription -> [String]) + -> (C.GenericPackageDescription -> [C.UnqualComponentName]) -> [NamedComponent] - go wrapper f = map (wrapper . T.pack) $ f gpkg + go wrapper f = map (wrapper . T.pack . C.unUnqualComponentName) $ f gpkg -- | Check if there are any duplicate package names and, if so, throw an -- exception. diff --git a/src/Stack/Init.hs b/src/Stack/Init.hs index e8381e8edc..0231058af4 100644 --- a/src/Stack/Init.hs +++ b/src/Stack/Init.hs @@ -293,7 +293,7 @@ renderStackYaml p ignoredPackages dupPackages = footerHelp = let major = toCabalVersion - $ toMajorVersion $ fromCabalVersion Meta.version + $ toMajorVersion $ fromCabalVersion $ C.mkVersion' Meta.version in commentHelp [ "Control whether we use the GHC we find on the path" , "system-ghc: true" diff --git a/src/Stack/Options/Completion.hs b/src/Stack/Options/Completion.hs index e316095d45..af26b2efac 100644 --- a/src/Stack/Options/Completion.hs +++ b/src/Stack/Options/Completion.hs @@ -18,6 +18,7 @@ import Data.Maybe import qualified Data.Set as Set import qualified Data.Text as T import qualified Distribution.PackageDescription as C +import qualified Distribution.Types.UnqualComponentName as C import Options.Applicative import Options.Applicative.Builder.Extra import Stack.Config (getLocalPackages) @@ -89,8 +90,8 @@ flagCompleter = buildConfigCompleter $ \input -> do (C.genPackageFlags (lpvGPD lpv))) $ Map.toList lpvs flagString name fl = - case C.flagName fl of - C.FlagName flname -> (if flagEnabled name fl then "-" else "") ++ flname + let flname = C.unFlagName $ C.flagName fl + in (if flagEnabled name fl then "-" else "") ++ flname flagEnabled name fl = fromMaybe (C.flagDefault fl) $ Map.lookup (fromCabalFlagName (C.flagName fl)) $ @@ -107,5 +108,5 @@ projectExeCompleter = buildConfigCompleter $ \input -> do return $ filter (input `isPrefixOf`) $ nubOrd $ - concatMap (\(_, lpv) -> map fst (C.condExecutables (lpvGPD lpv))) $ + concatMap (\(_, lpv) -> map (C.unUnqualComponentName . fst) (C.condExecutables (lpvGPD lpv))) $ Map.toList lpvs diff --git a/src/Stack/Package.hs b/src/Stack/Package.hs index a2f15a3c18..333001a070 100644 --- a/src/Stack/Package.hs +++ b/src/Stack/Package.hs @@ -51,7 +51,6 @@ import qualified Data.Set as S import qualified Data.Text as T import Data.Text.Encoding (decodeUtf8, decodeUtf8With) import Data.Text.Encoding.Error (lenientDecode) -import Data.Version (showVersion) import Distribution.Compiler import Distribution.ModuleName (ModuleName) import qualified Distribution.ModuleName as Cabal @@ -65,7 +64,13 @@ import Distribution.ParseUtils import Distribution.Simple.Utils import Distribution.System (OS (..), Arch, Platform (..)) import qualified Distribution.Text as D +import qualified Distribution.Types.CondTree as Cabal +import qualified Distribution.Types.Dependency as Cabal +import qualified Distribution.Types.ExeDependency as Cabal +import qualified Distribution.Types.LegacyExeDependency as Cabal +import qualified Distribution.Types.UnqualComponentName as Cabal import qualified Distribution.Verbosity as D +import Distribution.Version (showVersion) import qualified Hpack import qualified Hpack.Config as Hpack import Path as FL @@ -115,7 +120,7 @@ readPackageUnresolvedBS mcabalfp bs = rawParseGPD :: BS.ByteString -> Either PError ([PWarning], GenericPackageDescription) rawParseGPD bs = - case parsePackageDescription chars of + case parseGenericPackageDescription chars of ParseFailed per -> Left per ParseOk warnings gpkg -> Right (warnings,gpkg) where @@ -215,7 +220,9 @@ packageFromPackageDescription packageConfig pkgFlags pkg = , packageLicense = license pkg , packageDeps = deps , packageFiles = pkgFiles - , packageTools = packageDescTools pkg + , packageTools = map + (\(Cabal.ExeDependency name' _ range) -> Cabal.Dependency name' range) + (packageDescTools pkg) , packageGhcOptions = packageConfigGhcOptions packageConfig , packageFlags = packageConfigFlags packageConfig , packageDefaultFlags = M.fromList @@ -223,13 +230,14 @@ packageFromPackageDescription packageConfig pkgFlags pkg = , packageAllDeps = S.fromList (M.keys deps) , packageHasLibrary = maybe False (buildable . libBuildInfo) (library pkg) , packageTests = M.fromList - [(T.pack (testName t), testInterface t) | t <- testSuites pkg + [(T.pack (Cabal.unUnqualComponentName $ testName t), testInterface t) | t <- testSuites pkg , buildable (testBuildInfo t)] , packageBenchmarks = S.fromList - [T.pack (benchmarkName biBuildInfo) | biBuildInfo <- benchmarks pkg + [T.pack (Cabal.unUnqualComponentName $ benchmarkName biBuildInfo) | biBuildInfo <- benchmarks pkg , buildable (benchmarkBuildInfo biBuildInfo)] , packageExes = S.fromList - [T.pack (exeName biBuildInfo) | biBuildInfo <- executables pkg + [T.pack (Cabal.unUnqualComponentName $ exeName biBuildInfo) + | biBuildInfo <- executables pkg , buildable (buildInfo biBuildInfo)] -- This is an action used to collect info needed for "stack ghci". -- This info isn't usually needed, so computation of it is deferred. @@ -336,19 +344,19 @@ generatePkgDescOpts sourceMap installedMap omitPkgs addPkgs cabalfp pkg componen , fmap (\exe -> generate - (CExe (T.pack (exeName exe))) + (CExe (T.pack (Cabal.unUnqualComponentName (exeName exe)))) (buildInfo exe)) (executables pkg) , fmap (\bench -> generate - (CBench (T.pack (benchmarkName bench))) + (CBench (T.pack (Cabal.unUnqualComponentName (benchmarkName bench)))) (benchmarkBuildInfo bench)) (benchmarks pkg) , fmap (\test -> generate - (CTest (T.pack (testName test))) + (CTest (T.pack (Cabal.unUnqualComponentName (testName test)))) (testBuildInfo test)) (testSuites pkg)])) where @@ -529,13 +537,13 @@ packageDependencies pkg = packageToolDependencies :: PackageDescription -> Map Text VersionRange packageToolDependencies = M.fromList . - concatMap (fmap (packageNameText . depName &&& depRange) . + concatMap (fmap (\(Cabal.LegacyExeDependency name range) -> (T.pack name, range)) . buildTools) . allBuildInfo' -- | Get all dependencies of the package (buildable targets only). -packageDescTools :: PackageDescription -> [Dependency] -packageDescTools = concatMap buildTools . allBuildInfo' +packageDescTools :: PackageDescription -> [Cabal.ExeDependency] +packageDescTools = concatMap buildToolDepends . allBuildInfo' -- | This is a copy-paste from Cabal's @allBuildInfo@ function, but with the -- @buildable@ test removed. The implementation is broken. @@ -549,12 +557,10 @@ allBuildInfo' pkg_descr = [ bi | Just lib <- [library pkg_descr] , True || buildable bi ] ++ [ bi | tst <- testSuites pkg_descr , let bi = testBuildInfo tst - , True || buildable bi - , testEnabled tst ] + , True || buildable bi ] ++ [ bi | tst <- benchmarks pkg_descr , let bi = benchmarkBuildInfo tst - , True || buildable bi - , benchmarkEnabled tst ] + , True || buildable bi ] -- | Get all files referenced by the package. packageDescModulesAndFiles @@ -594,9 +600,9 @@ packageDescModulesAndFiles pkg = do return (modules, files, dfiles, warnings) where libComponent = const CLib - exeComponent = CExe . T.pack . exeName - testComponent = CTest . T.pack . testName - benchComponent = CBench . T.pack . benchmarkName + exeComponent = CExe . T.pack . Cabal.unUnqualComponentName . exeName + testComponent = CTest . T.pack . Cabal.unUnqualComponentName . testName + benchComponent = CBench . T.pack . Cabal.unUnqualComponentName . benchmarkName asModuleAndFileMap label f lib = do (a,b,c) <- f lib return (M.singleton (label lib) a, M.singleton (label lib) b, c) @@ -649,7 +655,7 @@ resolveGlobFiles = -- matchDirFileGlob_ :: (MonadLogger m, MonadIO m) => String -> String -> m [String] matchDirFileGlob_ dir filepath = case parseFileGlob filepath of - Nothing -> liftIO $ die $ + Nothing -> liftIO $ throwString $ "invalid file glob '" ++ filepath ++ "'. Wildcards '*' are only allowed in place of the file" ++ " name, not in the directory name or file extension." @@ -679,7 +685,7 @@ benchmarkFiles bench = do dir <- asks (parent . fst) (modules,files,warnings) <- resolveFilesAndDeps - (Just $ benchmarkName bench) + (Just $ Cabal.unUnqualComponentName $ benchmarkName bench) (dirs ++ [dir]) (bnames <> exposed) haskellModuleExts @@ -703,7 +709,7 @@ testFiles test = do dir <- asks (parent . fst) (modules,files,warnings) <- resolveFilesAndDeps - (Just $ testName test) + (Just $ Cabal.unUnqualComponentName $ testName test) (dirs ++ [dir]) (bnames <> exposed) haskellModuleExts @@ -728,7 +734,7 @@ executableFiles exe = do dir <- asks (parent . fst) (modules,files,warnings) <- resolveFilesAndDeps - (Just $ exeName exe) + (Just $ Cabal.unUnqualComponentName $ exeName exe) (dirs ++ [dir]) (map DotCabalModule (otherModules build) ++ [DotCabalMain (modulePath exe)]) @@ -780,7 +786,7 @@ targetJsSources = jsSources resolvePackageDescription :: PackageConfig -> GenericPackageDescription -> PackageDescription -resolvePackageDescription packageConfig (GenericPackageDescription desc defaultFlags mlib exes tests benches) = +resolvePackageDescription packageConfig (GenericPackageDescription desc defaultFlags mlib _subLibs _foreignLibs exes tests benches) = desc {library = fmap (resolveConditions rc updateLibDeps) mlib ,executables = @@ -809,12 +815,18 @@ resolvePackageDescription packageConfig (GenericPackageDescription desc defaultF (buildInfo exe) {targetBuildDepends = deps}} updateTestDeps test deps = test {testBuildInfo = - (testBuildInfo test) {targetBuildDepends = deps} - ,testEnabled = packageConfigEnableTests packageConfig} + (testBuildInfo test) + { targetBuildDepends = deps + , buildable = packageConfigEnableTests packageConfig + } + } updateBenchmarkDeps benchmark deps = benchmark {benchmarkBuildInfo = - (benchmarkBuildInfo benchmark) {targetBuildDepends = deps} - ,benchmarkEnabled = packageConfigEnableBenchmarks packageConfig} + (benchmarkBuildInfo benchmark) + { targetBuildDepends = deps + , buildable = packageConfigEnableBenchmarks packageConfig + } + } -- | Make a map from a list of flag specifications. -- @@ -852,7 +864,7 @@ resolveConditions :: (Monoid target,Show target) resolveConditions rc addDeps (CondNode lib deps cs) = basic <> children where basic = addDeps lib deps children = mconcat (map apply cs) - where apply (cond,node,mcs) = + where apply (Cabal.CondBranch cond node mcs) = if condSatisfied cond then resolveConditions rc addDeps node else maybe mempty (resolveConditions rc addDeps) mcs @@ -1254,10 +1266,10 @@ cabalFilePackageId :: (MonadIO m, MonadThrow m) => Path Abs File -> m PackageIdentifier cabalFilePackageId fp = do - pkgDescr <- liftIO (D.readPackageDescription D.silent $ toFilePath fp) + pkgDescr <- liftIO (D.readGenericPackageDescription D.silent $ toFilePath fp) (toStackPI . D.package . D.packageDescription) pkgDescr where - toStackPI (D.PackageIdentifier (D.PackageName name) ver) = do + toStackPI (D.PackageIdentifier (D.unPackageName -> name) ver) = do name' <- parsePackageNameFromString name ver' <- parseVersionFromString (showVersion ver) return (PackageIdentifier name' ver') diff --git a/src/Stack/Setup.hs b/src/Stack/Setup.hs index 53ad9e8f9a..f9880e06c7 100644 --- a/src/Stack/Setup.hs +++ b/src/Stack/Setup.hs @@ -62,6 +62,7 @@ import qualified Data.Yaml as Yaml import Distribution.System (OS (Linux), Arch (..), Platform (..)) import qualified Distribution.System as Cabal import Distribution.Text (simpleParse) +import Distribution.Version (mkVersion') import Lens.Micro (set) import Network.HTTP.Simple (getResponseBody, httpLBS, withResponse, getResponseStatusCode) import Network.HTTP.Download @@ -1904,4 +1905,4 @@ getDownloadVersion (StackReleaseInfo val) = do parseVersion $ T.drop 1 rawName stackVersion :: Version -stackVersion = fromCabalVersion Meta.version +stackVersion = fromCabalVersion (mkVersion' Meta.version) diff --git a/src/Stack/Snapshot.hs b/src/Stack/Snapshot.hs index 8470dea9cb..24b4072b64 100644 --- a/src/Stack/Snapshot.hs +++ b/src/Stack/Snapshot.hs @@ -42,6 +42,7 @@ import Data.Yaml (decodeFileEither, ParseException (AesonException)) import Distribution.InstalledPackageInfo (PError) import Distribution.PackageDescription (GenericPackageDescription) import qualified Distribution.PackageDescription as C +import qualified Distribution.Types.UnqualComponentName as C import Distribution.System (Platform) import Distribution.Text (display) import qualified Distribution.Version as C @@ -779,7 +780,10 @@ calculate gpd platform compilerVersion loc flags hide options = , lpiPackageDeps = Map.map fromVersionRange $ Map.filterWithKey (const . (/= name)) $ packageDependencies pd - , lpiProvidedExes = Set.fromList $ map (ExeName . T.pack . C.exeName) $ C.executables pd + , lpiProvidedExes = + Set.fromList + $ map (ExeName . T.pack . C.unUnqualComponentName . C.exeName) + $ C.executables pd , lpiNeededExes = Map.mapKeys ExeName $ Map.map fromVersionRange $ packageToolDependencies pd diff --git a/src/Stack/Types/Config.hs b/src/Stack/Types/Config.hs index c60b585c2d..926f264faf 100644 --- a/src/Stack/Types/Config.hs +++ b/src/Stack/Types/Config.hs @@ -192,7 +192,7 @@ import Distribution.PackageDescription (GenericPackageDescription) import Distribution.ParseUtils (PError) import Distribution.System (Platform) import qualified Distribution.Text -import Distribution.Version (anyVersion) +import Distribution.Version (anyVersion, mkVersion') import Generics.Deriving.Monoid (memptydefault, mappenddefault) import Lens.Micro (Lens', lens, _1, _2, to) import Options.Applicative (ReadM) @@ -1007,7 +1007,7 @@ instance Show ConfigException where ] show (BadStackVersionException requiredRange) = concat [ "The version of stack you are using (" - , show (fromCabalVersion Meta.version) + , show (fromCabalVersion (mkVersion' Meta.version)) , ") is outside the required\n" ,"version range specified in stack.yaml (" , T.unpack (versionRangeText requiredRange) diff --git a/src/Stack/Types/FlagName.hs b/src/Stack/Types/FlagName.hs index 240b9b429a..4ed38e8cf7 100644 --- a/src/Stack/Types/FlagName.hs +++ b/src/Stack/Types/FlagName.hs @@ -111,12 +111,12 @@ flagNameText (FlagName n) = n -- | Convert from a Cabal flag name. fromCabalFlagName :: Cabal.FlagName -> FlagName -fromCabalFlagName (Cabal.FlagName name) = - let !x = T.pack name +fromCabalFlagName name = + let !x = T.pack $ Cabal.unFlagName name in FlagName x -- | Convert to a Cabal flag name. toCabalFlagName :: FlagName -> Cabal.FlagName toCabalFlagName (FlagName name) = let !x = T.unpack name - in Cabal.FlagName x + in Cabal.mkFlagName x diff --git a/src/Stack/Types/PackageName.hs b/src/Stack/Types/PackageName.hs index de5fdb27c4..e31fe19c78 100644 --- a/src/Stack/Types/PackageName.hs +++ b/src/Stack/Types/PackageName.hs @@ -112,15 +112,15 @@ packageNameText (PackageName n) = n -- | Convert from a Cabal package name. fromCabalPackageName :: Cabal.PackageName -> PackageName -fromCabalPackageName (Cabal.PackageName name) = - let !x = T.pack name +fromCabalPackageName name = + let !x = T.pack $ Cabal.unPackageName name in PackageName x -- | Convert to a Cabal package name. toCabalPackageName :: PackageName -> Cabal.PackageName toCabalPackageName (PackageName name) = let !x = T.unpack name - in Cabal.PackageName x + in Cabal.mkPackageName x -- | Parse a package name from a file path. parsePackageNameFromFilePath :: MonadThrow m => Path a File -> m PackageName diff --git a/src/Stack/Types/Version.hs b/src/Stack/Types/Version.hs index 457db8d775..d2e4ba441e 100644 --- a/src/Stack/Types/Version.hs +++ b/src/Stack/Types/Version.hs @@ -139,12 +139,12 @@ versionText (Version v) = -- | Convert to a Cabal version. toCabalVersion :: Version -> Cabal.Version toCabalVersion (Version v) = - Cabal.Version (map fromIntegral (V.toList v)) [] + Cabal.mkVersion (map fromIntegral (V.toList v)) -- | Convert from a Cabal version. fromCabalVersion :: Cabal.Version -> Version -fromCabalVersion (Cabal.Version vs _) = - let !v = V.fromList (map fromIntegral vs) +fromCabalVersion vs = + let !v = V.fromList (map fromIntegral (Cabal.versionNumbers vs)) in Version v -- | Make a package version. diff --git a/src/Stack/Upgrade.hs b/src/Stack/Upgrade.hs index 5664381169..a596c059f0 100644 --- a/src/Stack/Upgrade.hs +++ b/src/Stack/Upgrade.hs @@ -17,6 +17,7 @@ import qualified Data.HashMap.Strict as HashMap import qualified Data.List import qualified Data.Map as Map import qualified Data.Text as T +import Distribution.Version (mkVersion') import Lens.Micro (set) import Options.Applicative import Path @@ -218,7 +219,7 @@ sourceUpgrade gConfigMonoid mresolver builtHash (SourceOpts gitRepo) = when (null versions) (throwString "No stack found in package indices") let version = Data.List.maximum versions - if version <= fromCabalVersion Paths.version + if version <= fromCabalVersion (mkVersion' Paths.version) then do $logInfo "Already at latest version, no upgrade required" return Nothing diff --git a/src/main/Main.hs b/src/main/Main.hs index e9d7912855..175f0d860a 100644 --- a/src/main/Main.hs +++ b/src/main/Main.hs @@ -35,6 +35,7 @@ import Development.GitRev (gitCommitCount, gitHash) #endif import Distribution.System (buildArch, buildPlatform) import Distribution.Text (display) +import Distribution.Version (mkVersion') import GHC.IO.Encoding (mkTextEncoding, textEncodingName) import Lens.Micro import Options.Applicative @@ -174,7 +175,7 @@ main = do case globalReExecVersion global of Just expectVersion -> do expectVersion' <- parseVersionFromString expectVersion - unless (checkVersion MatchMinor expectVersion' (fromCabalVersion Meta.version)) + unless (checkVersion MatchMinor expectVersion' (fromCabalVersion (mkVersion' Meta.version))) $ throwIO $ InvalidReExecVersion expectVersion (showVersion Meta.version) _ -> return () run global `catch` \e -> diff --git a/stack-7.10.yaml b/stack-7.10.yaml index 22e202bcfe..25567e0979 100644 --- a/stack-7.10.yaml +++ b/stack-7.10.yaml @@ -15,7 +15,7 @@ flags: mintty: win32-2-5: false extra-deps: -- Cabal-1.24.2.0 +- Cabal-2.0.0.2 - th-utilities-0.2.0.1 - store-0.4.1 - store-core-0.4 diff --git a/stack-nightly.yaml b/stack-nightly.yaml index 991ef482d1..31290d5409 100644 --- a/stack-nightly.yaml +++ b/stack-nightly.yaml @@ -13,5 +13,6 @@ flags: mintty: win32-2-5: false extra-deps: +- Cabal-2.0.0.2 - mintty-0.1.1 - text-metrics-0.3.0 diff --git a/stack.cabal b/stack.cabal index b72544da8b..170d34bd75 100644 --- a/stack.cabal +++ b/stack.cabal @@ -31,7 +31,7 @@ extra-source-files: CONTRIBUTING.md custom-setup setup-depends: base - , Cabal + , Cabal >= 2.0 && < 2.1 , filepath flag integration-tests @@ -187,7 +187,7 @@ library System.Process.Read System.Process.Run other-modules: Hackage.Security.Client.Repository.HttpLib.HttpClient - build-depends: Cabal >= 1.24 && < 1.25 + build-depends: Cabal >= 2.0 && < 2.1 , aeson (>= 1.0 && < 1.2) , ansi-terminal >= 0.6.2.3 , attoparsec >= 0.12.1.5 && < 0.14 @@ -284,7 +284,7 @@ executable stack if flag(static) ld-options: -static -pthread - build-depends: Cabal >= 1.18.1.5 && < 1.25 + build-depends: Cabal >= 2.0 && < 2.1 , base >=4.7 && < 5 , bytestring >= 0.10.4.0 , conduit >= 1.2.8 @@ -335,7 +335,7 @@ test-suite stack-test , Stack.SolverSpec , Stack.Untar.UntarSpec ghc-options: -threaded -Wall -fwarn-tabs -fwarn-incomplete-uni-patterns -fwarn-incomplete-record-updates - build-depends: Cabal >= 1.18.1.5 && < 1.25 + build-depends: Cabal >= 2.0 && < 2.1 , QuickCheck >= 2.8.2 && < 2.10 , attoparsec < 0.14 , base >=4.7 && <5 diff --git a/stack.yaml b/stack.yaml index 19c9ccdac7..b929ca3b6c 100644 --- a/stack.yaml +++ b/stack.yaml @@ -17,6 +17,7 @@ flags: mintty: win32-2-5: false extra-deps: +- Cabal-2.0.0.2 - mintty-0.1.1 - text-metrics-0.3.0 - unliftio-core-0.1.0.0