{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE RecordWildCards #-}

-- |
-- 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
  , IgnoreMajorVersionBumps (..)
  , showResult
  )
where

import Distribution.Client.Compat.Prelude
import Prelude ()

import qualified Data.Set as Set
import Distribution.Client.Config
  ( SavedConfig
      ( savedConfigureExFlags
      )
  )
import qualified Distribution.Client.IndexUtils as IndexUtils
import Distribution.Client.ProjectConfig
import Distribution.Client.Sandbox.PackageEnvironment
  ( loadUserConfig
  )
import Distribution.Client.Setup
import Distribution.Client.Targets
  ( UserConstraint
  , userToPackageConstraint
  )
import Distribution.Client.Types.SourcePackageDb as SourcePackageDb
import qualified Distribution.Compat.CharParsing as P
import Distribution.PackageDescription
import Distribution.PackageDescription.Configuration
import Distribution.Solver.Types.PackageConstraint
  ( packageConstraintToDependency
  )
import Distribution.Version
  ( LowerBound (..)
  , UpperBound (..)
  , Version
  , VersionInterval (..)
  , VersionRange
  , asVersionIntervals
  , majorBoundVersion
  )

import qualified Data.Set as S
import Distribution.Client.NixStyleOptions
import System.Directory
  ( getCurrentDirectory
  )

import Distribution.Client.ProjectOrchestration

import Control.Monad
import Distribution.Client.ScriptUtils
import Distribution.Package
import Distribution.ReadE
import Distribution.Simple.Command
import Distribution.Simple.Flag
import Distribution.Simple.Setup hiding (GlobalFlags (..))
import Distribution.Simple.Utils
import Distribution.Types.PackageVersionConstraint
import Distribution.Verbosity

import qualified Data.Map.Strict as Map
import Distribution.Client.CmdErrorMessages
import Distribution.Client.ProjectPlanning.Types
import Distribution.Client.TargetProblem
import Distribution.Client.Types.PackageSpecifier
import Distribution.Solver.Types.ConstraintSource
import Distribution.Solver.Types.SourcePackage
import Distribution.Types.Component
import qualified Text.PrettyPrint as PP

import Distribution.Client.Errors

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

outdatedCommand :: CommandUI (NixStyleFlags OutdatedFlags)
outdatedCommand :: CommandUI (NixStyleFlags OutdatedFlags)
outdatedCommand =
  CommandUI
    { commandName :: String
commandName = String
"v2-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 :: NixStyleFlags OutdatedFlags
commandDefaultFlags = OutdatedFlags -> NixStyleFlags OutdatedFlags
forall a. a -> NixStyleFlags a
defaultNixStyleFlags OutdatedFlags
defaultOutdatedFlags
    , commandOptions :: ShowOrParseArgs -> [OptionField (NixStyleFlags OutdatedFlags)]
commandOptions = (ShowOrParseArgs -> [OptionField OutdatedFlags])
-> ShowOrParseArgs -> [OptionField (NixStyleFlags OutdatedFlags)]
forall a.
(ShowOrParseArgs -> [OptionField a])
-> ShowOrParseArgs -> [OptionField (NixStyleFlags a)]
nixStyleOptions ((ShowOrParseArgs -> [OptionField OutdatedFlags])
 -> ShowOrParseArgs -> [OptionField (NixStyleFlags OutdatedFlags)])
-> (ShowOrParseArgs -> [OptionField OutdatedFlags])
-> ShowOrParseArgs
-> [OptionField (NixStyleFlags OutdatedFlags)]
forall a b. (a -> b) -> a -> b
$ \ShowOrParseArgs
showOrParseArgs ->
        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 = 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 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
    { 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 =
  [ 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 = 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
"project-context", String
"v2-freeze-file", String
"new-freeze-file"]
      String
"Check for outdated dependencies in the project context, for example, dependencies specified in cabal.project orcabal.project.freeze."
      OutdatedFlags -> Flag Bool
outdatedNewFreezeFile
      (\Flag Bool
v OutdatedFlags
flags -> OutdatedFlags
flags{outdatedNewFreezeFile = 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 = 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 = 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 = 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 = 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 = v})
      ( String
-> ReadE (Maybe IgnoreMajorVersionBumps)
-> (String, Maybe IgnoreMajorVersionBumps)
-> (Maybe IgnoreMajorVersionBumps -> [Maybe String])
-> MkOptDescr
     (OutdatedFlags -> Maybe IgnoreMajorVersionBumps)
     (Maybe IgnoreMajorVersionBumps -> OutdatedFlags -> OutdatedFlags)
     OutdatedFlags
forall b a.
Monoid b =>
String
-> ReadE b
-> (String, b)
-> (b -> [Maybe String])
-> MkOptDescr (a -> b) (b -> a -> a) a
optArg
          String
"PKGS"
          ReadE (Maybe IgnoreMajorVersionBumps)
ignoreMajorVersionBumpsParser
          (String
"", 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 a b. (a -> b) -> ReadE a -> ReadE b
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 a b. (a -> b) -> ParsecParser a -> ParsecParser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NonEmpty PackageName -> [PackageName]
forall a. NonEmpty a -> [a]
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
forall (m :: * -> *). CabalParsing m => m PackageName
parsec (Char -> ParsecParser Char
forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
',')))

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

getSourcePackages :: Verbosity -> ProjectConfig -> IO SourcePackageDb
getSourcePackages :: Verbosity -> ProjectConfig -> IO SourcePackageDb
getSourcePackages Verbosity
verbosity ProjectConfig
projectConfig =
  Verbosity
-> ProjectConfigShared
-> ProjectConfigBuildOnly
-> (RepoContext -> IO SourcePackageDb)
-> IO SourcePackageDb
forall a.
Verbosity
-> ProjectConfigShared
-> ProjectConfigBuildOnly
-> (RepoContext -> IO a)
-> IO a
projectConfigWithSolverRepoContext
    Verbosity
verbosity
    (ProjectConfig -> ProjectConfigShared
projectConfigShared ProjectConfig
projectConfig)
    (ProjectConfig -> ProjectConfigBuildOnly
projectConfigBuildOnly ProjectConfig
projectConfig)
    (\RepoContext
ctx -> Verbosity -> RepoContext -> IO SourcePackageDb
IndexUtils.getSourcePackages Verbosity
verbosity RepoContext
ctx)

outdatedAction :: NixStyleFlags OutdatedFlags -> [String] -> GlobalFlags -> IO ()
outdatedAction :: NixStyleFlags OutdatedFlags -> LFlags -> GlobalFlags -> IO ()
outdatedAction NixStyleFlags OutdatedFlags
flags LFlags
targetStrings GlobalFlags
globalFlags =
  Verbosity
-> AcceptNoTargets
-> Maybe ComponentKind
-> NixStyleFlags OutdatedFlags
-> LFlags
-> GlobalFlags
-> CurrentCommand
-> (TargetContext
    -> ProjectBaseContext -> [TargetSelector] -> IO ())
-> IO ()
forall a b.
Verbosity
-> AcceptNoTargets
-> Maybe ComponentKind
-> NixStyleFlags a
-> LFlags
-> GlobalFlags
-> CurrentCommand
-> (TargetContext
    -> ProjectBaseContext -> [TargetSelector] -> IO b)
-> IO b
withContextAndSelectors
    Verbosity
verbosity
    AcceptNoTargets
AcceptNoTargets
    Maybe ComponentKind
forall a. Maybe a
Nothing
    NixStyleFlags OutdatedFlags
flags
    LFlags
targetStrings
    GlobalFlags
globalFlags
    CurrentCommand
OtherCommand
    ((TargetContext -> ProjectBaseContext -> [TargetSelector] -> IO ())
 -> IO ())
-> (TargetContext
    -> ProjectBaseContext -> [TargetSelector] -> IO ())
-> IO ()
forall a b. (a -> b) -> a -> b
$ \TargetContext
_targetCtx ProjectBaseContext
ctx [TargetSelector]
targetSelectors -> do
      [CandidateOutdatedDependency]
deps <-
        if
            | Bool
freezeFile -> Verbosity -> IO [CandidateOutdatedDependency]
depsFromFreezeFile Verbosity
verbosity
            | Bool
newFreezeFile -> Verbosity -> ProjectConfig -> IO [CandidateOutdatedDependency]
depsFromProjectContext Verbosity
verbosity (ProjectBaseContext -> ProjectConfig
projectConfig ProjectBaseContext
ctx)
            | Bool
otherwise -> Verbosity
-> ProjectBaseContext
-> [TargetSelector]
-> IO [CandidateOutdatedDependency]
depsFromLocalPackages Verbosity
verbosity ProjectBaseContext
ctx [TargetSelector]
targetSelectors

      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
", " ((CandidateOutdatedDependency -> String)
-> [CandidateOutdatedDependency] -> LFlags
forall a b. (a -> b) -> [a] -> [b]
map CandidateOutdatedDependency -> String
forall a. Pretty a => a -> String
prettyShow [CandidateOutdatedDependency]
deps)

      SourcePackageDb
sourcePkgDb <- Verbosity -> ProjectConfig -> IO SourcePackageDb
getSourcePackages Verbosity
verbosity (ProjectBaseContext -> ProjectConfig
projectConfig ProjectBaseContext
ctx)
      let outdatedDeps :: [OutdatedDependency]
outdatedDeps =
            [CandidateOutdatedDependency]
-> SourcePackageDb -> ListOutdatedSettings -> [OutdatedDependency]
listOutdated
              [CandidateOutdatedDependency]
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 -> [OutdatedDependency] -> Bool -> IO ()
showResult Verbosity
verbosity [OutdatedDependency]
outdatedDeps Bool
simpleOutput
      if Bool
exitCode Bool -> Bool -> Bool
&& (Bool -> Bool
not (Bool -> Bool)
-> ([OutdatedDependency] -> Bool) -> [OutdatedDependency] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [OutdatedDependency] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([OutdatedDependency] -> Bool) -> [OutdatedDependency] -> Bool
forall a b. (a -> b) -> a -> b
$ [OutdatedDependency]
outdatedDeps)
        then IO ()
forall a. IO a
exitFailure
        else () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  where
    OutdatedFlags{[PackageName]
Maybe IgnoreMajorVersionBumps
Flag Bool
outdatedFreezeFile :: OutdatedFlags -> Flag Bool
outdatedNewFreezeFile :: OutdatedFlags -> Flag Bool
outdatedSimpleOutput :: OutdatedFlags -> Flag Bool
outdatedExitCode :: OutdatedFlags -> Flag Bool
outdatedQuiet :: OutdatedFlags -> Flag Bool
outdatedIgnore :: OutdatedFlags -> [PackageName]
outdatedMinor :: OutdatedFlags -> Maybe IgnoreMajorVersionBumps
outdatedFreezeFile :: Flag Bool
outdatedNewFreezeFile :: Flag Bool
outdatedSimpleOutput :: Flag Bool
outdatedExitCode :: Flag Bool
outdatedQuiet :: Flag Bool
outdatedIgnore :: [PackageName]
outdatedMinor :: Maybe IgnoreMajorVersionBumps
..} = NixStyleFlags OutdatedFlags -> OutdatedFlags
forall a. NixStyleFlags a -> a
extraFlags NixStyleFlags OutdatedFlags
flags
    verbosity :: Verbosity
verbosity =
      if Bool
quiet
        then Verbosity
silent
        else Verbosity -> Flag Verbosity -> Verbosity
forall a. a -> Flag a -> a
fromFlagOrDefault Verbosity
normal (CommonSetupFlags -> Flag Verbosity
setupVerbosity (ConfigFlags -> CommonSetupFlags
configCommonFlags (NixStyleFlags OutdatedFlags -> ConfigFlags
forall a. NixStyleFlags a -> ConfigFlags
configFlags NixStyleFlags OutdatedFlags
flags)))
    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
    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

reportOutdatedTargetProblem :: Verbosity -> [TargetProblem'] -> IO a
reportOutdatedTargetProblem :: forall a. Verbosity -> [TargetProblem'] -> IO a
reportOutdatedTargetProblem Verbosity
verbosity [TargetProblem']
problems =
  Verbosity -> String -> [TargetProblem'] -> IO a
forall a. Verbosity -> String -> [TargetProblem'] -> IO a
reportTargetProblems Verbosity
verbosity String
"check outdated dependencies for" [TargetProblem']
problems

-- | Print either the list of all outdated dependencies, or a message
-- that there are none.
showResult :: Verbosity -> [OutdatedDependency] -> Bool -> IO ()
showResult :: Verbosity -> [OutdatedDependency] -> Bool -> IO ()
showResult Verbosity
verbosity [OutdatedDependency]
outdatedDeps Bool
simpleOutput =
  if Bool -> Bool
not (Bool -> Bool)
-> ([OutdatedDependency] -> Bool) -> [OutdatedDependency] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [OutdatedDependency] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([OutdatedDependency] -> Bool) -> [OutdatedDependency] -> Bool
forall a b. (a -> b) -> a -> b
$ [OutdatedDependency]
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:"
      if Bool
simpleOutput
        then -- Simple output just prints package names, one per line
          IO ()
outputSimple
        else -- Hierarchical output grouped by package and component
          IO ()
outputStructured
    else Verbosity -> String -> IO ()
notice Verbosity
verbosity String
"All dependencies are up to date."
  where
    -- Group dependencies by package and component
    groupByPackage :: [OutdatedDependency] -> [(String, [(String, [OutdatedDependency])])]
    groupByPackage :: [OutdatedDependency]
-> [(String, [(String, [OutdatedDependency])])]
groupByPackage [OutdatedDependency]
deps =
      let
        -- First, create a list of (package, component, dependency) tuples
        pkgCompDeps :: [(String, String, OutdatedDependency)]
pkgCompDeps =
          [ (OutdatedDependencySource -> String
extractPackageName OutdatedDependencySource
src, OutdatedDependencySource -> String
extractComponentName OutdatedDependencySource
src, OutdatedDependency
dep)
          | dep :: OutdatedDependency
dep@(OutdatedDependency PackageVersionConstraint
_ Version
_ OutdatedDependencySource
src) <- [OutdatedDependency]
deps
          ]
        -- Group by package
        pkgGroups :: Map String (Map String [OutdatedDependency])
pkgGroups =
          (Map String [OutdatedDependency]
 -> Map String [OutdatedDependency]
 -> Map String [OutdatedDependency])
-> [(String, Map String [OutdatedDependency])]
-> Map String (Map String [OutdatedDependency])
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith
            (([OutdatedDependency]
 -> [OutdatedDependency] -> [OutdatedDependency])
-> Map String [OutdatedDependency]
-> Map String [OutdatedDependency]
-> Map String [OutdatedDependency]
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith [OutdatedDependency]
-> [OutdatedDependency] -> [OutdatedDependency]
forall a. [a] -> [a] -> [a]
(++))
            [ (String
pkg, (String -> [OutdatedDependency] -> Map String [OutdatedDependency]
forall k a. k -> a -> Map k a
Map.singleton String
comp [OutdatedDependency
d]))
            | (String
pkg, String
comp, OutdatedDependency
d) <- [(String, String, OutdatedDependency)]
pkgCompDeps
            ]
       in
        Map String [(String, [OutdatedDependency])]
-> [(String, [(String, [OutdatedDependency])])]
forall k a. Map k a -> [(k, a)]
Map.toList ((Map String [OutdatedDependency]
 -> [(String, [OutdatedDependency])])
-> Map String (Map String [OutdatedDependency])
-> Map String [(String, [OutdatedDependency])]
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map Map String [OutdatedDependency] -> [(String, [OutdatedDependency])]
forall k a. Map k a -> [(k, a)]
Map.toList Map String (Map String [OutdatedDependency])
pkgGroups)

    -- Extract package name from the source
    extractPackageName :: OutdatedDependencySource -> String
    extractPackageName :: OutdatedDependencySource -> String
extractPackageName (ConfigSource ConstraintSource
_) = String
"project-config"
    extractPackageName (ComponentSource PackageId
pkgId ComponentTarget
_) = PackageName -> String
forall a. Pretty a => a -> String
prettyShow (PackageId -> PackageName
pkgName PackageId
pkgId)

    -- Extract component name from the source
    extractComponentName :: OutdatedDependencySource -> String
    extractComponentName :: OutdatedDependencySource -> String
extractComponentName (ConfigSource ConstraintSource
src) = ConstraintSource -> String
showConstraintSource ConstraintSource
src
    extractComponentName (ComponentSource PackageId
pkgId ComponentTarget
ctarget) = PackageId -> ComponentTarget -> String
showComponentTarget PackageId
pkgId ComponentTarget
ctarget

    getConstraintPackageName :: PackageVersionConstraint -> PackageName
    getConstraintPackageName :: PackageVersionConstraint -> PackageName
getConstraintPackageName (PackageVersionConstraint PackageName
pn VersionRange
_) = PackageName
pn

    outputSimple :: IO ()
outputSimple =
      let pns :: [PackageName]
pns = [PackageName] -> [PackageName]
forall a. Ord a => [a] -> [a]
sortNub ([PackageName] -> [PackageName]) -> [PackageName] -> [PackageName]
forall a b. (a -> b) -> a -> b
$ (OutdatedDependency -> PackageName)
-> [OutdatedDependency] -> [PackageName]
forall a b. (a -> b) -> [a] -> [b]
map (PackageVersionConstraint -> PackageName
getConstraintPackageName (PackageVersionConstraint -> PackageName)
-> (OutdatedDependency -> PackageVersionConstraint)
-> OutdatedDependency
-> PackageName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OutdatedDependency -> PackageVersionConstraint
forall v. OutdatedDependencyX v -> PackageVersionConstraint
outdatedDependency) [OutdatedDependency]
outdatedDeps
       in [PackageName] -> (PackageName -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [PackageName]
pns ((PackageName -> IO ()) -> IO ())
-> (PackageName -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \PackageName
pn ->
            Verbosity -> String -> IO ()
noticeNoWrap Verbosity
verbosity (PackageName -> String
forall a. Pretty a => a -> String
prettyShow PackageName
pn)

    outputStructured :: IO ()
outputStructured =
      let
        -- Group by package name, then by component
        packageGroups :: [(String, [(String, [OutdatedDependency])])]
packageGroups = [OutdatedDependency]
-> [(String, [(String, [OutdatedDependency])])]
groupByPackage [OutdatedDependency]
outdatedDeps
       in
        [(String, [(String, [OutdatedDependency])])]
-> ((String, [(String, [OutdatedDependency])]) -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [(String, [(String, [OutdatedDependency])])]
packageGroups (((String, [(String, [OutdatedDependency])]) -> IO ()) -> IO ())
-> ((String, [(String, [OutdatedDependency])]) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(String
pkgName, [(String, [OutdatedDependency])]
componentGroups) -> do
          Verbosity -> String -> IO ()
noticeNoWrap Verbosity
verbosity (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"* " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
pkgName
          [(String, [OutdatedDependency])]
-> ((String, [OutdatedDependency]) -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [(String, [OutdatedDependency])]
componentGroups (((String, [OutdatedDependency]) -> IO ()) -> IO ())
-> ((String, [OutdatedDependency]) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(String
compName, [OutdatedDependency]
deps) -> do
            Verbosity -> String -> IO ()
noticeNoWrap Verbosity
verbosity (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"  - " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
compName
            [OutdatedDependency] -> (OutdatedDependency -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ ((OutdatedDependency -> OutdatedDependency -> Ordering)
-> [OutdatedDependency] -> [OutdatedDependency]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((OutdatedDependency -> PackageName)
-> OutdatedDependency -> OutdatedDependency -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (PackageVersionConstraint -> PackageName
getConstraintPackageName (PackageVersionConstraint -> PackageName)
-> (OutdatedDependency -> PackageVersionConstraint)
-> OutdatedDependency
-> PackageName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OutdatedDependency -> PackageVersionConstraint
forall v. OutdatedDependencyX v -> PackageVersionConstraint
outdatedDependency)) [OutdatedDependency]
deps) ((OutdatedDependency -> IO ()) -> IO ())
-> (OutdatedDependency -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
              \(OutdatedDependency PackageVersionConstraint
d Version
v OutdatedDependencySource
_) ->
                Verbosity -> String -> IO ()
noticeNoWrap Verbosity
verbosity (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"    * " String -> String -> String
forall a. [a] -> [a] -> [a]
++ 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
")"

data OutdatedDependencyX v = OutdatedDependency
  { forall v. OutdatedDependencyX v -> PackageVersionConstraint
outdatedDependency :: PackageVersionConstraint
  , forall v. OutdatedDependencyX v -> v
_outdatedVersion :: v
  , forall v. OutdatedDependencyX v -> OutdatedDependencySource
_outdatedSource :: OutdatedDependencySource
  }

instance Pretty (OutdatedDependencyX Version) where
  pretty :: OutdatedDependency -> Doc
pretty (OutdatedDependency PackageVersionConstraint
dep Version
ver OutdatedDependencySource
src) =
    PackageVersionConstraint -> Doc
forall a. Pretty a => a -> Doc
pretty PackageVersionConstraint
dep
      Doc -> Doc -> Doc
<+> String -> Doc
PP.text String
"(latest:"
      Doc -> Doc -> Doc
<+> Version -> Doc
forall a. Pretty a => a -> Doc
pretty Version
ver
      Doc -> Doc -> Doc
<+> String -> Doc
PP.text String
","
      Doc -> Doc -> Doc
<+> String -> Doc
PP.text String
"from:"
      Doc -> Doc -> Doc
<+> String -> Doc
PP.text (OutdatedDependencySource -> String
prettyOutdatedDependencySource OutdatedDependencySource
src)
      Doc -> Doc -> Doc
<+> String -> Doc
PP.text String
")"

instance Pretty (OutdatedDependencyX ()) where
  pretty :: CandidateOutdatedDependency -> Doc
pretty (OutdatedDependency PackageVersionConstraint
dep ()
_ OutdatedDependencySource
src) =
    PackageVersionConstraint -> Doc
forall a. Pretty a => a -> Doc
pretty PackageVersionConstraint
dep Doc -> Doc -> Doc
<+> String -> Doc
PP.text String
"(from:" Doc -> Doc -> Doc
<+> String -> Doc
PP.text (OutdatedDependencySource -> String
prettyOutdatedDependencySource OutdatedDependencySource
src) Doc -> Doc -> Doc
forall a. Monoid a => a -> a -> a
`mappend` String -> Doc
PP.text String
")"

data OutdatedDependencySource = ConfigSource ConstraintSource | ComponentSource PackageId ComponentTarget

-- | Pretty print an 'OutdatedDependencySource'.
prettyOutdatedDependencySource :: OutdatedDependencySource -> String
prettyOutdatedDependencySource :: OutdatedDependencySource -> String
prettyOutdatedDependencySource (ConfigSource ConstraintSource
src) = ConstraintSource -> String
showConstraintSource ConstraintSource
src
prettyOutdatedDependencySource (ComponentSource PackageId
pkgId ComponentTarget
ctarget) = PackageId -> String
forall a. Pretty a => a -> String
prettyShow PackageId
pkgId String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":" String -> String -> String
forall a. [a] -> [a] -> [a]
++ PackageId -> ComponentTarget -> String
showComponentTarget PackageId
pkgId ComponentTarget
ctarget

type CandidateOutdatedDependency = OutdatedDependencyX ()

mkCandidateOutdatedDependency :: PackageVersionConstraint -> OutdatedDependencySource -> CandidateOutdatedDependency
mkCandidateOutdatedDependency :: PackageVersionConstraint
-> OutdatedDependencySource -> CandidateOutdatedDependency
mkCandidateOutdatedDependency PackageVersionConstraint
dep OutdatedDependencySource
src = PackageVersionConstraint
-> () -> OutdatedDependencySource -> CandidateOutdatedDependency
forall v.
PackageVersionConstraint
-> v -> OutdatedDependencySource -> OutdatedDependencyX v
OutdatedDependency PackageVersionConstraint
dep () OutdatedDependencySource
src

type OutdatedDependency = OutdatedDependencyX Version

-- | Convert a list of 'UserConstraint's to a 'Dependency' list.
userConstraintsToDependencies :: [(UserConstraint, ConstraintSource)] -> [CandidateOutdatedDependency]
userConstraintsToDependencies :: [(UserConstraint, ConstraintSource)]
-> [CandidateOutdatedDependency]
userConstraintsToDependencies [(UserConstraint, ConstraintSource)]
ucnstrs =
  ((UserConstraint, ConstraintSource)
 -> Maybe CandidateOutdatedDependency)
-> [(UserConstraint, ConstraintSource)]
-> [CandidateOutdatedDependency]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\(UserConstraint
uc, ConstraintSource
src) -> (PackageVersionConstraint -> CandidateOutdatedDependency)
-> Maybe PackageVersionConstraint
-> Maybe CandidateOutdatedDependency
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((PackageVersionConstraint
 -> OutdatedDependencySource -> CandidateOutdatedDependency)
-> OutdatedDependencySource
-> PackageVersionConstraint
-> CandidateOutdatedDependency
forall a b c. (a -> b -> c) -> b -> a -> c
flip PackageVersionConstraint
-> OutdatedDependencySource -> CandidateOutdatedDependency
mkCandidateOutdatedDependency (ConstraintSource -> OutdatedDependencySource
ConfigSource ConstraintSource
src)) (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 -> Maybe PackageVersionConstraint)
-> UserConstraint -> Maybe PackageVersionConstraint
forall a b. (a -> b) -> a -> b
$ UserConstraint
uc)) [(UserConstraint, ConstraintSource)]
ucnstrs

-- | Read the list of dependencies from the freeze file.
depsFromFreezeFile :: Verbosity -> IO [CandidateOutdatedDependency]
depsFromFreezeFile :: Verbosity -> IO [CandidateOutdatedDependency]
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, ConstraintSource)]
ucnstrs =
        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, ConstraintSource)])
-> SavedConfig -> [(UserConstraint, ConstraintSource)]
forall a b. (a -> b) -> a -> b
$
          SavedConfig
userConfig
      deps :: [CandidateOutdatedDependency]
deps = [(UserConstraint, ConstraintSource)]
-> [CandidateOutdatedDependency]
userConstraintsToDependencies [(UserConstraint, ConstraintSource)]
ucnstrs
  Verbosity -> String -> IO ()
debug Verbosity
verbosity String
"Reading the list of dependencies from the freeze file"
  [CandidateOutdatedDependency] -> IO [CandidateOutdatedDependency]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [CandidateOutdatedDependency]
deps

-- | Read the list of dependencies from the cabal.project context.
-- This will get dependencies from
--  * cabal.project.freeze
--  * cabal.project.local
--  * cabal.project
-- files
depsFromProjectContext :: Verbosity -> ProjectConfig -> IO [CandidateOutdatedDependency]
depsFromProjectContext :: Verbosity -> ProjectConfig -> IO [CandidateOutdatedDependency]
depsFromProjectContext Verbosity
verbosity ProjectConfig
projectConfig = do
  let ucnstrs :: [(UserConstraint, ConstraintSource)]
ucnstrs = ProjectConfigShared -> [(UserConstraint, ConstraintSource)]
projectConfigConstraints (ProjectConfigShared -> [(UserConstraint, ConstraintSource)])
-> ProjectConfigShared -> [(UserConstraint, ConstraintSource)]
forall a b. (a -> b) -> a -> b
$ ProjectConfig -> ProjectConfigShared
projectConfigShared ProjectConfig
projectConfig
      deps :: [CandidateOutdatedDependency]
deps = [(UserConstraint, ConstraintSource)]
-> [CandidateOutdatedDependency]
userConstraintsToDependencies [(UserConstraint, ConstraintSource)]
ucnstrs
      provenance :: Set ProjectConfigProvenance
provenance = ProjectConfig -> Set ProjectConfigProvenance
projectConfigProvenance ProjectConfig
projectConfig
  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 project files: "
      String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> LFlags -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " [ProjectConfigPath -> String
forall a. Pretty a => a -> String
prettyShow ProjectConfigPath
p | Explicit ProjectConfigPath
p <- Set ProjectConfigProvenance -> [ProjectConfigProvenance]
forall a. Set a -> [a]
Set.toList Set ProjectConfigProvenance
provenance]
  [CandidateOutdatedDependency] -> IO [CandidateOutdatedDependency]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [CandidateOutdatedDependency]
deps

-- | Read the list of dependencies from the package description.
depsFromPkgDesc :: Verbosity -> PackageId -> GenericPackageDescription -> ComponentTarget -> IO [CandidateOutdatedDependency]
depsFromPkgDesc :: Verbosity
-> PackageId
-> GenericPackageDescription
-> ComponentTarget
-> IO [CandidateOutdatedDependency]
depsFromPkgDesc Verbosity
verbosity PackageId
pkgId GenericPackageDescription
gpd t :: ComponentTarget
t@(ComponentTarget ComponentName
cname SubComponentTarget
_subtarget) = do
  let pd :: PackageDescription
pd = GenericPackageDescription -> PackageDescription
flattenPackageDescription GenericPackageDescription
gpd
      bd :: [Dependency]
bd = BuildInfo -> [Dependency]
targetBuildDepends (Component -> BuildInfo
componentBuildInfo (PackageDescription -> ComponentName -> Component
getComponent PackageDescription
pd ComponentName
cname))
  Verbosity -> String -> IO ()
debug
    Verbosity
verbosity
    String
"Reading the list of dependencies from the package description"
  [CandidateOutdatedDependency] -> IO [CandidateOutdatedDependency]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([CandidateOutdatedDependency] -> IO [CandidateOutdatedDependency])
-> [CandidateOutdatedDependency]
-> IO [CandidateOutdatedDependency]
forall a b. (a -> b) -> a -> b
$ (Dependency -> CandidateOutdatedDependency)
-> [Dependency] -> [CandidateOutdatedDependency]
forall a b. (a -> b) -> [a] -> [b]
map Dependency -> CandidateOutdatedDependency
toPVC [Dependency]
bd
  where
    toPVC :: Dependency -> CandidateOutdatedDependency
toPVC (Dependency PackageName
pn VersionRange
vr NonEmptySet LibraryName
_) = PackageVersionConstraint
-> OutdatedDependencySource -> CandidateOutdatedDependency
mkCandidateOutdatedDependency (PackageName -> VersionRange -> PackageVersionConstraint
PackageVersionConstraint PackageName
pn VersionRange
vr) (PackageId -> ComponentTarget -> OutdatedDependencySource
ComponentSource PackageId
pkgId ComponentTarget
t)

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

-- | Find all outdated dependencies.
listOutdated
  :: [CandidateOutdatedDependency]
  -> SourcePackageDb
  -> ListOutdatedSettings
  -> [OutdatedDependency]
listOutdated :: [CandidateOutdatedDependency]
-> SourcePackageDb -> ListOutdatedSettings -> [OutdatedDependency]
listOutdated [CandidateOutdatedDependency]
deps SourcePackageDb
sourceDb (ListOutdatedSettings PackageName -> Bool
ignorePred PackageName -> Bool
minorPred) =
  (CandidateOutdatedDependency -> Maybe OutdatedDependency)
-> [CandidateOutdatedDependency] -> [OutdatedDependency]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe CandidateOutdatedDependency -> Maybe OutdatedDependency
isOutdated [CandidateOutdatedDependency]
deps
  where
    isOutdated :: CandidateOutdatedDependency -> Maybe OutdatedDependency
    isOutdated :: CandidateOutdatedDependency -> Maybe OutdatedDependency
isOutdated (OutdatedDependency PackageVersionConstraint
dep () OutdatedDependencySource
src)
      | PackageName -> Bool
ignorePred PackageName
pname = Maybe OutdatedDependency
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
-> Version -> OutdatedDependencySource -> OutdatedDependency
forall v.
PackageVersionConstraint
-> v -> OutdatedDependencySource -> OutdatedDependencyX v
OutdatedDependency PackageVersionConstraint
dep Version
v OutdatedDependencySource
src) (Version -> OutdatedDependency)
-> Maybe Version -> Maybe OutdatedDependency
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` [Version] -> [Version] -> Maybe Version
isOutdated' [Version]
this [Version]
latest
      where
        PackageVersionConstraint PackageName
pname VersionRange
vr = PackageVersionConstraint -> PackageVersionConstraint
simplifyPackageVersionConstraint PackageVersionConstraint
dep

    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 a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Version]
this
          latest' :: Version
latest' = [Version] -> Version
forall a. Ord a => [a] -> a
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

-- | For the outdated command, when a whole package is specified we want
-- to select all buildable components.
selectPackageTargetsForOutdated
  :: TargetSelector
  -> [AvailableTarget k]
  -> Either (TargetProblem') [k]
selectPackageTargetsForOutdated :: forall k.
TargetSelector -> [AvailableTarget k] -> Either TargetProblem' [k]
selectPackageTargetsForOutdated TargetSelector
targetSelector [AvailableTarget k]
targets
  -- No targets available at all is an error
  | [AvailableTarget k] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [AvailableTarget k]
targets = TargetProblem' -> Either TargetProblem' [k]
forall a b. a -> Either a b
Left (TargetSelector -> TargetProblem'
forall a. TargetSelector -> TargetProblem a
TargetProblemNoTargets TargetSelector
targetSelector)
  -- We select all buildable components for a package
  | Bool
otherwise = [k] -> Either TargetProblem' [k]
forall a b. b -> Either a b
Right ([k] -> Either TargetProblem' [k])
-> [k] -> Either TargetProblem' [k]
forall a b. (a -> b) -> a -> b
$ [AvailableTarget k] -> [k]
forall k. [AvailableTarget k] -> [k]
selectBuildableTargets [AvailableTarget k]
targets

-- | For the outdated command, when a specific component is specified
-- we simply select that component.
selectComponentTargetForOutdated
  :: SubComponentTarget
  -> AvailableTarget k
  -> Either (TargetProblem') k
selectComponentTargetForOutdated :: forall k.
SubComponentTarget -> AvailableTarget k -> Either TargetProblem' k
selectComponentTargetForOutdated SubComponentTarget
subtarget AvailableTarget k
target =
  SubComponentTarget -> AvailableTarget k -> Either TargetProblem' k
forall k a.
SubComponentTarget
-> AvailableTarget k -> Either (TargetProblem a) k
selectComponentTargetBasic SubComponentTarget
subtarget AvailableTarget k
target

-- | Read the list of dependencies from local packages
depsFromLocalPackages :: Verbosity -> ProjectBaseContext -> [TargetSelector] -> IO [CandidateOutdatedDependency]
depsFromLocalPackages :: Verbosity
-> ProjectBaseContext
-> [TargetSelector]
-> IO [CandidateOutdatedDependency]
depsFromLocalPackages Verbosity
verbosity ProjectBaseContext
ctx [TargetSelector]
targetSelectors = do
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([TargetSelector] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TargetSelector]
targetSelectors) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    Verbosity -> CabalInstallException -> IO ()
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity CabalInstallException
TargetSelectorNoTargetsInCwdTrue
  TargetsMapX PackageId
targets <-
    ([TargetProblem'] -> IO (TargetsMapX PackageId))
-> (TargetsMapX PackageId -> IO (TargetsMapX PackageId))
-> Either [TargetProblem'] (TargetsMapX PackageId)
-> IO (TargetsMapX PackageId)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Verbosity -> [TargetProblem'] -> IO (TargetsMapX PackageId)
forall a. Verbosity -> [TargetProblem'] -> IO a
reportOutdatedTargetProblem Verbosity
verbosity) TargetsMapX PackageId -> IO (TargetsMapX PackageId)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either [TargetProblem'] (TargetsMapX PackageId)
 -> IO (TargetsMapX PackageId))
-> Either [TargetProblem'] (TargetsMapX PackageId)
-> IO (TargetsMapX PackageId)
forall a b. (a -> b) -> a -> b
$
      (forall k.
 TargetSelector -> [AvailableTarget k] -> Either TargetProblem' [k])
-> (forall k.
    SubComponentTarget -> AvailableTarget k -> Either TargetProblem' k)
-> [PackageSpecifier UnresolvedSourcePackage]
-> [TargetSelector]
-> Either [TargetProblem'] (TargetsMapX PackageId)
forall err.
(forall k.
 TargetSelector
 -> [AvailableTarget k] -> Either (TargetProblem err) [k])
-> (forall k.
    SubComponentTarget
    -> AvailableTarget k -> Either (TargetProblem err) k)
-> [PackageSpecifier UnresolvedSourcePackage]
-> [TargetSelector]
-> Either [TargetProblem err] (TargetsMapX PackageId)
resolveTargetsFromLocalPackages
        TargetSelector -> [AvailableTarget k] -> Either TargetProblem' [k]
forall k.
TargetSelector -> [AvailableTarget k] -> Either TargetProblem' [k]
selectPackageTargetsForOutdated
        SubComponentTarget -> AvailableTarget k -> Either TargetProblem' k
forall k.
SubComponentTarget -> AvailableTarget k -> Either TargetProblem' k
selectComponentTargetForOutdated
        (ProjectBaseContext -> [PackageSpecifier UnresolvedSourcePackage]
localPackages ProjectBaseContext
ctx)
        [TargetSelector]
targetSelectors
  ([[CandidateOutdatedDependency]] -> [CandidateOutdatedDependency])
-> IO [[CandidateOutdatedDependency]]
-> IO [CandidateOutdatedDependency]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[CandidateOutdatedDependency]] -> [CandidateOutdatedDependency]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (IO [[CandidateOutdatedDependency]]
 -> IO [CandidateOutdatedDependency])
-> ((PackageSpecifier UnresolvedSourcePackage
     -> IO [CandidateOutdatedDependency])
    -> IO [[CandidateOutdatedDependency]])
-> (PackageSpecifier UnresolvedSourcePackage
    -> IO [CandidateOutdatedDependency])
-> IO [CandidateOutdatedDependency]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PackageSpecifier UnresolvedSourcePackage]
-> (PackageSpecifier UnresolvedSourcePackage
    -> IO [CandidateOutdatedDependency])
-> IO [[CandidateOutdatedDependency]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (ProjectBaseContext -> [PackageSpecifier UnresolvedSourcePackage]
localPackages ProjectBaseContext
ctx) ((PackageSpecifier UnresolvedSourcePackage
  -> IO [CandidateOutdatedDependency])
 -> IO [CandidateOutdatedDependency])
-> (PackageSpecifier UnresolvedSourcePackage
    -> IO [CandidateOutdatedDependency])
-> IO [CandidateOutdatedDependency]
forall a b. (a -> b) -> a -> b
$ \PackageSpecifier UnresolvedSourcePackage
pkg -> case PackageSpecifier UnresolvedSourcePackage
pkg of
    SpecificSourcePackage UnresolvedSourcePackage
pkg' -> do
      -- Find the package in the resolved targets
      let pkgId :: PackageId
pkgId = UnresolvedSourcePackage -> PackageId
forall pkg. Package pkg => pkg -> PackageId
packageId UnresolvedSourcePackage
pkg'
      let pkgTargets :: [ComponentTarget]
pkgTargets =
            case PackageId
-> TargetsMapX PackageId
-> Maybe [(ComponentTarget, NonEmpty TargetSelector)]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PackageId
pkgId TargetsMapX PackageId
targets of
              Just [(ComponentTarget, NonEmpty TargetSelector)]
componentTargets -> ((ComponentTarget, NonEmpty TargetSelector) -> ComponentTarget)
-> [(ComponentTarget, NonEmpty TargetSelector)]
-> [ComponentTarget]
forall a b. (a -> b) -> [a] -> [b]
map (ComponentTarget, NonEmpty TargetSelector) -> ComponentTarget
forall a b. (a, b) -> a
fst [(ComponentTarget, NonEmpty TargetSelector)]
componentTargets
              Maybe [(ComponentTarget, NonEmpty TargetSelector)]
Nothing -> []
      -- If no specific components were targeted, use the whole package
      -- Get dependencies for each targeted component
      ([[CandidateOutdatedDependency]] -> [CandidateOutdatedDependency])
-> IO [[CandidateOutdatedDependency]]
-> IO [CandidateOutdatedDependency]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[CandidateOutdatedDependency]] -> [CandidateOutdatedDependency]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (IO [[CandidateOutdatedDependency]]
 -> IO [CandidateOutdatedDependency])
-> ((ComponentTarget -> IO [CandidateOutdatedDependency])
    -> IO [[CandidateOutdatedDependency]])
-> (ComponentTarget -> IO [CandidateOutdatedDependency])
-> IO [CandidateOutdatedDependency]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ComponentTarget]
-> (ComponentTarget -> IO [CandidateOutdatedDependency])
-> IO [[CandidateOutdatedDependency]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [ComponentTarget]
pkgTargets ((ComponentTarget -> IO [CandidateOutdatedDependency])
 -> IO [CandidateOutdatedDependency])
-> (ComponentTarget -> IO [CandidateOutdatedDependency])
-> IO [CandidateOutdatedDependency]
forall a b. (a -> b) -> a -> b
$ \ComponentTarget
target ->
        Verbosity
-> PackageId
-> GenericPackageDescription
-> ComponentTarget
-> IO [CandidateOutdatedDependency]
depsFromPkgDesc Verbosity
verbosity PackageId
pkgId (UnresolvedSourcePackage -> GenericPackageDescription
forall loc. SourcePackage loc -> GenericPackageDescription
srcpkgDescription UnresolvedSourcePackage
pkg') ComponentTarget
target
    PackageSpecifier UnresolvedSourcePackage
_ -> [CandidateOutdatedDependency] -> IO [CandidateOutdatedDependency]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []