take the usage info header as an argument
oops!
This commit is contained in:
parent
8428d0dd06
commit
4dba693a5f
1 changed files with 11 additions and 9 deletions
|
@ -84,6 +84,7 @@ private
|
||||||
setFilter : String -> Mod
|
setFilter : String -> Mod
|
||||||
setFilter str opts = pure $ {pattern := Just str} opts
|
setFilter str opts = pure $ {pattern := Just str} opts
|
||||||
|
|
||||||
|
parameters (header : String)
|
||||||
mutual
|
mutual
|
||||||
||| option descriptions
|
||| option descriptions
|
||||||
export
|
export
|
||||||
|
@ -119,7 +120,7 @@ mutual
|
||||||
||| usage message
|
||| usage message
|
||||||
export
|
export
|
||||||
usage : List String
|
usage : List String
|
||||||
usage = assert_total $ "quox test suite" :: lines (usageInfo "" opts)
|
usage = assert_total $ header :: lines (usageInfo "" opts)
|
||||||
|
|
||||||
|
|
||||||
||| interpret the result of `getOpt`
|
||| interpret the result of `getOpt`
|
||||||
|
@ -137,19 +138,20 @@ getArgs1 =
|
||||||
[] => failureWith ["expected getArgs to start with exe name"]
|
[] => failureWith ["expected getArgs to start with exe name"]
|
||||||
|
|
||||||
|
|
||||||
||| read & interpret the command line arguments
|
||| read & interpret the command line arguments.
|
||||||
|
||| the first argument is the header to print on the usage message.
|
||||||
|||
|
|||
|
||||||
||| [todo] allow unrecognised things and pass them back out
|
||| [todo] allow unrecognised things and pass them back out
|
||||||
export
|
export
|
||||||
getTestOpts' : List String -> IO Options
|
getTestOpts' : String -> List String -> IO Options
|
||||||
getTestOpts' args =
|
getTestOpts' header args =
|
||||||
case getOpt Permute opts args of
|
case getOpt Permute (opts header) args of
|
||||||
MkResult opts [] [] [] => makeOpts opts
|
MkResult opts [] [] [] => makeOpts opts
|
||||||
res => failureWith $ res.errors ++ usage
|
res => failureWith $ res.errors ++ usage header
|
||||||
|
|
||||||
||| interpret some command line arguments passed in
|
||| interpret some command line arguments passed in
|
||||||
|||
|
|||
|
||||||
||| [todo] allow unrecognised things and pass them back out
|
||| [todo] allow unrecognised things and pass them back out
|
||||||
export
|
export
|
||||||
getTestOpts : IO Options
|
getTestOpts : String -> IO Options
|
||||||
getTestOpts = getTestOpts' !getArgs1
|
getTestOpts header = getTestOpts' header !getArgs1
|
||||||
|
|
Loading…
Reference in a new issue