quox/tests/Options.idr

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