Commit 0c8d697e authored by refold's avatar refold

Add a dummy 'sandbox-delete' command.

parent f2a0ab9b
......@@ -9,6 +9,7 @@
module Distribution.Client.Sandbox (
sandboxInit,
sandboxDelete,
sandboxAddSource,
sandboxConfigure,
sandboxBuild,
......@@ -98,6 +99,11 @@ sandboxInit :: Verbosity -> SandboxFlags -> GlobalFlags -> IO ()
sandboxInit _verbosity _sandboxFlags _globalFlags = do
die "Not implemented."
-- | Entry point for the 'cabal sandbox-delete' command.
sandboxDelete :: Verbosity -> SandboxFlags -> GlobalFlags -> IO ()
sandboxDelete _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
......
......@@ -31,8 +31,8 @@ module Distribution.Client.Setup
, win32SelfUpgradeCommand, Win32SelfUpgradeFlags(..)
, indexCommand, IndexFlags(..)
, dumpPkgEnvCommand
, sandboxInitCommand, sandboxConfigureCommand, sandboxAddSourceCommand
, sandboxBuildCommand, sandboxInstallCommand
, sandboxInitCommand, sandboxDeleteCommand, sandboxConfigureCommand
, sandboxAddSourceCommand, sandboxBuildCommand, sandboxInstallCommand
, SandboxFlags(..), defaultSandboxLocation
, parsePackageArgs
......@@ -1306,6 +1306,16 @@ sandboxInitCommand = CommandUI {
commandOptions = commonSandboxOptions
}
sandboxDeleteCommand :: CommandUI SandboxFlags
sandboxDeleteCommand = CommandUI {
commandName = "sandbox-delete",
commandSynopsis = "Deletes current sandbox",
commandDescription = Nothing,
commandUsage = \pname -> usageFlags pname "sandbox-delete",
commandDefaultFlags = defaultSandboxFlags,
commandOptions = commonSandboxOptions
}
sandboxAddSourceCommand :: CommandUI SandboxFlags
sandboxAddSourceCommand = CommandUI {
commandName = "sandbox-add-source",
......
......@@ -31,8 +31,9 @@ import Distribution.Client.Setup
, SDistFlags(..), SDistExFlags(..), sdistCommand
, Win32SelfUpgradeFlags(..), win32SelfUpgradeCommand
, IndexFlags(..), indexCommand
, SandboxFlags(..), sandboxInitCommand, sandboxAddSourceCommand
, sandboxConfigureCommand, sandboxBuildCommand, sandboxInstallCommand
, SandboxFlags(..), sandboxInitCommand, sandboxDeleteCommand
, sandboxAddSourceCommand, sandboxConfigureCommand
, sandboxBuildCommand, sandboxInstallCommand
, dumpPkgEnvCommand
, reportCommand
, unpackCommand, UnpackFlags(..) )
......@@ -65,6 +66,7 @@ import Distribution.Client.SrcDist (sdist)
import Distribution.Client.Unpack (unpack)
import Distribution.Client.Index (index)
import Distribution.Client.Sandbox (sandboxInit
, sandboxDelete
, sandboxAddSource
, sandboxBuild
, sandboxConfigure
......@@ -170,6 +172,8 @@ mainWorker args = topHandler $
indexCommand `commandAddAction` indexAction
,hiddenCommand $
sandboxInitCommand `commandAddAction` sandboxInitAction
,hiddenCommand $
sandboxDeleteCommand `commandAddAction` sandboxDeleteAction
,hiddenCommand $
sandboxAddSourceCommand `commandAddAction` sandboxAddSourceAction
,hiddenCommand $
......@@ -592,6 +596,14 @@ sandboxInitAction sandboxFlags extraArgs globalFlags = do
let verbosity = fromFlag (sandboxVerbosity sandboxFlags)
sandboxInit verbosity sandboxFlags globalFlags
sandboxDeleteAction :: SandboxFlags -> [String] -> GlobalFlags -> IO ()
sandboxDeleteAction 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)
sandboxDelete verbosity sandboxFlags globalFlags
sandboxAddSourceAction :: SandboxFlags -> [String] -> GlobalFlags -> IO ()
sandboxAddSourceAction sandboxFlags extraArgs _globalFlags = do
let verbosity = fromFlag (sandboxVerbosity sandboxFlags)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment