rhi/idris2-tap
1
0
Fork 0
Code Issues 1 Pull requests Projects Releases Wiki Activity

take the usage info header as an argument

Browse source 
oops!
This commit is contained in:
rhiannon morris 2023-02-22 21:56:02 +01:00
parent 8428d0dd06
commit 4dba693a5f
1 changed files with 11 additions and 9 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

20
TAP/Options.idr
View file

@ -84,7 +84,8 @@ private
setFilter : String -> Mod setFilter : String -> Mod
setFilter str opts = pure $ {pattern := Just str} opts setFilter str opts = pure $ {pattern := Just str} opts
mutual parameters (header : String)
mutual
||| option descriptions ||| option descriptions
export export
opts : List (OptDescr Mod) opts : List (OptDescr Mod)
@ -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