Skip to content

Commit

Permalink
Fix command line parsing
Browse files Browse the repository at this point in the history
  • Loading branch information
erikd committed Oct 27, 2023
1 parent 6193dbf commit 85630c1
Showing 1 changed file with 116 additions and 7 deletions.
123 changes: 116 additions & 7 deletions cabal-install/src/Distribution/Client/CmdOutdated.hs
Original file line number Diff line number Diff line change
Expand Up @@ -10,8 +10,8 @@ module Distribution.Client.CmdOutdated

import qualified Data.Set as Set

import qualified Distribution.Compat.CharParsing as P
import Distribution.Client.Compat.Prelude

import Distribution.Client.Config
( SavedConfig
( savedGlobalFlags
Expand All @@ -27,7 +27,6 @@ import Distribution.Client.NixStyleOptions
import Distribution.Client.Outdated
( IgnoreMajorVersionBumps (..)
, ListOutdatedSettings (..)
, OutdatedFlags (..)
)
import qualified Distribution.Client.Outdated as V1Outdated
import Distribution.Client.ProjectConfig
Expand All @@ -46,7 +45,8 @@ import Distribution.Client.Sandbox
( loadConfigOrSandboxConfig
)
import Distribution.Client.Setup
( GlobalFlags (..)
( ConfigFlags (..)
, GlobalFlags (..)
, configCompilerAux'
, withRepoContext
)
Expand All @@ -56,14 +56,26 @@ import Distribution.Client.Types.PackageLocation
import Distribution.Client.Types.PackageSpecifier
( PackageSpecifier (..)
)
import Distribution.ReadE
( parsecToReadE
)
import Distribution.Simple.Command
( CommandUI (..)
, OptionField
, ShowOrParseArgs
, optArg
, option
, reqArg
, usageAlternatives
)
import Distribution.Simple.Flag
( flagToMaybe
( Flag (..)
, flagToMaybe
, fromFlagOrDefault
)
import Distribution.Simple.Setup
( trueArg
)
import Distribution.Simple.Utils
( debug
, dieWithException
Expand Down Expand Up @@ -101,13 +113,13 @@ outdatedCommand =
{ commandName = "v2-outdated"
, commandSynopsis = "Check for outdated dependencies."
, commandUsage = usageAlternatives "v2-outdated" ["[FLAGS]", "[PACKAGES]"]
, commandDefaultFlags = defaultNixStyleFlags V1Outdated.defaultOutdatedFlags
, commandDefaultFlags = defaultNixStyleFlags defaultOutdatedFlags
, commandDescription = Just $ \_ ->
wrapText $
"Checks for outdated dependencies in the package description file "
++ "or freeze file"
, commandNotes = Nothing
, commandOptions = nixStyleOptions V1Outdated.outdatedOptions
, commandOptions = nixStyleOptions outdatedOptions
}

-- | To a first approximation, the @outdated@ command runs the first phase of
Expand Down Expand Up @@ -185,7 +197,29 @@ outdatedAction flags _extraArgs globalFlags = do
verbosity =
if quiet
then silent
else fromFlagOrDefault normal (outdatedVerbosity outdatedFlags)
else fromFlagOrDefault normal (configVerbosity $ configFlags flags)

data OutdatedFlags = OutdatedFlags
{ outdatedFreezeFile :: Flag Bool
, outdatedNewFreezeFile :: Flag Bool
, outdatedSimpleOutput :: Flag Bool
, outdatedExitCode :: Flag Bool
, outdatedQuiet :: Flag Bool
, outdatedIgnore :: [PackageName]
, outdatedMinor :: Maybe IgnoreMajorVersionBumps
}

defaultOutdatedFlags :: OutdatedFlags
defaultOutdatedFlags =
OutdatedFlags
{ outdatedFreezeFile = mempty
, outdatedNewFreezeFile = mempty
, outdatedSimpleOutput = mempty
, outdatedExitCode = mempty
, outdatedQuiet = mempty
, outdatedIgnore = mempty
, outdatedMinor = mempty
}

extractPackageVersionConstraints :: [PackageSpecifier (SourcePackage UnresolvedPkgLoc)] -> [PackageVersionConstraint]
extractPackageVersionConstraints =
Expand Down Expand Up @@ -214,3 +248,78 @@ genericPackageDependencies gpd =
where
extract :: forall a confVar. Semigroup a => (UnqualComponentName, CondTree confVar [Dependency] a) -> [Dependency]
extract = snd . ignoreConditions . snd

outdatedOptions :: ShowOrParseArgs -> [OptionField OutdatedFlags]
outdatedOptions _showOrParseArgs =
[ option
[]
["freeze-file", "v1-freeze-file"]
"Act on the freeze file"
outdatedFreezeFile
(\v flags -> flags{outdatedFreezeFile = v})
trueArg
, option
[]
["v2-freeze-file", "new-freeze-file"]
"Act on the new-style freeze file (default: cabal.project.freeze)"
outdatedNewFreezeFile
(\v flags -> flags{outdatedNewFreezeFile = v})
trueArg
, option
[]
["simple-output"]
"Only print names of outdated dependencies, one per line"
outdatedSimpleOutput
(\v flags -> flags{outdatedSimpleOutput = v})
trueArg
, option
[]
["exit-code"]
"Exit with non-zero when there are outdated dependencies"
outdatedExitCode
(\v flags -> flags{outdatedExitCode = v})
trueArg
, option
['q']
["quiet"]
"Don't print any output. Implies '--exit-code' and '-v0'"
outdatedQuiet
(\v flags -> flags{outdatedQuiet = v})
trueArg
, option
[]
["ignore"]
"Packages to ignore"
outdatedIgnore
(\v flags -> flags{outdatedIgnore = v})
(reqArg "PKGS" pkgNameListParser (map prettyShow))
, option
[]
["minor"]
"Ignore major version bumps for these packages"
outdatedMinor
(\v flags -> flags{outdatedMinor = v})
( optArg
"PKGS"
ignoreMajorVersionBumpsParser
("", Just IgnoreMajorVersionBumpsAll)
ignoreMajorVersionBumpsPrinter
)
]
where
ignoreMajorVersionBumpsPrinter
:: Maybe IgnoreMajorVersionBumps
-> [Maybe String]
ignoreMajorVersionBumpsPrinter Nothing = []
ignoreMajorVersionBumpsPrinter (Just IgnoreMajorVersionBumpsNone) = []
ignoreMajorVersionBumpsPrinter (Just IgnoreMajorVersionBumpsAll) = [Nothing]
ignoreMajorVersionBumpsPrinter (Just (IgnoreMajorVersionBumpsSome pkgs)) =
map (Just . prettyShow) pkgs

ignoreMajorVersionBumpsParser =
(Just . IgnoreMajorVersionBumpsSome) `fmap` pkgNameListParser

pkgNameListParser =
parsecToReadE
("Couldn't parse the list of package names: " ++)
(fmap toList (P.sepByNonEmpty parsec (P.char ',')))

0 comments on commit 85630c1

Please sign in to comment.