114 lines
2.6 KiB
Idris
114 lines
2.6 KiB
Idris
module Options
|
|
|
|
import Data.String
|
|
import System
|
|
import System.Console.GetOpt
|
|
|
|
%default total
|
|
|
|
|
|
public export
|
|
data TAPVersion = V13 | V14
|
|
|
|
export
|
|
readVersion : String -> Maybe TAPVersion
|
|
readVersion "13" = Just V13
|
|
readVersion "14" = Just V14
|
|
readVersion _ = Nothing
|
|
|
|
export Show TAPVersion where show V13 = "13"; show V14 = "14"
|
|
|
|
|
|
public export
|
|
record Options where
|
|
constructor Opts
|
|
version : TAPVersion
|
|
pattern : Maybe String
|
|
color : Bool
|
|
|
|
export
|
|
defaultOpts : Options
|
|
defaultOpts = Opts {
|
|
version = V13,
|
|
pattern = Nothing,
|
|
color = False
|
|
}
|
|
|
|
public export
|
|
Mod : Type
|
|
Mod = Options -> IO Options
|
|
|
|
|
|
export
|
|
failureWith : List String -> IO a
|
|
failureWith msgs = do
|
|
traverse_ (\s => putStrLn "# \{s}") msgs
|
|
putStrLn "\nBail out!"
|
|
exitFailure
|
|
|
|
private
|
|
setTapVer : String -> Mod
|
|
setTapVer ver opts =
|
|
case readVersion ver of
|
|
Just v => pure $ {version := v} opts
|
|
Nothing => failureWith ["unrecognised TAP version '\{ver}'"]
|
|
|
|
private
|
|
setPat : String -> Mod
|
|
setPat str opts = pure $ {pattern := Just str} opts
|
|
|
|
mutual
|
|
export
|
|
opts : List (OptDescr Mod)
|
|
opts =
|
|
[ MkOpt {
|
|
description = "show this help",
|
|
shortNames = ['h', '?'], longNames = ["help"],
|
|
argDescr = NoArg $ const $ failureWith usage
|
|
},
|
|
MkOpt {
|
|
description = "TAP version to output (13 or 14, default 13)",
|
|
shortNames = ['V'], longNames = ["version"],
|
|
argDescr = ReqArg setTapVer "VERSION"
|
|
},
|
|
MkOpt {
|
|
description = "only run tests containing STR in their group or label",
|
|
shortNames = ['F'], longNames = ["filter"],
|
|
argDescr = ReqArg setPat "STR"
|
|
},
|
|
MkOpt {
|
|
description = "don't colour-code results (default)",
|
|
shortNames = ['C'], longNames = ["no-color", "no-colour"],
|
|
argDescr = NoArg $ pure . {color := False}
|
|
},
|
|
MkOpt {
|
|
description = "colour-code results (not TAP compliant)",
|
|
shortNames = ['c'], longNames = ["color", "colour"],
|
|
argDescr = NoArg $ pure . {color := True}
|
|
}
|
|
]
|
|
|
|
export
|
|
usage : List String
|
|
usage = assert_total $ "quox test suite" :: lines (usageInfo "" opts)
|
|
|
|
|
|
export
|
|
makeOpts : List Mod -> IO Options
|
|
makeOpts = foldlM (\x, f => f x) defaultOpts
|
|
|
|
|
|
export
|
|
getArgs1 : IO (List String)
|
|
getArgs1 =
|
|
case !getArgs of
|
|
_ :: args => pure args
|
|
[] => failureWith ["expected getArgs to start with exe name"]
|
|
|
|
export
|
|
getTestOpts : IO Options
|
|
getTestOpts =
|
|
case getOpt Permute opts !getArgs1 of
|
|
MkResult opts [] [] [] => makeOpts opts
|
|
res => failureWith $ res.errors ++ usage
|