Merge pull request #172 from psafont/cmdliner

BREAKING CHANGE: Use nondeprecated cmdliner types in interface

.github/workflows/test.yml

@@ -10,7 +10,7 @@ jobs:
       matrix:
         # windows-latest async does not support it for now
         operating-system: [macos-latest, ubuntu-latest]
-        ocaml-version: [ '4.12.0', '4.11.1', '4.10.1', '4.09.1', '4.08.1' ]
+        ocaml-version: [ '4.14.0', '4.08.1' ]
     steps:
     - uses: actions/checkout@master
     - name: Setup Python
@@ -26,22 +26,14 @@ jobs:
         key: ${{ runner.os }}-pip
         restore-keys: |
           ${{ runner.os }}-
-    - name: Install dependencies
+    - name: Install Python dependencies
       run: pip install pylint pycodestyle
-    - name: OCaml GitHub Action
-      uses: avsm/setup-ocaml@v1
+    - name: Install OCaml
+      uses: ocaml/setup-ocaml@v2
       with:
-        ocaml-version: ${{ matrix.ocaml-version }}
-    - name: Pin Packages
-      run: |
-        opam pin add rpclib.dev -n .
-        opam pin add rpclib-js.dev -n .
-        opam pin add rpclib-html.dev -n .
-        opam pin add rpclib-lwt.dev -n .
-        opam pin add rpclib-async.dev -n .
-        opam pin add ppx_deriving_rpc.dev -n .
-    - name: Dependencies
-      run: opam install -t rpclib rpclib-js rpclib-html rpclib-lwt rpclib-async ppx_deriving_rpc --deps-only
+        ocaml-compiler: ${{ matrix.ocaml-version }}
+    - name: Install OCaml dependencies
+      run: opam install -t . --deps-only
     - name: Build and test independently
       run: opam install -t rpclib rpclib-js rpclib-html rpclib-lwt rpclib-async ppx_deriving_rpc
     - name: Run Rpc Tests

CHANGES.md

@@ -1,3 +1,6 @@
+## 9.0.0 (June 2022)
+* Breaking: change Cmdlinergen to use non-deprecated types (psafont #172)
+
 ## 8.1.2 (February 2022)
 * Add the `noargs` constructor for declaring interfaces that do not take any 
   parameters. (tbrk #170)

example/example2_client.ml

@@ -26,26 +26,25 @@ let binary_rpc path (call : Rpc.call) : Rpc.response =
   in
   response
 
-
-let default_cmd =
-  let doc = "a cli for an API" in
-  ( Cmdliner.Term.(ret (const (fun _ -> `Help (`Pager, None)) $ const ()))
-  , Cmdliner.Term.info "cli" ~version:"1.6.1" ~doc )
-
-
 let server_cmd =
   let doc = "Start the server" in
-  ( Cmdliner.Term.(const Example2_server.start_server $ const ())
-  , Cmdliner.Term.info "server" ~doc )
+  Cmdliner.(Cmd.v
+   (Cmd.info "server" ~doc )
+   (Term.(const Example2_server.start_server $ const ())))
 
 
 let cli () =
+  let default =
+    Cmdliner.Term.(ret (const (fun _ -> `Help (`Pager, None)) $ const ()))
+  in
+  let info = Cmdliner.Cmd.info "cli" ~version:"1.6.1" ~doc:"a cli for an API" in
   let rpc = binary_rpc Example2_idl.sockpath in
-  Cmdliner.Term.eval_choice
-    default_cmd
-    (server_cmd
+  let cmds = server_cmd
     :: List.map
          (fun t ->
            let term, info = t rpc in
-           Cmdliner.Term.(term $ const ()), info)
-         (Cmds.implementation ()))
+           Cmdliner.(Cmd.v info Term.(term $ const ())))
+         (Cmds.implementation ())
+  in
+  let cmd = Cmdliner.Cmd.group ~default info cmds in
+  exit (Cmdliner.Cmd.eval cmd)

example/example3_client.ml

@@ -51,16 +51,9 @@ let generate_md () =
   ()
 *)
 
-let default_cmd =
-  let doc = "a cli for an API" in
-  ( Cmdliner.Term.(ret (const (fun _ -> `Help (`Pager, None)) $ const ()))
-  , Cmdliner.Term.info "cli" ~version:"1.6.1" ~doc )
-
-
 let generate_md_cmd =
   let doc = "Generate Markdown for the interfaces" in
-  Cmdliner.Term.(const generate_md $ const ()), Cmdliner.Term.info "markdown" ~doc
-
+  Cmdliner.(Cmd.v (Cmd.info "markdown" ~doc) Term.(const generate_md $ const ()))
 
 (*let generate_md_cmd =
   let doc = "Generate Python for the interfaces" in
@@ -97,14 +90,20 @@ let binary_rpc path (call : Rpc.call) : Rpc.response =
 
 let cli () =
   let rpc = binary_rpc "path" in
-  Cmdliner.Term.eval_choice
-    default_cmd
-    (generate_md_cmd
+  let default = Cmdliner.Term.(ret (const (fun _ -> `Help (`Pager, None)) $ const ())) in
+  let info = 
+    let doc = "a cli for an API" in
+    Cmdliner.Cmd.info "cli" ~version:"1.6.1" ~doc
+  in
+  let cmds = generate_md_cmd
     :: List.map
          (fun t ->
            let term, info = t rpc in
-           Cmdliner.Term.(term $ const ()), info)
-         (PCmds.implementation () @ DCmds.implementation ()))
+           Cmdliner.(Cmd.v info (Term.(term $ const ()))))
+         (PCmds.implementation () @ DCmds.implementation ())
+  in
+  let cmd = Cmdliner.Cmd.group ~default info cmds in 
+  exit (Cmdliner.Cmd.eval cmd)
 
 
 let _ = cli ()

rpclib.opam

@@ -8,11 +8,11 @@ doc: "https://mirage.github.io/ocaml-rpc/rpclib"
 bug-reports: "https://github.com/mirage/ocaml-rpc/issues"
 license: "ISC"
 depends: [
-  "ocaml" {>= "4.04.0"}
+  "ocaml" {>= "4.08.0"}
   "alcotest" {with-test}
   "dune" {>= "2.0.0"}
   "base64" {>= "3.4.0"}
-  "cmdliner" {>= "0.9.8"}
+  "cmdliner" {>= "1.1.0"}
   "rresult" {>= "0.3.0"}
   "result" {>= "1.5"}
   "xmlm"

src/lib/cmdlinergen.ml

@@ -3,7 +3,7 @@ open Idl
 module Gen () = struct
   type implementation =
     unit
-    -> ((Rpc.call -> Rpc.response) -> (unit -> unit) Cmdliner.Term.t * Cmdliner.Term.info)
+    -> ((Rpc.call -> Rpc.response) -> (unit -> unit) Cmdliner.Term.t * Cmdliner.Cmd.info)
        list
 
   type ('a, 'b) comp = ('a, 'b) Result.t
@@ -50,60 +50,60 @@ module Gen () = struct
     match p.Param.typedef.Rpc.Types.ty with
     | Basic Int ->
       Term.app
-        (Term.pure Rpc.rpc_of_int64)
+        (Term.const Rpc.rpc_of_int64)
         Cmdliner.Arg.(required & pos (incr ()) (some int64) None & pinfo)
     | Basic Int32 ->
       Term.app
-        (Term.pure Rpc.rpc_of_int64)
+        (Term.const Rpc.rpc_of_int64)
         Cmdliner.Arg.(required & pos (incr ()) (some int64) None & pinfo)
     | Basic Int64 ->
       Term.app
-        (Term.pure Rpc.rpc_of_int64)
+        (Term.const Rpc.rpc_of_int64)
         Cmdliner.Arg.(required & pos (incr ()) (some int64) None & pinfo)
     | Basic String ->
       Term.app
-        (Term.pure Rpc.rpc_of_string)
+        (Term.const Rpc.rpc_of_string)
         Cmdliner.Arg.(required & pos (incr ()) (some string) None & pinfo)
     | Basic Bool ->
       Term.app
-        (Term.pure Rpc.rpc_of_bool)
+        (Term.const Rpc.rpc_of_bool)
         Cmdliner.Arg.(required & pos (incr ()) (some bool) None & pinfo)
     | Basic Float ->
       Term.app
-        (Term.pure Rpc.rpc_of_float)
+        (Term.const Rpc.rpc_of_float)
         Cmdliner.Arg.(required & pos (incr ()) (some float) None & pinfo)
     | Basic Char ->
       Term.app
-        (Term.pure (fun s -> Rpc.rpc_of_char s.[0]))
+        (Term.const (fun s -> Rpc.rpc_of_char s.[0]))
         Cmdliner.Arg.(required & pos (incr ()) (some string) None & pinfo)
     | Unit -> Term.(const Rpc.Null)
     | DateTime ->
       Term.app
-        (Term.pure Rpc.rpc_of_dateTime)
+        (Term.const Rpc.rpc_of_dateTime)
         Cmdliner.Arg.(required & pos (incr ()) (some string) None & pinfo)
     | Base64 ->
       Term.app
-        (Term.pure Rpc.rpc_of_base64)
+        (Term.const Rpc.rpc_of_base64)
         Cmdliner.Arg.(required & pos (incr ()) (some string) None & pinfo)
     | Array _ ->
       Term.app
-        (Term.pure (fun x ->
+        (Term.const (fun x ->
              let x = Jsonrpc.of_string x in
              match x with
              | Rpc.Enum _ -> x
              | _ -> failwith "Type error"))
         Cmdliner.Arg.(required & pos (incr ()) (some string) None & pinfo)
     | List _ ->
       Term.app
-        (Term.pure (fun x ->
+        (Term.const (fun x ->
              let x = Jsonrpc.of_string x in
              match x with
              | Rpc.Enum _ -> x
              | _ -> failwith "Type error"))
         Cmdliner.Arg.(required & pos (incr ()) (some string) None & pinfo)
     | Dict _ ->
       Term.app
-        (Term.pure (fun x ->
+        (Term.const (fun x ->
              let x = Jsonrpc.of_string x in
              match x with
              | Rpc.Dict _ -> x
@@ -115,23 +115,23 @@ module Gen () = struct
     | Tuple4 _ -> Term.const Rpc.Null
     | Struct _ ->
       Term.app
-        (Term.pure (fun x ->
+        (Term.const (fun x ->
              let x = Jsonrpc.of_string x in
              match x with
              | Rpc.Dict _ -> x
              | _ -> failwith "Type error"))
         Cmdliner.Arg.(required & pos (incr ()) (some string) None & pinfo)
     | Variant _ ->
       Term.app
-        (Term.pure (fun x ->
+        (Term.const (fun x ->
              let x = Jsonrpc.of_string x in
              match x with
              | Rpc.Enum _ | Rpc.String _ -> x
              | _ -> failwith "Type error"))
         Cmdliner.Arg.(required & pos (incr ()) (some string) None & pinfo)
     | Abstract { of_rpc; _ } ->
       Term.app
-        (Term.pure (fun x ->
+        (Term.const (fun x ->
              let x = Jsonrpc.of_string x in
              match of_rpc x with
              | Ok _ -> x
@@ -192,7 +192,7 @@ module Gen () = struct
       in
       let doc = String.concat " " desc_list in
       pos := 0;
-      inner (Cmdliner.Term.pure ([], [])) ty, Cmdliner.Term.info wire_name ~doc
+      inner (Cmdliner.Term.const ([], [])) ty, Cmdliner.Cmd.info wire_name ~doc
     in
     terms := generate :: !terms