-
Notifications
You must be signed in to change notification settings - Fork 697
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
Implementation of v2-outdated command
When the `Outdated.hs` module gets dropped, some parts of that module that are used in this one, should be moved to this module.
- Loading branch information
Showing
5 changed files
with
243 additions
and
13 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,216 @@ | ||
| {-# LANGUAGE MultiWayIf #-} | ||
| {-# LANGUAGE NamedFieldPuns #-} | ||
| {-# LANGUAGE RankNTypes #-} | ||
|
|
||
| -- | cabal-install CLI command: outdated | ||
| module Distribution.Client.CmdOutdated | ||
| ( outdatedCommand | ||
| , outdatedAction | ||
| ) where | ||
|
|
||
| import qualified Data.Set as Set | ||
|
|
||
| import Distribution.Client.Compat.Prelude | ||
|
|
||
| import Distribution.Client.Config | ||
| ( SavedConfig | ||
| ( savedGlobalFlags | ||
| ) | ||
| ) | ||
| import Distribution.Client.Errors (CabalInstallException (OutdatedAction)) | ||
| import qualified Distribution.Client.IndexUtils as IndexUtils | ||
| import Distribution.Client.NixStyleOptions | ||
| ( NixStyleFlags (..) | ||
| , defaultNixStyleFlags | ||
| , nixStyleOptions | ||
| ) | ||
| import Distribution.Client.Outdated | ||
| ( IgnoreMajorVersionBumps (..) | ||
| , ListOutdatedSettings (..) | ||
| , OutdatedFlags (..) | ||
| ) | ||
| import qualified Distribution.Client.Outdated as V1Outdated | ||
| import Distribution.Client.ProjectConfig | ||
| ( ProjectConfig (..) | ||
| , commandLineFlagsToProjectConfig | ||
| ) | ||
| import Distribution.Client.ProjectFlags | ||
| ( ProjectFlags (..) | ||
| ) | ||
| import Distribution.Client.ProjectOrchestration | ||
| ( CurrentCommand (..) | ||
| , ProjectBaseContext (..) | ||
| , establishProjectBaseContext | ||
| ) | ||
| import Distribution.Client.Sandbox | ||
| ( loadConfigOrSandboxConfig | ||
| ) | ||
| import Distribution.Client.Setup | ||
| ( GlobalFlags (..) | ||
| , configCompilerAux' | ||
| , withRepoContext | ||
| ) | ||
| import Distribution.Client.Types.PackageLocation | ||
| ( UnresolvedPkgLoc | ||
| ) | ||
| import Distribution.Client.Types.PackageSpecifier | ||
| ( PackageSpecifier (..) | ||
| ) | ||
| import Distribution.Simple.Command | ||
| ( CommandUI (..) | ||
| , usageAlternatives | ||
| ) | ||
| import Distribution.Simple.Flag | ||
| ( flagToMaybe | ||
| , fromFlagOrDefault | ||
| ) | ||
| import Distribution.Simple.Utils | ||
| ( debug | ||
| , dieWithException | ||
| , wrapText | ||
| ) | ||
| import Distribution.Solver.Types.SourcePackage | ||
| ( SourcePackage (..) | ||
| ) | ||
| import Distribution.Types.CondTree | ||
| ( CondTree (..) | ||
| , ignoreConditions | ||
| ) | ||
| import Distribution.Types.Dependency (Dependency (..)) | ||
| import Distribution.Types.GenericPackageDescription | ||
| ( GenericPackageDescription (..) | ||
| ) | ||
| import Distribution.Types.PackageName | ||
| ( PackageName | ||
| ) | ||
| import Distribution.Types.PackageVersionConstraint | ||
| ( PackageVersionConstraint (..) | ||
| ) | ||
| import Distribution.Types.UnqualComponentName (UnqualComponentName) | ||
| import Distribution.Verbosity | ||
| ( normal | ||
| , silent | ||
| ) | ||
| import Distribution.Version | ||
| ( simplifyVersionRange | ||
| ) | ||
|
|
||
| outdatedCommand :: CommandUI (NixStyleFlags OutdatedFlags) | ||
| outdatedCommand = | ||
| CommandUI | ||
| { commandName = "v2-outdated" | ||
| , commandSynopsis = "Check for outdated dependencies." | ||
| , commandUsage = usageAlternatives "v2-outdated" ["[FLAGS]", "[PACKAGES]"] | ||
| , commandDefaultFlags = defaultNixStyleFlags V1Outdated.defaultOutdatedFlags | ||
| , commandDescription = Just $ \_ -> | ||
| wrapText $ | ||
| "Checks for outdated dependencies in the package description file " | ||
| ++ "or freeze file" | ||
| , commandNotes = Nothing | ||
| , commandOptions = nixStyleOptions V1Outdated.outdatedOptions | ||
| } | ||
|
|
||
| -- | To a first approximation, the @outdated@ command runs the first phase of | ||
| -- the @build@ command where we bring the install plan up to date, and then | ||
| -- based on the install plan we write out a @cabal.project.outdated@ config file. | ||
| -- | ||
| -- For more details on how this works, see the module | ||
| -- "Distribution.Client.ProjectOrchestration" | ||
| outdatedAction :: NixStyleFlags OutdatedFlags -> [String] -> GlobalFlags -> IO () | ||
| outdatedAction flags _extraArgs globalFlags = do | ||
| let mprojectDir = flagToMaybe . flagProjectDir $ projectFlags flags | ||
| mprojectFile = flagToMaybe . flagProjectFile $ projectFlags flags | ||
|
|
||
| config <- loadConfigOrSandboxConfig verbosity globalFlags | ||
| let globalFlags' = savedGlobalFlags config `mappend` globalFlags | ||
|
|
||
| (comp, platform, _progdb) <- configCompilerAux' $ configFlags flags | ||
|
|
||
| withRepoContext verbosity globalFlags' $ \repoContext -> do | ||
| when (not v2FreezeFile && (isJust mprojectDir || isJust mprojectFile)) $ | ||
| dieWithException verbosity OutdatedAction | ||
|
|
||
| sourcePkgDb <- IndexUtils.getSourcePackages verbosity repoContext | ||
| prjBaseCtxt <- establishProjectBaseContext verbosity cliConfig OtherCommand | ||
| pkgVerConstraints <- | ||
| if | v1FreezeFile -> V1Outdated.depsFromFreezeFile verbosity | ||
| | v2FreezeFile -> | ||
| V1Outdated.depsFromNewFreezeFile verbosity globalFlags comp platform mprojectDir mprojectFile | ||
| | otherwise -> pure $ extractPackageVersionConstraints (localPackages prjBaseCtxt) | ||
|
|
||
| debug verbosity $ | ||
| "Dependencies loaded: " ++ intercalate ", " (map prettyShow pkgVerConstraints) | ||
|
|
||
| let outdatedDeps = V1Outdated.listOutdated pkgVerConstraints sourcePkgDb (ListOutdatedSettings ignorePred minorPred) | ||
|
|
||
| when (not quiet) $ | ||
| V1Outdated.showResult verbosity outdatedDeps simpleOutput | ||
| if exitCode && (not . null $ outdatedDeps) | ||
| then exitFailure | ||
| else pure () | ||
| where | ||
| cliConfig :: ProjectConfig | ||
| cliConfig = | ||
| commandLineFlagsToProjectConfig | ||
| globalFlags | ||
| flags | ||
| mempty -- ClientInstallFlags, not needed here | ||
|
|
||
| outdatedFlags :: OutdatedFlags | ||
| outdatedFlags = extraFlags flags | ||
|
|
||
| v1FreezeFile, v2FreezeFile, simpleOutput, exitCode, quiet :: Bool | ||
| v1FreezeFile = fromFlagOrDefault False $ outdatedFreezeFile outdatedFlags | ||
| v2FreezeFile = fromFlagOrDefault False $ outdatedNewFreezeFile outdatedFlags | ||
| simpleOutput = fromFlagOrDefault False $ outdatedSimpleOutput outdatedFlags | ||
| exitCode = fromFlagOrDefault quiet $ outdatedExitCode outdatedFlags | ||
| quiet = fromFlagOrDefault False $ outdatedQuiet outdatedFlags | ||
|
|
||
| ignorePred :: PackageName -> Bool | ||
| ignorePred = | ||
| let ignoreSet = Set.fromList $ outdatedIgnore outdatedFlags | ||
| in \pkgname -> pkgname `Set.member` ignoreSet | ||
|
|
||
| minorPred :: PackageName -> Bool | ||
| minorPred = | ||
| case outdatedMinor outdatedFlags of | ||
| Nothing -> const False | ||
| Just IgnoreMajorVersionBumpsNone -> const False | ||
| Just IgnoreMajorVersionBumpsAll -> const True | ||
| Just (IgnoreMajorVersionBumpsSome pkgs) -> | ||
| let minorSet = Set.fromList pkgs | ||
| in \pkgname -> pkgname `Set.member` minorSet | ||
|
|
||
| verbosity :: Verbosity | ||
| verbosity = | ||
| if quiet | ||
| then silent | ||
| else fromFlagOrDefault normal (outdatedVerbosity outdatedFlags) | ||
|
|
||
| extractPackageVersionConstraints :: [PackageSpecifier (SourcePackage UnresolvedPkgLoc)] -> [PackageVersionConstraint] | ||
| extractPackageVersionConstraints = | ||
| map toPackageVersionConstraint . concatMap genericPackageDependencies . mapMaybe getGenericPackageDescription | ||
| where | ||
| getGenericPackageDescription :: PackageSpecifier (SourcePackage UnresolvedPkgLoc) -> Maybe GenericPackageDescription | ||
| getGenericPackageDescription ps = | ||
| case ps of | ||
| NamedPackage{} -> Nothing | ||
| SpecificSourcePackage x -> Just $ srcpkgDescription x | ||
|
|
||
| toPackageVersionConstraint :: Dependency -> PackageVersionConstraint | ||
| toPackageVersionConstraint (Dependency name versionRange _) = | ||
| PackageVersionConstraint name (simplifyVersionRange versionRange) | ||
|
|
||
| genericPackageDependencies :: GenericPackageDescription -> [Dependency] | ||
| genericPackageDependencies gpd = | ||
| concat | ||
| [ maybe [] (snd . ignoreConditions) $ condLibrary gpd | ||
| , concatMap extract $ condSubLibraries gpd | ||
| , concatMap extract $ condForeignLibs gpd | ||
| , concatMap extract $ condExecutables gpd | ||
| , concatMap extract $ condTestSuites gpd | ||
| , concatMap extract $ condBenchmarks gpd | ||
| ] | ||
| where | ||
| extract :: forall a confVar. Semigroup a => (UnqualComponentName, CondTree confVar [Dependency] a) -> [Dependency] | ||
| extract = snd . ignoreConditions . snd |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,4 @@ | ||
| synopsis: Implpement v2-outdated command | ||
| packages: cabal-install | ||
| prs: #9373 | ||
| issues: |