Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
Packages
Cabal
Commits
7cdc32fd
Commit
7cdc32fd
authored
Jan 20, 2017
by
Mikhail Glushenkov
Committed by
GitHub
Jan 20, 2017
Browse files
Merge pull request #4207 from 23Skidoo/outdated-command
New 'cabal-install' command: 'outdated'
parents
e332fb58
729ac031
Changes
29
Hide whitespace changes
Inline
Side-by-side
.gitignore
View file @
7cdc32fd
...
...
@@ -10,10 +10,10 @@ cabal-dev/
*.p_hi
*.prof
*.tix
cabal.config
dist
dist-*
register.sh
./cabal.config
/Cabal/dist/
/Cabal/tests/Setup
...
...
Cabal/Distribution/Simple/Setup.hs
View file @
7cdc32fd
...
...
@@ -310,8 +310,8 @@ instance Binary AllowNewer
instance
Binary
AllowOlder
instance
Semigroup
RelaxDeps
where
RelaxDepsNone
<>
r
=
r
l
@
RelaxDepsAll
<>
_
=
l
RelaxDepsNone
<>
r
=
r
l
@
RelaxDepsAll
<>
_
=
l
l
@
(
RelaxDepsSome
_
)
<>
RelaxDepsNone
=
l
(
RelaxDepsSome
_
)
<>
r
@
RelaxDepsAll
=
r
(
RelaxDepsSome
a
)
<>
(
RelaxDepsSome
b
)
=
RelaxDepsSome
(
a
++
b
)
...
...
@@ -345,7 +345,7 @@ relaxDepsParser =
(
Just
.
RelaxDepsSome
)
`
fmap
`
Parse
.
sepBy1
parse
(
Parse
.
char
','
)
relaxDepsPrinter
::
(
Maybe
RelaxDeps
)
->
[
Maybe
String
]
relaxDepsPrinter
Nothing
=
[]
relaxDepsPrinter
Nothing
=
[]
relaxDepsPrinter
(
Just
RelaxDepsNone
)
=
[]
relaxDepsPrinter
(
Just
RelaxDepsAll
)
=
[
Nothing
]
relaxDepsPrinter
(
Just
(
RelaxDepsSome
pkgs
))
=
map
(
Just
.
display
)
$
pkgs
...
...
Cabal/Distribution/Types/Dependency.hs
View file @
7cdc32fd
...
...
@@ -2,6 +2,8 @@
{-# LANGUAGE DeriveGeneric #-}
module
Distribution.Types.Dependency
(
Dependency
(
..
)
,
depPkgName
,
depVerRange
,
thisPackageVersion
,
notThisPackageVersion
,
simplifyDependency
...
...
@@ -26,6 +28,12 @@ import Text.PrettyPrint ((<+>))
data
Dependency
=
Dependency
PackageName
VersionRange
deriving
(
Generic
,
Read
,
Show
,
Eq
,
Typeable
,
Data
)
depPkgName
::
Dependency
->
PackageName
depPkgName
(
Dependency
pn
_
)
=
pn
depVerRange
::
Dependency
->
VersionRange
depVerRange
(
Dependency
_
vr
)
=
vr
instance
Binary
Dependency
instance
NFData
Dependency
where
rnf
=
genericRnf
...
...
Cabal/doc/developing-packages.rst
View file @
7cdc32fd
...
...
@@ -1147,6 +1147,83 @@ For example, given the following dependencies specified in
foo >= 0.5.2 && < 0.6
bar >= 1.1 && < 1.2
Listing outdated dependency version bounds
""""""""""""""""""""""""""""""""""""""""""
Manually updating dependency version bounds in a ``.cabal`` file or a
freeze file can be tedious, especially when there'
s
a
lot
of
dependencies
.
The
``
cabal
outdated
``
command
is
designed
to
help
with
that
.
It
will
print
a
list
of
packages
for
which
there
is
a
new
version
on
Hackage
that
is
outside
the
version
bound
specified
in
the
``
build
-
depends
``
field
.
The
``
outdated
``
command
can
also
be
configured
to
act
on
the
freeze
file
(
both
old
-
and
new
-
style
)
and
ignore
major
(
or
all
)
version
bumps
on
Hackage
for
a
subset
of
dependencies
.
The
following
flags
are
supported
by
the
``
outdated
``
command
:
``--
freeze
-
file
``
Read
dependency
version
bounds
from
the
freeze
file
(``
cabal
.
config
``)
instead
of
the
package
description
file
(``$
PACKAGENAME
.
cabal
``).
``--
new
-
freeze
-
file
``
Read
dependency
version
bounds
from
the
new
-
style
freeze
file
(``
cabal
.
project
.
freeze
``)
instead
of
the
package
description
file
.
``--
simple
-
output
``
Print
only
the
names
of
outdated
dependencies
,
one
per
line
.
``--
exit
-
code
``
Exit
with
a
non
-
zero
exit
code
when
there
are
outdated
dependencies
.
``-
q
,
--
quiet
``
Don
't print any output. Implies ``-v0`` and ``--exit-code``.
``--ignore`` *PACKAGENAMES*
Don'
t
warn
about
outdated
dependency
version
bounds
for
the
packages
in
this
list
.
``--
minor
``
*[
PACKAGENAMES
]*
Ignore
major
version
bumps
for
these
packages
.
E
.
g
.
if
there
's a version 2.0
of a package ``pkg`` on Hackage and the freeze file specifies the constraint
``pkg == 1.9``, ``cabal outdated --freeze --minor=pkg`` will only consider
the ``pkg`` outdated when there'
s
a
version
of
``
pkg
``
on
Hackage
satisfying
``
pkg
>
1.9
&&
<
2.0
``.
``--
minor
``
can
also
be
used
without
arguments
,
in
that
case
major
version
bumps
are
ignored
for
all
packages
.
Examples
:
..
code
-
block
::
console
$
cd
/
some
/
package
$
cabal
outdated
Outdated
dependencies
:
haskell
-
src
-
exts
<
1.17
(
latest
:
1.19.1
)
language
-
javascript
<
0.6
(
latest
:
0.6.0.9
)
unix
==
2.7.2.0
(
latest
:
2.7.2.1
)
$
cabal
outdated
--
simple
-
output
haskell
-
src
-
exts
language
-
javascript
unix
$
cabal
outdated
--
ignore
=
haskell
-
src
-
exts
Outdated
dependencies
:
language
-
javascript
<
0.6
(
latest
:
0.6.0.9
)
unix
==
2.7.2.0
(
latest
:
2.7.2.1
)
$
cabal
outdated
--
ignore
=
haskell
-
src
-
exts
,
language
-
javascript
,
unix
All
dependencies
are
up
to
date
.
$
cabal
outdated
--
ignore
=
haskell
-
src
-
exts
,
language
-
javascript
,
unix
-
q
$
echo
$?
0
$
cd
/
some
/
other
/
package
$
cabal
outdated
--
freeze
-
file
Outdated
dependencies
:
HTTP
==
4000.3.3
(
latest
:
4000.3.4
)
HUnit
==
1.3.1.1
(
latest
:
1.5.0.0
)
$
cabal
outdated
--
freeze
-
file
--
ignore
=
HTTP
--
minor
=
HUnit
Outdated
dependencies
:
HUnit
==
1.3.1.1
(
latest
:
1.3.1.2
)
Executables
^^^^^^^^^^^
...
...
cabal-install/Distribution/Client/Freeze.hs
View file @
7cdc32fd
...
...
@@ -72,15 +72,15 @@ import Distribution.Version
-- constraining each dependency to an exact version.
--
freeze
::
Verbosity
->
PackageDBStack
->
RepoContext
->
Compiler
->
Platform
->
ProgramDb
->
Maybe
SandboxPackageInfo
->
GlobalFlags
->
FreezeFlags
->
IO
()
->
PackageDBStack
->
RepoContext
->
Compiler
->
Platform
->
ProgramDb
->
Maybe
SandboxPackageInfo
->
GlobalFlags
->
FreezeFlags
->
IO
()
freeze
verbosity
packageDBs
repoCtxt
comp
platform
progdb
mSandboxPkgInfo
globalFlags
freezeFlags
=
do
...
...
@@ -238,7 +238,8 @@ freezePackages :: Package pkg => Verbosity -> GlobalFlags -> [pkg] -> IO ()
freezePackages
verbosity
globalFlags
pkgs
=
do
pkgEnv
<-
fmap
(
createPkgEnv
.
addFrozenConstraints
)
$
loadUserConfig
verbosity
""
(
flagToMaybe
.
globalConstraintsFile
$
globalFlags
)
loadUserConfig
verbosity
""
(
flagToMaybe
.
globalConstraintsFile
$
globalFlags
)
writeFileAtomic
userPackageEnvironmentFile
$
showPkgEnv
pkgEnv
where
addFrozenConstraints
config
=
...
...
@@ -248,7 +249,8 @@ freezePackages verbosity globalFlags pkgs = do
}
}
constraint
pkg
=
(
pkgIdToConstraint
$
packageId
pkg
,
ConstraintSourceUserConfig
userPackageEnvironmentFile
)
(
pkgIdToConstraint
$
packageId
pkg
,
ConstraintSourceUserConfig
userPackageEnvironmentFile
)
where
pkgIdToConstraint
pkgId
=
UserConstraint
UserToplevel
(
packageName
pkgId
)
...
...
cabal-install/Distribution/Client/Outdated.hs
0 → 100644
View file @
7cdc32fd
-----------------------------------------------------------------------------
-- |
-- Module : Distribution.Client.Outdated
-- 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.Outdated
(
outdated
,
ListOutdatedSettings
(
..
),
listOutdated
)
where
import
Prelude
()
import
Distribution.Client.Config
import
Distribution.Client.IndexUtils
as
IndexUtils
import
Distribution.Client.Compat.Prelude
import
Distribution.Client.ProjectConfig
import
Distribution.Client.RebuildMonad
import
Distribution.Client.Setup
hiding
(
quiet
)
import
Distribution.Client.Targets
import
Distribution.Client.Types
import
Distribution.Solver.Types.PackageConstraint
import
Distribution.Solver.Types.PackageIndex
import
Distribution.Client.Sandbox.PackageEnvironment
import
Distribution.Package
(
PackageName
,
packageVersion
)
import
Distribution.PackageDescription
(
buildDepends
)
import
Distribution.PackageDescription.Configuration
(
finalizePD
)
import
Distribution.PackageDescription.Parse
(
readPackageDescription
)
import
Distribution.Simple.Compiler
(
Compiler
,
compilerInfo
)
import
Distribution.Simple.Setup
(
fromFlagOrDefault
)
import
Distribution.Simple.Utils
(
die
,
notice
,
debug
,
tryFindPackageDesc
)
import
Distribution.System
(
Platform
)
import
Distribution.Text
(
display
)
import
Distribution.Types.ComponentRequestedSpec
(
ComponentRequestedSpec
(
..
))
import
Distribution.Types.Dependency
(
Dependency
(
..
),
depPkgName
,
simplifyDependency
)
import
Distribution.Verbosity
(
Verbosity
,
silent
)
import
Distribution.Version
(
Version
,
LowerBound
(
..
),
UpperBound
(
..
)
,
asVersionIntervals
,
majorBoundVersion
)
import
qualified
Data.Set
as
S
import
System.Directory
(
getCurrentDirectory
)
import
System.Exit
(
exitFailure
)
-- | Entry point for the 'outdated' command.
outdated
::
Verbosity
->
OutdatedFlags
->
RepoContext
->
Compiler
->
Platform
->
IO
()
outdated
verbosity0
outdatedFlags
repoContext
comp
platform
=
do
let
freezeFile
=
fromFlagOrDefault
False
(
outdatedFreezeFile
outdatedFlags
)
newFreezeFile
=
fromFlagOrDefault
False
(
outdatedNewFreezeFile
outdatedFlags
)
simpleOutput
=
fromFlagOrDefault
False
(
outdatedSimpleOutput
outdatedFlags
)
quiet
=
fromFlagOrDefault
False
(
outdatedQuiet
outdatedFlags
)
exitCode
=
fromFlagOrDefault
quiet
(
outdatedExitCode
outdatedFlags
)
ignorePred
=
let
ignoreSet
=
S
.
fromList
(
outdatedIgnore
outdatedFlags
)
in
\
pkgname
->
pkgname
`
S
.
member
`
ignoreSet
minorPred
=
case
outdatedMinor
outdatedFlags
of
Nothing
->
const
False
Just
IgnoreMajorVersionBumpsNone
->
const
False
Just
IgnoreMajorVersionBumpsAll
->
const
True
Just
(
IgnoreMajorVersionBumpsSome
pkgs
)
->
let
minorSet
=
S
.
fromList
pkgs
in
\
pkgname
->
pkgname
`
S
.
member
`
minorSet
verbosity
=
if
quiet
then
silent
else
verbosity0
sourcePkgDb
<-
IndexUtils
.
getSourcePackages
verbosity
repoContext
let
pkgIndex
=
packageIndex
sourcePkgDb
deps
<-
if
freezeFile
then
depsFromFreezeFile
verbosity
else
if
newFreezeFile
then
depsFromNewFreezeFile
verbosity
else
depsFromPkgDesc
verbosity
comp
platform
debug
verbosity
$
"Dependencies loaded: "
++
(
intercalate
", "
$
map
display
deps
)
let
outdatedDeps
=
listOutdated
deps
pkgIndex
(
ListOutdatedSettings
ignorePred
minorPred
)
when
(
not
quiet
)
$
showResult
verbosity
outdatedDeps
simpleOutput
if
(
exitCode
&&
(
not
.
null
$
outdatedDeps
))
then
exitFailure
else
return
()
-- | Print either the list of all outdated dependencies, or a message
-- that there are none.
showResult
::
Verbosity
->
[(
Dependency
,
Version
)]
->
Bool
->
IO
()
showResult
verbosity
outdatedDeps
simpleOutput
=
if
(
not
.
null
$
outdatedDeps
)
then
do
when
(
not
simpleOutput
)
$
notice
verbosity
"Outdated dependencies:"
for_
outdatedDeps
$
\
(
d
@
(
Dependency
pn
_
),
v
)
->
let
outdatedDep
=
if
simpleOutput
then
display
pn
else
display
d
++
" (latest: "
++
display
v
++
")"
in
notice
verbosity
outdatedDep
else
notice
verbosity
"All dependencies are up to date."
-- | Convert a list of 'UserConstraint's to a 'Dependency' list.
userConstraintsToDependencies
::
[
UserConstraint
]
->
[
Dependency
]
userConstraintsToDependencies
ucnstrs
=
mapMaybe
(
packageConstraintToDependency
.
userToPackageConstraint
)
ucnstrs
-- | Read the list of dependencies from the freeze file.
depsFromFreezeFile
::
Verbosity
->
IO
[
Dependency
]
depsFromFreezeFile
verbosity
=
do
cwd
<-
getCurrentDirectory
userConfig
<-
loadUserConfig
verbosity
cwd
Nothing
let
ucnstrs
=
map
fst
.
configExConstraints
.
savedConfigureExFlags
$
userConfig
deps
=
userConstraintsToDependencies
ucnstrs
debug
verbosity
"Reading the list of dependencies from the freeze file"
return
deps
-- | Read the list of dependencies from the new-style freeze file.
depsFromNewFreezeFile
::
Verbosity
->
IO
[
Dependency
]
depsFromNewFreezeFile
verbosity
=
do
projectRootDir
<-
findProjectRoot
{- TODO: Support '--project-file' -}
mempty
projectConfig
<-
runRebuild
projectRootDir
$
readProjectLocalFreezeConfig
verbosity
mempty
projectRootDir
let
ucnstrs
=
map
fst
.
projectConfigConstraints
.
projectConfigShared
$
projectConfig
deps
=
userConstraintsToDependencies
ucnstrs
debug
verbosity
"Reading the list of dependencies from the new-style freeze file"
return
deps
-- | Read the list of dependencies from the package description.
depsFromPkgDesc
::
Verbosity
->
Compiler
->
Platform
->
IO
[
Dependency
]
depsFromPkgDesc
verbosity
comp
platform
=
do
cwd
<-
getCurrentDirectory
path
<-
tryFindPackageDesc
cwd
gpd
<-
readPackageDescription
verbosity
path
let
cinfo
=
compilerInfo
comp
epd
=
finalizePD
[]
(
ComponentRequestedSpec
True
True
)
(
const
True
)
platform
cinfo
[]
gpd
case
epd
of
Left
_
->
die
"finalizePD failed"
Right
(
pd
,
_
)
->
do
let
bd
=
buildDepends
pd
debug
verbosity
"Reading the list of dependencies from the package description"
return
bd
-- | Various knobs for customising the behaviour of 'listOutdated'.
data
ListOutdatedSettings
=
ListOutdatedSettings
{
-- | Should this package be ignored?
listOutdatedIgnorePred
::
PackageName
->
Bool
,
-- | Should major version bumps should be ignored for this package?
listOutdatedMinorPred
::
PackageName
->
Bool
}
-- | Find all outdated dependencies.
listOutdated
::
[
Dependency
]
->
PackageIndex
UnresolvedSourcePackage
->
ListOutdatedSettings
->
[(
Dependency
,
Version
)]
listOutdated
deps
pkgIndex
(
ListOutdatedSettings
ignorePred
minorPred
)
=
mapMaybe
isOutdated
$
map
simplifyDependency
deps
where
isOutdated
::
Dependency
->
Maybe
(
Dependency
,
Version
)
isOutdated
dep
|
ignorePred
(
depPkgName
dep
)
=
Nothing
|
otherwise
=
let
this
=
map
packageVersion
$
lookupDependency
pkgIndex
dep
latest
=
lookupLatest
dep
in
(
\
v
->
(
dep
,
v
))
`
fmap
`
isOutdated'
this
latest
isOutdated'
::
[
Version
]
->
[
Version
]
->
Maybe
Version
isOutdated'
[]
_
=
Nothing
isOutdated'
_
[]
=
Nothing
isOutdated'
this
latest
=
let
this'
=
maximum
this
latest'
=
maximum
latest
in
if
this'
<
latest'
then
Just
latest'
else
Nothing
lookupLatest
::
Dependency
->
[
Version
]
lookupLatest
dep
|
minorPred
(
depPkgName
dep
)
=
map
packageVersion
$
lookupDependency
pkgIndex
(
relaxMinor
dep
)
|
otherwise
=
map
packageVersion
$
lookupPackageName
pkgIndex
(
depPkgName
dep
)
relaxMinor
::
Dependency
->
Dependency
relaxMinor
(
Dependency
pn
vr
)
=
(
Dependency
pn
vr'
)
where
vr'
=
let
vis
=
asVersionIntervals
vr
(
LowerBound
v0
_
,
upper
)
=
last
vis
in
case
upper
of
NoUpperBound
->
vr
UpperBound
_v1
_
->
majorBoundVersion
v0
cabal-install/Distribution/Client/ProjectConfig.hs
View file @
7cdc32fd
...
...
@@ -16,6 +16,7 @@ module Distribution.Client.ProjectConfig (
-- * Project config files
findProjectRoot
,
readProjectConfig
,
readProjectLocalFreezeConfig
,
writeProjectLocalExtraConfig
,
writeProjectLocalFreezeConfig
,
writeProjectConfigFile
,
...
...
cabal-install/Distribution/Client/Sandbox/PackageEnvironment.hs
View file @
7cdc32fd
...
...
@@ -50,7 +50,7 @@ import Distribution.Simple.InstallDirs ( InstallDirs(..), PathTemplate
import
Distribution.Simple.Setup
(
Flag
(
..
)
,
ConfigFlags
(
..
),
HaddockFlags
(
..
)
,
fromFlagOrDefault
,
toFlag
,
flagToMaybe
)
import
Distribution.Simple.Utils
(
die
,
info
,
notice
,
warn
)
import
Distribution.Simple.Utils
(
die
,
info
,
notice
,
warn
,
debug
)
import
Distribution.Solver.Types.ConstraintSource
import
Distribution.ParseUtils
(
FieldDescr
(
..
),
ParseResult
(
..
)
,
commaListField
,
commaNewLineListField
...
...
@@ -277,14 +277,24 @@ inheritedPackageEnvironment verbosity pkgEnv = do
-- | Load the user package environment if it exists (the optional "cabal.config"
-- file). If it does not exist locally, attempt to load an optional global one.
userPackageEnvironment
::
Verbosity
->
FilePath
->
Maybe
FilePath
->
IO
PackageEnvironment
userPackageEnvironment
::
Verbosity
->
FilePath
->
Maybe
FilePath
->
IO
PackageEnvironment
userPackageEnvironment
verbosity
pkgEnvDir
globalConfigLocation
=
do
let
path
=
pkgEnvDir
</>
userPackageEnvironmentFile
minp
<-
readPackageEnvironmentFile
(
ConstraintSourceUserConfig
path
)
mempty
path
minp
<-
readPackageEnvironmentFile
(
ConstraintSourceUserConfig
path
)
mempty
path
case
(
minp
,
globalConfigLocation
)
of
(
Just
parseRes
,
_
)
->
processConfigParse
path
parseRes
(
_
,
Just
globalLoc
)
->
maybe
(
warn
verbosity
(
"no constraints file found at "
++
globalLoc
)
>>
return
mempty
)
(
processConfigParse
globalLoc
)
=<<
readPackageEnvironmentFile
(
ConstraintSourceUserConfig
globalLoc
)
mempty
globalLoc
_
->
return
mempty
(
_
,
Just
globalLoc
)
->
do
minp'
<-
readPackageEnvironmentFile
(
ConstraintSourceUserConfig
globalLoc
)
mempty
globalLoc
maybe
(
warn
verbosity
(
"no constraints file found at "
++
globalLoc
)
>>
return
mempty
)
(
processConfigParse
globalLoc
)
minp'
_
->
do
debug
verbosity
(
"no user package environment file found at "
++
pkgEnvDir
)
return
mempty
where
processConfigParse
path
(
ParseOk
warns
parseResult
)
=
do
when
(
not
$
null
warns
)
$
warn
verbosity
$
...
...
@@ -299,7 +309,8 @@ userPackageEnvironment verbosity pkgEnvDir globalConfigLocation = do
-- | Same as @userPackageEnvironmentFile@, but returns a SavedConfig.
loadUserConfig
::
Verbosity
->
FilePath
->
Maybe
FilePath
->
IO
SavedConfig
loadUserConfig
verbosity
pkgEnvDir
globalConfigLocation
=
fmap
pkgEnvSavedConfig
$
userPackageEnvironment
verbosity
pkgEnvDir
globalConfigLocation
fmap
pkgEnvSavedConfig
$
userPackageEnvironment
verbosity
pkgEnvDir
globalConfigLocation
-- | Common error handling code used by 'tryLoadSandboxPackageEnvironment' and
-- 'updatePackageEnvironment'.
...
...
@@ -401,7 +412,8 @@ pkgEnvFieldDescrs src = [
,
commaNewLineListField
"constraints"
(
Text
.
disp
.
fst
)
((
\
pc
->
(
pc
,
src
))
`
fmap
`
Text
.
parse
)
(
sortConstraints
.
configExConstraints
.
savedConfigureExFlags
.
pkgEnvSavedConfig
)
(
sortConstraints
.
configExConstraints
.
savedConfigureExFlags
.
pkgEnvSavedConfig
)
(
\
v
pkgEnv
->
updateConfigureExFlags
pkgEnv
(
\
flags
->
flags
{
configExConstraints
=
v
}))
...
...
cabal-install/Distribution/Client/Setup.hs
View file @
7cdc32fd
...
...
@@ -33,6 +33,7 @@ module Distribution.Client.Setup
,
fetchCommand
,
FetchFlags
(
..
)
,
freezeCommand
,
FreezeFlags
(
..
)
,
genBoundsCommand
,
outdatedCommand
,
OutdatedFlags
(
..
),
IgnoreMajorVersionBumps
(
..
)
,
getCommand
,
unpackCommand
,
GetFlags
(
..
)
,
checkCommand
,
formatCommand
...
...
@@ -64,10 +65,8 @@ import Distribution.Client.BuildReports.Types
(
ReportLevel
(
..
)
)
import
Distribution.Client.Dependency.Types
(
PreSolver
(
..
)
)
import
Distribution.Client.IndexUtils.Timestamp
(
IndexState
)
import
qualified
Distribution.Client.Init.Types
as
IT
(
InitFlags
(
..
),
PackageType
(
..
)
)
import
Distribution.Client.Targets
...
...
@@ -100,7 +99,7 @@ import Distribution.Simple.InstallDirs
import
Distribution.Version
(
Version
,
mkVersion
,
nullVersion
,
anyVersion
,
thisVersion
)
import
Distribution.Package
(
PackageIdentifier
,
packageName
,
packageVersion
)
(
PackageIdentifier
,
PackageName
,
packageName
,
packageVersion
)
import
Distribution.Types.Dependency
import
Distribution.PackageDescription
(
BuildType
(
..
),
RepoKind
(
..
)
)
...
...
@@ -110,7 +109,7 @@ import Distribution.Text
import
Distribution.ReadE
(
ReadE
(
..
),
readP_to_E
,
succeedReadE
)
import
qualified
Distribution.Compat.ReadP
as
Parse
(
ReadP
,
char
,
munch1
,
pfail
,
(
+++
)
)
(
ReadP
,
char
,
munch1
,
pfail
,
sepBy1
,
(
+++
)
)
import
Distribution.ParseUtils
(
readPToMaybe
)
import
Distribution.Verbosity
...
...
@@ -171,6 +170,7 @@ globalCommand commands = CommandUI {
,
"report"
,
"freeze"
,
"gen-bounds"
,
"outdated"
,
"haddock"
,
"hscolour"
,
"copy"
...
...
@@ -222,6 +222,7 @@ globalCommand commands = CommandUI {
,
par
,
addCmd
"freeze"
,
addCmd
"gen-bounds"
,
addCmd
"outdated"
,
addCmd
"haddock"
,
addCmd
"hscolour"
,
addCmd
"copy"
...
...
@@ -798,7 +799,8 @@ freezeCommand = CommandUI {
commandUsage
=
usageFlags
"freeze"
,
commandDefaultFlags
=
defaultFreezeFlags
,
commandOptions
=
\
showOrParseArgs
->
[
optionVerbosity
freezeVerbosity
(
\
v
flags
->
flags
{
freezeVerbosity
=
v
})
optionVerbosity
freezeVerbosity
(
\
v
flags
->
flags
{
freezeVerbosity
=
v
})
,
option
[]
[
"dry-run"
]
"Do not freeze anything, only print what would be frozen"
...
...
@@ -806,18 +808,21 @@ freezeCommand = CommandUI {
trueArg
,
option
[]
[
"tests"
]
"freezing of the dependencies of any tests suites in the package description file."
(
"freezing of the dependencies of any tests suites "
++
"in the package description file."
)
freezeTests
(
\
v
flags
->
flags
{
freezeTests
=
v
})
(
boolOpt
[]
[]
)
,
option
[]
[
"benchmarks"
]
"freezing of the dependencies of any benchmarks suites in the package description file."
(
"freezing of the dependencies of any benchmarks suites "
++
"in the package description file."
)
freezeBenchmarks
(
\
v
flags
->
flags
{
freezeBenchmarks
=
v
})
(
boolOpt
[]
[]
)
]
++
optionSolver
freezeSolver
(
\
v
flags
->
flags
{
freezeSolver
=
v
})
:
optionSolver
freezeSolver
(
\
v
flags
->
flags
{
freezeSolver
=
v
})
:
optionSolverFlags
showOrParseArgs
freezeMaxBackjumps
(
\
v
flags
->
flags
{
freezeMaxBackjumps
=
v
})
freezeReorderGoals
(
\
v
flags
->
flags
{
freezeReorderGoals
=
v
})
...
...
@@ -829,13 +834,18 @@ freezeCommand = CommandUI {
}
-- ------------------------------------------------------------
-- * 'gen-bounds' command
-- ------------------------------------------------------------
genBoundsCommand
::
CommandUI
FreezeFlags
genBoundsCommand
=
CommandUI
{
commandName
=
"gen-bounds"
,
commandSynopsis
=
"Generate dependency bounds."
,
commandDescription
=
Just
$
\
_
->
wrapText
$
"Generates bounds for all dependencies that do not currently have them. "
++
"Generated bounds are printed to stdout. You can then paste them into your .cabal file.
\n
"
++
"Generated bounds are printed to stdout. "
++
"You can then paste them into your .cabal file.
\n
"
++
"
\n
"
,
commandNotes
=
Nothing
,
commandUsage
=
usageFlags
"gen-bounds"
,
...
...
@@ -845,6 +855,116 @@ genBoundsCommand = CommandUI {
]
}
-- ------------------------------------------------------------
-- * 'outdated' command
-- ------------------------------------------------------------
data
IgnoreMajorVersionBumps
=
IgnoreMajorVersionBumpsNone
|
IgnoreMajorVersionBumpsAll
|
IgnoreMajorVersionBumpsSome
[
PackageName
]
instance
Monoid
IgnoreMajorVersionBumps
where
mempty
=
IgnoreMajorVersionBumpsNone
mappend
=
(
<>
)
instance
Semigroup
IgnoreMajorVersionBumps
where
IgnoreMajorVersionBumpsNone
<>
r
=
r
l
@
IgnoreMajorVersionBumpsAll
<>
_
=
l
l
@
(
IgnoreMajorVersionBumpsSome
_
)
<>
IgnoreMajorVersionBumpsNone
=
l
(
IgnoreMajorVersionBumpsSome
_
)
<>
r
@
IgnoreMajorVersionBumpsAll
=
r
(
IgnoreMajorVersionBumpsSome
a
)
<>
(
IgnoreMajorVersionBumpsSome
b
)
=
IgnoreMajorVersionBumpsSome
(
a
++
b
)
data
OutdatedFlags
=
OutdatedFlags
{
outdatedVerbosity
::
Flag
Verbosity
,
outdatedFreezeFile
::
Flag
Bool
,
outdatedNewFreezeFile
::
Flag
Bool
,
outdatedSimpleOutput
::
Flag
Bool
,
outdatedExitCode
::
Flag
Bool
,
outdatedQuiet
::
Flag
Bool
,
outdatedIgnore
::
[
PackageName
],
outdatedMinor
::
Maybe
IgnoreMajorVersionBumps
}
defaultOutdatedFlags
::
OutdatedFlags
defaultOutdatedFlags
=
OutdatedFlags
{
outdatedVerbosity
=
toFlag
normal
,
outdatedFreezeFile
=
mempty
,
outdatedNewFreezeFile
=
mempty
,
outdatedSimpleOutput
=
mempty
,
outdatedExitCode
=
mempty
,
outdatedQuiet
=
mempty
,
outdatedIgnore
=
mempty
,
outdatedMinor
=
mempty
}