{-# LANGUAGE CPP #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE NamedFieldPuns #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Distribution.Client.CmdOutdated
-- Maintainer  :  cabal-devel@haskell.org
-- Portability :  portable
--
-- Implementation of the 'outdated' command. Checks for outdated
-- dependencies in the package description file or freeze file.
-----------------------------------------------------------------------------

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 )

-------------------------------------------------------------------------------
-- Command
-------------------------------------------------------------------------------

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)
  }

-------------------------------------------------------------------------------
-- Flags
-------------------------------------------------------------------------------

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
',')))

-------------------------------------------------------------------------------
-- Action
-------------------------------------------------------------------------------

-- | Entry point for the 'outdated' command.
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


-- | Print either the list of all outdated dependencies, or a message
-- that there are none.
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."

-- | Convert a list of 'UserConstraint's to a 'Dependency' list.
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

-- | Read the list of dependencies from the freeze file.
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

-- | Read the list of dependencies from the new-style freeze file.
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
                      {- TODO: Support dist dir override -} 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

-- | Read the list of dependencies from the package description.
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

-- | Various knobs for customising the behaviour of 'listOutdated'.
data ListOutdatedSettings = ListOutdatedSettings
  { -- | Should this package be ignored?
    ListOutdatedSettings -> PackageName -> Bool
listOutdatedIgnorePred :: PackageName -> Bool
  , -- | Should major version bumps be ignored for this package?
    ListOutdatedSettings -> PackageName -> Bool
listOutdatedMinorPred  :: PackageName -> Bool
  }

-- | Find all outdated dependencies.
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