Skip to content
Browse files

Implement the 'run' command.

See the discussion in #1088.
  • Loading branch information...
1 parent 5f51b62 commit f551e919150fe9ab3ad24533274c4e6687d79cac @23Skidoo committed Nov 1, 2012
View
70 cabal-install/Distribution/Client/Run.hs
@@ -0,0 +1,70 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module : Distribution.Client.Run
+-- Maintainer : cabal-devel@haskell.org
+-- Portability : portable
+--
+-- Implementation of the 'run' command.
+-----------------------------------------------------------------------------
+
+module Distribution.Client.Run ( run )
+ where
+
+import Distribution.Client.Setup (BuildFlags (..))
+import Distribution.Client.SetupWrapper (SetupScriptOptions (..),
+ defaultSetupScriptOptions)
+
+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)
+
+import Data.Functor ((<$>))
+import Data.List (find)
+import System.Directory (canonicalizePath,
+ getCurrentDirectory)
+import System.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 <- canonicalizePath $ exePath exe
+ env <- (dataDirEnvVar:) <$> getEnvironment
+ rawSystemExitWithEnv verbosity path exeArgs env
+
+ 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
+ _ -> case args of
+ [] -> die $ "This package contains multiple executables. "
+ ++ "You must pass the executable name as the first argument "
+ ++ "to run."
+ (x:xs) -> case find (\exe -> exeName exe == x) exes of
+ Nothing -> die $ "No executable named '" ++ x ++ "'."
+ Just exe -> doRun exe xs
View
16 cabal-install/Distribution/Client/Setup.hs
@@ -25,6 +25,7 @@ module Distribution.Client.Setup
, checkCommand
, uploadCommand, UploadFlags(..)
, reportCommand, ReportFlags(..)
+ , runCommand
, unpackCommand, UnpackFlags(..)
, initCommand, IT.InitFlags(..)
, sdistCommand, SDistFlags(..), SDistExFlags(..), ArchiveFormat(..)
@@ -430,6 +431,21 @@ checkCommand = CommandUI {
commandOptions = \_ -> []
}
+runCommand :: CommandUI BuildFlags
+runCommand = CommandUI {
+ commandName = "run",
+ commandSynopsis = "Runs the compiled executable.",
+ commandDescription = Nothing,
+ commandUsage =
+ (\pname -> "Usage: " ++ pname
+ ++ " run [FLAGS] [EXECUTABLE] [-- EXECUTABLE_FLAGS]\n\n"
+ ++ "Flags for run:"),
+ commandDefaultFlags = mempty,
+ commandOptions = Cabal.buildOptions progConf
+ }
+ where
+ progConf = defaultProgramConfiguration
+
-- ------------------------------------------------------------
-- * Report flags
-- ------------------------------------------------------------
View
14 cabal-install/Main.hs
@@ -27,6 +27,7 @@ import Distribution.Client.Setup
, InfoFlags(..), infoCommand
, UploadFlags(..), uploadCommand
, ReportFlags(..), reportCommand
+ , runCommand
, InitFlags(initVerbosity), initCommand
, SDistFlags(..), SDistExFlags(..), sdistCommand
, Win32SelfUpgradeFlags(..), win32SelfUpgradeCommand
@@ -62,6 +63,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.SrcDist (sdist)
import Distribution.Client.Unpack (unpack)
import Distribution.Client.Index (index)
@@ -150,6 +152,7 @@ mainWorker args = topHandler $
,sdistCommand `commandAddAction` sdistAction
,uploadCommand `commandAddAction` uploadAction
,reportCommand `commandAddAction` reportAction
+ ,runCommand `commandAddAction` runAction
,initCommand `commandAddAction` initAction
,configureExCommand `commandAddAction` configureAction
,buildCommand `commandAddAction` buildAction
@@ -555,6 +558,17 @@ reportAction reportFlags extraArgs globalFlags = do
(flagToMaybe $ reportUsername reportFlags')
(flagToMaybe $ reportPassword reportFlags')
+runAction :: BuildFlags -> [String] -> GlobalFlags -> IO ()
+runAction buildFlags extraArgs globalFlags = do
+ let verbosity = fromFlagOrDefault normal (buildVerbosity buildFlags)
+ distPref = fromFlagOrDefault (useDistPref defaultSetupScriptOptions)
+ (buildDistPref buildFlags)
+
+ reconfigure verbosity distPref mempty [] globalFlags (const Nothing)
+ build verbosity distPref mempty []
+
+ run verbosity buildFlags extraArgs
+
unpackAction :: UnpackFlags -> [String] -> GlobalFlags -> IO ()
unpackAction unpackFlags extraArgs globalFlags = do
let verbosity = fromFlag (unpackVerbosity unpackFlags)
View
1 cabal-install/cabal-install.cabal
@@ -93,6 +93,7 @@ Executable cabal
Distribution.Client.PackageIndex
Distribution.Client.PackageUtils
Distribution.Client.ParseUtils
+ Distribution.Client.Run
Distribution.Client.Sandbox
Distribution.Client.Setup
Distribution.Client.SetupWrapper

0 comments on commit f551e91

Please sign in to comment.
Something went wrong with that request. Please try again.