diff options
| author |  Joey Hess <joeyh@joeyh.name> | 2015-07-13 13:19:20 -0400 |
|---|---|---|
| committer | Joey Hess <joeyh@joeyh.name> | 2015-07-13 13:20:10 -0400 |
| commit | 52cfabcd567a3b15c8217edce752f3a3c59ca5ce (patch) | |
| tree | f0512188b4e56640fcceeec0dddb9c754ed23783 /Command/Test.hs | |
| parent | 8e9ddfe41e73662be5c7fd0ebc6432a52b1dd227 (diff) | |
wire tasty's option parser into the main program option parser
This makes bash completion work for git-annex test, and is
generally cleaner.
Diffstat (limited to 'Command/Test.hs')
| -rw-r--r-- | Command/Test.hs | 40 |
1 files changed, 16 insertions, 24 deletions
diff --git a/Command/Test.hs b/Command/Test.hs index 57a9b16d3..35d6e1504 100644 --- a/Command/Test.hs +++ b/Command/Test.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2013 Joey Hess <id@joeyh.name> + - Copyright 2013-2015 Joey Hess <id@joeyh.name> - - Licensed under the GNU GPL version 3 or higher. -} @@ -10,31 +10,23 @@ module Command.Test where import Common import Command import Messages +import Types.Test -cmd :: Command -cmd = noRepo (parseparams startIO) $ dontCheck repoExists $ - command "test" SectionTesting - "run built-in test suite" - paramNothing (parseparams seek) - where - parseparams = withParams +cmd :: Parser TestOptions -> Maybe TestRunner -> Command +cmd optparser runner = noRepo (startIO runner <$$> const optparser) $ + dontCheck repoExists $ + command "test" SectionTesting + "run built-in test suite" + paramNothing (seek runner <$$> const optparser) -seek :: CmdParams -> CommandSeek -seek = withWords start +seek :: Maybe TestRunner -> TestOptions -> CommandSeek +seek runner o = commandAction $ start runner o -{- We don't actually run the test suite here because of a dependency loop. - - The main program notices when the command is test and runs it; this - - function is never run if that works. - - - - However, if git-annex is built without the test suite, just print a - - warning, and do not exit nonzero. This is so git-annex test can be run - - in debian/rules despite some architectures not being able to build the - - test suite. - -} -start :: [String] -> CommandStart -start ps = do - liftIO $ startIO ps +start :: Maybe TestRunner -> TestOptions -> CommandStart +start runner o = do + liftIO $ startIO runner o stop -startIO :: CmdParams -> IO () -startIO _ = warningIO "git-annex was built without its test suite; not testing" +startIO :: Maybe TestRunner -> TestOptions -> IO () +startIO Nothing _ = warningIO "git-annex was built without its test suite; not testing" +startIO (Just runner) o = runner o |