Skip to content
GitLab
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
fb8914dd
Commit
fb8914dd
authored
Jun 29, 2014
by
Mikhail Glushenkov
Browse files
Merge pull request #1976 from benarmston/exec-refactor
Refactor exec command to use the ConfiguredProgram abstraction
parents
120011f2
92868c4e
Changes
12
Hide whitespace changes
Inline
Side-by-side
.gitignore
View file @
fb8914dd
...
...
@@ -5,6 +5,7 @@ cabal-dev/
Cabal/dist/
Cabal/tests/Setup
cabal-install/dist/
cabal-install/tests/PackageTests/*/dist/
.hpc/
*.hi
*.o
...
...
Cabal/Distribution/Simple/Program/Db.hs
View file @
fb8914dd
...
...
@@ -34,6 +34,7 @@ module Distribution.Simple.Program.Db (
knownPrograms
,
getProgramSearchPath
,
setProgramSearchPath
,
modifyProgramSearchPath
,
userSpecifyPath
,
userSpecifyPaths
,
userMaybeSpecifyPath
,
...
...
@@ -185,6 +186,16 @@ getProgramSearchPath = progSearchPath
setProgramSearchPath
::
ProgramSearchPath
->
ProgramDb
->
ProgramDb
setProgramSearchPath
searchpath
db
=
db
{
progSearchPath
=
searchpath
}
-- | Modify the current 'ProgramSearchPath' used by the 'ProgramDb'.
-- This will affect programs that are configured from here on, so you
-- should usually modify it before configuring any programs.
--
modifyProgramSearchPath
::
(
ProgramSearchPath
->
ProgramSearchPath
)
->
ProgramDb
->
ProgramDb
modifyProgramSearchPath
f
db
=
setProgramSearchPath
(
f
$
getProgramSearchPath
db
)
db
-- |User-specify this path. Basically override any path information
-- for this program in the configuration. If it's not a known
-- program ignore it.
...
...
cabal-install/Distribution/Client/Exec.hs
0 → 100644
View file @
fb8914dd
-----------------------------------------------------------------------------
-- |
-- Module : Distribution.Client.Exec
-- Maintainer : cabal-devel@haskell.org
-- Portability : portable
--
-- Implementation of the 'exec' command. Runs an arbitrary executable in an
-- environment suitable for making use of the sandbox.
-----------------------------------------------------------------------------
module
Distribution.Client.Exec
(
exec
)
where
import
Distribution.Client.Sandbox.PackageEnvironment
(
sandboxPackageDBPath
)
import
Distribution.Client.Sandbox.Types
(
UseSandbox
(
..
))
import
Distribution.Simple.Compiler
(
Compiler
)
import
Distribution.Simple.GHC
(
ghcGlobalPackageDB
)
import
Distribution.Simple.Program
(
ghcProgram
,
lookupProgram
)
import
Distribution.Simple.Program.Db
(
ProgramDb
,
requireProgram
,
modifyProgramSearchPath
)
import
Distribution.Simple.Program.Find
(
ProgramSearchPathEntry
(
..
))
import
Distribution.Simple.Program.Run
(
programInvocation
,
runProgramInvocation
)
import
Distribution.Simple.Program.Types
(
simpleProgram
,
ConfiguredProgram
(
..
)
)
import
Distribution.Simple.Utils
(
die
)
import
Distribution.System
(
Platform
)
import
Distribution.Verbosity
(
Verbosity
)
import
System.FilePath
(
searchPathSeparator
,
(
</>
))
import
Control.Applicative
((
<$>
))
import
Data.Traversable
as
T
-- | Execute the given command in the package's environment.
--
-- The given command is executed with GHC configured to use the correct
-- package database and with the sandbox bin directory added to the PATH.
exec
::
Verbosity
->
UseSandbox
->
Compiler
->
Platform
->
ProgramDb
->
[
String
]
->
IO
()
exec
verbosity
useSandbox
comp
platform
programDb
extraArgs
=
case
extraArgs
of
(
exe
:
args
)
->
do
program
<-
requireProgram'
verbosity
useSandbox
programDb
exe
env
<-
((
++
)
(
programOverrideEnv
program
))
<$>
environmentOverrides
let
invocation
=
programInvocation
program
{
programOverrideEnv
=
env
}
args
runProgramInvocation
verbosity
invocation
[]
->
die
"Please specify an executable to run"
where
environmentOverrides
=
case
useSandbox
of
NoSandbox
->
return
[]
(
UseSandbox
sandboxDir
)
->
sandboxEnvironment
verbosity
sandboxDir
comp
platform
programDb
-- | Return the package's sandbox environment.
--
-- The environment sets GHC_PACKAGE_PATH so that GHC will use the sandbox.
sandboxEnvironment
::
Verbosity
->
FilePath
->
Compiler
->
Platform
->
ProgramDb
->
IO
[(
String
,
Maybe
String
)]
sandboxEnvironment
verbosity
sandboxDir
comp
platform
programDb
=
do
mGlobalPackageDb
<-
T
.
sequence
$
ghcGlobalPackageDB
verbosity
<$>
lookupProgram
ghcProgram
programDb
case
mGlobalPackageDb
of
Nothing
->
die
"exec only works with GHC"
Just
gDb
->
return
$
overrides
gDb
where
overrides
gDb
=
[
(
"GHC_PACKAGE_PATH"
,
ghcPackagePath
gDb
)
]
ghcPackagePath
gDb
=
let
s
=
sandboxPackageDBPath
sandboxDir
comp
platform
in
Just
$
prependToSearchPath
gDb
s
prependToSearchPath
path
newValue
=
newValue
++
[
searchPathSeparator
]
++
path
-- | Check that a program is configured and available to be run. If
-- a sandbox is available check in the sandbox's directory.
requireProgram'
::
Verbosity
->
UseSandbox
->
ProgramDb
->
String
->
IO
ConfiguredProgram
requireProgram'
verbosity
useSandbox
programDb
exe
=
do
(
program
,
_
)
<-
requireProgram
verbosity
(
simpleProgram
exe
)
updateSearchPath
return
program
where
updateSearchPath
=
flip
modifyProgramSearchPath
programDb
$
\
searchPath
->
case
useSandbox
of
NoSandbox
->
searchPath
UseSandbox
sandboxDir
->
ProgramSearchPathDir
(
sandboxDir
</>
"bin"
)
:
searchPath
cabal-install/Distribution/Client/Setup.hs
View file @
fb8914dd
...
...
@@ -1650,8 +1650,27 @@ defaultExecFlags = ExecFlags {
execCommand
::
CommandUI
ExecFlags
execCommand
=
CommandUI
{
commandName
=
"exec"
,
commandSynopsis
=
"Run a command with the cabal environment"
,
commandDescription
=
Nothing
,
commandSynopsis
=
"Execute a command in the context of the package"
,
commandDescription
=
Just
$
\
pname
->
"Execute the given command making the package's installed dependencies
\n
"
++
"available to GHC. When a sandbox is being used, this causes GHC to
\n
"
++
"use the sandbox package database as if it had been invoked directly
\n
"
++
"by cabal. If a sandbox is not being used, GHC is not affected.
\n\n
"
++
"Any cabal executable packages installed into either the user package
\n
"
++
"database or into the current package's sandbox (if there is a current
\n
"
++
"package and sandbox) are available on PATH.
\n\n
"
++
"Examples:
\n
"
++
" Install the executable package pandoc into a sandbox and run it:
\n
"
++
" "
++
pname
++
" sandbox init
\n
"
++
" "
++
pname
++
" install pandoc
\n
"
++
" "
++
pname
++
" exec pandoc foo.md
\n\n
"
++
" Install the executable package hlint into the user package database
\n
"
++
" and run it:
\n
"
++
" "
++
pname
++
" install --user hlint
\n
"
++
" "
++
pname
++
" exec hlint Foo.hs
\n\n
"
++
" Execute runghc on Foo.hs with runghc configured to use the
\n
"
++
" sandbox package database (if a sandbox is being used):
\n
"
++
" "
++
pname
++
" exec runghc Foo.hs
\n
"
,
commandUsage
=
\
pname
->
"Usage: "
++
pname
++
" exec [FLAGS] COMMAND [-- [ARGS...]]
\n\n
"
++
"Flags for exec:"
,
...
...
cabal-install/Main.hs
View file @
fb8914dd
...
...
@@ -65,6 +65,7 @@ import qualified Distribution.Client.List as List
import
Distribution.Client.Install
(
install
)
import
Distribution.Client.Configure
(
configure
)
import
Distribution.Client.Update
(
update
)
import
Distribution.Client.Exec
(
exec
)
import
Distribution.Client.Fetch
(
fetch
)
import
Distribution.Client.Freeze
(
freeze
)
import
Distribution.Client.Check
as
Check
(
check
)
...
...
@@ -80,7 +81,6 @@ import Distribution.Client.Sandbox (sandboxInit
,
sandboxListSources
,
sandboxHcPkg
,
dumpPackageEnvironment
,
withSandboxBinDirOnSearchPath
,
getSandboxConfigFilePath
,
loadConfigOrSandboxConfig
...
...
@@ -97,7 +97,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
)
...
...
@@ -127,14 +126,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
...
...
@@ -145,7 +141,7 @@ import qualified Paths_cabal_install (version)
import
System.Environment
(
getArgs
,
getProgName
)
import
System.Exit
(
exitFailure
)
import
System.FilePath
(
splitExtension
,
takeExtension
,
searchPathSeparator
)
import
System.FilePath
(
splitExtension
,
takeExtension
)
import
System.IO
(
BufferMode
(
LineBuffering
),
hSetBuffering
#
ifdef
mingw32_HOST_OS
,
stderr
...
...
@@ -1062,32 +1058,9 @@ 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
++
[
searchPathSeparator
]
++
g
)]
let
configFlags
=
savedConfigureFlags
config
(
comp
,
platform
,
conf
)
<-
configCompilerAux'
configFlags
exec
verbosity
useSandbox
comp
platform
conf
extraArgs
-- | See 'Distribution.Client.Install.withWin32SelfUpgrade' for details.
--
...
...
cabal-install/cabal-install.cabal
View file @
fb8914dd
...
...
@@ -73,6 +73,7 @@ executable cabal
Distribution.Client.Dependency.Modular.Tree
Distribution.Client.Dependency.Modular.Validate
Distribution.Client.Dependency.Modular.Version
Distribution.Client.Exec
Distribution.Client.Fetch
Distribution.Client.FetchUtils
Distribution.Client.Freeze
...
...
@@ -212,6 +213,7 @@ test-suite package-tests
hs-source-dirs: tests
main-is: PackageTests.hs
other-modules:
PackageTests.Exec.Check
PackageTests.Freeze.Check
PackageTests.PackageTester
build-depends:
...
...
cabal-install/tests/PackageTests.hs
View file @
fb8914dd
...
...
@@ -7,6 +7,7 @@ module Main
where
-- Modules from Cabal.
import
Distribution.Simple.Program.Builtin
(
ghcPkgProgram
)
import
Distribution.Simple.Program.Db
(
defaultProgramDb
,
requireProgram
)
import
Distribution.Simple.Program.Types
(
Program
(
..
),
simpleProgram
,
programPath
)
...
...
@@ -19,13 +20,15 @@ import System.Directory (getCurrentDirectory, setCurrentDirectory)
import
Test.Framework
(
Test
,
defaultMain
,
testGroup
)
-- Modules containing the tests.
import
qualified
PackageTests.Exec.Check
import
qualified
PackageTests.Freeze.Check
-- List of tests to run. Each test will be called with the path to the
-- cabal binary to use.
tests
::
[
FilePath
->
Test
]
tests
=
[
testGroup
"Freeze"
.
PackageTests
.
Freeze
.
Check
.
tests
tests
::
FilePath
->
FilePath
->
[
Test
]
tests
cabalPath
ghcPkgPath
=
[
testGroup
"Freeze"
$
PackageTests
.
Freeze
.
Check
.
tests
cabalPath
,
testGroup
"Exec"
$
PackageTests
.
Exec
.
Check
.
tests
cabalPath
ghcPkgPath
]
cabalProgram
::
Program
...
...
@@ -36,12 +39,15 @@ cabalProgram = (simpleProgram "cabal") {
main
::
IO
()
main
=
do
(
cabal
,
_
)
<-
requireProgram
normal
cabalProgram
defaultProgramDb
(
ghcPkg
,
_
)
<-
requireProgram
normal
ghcPkgProgram
defaultProgramDb
let
cabalPath
=
programPath
cabal
ghcPkgPath
=
programPath
ghcPkg
putStrLn
$
"Using cabal: "
++
cabalPath
putStrLn
$
"Using ghc-pkg: "
++
ghcPkgPath
cwd
<-
getCurrentDirectory
let
runTests
=
do
setCurrentDirectory
"tests"
defaultMain
(
map
(
$
cabalPath
)
tests
)
defaultMain
$
tests
cabalPath
ghcPkgPath
-- Change back to the old working directory so that the tests can be
-- repeatedly run in `cabal repl` via `:main`.
runTests
`
E
.
finally
`
setCurrentDirectory
cwd
cabal-install/tests/PackageTests/Exec/Check.hs
0 → 100644
View file @
fb8914dd
module
PackageTests.Exec.Check
(
tests
)
where
import
PackageTests.PackageTester
import
Test.Framework
as
TF
(
Test
)
import
Test.Framework.Providers.HUnit
(
testCase
)
import
Test.HUnit
(
assertBool
)
import
Control.Applicative
((
<$>
))
import
Data.List
(
intercalate
,
isInfixOf
)
import
System.FilePath
((
</>
))
dir
::
FilePath
dir
=
"PackageTests"
</>
"Exec"
tests
::
FilePath
->
FilePath
->
[
TF
.
Test
]
tests
cabalPath
ghcPkgPath
=
[
testCase
"exits with failure if given no argument"
$
do
result
<-
cabal_exec
dir
[]
cabalPath
assertExecFailed
result
,
testCase
"prints error message if given no argument"
$
do
result
<-
cabal_exec
dir
[]
cabalPath
assertExecFailed
result
let
output
=
outputText
result
expected
=
"specify an executable to run"
errMsg
=
"should have requested an executable be specified
\n
"
++
output
assertBool
errMsg
$
expected
`
isInfixOf
`
(
intercalate
" "
.
lines
$
output
)
,
testCase
"runs the given command"
$
do
result
<-
cabal_exec
dir
[
"echo"
,
"this"
,
"string"
]
cabalPath
assertExecSucceeded
result
let
output
=
outputText
result
expected
=
"this string"
errMsg
=
"should have ran the given command
\n
"
++
output
assertBool
errMsg
$
expected
`
isInfixOf
`
(
intercalate
" "
.
lines
$
output
)
,
testCase
"can run executables installed in the sandbox"
$
do
-- Test that an executable installed into the sandbox can be found.
-- We do this by removing any existing sandbox. Checking that the
-- executable cannot be found. Creating a new sandbox. Installing
-- the executable and checking it can be run.
_
<-
assertCleanSucceeded
<$>
cabal_clean
dir
[]
cabalPath
_
<-
assertSandboxSucceeded
<$>
cabal_sandbox
dir
[
"delete"
]
cabalPath
assertMyExecutableNotFound
cabalPath
_
<-
assertSandboxSucceeded
<$>
cabal_sandbox
dir
[
"init"
]
cabalPath
_
<-
assertInstallSucceeded
<$>
cabal_install
dir
[]
cabalPath
result
<-
cabal_exec
dir
[
"my-executable"
]
cabalPath
assertExecSucceeded
result
let
output
=
outputText
result
expected
=
"This is my-executable"
errMsg
=
"should have found a my-executable
\n
"
++
output
assertBool
errMsg
$
expected
`
isInfixOf
`
(
intercalate
" "
.
lines
$
output
)
,
testCase
"adds the sandbox bin directory to the PATH"
$
do
_
<-
assertCleanSucceeded
<$>
cabal_clean
dir
[]
cabalPath
_
<-
assertSandboxSucceeded
<$>
cabal_sandbox
dir
[
"delete"
]
cabalPath
assertMyExecutableNotFound
cabalPath
_
<-
assertSandboxSucceeded
<$>
cabal_sandbox
dir
[
"init"
]
cabalPath
_
<-
assertInstallSucceeded
<$>
cabal_install
dir
[]
cabalPath
result
<-
cabal_exec
dir
[
"bash"
,
"--"
,
"-c"
,
"my-executable"
]
cabalPath
assertExecSucceeded
result
let
output
=
outputText
result
expected
=
"This is my-executable"
errMsg
=
"should have found a my-executable
\n
"
++
output
assertBool
errMsg
$
expected
`
isInfixOf
`
(
intercalate
" "
.
lines
$
output
)
,
testCase
"configures GHC to use the sandbox"
$
do
let
libNameAndVersion
=
"my-0.1"
_
<-
assertCleanSucceeded
<$>
cabal_clean
dir
[]
cabalPath
_
<-
assertSandboxSucceeded
<$>
cabal_sandbox
dir
[
"delete"
]
cabalPath
_
<-
assertSandboxSucceeded
<$>
cabal_sandbox
dir
[
"init"
]
cabalPath
_
<-
assertInstallSucceeded
<$>
cabal_install
dir
[]
cabalPath
assertMyLibIsNotAvailableOutsideofSandbox
ghcPkgPath
libNameAndVersion
result
<-
cabal_exec
dir
[
"ghc-pkg"
,
"list"
]
cabalPath
assertExecSucceeded
result
let
output
=
outputText
result
errMsg
=
"my library should have been found"
assertBool
errMsg
$
libNameAndVersion
`
isInfixOf
`
(
intercalate
" "
.
lines
$
output
)
-- , testCase "can find executables built from the package" $ do
-- , testCase "configures cabal to use the sandbox" $ do
]
assertMyExecutableNotFound
::
FilePath
->
IO
()
assertMyExecutableNotFound
cabalPath
=
do
result
<-
cabal_exec
dir
[
"my-executable"
]
cabalPath
assertExecFailed
result
let
output
=
outputText
result
expected
=
"cabal: The program 'my-executable' is required but it "
++
"could not be found"
errMsg
=
"should not have found a my-executable
\n
"
++
output
assertBool
errMsg
$
expected
`
isInfixOf
`
(
intercalate
" "
.
lines
$
output
)
assertMyLibIsNotAvailableOutsideofSandbox
::
FilePath
->
String
->
IO
()
assertMyLibIsNotAvailableOutsideofSandbox
ghcPkgPath
libNameAndVersion
=
do
(
_
,
_
,
output
)
<-
run
(
Just
$
dir
)
ghcPkgPath
[
"list"
]
assertBool
"my library should not have been found"
$
not
$
libNameAndVersion
`
isInfixOf
`
(
intercalate
" "
.
lines
$
output
)
cabal-install/tests/PackageTests/Exec/Foo.hs
0 → 100644
View file @
fb8914dd
module
Foo
where
foo
::
String
foo
=
"foo"
cabal-install/tests/PackageTests/Exec/My.hs
0 → 100644
View file @
fb8914dd
module
Main
where
main
::
IO
()
main
=
do
putStrLn
"This is my-executable"
cabal-install/tests/PackageTests/Exec/my.cabal
0 → 100644
View file @
fb8914dd
name: my
version: 0.1
license: BSD3
cabal-version: >= 1.2
build-type: Simple
library
exposed-modules: Foo
build-depends: base
executable my-executable
main-is: My.hs
build-depends: base
cabal-install/tests/PackageTests/PackageTester.hs
View file @
fb8914dd
...
...
@@ -20,14 +20,24 @@ module PackageTests.PackageTester
(
Result
(
..
)
-- * Running cabal commands
,
cabal_clean
,
cabal_exec
,
cabal_freeze
,
cabal_install
,
cabal_sandbox
,
run
-- * Test helpers
,
assertCleanSucceeded
,
assertExecFailed
,
assertExecSucceeded
,
assertFreezeSucceeded
,
assertInstallSucceeded
,
assertSandboxSucceeded
)
where
import
qualified
Control.Exception.Extensible
as
E
import
Control.Monad
(
unless
)
import
Control.Monad
(
when
,
unless
)
import
Data.Maybe
(
fromMaybe
)
import
System.Directory
(
canonicalizePath
,
doesFileExist
)
import
System.Environment
(
getEnv
)
...
...
@@ -47,10 +57,13 @@ import Distribution.Verbosity (Verbosity, flagToVerbosity, normal)
data
Success
=
Failure
-- | ConfigureSuccess
-- | BuildSuccess
-- | InstallSuccess
-- | TestSuccess
-- | BenchSuccess
|
CleanSuccess
|
ExecSuccess
|
FreezeSuccess
|
InstallSuccess
|
SandboxSuccess
deriving
(
Eq
,
Show
)
data
Result
=
Result
...
...
@@ -75,12 +88,36 @@ recordRun (cmd, exitCode, exeOutput) thisSucc res =
cmd
++
"
\n
"
++
exeOutput
}
-- | Run the clean command and return its result.
cabal_clean
::
FilePath
->
[
String
]
->
FilePath
->
IO
Result
cabal_clean
dir
args
cabalPath
=
do
res
<-
cabal
dir
([
"clean"
]
++
args
)
cabalPath
return
$
recordRun
res
CleanSuccess
nullResult
-- | Run the exec command and return its result.
cabal_exec
::
FilePath
->
[
String
]
->
FilePath
->
IO
Result
cabal_exec
dir
args
cabalPath
=
do
res
<-
cabal
dir
([
"exec"
]
++
args
)
cabalPath
return
$
recordRun
res
ExecSuccess
nullResult
-- | Run the freeze command and return its result.
cabal_freeze
::
FilePath
->
[
String
]
->
FilePath
->
IO
Result
cabal_freeze
dir
args
cabalPath
=
do
res
<-
cabal
dir
([
"freeze"
]
++
args
)
cabalPath
return
$
recordRun
res
FreezeSuccess
nullResult
-- | Run the install command and return its result.
cabal_install
::
FilePath
->
[
String
]
->
FilePath
->
IO
Result
cabal_install
dir
args
cabalPath
=
do
res
<-
cabal
dir
([
"install"
]
++
args
)
cabalPath
return
$
recordRun
res
InstallSuccess
nullResult
-- | Run the sandbox command and return its result.
cabal_sandbox
::
FilePath
->
[
String
]
->
FilePath
->
IO
Result
cabal_sandbox
dir
args
cabalPath
=
do
res
<-
cabal
dir
([
"sandbox"
]
++
args
)
cabalPath
return
$
recordRun
res
SandboxSuccess
nullResult
-- | Returns the command that was issued, the return code, and the output text.
cabal
::
FilePath
->
[
String
]
->
FilePath
->
IO
(
String
,
ExitCode
,
String
)
cabal
dir
cabalArgs
cabalPath
=
do
...
...
@@ -118,12 +155,42 @@ run cwd path args = do
------------------------------------------------------------------------
-- * Test helpers
assertCleanSucceeded
::
Result
->
Assertion
assertCleanSucceeded
result
=
unless
(
successful
result
)
$
assertFailure
$
"expected:
\'
cabal clean
\'
should succeed
\n
"
++
" output: "
++
outputText
result
assertExecSucceeded
::
Result
->
Assertion
assertExecSucceeded
result
=
unless
(
successful
result
)
$
assertFailure
$
"expected:
\'
cabal exec
\'
should succeed
\n
"
++
" output: "
++
outputText
result
assertExecFailed
::
Result
->
Assertion
assertExecFailed
result
=
when
(
successful
result
)
$
assertFailure
$
"expected:
\'
cabal exec
\'
should fail
\n
"
++
" output: "
++
outputText
result
assertFreezeSucceeded
::
Result
->
Assertion
assertFreezeSucceeded
result
=
unless
(
successful
result
)
$
assertFailure
$
"expected:
\'
cabal freeze
\'
should succeed
\n
"
++
" output: "
++
outputText
result
assertInstallSucceeded
::
Result
->
Assertion
assertInstallSucceeded
result
=
unless
(
successful
result
)
$
assertFailure
$
"expected:
\'
cabal install
\'
should succeed
\n
"
++
" output: "
++
outputText
result
assertSandboxSucceeded
::
Result
->
Assertion
assertSandboxSucceeded
result
=
unless
(
successful
result
)
$
assertFailure
$
"expected:
\'
cabal sandbox
\'
should succeed
\n
"
++
" output: "
++
outputText
result
------------------------------------------------------------------------
-- Verbosity
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new 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