structure Opts =
struct
  datatype 'a optDesc = BoolOpt of bool -> unit
                      | StringOpt of string -> unit

  structure StringMap = Map(type k = string val cmp = String.compare)

  fun error (msg : string) : 'a =
    (print msg ;
     OS.Process.exit (OS.Process.failure))

  fun boolFromString s =
    case s of
      "1" => true
    | "t" => true
    | "T" => true
    | "true" => true
    | "TRUE" => true
    | "True" => true
    | "0" => false
    | "f" => false
    | "F" => false
    | "false" => false
    | "FALSE" => false
    | "False" => false
    | _ => error "invalid boolean value"

  fun getOpt (desc : (string * 'a optDesc) list) : string list =
    let
      val parsers = StringMap.fromList desc
      fun go [] = []
        | go (arg :: args) =
            if arg = "-" orelse not (String.isPrefix "-" arg)
            then arg :: args
            else if arg = "--"
            then args
            else
              let
                val name =
                  if String.isPrefix "--" arg
                  then String.extract (arg, 2, NONE)
                  else String.extract (arg, 1, NONE)
                val _ =
                  if String.isPrefix "-" name orelse String.isPrefix "=" name
                  then error "bad flag syntax"
                  else ()
                (* It's a flag. Does it have an argument? *)
                val (name', value) =
                  case CharVector.findi (fn (_, x) => x = #"=") name of
                    SOME (i, _) => (substring (name, 0, i), String.extract (name, i + 1, NONE))
                  | NONE => (name, "")
                val parser =
                  case StringMap.lookup name' parsers of
                    SOME x => x
                  | NONE => error ("flag provided but not defined: " ^ String.toString name')
              in
                case parser of
                  BoolOpt func =>
                    if value = ""
                    then
                      (func true ;
                       go args)
                    else
                      (func (boolFromString value) ;
                       go args)
                | StringOpt func =>
                    (* It must have a value, which might be the next argument. *)
                    if value = "" andalso not (null args)
                    then
                      (func (hd args) ;
                       go (tl args))
                    else if value = ""
                    then error ("flag needs an argument: " ^ String.toString name')
                    else
                      (func value ;
                       go args)
              end
    in
      go (CommandLine.arguments ())
    end
end