Implementation of v2-outdated command

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

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

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

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