Commit f2a8bdf4 authored by Duncan Coutts's avatar Duncan Coutts

Add initial templates for new run & bench commands

So far they just build the exe bench and don't do the next steps,
but they do at least select the right components to build.

Also bring the existing test command into sync with the others.
parent b07d0c95
{-# LANGUAGE NamedFieldPuns #-}
-- | cabal-install CLI command: bench
--
module Distribution.Client.CmdBench (
benchCommand,
benchAction,
) where
import Distribution.Client.ProjectOrchestration
import Distribution.Client.ProjectConfig
( BuildTimeSettings(..) )
import Distribution.Client.BuildTarget
( readUserBuildTargets )
import Distribution.Client.Setup
( GlobalFlags, ConfigFlags(..), ConfigExFlags, InstallFlags )
import qualified Distribution.Client.Setup as Client
import Distribution.Simple.Setup
( HaddockFlags, fromFlagOrDefault )
import Distribution.Simple.Command
( CommandUI(..), usageAlternatives )
import Distribution.Verbosity
( normal )
import Distribution.Simple.Utils
( wrapText, die' )
import qualified Data.Map as Map
import Control.Monad (when)
benchCommand :: CommandUI (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags)
benchCommand = Client.installCommand {
commandName = "new-bench",
commandSynopsis = "Run benchmarks",
commandUsage = usageAlternatives "new-bench" [ "[TARGETS] [FLAGS]" ],
commandDescription = Just $ \_ -> wrapText $
"Runs the specified benchmarks, first ensuring they are up to "
++ "date.\n\n"
++ "Any benchmark in any package in the project can be specified. "
++ "A package can be specified in which case all the benchmarks in the "
++ "package are run. The default is to run all the benchmarks in the "
++ "package in the current directory.\n\n"
++ "Dependencies are built or rebuilt as necessary. Additional "
++ "configuration flags can be specified on the command line and these "
++ "extend the project configuration from the 'cabal.project', "
++ "'cabal.project.local' and other files.",
commandNotes = Just $ \pname ->
"Examples:\n"
++ " " ++ pname ++ " new-bench\n"
++ " Run all the benchmarks in the package in the current directory\n"
++ " " ++ pname ++ " new-bench pkgname\n"
++ " Run all the benchmarks in the package named pkgname\n"
++ " " ++ pname ++ " new-bench cname\n"
++ " Run the benchmark named cname\n"
++ " " ++ pname ++ " new-bench cname -O2\n"
++ " Run the benchmark built with '-O2' (including local libs used)\n\n"
++ "Note: this command is part of the new project-based system (aka "
++ "nix-style\nlocal builds). These features are currently in beta. "
++ "Please see\n"
++ "http://cabal.readthedocs.io/en/latest/nix-local-build-overview.html "
++ "for\ndetails and advice on what you can expect to work. If you "
++ "encounter problems\nplease file issues at "
++ "https://github.com/haskell/cabal/issues and if you\nhave any time "
++ "to get involved and help with testing, fixing bugs etc then\nthat "
++ "is very much appreciated.\n"
}
-- | The @build@ command does a lot. It brings the install plan up to date,
-- selects that part of the plan needed by the given or implicit targets and
-- then executes the plan.
--
-- For more details on how this works, see the module
-- "Distribution.Client.ProjectOrchestration"
--
benchAction :: (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags)
-> [String] -> GlobalFlags -> IO ()
benchAction (configFlags, configExFlags, installFlags, haddockFlags)
targetStrings globalFlags = do
userTargets <- readUserBuildTargets verbosity targetStrings
buildCtx <-
runProjectPreBuildPhase
verbosity
( globalFlags, configFlags, configExFlags
, installFlags, haddockFlags )
PreBuildHooks {
hookPrePlanning = \_ _ _ -> return (),
hookSelectPlanSubset = \buildSettings' elaboratedPlan -> do
when (buildSettingOnlyDeps buildSettings') $
die' verbosity $
"The bench command does not support '--only-dependencies'. "
++ "You may wish to use 'build --only-dependencies' and then "
++ "use 'bench'."
-- Interpret the targets on the command line as bench targets
-- (as opposed to say build or haddock targets).
targets <- either reportBenchTargetProblems return
=<< resolveTargets
selectPackageTargets
selectComponentTarget
TargetProblemCommon
elaboratedPlan
userTargets
--TODO: [required eventually] handle no targets case
when (Map.null targets) $
fail "TODO handle no targets case"
let elaboratedPlan' = pruneInstallPlanToTargets
TargetActionBuild
targets
elaboratedPlan
return elaboratedPlan'
}
printPlan verbosity buildCtx
buildOutcomes <- runProjectBuildPhase verbosity buildCtx
runProjectPostBuildPhase verbosity buildCtx buildOutcomes
where
verbosity = fromFlagOrDefault normal (configVerbosity configFlags)
-- For bench: select all buildable benchmarks
-- Fail if there are no benchmarks or no buildable benchmarks.
--
selectPackageTargets :: BuildTarget PackageId
-> [AvailableTarget k] -> Either BenchTargetProblem [k]
selectPackageTargets _bt ts
| (_:_) <- benchts = Right benchts
| (_:_) <- allbenchts = Left (TargetPackageNoEnabledBenchmarks allbenchts')
| otherwise = Left (TargetPackageNoBenchmarks allbenchts')
where
allbenchts = [ t | t@(AvailableTarget (CBenchName _) _) <- ts ]
benchts = [ k | TargetBuildable k _
<- map availableTargetStatus allbenchts ]
allbenchts'= [ fmap (const ()) t | t <- allbenchts ]
selectComponentTarget :: BuildTarget PackageId
-> AvailableTarget k -> Either BenchTargetProblem k
selectComponentTarget bt t
| CBenchName _ <- availableTargetComponentName t
= either (Left . TargetProblemCommon) return $
selectComponentTargetBasic bt t
| otherwise
= Left (TargetComponentNotBenchmark (fmap (const ()) t))
data BenchTargetProblem =
TargetPackageNoEnabledBenchmarks [AvailableTarget ()]
| TargetPackageNoBenchmarks [AvailableTarget ()]
| TargetComponentNotBenchmark (AvailableTarget ())
| TargetProblemCommon TargetProblem
deriving Show
reportBenchTargetProblems :: [BenchTargetProblem] -> IO a
reportBenchTargetProblems = fail . show
{-# LANGUAGE NamedFieldPuns #-}
-- | cabal-install CLI command: run
--
module Distribution.Client.CmdRun (
runCommand,
runAction,
) where
import Distribution.Client.ProjectOrchestration
import Distribution.Client.ProjectConfig
( BuildTimeSettings(..) )
import Distribution.Client.BuildTarget
( readUserBuildTargets )
import Distribution.Client.Setup
( GlobalFlags, ConfigFlags(..), ConfigExFlags, InstallFlags )
import qualified Distribution.Client.Setup as Client
import Distribution.Simple.Setup
( HaddockFlags, fromFlagOrDefault )
import Distribution.Simple.Command
( CommandUI(..), usageAlternatives )
import Distribution.Verbosity
( normal )
import Distribution.Simple.Utils
( wrapText, die' )
import qualified Data.Map as Map
import Control.Monad (when)
runCommand :: CommandUI (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags)
runCommand = Client.installCommand {
commandName = "new-run",
commandSynopsis = "Run an executable.",
commandUsage = usageAlternatives "new-run"
[ "[TARGET] [FLAGS] [-- EXECUTABLE_FLAGS]" ],
commandDescription = Just $ \pname -> wrapText $
"Runs the specified executable, first ensuring it is up to date.\n\n"
++ "Any executable in any package in the project can be specified. "
++ "A package can be specified if contains just one executable. "
++ "The default is to use the package in the current directory if it "
++ "contains just one executable.\n\n"
++ "Extra arguments can be passed to the program, but use '--' to "
++ "separate arguments for the program from arguments for " ++ pname
++ ". The executable is run in an environment where it can find its "
++ "data files inplace in the build tree.\n\n"
++ "Dependencies are built or rebuilt as necessary. Additional "
++ "configuration flags can be specified on the command line and these "
++ "extend the project configuration from the 'cabal.project', "
++ "'cabal.project.local' and other files.",
commandNotes = Just $ \pname ->
"Examples:\n"
++ " " ++ pname ++ " new-run\n"
++ " Run the executable in the package in the current directory\n"
++ " " ++ pname ++ " new-run foo-tool\n"
++ " Run the named executable (in any package in the project)\n"
++ " " ++ pname ++ " new-run pkgfoo:foo-tool\n"
++ " Run the executable 'foo-tool' in the package 'pkgfoo'\n"
++ " " ++ pname ++ " new-run foo -O2 -- dothing --fooflag\n"
++ " Build with '-O2' and run the program, passing it extra arguments.\n\n"
++ "Note: this command is part of the new project-based system (aka "
++ "nix-style\nlocal builds). These features are currently in beta. "
++ "Please see\n"
++ "http://cabal.readthedocs.io/en/latest/nix-local-build-overview.html "
++ "for\ndetails and advice on what you can expect to work. If you "
++ "encounter problems\nplease file issues at "
++ "https://github.com/haskell/cabal/issues and if you\nhave any time "
++ "to get involved and help with testing, fixing bugs etc then\nthat "
++ "is very much appreciated.\n"
}
-- | The @build@ command does a lot. It brings the install plan up to date,
-- selects that part of the plan needed by the given or implicit targets and
-- then executes the plan.
--
-- For more details on how this works, see the module
-- "Distribution.Client.ProjectOrchestration"
--
runAction :: (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags)
-> [String] -> GlobalFlags -> IO ()
runAction (configFlags, configExFlags, installFlags, haddockFlags)
targetStrings globalFlags = do
userTargets <- readUserBuildTargets verbosity targetStrings
buildCtx <-
runProjectPreBuildPhase
verbosity
( globalFlags, configFlags, configExFlags
, installFlags, haddockFlags )
PreBuildHooks {
hookPrePlanning = \_ _ _ -> return (),
hookSelectPlanSubset = \buildSettings' elaboratedPlan -> do
when (buildSettingOnlyDeps buildSettings') $
die' verbosity $
"The repl command does not support '--only-dependencies'. "
++ "You may wish to use 'build --only-dependencies' and then "
++ "use 'repl'."
-- Interpret the targets on the command line as build targets
-- (as opposed to say repl or haddock targets).
targets <- either reportRunTargetProblems return
=<< resolveTargets
selectPackageTargets
selectComponentTarget
TargetProblemCommon
elaboratedPlan
userTargets
when (Map.size targets > 1) $
let problem = TargetsMultiple (Map.elems targets)
in reportRunTargetProblems [problem]
--TODO: [required eventually] handle no targets case
when (Map.null targets) $
fail "TODO handle no targets case"
let elaboratedPlan' = pruneInstallPlanToTargets
TargetActionBuild
targets
elaboratedPlan
return elaboratedPlan'
}
printPlan verbosity buildCtx
buildOutcomes <- runProjectBuildPhase verbosity buildCtx
runProjectPostBuildPhase verbosity buildCtx buildOutcomes
where
verbosity = fromFlagOrDefault normal (configVerbosity configFlags)
-- For run: select the exe if there is only one and it's buildable.
-- Fail if there are no or multiple buildable exe components.
--
selectPackageTargets :: BuildTarget PackageId
-> [AvailableTarget k] -> Either RunTargetProblem [k]
selectPackageTargets _bt ts
| [exet] <- exets = Right [exet]
| (_:_) <- exets = Left TargetPackageMultipleExes
| (_:_) <- allexets = Left TargetPackageNoBuildableExes
| otherwise = Left TargetPackageNoTargets
where
allexets = [ t | t@(AvailableTarget (CExeName _) _) <- ts ]
exets = [ k | TargetBuildable k _ <- map availableTargetStatus allexets ]
selectComponentTarget :: BuildTarget PackageId
-> AvailableTarget k -> Either RunTargetProblem k
selectComponentTarget bt t
| CExeName _ <- availableTargetComponentName t
= either (Left . TargetProblemCommon) return $
selectComponentTargetBasic bt t
| otherwise
= Left (TargetComponentNotExe (fmap (const ()) t))
data RunTargetProblem =
TargetPackageMultipleExes
| TargetPackageNoBuildableExes
| TargetPackageNoTargets
| TargetComponentNotExe (AvailableTarget ())
| TargetProblemCommon TargetProblem
| TargetsMultiple [[ComponentTarget]] --TODO: more detail needed
deriving Show
reportRunTargetProblems :: [RunTargetProblem] -> IO a
reportRunTargetProblems = fail . show
{-# LANGUAGE NamedFieldPuns #-}
-- | cabal-install CLI command: new-test
-- | cabal-install CLI command: test
--
module Distribution.Client.CmdTest (
testCommand,
......@@ -8,36 +8,71 @@ module Distribution.Client.CmdTest (
) where
import Distribution.Client.ProjectOrchestration
import Distribution.Client.ProjectConfig
( BuildTimeSettings(..) )
import Distribution.Client.BuildTarget
( readUserBuildTargets )
import Distribution.Client.Setup
( GlobalFlags, ConfigFlags(..), ConfigExFlags, InstallFlags )
import qualified Distribution.Client.Setup as Client
import Distribution.Simple.Setup
( HaddockFlags, fromFlagOrDefault )
import Distribution.Verbosity
( normal )
import Distribution.Simple.Command
( CommandUI(..), usageAlternatives )
import Distribution.Verbosity
( normal )
import Distribution.Simple.Utils
( wrapText )
import qualified Distribution.Client.Setup as Client
( wrapText, die' )
import qualified Data.Map as Map
import Control.Monad (when)
testCommand :: CommandUI (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags)
testCommand = Client.installCommand {
commandName = "new-test",
commandSynopsis = "Perform new-build and run tests",
commandUsage = usageAlternatives "new-test" [ "[FLAGS] TARGET" ],
commandSynopsis = "Run test-suites",
commandUsage = usageAlternatives "new-test" [ "[TARGETS] [FLAGS]" ],
commandDescription = Just $ \_ -> wrapText $
"Build and run test targets",
commandNotes = Just $ \_pname ->
"Runs the specified test-suites, first ensuring they are up to "
++ "date.\n\n"
++ "Any test-suite in any package in the project can be specified. "
++ "A package can be specified in which case all the test-suites in the "
++ "package are run. The default is to run all the test-suites in the "
++ "package in the current directory.\n\n"
++ "Dependencies are built or rebuilt as necessary. Additional "
++ "configuration flags can be specified on the command line and these "
++ "extend the project configuration from the 'cabal.project', "
++ "'cabal.project.local' and other files.",
commandNotes = Just $ \pname ->
"Examples:\n"
++ " " ++ pname ++ " new-test\n"
++ " Run all the test-suites in the package in the current directory\n"
++ " " ++ pname ++ " new-test pkgname\n"
++ " Run all the test-suites in the package named pkgname\n"
++ " " ++ pname ++ " new-test cname\n"
++ " Run the test-suite named cname\n"
++ " " ++ pname ++ " new-test cname --enable-coverage\n"
++ " Run the test-suite built with code coverage (including local libs used)\n\n"
++ "Note: this command is part of the new project-based system (aka "
++ "nix-style\nlocal builds). These features are currently in beta. "
++ "Please see\n"
++ "http://cabal.readthedocs.io/en/latest/nix-local-build-overview.html "
++ "for\ndetails and advice on what you can expect to work. If you "
++ "encounter problems\nplease file issues at "
++ "https://github.com/haskell/cabal/issues and if you\nhave any time "
++ "to get involved and help with testing, fixing bugs etc then\nthat "
++ "is very much appreciated.\n"
}
-- | The @test@ command is very much like @build@. It brings the install plan
-- up to date, selects that part of the plan needed by the given or implicit
-- test arget(s) and then executes the plan.
-- test target(s) and then executes the plan.
--
-- Compared to @build@ the difference is that there's also test targets
-- which are ephemeral.
......@@ -46,7 +81,7 @@ testCommand = Client.installCommand {
-- "Distribution.Client.ProjectOrchestration"
--
testAction :: (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags)
-> [String] -> GlobalFlags -> IO ()
-> [String] -> GlobalFlags -> IO ()
testAction (configFlags, configExFlags, installFlags, haddockFlags)
targetStrings globalFlags = do
......@@ -60,7 +95,13 @@ testAction (configFlags, configExFlags, installFlags, haddockFlags)
PreBuildHooks {
hookPrePlanning = \_ _ _ -> return (),
hookSelectPlanSubset = \_buildSettings elaboratedPlan -> do
hookSelectPlanSubset = \buildSettings' elaboratedPlan -> do
when (buildSettingOnlyDeps buildSettings') $
die' verbosity $
"The test command does not support '--only-dependencies'. "
++ "You may wish to use 'build --only-dependencies' and then "
++ "use 'test'."
-- Interpret the targets on the command line as test targets
-- (as opposed to say build or haddock targets).
targets <- either reportTestTargetProblems return
......@@ -70,6 +111,11 @@ testAction (configFlags, configExFlags, installFlags, haddockFlags)
TargetProblemCommon
elaboratedPlan
userTargets
--TODO: [required eventually] handle no targets case
when (Map.null targets) $
fail "TODO handle no targets case"
let elaboratedPlan' = pruneInstallPlanToTargets
TargetActionTest
targets
......@@ -117,4 +163,3 @@ data TestTargetProblem =
reportTestTargetProblems :: [TestTargetProblem] -> IO a
reportTestTargetProblems = fail . show
......@@ -182,6 +182,9 @@ globalCommand commands = CommandUI {
, "new-configure"
, "new-repl"
, "new-freeze"
, "new-run"
, "new-test"
, "new-bench"
, "new-haddock"
]
maxlen = maximum $ [length name | (name, _) <- cmdDescs]
......@@ -244,6 +247,9 @@ globalCommand commands = CommandUI {
, addCmd "new-build"
, addCmd "new-configure"
, addCmd "new-repl"
, addCmd "new-run"
, addCmd "new-test"
, addCmd "new-bench"
, addCmd "new-freeze"
, addCmd "new-haddock"
] ++ if null otherCmds then [] else par
......
......@@ -228,12 +228,14 @@ library
Distribution.Client.BuildReports.Types
Distribution.Client.BuildReports.Upload
Distribution.Client.Check
Distribution.Client.CmdBench
Distribution.Client.CmdBuild
Distribution.Client.CmdConfigure
Distribution.Client.CmdFreeze
Distribution.Client.CmdHaddock
Distribution.Client.CmdTest
Distribution.Client.CmdRepl
Distribution.Client.CmdRun
Distribution.Client.CmdTest
Distribution.Client.Config
Distribution.Client.Configure
Distribution.Client.Dependency
......
......@@ -74,12 +74,14 @@ import Distribution.Client.Targets
import qualified Distribution.Client.List as List
( list, info )
import qualified Distribution.Client.CmdBuild as CmdBuild
import qualified Distribution.Client.CmdConfigure as CmdConfigure
import qualified Distribution.Client.CmdBuild as CmdBuild
import qualified Distribution.Client.CmdRepl as CmdRepl
import qualified Distribution.Client.CmdFreeze as CmdFreeze
import qualified Distribution.Client.CmdHaddock as CmdHaddock
import qualified Distribution.Client.CmdRepl as CmdRepl
import qualified Distribution.Client.CmdRun as CmdRun
import qualified Distribution.Client.CmdTest as CmdTest
import qualified Distribution.Client.CmdBench as CmdBench
import Distribution.Client.Install (install)
import Distribution.Client.Configure (configure, writeConfigFlags)
......@@ -292,6 +294,9 @@ mainWorker args = topHandler $
, hiddenCmd CmdTest.testCommand CmdTest.testAction
, regularCmd CmdFreeze.freezeCommand CmdFreeze.freezeAction
, regularCmd CmdHaddock.haddockCommand CmdHaddock.haddockAction
, regularCmd CmdRun.runCommand CmdRun.runAction
, regularCmd CmdTest.testCommand CmdTest.testAction
, regularCmd CmdBench.benchCommand CmdBench.benchAction
]
type Action = GlobalFlags -> IO ()
......
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