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.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
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"