Implement --dry-run for 'cabal install'

cabal-install/Hackage/Install.hs

@@ -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

@@ -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 {
       ++ "\nSee 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

@@ -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

@@ -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 (cflags,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 cflags)
   config <- loadConfig verbosity configFile
-  let flags' = savedConfigToConfigFlags (Cabal.configPackageDB flags) config
-               `mappend` flags
-  (comp, conf) <- configCompilerAux flags'
+  let cflags' = savedConfigToConfigFlags (Cabal.configPackageDB cflags) config
+               `mappend` cflags
+  (comp, conf) <- configCompilerAux cflags'
   install verbosity
-          (fromFlag $ Cabal.configPackageDB flags') (configRepos config)
-          comp conf flags' pkgs
+          (fromFlag $ Cabal.configPackageDB cflags') (configRepos config)
+          comp conf cflags' iflags pkgs
 
 infoAction :: Cabal.Flag Verbosity -> [String] -> IO ()
 infoAction verbosityFlag extraArgs = do