Commit f2a0ab9b authored by refold's avatar refold

Add a dummy 'sandbox-init' command.

parent 6526f945
......@@ -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",
......
......@@ -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
......
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