support TAP 13 for /usr/bin/prove's benefit

13 doesn't support test trees so we gotta flatten it >:(

tests/Makefile

@@ -8,10 +8,18 @@ depends/quox: lib
 	mkdir -p depends
 	ln -sf ../../build/ttc depends/quox
 
-.PHONY: test
+.PHONY: build-tests
-test: depends/quox
+build-tests: depends/quox
 	idris2 --build tests.ipkg
-	build/exec/quox-tests
+
+.PHONY: test
+test: build-tests
+	build/exec/quox-tests -V 14
+
+.PHONY: prove
+prove: build-tests
+	prove build/exec/quox-tests
+
 
 .PHONY: clean
 clean:

tests/Options.idr

@@ -0,0 +1,40 @@
+module Options
+
+import Data.String
+import System
+import System.Console.GetOpt
+
+
+public export
+record Options where
+  constructor Opts
+  tapVersion : String
+
+defaultOpts = Opts {tapVersion = "13"}
+
+OptMod = Options -> Options
+
+opts : List (OptDescr OptMod)
+opts = [
+  MkOpt ['V'] ["version"]
+    (ReqArg (\v => the OptMod {tapVersion := v}) "VERSION")
+    "TAP version to output (13 or 14, default 13)"
+]
+-- [todo] get rid of "the OptMod" when type inference is better, maybe
+
+makeOpts : List OptMod -> Options
+makeOpts = foldl (flip ($)) defaultOpts
+
+
+getArgs1 : IO (List String)
+getArgs1 =
+  case !getArgs of
+       _ :: args => pure args
+       []        => die "expecting getArgs to start with exe name"
+
+export
+getTestOpts : IO Options
+getTestOpts =
+  case getOpt Permute opts !getArgs1 of
+       MkResult opts [] [] [] => pure $ makeOpts opts
+       res => die $ unlines $ res.errors ++ [usageInfo "quox test suite" opts]

tests/TAP.idr

@@ -116,6 +116,31 @@ export %inline
 header : List a -> String
 header tests = "1..\{show $ length tests}"
 
+makePrefix : SnocList String -> String
+makePrefix [<]       = ""
+makePrefix (xs :< x) = foldr (\a, b => "\{a}/\{b}") x xs
+
+withPrefix : SnocList String -> TestBase -> Test
+withPrefix pfx b = One $ {label := "[\{makePrefix pfx}] \{b.label}"} b
+
+mutual
+  export
+  flattenWith : SnocList String -> List Test -> List Test
+  flattenWith pfx = concatMap (flatten1With pfx)
+
+  export
+  flatten1With : SnocList String -> Test -> List Test
+  flatten1With pfx (One   t)    = [withPrefix pfx t]
+  flatten1With pfx (Group x ts) = flattenWith (pfx :< x) ts
+
+export
+flatten : List Test -> List Test
+flatten = flattenWith [<]
+
+export
+flatten1 : Test -> List Test
+flatten1 = flatten1With [<]
+
 
 private
 Runner : Type -> Type
@@ -174,9 +199,17 @@ mutual
 
 
 export
-run : List Test -> IO ExitCode
+run : (ver : Nat) -> List Test -> IO ExitCode
-run tests = do
+run ver tests = do
-  putStrLn "TAP version 14"
+  putStrLn "TAP version \{show ver}"
   pure $ if !(runReaderT 0 $ runList tests)
             then ExitSuccess
             else ExitFailure 70
+
+export
+main : List Test -> IO ()
+main tests = exitWith !(run 14 tests)
+
+export
+mainFlat : List Test -> IO ()
+mainFlat tests = exitWith !(run 13 $ flatten tests)

tests/Tests.idr

@@ -1,11 +1,18 @@
 module Tests
 
-import Tests.Equal
+import Options
-
 import TAP
-
+import Tests.Lexer
+import Tests.Equal
 import System
 
-export main : IO Int
+
-main = exitWith =<< run
+allTests = [Equal.tests]
-  [Equal.tests]
+
+main = do
+  opts <- getTestOpts
+  go <- case opts.tapVersion of
+    "13" => pure TAP.mainFlat
+    "14" => pure TAP.main
+    _    => die "unrecognised TAP version; use 13 or 14"
+  go allTests