better method for running tasty's optparse as a subcommand

This commit is contained in:
Joey Hess 2015-07-08 00:38:27 -04:00
parent 0a3541a8d5
commit 4018e5f6f1
2 changed files with 27 additions and 13 deletions

15
Test.hs
View file

@ -15,12 +15,12 @@ import Test.Tasty.HUnit
import Test.Tasty.QuickCheck
import Test.Tasty.Ingredients.Rerun
import Options.Applicative hiding (command)
import qualified Data.Map as M
import qualified Text.JSON
import Common
import qualified Utility.SubTasty
import qualified Utility.SafeCommand
import qualified Annex
import qualified Annex.UUID
@ -83,11 +83,7 @@ import qualified Utility.Gpg
main :: [String] -> IO ()
main ps = do
-- Can't use tasty's defaultMain because one of the command line
-- parameters is "test".
let pinfo = info (helper <*> suiteOptionParser ingredients tests)
( fullDesc <> header "Builtin test suite" )
opts <- parseOpts (prefs idm) pinfo ps
opts <- Utility.SubTasty.parseOpts "test" ingredients tests ("test":ps)
case tryIngredients ingredients opts tests of
Nothing -> error "No tests found!?"
Just act -> ifM act
@ -97,13 +93,6 @@ main ps = do
putStrLn " with utilities, such as git, installed on this system.)"
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 =

25
Utility/SubTasty.hs Normal file
View 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"