better method for running tasty's optparse as a subcommand
This commit is contained in:
parent
0a3541a8d5
commit
4018e5f6f1
2 changed files with 27 additions and 13 deletions
15
Test.hs
15
Test.hs
|
@ -15,12 +15,12 @@ import Test.Tasty.HUnit
|
||||||
import Test.Tasty.QuickCheck
|
import Test.Tasty.QuickCheck
|
||||||
import Test.Tasty.Ingredients.Rerun
|
import Test.Tasty.Ingredients.Rerun
|
||||||
|
|
||||||
import Options.Applicative hiding (command)
|
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
import qualified Text.JSON
|
import qualified Text.JSON
|
||||||
|
|
||||||
import Common
|
import Common
|
||||||
|
|
||||||
|
import qualified Utility.SubTasty
|
||||||
import qualified Utility.SafeCommand
|
import qualified Utility.SafeCommand
|
||||||
import qualified Annex
|
import qualified Annex
|
||||||
import qualified Annex.UUID
|
import qualified Annex.UUID
|
||||||
|
@ -83,11 +83,7 @@ import qualified Utility.Gpg
|
||||||
|
|
||||||
main :: [String] -> IO ()
|
main :: [String] -> IO ()
|
||||||
main ps = do
|
main ps = do
|
||||||
-- Can't use tasty's defaultMain because one of the command line
|
opts <- Utility.SubTasty.parseOpts "test" ingredients tests ("test":ps)
|
||||||
-- parameters is "test".
|
|
||||||
let pinfo = info (helper <*> suiteOptionParser ingredients tests)
|
|
||||||
( fullDesc <> header "Builtin test suite" )
|
|
||||||
opts <- parseOpts (prefs idm) pinfo ps
|
|
||||||
case tryIngredients ingredients opts tests of
|
case tryIngredients ingredients opts tests of
|
||||||
Nothing -> error "No tests found!?"
|
Nothing -> error "No tests found!?"
|
||||||
Just act -> ifM act
|
Just act -> ifM act
|
||||||
|
@ -97,13 +93,6 @@ main ps = do
|
||||||
putStrLn " with utilities, such as git, installed on this system.)"
|
putStrLn " with utilities, such as git, installed on this system.)"
|
||||||
exitFailure
|
exitFailure
|
||||||
)
|
)
|
||||||
where
|
|
||||||
parseOpts pprefs pinfo args =
|
|
||||||
case execParserPure pprefs pinfo args of
|
|
||||||
(Options.Applicative.Failure failure) -> do
|
|
||||||
let (msg, _exit) = renderFailure failure "git-annex test"
|
|
||||||
error msg
|
|
||||||
v -> handleParseResult v
|
|
||||||
|
|
||||||
ingredients :: [Ingredient]
|
ingredients :: [Ingredient]
|
||||||
ingredients =
|
ingredients =
|
||||||
|
|
25
Utility/SubTasty.hs
Normal file
25
Utility/SubTasty.hs
Normal file
|
@ -0,0 +1,25 @@
|
||||||
|
{- Running tasty as a subcommand.
|
||||||
|
-
|
||||||
|
- Copyright 2015 Joey Hess <id@joeyh.name>
|
||||||
|
-
|
||||||
|
- License: BSD-2-clause
|
||||||
|
-}
|
||||||
|
|
||||||
|
module Utility.SubTasty where
|
||||||
|
|
||||||
|
import Test.Tasty
|
||||||
|
import Test.Tasty.Options
|
||||||
|
import Test.Tasty.Runners
|
||||||
|
import Options.Applicative
|
||||||
|
|
||||||
|
-- Uses tasty's option parser, modified to expect a subcommand.
|
||||||
|
parseOpts :: String -> [Ingredient] -> TestTree -> [String] -> IO OptionSet
|
||||||
|
parseOpts subcommand is ts =
|
||||||
|
handleParseResult . execParserPure (prefs idm) pinfo
|
||||||
|
where
|
||||||
|
pinfo = info (helper <*> subpinfo) (fullDesc <> header desc)
|
||||||
|
subpinfo = subparser $ command subcommand $
|
||||||
|
suiteOptionParser is ts
|
||||||
|
`info`
|
||||||
|
progDesc desc
|
||||||
|
desc = "Builtin test suite"
|
Loading…
Add table
Add a link
Reference in a new issue