better method for running tasty's optparse as a subcommand

2 files changed, 27 insertions, 13 deletions

diff --git a/Test.hs b/Test.hs
index 2bcc5fcf4..762854f1f 100644
--- a/Test.hs
+++ b/Test.hs
@@ -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 =
diff --git a/Utility/SubTasty.hs b/Utility/SubTasty.hs
new file mode 100644
index 000000000..5164f9d1b
--- /dev/null
+++ b/Utility/SubTasty.hs
@@ -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"