Add a dummy 'sandbox-init' command.

cabal-install/Distribution/Client/Sandbox.hs

@@ -8,12 +8,13 @@
 -----------------------------------------------------------------------------
 
 module Distribution.Client.Sandbox (
-    dumpPackageEnvironment,
-
+    sandboxInit,
     sandboxAddSource,
     sandboxConfigure,
     sandboxBuild,
-    sandboxInstall
+    sandboxInstall,
+
+    dumpPackageEnvironment
   ) where
 
 import Distribution.Client.Setup
@@ -92,6 +93,19 @@ dumpPackageEnvironment verbosity sandboxFlags = do
   commentPkgEnv <- commentPackageEnvironment pkgEnvDir
   putStrLn . showPackageEnvironmentWithComments commentPkgEnv $ pkgEnv
 
+-- | Entry point for the 'cabal sandbox-init' command.
+sandboxInit :: Verbosity -> SandboxFlags -> GlobalFlags -> IO ()
+sandboxInit _verbosity _sandboxFlags _globalFlags = do
+  die "Not implemented."
+
+-- | Entry point for the 'cabal sandbox-add-source' command.
+sandboxAddSource :: Verbosity -> SandboxFlags -> [FilePath] -> IO ()
+sandboxAddSource verbosity sandboxFlags buildTreeRefs = do
+  sandboxDir <- getSandboxLocation verbosity sandboxFlags
+  pkgEnv     <- tryLoadPackageEnvironment verbosity sandboxDir
+  indexFile  <- tryGetIndexFilePath pkgEnv
+  Index.addBuildTreeRefs verbosity indexFile buildTreeRefs
+
 -- | Entry point for the 'cabal sandbox-configure' command.
 sandboxConfigure :: Verbosity -> SandboxFlags -> ConfigFlags -> ConfigExFlags
                     -> [String] -> GlobalFlags -> IO ()
@@ -146,14 +160,6 @@ sandboxConfigure verbosity
       -- ...and pass it to configCompilerAux.
       configCompilerAux configFlags'
 
--- | Entry point for the 'cabal sandbox-add-source' command.
-sandboxAddSource :: Verbosity -> SandboxFlags -> [FilePath] -> IO ()
-sandboxAddSource verbosity sandboxFlags buildTreeRefs = do
-  sandboxDir <- getSandboxLocation verbosity sandboxFlags
-  pkgEnv     <- tryLoadPackageEnvironment verbosity sandboxDir
-  indexFile  <- tryGetIndexFilePath pkgEnv
-  Index.addBuildTreeRefs verbosity indexFile buildTreeRefs
-
 -- | Entry point for the 'cabal sandbox-build' command.
 sandboxBuild :: Verbosity -> SandboxFlags -> BuildFlags -> [String] -> IO ()
 sandboxBuild verbosity sandboxFlags buildFlags' extraArgs = do

cabal-install/Distribution/Client/Setup.hs

@@ -30,9 +30,10 @@ module Distribution.Client.Setup
     , sdistCommand, SDistFlags(..), SDistExFlags(..), ArchiveFormat(..)
     , win32SelfUpgradeCommand, Win32SelfUpgradeFlags(..)
     , indexCommand, IndexFlags(..)
-    , dumpPkgEnvCommand, sandboxConfigureCommand, sandboxAddSourceCommand
-    , sandboxBuildCommand, sandboxInstallCommand, defaultSandboxLocation
-    , SandboxFlags(..)
+    , dumpPkgEnvCommand
+    , sandboxInitCommand, sandboxConfigureCommand, sandboxAddSourceCommand
+    , sandboxBuildCommand, sandboxInstallCommand
+    , SandboxFlags(..), defaultSandboxLocation
 
     , parsePackageArgs
     --TODO: stop exporting these:
@@ -1295,6 +1296,26 @@ commonSandboxOptions _showOrParseArgs =
       (reqArgFlag "DIR")
   ]
 
+sandboxInitCommand :: CommandUI SandboxFlags
+sandboxInitCommand = CommandUI {
+  commandName         = "sandbox-init",
+  commandSynopsis     = "Initialise a fresh sandbox",
+  commandDescription  = Nothing,
+  commandUsage        = \pname -> usageFlags pname "sandbox-init",
+  commandDefaultFlags = defaultSandboxFlags,
+  commandOptions      = commonSandboxOptions
+  }
+
+sandboxAddSourceCommand :: CommandUI SandboxFlags
+sandboxAddSourceCommand = CommandUI {
+  commandName         = "sandbox-add-source",
+  commandSynopsis     = "Make a source package available in a sandbox",
+  commandDescription  = Nothing,
+  commandUsage        = \pname -> usageFlags pname "sandbox-add-source",
+  commandDefaultFlags = defaultSandboxFlags,
+  commandOptions      = commonSandboxOptions
+  }
+
 sandboxConfigureCommand :: CommandUI (SandboxFlags, ConfigFlags, ConfigExFlags)
 sandboxConfigureCommand = CommandUI {
   commandName         = "sandbox-configure",
@@ -1315,16 +1336,6 @@ sandboxConfigureCommand = CommandUI {
     get2 (_,b,_) = b; set2 b (a,_,c) = (a,b,c)
     get3 (_,_,c) = c; set3 c (a,b,_) = (a,b,c)
 
-sandboxAddSourceCommand :: CommandUI SandboxFlags
-sandboxAddSourceCommand = CommandUI {
-  commandName         = "sandbox-add-source",
-  commandSynopsis     = "Make a source package available in a sandbox",
-  commandDescription  = Nothing,
-  commandUsage        = \pname -> usageFlags pname "sandbox-add-source",
-  commandDefaultFlags = defaultSandboxFlags,
-  commandOptions      = commonSandboxOptions
-  }
-
 sandboxBuildCommand :: CommandUI (SandboxFlags, BuildFlags)
 sandboxBuildCommand = CommandUI {
   commandName         = "sandbox-build",

cabal-install/Main.hs

@@ -31,7 +31,7 @@ import Distribution.Client.Setup
          , SDistFlags(..), SDistExFlags(..), sdistCommand
          , Win32SelfUpgradeFlags(..), win32SelfUpgradeCommand
          , IndexFlags(..), indexCommand
-         , SandboxFlags(..), sandboxAddSourceCommand
+         , SandboxFlags(..), sandboxInitCommand, sandboxAddSourceCommand
          , sandboxConfigureCommand, sandboxBuildCommand, sandboxInstallCommand
          , dumpPkgEnvCommand
          , reportCommand
@@ -64,8 +64,10 @@ import Distribution.Client.Upload as Upload   (upload, check, report)
 import Distribution.Client.SrcDist            (sdist)
 import Distribution.Client.Unpack             (unpack)
 import Distribution.Client.Index              (index)
-import Distribution.Client.Sandbox            (sandboxConfigure
-                                              , sandboxAddSource, sandboxBuild
+import Distribution.Client.Sandbox            (sandboxInit
+                                              , sandboxAddSource
+                                              , sandboxBuild
+                                              , sandboxConfigure
                                               , sandboxInstall
                                               , dumpPackageEnvironment)
 import Distribution.Client.Init               (initCabal)
@@ -167,9 +169,11 @@ mainWorker args = topHandler $
       ,hiddenCommand $
        indexCommand `commandAddAction` indexAction
       ,hiddenCommand $
-       sandboxConfigureCommand `commandAddAction` sandboxConfigureAction
+       sandboxInitCommand `commandAddAction` sandboxInitAction
       ,hiddenCommand $
        sandboxAddSourceCommand `commandAddAction` sandboxAddSourceAction
+      ,hiddenCommand $
+       sandboxConfigureCommand `commandAddAction` sandboxConfigureAction
       ,hiddenCommand $
        sandboxBuildCommand `commandAddAction` sandboxBuildAction
       ,hiddenCommand $
@@ -580,6 +584,19 @@ indexAction indexFlags extraArgs _globalFlags = do
   let verbosity = fromFlag (indexVerbosity indexFlags)
   index verbosity indexFlags (head extraArgs)
 
+sandboxInitAction :: SandboxFlags -> [String] -> GlobalFlags -> IO ()
+sandboxInitAction sandboxFlags extraArgs globalFlags = do
+  when ((>0). length $ extraArgs) $ do
+    die $ "the 'sandbox-init' command doesn't expect any arguments: "
+      ++ unwords extraArgs
+  let verbosity = fromFlag (sandboxVerbosity sandboxFlags)
+  sandboxInit verbosity sandboxFlags globalFlags
+
+sandboxAddSourceAction :: SandboxFlags -> [String] -> GlobalFlags -> IO ()
+sandboxAddSourceAction sandboxFlags extraArgs _globalFlags = do
+  let verbosity = fromFlag (sandboxVerbosity sandboxFlags)
+  sandboxAddSource verbosity sandboxFlags extraArgs
+
 sandboxConfigureAction :: (SandboxFlags, ConfigFlags, ConfigExFlags)
                           -> [String] -> GlobalFlags -> IO ()
 sandboxConfigureAction (sandboxFlags, configFlags, configExFlags)
@@ -588,11 +605,6 @@ sandboxConfigureAction (sandboxFlags, configFlags, configExFlags)
   sandboxConfigure verbosity sandboxFlags configFlags configExFlags
     extraArgs globalFlags
 
-sandboxAddSourceAction :: SandboxFlags -> [String] -> GlobalFlags -> IO ()
-sandboxAddSourceAction sandboxFlags extraArgs _globalFlags = do
-  let verbosity = fromFlag (sandboxVerbosity sandboxFlags)
-  sandboxAddSource verbosity sandboxFlags extraArgs
-
 sandboxBuildAction :: (SandboxFlags, BuildFlags) -> [String] -> GlobalFlags
                       -> IO ()
 sandboxBuildAction (sandboxFlags, buildFlags) extraArgs _globalFlags = do