Commit e24bffb8 authored by Mikhail Glushenkov's avatar Mikhail Glushenkov Committed by tibbe
Browse files

Revert "Add cabal exec"

This reverts commit 99d912d3.

Looks like Johan managed to botch a merge somehow, see #1786. Or maybe that was
a bug on the GitHub side.

(cherry picked from commit d10d67cc)
parent 04b545f0
......@@ -44,7 +44,6 @@ module Distribution.Simple.GHC (
componentGhcOptions,
ghcLibDir,
ghcDynamic,
ghcGlobalPackageDB,
) where
import qualified Distribution.Simple.GHC.IPI641 as IPI641
......@@ -550,13 +549,6 @@ ghcLibDir' verbosity ghcProg =
(reverse . dropWhile isSpace . reverse) `fmap`
rawSystemProgramStdout verbosity ghcProg ["--print-libdir"]
-- | Return the 'FilePath' to the global GHC package database.
ghcGlobalPackageDB :: Verbosity -> ConfiguredProgram -> IO FilePath
ghcGlobalPackageDB verbosity ghcProg =
(reverse . dropWhile isSpace . reverse) `fmap`
rawSystemProgramStdout verbosity ghcProg ["--print-global-package-db"]
-- Cabal does not use the environment variable GHC_PACKAGE_PATH; let users
-- know that this is the case. See ticket #335. Simply ignoring it is not a
-- good idea, since then ghc and cabal are looking at different sets of
......
......@@ -19,7 +19,6 @@ module Distribution.Client.Sandbox.PackageEnvironment (
, showPackageEnvironment
, showPackageEnvironmentWithComments
, setPackageDB
, sandboxPackageDBPath
, loadUserConfig
, basePackageEnvironment
......@@ -211,23 +210,14 @@ initialPackageEnvironment sandboxDir compiler platform = do
}
}
-- | Return the path to the sandbox package database.
sandboxPackageDBPath :: FilePath -> Compiler -> Platform -> String
sandboxPackageDBPath sandboxDir compiler platform =
sandboxDir
</> (Text.display platform ++ "-"
++ showCompilerId compiler
++ "-packages.conf.d")
-- | Use the package DB location specific for this compiler.
setPackageDB :: FilePath -> Compiler -> Platform -> ConfigFlags -> ConfigFlags
setPackageDB sandboxDir compiler platform configFlags =
configFlags {
configPackageDBs = [Just (SpecificPackageDB $ sandboxPackageDBPath
sandboxDir
compiler
platform)]
configPackageDBs = [Just (SpecificPackageDB $ sandboxDir
</> (Text.display platform ++ "-"
++ showCompilerId compiler
++ "-packages.conf.d"))]
}
-- | Almost the same as 'savedConf `mappend` pkgEnv', but some settings are
......
......@@ -34,7 +34,6 @@ module Distribution.Client.Setup
, sdistCommand, SDistFlags(..), SDistExFlags(..), ArchiveFormat(..)
, win32SelfUpgradeCommand, Win32SelfUpgradeFlags(..)
, sandboxCommand, defaultSandboxLocation, SandboxFlags(..)
, execCommand, ExecFlags(..)
, parsePackageArgs
--TODO: stop exporting these:
......@@ -1609,44 +1608,6 @@ 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 command with the cabal environment",
commandDescription = Nothing,
commandUsage = \pname ->
"Usage: " ++ pname ++ " exec [FLAGS] 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,11 +36,10 @@ import Distribution.Client.Setup
, SDistFlags(..), SDistExFlags(..), sdistCommand
, Win32SelfUpgradeFlags(..), win32SelfUpgradeCommand
, SandboxFlags(..), sandboxCommand
, ExecFlags(..), execCommand
, reportCommand
)
import Distribution.Simple.Setup
( HaddockFlags(..), haddockCommand
( HaddockFlags(..), haddockCommand, defaultHaddockFlags
, HscolourFlags(..), hscolourCommand
, ReplFlags(..), replCommand
, CopyFlags(..), copyCommand
......@@ -78,7 +77,6 @@ import Distribution.Client.Sandbox (sandboxInit
,sandboxListSources
,sandboxHcPkg
,dumpPackageEnvironment
,withSandboxBinDirOnSearchPath
,getSandboxConfigFilePath
,loadConfigOrSandboxConfig
......@@ -95,7 +93,6 @@ import Distribution.Client.Sandbox (sandboxInit
,configPackageDB')
import Distribution.Client.Sandbox.PackageEnvironment
(setPackageDB
,sandboxPackageDBPath
,userPackageEnvironmentFile)
import Distribution.Client.Sandbox.Timestamp (maybeAddCompilerTimestampRecord)
import Distribution.Client.Sandbox.Types (UseSandbox(..), whenUsingSandbox)
......@@ -122,14 +119,11 @@ import Distribution.Simple.Configure
, ConfigStateFileErrorType(..), localBuildInfoFile
, getPersistBuildConfig, tryGetPersistBuildConfig )
import qualified Distribution.Simple.LocalBuildInfo as LBI
import Distribution.Simple.GHC (ghcGlobalPackageDB)
import Distribution.Simple.Program (defaultProgramConfiguration, lookupProgram, ghcProgram)
import Distribution.Simple.Program.Run (getEffectiveEnvironment)
import Distribution.Simple.Program (defaultProgramConfiguration)
import qualified Distribution.Simple.Setup as Cabal
import Distribution.Simple.Utils
( cabalVersion, debug, die, notice, info, topHandler
, findPackageDesc, tryFindPackageDesc , rawSystemExit
, rawSystemExitWithEnv )
( cabalVersion, die, notice, info, topHandler
, findPackageDesc, tryFindPackageDesc )
import Distribution.Text
( display )
import Distribution.Verbosity as Verbosity
......@@ -220,11 +214,9 @@ mainWorker args = topHandler $
,replCommand defaultProgramConfiguration
`commandAddAction` replAction
,sandboxCommand `commandAddAction` sandboxAction
,execCommand `commandAddAction` execAction
,haddockCommand `commandAddAction` haddockAction
,wrapperAction copyCommand
copyVerbosity copyDistPref
,wrapperAction haddockCommand
haddockVerbosity haddockDistPref
,wrapperAction cleanCommand
cleanVerbosity cleanDistPref
,wrapperAction hscolourCommand
......@@ -638,11 +630,14 @@ installAction (configFlags, configExFlags, installFlags, haddockFlags)
let sandboxDistPref = case useSandbox of
NoSandbox -> NoFlag
UseSandbox sandboxDir -> Flag $ sandboxBuildDir sandboxDir
configFlags' = savedConfigureFlags config `mappend` configFlags
configFlags' = maybeForceTests installFlags' $
savedConfigureFlags config `mappend` configFlags
configExFlags' = defaultConfigExFlags `mappend`
savedConfigureExFlags config `mappend` configExFlags
installFlags' = defaultInstallFlags `mappend`
savedInstallFlags config `mappend` installFlags
haddockFlags' = defaultHaddockFlags `mappend`
savedHaddockFlags config `mappend` haddockFlags
globalFlags' = savedGlobalFlags config `mappend` globalFlags
(comp, platform, conf) <- configCompilerAux' configFlags'
......@@ -677,9 +672,16 @@ installAction (configFlags, configExFlags, installFlags, haddockFlags)
comp platform conf
useSandbox mSandboxPkgInfo
globalFlags' configFlags'' configExFlags'
installFlags' haddockFlags
installFlags' haddockFlags'
targets
where
-- '--run-tests' implies '--enable-tests'.
maybeForceTests installFlags' configFlags' =
if fromFlagOrDefault False (installRunTests installFlags')
then configFlags' { configTests = toFlag True }
else configFlags'
testAction :: (TestFlags, BuildFlags, BuildExFlags) -> [String] -> GlobalFlags
-> IO ()
testAction (testFlags, buildFlags, buildExFlags) extraArgs globalFlags = do
......@@ -742,6 +744,20 @@ benchmarkAction (benchmarkFlags, buildFlags, buildExFlags)
setupWrapper verbosity setupOptions Nothing
Cabal.benchmarkCommand (const benchmarkFlags) extraArgs
haddockAction :: HaddockFlags -> [String] -> GlobalFlags -> IO ()
haddockAction haddockFlags extraArgs globalFlags = do
let verbosity = fromFlag (haddockVerbosity haddockFlags)
(_useSandbox, config) <- loadConfigOrSandboxConfig verbosity globalFlags mempty
let haddockFlags' = defaultHaddockFlags `mappend`
savedHaddockFlags config `mappend` haddockFlags
setupScriptOptions = defaultSetupScriptOptions {
useDistPref = fromFlagOrDefault
(useDistPref defaultSetupScriptOptions)
(haddockDistPref haddockFlags')
}
setupWrapper verbosity setupScriptOptions Nothing
haddockCommand (const haddockFlags') extraArgs
listAction :: ListFlags -> [String] -> GlobalFlags -> IO ()
listAction listFlags extraArgs globalFlags = do
let verbosity = fromFlag (listVerbosity listFlags)
......@@ -994,37 +1010,6 @@ 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) -> do
case useSandbox of
NoSandbox ->
rawSystemExit verbosity exec args
(UseSandbox sandboxDir) -> do
let configFlags = savedConfigureFlags config
(comp, platform, conf) <- configCompilerAux' configFlags
withSandboxBinDirOnSearchPath sandboxDir $ do
menv <- newEnv sandboxDir comp platform conf verbosity
case menv of
Just env -> rawSystemExitWithEnv verbosity exec args env
Nothing -> rawSystemExit verbosity exec args
-- Error handling.
[] -> die $ "Please specify an executable to run"
where
newEnv sandboxDir comp platform conf verbosity = do
let s = sandboxPackageDBPath sandboxDir comp platform
case lookupProgram ghcProgram conf of
Nothing -> do
debug verbosity "sandbox exec only works with GHC"
exitFailure
Just ghcProg -> do
g <- ghcGlobalPackageDB verbosity ghcProg
getEffectiveEnvironment [("GHC_PACKAGE_PATH", Just $ s ++ ":" ++ g)]
-- | 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