You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
80 lines
2.5 KiB
80 lines
2.5 KiB
7 years ago
|
(* Copyright (c) 2018 - present Facebook, Inc. All rights reserved.
|
||
|
|
|
||
|
|
This source code is licensed under the BSD style license found in the
|
||
|
|
LICENSE file in the root directory of this source tree. An additional
|
||
|
|
grant of patent rights can be found in the PATENTS file in the same
|
||
|
|
directory. *)
|
||
|
|
|
||
|
|
(** Configuration options *)
|
||
|
|
|
||
|
|
(** Extension of Cmdliner supporting lighter-weight option definition *)
|
||
|
|
module Cmdliner : sig
|
||
|
|
include module type of Cmdliner
|
||
|
|
|
||
|
|
val mk : default:'a -> 'a Term.t -> 'a ref
|
||
|
|
(** [mk ~default term] is a ref which, after [parse] is called, contains
|
||
|
|
the value of the command line option specified by [term]. *)
|
||
|
|
|
||
|
|
val parse : Term.info -> (unit -> unit Term.ret) -> unit
|
||
|
|
(** [parse info validate] parses the command line according to the options
|
||
|
|
declared by calls to [mk], using manual and version [info], and
|
||
|
|
calling [validate] to check usage constraints not expressible in the
|
||
|
|
[Term] language. *)
|
||
|
|
end = struct
|
||
|
|
include Cmdliner
|
||
|
|
|
||
|
|
(** existential package of a Term and a setter for a ref to receive the
|
||
|
|
parsed value *)
|
||
|
|
type arg = Arg: 'a Term.t * ('a -> unit) -> arg
|
||
|
|
|
||
|
|
(** convert a list of arg packages to a term for the tuple of all the arg
|
||
|
|
terms, and apply it to a function that sets all the receiver refs *)
|
||
|
|
let tuple args =
|
||
|
|
let pair (Arg (trm_x, set_x)) (Arg (trm_y, set_y)) =
|
||
|
|
let trm_xy = Term.(const (fun a b -> (a, b)) $ trm_x $ trm_y) in
|
||
|
|
let set_xy (a, b) = set_x a ; set_y b in
|
||
|
|
Arg (trm_xy, set_xy)
|
||
|
|
in
|
||
|
|
let init = Arg (Term.const (), fun () -> ()) in
|
||
|
|
let Arg (trm, set) = List.fold_right ~f:pair args ~init in
|
||
|
|
Term.app (Term.const set) trm
|
||
|
|
|
||
|
|
let args : arg list ref = ref []
|
||
|
|
|
||
|
|
let mk ~default arg =
|
||
|
|
let var = ref default in
|
||
|
|
let set x = var := x in
|
||
|
|
args := Arg (arg, set) :: !args ;
|
||
|
|
var
|
||
|
|
|
||
|
|
let parse info validate =
|
||
|
|
match Term.eval (Term.(ret (const validate $ tuple !args)), info) with
|
||
|
|
| `Ok () -> ()
|
||
|
|
| `Error _ -> Caml.exit 1
|
||
|
|
| `Help | `Version -> Caml.exit 0
|
||
|
|
end
|
||
|
|
|
||
|
|
open Cmdliner
|
||
|
|
|
||
|
|
let input =
|
||
|
|
mk ~default:""
|
||
|
|
Arg.(required & pos ~rev:true 0 (some string) None & info [])
|
||
|
|
|
||
|
|
let output =
|
||
|
|
let default = None in
|
||
|
|
mk ~default Arg.(value & opt (some string) default & info ["o"; "output"])
|
||
|
|
|
||
|
|
let trace_all =
|
||
|
|
let default = false in
|
||
|
|
mk ~default Arg.(value & flag & info ["t"; "trace-all"])
|
||
|
|
|
||
|
|
let info = Term.info "sledge" ~version:Version.version
|
||
|
|
|
||
|
|
let validate () = `Ok ()
|
||
|
|
|
||
|
|
;; parse info validate
|
||
|
|
|
||
|
|
let run main =
|
||
|
|
Trace.init ~trace_all:!trace_all ;
|
||
|
|
main ~input:!input ~output:!output
|