Permalink
Browse files

Add a dummy 'sandbox-init' command.

  • Loading branch information...
1 parent 6526f94 commit f2a0ab9b8969a5e1fb128bc68cf164d75047d039 @23Skidoo 23Skidoo committed Sep 13, 2012
Showing with 62 additions and 33 deletions.
  1. +17 −11 cabal-install/Distribution/Client/Sandbox.hs
  2. +24 −13 cabal-install/Distribution/Client/Setup.hs
  3. +21 −9 cabal-install/Main.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
@@ -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",
View
@@ -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,10 +169,12 @@ 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 $
sandboxInstallCommand `commandAddAction` sandboxInstallAction
@@ -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

0 comments on commit f2a0ab9

Please sign in to comment.