diff --git a/cabal-install/cabal-install.cabal b/cabal-install/cabal-install.cabal index deba8082655..618f5f45100 100644 --- a/cabal-install/cabal-install.cabal +++ b/cabal-install/cabal-install.cabal @@ -90,6 +90,7 @@ library Distribution.Client.CmdInstall.ClientInstallTargetSelector Distribution.Client.CmdLegacy Distribution.Client.CmdListBin + Distribution.Client.CmdOutdated Distribution.Client.CmdRepl Distribution.Client.CmdRun Distribution.Client.CmdSdist diff --git a/cabal-install/src/Distribution/Client/CmdOutdated.hs b/cabal-install/src/Distribution/Client/CmdOutdated.hs new file mode 100644 index 00000000000..fccffa1bd8f --- /dev/null +++ b/cabal-install/src/Distribution/Client/CmdOutdated.hs @@ -0,0 +1,203 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE RankNTypes #-} + +-- | cabal-install CLI command: outdated +module Distribution.Client.CmdOutdated + ( outdatedCommand + , outdatedAction + ) where + +import Distribution.Client.Compat.Prelude +import Prelude () + +import Distribution.Client.Config + ( SavedConfig + ( savedGlobalFlags + ) + ) +import qualified Distribution.Client.IndexUtils as IndexUtils +import Distribution.Client.NixStyleOptions + ( NixStyleFlags (..) + , defaultNixStyleFlags + , nixStyleOptions + ) +import Distribution.Client.Errors (CabalInstallException (OutdatedAction)) +import Distribution.Client.Outdated + ( OutdatedFlags (..) + ) +import qualified Distribution.Client.Outdated as V1Outdated +import Distribution.Client.ProjectConfig + ( ProjectConfig (..) + , commandLineFlagsToProjectConfig + , fetchAndReadSourcePackages + , findProjectPackages + ) +import Distribution.Client.ProjectFlags + ( ProjectFlags (..) + ) +import Distribution.Client.ProjectOrchestration + ( CurrentCommand (..) + , ProjectBaseContext (..) + , establishProjectBaseContext + ) +import Distribution.Client.RebuildMonad + ( runRebuild + ) +import Distribution.Client.Sandbox + ( loadConfigOrSandboxConfig + ) +import Distribution.Client.Types.PackageLocation + ( UnresolvedPkgLoc + ) +import Distribution.Client.Types.PackageSpecifier + ( PackageSpecifier (..) + ) +import Distribution.Solver.Types.SourcePackage + ( SourcePackage (..) + ) +import Distribution.Client.Setup + ( GlobalFlags (..) + , withRepoContext + ) +import Distribution.Simple.Flag + ( Flag (..) + , flagToMaybe + , fromFlagOrDefault + ) +import Distribution.Simple.Utils + ( debug + , dieWithException + , wrapText + ) +import Distribution.Types.GenericPackageDescription + ( GenericPackageDescription (..) + ) +import Distribution.Types.UnqualComponentName (UnqualComponentName) +import Distribution.Types.PackageVersionConstraint + ( PackageVersionConstraint (..) + ) +import Distribution.Types.CondTree + ( CondTree (..) + , ignoreConditions + ) +import Distribution.Types.Dependency (Dependency (..)) +import Distribution.Verbosity + ( normal + , silent + ) +import Distribution.Version + ( simplifyVersionRange + ) +import Distribution.Simple.Command + ( CommandUI (..) + , usageAlternatives + ) + + +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 + + withRepoContext verbosity globalFlags' $ \repoContext -> do + when (isJust mprojectDir || isJust mprojectFile) $ + dieWithException verbosity OutdatedAction + + sourcePkgDb <- IndexUtils.getSourcePackages verbosity repoContext + + projectBaseContext <- establishProjectBaseContext verbosity cliConfig OtherCommand + + packageSpecifierList <- + runRebuild "." $ do + plList <- findProjectPackages (distDirLayout projectBaseContext) (projectConfig projectBaseContext) + fetchAndReadSourcePackages verbosity (distDirLayout projectBaseContext) + (projectConfigShared $ projectConfig projectBaseContext) + (projectConfigBuildOnly $ projectConfig projectBaseContext) + plList + + + let packageVersionConstraintList = extractPackageVersionConstraints packageSpecifierList + + debug verbosity $ + "Dependencies loaded: " + ++ intercalate ", " (map prettyShow packageVersionConstraintList) + + let outdatedDeps = V1Outdated.listOutdated packageVersionConstraintList sourcePkgDb (V1Outdated.ListOutdatedSettings (const True) (const True)) + + 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 + + simpleOutput = fromFlagOrDefault False (Flag False) -- outdatedSimpleOutput + exitCode = fromFlagOrDefault quiet (Flag False) -- outdatedExitCode + quiet = fromFlagOrDefault False (Flag False) -- outdatedQuiet + verbosity = + if quiet + then silent + else fromFlagOrDefault normal (outdatedVerbosity outdatedFlags) + + outdatedFlags :: OutdatedFlags + outdatedFlags = extraFlags flags + +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 diff --git a/cabal-install/src/Distribution/Client/Main.hs b/cabal-install/src/Distribution/Client/Main.hs index d8e66c63b8a..854e70cab81 100644 --- a/cabal-install/src/Distribution/Client/Main.hs +++ b/cabal-install/src/Distribution/Client/Main.hs @@ -127,6 +127,7 @@ import qualified Distribution.Client.CmdHaddockProject as CmdHaddockProject import qualified Distribution.Client.CmdInstall as CmdInstall import Distribution.Client.CmdLegacy import qualified Distribution.Client.CmdListBin as CmdListBin +import qualified Distribution.Client.CmdOutdated as CmdOutdated import qualified Distribution.Client.CmdRepl as CmdRepl import qualified Distribution.Client.CmdRun as CmdRun import qualified Distribution.Client.CmdSdist as CmdSdist @@ -416,6 +417,7 @@ mainWorker args = do , newCmd CmdBench.benchCommand CmdBench.benchAction , newCmd CmdExec.execCommand CmdExec.execAction , newCmd CmdClean.cleanCommand CmdClean.cleanAction + , newCmd CmdOutdated.outdatedCommand CmdOutdated.outdatedAction , newCmd CmdSdist.sdistCommand CmdSdist.sdistAction , legacyCmd configureExCommand configureAction , legacyCmd buildCommand buildAction diff --git a/cabal-install/src/Distribution/Client/Outdated.hs b/cabal-install/src/Distribution/Client/Outdated.hs index 49b264c4969..9c5e17c8ca9 100644 --- a/cabal-install/src/Distribution/Client/Outdated.hs +++ b/cabal-install/src/Distribution/Client/Outdated.hs @@ -14,10 +14,14 @@ -- Implementation of the 'outdated' command. Checks for outdated -- dependencies in the package description file or freeze file. module Distribution.Client.Outdated - ( outdatedCommand + ( ListOutdatedSettings (..) + , OutdatedFlags (..) + , defaultOutdatedFlags , outdatedAction - , ListOutdatedSettings (..) + , outdatedCommand + , outdatedOptions , listOutdated + , showResult ) where