Merge pull request #179 from n-osborne/quiet-flag

Add a quiet flag

CHANGES.md

@@ -1,5 +1,7 @@
 # Unreleased
 
+- Add a quiet flag
+  [\#179](https://github.com/ocaml-gospel/ortac/pull/179)
 - Check for out of scope variables
   [\#175](https://github.com/ocaml-gospel/ortac/pull/175)
 - Translate constant integer patterns with a guard testing for equality

bin/registration.ml

@@ -25,6 +25,9 @@ let output_file =
         ~doc:
           "Print the generated code in OUTPUT. Overwrite the file if it exists.")
 
+let quiet =
+  Arg.(value & flag & info [ "q"; "quiet" ] ~doc:"Don't print any warnings.")
+
 let ocaml_file =
   let parse s =
     match Sys.file_exists s with

bin/registration.mli

@@ -7,3 +7,4 @@ val get_out_formatter : string option -> Format.formatter
 val setup_log : unit Cmdliner.Term.t
 val output_file : string option Cmdliner.Term.t
 val ocaml_file : string Cmdliner.Term.t
+val quiet : bool Cmdliner.Term.t

plugins/qcheck-stm/src/ortac_qcheck_stm.ml

@@ -4,10 +4,10 @@ module Ir_of_gospel = Ir_of_gospel
 module Reserr = Reserr
 module Stm_of_ir = Stm_of_ir
 
-let main path init sut output () =
+let main path init sut output quiet () =
   let open Reserr in
   let fmt = Registration.get_out_formatter output in
-  let pp = pp Ppxlib_ast.Pprintast.structure fmt in
+  let pp = pp quiet Ppxlib_ast.Pprintast.structure fmt in
   pp
     (let* sigs, config = Config.init path init sut in
      let* ir = Ir_of_gospel.run sigs config in
@@ -40,7 +40,8 @@ end = struct
 
   let term =
     let open Registration in
-    Term.(const main $ ocaml_file $ init $ sut $ output_file $ setup_log)
+    Term.(
+      const main $ ocaml_file $ init $ sut $ output_file $ quiet $ setup_log)
 
   let cmd = Cmd.v info term
 end

plugins/qcheck-stm/src/reserr.ml

@@ -220,12 +220,13 @@ let pp_kind ppf kind =
 
 let pp_errors = W.pp_param pp_kind level |> Fmt.list
 
-let pp pp_ok ppf r =
+let pp quiet pp_ok ppf r =
   let open Fmt in
   match r with
   | Ok a, warns -> (
       pf ppf "%a@." pp_ok a;
-      match warns with [] -> () | warns -> pf stderr "%a@." pp_errors warns)
+      if not quiet then
+        match warns with [] -> () | warns -> pf stderr "%a@." pp_errors warns)
   | Error errs, warns -> pf stderr "%a@." pp_errors (errs @ warns)
 
 let sequence r =

plugins/qcheck-stm/src/reserr.mli

@@ -66,4 +66,4 @@ val fmap : ('a -> 'b) -> 'a reserr -> 'b reserr
 val ( <$> ) : ('a -> 'b) -> 'a reserr -> 'b reserr
 val app : ('a -> 'b) reserr -> 'a reserr -> 'b reserr
 val ( <*> ) : ('a -> 'b) reserr -> 'a reserr -> 'b reserr
-val pp : 'a Fmt.t -> 'a reserr Fmt.t
+val pp : bool -> 'a Fmt.t -> 'a reserr Fmt.t