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
c76d7fc3
Commit
c76d7fc3
authored
Feb 28, 2008
by
Lennart Kolmodin
Browse files
Implement --dry-run for 'cabal install'
parent
fd5a1560
Changes
4
Hide whitespace changes
Inline
Side-by-side
cabal-install/Hackage/Install.hs
View file @
c76d7fc3
...
...
@@ -25,6 +25,7 @@ import Hackage.Dependency (resolveDependencies, resolveDependenciesLocal, packag
import
Hackage.Fetch
(
fetchPackage
)
import
qualified
Hackage.IndexUtils
as
IndexUtils
import
qualified
Hackage.DepGraph
as
DepGraph
import
Hackage.Setup
(
InstallFlags
(
..
))
import
Hackage.Tar
(
extractTarGzFile
)
import
Hackage.Types
(
UnresolvedDependency
(
..
),
PkgInfo
(
..
),
FlagAssignment
,
Repo
)
...
...
@@ -57,12 +58,14 @@ install :: Verbosity
->
Compiler
->
ProgramConfiguration
->
Cabal
.
ConfigFlags
->
InstallFlags
->
[
UnresolvedDependency
]
->
IO
()
install
verbosity
packageDB
repos
comp
conf
configFlags
deps
=
do
install
verbosity
packageDB
repos
comp
conf
configFlags
installFlags
deps
=
do
let
dryRun
=
Cabal
.
fromFlagOrDefault
False
(
installDryRun
installFlags
)
buildResults
<-
if
null
deps
then
installLocalPackage
verbosity
packageDB
repos
comp
conf
configFlags
else
installRepoPackages
verbosity
packageDB
repos
comp
conf
configFlags
deps
then
installLocalPackage
verbosity
packageDB
repos
comp
conf
configFlags
dryRun
else
installRepoPackages
verbosity
packageDB
repos
comp
conf
configFlags
dryRun
deps
case
filter
(
buildFailed
.
snd
)
buildResults
of
[]
->
return
()
--TODO: return the build results
failed
->
die
$
"Error: some packages failed to install:
\n
"
...
...
@@ -87,8 +90,9 @@ installLocalPackage :: Verbosity
->
Compiler
->
ProgramConfiguration
->
Cabal
.
ConfigFlags
->
Bool
-- ^Dry run
->
IO
[(
PackageIdentifier
,
BuildResult
)]
installLocalPackage
verbosity
packageDB
repos
comp
conf
configFlags
=
installLocalPackage
verbosity
packageDB
repos
comp
conf
configFlags
dryRun
=
do
cabalFile
<-
defaultPackageDesc
verbosity
desc
<-
readPackageDescription
verbosity
cabalFile
Just
installed
<-
getInstalledPackages
verbosity
comp
packageDB
conf
...
...
@@ -97,10 +101,15 @@ installLocalPackage verbosity packageDB repos comp conf configFlags =
(
Cabal
.
configConfigurationsFlags
configFlags
)
buildResults
<-
case
packagesToInstall
resolvedDeps
of
Left
missing
->
die
$
"Unresolved dependencies: "
++
showDependencies
missing
Right
pkgs
->
installPackages
verbosity
configFlags
pkgs
--TODO: don't run if buildResult failed
buildResult
<-
installUnpackedPkg
verbosity
configFlags
Nothing
return
((
packageId
(
packageDescription
desc
),
buildResult
)
:
buildResults
)
Right
pkgs
->
do
if
dryRun
then
printDryRun
pkgs
>>
return
[]
else
installPackages
verbosity
configFlags
pkgs
if
dryRun
then
return
[]
--TODO: don't run if buildResult failed
else
do
buildResult
<-
installUnpackedPkg
verbosity
configFlags
Nothing
return
((
packageId
(
packageDescription
desc
),
buildResult
)
:
buildResults
)
installRepoPackages
::
Verbosity
->
PackageDB
...
...
@@ -108,9 +117,10 @@ installRepoPackages :: Verbosity
->
Compiler
->
ProgramConfiguration
->
Cabal
.
ConfigFlags
->
Bool
-- ^Dry run
->
[
UnresolvedDependency
]
->
IO
[(
PackageIdentifier
,
BuildResult
)]
installRepoPackages
verbosity
packageDB
repos
comp
conf
configFlags
deps
=
installRepoPackages
verbosity
packageDB
repos
comp
conf
configFlags
dryRun
deps
=
do
Just
installed
<-
getInstalledPackages
verbosity
comp
packageDB
conf
available
<-
fmap
mconcat
(
mapM
(
IndexUtils
.
readRepoIndex
verbosity
)
repos
)
deps'
<-
IndexUtils
.
disambiguateDependencies
available
deps
...
...
@@ -121,8 +131,25 @@ installRepoPackages verbosity packageDB repos comp conf configFlags deps =
|
DepGraph
.
empty
pkgs
->
notice
verbosity
"All requested packages already installed. Nothing to do."
>>
return
[]
|
dryRun
->
do
printDryRun
pkgs
return
[]
|
otherwise
->
installPackages
verbosity
configFlags
pkgs
printDryRun
::
DepGraph
.
DepGraph
->
IO
()
printDryRun
pkgs
|
DepGraph
.
empty
pkgs
=
putStrLn
"No packages to be installed."
|
otherwise
=
do
putStrLn
"In order, the following would be installed:"
mapM_
(
putStrLn
.
showPackageId
)
(
order
pkgs
)
where
order
ps
|
DepGraph
.
empty
ps
=
[]
|
otherwise
=
let
(
DepGraph
.
ResolvedPackage
pkgInfo
_
_
)
=
DepGraph
.
ready
ps
pkgId
=
packageId
pkgInfo
in
(
pkgId
:
order
(
DepGraph
.
removeCompleted
pkgId
ps
))
installPackages
::
Verbosity
->
Cabal
.
ConfigFlags
-- ^Options which will be passed to every package.
->
DepGraph
.
DepGraph
...
...
cabal-install/Hackage/Setup.hs
View file @
c76d7fc3
...
...
@@ -13,7 +13,7 @@
module
Hackage.Setup
(
globalCommand
,
Cabal
.
GlobalFlags
(
..
)
,
configureCommand
,
installCommand
--Cabal.
InstallFlags(..)
,
installCommand
,
InstallFlags
(
..
)
,
listCommand
,
updateCommand
,
upgradeCommand
...
...
@@ -62,16 +62,11 @@ globalCommand = Cabal.globalCommand {
++
"
\n
See http://www.haskell.org/cabal/ for more information.
\n
"
}
configureCommand
::
CommandUI
Cabal
.
ConfigFlags
configureCommand
=
(
Cabal
.
configureCommand
defaultProgramConfiguration
)
{
commandDefaultFlags
=
mempty
}
cabalConfigureCommand
::
CommandUI
Cabal
.
ConfigFlags
cabalConfigureCommand
=
Cabal
.
configureCommand
defaultProgramConfiguration
installCommand
::
CommandUI
Cabal
.
ConfigFlags
installCommand
=
(
Cabal
.
configureCommand
defaultProgramConfiguration
)
{
commandName
=
"install"
,
commandSynopsis
=
"Installs a list of packages."
,
commandUsage
=
usagePackages
"install"
,
configureCommand
::
CommandUI
Cabal
.
ConfigFlags
configureCommand
=
cabalConfigureCommand
{
commandDefaultFlags
=
mempty
}
...
...
@@ -145,6 +140,47 @@ checkCommand = CommandUI {
commandOptions
=
mempty
}
-- ------------------------------------------------------------
-- * Install flags
-- ------------------------------------------------------------
-- Install takes exactly the same flags as configure, but with the addition
-- of doing --dry-run.
data
InstallFlags
=
InstallFlags
{
installDryRun
::
Flag
Bool
}
defaultInstallFlags
::
InstallFlags
defaultInstallFlags
=
InstallFlags
{
installDryRun
=
mempty
}
installCommand
::
CommandUI
(
Cabal
.
ConfigFlags
,
InstallFlags
)
installCommand
=
cabalConfigureCommand
{
commandName
=
"install"
,
commandSynopsis
=
"Installs a list of packages."
,
commandUsage
=
usagePackages
"install"
,
commandDefaultFlags
=
mempty
,
commandOptions
=
\
showOrParseArgs
->
liftOptionsFst
(
commandOptions
cabalConfigureCommand
showOrParseArgs
)
++
liftOptionsSnd
[
option
[]
[
"dry-run"
]
"Do not install anything, only print what would be installed."
installDryRun
(
\
v
flags
->
flags
{
installDryRun
=
v
})
(
noArg
(
toFlag
True
)
(
fromFlagOrDefault
False
))
]
}
instance
Monoid
InstallFlags
where
mempty
=
defaultInstallFlags
mappend
a
b
=
InstallFlags
{
installDryRun
=
combine
installDryRun
}
where
combine
field
=
field
a
`
mappend
`
field
b
-- ------------------------------------------------------------
-- * Upload flags
-- ------------------------------------------------------------
...
...
@@ -214,6 +250,12 @@ instance Monoid UploadFlags where
-- * GetOpt Utils
-- ------------------------------------------------------------
liftOptionsFst
::
[
Option
a
]
->
[
Option
(
a
,
b
)]
liftOptionsFst
=
map
(
liftOption
fst
(
\
a
(
_
,
b
)
->
(
a
,
b
)))
liftOptionsSnd
::
[
Option
b
]
->
[
Option
(
a
,
b
)]
liftOptionsSnd
=
map
(
liftOption
snd
(
\
b
(
a
,
_
)
->
(
a
,
b
)))
optionVerbose
::
(
flags
->
Flag
Verbosity
)
->
(
Flag
Verbosity
->
flags
->
flags
)
->
Option
flags
...
...
cabal-install/Hackage/Upgrade.hs
View file @
c76d7fc3
...
...
@@ -28,7 +28,7 @@ import Distribution.Version (VersionRange(..), Dependency(..))
import
Distribution.Verbosity
(
Verbosity
)
import
qualified
Distribution.Simple.Setup
as
Cabal
import
Data.Monoid
(
Monoid
(
mconcat
))
import
Data.Monoid
(
Monoid
(
..
))
upgrade
::
Verbosity
->
PackageDB
->
[
Repo
]
...
...
@@ -43,7 +43,7 @@ upgrade verbosity packageDB repos comp conf configFlags = do
putStrLn
"Upgrading the following packages: "
--FIXME: check if upgradable is null
mapM_
putStrLn
[
showPackageId
(
packageId
x
)
|
x
<-
upgradable
]
install
verbosity
packageDB
repos
comp
conf
configFlags
install
verbosity
packageDB
repos
comp
conf
configFlags
mempty
[
UnresolvedDependency
(
identifierToDependency
$
packageId
x
)
[]
|
x
<-
upgradable
]
...
...
cabal-install/Main.hs
View file @
c76d7fc3
...
...
@@ -119,18 +119,18 @@ configureAction flags extraArgs = do
:
commandShowOptions
configureCommand
flags'
++
extraArgs
setupWrapper
args
Nothing
installAction
::
Cabal
.
ConfigFlags
->
[
String
]
->
IO
()
installAction
flags
extraArgs
=
do
installAction
::
(
Cabal
.
ConfigFlags
,
InstallFlags
)
->
[
String
]
->
IO
()
installAction
(
c
flags
,
iflags
)
extraArgs
=
do
pkgs
<-
either
die
return
(
parsePackageArgs
extraArgs
)
configFile
<-
defaultConfigFile
--FIXME
let
verbosity
=
fromFlagOrDefault
normal
(
Cabal
.
configVerbose
flags
)
let
verbosity
=
fromFlagOrDefault
normal
(
Cabal
.
configVerbose
c
flags
)
config
<-
loadConfig
verbosity
configFile
let
flags'
=
savedConfigToConfigFlags
(
Cabal
.
configPackageDB
flags
)
config
`
mappend
`
flags
(
comp
,
conf
)
<-
configCompilerAux
flags'
let
c
flags'
=
savedConfigToConfigFlags
(
Cabal
.
configPackageDB
c
flags
)
config
`
mappend
`
c
flags
(
comp
,
conf
)
<-
configCompilerAux
c
flags'
install
verbosity
(
fromFlag
$
Cabal
.
configPackageDB
flags'
)
(
configRepos
config
)
comp
conf
flags'
pkgs
(
fromFlag
$
Cabal
.
configPackageDB
c
flags'
)
(
configRepos
config
)
comp
conf
c
flags'
iflags
pkgs
infoAction
::
Cabal
.
Flag
Verbosity
->
[
String
]
->
IO
()
infoAction
verbosityFlag
extraArgs
=
do
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment