Skip to content

Commit c9ad027

Browse files
erikderikd
committed
Implementation of v2-outdated command
1 parent 47b2bf8 commit c9ad027

File tree

4 files changed

+208
-2
lines changed

4 files changed

+208
-2
lines changed

‎cabal-install/cabal-install.cabal

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -90,6 +90,7 @@ library
9090
Distribution.Client.CmdInstall.ClientInstallTargetSelector
9191
Distribution.Client.CmdLegacy
9292
Distribution.Client.CmdListBin
93+
Distribution.Client.CmdOutdated
9394
Distribution.Client.CmdRepl
9495
Distribution.Client.CmdRun
9596
Distribution.Client.CmdSdist

‎cabal-install/src/Distribution/Client/CmdOutdated.hs

Lines changed: 199 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,199 @@
1+
{-# LANGUAGE CPP #-}
2+
{-# LANGUAGE NamedFieldPuns #-}
3+
{-# LANGUAGE RankNTypes #-}
4+
5+
-- | cabal-install CLI command: outdated
6+
module Distribution.Client.CmdOutdated
7+
( outdatedCommand
8+
, outdatedAction
9+
) where
10+
11+
import Distribution.Client.Compat.Prelude
12+
13+
import Distribution.Client.Config
14+
( SavedConfig
15+
( savedGlobalFlags
16+
)
17+
)
18+
import Distribution.Client.Errors (CabalInstallException (OutdatedAction))
19+
import qualified Distribution.Client.IndexUtils as IndexUtils
20+
import Distribution.Client.NixStyleOptions
21+
( NixStyleFlags (..)
22+
, defaultNixStyleFlags
23+
, nixStyleOptions
24+
)
25+
import Distribution.Client.Outdated
26+
( OutdatedFlags (..)
27+
)
28+
import qualified Distribution.Client.Outdated as V1Outdated
29+
import Distribution.Client.ProjectConfig
30+
( ProjectConfig (..)
31+
, commandLineFlagsToProjectConfig
32+
, fetchAndReadSourcePackages
33+
, findProjectPackages
34+
)
35+
import Distribution.Client.ProjectFlags
36+
( ProjectFlags (..)
37+
)
38+
import Distribution.Client.ProjectOrchestration
39+
( CurrentCommand (..)
40+
, ProjectBaseContext (..)
41+
, establishProjectBaseContext
42+
)
43+
import Distribution.Client.RebuildMonad
44+
( runRebuild
45+
)
46+
import Distribution.Client.Sandbox
47+
( loadConfigOrSandboxConfig
48+
)
49+
import Distribution.Client.Setup
50+
( GlobalFlags (..)
51+
, withRepoContext
52+
)
53+
import Distribution.Client.Types.PackageLocation
54+
( UnresolvedPkgLoc
55+
)
56+
import Distribution.Client.Types.PackageSpecifier
57+
( PackageSpecifier (..)
58+
)
59+
import Distribution.Simple.Command
60+
( CommandUI (..)
61+
, usageAlternatives
62+
)
63+
import Distribution.Simple.Flag
64+
( Flag (..)
65+
, flagToMaybe
66+
, fromFlagOrDefault
67+
)
68+
import Distribution.Simple.Utils
69+
( debug
70+
, dieWithException
71+
, wrapText
72+
)
73+
import Distribution.Solver.Types.SourcePackage
74+
( SourcePackage (..)
75+
)
76+
import Distribution.Types.CondTree
77+
( CondTree (..)
78+
, ignoreConditions
79+
)
80+
import Distribution.Types.Dependency (Dependency (..))
81+
import Distribution.Types.GenericPackageDescription
82+
( GenericPackageDescription (..)
83+
)
84+
import Distribution.Types.PackageVersionConstraint
85+
( PackageVersionConstraint (..)
86+
)
87+
import Distribution.Types.UnqualComponentName (UnqualComponentName)
88+
import Distribution.Verbosity
89+
( normal
90+
, silent
91+
)
92+
import Distribution.Version
93+
( simplifyVersionRange
94+
)
95+
96+
outdatedCommand :: CommandUI (NixStyleFlags OutdatedFlags)
97+
outdatedCommand =
98+
CommandUI
99+
{ commandName = "v2-outdated"
100+
, commandSynopsis = "Check for outdated dependencies."
101+
, commandUsage = usageAlternatives "v2-outdated" ["[FLAGS]", "[PACKAGES]"]
102+
, commandDefaultFlags = defaultNixStyleFlags V1Outdated.defaultOutdatedFlags
103+
, commandDescription = Just $ \_ ->
104+
wrapText $
105+
"Checks for outdated dependencies in the package description file "
106+
++ "or freeze file"
107+
, commandNotes = Nothing
108+
, commandOptions = nixStyleOptions V1Outdated.outdatedOptions
109+
}
110+
111+
-- | To a first approximation, the @outdated@ command runs the first phase of
112+
-- the @build@ command where we bring the install plan up to date, and then
113+
-- based on the install plan we write out a @cabal.project.outdated@ config file.
114+
--
115+
-- For more details on how this works, see the module
116+
-- "Distribution.Client.ProjectOrchestration"
117+
outdatedAction :: NixStyleFlags OutdatedFlags -> [String] -> GlobalFlags -> IO ()
118+
outdatedAction flags _extraArgs globalFlags = do
119+
let mprojectDir = flagToMaybe . flagProjectDir $ projectFlags flags
120+
mprojectFile = flagToMaybe . flagProjectFile $ projectFlags flags
121+
122+
config <- loadConfigOrSandboxConfig verbosity globalFlags
123+
let globalFlags' = savedGlobalFlags config `mappend` globalFlags
124+
125+
withRepoContext verbosity globalFlags' $ \repoContext -> do
126+
when (isJust mprojectDir || isJust mprojectFile) $
127+
dieWithException verbosity OutdatedAction
128+
129+
sourcePkgDb <- IndexUtils.getSourcePackages verbosity repoContext
130+
131+
prjBaseCtxt <- establishProjectBaseContext verbosity cliConfig OtherCommand
132+
133+
pkgSpecifiers <-
134+
runRebuild "." $ do
135+
plList <- findProjectPackages (distDirLayout prjBaseCtxt) (projectConfig prjBaseCtxt)
136+
fetchAndReadSourcePackages
137+
verbosity
138+
(distDirLayout prjBaseCtxt)
139+
(projectConfigShared $ projectConfig prjBaseCtxt)
140+
(projectConfigBuildOnly $ projectConfig prjBaseCtxt)
141+
plList
142+
143+
let pkgVerConstraints = extractPackageVersionConstraints pkgSpecifiers
144+
145+
debug verbosity $
146+
"Dependencies loaded: " ++ intercalate ", " (map prettyShow pkgVerConstraints)
147+
148+
let outdatedDeps = V1Outdated.listOutdated pkgVerConstraints sourcePkgDb (V1Outdated.ListOutdatedSettings (const True) (const True))
149+
150+
when (not quiet) $
151+
V1Outdated.showResult verbosity outdatedDeps simpleOutput
152+
if exitCode && (not . null $ outdatedDeps)
153+
then exitFailure
154+
else pure ()
155+
where
156+
cliConfig :: ProjectConfig
157+
cliConfig =
158+
commandLineFlagsToProjectConfig
159+
globalFlags
160+
flags
161+
mempty -- ClientInstallFlags, not needed here
162+
simpleOutput = fromFlagOrDefault False (Flag False) -- outdatedSimpleOutput
163+
exitCode = fromFlagOrDefault quiet (Flag False) -- outdatedExitCode
164+
quiet = fromFlagOrDefault False (Flag False) -- outdatedQuiet
165+
verbosity =
166+
if quiet
167+
then silent
168+
else fromFlagOrDefault normal (outdatedVerbosity outdatedFlags)
169+
170+
outdatedFlags :: OutdatedFlags
171+
outdatedFlags = extraFlags flags
172+
173+
extractPackageVersionConstraints :: [PackageSpecifier (SourcePackage UnresolvedPkgLoc)] -> [PackageVersionConstraint]
174+
extractPackageVersionConstraints =
175+
map toPackageVersionConstraint . concatMap genericPackageDependencies . mapMaybe getGenericPackageDescription
176+
where
177+
getGenericPackageDescription :: PackageSpecifier (SourcePackage UnresolvedPkgLoc) -> Maybe GenericPackageDescription
178+
getGenericPackageDescription ps =
179+
case ps of
180+
NamedPackage{} -> Nothing
181+
SpecificSourcePackage x -> Just $ srcpkgDescription x
182+
183+
toPackageVersionConstraint :: Dependency -> PackageVersionConstraint
184+
toPackageVersionConstraint (Dependency name versionRange _) =
185+
PackageVersionConstraint name (simplifyVersionRange versionRange)
186+
187+
genericPackageDependencies :: GenericPackageDescription -> [Dependency]
188+
genericPackageDependencies gpd =
189+
concat
190+
[ maybe [] (snd . ignoreConditions) $ condLibrary gpd
191+
, concatMap extract $ condSubLibraries gpd
192+
, concatMap extract $ condForeignLibs gpd
193+
, concatMap extract $ condExecutables gpd
194+
, concatMap extract $ condTestSuites gpd
195+
, concatMap extract $ condBenchmarks gpd
196+
]
197+
where
198+
extract :: forall a confVar. Semigroup a => (UnqualComponentName, CondTree confVar [Dependency] a) -> [Dependency]
199+
extract = snd . ignoreConditions . snd

‎cabal-install/src/Distribution/Client/Main.hs

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -127,6 +127,7 @@ import qualified Distribution.Client.CmdHaddockProject as CmdHaddockProject
127127
import qualified Distribution.Client.CmdInstall as CmdInstall
128128
import Distribution.Client.CmdLegacy
129129
import qualified Distribution.Client.CmdListBin as CmdListBin
130+
import qualified Distribution.Client.CmdOutdated as CmdOutdated
130131
import qualified Distribution.Client.CmdRepl as CmdRepl
131132
import qualified Distribution.Client.CmdRun as CmdRun
132133
import qualified Distribution.Client.CmdSdist as CmdSdist
@@ -416,6 +417,7 @@ mainWorker args = do
416417
, newCmd CmdBench.benchCommand CmdBench.benchAction
417418
, newCmd CmdExec.execCommand CmdExec.execAction
418419
, newCmd CmdClean.cleanCommand CmdClean.cleanAction
420+
, newCmd CmdOutdated.outdatedCommand CmdOutdated.outdatedAction
419421
, newCmd CmdSdist.sdistCommand CmdSdist.sdistAction
420422
, legacyCmd configureExCommand configureAction
421423
, legacyCmd buildCommand buildAction

‎cabal-install/src/Distribution/Client/Outdated.hs

Lines changed: 6 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -14,10 +14,14 @@
1414
-- Implementation of the 'outdated' command. Checks for outdated
1515
-- dependencies in the package description file or freeze file.
1616
module Distribution.Client.Outdated
17-
( outdatedCommand
17+
( ListOutdatedSettings (..)
18+
, OutdatedFlags (..)
19+
, defaultOutdatedFlags
1820
, outdatedAction
19-
, ListOutdatedSettings (..)
21+
, outdatedCommand
22+
, outdatedOptions
2023
, listOutdated
24+
, showResult
2125
)
2226
where
2327

0 commit comments

Comments
 (0)