{-# 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
( instantiateProjectConfigSkeleton )
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 :: forall flags.
String
-> String
-> (String -> String)
-> Maybe (String -> String)
-> Maybe (String -> String)
-> flags
-> (ShowOrParseArgs -> [OptionField flags])
-> CommandUI flags
CommandUI
{ commandName :: String
commandName = String
"outdated"
, commandSynopsis :: String
commandSynopsis = String
"Check for outdated dependencies."
, commandDescription :: Maybe (String -> String)
commandDescription = (String -> String) -> Maybe (String -> String)
forall a. a -> Maybe a
Just ((String -> String) -> Maybe (String -> String))
-> (String -> String) -> Maybe (String -> String)
forall a b. (a -> b) -> a -> b
$ \String
_ -> String -> String
wrapText (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$
String
"Checks for outdated dependencies in the package description file "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"or freeze file"
, commandNotes :: Maybe (String -> String)
commandNotes = Maybe (String -> String)
forall a. Maybe a
Nothing
, commandUsage :: String -> String
commandUsage = \String
pname ->
String
"Usage: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
pname String -> String -> String
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 ->
(OptionField ProjectFlags
-> OptionField (ProjectFlags, OutdatedFlags))
-> [OptionField ProjectFlags]
-> [OptionField (ProjectFlags, OutdatedFlags)]
forall a b. (a -> b) -> [a] -> [b]
map (ALens' (ProjectFlags, OutdatedFlags) ProjectFlags
-> OptionField ProjectFlags
-> OptionField (ProjectFlags, OutdatedFlags)
forall b a. ALens' b a -> OptionField a -> OptionField b
liftOptionL ALens' (ProjectFlags, OutdatedFlags) ProjectFlags
forall a c b. Lens (a, c) (b, c) a b
_1)
([OptionField ProjectFlags] -> [OptionField ProjectFlags]
forall a. [OptionField a] -> [OptionField a]
removeIgnoreProjectOption (ShowOrParseArgs -> [OptionField ProjectFlags]
projectFlagsOptions ShowOrParseArgs
showOrParseArgs)) [OptionField (ProjectFlags, OutdatedFlags)]
-> [OptionField (ProjectFlags, OutdatedFlags)]
-> [OptionField (ProjectFlags, OutdatedFlags)]
forall a. [a] -> [a] -> [a]
++
(OptionField OutdatedFlags
-> OptionField (ProjectFlags, OutdatedFlags))
-> [OptionField OutdatedFlags]
-> [OptionField (ProjectFlags, OutdatedFlags)]
forall a b. (a -> b) -> [a] -> [b]
map (ALens' (ProjectFlags, OutdatedFlags) OutdatedFlags
-> OptionField OutdatedFlags
-> OptionField (ProjectFlags, OutdatedFlags)
forall b a. ALens' b a -> OptionField a -> OptionField b
liftOptionL ALens' (ProjectFlags, OutdatedFlags) OutdatedFlags
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 = IgnoreMajorVersionBumps
-> IgnoreMajorVersionBumps -> IgnoreMajorVersionBumps
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 [PackageName] -> [PackageName] -> [PackageName]
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 :: Flag Verbosity
-> Flag Bool
-> Flag Bool
-> Flag Bool
-> Flag Bool
-> Flag Bool
-> [PackageName]
-> Maybe IgnoreMajorVersionBumps
-> OutdatedFlags
OutdatedFlags
{ outdatedVerbosity :: Flag Verbosity
outdatedVerbosity = Verbosity -> Flag Verbosity
forall a. a -> Flag a
toFlag Verbosity
normal
, outdatedFreezeFile :: Flag Bool
outdatedFreezeFile = Flag Bool
forall a. Monoid a => a
mempty
, outdatedNewFreezeFile :: Flag Bool
outdatedNewFreezeFile = Flag Bool
forall a. Monoid a => a
mempty
, outdatedSimpleOutput :: Flag Bool
outdatedSimpleOutput = Flag Bool
forall a. Monoid a => a
mempty
, outdatedExitCode :: Flag Bool
outdatedExitCode = Flag Bool
forall a. Monoid a => a
mempty
, outdatedQuiet :: Flag Bool
outdatedQuiet = Flag Bool
forall a. Monoid a => a
mempty
, outdatedIgnore :: [PackageName]
outdatedIgnore = [PackageName]
forall a. Monoid a => a
mempty
, outdatedMinor :: Maybe IgnoreMajorVersionBumps
outdatedMinor = Maybe IgnoreMajorVersionBumps
forall a. Monoid a => a
mempty
}
outdatedOptions :: ShowOrParseArgs -> [OptionField OutdatedFlags]
outdatedOptions :: ShowOrParseArgs -> [OptionField OutdatedFlags]
outdatedOptions ShowOrParseArgs
_showOrParseArgs =
[ (OutdatedFlags -> Flag Verbosity)
-> (Flag Verbosity -> OutdatedFlags -> OutdatedFlags)
-> OptionField OutdatedFlags
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})
, String
-> LFlags
-> String
-> (OutdatedFlags -> Flag Bool)
-> (Flag Bool -> OutdatedFlags -> OutdatedFlags)
-> MkOptDescr
(OutdatedFlags -> Flag Bool)
(Flag Bool -> OutdatedFlags -> OutdatedFlags)
OutdatedFlags
-> OptionField OutdatedFlags
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})
MkOptDescr
(OutdatedFlags -> Flag Bool)
(Flag Bool -> OutdatedFlags -> OutdatedFlags)
OutdatedFlags
forall a. MkOptDescr (a -> Flag Bool) (Flag Bool -> a -> a) a
trueArg
, String
-> LFlags
-> String
-> (OutdatedFlags -> Flag Bool)
-> (Flag Bool -> OutdatedFlags -> OutdatedFlags)
-> MkOptDescr
(OutdatedFlags -> Flag Bool)
(Flag Bool -> OutdatedFlags -> OutdatedFlags)
OutdatedFlags
-> OptionField OutdatedFlags
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})
MkOptDescr
(OutdatedFlags -> Flag Bool)
(Flag Bool -> OutdatedFlags -> OutdatedFlags)
OutdatedFlags
forall a. MkOptDescr (a -> Flag Bool) (Flag Bool -> a -> a) a
trueArg
, String
-> LFlags
-> String
-> (OutdatedFlags -> Flag Bool)
-> (Flag Bool -> OutdatedFlags -> OutdatedFlags)
-> MkOptDescr
(OutdatedFlags -> Flag Bool)
(Flag Bool -> OutdatedFlags -> OutdatedFlags)
OutdatedFlags
-> OptionField OutdatedFlags
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})
MkOptDescr
(OutdatedFlags -> Flag Bool)
(Flag Bool -> OutdatedFlags -> OutdatedFlags)
OutdatedFlags
forall a. MkOptDescr (a -> Flag Bool) (Flag Bool -> a -> a) a
trueArg
, String
-> LFlags
-> String
-> (OutdatedFlags -> Flag Bool)
-> (Flag Bool -> OutdatedFlags -> OutdatedFlags)
-> MkOptDescr
(OutdatedFlags -> Flag Bool)
(Flag Bool -> OutdatedFlags -> OutdatedFlags)
OutdatedFlags
-> OptionField OutdatedFlags
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})
MkOptDescr
(OutdatedFlags -> Flag Bool)
(Flag Bool -> OutdatedFlags -> OutdatedFlags)
OutdatedFlags
forall a. MkOptDescr (a -> Flag Bool) (Flag Bool -> a -> a) a
trueArg
, String
-> LFlags
-> String
-> (OutdatedFlags -> Flag Bool)
-> (Flag Bool -> OutdatedFlags -> OutdatedFlags)
-> MkOptDescr
(OutdatedFlags -> Flag Bool)
(Flag Bool -> OutdatedFlags -> OutdatedFlags)
OutdatedFlags
-> OptionField OutdatedFlags
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})
MkOptDescr
(OutdatedFlags -> Flag Bool)
(Flag Bool -> OutdatedFlags -> OutdatedFlags)
OutdatedFlags
forall a. MkOptDescr (a -> Flag Bool) (Flag Bool -> a -> a) a
trueArg
, String
-> LFlags
-> String
-> (OutdatedFlags -> [PackageName])
-> ([PackageName] -> OutdatedFlags -> OutdatedFlags)
-> MkOptDescr
(OutdatedFlags -> [PackageName])
([PackageName] -> OutdatedFlags -> OutdatedFlags)
OutdatedFlags
-> OptionField OutdatedFlags
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})
(String
-> ReadE [PackageName]
-> ([PackageName] -> LFlags)
-> MkOptDescr
(OutdatedFlags -> [PackageName])
([PackageName] -> OutdatedFlags -> OutdatedFlags)
OutdatedFlags
forall b a.
Monoid b =>
String
-> ReadE b -> (b -> LFlags) -> MkOptDescr (a -> b) (b -> a -> a) a
reqArg String
"PKGS" ReadE [PackageName]
pkgNameListParser ((PackageName -> String) -> [PackageName] -> LFlags
forall a b. (a -> b) -> [a] -> [b]
map PackageName -> String
forall a. Pretty a => a -> String
prettyShow))
, String
-> LFlags
-> String
-> (OutdatedFlags -> Maybe IgnoreMajorVersionBumps)
-> (Maybe IgnoreMajorVersionBumps
-> OutdatedFlags -> OutdatedFlags)
-> MkOptDescr
(OutdatedFlags -> Maybe IgnoreMajorVersionBumps)
(Maybe IgnoreMajorVersionBumps -> OutdatedFlags -> OutdatedFlags)
OutdatedFlags
-> OptionField OutdatedFlags
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})
( String
-> ReadE (Maybe IgnoreMajorVersionBumps)
-> Maybe IgnoreMajorVersionBumps
-> (Maybe IgnoreMajorVersionBumps -> [Maybe String])
-> MkOptDescr
(OutdatedFlags -> Maybe IgnoreMajorVersionBumps)
(Maybe IgnoreMajorVersionBumps -> OutdatedFlags -> OutdatedFlags)
OutdatedFlags
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
(IgnoreMajorVersionBumps -> Maybe IgnoreMajorVersionBumps
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) = [Maybe String
forall a. Maybe a
Nothing]
ignoreMajorVersionBumpsPrinter (Just (IgnoreMajorVersionBumpsSome [PackageName]
pkgs)) =
(PackageName -> Maybe String) -> [PackageName] -> [Maybe String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String)
-> (PackageName -> String) -> PackageName -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageName -> String
forall a. Pretty a => a -> String
prettyShow) [PackageName]
pkgs
ignoreMajorVersionBumpsParser :: ReadE (Maybe IgnoreMajorVersionBumps)
ignoreMajorVersionBumpsParser =
(IgnoreMajorVersionBumps -> Maybe IgnoreMajorVersionBumps
forall a. a -> Maybe a
Just (IgnoreMajorVersionBumps -> Maybe IgnoreMajorVersionBumps)
-> ([PackageName] -> IgnoreMajorVersionBumps)
-> [PackageName]
-> Maybe IgnoreMajorVersionBumps
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PackageName] -> IgnoreMajorVersionBumps
IgnoreMajorVersionBumpsSome) ([PackageName] -> Maybe IgnoreMajorVersionBumps)
-> ReadE [PackageName] -> ReadE (Maybe IgnoreMajorVersionBumps)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` ReadE [PackageName]
pkgNameListParser
pkgNameListParser :: ReadE [PackageName]
pkgNameListParser = (String -> String)
-> ParsecParser [PackageName] -> ReadE [PackageName]
forall a. (String -> String) -> ParsecParser a -> ReadE a
parsecToReadE
(String
"Couldn't parse the list of package names: " String -> String -> String
forall a. [a] -> [a] -> [a]
++)
((NonEmpty PackageName -> [PackageName])
-> ParsecParser (NonEmpty PackageName)
-> ParsecParser [PackageName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NonEmpty PackageName -> [PackageName]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (ParsecParser PackageName
-> ParsecParser Char -> ParsecParser (NonEmpty PackageName)
forall (m :: * -> *) a sep.
Alternative m =>
m a -> m sep -> m (NonEmpty a)
P.sepByNonEmpty ParsecParser PackageName
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec (Char -> ParsecParser Char
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 GlobalFlags -> GlobalFlags -> GlobalFlags
forall a. Monoid a => a -> a -> a
`mappend` GlobalFlags
globalFlags
configFlags :: ConfigFlags
configFlags = SavedConfig -> ConfigFlags
savedConfigureFlags SavedConfig
config
Verbosity -> GlobalFlags -> (RepoContext -> IO ()) -> IO ()
forall a. Verbosity -> GlobalFlags -> (RepoContext -> IO a) -> IO a
withRepoContext Verbosity
verbosity GlobalFlags
globalFlags' ((RepoContext -> IO ()) -> IO ())
-> (RepoContext -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \RepoContext
repoContext -> do
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
newFreezeFile Bool -> Bool -> Bool
&& Maybe String -> Bool
forall a. Maybe a -> Bool
isJust Maybe String
mprojectFile) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Verbosity -> String -> IO ()
forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity (String -> IO ()) -> String -> IO ()
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
(NubList String -> LFlags
forall a. NubList a -> [a]
fromNubList (NubList String -> LFlags)
-> (GlobalFlags -> NubList String) -> GlobalFlags -> LFlags
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GlobalFlags -> NubList String
globalProgPathExtra (GlobalFlags -> LFlags) -> GlobalFlags -> LFlags
forall a b. (a -> b) -> a -> b
$ GlobalFlags
globalFlags)
(Flag String -> Maybe String
forall a. Flag a -> Maybe a
flagToMaybe (Flag String -> Maybe String)
-> (GlobalFlags -> Flag String) -> GlobalFlags -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GlobalFlags -> Flag String
globalHttpTransport (GlobalFlags -> Maybe String) -> GlobalFlags -> Maybe String
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 (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Dependencies loaded: "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> LFlags -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ((PackageVersionConstraint -> String)
-> [PackageVersionConstraint] -> LFlags
forall a b. (a -> b) -> [a] -> [b]
map PackageVersionConstraint -> String
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)
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
quiet) (IO () -> IO ()) -> IO () -> IO ()
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 (Bool -> Bool)
-> ([(PackageVersionConstraint, Version)] -> Bool)
-> [(PackageVersionConstraint, Version)]
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(PackageVersionConstraint, Version)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([(PackageVersionConstraint, Version)] -> Bool)
-> [(PackageVersionConstraint, Version)] -> Bool
forall a b. (a -> b) -> a -> b
$ [(PackageVersionConstraint, Version)]
outdatedDeps)
then IO ()
forall a. IO a
exitFailure
else () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
where
verbosity :: Verbosity
verbosity = if Bool
quiet
then Verbosity
silent
else Verbosity -> Flag Verbosity -> Verbosity
forall a. a -> Flag a -> a
fromFlagOrDefault Verbosity
normal Flag Verbosity
outdatedVerbosity
freezeFile :: Bool
freezeFile = Bool -> Flag Bool -> Bool
forall a. a -> Flag a -> a
fromFlagOrDefault Bool
False Flag Bool
outdatedFreezeFile
newFreezeFile :: Bool
newFreezeFile = Bool -> Flag Bool -> Bool
forall a. a -> Flag a -> a
fromFlagOrDefault Bool
False Flag Bool
outdatedNewFreezeFile
mprojectFile :: Maybe String
mprojectFile = Flag String -> Maybe String
forall a. Flag a -> Maybe a
flagToMaybe Flag String
flagProjectFileName
simpleOutput :: Bool
simpleOutput = Bool -> Flag Bool -> Bool
forall a. a -> Flag a -> a
fromFlagOrDefault Bool
False Flag Bool
outdatedSimpleOutput
quiet :: Bool
quiet = Bool -> Flag Bool -> Bool
forall a. a -> Flag a -> a
fromFlagOrDefault Bool
False Flag Bool
outdatedQuiet
exitCode :: Bool
exitCode = Bool -> Flag Bool -> Bool
forall a. a -> Flag a -> a
fromFlagOrDefault Bool
quiet Flag Bool
outdatedExitCode
ignorePred :: PackageName -> Bool
ignorePred = let ignoreSet :: Set PackageName
ignoreSet = [PackageName] -> Set PackageName
forall a. Ord a => [a] -> Set a
S.fromList [PackageName]
outdatedIgnore
in \PackageName
pkgname -> PackageName
pkgname PackageName -> Set PackageName -> Bool
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 -> Bool -> PackageName -> Bool
forall a b. a -> b -> a
const Bool
False
Just IgnoreMajorVersionBumps
IgnoreMajorVersionBumpsNone -> Bool -> PackageName -> Bool
forall a b. a -> b -> a
const Bool
False
Just IgnoreMajorVersionBumps
IgnoreMajorVersionBumpsAll -> Bool -> PackageName -> Bool
forall a b. a -> b -> a
const Bool
True
Just (IgnoreMajorVersionBumpsSome [PackageName]
pkgs) ->
let minorSet :: Set PackageName
minorSet = [PackageName] -> Set PackageName
forall a. Ord a => [a] -> Set a
S.fromList [PackageName]
pkgs
in \PackageName
pkgname -> PackageName
pkgname PackageName -> Set PackageName -> Bool
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 (Bool -> Bool)
-> ([(PackageVersionConstraint, Version)] -> Bool)
-> [(PackageVersionConstraint, Version)]
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(PackageVersionConstraint, Version)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([(PackageVersionConstraint, Version)] -> Bool)
-> [(PackageVersionConstraint, Version)] -> Bool
forall a b. (a -> b) -> a -> b
$ [(PackageVersionConstraint, Version)]
outdatedDeps
then
do Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
simpleOutput) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Verbosity -> String -> IO ()
notice Verbosity
verbosity String
"Outdated dependencies:"
[(PackageVersionConstraint, Version)]
-> ((PackageVersionConstraint, Version) -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [(PackageVersionConstraint, Version)]
outdatedDeps (((PackageVersionConstraint, Version) -> IO ()) -> IO ())
-> ((PackageVersionConstraint, Version) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(d :: PackageVersionConstraint
d@(PackageVersionConstraint PackageName
pn VersionRange
_), Version
v) ->
let outdatedDep :: String
outdatedDep = if Bool
simpleOutput then PackageName -> String
forall a. Pretty a => a -> String
prettyShow PackageName
pn
else PackageVersionConstraint -> String
forall a. Pretty a => a -> String
prettyShow PackageVersionConstraint
d String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" (latest: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Version -> String
forall a. Pretty a => a -> String
prettyShow Version
v String -> String -> String
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 =
(UserConstraint -> Maybe PackageVersionConstraint)
-> [UserConstraint] -> [PackageVersionConstraint]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (PackageConstraint -> Maybe PackageVersionConstraint
packageConstraintToDependency (PackageConstraint -> Maybe PackageVersionConstraint)
-> (UserConstraint -> PackageConstraint)
-> UserConstraint
-> Maybe PackageVersionConstraint
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 Maybe String
forall a. Maybe a
Nothing
let ucnstrs :: [UserConstraint]
ucnstrs = ((UserConstraint, ConstraintSource) -> UserConstraint)
-> [(UserConstraint, ConstraintSource)] -> [UserConstraint]
forall a b. (a -> b) -> [a] -> [b]
map (UserConstraint, ConstraintSource) -> UserConstraint
forall a b. (a, b) -> a
fst ([(UserConstraint, ConstraintSource)] -> [UserConstraint])
-> (SavedConfig -> [(UserConstraint, ConstraintSource)])
-> SavedConfig
-> [UserConstraint]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConfigExFlags -> [(UserConstraint, ConstraintSource)]
configExConstraints (ConfigExFlags -> [(UserConstraint, ConstraintSource)])
-> (SavedConfig -> ConfigExFlags)
-> SavedConfig
-> [(UserConstraint, ConstraintSource)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SavedConfig -> ConfigExFlags
savedConfigureExFlags (SavedConfig -> [UserConstraint])
-> SavedConfig -> [UserConstraint]
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"
[PackageVersionConstraint] -> IO [PackageVersionConstraint]
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 <- (BadProjectRoot -> IO ProjectRoot)
-> (ProjectRoot -> IO ProjectRoot)
-> Either BadProjectRoot ProjectRoot
-> IO ProjectRoot
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either BadProjectRoot -> IO ProjectRoot
forall e a. Exception e => e -> IO a
throwIO ProjectRoot -> IO ProjectRoot
forall (m :: * -> *) a. Monad m => a -> m a
return (Either BadProjectRoot ProjectRoot -> IO ProjectRoot)
-> IO (Either BadProjectRoot ProjectRoot) -> IO ProjectRoot
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
Maybe String
-> Maybe String -> IO (Either BadProjectRoot ProjectRoot)
findProjectRoot Maybe String
forall a. Maybe a
Nothing Maybe String
mprojectFile
let distDirLayout :: DistDirLayout
distDirLayout = ProjectRoot -> Maybe String -> DistDirLayout
defaultDistDirLayout ProjectRoot
projectRoot
Maybe String
forall a. Maybe a
Nothing
ProjectConfig
projectConfig <- String -> Rebuild ProjectConfig -> IO ProjectConfig
forall a. String -> Rebuild a -> IO a
runRebuild (DistDirLayout -> String
distProjectRootDirectory DistDirLayout
distDirLayout) (Rebuild ProjectConfig -> IO ProjectConfig)
-> Rebuild ProjectConfig -> IO ProjectConfig
forall a b. (a -> b) -> a -> b
$ do
ProjectConfigSkeleton
pcs <- Verbosity
-> HttpTransport -> DistDirLayout -> Rebuild ProjectConfigSkeleton
readProjectLocalFreezeConfig Verbosity
verbosity HttpTransport
httpTransport DistDirLayout
distDirLayout
ProjectConfig -> Rebuild ProjectConfig
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ProjectConfig -> Rebuild ProjectConfig)
-> ProjectConfig -> Rebuild ProjectConfig
forall a b. (a -> b) -> a -> b
$ OS
-> Arch
-> CompilerInfo
-> FlagAssignment
-> ProjectConfigSkeleton
-> ProjectConfig
instantiateProjectConfigSkeleton OS
os Arch
arch (Compiler -> CompilerInfo
compilerInfo Compiler
compiler) FlagAssignment
forall a. Monoid a => a
mempty ProjectConfigSkeleton
pcs
let ucnstrs :: [UserConstraint]
ucnstrs = ((UserConstraint, ConstraintSource) -> UserConstraint)
-> [(UserConstraint, ConstraintSource)] -> [UserConstraint]
forall a b. (a -> b) -> [a] -> [b]
map (UserConstraint, ConstraintSource) -> UserConstraint
forall a b. (a, b) -> a
fst ([(UserConstraint, ConstraintSource)] -> [UserConstraint])
-> (ProjectConfig -> [(UserConstraint, ConstraintSource)])
-> ProjectConfig
-> [UserConstraint]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProjectConfigShared -> [(UserConstraint, ConstraintSource)]
projectConfigConstraints (ProjectConfigShared -> [(UserConstraint, ConstraintSource)])
-> (ProjectConfig -> ProjectConfigShared)
-> ProjectConfig
-> [(UserConstraint, ConstraintSource)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProjectConfig -> ProjectConfigShared
projectConfigShared
(ProjectConfig -> [UserConstraint])
-> ProjectConfig -> [UserConstraint]
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
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
freezeFileExists (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Verbosity -> String -> IO ()
forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
String
"Couldn't find a freeze file expected at: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
freezeFile String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n\n"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"We are looking for this file because you supplied '--project-file' or '--v2-freeze-file'. "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"When one of these flags is given, we try to read the dependencies from a freeze file. "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"If it is undesired behaviour, you should not use these flags, otherwise please generate "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"a freeze file via 'cabal freeze'."
Verbosity -> String -> IO ()
debug Verbosity
verbosity (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
String
"Reading the list of dependencies from the new-style freeze file " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
freezeFile
[PackageVersionConstraint] -> IO [PackageVersionConstraint]
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 FlagAssignment
forall a. Monoid a => a
mempty (Bool -> Bool -> ComponentRequestedSpec
ComponentRequestedSpec Bool
True Bool
True)
(Bool -> Dependency -> Bool
forall a b. a -> b -> a
const Bool
True) Platform
platform CompilerInfo
cinfo [] GenericPackageDescription
gpd
case Either [Dependency] (PackageDescription, FlagAssignment)
epd of
Left [Dependency]
_ -> Verbosity -> String -> IO [PackageVersionConstraint]
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"
[PackageVersionConstraint] -> IO [PackageVersionConstraint]
forall (m :: * -> *) a. Monad m => a -> m a
return ([PackageVersionConstraint] -> IO [PackageVersionConstraint])
-> [PackageVersionConstraint] -> IO [PackageVersionConstraint]
forall a b. (a -> b) -> a -> b
$ (Dependency -> PackageVersionConstraint)
-> [Dependency] -> [PackageVersionConstraint]
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) =
(PackageVersionConstraint
-> Maybe (PackageVersionConstraint, Version))
-> [PackageVersionConstraint]
-> [(PackageVersionConstraint, Version)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe PackageVersionConstraint
-> Maybe (PackageVersionConstraint, Version)
isOutdated ([PackageVersionConstraint]
-> [(PackageVersionConstraint, Version)])
-> [PackageVersionConstraint]
-> [(PackageVersionConstraint, Version)]
forall a b. (a -> b) -> a -> b
$ (PackageVersionConstraint -> PackageVersionConstraint)
-> [PackageVersionConstraint] -> [PackageVersionConstraint]
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 = Maybe (PackageVersionConstraint, Version)
forall a. Maybe a
Nothing
| Bool
otherwise =
let this :: [Version]
this = (UnresolvedSourcePackage -> Version)
-> [UnresolvedSourcePackage] -> [Version]
forall a b. (a -> b) -> [a] -> [b]
map UnresolvedSourcePackage -> Version
forall pkg. Package pkg => pkg -> Version
packageVersion ([UnresolvedSourcePackage] -> [Version])
-> [UnresolvedSourcePackage] -> [Version]
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)) (Version -> (PackageVersionConstraint, Version))
-> Maybe Version -> Maybe (PackageVersionConstraint, Version)
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]
_ = Maybe Version
forall a. Maybe a
Nothing
isOutdated' [Version]
_ [] = Maybe Version
forall a. Maybe a
Nothing
isOutdated' [Version]
this [Version]
latest =
let this' :: Version
this' = [Version] -> Version
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Version]
this
latest' :: Version
latest' = [Version] -> Version
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Version]
latest
in if Version
this' Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
< Version
latest' then Version -> Maybe Version
forall a. a -> Maybe a
Just Version
latest' else Maybe Version
forall a. Maybe a
Nothing
lookupLatest :: PackageVersionConstraint -> [Version]
lookupLatest :: PackageVersionConstraint -> [Version]
lookupLatest (PackageVersionConstraint PackageName
pname VersionRange
vr)
| PackageName -> Bool
minorPred PackageName
pname =
(UnresolvedSourcePackage -> Version)
-> [UnresolvedSourcePackage] -> [Version]
forall a b. (a -> b) -> [a] -> [b]
map UnresolvedSourcePackage -> Version
forall pkg. Package pkg => pkg -> Version
packageVersion ([UnresolvedSourcePackage] -> [Version])
-> [UnresolvedSourcePackage] -> [Version]
forall a b. (a -> b) -> a -> b
$ SourcePackageDb
-> PackageName -> VersionRange -> [UnresolvedSourcePackage]
SourcePackageDb.lookupDependency SourcePackageDb
sourceDb PackageName
pname (VersionRange -> VersionRange
relaxMinor VersionRange
vr)
| Bool
otherwise =
(UnresolvedSourcePackage -> Version)
-> [UnresolvedSourcePackage] -> [Version]
forall a b. (a -> b) -> [a] -> [b]
map UnresolvedSourcePackage -> Version
forall pkg. Package pkg => pkg -> Version
packageVersion ([UnresolvedSourcePackage] -> [Version])
-> [UnresolvedSourcePackage] -> [Version]
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 VersionRange
-> (VersionInterval -> VersionRange)
-> Maybe VersionInterval
-> VersionRange
forall b a. b -> (a -> b) -> Maybe a -> b
maybe VersionRange
vr VersionInterval -> VersionRange
relax ([VersionInterval] -> Maybe VersionInterval
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