Repository : ssh://g...@git.haskell.org/Cabal
On branch : ghc-head
Link :
http://git.haskell.org/packages/Cabal.git/commitdiff/ed563b1cd8cd1bd8c2ba9b8cb541a458c9ee4978
>---------------------------------------------------------------
commit ed563b1cd8cd1bd8c2ba9b8cb541a458c9ee4978
Author: Mikhail Glushenkov <mikhail.glushen...@gmail.com>
Date: Thu Sep 12 20:26:06 2013 +0200
'cabal run': don't pass any extra args to build except the exe name.
See the comments on 5a62f4ab40dc8216cfb487be49372db16a85231c.
(cherry picked from commit a307cad11540c482096ebae5fe641e1d45857a04)
>---------------------------------------------------------------
ed563b1cd8cd1bd8c2ba9b8cb541a458c9ee4978
cabal-install/Distribution/Client/Run.hs | 62 ++++++++++++++----------------
cabal-install/Main.hs | 13 +++++--
2 files changed, 37 insertions(+), 38 deletions(-)
diff --git a/cabal-install/Distribution/Client/Run.hs
b/cabal-install/Distribution/Client/Run.hs
index a36546c..a23a0e3 100644
--- a/cabal-install/Distribution/Client/Run.hs
+++ b/cabal-install/Distribution/Client/Run.hs
@@ -7,21 +7,16 @@
-- Implementation of the 'run' command.
-----------------------------------------------------------------------------
-module Distribution.Client.Run ( run )
+module Distribution.Client.Run ( run, splitRunArgs )
where
-import Distribution.Client.Setup (BuildFlags (..))
-import Distribution.Client.SetupWrapper (SetupScriptOptions (..),
- defaultSetupScriptOptions)
import Distribution.Client.Utils (tryCanonicalizePath)
import Distribution.PackageDescription (Executable (..),
PackageDescription (..))
import Distribution.Simple.Build.PathsModule (pkgPathEnvVar)
import Distribution.Simple.BuildPaths (exeExtension)
-import Distribution.Simple.Configure (getPersistBuildConfig)
import Distribution.Simple.LocalBuildInfo (LocalBuildInfo (..))
-import Distribution.Simple.Setup (fromFlagOrDefault)
import Distribution.Simple.Utils (die, rawSystemExitWithEnv)
import Distribution.Verbosity (Verbosity)
@@ -32,39 +27,38 @@ import Distribution.Compat.Environment
(getEnvironment)
import System.FilePath ((<.>), (</>))
-run :: Verbosity -> BuildFlags -> [String] -> IO ()
-run verbosity buildFlags args = do
- let distPref = fromFlagOrDefault (useDistPref defaultSetupScriptOptions)
- (buildDistPref buildFlags)
- -- The package must have been configured by now.
- lbi <- getPersistBuildConfig distPref
-
- curDir <- getCurrentDirectory
- let buildPref = buildDir lbi
- pkg_descr = localPkgDescr lbi
- exes = executables pkg_descr
- dataDirEnvVar = (pkgPathEnvVar pkg_descr "datadir",
- curDir </> dataDir pkg_descr)
-
- exePath :: Executable -> FilePath
- exePath exe = buildPref </> exeName exe </> (exeName exe <.>
exeExtension)
-
- doRun :: Executable -> [String] -> IO ()
- doRun exe exeArgs = do
- path <- tryCanonicalizePath $ exePath exe
- env <- (dataDirEnvVar:) <$> getEnvironment
- rawSystemExitWithEnv verbosity path exeArgs env
-
+-- | Return the executable to run and any extra arguments that should be
+-- forwarded to it.
+splitRunArgs :: LocalBuildInfo -> [String] -> IO (Executable, [String])
+splitRunArgs lbi args =
case exes of
[] -> die "Couldn't find any executables."
[exe] -> case args of
- [] -> doRun exe []
- (x:xs) | x == exeName exe -> doRun exe xs
- | otherwise -> doRun exe args
+ [] -> return (exe, [])
+ (x:xs) | x == exeName exe -> return (exe, xs)
+ | otherwise -> return (exe, args)
_ -> case args of
[] -> die $ "This package contains multiple executables. "
++ "You must pass the executable name as the first argument "
- ++ "to run."
+ ++ "to 'cabal run'."
(x:xs) -> case find (\exe -> exeName exe == x) exes of
Nothing -> die $ "No executable named '" ++ x ++ "'."
- Just exe -> doRun exe xs
+ Just exe -> return (exe, xs)
+ where
+ pkg_descr = localPkgDescr lbi
+ exes = executables pkg_descr
+
+
+-- | Run a given executable.
+run :: Verbosity -> LocalBuildInfo -> Executable -> [String] -> IO ()
+run verbosity lbi exe exeArgs = do
+ curDir <- getCurrentDirectory
+ let buildPref = buildDir lbi
+ pkg_descr = localPkgDescr lbi
+ dataDirEnvVar = (pkgPathEnvVar pkg_descr "datadir",
+ curDir </> dataDir pkg_descr)
+
+ path <- tryCanonicalizePath $
+ buildPref </> exeName exe </> (exeName exe <.> exeExtension)
+ env <- (dataDirEnvVar:) <$> getEnvironment
+ rawSystemExitWithEnv verbosity path exeArgs env
diff --git a/cabal-install/Main.hs b/cabal-install/Main.hs
index 70551b9..bb64adb 100644
--- a/cabal-install/Main.hs
+++ b/cabal-install/Main.hs
@@ -64,7 +64,7 @@ import Distribution.Client.Fetch (fetch)
import Distribution.Client.Check as Check (check)
--import Distribution.Client.Clean (clean)
import Distribution.Client.Upload as Upload (upload, check, report)
-import Distribution.Client.Run (run)
+import Distribution.Client.Run (run, splitRunArgs)
import Distribution.Client.SrcDist (sdist)
import Distribution.Client.Get (get)
import Distribution.Client.Sandbox (sandboxInit
@@ -95,6 +95,8 @@ import Distribution.Client.Sandbox.Types
(UseSandbox(..), whenUsingSandbox)
import Distribution.Client.Init (initCabal)
import qualified Distribution.Client.Win32SelfUpgrade as Win32SelfUpgrade
+import Distribution.PackageDescription
+ ( Executable(..) )
import Distribution.Simple.Command
( CommandParse(..), CommandUI(..), Command
, commandsRun, commandAddAction, hiddenCommand )
@@ -103,7 +105,7 @@ import Distribution.Simple.Compiler
import Distribution.Simple.Configure
( checkPersistBuildConfigOutdated, configCompilerAuxEx
, ConfigStateFileErrorType(..), localBuildInfoFile
- , tryGetPersistBuildConfig )
+ , getPersistBuildConfig, tryGetPersistBuildConfig )
import qualified Distribution.Simple.LocalBuildInfo as LBI
import Distribution.Simple.Program (defaultProgramConfiguration)
import qualified Distribution.Simple.Setup as Cabal
@@ -813,11 +815,14 @@ runAction (buildFlags, buildExFlags) extraArgs
globalFlags = do
globalFlags noAddSource (buildNumJobs buildExFlags)
(const Nothing)
+ lbi <- getPersistBuildConfig distPref
+ (exe, exeArgs) <- splitRunArgs lbi extraArgs
+
maybeWithSandboxDirOnSearchPath useSandbox $
- build verbosity distPref mempty extraArgs
+ build verbosity distPref mempty ["exe:" ++ exeName exe]
maybeWithSandboxDirOnSearchPath useSandbox $
- run verbosity buildFlags extraArgs
+ run verbosity lbi exe exeArgs
getAction :: GetFlags -> [String] -> GlobalFlags -> IO ()
getAction getFlags extraArgs globalFlags = do
_______________________________________________
ghc-commits mailing list
ghc-commits@haskell.org
http://www.haskell.org/mailman/listinfo/ghc-commits
