Commit bd002a81 authored by etrepum's avatar etrepum Committed by Mikhail Glushenkov

prototype of "cabal exec", missing GHC_PACKAGE_PATH support

Conflicts:
	cabal-install/Main.hs
parent d10d67cc
......@@ -34,6 +34,7 @@ module Distribution.Client.Setup
, sdistCommand, SDistFlags(..), SDistExFlags(..), ArchiveFormat(..)
, win32SelfUpgradeCommand, Win32SelfUpgradeFlags(..)
, sandboxCommand, defaultSandboxLocation, SandboxFlags(..)
, execCommand, ExecFlags(..)
, parsePackageArgs
--TODO: stop exporting these:
......@@ -1608,6 +1609,44 @@ instance Monoid SandboxFlags where
}
where combine field = field a `mappend` field b
-- ------------------------------------------------------------
-- * Exec Flags
-- ------------------------------------------------------------
data ExecFlags = ExecFlags {
execVerbosity :: Flag Verbosity
}
defaultExecFlags :: ExecFlags
defaultExecFlags = ExecFlags {
execVerbosity = toFlag normal
}
execCommand :: CommandUI ExecFlags
execCommand = CommandUI {
commandName = "exec",
commandSynopsis = "Run a shell command with the cabal environment",
commandDescription = Nothing,
commandUsage = \pname ->
"Usage: " ++ pname ++ " exec COMMAND [ARGS]\n\n"
++ "Flags for exec:",
commandDefaultFlags = defaultExecFlags,
commandOptions = \_ ->
[ optionVerbosity execVerbosity
(\v flags -> flags { execVerbosity = v })
]
}
instance Monoid ExecFlags where
mempty = ExecFlags {
execVerbosity = mempty
}
mappend a b = ExecFlags {
execVerbosity = combine execVerbosity
}
where combine field = field a `mappend` field b
-- ------------------------------------------------------------
-- * GetOpt Utils
-- ------------------------------------------------------------
......
......@@ -36,6 +36,7 @@ import Distribution.Client.Setup
, SDistFlags(..), SDistExFlags(..), sdistCommand
, Win32SelfUpgradeFlags(..), win32SelfUpgradeCommand
, SandboxFlags(..), sandboxCommand
, ExecFlags(..), execCommand
, reportCommand
)
import Distribution.Simple.Setup
......@@ -123,7 +124,7 @@ import Distribution.Simple.Program (defaultProgramConfiguration)
import qualified Distribution.Simple.Setup as Cabal
import Distribution.Simple.Utils
( cabalVersion, die, notice, info, topHandler
, findPackageDesc, tryFindPackageDesc )
, findPackageDesc, tryFindPackageDesc , rawSystemExit )
import Distribution.Text
( display )
import Distribution.Verbosity as Verbosity
......@@ -215,6 +216,7 @@ mainWorker args = topHandler $
`commandAddAction` replAction
,sandboxCommand `commandAddAction` sandboxAction
,haddockCommand `commandAddAction` haddockAction
,execCommand `commandAddAction` execAction
,wrapperAction copyCommand
copyVerbosity copyDistPref
,wrapperAction cleanCommand
......@@ -1010,6 +1012,17 @@ sandboxAction sandboxFlags extraArgs globalFlags = do
where
noExtraArgs = (<1) . length
execAction :: ExecFlags -> [String] -> GlobalFlags -> IO ()
execAction execFlags extraArgs globalFlags = do
let verbosity = fromFlag (execVerbosity execFlags)
(useSandbox, _config) <- loadConfigOrSandboxConfig verbosity globalFlags
mempty
case extraArgs of
(exec:args) -> maybeWithSandboxDirOnSearchPath useSandbox $
rawSystemExit verbosity exec args
-- Error handling.
[] -> die $ "Please specify an executable to run"
-- | See 'Distribution.Client.Install.withWin32SelfUpgrade' for details.
--
win32SelfUpgradeAction :: Win32SelfUpgradeFlags -> [String] -> GlobalFlags
......
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