quox/tests/Options.idr

114 lines
2.6 KiB
Idris
Raw Normal View History

module Options
import Data.String
import System
import System.Console.GetOpt
2022-05-24 06:09:17 -04:00
%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
2022-05-24 06:09:17 -04:00
version : TAPVersion
pattern : Maybe String
color : Bool
export
defaultOpts : Options
defaultOpts = Opts {
version = V13,
pattern = Nothing,
color = False
}
2022-05-24 06:09:17 -04:00
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}'"]
2022-05-24 06:09:17 -04:00
private
setPat : String -> Mod
setPat str opts = pure $ {pattern := Just str} opts
2022-05-24 06:09:17 -04:00
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}
}
]
2022-05-24 06:09:17 -04:00
export
usage : List String
usage = assert_total $ "quox test suite" :: lines (usageInfo "" opts)
2022-05-24 06:09:17 -04:00
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
2022-05-24 06:09:17 -04:00
[] => failureWith ["expected getArgs to start with exe name"]
export
getTestOpts : IO Options
getTestOpts =
case getOpt Permute opts !getArgs1 of
2022-05-24 06:09:17 -04:00
MkResult opts [] [] [] => makeOpts opts
res => failureWith $ res.errors ++ usage