{-# LANGUAGE CPP #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE NamedFieldPuns #-}
module Distribution.Client.CmdOutdated
( outdatedCommand, outdatedAction
, ListOutdatedSettings(..), listOutdated )
where
import Distribution.Client.Compat.Prelude
import Distribution.Compat.Lens
( _1, _2 )
import Prelude ()
import Distribution.Client.Config
( SavedConfig(savedGlobalFlags, savedConfigureFlags
, savedConfigureExFlags) )
import Distribution.Client.IndexUtils as IndexUtils
import Distribution.Client.DistDirLayout
( defaultDistDirLayout
, DistDirLayout(distProjectRootDirectory, distProjectFile) )
import Distribution.Client.ProjectConfig
import Distribution.Client.ProjectConfig.Legacy
( instantiateProjectConfigSkeletonWithCompiler )
import Distribution.Client.ProjectFlags
( projectFlagsOptions, ProjectFlags(..), defaultProjectFlags
, removeIgnoreProjectOption )
import Distribution.Client.RebuildMonad
( runRebuild )
import Distribution.Client.Sandbox
( loadConfigOrSandboxConfig )
import Distribution.Client.Setup
import Distribution.Client.Targets
( userToPackageConstraint, UserConstraint )
import Distribution.Client.Types.SourcePackageDb as SourcePackageDb
import Distribution.Solver.Types.PackageConstraint
( packageConstraintToDependency )
import Distribution.Client.Sandbox.PackageEnvironment
( loadUserConfig )
import Distribution.Utils.Generic
( safeLast, wrapText )
import Distribution.Package
( PackageName, packageVersion )
import Distribution.PackageDescription
( allBuildDepends )
import Distribution.PackageDescription.Configuration
( finalizePD )
import Distribution.Simple.Compiler
( Compiler, compilerInfo )
import Distribution.Simple.Setup
( optionVerbosity, trueArg )
import Distribution.Simple.Utils
( die', notice, debug, tryFindPackageDesc )
import Distribution.System
( Platform (..) )
import Distribution.Types.ComponentRequestedSpec
( ComponentRequestedSpec(..) )
import Distribution.Types.Dependency
( Dependency(..) )
import Distribution.Verbosity
( silent, normal )
import Distribution.Version
( Version, VersionInterval (..), VersionRange, LowerBound(..)
, UpperBound(..) , asVersionIntervals, majorBoundVersion )
import Distribution.Types.PackageVersionConstraint
( PackageVersionConstraint (..), simplifyPackageVersionConstraint )
import Distribution.Simple.Flag
( Flag(..), flagToMaybe, fromFlagOrDefault, toFlag )
import Distribution.Simple.Command
( ShowOrParseArgs, OptionField, CommandUI(..), optArg, option, reqArg, liftOptionL )
import Distribution.Simple.PackageDescription
( readGenericPackageDescription )
import qualified Distribution.Compat.CharParsing as P
import Distribution.ReadE
( parsecToReadE )
import Distribution.Client.HttpUtils
import Distribution.Utils.NubList
( fromNubList )
import qualified Data.Set as S
import System.Directory
( getCurrentDirectory, doesFileExist )
outdatedCommand :: CommandUI (ProjectFlags, OutdatedFlags)
outdatedCommand :: CommandUI (ProjectFlags, OutdatedFlags)
outdatedCommand = CommandUI
{ commandName :: String
commandName = String
"outdated"
, commandSynopsis :: String
commandSynopsis = String
"Check for outdated dependencies."
, commandDescription :: Maybe (String -> String)
commandDescription = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ \String
_ -> String -> String
wrapText forall a b. (a -> b) -> a -> b
$
String
"Checks for outdated dependencies in the package description file "
forall a. [a] -> [a] -> [a]
++ String
"or freeze file"
, commandNotes :: Maybe (String -> String)
commandNotes = forall a. Maybe a
Nothing
, commandUsage :: String -> String
commandUsage = \String
pname ->
String
"Usage: " forall a. [a] -> [a] -> [a]
++ String
pname forall a. [a] -> [a] -> [a]
++ String
" outdated [FLAGS] [PACKAGES]\n"
, commandDefaultFlags :: (ProjectFlags, OutdatedFlags)
commandDefaultFlags = (ProjectFlags
defaultProjectFlags, OutdatedFlags
defaultOutdatedFlags)
, commandOptions :: ShowOrParseArgs -> [OptionField (ProjectFlags, OutdatedFlags)]
commandOptions = \ShowOrParseArgs
showOrParseArgs ->
forall a b. (a -> b) -> [a] -> [b]
map (forall b a. ALens' b a -> OptionField a -> OptionField b
liftOptionL forall a c b. Lens (a, c) (b, c) a b
_1)
(forall a. [OptionField a] -> [OptionField a]
removeIgnoreProjectOption (ShowOrParseArgs -> [OptionField ProjectFlags]
projectFlagsOptions ShowOrParseArgs
showOrParseArgs)) forall a. [a] -> [a] -> [a]
++
forall a b. (a -> b) -> [a] -> [b]
map (forall b a. ALens' b a -> OptionField a -> OptionField b
liftOptionL forall c a b. Lens (c, a) (c, b) a b
_2) (ShowOrParseArgs -> [OptionField OutdatedFlags]
outdatedOptions ShowOrParseArgs
showOrParseArgs)
}
data IgnoreMajorVersionBumps = IgnoreMajorVersionBumpsNone
| IgnoreMajorVersionBumpsAll
| IgnoreMajorVersionBumpsSome [PackageName]
instance Monoid IgnoreMajorVersionBumps where
mempty :: IgnoreMajorVersionBumps
mempty = IgnoreMajorVersionBumps
IgnoreMajorVersionBumpsNone
mappend :: IgnoreMajorVersionBumps
-> IgnoreMajorVersionBumps -> IgnoreMajorVersionBumps
mappend = forall a. Semigroup a => a -> a -> a
(<>)
instance Semigroup IgnoreMajorVersionBumps where
IgnoreMajorVersionBumps
IgnoreMajorVersionBumpsNone <> :: IgnoreMajorVersionBumps
-> IgnoreMajorVersionBumps -> IgnoreMajorVersionBumps
<> IgnoreMajorVersionBumps
r = IgnoreMajorVersionBumps
r
l :: IgnoreMajorVersionBumps
l@IgnoreMajorVersionBumps
IgnoreMajorVersionBumpsAll <> IgnoreMajorVersionBumps
_ = IgnoreMajorVersionBumps
l
l :: IgnoreMajorVersionBumps
l@(IgnoreMajorVersionBumpsSome [PackageName]
_) <> IgnoreMajorVersionBumps
IgnoreMajorVersionBumpsNone = IgnoreMajorVersionBumps
l
(IgnoreMajorVersionBumpsSome [PackageName]
_) <> r :: IgnoreMajorVersionBumps
r@IgnoreMajorVersionBumps
IgnoreMajorVersionBumpsAll = IgnoreMajorVersionBumps
r
(IgnoreMajorVersionBumpsSome [PackageName]
a) <> (IgnoreMajorVersionBumpsSome [PackageName]
b) =
[PackageName] -> IgnoreMajorVersionBumps
IgnoreMajorVersionBumpsSome ([PackageName]
a forall a. [a] -> [a] -> [a]
++ [PackageName]
b)
data OutdatedFlags = OutdatedFlags
{ OutdatedFlags -> Flag Verbosity
outdatedVerbosity :: Flag Verbosity
, OutdatedFlags -> Flag Bool
outdatedFreezeFile :: Flag Bool
, OutdatedFlags -> Flag Bool
outdatedNewFreezeFile :: Flag Bool
, OutdatedFlags -> Flag Bool
outdatedSimpleOutput :: Flag Bool
, OutdatedFlags -> Flag Bool
outdatedExitCode :: Flag Bool
, OutdatedFlags -> Flag Bool
outdatedQuiet :: Flag Bool
, OutdatedFlags -> [PackageName]
outdatedIgnore :: [PackageName]
, OutdatedFlags -> Maybe IgnoreMajorVersionBumps
outdatedMinor :: Maybe IgnoreMajorVersionBumps
}
defaultOutdatedFlags :: OutdatedFlags
defaultOutdatedFlags :: OutdatedFlags
defaultOutdatedFlags = OutdatedFlags
{ outdatedVerbosity :: Flag Verbosity
outdatedVerbosity = forall a. a -> Flag a
toFlag Verbosity
normal
, outdatedFreezeFile :: Flag Bool
outdatedFreezeFile = forall a. Monoid a => a
mempty
, outdatedNewFreezeFile :: Flag Bool
outdatedNewFreezeFile = forall a. Monoid a => a
mempty
, outdatedSimpleOutput :: Flag Bool
outdatedSimpleOutput = forall a. Monoid a => a
mempty
, outdatedExitCode :: Flag Bool
outdatedExitCode = forall a. Monoid a => a
mempty
, outdatedQuiet :: Flag Bool
outdatedQuiet = forall a. Monoid a => a
mempty
, outdatedIgnore :: [PackageName]
outdatedIgnore = forall a. Monoid a => a
mempty
, outdatedMinor :: Maybe IgnoreMajorVersionBumps
outdatedMinor = forall a. Monoid a => a
mempty
}
outdatedOptions :: ShowOrParseArgs -> [OptionField OutdatedFlags]
outdatedOptions :: ShowOrParseArgs -> [OptionField OutdatedFlags]
outdatedOptions ShowOrParseArgs
_showOrParseArgs =
[ forall flags.
(flags -> Flag Verbosity)
-> (Flag Verbosity -> flags -> flags) -> OptionField flags
optionVerbosity
OutdatedFlags -> Flag Verbosity
outdatedVerbosity
(\Flag Verbosity
v OutdatedFlags
flags -> OutdatedFlags
flags {outdatedVerbosity :: Flag Verbosity
outdatedVerbosity = Flag Verbosity
v})
, forall get set a.
String
-> LFlags
-> String
-> get
-> set
-> MkOptDescr get set a
-> OptionField a
option [] [String
"freeze-file", String
"v1-freeze-file"]
String
"Act on the freeze file"
OutdatedFlags -> Flag Bool
outdatedFreezeFile (\Flag Bool
v OutdatedFlags
flags -> OutdatedFlags
flags {outdatedFreezeFile :: Flag Bool
outdatedFreezeFile = Flag Bool
v})
forall a. MkOptDescr (a -> Flag Bool) (Flag Bool -> a -> a) a
trueArg
, forall get set a.
String
-> LFlags
-> String
-> get
-> set
-> MkOptDescr get set a
-> OptionField a
option [] [String
"v2-freeze-file", String
"new-freeze-file"]
String
"Act on the new-style freeze file (default: cabal.project.freeze)"
OutdatedFlags -> Flag Bool
outdatedNewFreezeFile (\Flag Bool
v OutdatedFlags
flags -> OutdatedFlags
flags {outdatedNewFreezeFile :: Flag Bool
outdatedNewFreezeFile = Flag Bool
v})
forall a. MkOptDescr (a -> Flag Bool) (Flag Bool -> a -> a) a
trueArg
, forall get set a.
String
-> LFlags
-> String
-> get
-> set
-> MkOptDescr get set a
-> OptionField a
option [] [String
"simple-output"]
String
"Only print names of outdated dependencies, one per line"
OutdatedFlags -> Flag Bool
outdatedSimpleOutput (\Flag Bool
v OutdatedFlags
flags -> OutdatedFlags
flags {outdatedSimpleOutput :: Flag Bool
outdatedSimpleOutput = Flag Bool
v})
forall a. MkOptDescr (a -> Flag Bool) (Flag Bool -> a -> a) a
trueArg
, forall get set a.
String
-> LFlags
-> String
-> get
-> set
-> MkOptDescr get set a
-> OptionField a
option [] [String
"exit-code"]
String
"Exit with non-zero when there are outdated dependencies"
OutdatedFlags -> Flag Bool
outdatedExitCode (\Flag Bool
v OutdatedFlags
flags -> OutdatedFlags
flags {outdatedExitCode :: Flag Bool
outdatedExitCode = Flag Bool
v})
forall a. MkOptDescr (a -> Flag Bool) (Flag Bool -> a -> a) a
trueArg
, forall get set a.
String
-> LFlags
-> String
-> get
-> set
-> MkOptDescr get set a
-> OptionField a
option [Char
'q'] [String
"quiet"]
String
"Don't print any output. Implies '--exit-code' and '-v0'"
OutdatedFlags -> Flag Bool
outdatedQuiet (\Flag Bool
v OutdatedFlags
flags -> OutdatedFlags
flags {outdatedQuiet :: Flag Bool
outdatedQuiet = Flag Bool
v})
forall a. MkOptDescr (a -> Flag Bool) (Flag Bool -> a -> a) a
trueArg
, forall get set a.
String
-> LFlags
-> String
-> get
-> set
-> MkOptDescr get set a
-> OptionField a
option [] [String
"ignore"]
String
"Packages to ignore"
OutdatedFlags -> [PackageName]
outdatedIgnore (\[PackageName]
v OutdatedFlags
flags -> OutdatedFlags
flags {outdatedIgnore :: [PackageName]
outdatedIgnore = [PackageName]
v})
(forall b a.
Monoid b =>
String
-> ReadE b -> (b -> LFlags) -> MkOptDescr (a -> b) (b -> a -> a) a
reqArg String
"PKGS" ReadE [PackageName]
pkgNameListParser (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> String
prettyShow))
, forall get set a.
String
-> LFlags
-> String
-> get
-> set
-> MkOptDescr get set a
-> OptionField a
option [] [String
"minor"]
String
"Ignore major version bumps for these packages"
OutdatedFlags -> Maybe IgnoreMajorVersionBumps
outdatedMinor (\Maybe IgnoreMajorVersionBumps
v OutdatedFlags
flags -> OutdatedFlags
flags {outdatedMinor :: Maybe IgnoreMajorVersionBumps
outdatedMinor = Maybe IgnoreMajorVersionBumps
v})
( forall b a.
Monoid b =>
String
-> ReadE b
-> b
-> (b -> [Maybe String])
-> MkOptDescr (a -> b) (b -> a -> a) a
optArg
String
"PKGS"
ReadE (Maybe IgnoreMajorVersionBumps)
ignoreMajorVersionBumpsParser
(forall a. a -> Maybe a
Just IgnoreMajorVersionBumps
IgnoreMajorVersionBumpsAll)
Maybe IgnoreMajorVersionBumps -> [Maybe String]
ignoreMajorVersionBumpsPrinter
)
]
where
ignoreMajorVersionBumpsPrinter :: Maybe IgnoreMajorVersionBumps
-> [Maybe String]
ignoreMajorVersionBumpsPrinter :: Maybe IgnoreMajorVersionBumps -> [Maybe String]
ignoreMajorVersionBumpsPrinter Maybe IgnoreMajorVersionBumps
Nothing = []
ignoreMajorVersionBumpsPrinter (Just IgnoreMajorVersionBumps
IgnoreMajorVersionBumpsNone)= []
ignoreMajorVersionBumpsPrinter (Just IgnoreMajorVersionBumps
IgnoreMajorVersionBumpsAll) = [forall a. Maybe a
Nothing]
ignoreMajorVersionBumpsPrinter (Just (IgnoreMajorVersionBumpsSome [PackageName]
pkgs)) =
forall a b. (a -> b) -> [a] -> [b]
map (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Pretty a => a -> String
prettyShow) [PackageName]
pkgs
ignoreMajorVersionBumpsParser :: ReadE (Maybe IgnoreMajorVersionBumps)
ignoreMajorVersionBumpsParser =
(forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PackageName] -> IgnoreMajorVersionBumps
IgnoreMajorVersionBumpsSome) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` ReadE [PackageName]
pkgNameListParser
pkgNameListParser :: ReadE [PackageName]
pkgNameListParser = forall a. (String -> String) -> ParsecParser a -> ReadE a
parsecToReadE
(String
"Couldn't parse the list of package names: " forall a. [a] -> [a] -> [a]
++)
(forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (forall (m :: * -> *) a sep.
Alternative m =>
m a -> m sep -> m (NonEmpty a)
P.sepByNonEmpty forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec (forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
',')))
outdatedAction :: (ProjectFlags, OutdatedFlags) -> [String] -> GlobalFlags -> IO ()
outdatedAction :: (ProjectFlags, OutdatedFlags) -> LFlags -> GlobalFlags -> IO ()
outdatedAction (ProjectFlags{Flag String
flagProjectFileName :: ProjectFlags -> Flag String
flagProjectFileName :: Flag String
flagProjectFileName}, OutdatedFlags{[PackageName]
Maybe IgnoreMajorVersionBumps
Flag Bool
Flag Verbosity
outdatedMinor :: Maybe IgnoreMajorVersionBumps
outdatedIgnore :: [PackageName]
outdatedQuiet :: Flag Bool
outdatedExitCode :: Flag Bool
outdatedSimpleOutput :: Flag Bool
outdatedNewFreezeFile :: Flag Bool
outdatedFreezeFile :: Flag Bool
outdatedVerbosity :: Flag Verbosity
outdatedMinor :: OutdatedFlags -> Maybe IgnoreMajorVersionBumps
outdatedIgnore :: OutdatedFlags -> [PackageName]
outdatedQuiet :: OutdatedFlags -> Flag Bool
outdatedExitCode :: OutdatedFlags -> Flag Bool
outdatedSimpleOutput :: OutdatedFlags -> Flag Bool
outdatedNewFreezeFile :: OutdatedFlags -> Flag Bool
outdatedFreezeFile :: OutdatedFlags -> Flag Bool
outdatedVerbosity :: OutdatedFlags -> Flag Verbosity
..}) LFlags
_targetStrings GlobalFlags
globalFlags = do
SavedConfig
config <- Verbosity -> GlobalFlags -> IO SavedConfig
loadConfigOrSandboxConfig Verbosity
verbosity GlobalFlags
globalFlags
let globalFlags' :: GlobalFlags
globalFlags' = SavedConfig -> GlobalFlags
savedGlobalFlags SavedConfig
config forall a. Monoid a => a -> a -> a
`mappend` GlobalFlags
globalFlags
configFlags :: ConfigFlags
configFlags = SavedConfig -> ConfigFlags
savedConfigureFlags SavedConfig
config
forall a. Verbosity -> GlobalFlags -> (RepoContext -> IO a) -> IO a
withRepoContext Verbosity
verbosity GlobalFlags
globalFlags' forall a b. (a -> b) -> a -> b
$ \RepoContext
repoContext -> do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
newFreezeFile Bool -> Bool -> Bool
&& forall a. Maybe a -> Bool
isJust Maybe String
mprojectFile) forall a b. (a -> b) -> a -> b
$
forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity forall a b. (a -> b) -> a -> b
$
String
"--project-file must only be used with --v2-freeze-file."
SourcePackageDb
sourcePkgDb <- Verbosity -> RepoContext -> IO SourcePackageDb
IndexUtils.getSourcePackages Verbosity
verbosity RepoContext
repoContext
(Compiler
comp, Platform
platform, ProgramDb
_progdb) <- ConfigFlags -> IO (Compiler, Platform, ProgramDb)
configCompilerAux' ConfigFlags
configFlags
[PackageVersionConstraint]
deps <- if Bool
freezeFile
then Verbosity -> IO [PackageVersionConstraint]
depsFromFreezeFile Verbosity
verbosity
else if Bool
newFreezeFile
then do
HttpTransport
httpTransport <- Verbosity -> LFlags -> Maybe String -> IO HttpTransport
configureTransport Verbosity
verbosity
(forall a. NubList a -> [a]
fromNubList forall b c a. (b -> c) -> (a -> b) -> a -> c
. GlobalFlags -> NubList String
globalProgPathExtra forall a b. (a -> b) -> a -> b
$ GlobalFlags
globalFlags)
(forall a. Flag a -> Maybe a
flagToMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. GlobalFlags -> Flag String
globalHttpTransport forall a b. (a -> b) -> a -> b
$ GlobalFlags
globalFlags)
Verbosity
-> HttpTransport
-> Compiler
-> Platform
-> Maybe String
-> IO [PackageVersionConstraint]
depsFromNewFreezeFile Verbosity
verbosity HttpTransport
httpTransport Compiler
comp Platform
platform Maybe String
mprojectFile
else do
Verbosity -> Compiler -> Platform -> IO [PackageVersionConstraint]
depsFromPkgDesc Verbosity
verbosity Compiler
comp Platform
platform
Verbosity -> String -> IO ()
debug Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ String
"Dependencies loaded: "
forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
", " (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> String
prettyShow [PackageVersionConstraint]
deps)
let outdatedDeps :: [(PackageVersionConstraint, Version)]
outdatedDeps = [PackageVersionConstraint]
-> SourcePackageDb
-> ListOutdatedSettings
-> [(PackageVersionConstraint, Version)]
listOutdated [PackageVersionConstraint]
deps SourcePackageDb
sourcePkgDb
((PackageName -> Bool)
-> (PackageName -> Bool) -> ListOutdatedSettings
ListOutdatedSettings PackageName -> Bool
ignorePred PackageName -> Bool
minorPred)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
quiet) forall a b. (a -> b) -> a -> b
$
Verbosity -> [(PackageVersionConstraint, Version)] -> Bool -> IO ()
showResult Verbosity
verbosity [(PackageVersionConstraint, Version)]
outdatedDeps Bool
simpleOutput
if Bool
exitCode Bool -> Bool -> Bool
&& (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall a b. (a -> b) -> a -> b
$ [(PackageVersionConstraint, Version)]
outdatedDeps)
then forall a. IO a
exitFailure
else forall (m :: * -> *) a. Monad m => a -> m a
return ()
where
verbosity :: Verbosity
verbosity = if Bool
quiet
then Verbosity
silent
else forall a. a -> Flag a -> a
fromFlagOrDefault Verbosity
normal Flag Verbosity
outdatedVerbosity
freezeFile :: Bool
freezeFile = forall a. a -> Flag a -> a
fromFlagOrDefault Bool
False Flag Bool
outdatedFreezeFile
newFreezeFile :: Bool
newFreezeFile = forall a. a -> Flag a -> a
fromFlagOrDefault Bool
False Flag Bool
outdatedNewFreezeFile
mprojectFile :: Maybe String
mprojectFile = forall a. Flag a -> Maybe a
flagToMaybe Flag String
flagProjectFileName
simpleOutput :: Bool
simpleOutput = forall a. a -> Flag a -> a
fromFlagOrDefault Bool
False Flag Bool
outdatedSimpleOutput
quiet :: Bool
quiet = forall a. a -> Flag a -> a
fromFlagOrDefault Bool
False Flag Bool
outdatedQuiet
exitCode :: Bool
exitCode = forall a. a -> Flag a -> a
fromFlagOrDefault Bool
quiet Flag Bool
outdatedExitCode
ignorePred :: PackageName -> Bool
ignorePred = let ignoreSet :: Set PackageName
ignoreSet = forall a. Ord a => [a] -> Set a
S.fromList [PackageName]
outdatedIgnore
in \PackageName
pkgname -> PackageName
pkgname forall a. Ord a => a -> Set a -> Bool
`S.member` Set PackageName
ignoreSet
minorPred :: PackageName -> Bool
minorPred = case Maybe IgnoreMajorVersionBumps
outdatedMinor of
Maybe IgnoreMajorVersionBumps
Nothing -> forall a b. a -> b -> a
const Bool
False
Just IgnoreMajorVersionBumps
IgnoreMajorVersionBumpsNone -> forall a b. a -> b -> a
const Bool
False
Just IgnoreMajorVersionBumps
IgnoreMajorVersionBumpsAll -> forall a b. a -> b -> a
const Bool
True
Just (IgnoreMajorVersionBumpsSome [PackageName]
pkgs) ->
let minorSet :: Set PackageName
minorSet = forall a. Ord a => [a] -> Set a
S.fromList [PackageName]
pkgs
in \PackageName
pkgname -> PackageName
pkgname forall a. Ord a => a -> Set a -> Bool
`S.member` Set PackageName
minorSet
showResult :: Verbosity -> [(PackageVersionConstraint,Version)] -> Bool -> IO ()
showResult :: Verbosity -> [(PackageVersionConstraint, Version)] -> Bool -> IO ()
showResult Verbosity
verbosity [(PackageVersionConstraint, Version)]
outdatedDeps Bool
simpleOutput =
if Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall a b. (a -> b) -> a -> b
$ [(PackageVersionConstraint, Version)]
outdatedDeps
then
do forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
simpleOutput) forall a b. (a -> b) -> a -> b
$
Verbosity -> String -> IO ()
notice Verbosity
verbosity String
"Outdated dependencies:"
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [(PackageVersionConstraint, Version)]
outdatedDeps forall a b. (a -> b) -> a -> b
$ \(d :: PackageVersionConstraint
d@(PackageVersionConstraint PackageName
pn VersionRange
_), Version
v) ->
let outdatedDep :: String
outdatedDep = if Bool
simpleOutput then forall a. Pretty a => a -> String
prettyShow PackageName
pn
else forall a. Pretty a => a -> String
prettyShow PackageVersionConstraint
d forall a. [a] -> [a] -> [a]
++ String
" (latest: " forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
prettyShow Version
v forall a. [a] -> [a] -> [a]
++ String
")"
in Verbosity -> String -> IO ()
notice Verbosity
verbosity String
outdatedDep
else Verbosity -> String -> IO ()
notice Verbosity
verbosity String
"All dependencies are up to date."
userConstraintsToDependencies :: [UserConstraint] -> [PackageVersionConstraint]
userConstraintsToDependencies :: [UserConstraint] -> [PackageVersionConstraint]
userConstraintsToDependencies [UserConstraint]
ucnstrs =
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (PackageConstraint -> Maybe PackageVersionConstraint
packageConstraintToDependency forall b c a. (b -> c) -> (a -> b) -> a -> c
. UserConstraint -> PackageConstraint
userToPackageConstraint) [UserConstraint]
ucnstrs
depsFromFreezeFile :: Verbosity -> IO [PackageVersionConstraint]
depsFromFreezeFile :: Verbosity -> IO [PackageVersionConstraint]
depsFromFreezeFile Verbosity
verbosity = do
String
cwd <- IO String
getCurrentDirectory
SavedConfig
userConfig <- Verbosity -> String -> Maybe String -> IO SavedConfig
loadUserConfig Verbosity
verbosity String
cwd forall a. Maybe a
Nothing
let ucnstrs :: [UserConstraint]
ucnstrs = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConfigExFlags -> [(UserConstraint, ConstraintSource)]
configExConstraints forall b c a. (b -> c) -> (a -> b) -> a -> c
. SavedConfig -> ConfigExFlags
savedConfigureExFlags forall a b. (a -> b) -> a -> b
$
SavedConfig
userConfig
deps :: [PackageVersionConstraint]
deps = [UserConstraint] -> [PackageVersionConstraint]
userConstraintsToDependencies [UserConstraint]
ucnstrs
Verbosity -> String -> IO ()
debug Verbosity
verbosity String
"Reading the list of dependencies from the freeze file"
forall (m :: * -> *) a. Monad m => a -> m a
return [PackageVersionConstraint]
deps
depsFromNewFreezeFile :: Verbosity -> HttpTransport -> Compiler -> Platform -> Maybe FilePath -> IO [PackageVersionConstraint]
depsFromNewFreezeFile :: Verbosity
-> HttpTransport
-> Compiler
-> Platform
-> Maybe String
-> IO [PackageVersionConstraint]
depsFromNewFreezeFile Verbosity
verbosity HttpTransport
httpTransport Compiler
compiler (Platform Arch
arch OS
os) Maybe String
mprojectFile = do
ProjectRoot
projectRoot <- forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall e a. Exception e => e -> IO a
throwIO forall (m :: * -> *) a. Monad m => a -> m a
return forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
Maybe String
-> Maybe String -> IO (Either BadProjectRoot ProjectRoot)
findProjectRoot forall a. Maybe a
Nothing Maybe String
mprojectFile
let distDirLayout :: DistDirLayout
distDirLayout = ProjectRoot -> Maybe String -> DistDirLayout
defaultDistDirLayout ProjectRoot
projectRoot
forall a. Maybe a
Nothing
ProjectConfig
projectConfig <- forall a. String -> Rebuild a -> IO a
runRebuild (DistDirLayout -> String
distProjectRootDirectory DistDirLayout
distDirLayout) forall a b. (a -> b) -> a -> b
$ do
ProjectConfigSkeleton
pcs <- Verbosity
-> HttpTransport -> DistDirLayout -> Rebuild ProjectConfigSkeleton
readProjectLocalFreezeConfig Verbosity
verbosity HttpTransport
httpTransport DistDirLayout
distDirLayout
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ OS
-> Arch
-> CompilerInfo
-> FlagAssignment
-> ProjectConfigSkeleton
-> ProjectConfig
instantiateProjectConfigSkeletonWithCompiler OS
os Arch
arch (Compiler -> CompilerInfo
compilerInfo Compiler
compiler) forall a. Monoid a => a
mempty ProjectConfigSkeleton
pcs
let ucnstrs :: [UserConstraint]
ucnstrs = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProjectConfigShared -> [(UserConstraint, ConstraintSource)]
projectConfigConstraints forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProjectConfig -> ProjectConfigShared
projectConfigShared
forall a b. (a -> b) -> a -> b
$ ProjectConfig
projectConfig
deps :: [PackageVersionConstraint]
deps = [UserConstraint] -> [PackageVersionConstraint]
userConstraintsToDependencies [UserConstraint]
ucnstrs
freezeFile :: String
freezeFile = DistDirLayout -> String -> String
distProjectFile DistDirLayout
distDirLayout String
"freeze"
Bool
freezeFileExists <- String -> IO Bool
doesFileExist String
freezeFile
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
freezeFileExists forall a b. (a -> b) -> a -> b
$
forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity forall a b. (a -> b) -> a -> b
$
String
"Couldn't find a freeze file expected at: " forall a. [a] -> [a] -> [a]
++ String
freezeFile forall a. [a] -> [a] -> [a]
++ String
"\n\n"
forall a. [a] -> [a] -> [a]
++ String
"We are looking for this file because you supplied '--project-file' or '--v2-freeze-file'. "
forall a. [a] -> [a] -> [a]
++ String
"When one of these flags is given, we try to read the dependencies from a freeze file. "
forall a. [a] -> [a] -> [a]
++ String
"If it is undesired behaviour, you should not use these flags, otherwise please generate "
forall a. [a] -> [a] -> [a]
++ String
"a freeze file via 'cabal freeze'."
Verbosity -> String -> IO ()
debug Verbosity
verbosity forall a b. (a -> b) -> a -> b
$
String
"Reading the list of dependencies from the new-style freeze file " forall a. [a] -> [a] -> [a]
++ String
freezeFile
forall (m :: * -> *) a. Monad m => a -> m a
return [PackageVersionConstraint]
deps
depsFromPkgDesc :: Verbosity -> Compiler -> Platform -> IO [PackageVersionConstraint]
depsFromPkgDesc :: Verbosity -> Compiler -> Platform -> IO [PackageVersionConstraint]
depsFromPkgDesc Verbosity
verbosity Compiler
comp Platform
platform = do
String
cwd <- IO String
getCurrentDirectory
String
path <- Verbosity -> String -> IO String
tryFindPackageDesc Verbosity
verbosity String
cwd
GenericPackageDescription
gpd <- Verbosity -> String -> IO GenericPackageDescription
readGenericPackageDescription Verbosity
verbosity String
path
let cinfo :: CompilerInfo
cinfo = Compiler -> CompilerInfo
compilerInfo Compiler
comp
epd :: Either [Dependency] (PackageDescription, FlagAssignment)
epd = FlagAssignment
-> ComponentRequestedSpec
-> (Dependency -> Bool)
-> Platform
-> CompilerInfo
-> [PackageVersionConstraint]
-> GenericPackageDescription
-> Either [Dependency] (PackageDescription, FlagAssignment)
finalizePD forall a. Monoid a => a
mempty (Bool -> Bool -> ComponentRequestedSpec
ComponentRequestedSpec Bool
True Bool
True)
(forall a b. a -> b -> a
const Bool
True) Platform
platform CompilerInfo
cinfo [] GenericPackageDescription
gpd
case Either [Dependency] (PackageDescription, FlagAssignment)
epd of
Left [Dependency]
_ -> forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity String
"finalizePD failed"
Right (PackageDescription
pd, FlagAssignment
_) -> do
let bd :: [Dependency]
bd = PackageDescription -> [Dependency]
allBuildDepends PackageDescription
pd
Verbosity -> String -> IO ()
debug Verbosity
verbosity
String
"Reading the list of dependencies from the package description"
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Dependency -> PackageVersionConstraint
toPVC [Dependency]
bd
where
toPVC :: Dependency -> PackageVersionConstraint
toPVC (Dependency PackageName
pn VersionRange
vr NonEmptySet LibraryName
_) = PackageName -> VersionRange -> PackageVersionConstraint
PackageVersionConstraint PackageName
pn VersionRange
vr
data ListOutdatedSettings = ListOutdatedSettings
{
ListOutdatedSettings -> PackageName -> Bool
listOutdatedIgnorePred :: PackageName -> Bool
,
ListOutdatedSettings -> PackageName -> Bool
listOutdatedMinorPred :: PackageName -> Bool
}
listOutdated :: [PackageVersionConstraint]
-> SourcePackageDb
-> ListOutdatedSettings
-> [(PackageVersionConstraint, Version)]
listOutdated :: [PackageVersionConstraint]
-> SourcePackageDb
-> ListOutdatedSettings
-> [(PackageVersionConstraint, Version)]
listOutdated [PackageVersionConstraint]
deps SourcePackageDb
sourceDb (ListOutdatedSettings PackageName -> Bool
ignorePred PackageName -> Bool
minorPred) =
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe PackageVersionConstraint
-> Maybe (PackageVersionConstraint, Version)
isOutdated forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map PackageVersionConstraint -> PackageVersionConstraint
simplifyPackageVersionConstraint [PackageVersionConstraint]
deps
where
isOutdated :: PackageVersionConstraint -> Maybe (PackageVersionConstraint, Version)
isOutdated :: PackageVersionConstraint
-> Maybe (PackageVersionConstraint, Version)
isOutdated dep :: PackageVersionConstraint
dep@(PackageVersionConstraint PackageName
pname VersionRange
vr)
| PackageName -> Bool
ignorePred PackageName
pname = forall a. Maybe a
Nothing
| Bool
otherwise =
let this :: [Version]
this = forall a b. (a -> b) -> [a] -> [b]
map forall pkg. Package pkg => pkg -> Version
packageVersion forall a b. (a -> b) -> a -> b
$ SourcePackageDb
-> PackageName -> VersionRange -> [UnresolvedSourcePackage]
SourcePackageDb.lookupDependency SourcePackageDb
sourceDb PackageName
pname VersionRange
vr
latest :: [Version]
latest = PackageVersionConstraint -> [Version]
lookupLatest PackageVersionConstraint
dep
in (\Version
v -> (PackageVersionConstraint
dep, Version
v)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` [Version] -> [Version] -> Maybe Version
isOutdated' [Version]
this [Version]
latest
isOutdated' :: [Version] -> [Version] -> Maybe Version
isOutdated' :: [Version] -> [Version] -> Maybe Version
isOutdated' [] [Version]
_ = forall a. Maybe a
Nothing
isOutdated' [Version]
_ [] = forall a. Maybe a
Nothing
isOutdated' [Version]
this [Version]
latest =
let this' :: Version
this' = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Version]
this
latest' :: Version
latest' = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Version]
latest
in if Version
this' forall a. Ord a => a -> a -> Bool
< Version
latest' then forall a. a -> Maybe a
Just Version
latest' else forall a. Maybe a
Nothing
lookupLatest :: PackageVersionConstraint -> [Version]
lookupLatest :: PackageVersionConstraint -> [Version]
lookupLatest (PackageVersionConstraint PackageName
pname VersionRange
vr)
| PackageName -> Bool
minorPred PackageName
pname =
forall a b. (a -> b) -> [a] -> [b]
map forall pkg. Package pkg => pkg -> Version
packageVersion forall a b. (a -> b) -> a -> b
$ SourcePackageDb
-> PackageName -> VersionRange -> [UnresolvedSourcePackage]
SourcePackageDb.lookupDependency SourcePackageDb
sourceDb PackageName
pname (VersionRange -> VersionRange
relaxMinor VersionRange
vr)
| Bool
otherwise =
forall a b. (a -> b) -> [a] -> [b]
map forall pkg. Package pkg => pkg -> Version
packageVersion forall a b. (a -> b) -> a -> b
$ SourcePackageDb -> PackageName -> [UnresolvedSourcePackage]
SourcePackageDb.lookupPackageName SourcePackageDb
sourceDb PackageName
pname
relaxMinor :: VersionRange -> VersionRange
relaxMinor :: VersionRange -> VersionRange
relaxMinor VersionRange
vr =
let vis :: [VersionInterval]
vis = VersionRange -> [VersionInterval]
asVersionIntervals VersionRange
vr
in forall b a. b -> (a -> b) -> Maybe a -> b
maybe VersionRange
vr VersionInterval -> VersionRange
relax (forall a. [a] -> Maybe a
safeLast [VersionInterval]
vis)
where relax :: VersionInterval -> VersionRange
relax (VersionInterval (LowerBound Version
v0 Bound
_) UpperBound
upper) =
case UpperBound
upper of
UpperBound
NoUpperBound -> VersionRange
vr
UpperBound Version
_v1 Bound
_ -> Version -> VersionRange
majorBoundVersion Version
v0