Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
Packages
Cabal
Commits
99d912d3
Commit
99d912d3
authored
Jan 11, 2014
by
etrepum
Committed by
tibbe
Apr 12, 2014
Browse files
Add cabal exec
parent
fdf8afce
Changes
4
Hide whitespace changes
Inline
Side-by-side
Cabal/Distribution/Simple/GHC.hs
View file @
99d912d3
...
...
@@ -44,6 +44,7 @@ module Distribution.Simple.GHC (
componentGhcOptions
,
ghcLibDir
,
ghcDynamic
,
ghcGlobalPackageDB
,
)
where
import
qualified
Distribution.Simple.GHC.IPI641
as
IPI641
...
...
@@ -549,6 +550,13 @@ 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
...
...
cabal-install/Distribution/Client/Sandbox/PackageEnvironment.hs
View file @
99d912d3
...
...
@@ -19,6 +19,7 @@ module Distribution.Client.Sandbox.PackageEnvironment (
,
showPackageEnvironment
,
showPackageEnvironmentWithComments
,
setPackageDB
,
sandboxPackageDBPath
,
loadUserConfig
,
basePackageEnvironment
...
...
@@ -210,14 +211,23 @@ 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
$
sandbox
Dir
</>
(
Text
.
display
platform
++
"-"
++
showCompilerId
compiler
++
"-packages.conf.d"
)
)]
configPackageDBs
=
[
Just
(
SpecificPackageDB
$
sandbox
PackageDBPath
sandboxDir
compiler
platform
)]
}
-- | Almost the same as 'savedConf `mappend` pkgEnv', but some settings are
...
...
cabal-install/Distribution/Client/Setup.hs
View file @
99d912d3
...
...
@@ -34,6 +34,7 @@ module Distribution.Client.Setup
,
sdistCommand
,
SDistFlags
(
..
),
SDistExFlags
(
..
),
ArchiveFormat
(
..
)
,
win32SelfUpgradeCommand
,
Win32SelfUpgradeFlags
(
..
)
,
sandboxCommand
,
defaultSandboxLocation
,
SandboxFlags
(
..
)
,
execCommand
,
ExecFlags
(
..
)
,
parsePackageArgs
--TODO: stop exporting these:
...
...
@@ -1602,6 +1603,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 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
-- ------------------------------------------------------------
...
...
cabal-install/Main.hs
View file @
99d912d3
...
...
@@ -36,10 +36,11 @@ import Distribution.Client.Setup
,
SDistFlags
(
..
),
SDistExFlags
(
..
),
sdistCommand
,
Win32SelfUpgradeFlags
(
..
),
win32SelfUpgradeCommand
,
SandboxFlags
(
..
),
sandboxCommand
,
ExecFlags
(
..
),
execCommand
,
reportCommand
)
import
Distribution.Simple.Setup
(
HaddockFlags
(
..
),
haddockCommand
,
defaultHaddockFlags
(
HaddockFlags
(
..
),
haddockCommand
,
HscolourFlags
(
..
),
hscolourCommand
,
ReplFlags
(
..
),
replCommand
,
CopyFlags
(
..
),
copyCommand
...
...
@@ -77,6 +78,7 @@ import Distribution.Client.Sandbox (sandboxInit
,
sandboxListSources
,
sandboxHcPkg
,
dumpPackageEnvironment
,
withSandboxBinDirOnSearchPath
,
getSandboxConfigFilePath
,
loadConfigOrSandboxConfig
...
...
@@ -93,6 +95,7 @@ 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
)
...
...
@@ -119,11 +122,14 @@ import Distribution.Simple.Configure
,
ConfigStateFileErrorType
(
..
),
localBuildInfoFile
,
getPersistBuildConfig
,
tryGetPersistBuildConfig
)
import
qualified
Distribution.Simple.LocalBuildInfo
as
LBI
import
Distribution.Simple.Program
(
defaultProgramConfiguration
)
import
Distribution.Simple.GHC
(
ghcGlobalPackageDB
)
import
Distribution.Simple.Program
(
defaultProgramConfiguration
,
lookupProgram
,
ghcProgram
)
import
Distribution.Simple.Program.Run
(
getEffectiveEnvironment
)
import
qualified
Distribution.Simple.Setup
as
Cabal
import
Distribution.Simple.Utils
(
cabalVersion
,
die
,
notice
,
info
,
topHandler
,
findPackageDesc
,
tryFindPackageDesc
)
(
cabalVersion
,
debug
,
die
,
notice
,
info
,
topHandler
,
findPackageDesc
,
tryFindPackageDesc
,
rawSystemExit
,
rawSystemExitWithEnv
)
import
Distribution.Text
(
display
)
import
Distribution.Verbosity
as
Verbosity
...
...
@@ -214,9 +220,11 @@ mainWorker args = topHandler $
,
replCommand
defaultProgramConfiguration
`
commandAddAction
`
replAction
,
sandboxCommand
`
commandAddAction
`
sandboxAction
,
haddock
Command
`
commandAddAction
`
haddock
Action
,
exec
Command
`
commandAddAction
`
exec
Action
,
wrapperAction
copyCommand
copyVerbosity
copyDistPref
,
wrapperAction
haddockCommand
haddockVerbosity
haddockDistPref
,
wrapperAction
cleanCommand
cleanVerbosity
cleanDistPref
,
wrapperAction
hscolourCommand
...
...
@@ -630,14 +638,11 @@ installAction (configFlags, configExFlags, installFlags, haddockFlags)
let
sandboxDistPref
=
case
useSandbox
of
NoSandbox
->
NoFlag
UseSandbox
sandboxDir
->
Flag
$
sandboxBuildDir
sandboxDir
configFlags'
=
maybeForceTests
installFlags'
$
savedConfigureFlags
config
`
mappend
`
configFlags
configFlags'
=
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'
...
...
@@ -672,16 +677,9 @@ 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
...
...
@@ -744,20 +742,6 @@ 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
)
...
...
@@ -1010,6 +994,37 @@ 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
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment