Cmdliner.1.1.0

Dockerfile

@@ -1,6 +1,6 @@
-FROM ocaml/opam:debian-11-ocaml-4.13@sha256:0c67662714d7f398ac4a8197d61ef85749effb8681d771837e9ebe36b0d4e20a AS build
+FROM ocaml/opam:debian-11-ocaml-4.13@sha256:dca2be63c27c3860560bd70001f94c39c32e8a22fdc270e5e77d297b665c871f AS build
 RUN sudo apt-get update && sudo apt-get install libev-dev capnproto m4 pkg-config libsqlite3-dev libgmp-dev -y --no-install-recommends
-RUN cd ~/opam-repository && git pull origin -q master && git reset --hard fbc1d981740a86692a63593aa3760a61f7b5072b && opam update
+RUN cd ~/opam-repository && git pull origin -q master && git reset --hard 057ef8fae9c1014d7a7e4d85e9eaf0ef7fbd4cfb && opam update
 COPY --chown=opam ocluster-api.opam ocluster.opam /src/
 COPY --chown=opam obuilder/obuilder.opam obuilder/obuilder-spec.opam /src/obuilder/
 RUN opam pin -yn /src/obuilder/

Dockerfile.worker

@@ -1,6 +1,6 @@
-FROM ocaml/opam:debian-11-ocaml-4.13@sha256:0c67662714d7f398ac4a8197d61ef85749effb8681d771837e9ebe36b0d4e20a AS build
+FROM ocaml/opam:debian-11-ocaml-4.13@sha256:dca2be63c27c3860560bd70001f94c39c32e8a22fdc270e5e77d297b665c871f AS build
 RUN sudo apt-get update && sudo apt-get install libev-dev capnproto m4 pkg-config libsqlite3-dev libgmp-dev -y --no-install-recommends
-RUN cd ~/opam-repository && git pull origin -q master && git reset --hard fbc1d981740a86692a63593aa3760a61f7b5072b && opam update
+RUN cd ~/opam-repository && git pull origin -q master && git reset --hard 057ef8fae9c1014d7a7e4d85e9eaf0ef7fbd4cfb && opam update
 COPY --chown=opam ocluster-api.opam ocluster.opam /src/
 COPY --chown=opam obuilder/obuilder.opam obuilder/obuilder-spec.opam /src/obuilder/
 RUN opam pin -yn /src/obuilder/

bin/admin.ml

@@ -240,55 +240,62 @@ let wait =
 
 let add_client =
   let doc = "Create a new client endpoint for submitting jobs" in
-  Term.(const add_client $ Logging.term $ connect_addr $ Arg.required (client_id ~pos:0)),
-  Term.info "add-client" ~doc
+  let info = Cmd.info "add-client" ~doc in
+  Cmd.v info
+    Term.(const add_client $ Logging.term $ connect_addr $ Arg.required (client_id ~pos:0))
 
 let remove_client =
   let doc = "Unregister a client." in
-  Term.(const remove_client $ Logging.term $ connect_addr $ Arg.required (client_id ~pos:0)),
-  Term.info "remove-client" ~doc
+  let info = Cmd.info "remove-client" ~doc in
+  Cmd.v info
+    Term.(const remove_client $ Logging.term $ connect_addr $ Arg.required (client_id ~pos:0))
 
 let list_clients =
   let doc = "List registered clients" in
-  Term.(const list_clients $ Logging.term $ connect_addr),
-  Term.info "list-clients" ~doc
+  let info = Cmd.info "list-clients" ~doc in
+  Cmd.v info
+    Term.(const list_clients $ Logging.term $ connect_addr)
 
 let set_rate =
   let doc = "Set expected number of parallel jobs for a pool/client combination" in
-  Term.(const set_rate $ Logging.term $ connect_addr $ Arg.required pool_pos $ Arg.required (client_id ~pos:1) $ Arg.required (rate ~pos:2)),
-  Term.info "set-rate" ~doc
+  let info = Cmd.info "set-rate" ~doc in
+  Cmd.v info
+    Term.(const set_rate $ Logging.term $ connect_addr $ Arg.required pool_pos $ Arg.required (client_id ~pos:1) $ Arg.required (rate ~pos:2))
 
 let show =
   let doc = "Show information about a service, pool or worker" in
-  Term.(const show $ Logging.term $ connect_addr $ Arg.value pool_pos),
-  Term.info "show" ~doc
+  let info = Cmd.info "show" ~doc in
+  Cmd.v info
+    Term.(const show $ Logging.term $ connect_addr $ Arg.value pool_pos)
 
 let pause =
   let doc = "Set a worker to be unavailable for further jobs" in
-  Term.(const (set_active false) $ Logging.term $ all $ auto_create $ wait $ connect_addr $ Arg.required pool_pos $ worker),
-  Term.info "pause" ~doc
+  let info = Cmd.info "pause" ~doc in
+  Cmd.v info
+    Term.(const (set_active false) $ Logging.term $ all $ auto_create $ wait $ connect_addr $ Arg.required pool_pos $ worker)
 
 let unpause =
   let doc = "Resume a paused worker" in
-  Term.(const (set_active true) $ Logging.term $ all $ auto_create $ const false $ connect_addr $ Arg.required pool_pos $ worker),
-  Term.info "unpause" ~doc
+  let info = Cmd.info "unpause" ~doc in
+  Cmd.v info
+    Term.(const (set_active true) $ Logging.term $ all $ auto_create $ const false $ connect_addr $ Arg.required pool_pos $ worker)
 
 let update =
   let doc = "Drain and then update worker(s)" in
-  Term.(const update $ Logging.term $ connect_addr $ Arg.required pool_pos $ worker),
-  Term.info "update" ~doc
+  let info = Cmd.info "update" ~doc in
+  Cmd.v info
+    Term.(const update $ Logging.term $ connect_addr $ Arg.required pool_pos $ worker)
 
 let forget =
   let doc = "Forget about an old worker" in
-  Term.(const forget $ Logging.term $ connect_addr $ Arg.required pool_pos $ worker),
-  Term.info "forget" ~doc
+  let info = Cmd.info "forget" ~doc in
+  Cmd.v info
+    Term.(const forget $ Logging.term $ connect_addr $ Arg.required pool_pos $ worker)
+
 
 let cmds = [add_client; remove_client; list_clients; set_rate; show; pause; unpause; update; forget]
 
-let default_cmd =
+let () =
   let doc = "a command-line admin client for the build-scheduler" in
-  let sdocs = Manpage.s_common_options in
-  Term.(ret (const (`Help (`Pager, None)))),
-  Term.info "ocluster-admin" ~doc ~sdocs ~version:Version.t
-
-let () = Term.(exit @@ eval_choice ~argv:Options.argv default_cmd cmds)
+  let info = Cmd.info "ocluster-admin" ~doc ~version:Version.t in
+  exit (Cmd.eval ~argv:Options.argv @@ Cmd.group info cmds)

bin/client.ml

@@ -121,12 +121,12 @@ let context_dockerfile =
 let dockerfile =
   let make local_dockerfile context_dockerfile =
     match local_dockerfile, context_dockerfile with
-    | None, None -> `Ok (`Context_path "Dockerfile")
-    | Some local, None -> `Ok (`Local_path local)
-    | None, Some context -> `Ok (`Context_path context)
-    | Some _, Some _ -> `Error (false, "Can't use --local-dockerfile and --context-dockerfile together!")
+    | None, None -> Ok (`Context_path "Dockerfile")
+    | Some local, None -> Ok (`Local_path local)
+    | None, Some context -> Ok (`Context_path context)
+    | Some _, Some _ -> Error ("Can't use --local-dockerfile and --context-dockerfile together!")
   in
-  Term.(ret (pure make $ local_dockerfile $ context_dockerfile))
+  Term.(term_result' (const make $ local_dockerfile $ context_dockerfile))
 
 let repo =
   Arg.value @@
@@ -243,48 +243,47 @@ let push_to =
     | _, None, Some _
     | _, Some _, None -> Fmt.failwith "Must use --push-user with --push-password"
   in
-  Term.(pure make $ push_to $ push_user $ push_password_file)
+  Term.(const make $ push_to $ push_user $ push_password_file)
 
 let build_options =
   let make build_args squash buildkit include_git =
     { Cluster_api.Docker.Spec.build_args; squash; buildkit; include_git }
   in
-  Term.(pure make $ build_args $ squash $ buildkit $ include_git)
+  Term.(const make $ build_args $ squash $ buildkit $ include_git)
 
 let submit_options_common =
   let make submission_path pool repository commits cache_hint urgent secrets =
     { submission_path; pool; repository; commits; cache_hint; urgent; secrets }
   in
-  Term.(pure make $ connect_addr $ pool $ repo $ commits $ cache_hint $ urgent $ secrets)
+  Term.(const make $ connect_addr $ pool $ repo $ commits $ cache_hint $ urgent $ secrets)
 
 let submit_docker_options =
   let make dockerfile push_to build_options =
     `Docker (dockerfile, push_to, build_options)
   in
-  Term.(pure make $ dockerfile $ push_to $ build_options)
+  Term.(const make $ dockerfile $ push_to $ build_options)
 
 let submit_docker =
   let doc = "Submit a Docker build to the scheduler" in
-  Term.(const submit $ Logging.term $ submit_options_common $ submit_docker_options),
-  Term.info "submit-docker" ~doc
+  let info = Cmd.info "submit-docker" ~doc in
+  Cmd.v info
+    Term.(const submit $ Logging.term $ submit_options_common $ submit_docker_options)
 
 let submit_obuilder_options =
   let make spec =
     `Obuilder spec
   in
-  Term.(pure make $ local_obuilder)
+  Term.(const make $ local_obuilder)
 
 let submit_obuilder =
   let doc = "Submit an OBuilder build to the scheduler" in
-  Term.(const submit $ Logging.term $ submit_options_common $ submit_obuilder_options),
-  Term.info "submit-obuilder" ~doc
+  let info = Cmd.info "submit-obuilder" ~doc in
+  Cmd.v info
+    Term.(const submit $ Logging.term $ submit_options_common $ submit_obuilder_options)
 
 let cmds = [submit_docker; submit_obuilder]
 
-let default_cmd =
+let () =
   let doc = "a command-line client for the build-scheduler" in
-  let sdocs = Manpage.s_common_options in
-  Term.(ret (const (`Help (`Pager, None)))),
-  Term.info "ocluster-client" ~doc ~sdocs ~version:Version.t
-
-let () = Term.(exit @@ eval_choice ~argv:Options.argv default_cmd cmds)
+  let info = Cmd.info "ocluster-client" ~doc ~version:Version.t in
+  exit (Cmd.eval ~argv:Options.argv @@ Cmd.group info cmds)

bin/logging.ml

@@ -23,4 +23,6 @@ let init style_renderer level =
   Logs.set_reporter reporter
 
 let term =
-  Cmdliner.Term.(const init $ Fmt_cli.style_renderer () $ Logs_cli.level ())
+  let open Cmdliner in
+  let docs = Manpage.s_common_options in
+  Term.(const init $ Fmt_cli.style_renderer ~docs () $ Logs_cli.level ~docs ())

bin/scheduler.ml

@@ -126,10 +126,10 @@ let main default_level ?formatter capnp secrets_dir pools prometheus_config stat
 let main ~install (default_level, args1) ((capnp, secrets_dir, pools, prometheus_config, state_dir, default_clients), args2) =
   let (name, display, text) = ("ocluster-scheduler", "OCluster Scheduler", "Manage build workers") in
   if install then
-    `Ok (Winsvc_wrapper.install name display text (args1 @args2))
+    Ok (Winsvc_wrapper.install name display text (args1 @args2))
   else
-    `Ok (Winsvc_wrapper.run name state_dir (fun ?formatter () ->
-             main default_level ?formatter capnp secrets_dir pools prometheus_config state_dir default_clients))
+    Ok (Winsvc_wrapper.run name state_dir (fun ?formatter () ->
+            main default_level ?formatter capnp secrets_dir pools prometheus_config state_dir default_clients))
 
 open Cmdliner
 
@@ -195,18 +195,21 @@ let cmd ~install =
         command-line paramater to install the scheduler as a Windows \
         service with the specified parameters, and '$(b,remove)' to \
         remove the scheduler from the services." ] in
-  Term.(ret (const (main ~install) $ with_used_args (Logs_cli.level ()) $ scheduler_opts_t)),
-  Term.info "ocluster-scheduler" ~doc ~man ~version:Version.t
+  let info = Cmd.info "ocluster-scheduler" ~doc ~man ~version:Version.t in
+  Cmd.v info
+    Term.(term_result'
+      (const (main ~install) $ with_used_args (Logs_cli.level ())
+       $ scheduler_opts_t))
 
 let () =
   match Array.to_list Sys.argv with
   | hd :: "install" :: argv ->
-    Term.(exit @@ eval ~argv:(Array.of_list (hd :: argv)) (cmd ~install:true))
+    exit (Cmd.eval ~argv:(Array.of_list (hd :: argv)) (cmd ~install:true))
   | _ :: "remove" :: args ->
     if args <> [] then begin
       prerr_endline "'remove' should be used only once, in first position.";
       exit 1
     end else
       Winsvc_wrapper.remove "ocluster-scheduler"
   | _ ->
-    Term.(exit @@ eval (cmd ~install:false))
+    exit (Cmd.eval (cmd ~install:false))

bin/worker.ml

@@ -58,10 +58,10 @@ let main default_level ?formatter registration_path capacity name allow_push pru
 let main ~install (default_level, args1) ((registration_path, capacity, name, allow_push, prune_threshold, state_dir, obuilder), args2) =
   let (name', display, text) = ("ocluster-worker", "OCluster Worker", "Run a build worker") in
   if install then
-    `Ok (Winsvc_wrapper.install name' display text (args1 @ args2))
+    Ok (Winsvc_wrapper.install name' display text (args1 @ args2))
   else
-    `Ok (Winsvc_wrapper.run name' state_dir (fun ?formatter () ->
-             main default_level ?formatter registration_path capacity name allow_push prune_threshold state_dir obuilder))
+    Ok (Winsvc_wrapper.run name' state_dir (fun ?formatter () ->
+            main default_level ?formatter registration_path capacity name allow_push prune_threshold state_dir obuilder))
 
 open Cmdliner
 
@@ -129,8 +129,7 @@ module Obuilder_config = struct
       | None -> None
       | Some store -> Some (Cluster_worker.Obuilder_config.v sandbox_config store)
     in
-    let open Cmdliner.Term in
-    Term.pure make $ Obuilder.Runc_sandbox.cmdliner $ store
+    Term.(const make $ Obuilder.Runc_sandbox.cmdliner $ store)
 end
 
 let worker_opts_t =
@@ -147,18 +146,20 @@ let cmd ~install =
         command-line paramater to install the worker as a Windows \
         service with the specified parameters, and '$(b,remove)' to \
         remove the worker from the services." ] in
-  Term.(ret (const (main ~install) $ with_used_args (Logs_cli.level ()) $ worker_opts_t)),
-  Term.info "ocluster-worker" ~doc ~man ~version:Version.t
+  let info = Cmd.info "ocluster-worker" ~doc ~man ~version:Version.t in
+  Cmd.v info
+    Term.(term_result'
+      (const (main ~install) $ with_used_args (Logs_cli.level ()) $ worker_opts_t))
 
 let () =
   match Array.to_list Sys.argv with
   | hd :: "install" :: argv ->
-    Term.(exit @@ eval ~argv:(Array.of_list (hd :: argv)) (cmd ~install:true))
+    exit (Cmd.eval ~argv:(Array.of_list (hd :: argv)) (cmd ~install:true))
   | _ :: "remove" :: args ->
     if args <> [] then begin
       prerr_endline "'remove' should be used only once, in first position.";
       exit 1
     end else
       Winsvc_wrapper.remove "ocluster-worker"
   | _ ->
-    Term.(exit @@ eval (cmd ~install:false))
+    exit (Cmd.eval (cmd ~install:false))

dune-project

@@ -33,6 +33,7 @@
   (capnp-rpc-unix (>= 1.2))
   (extunix (>= 0.3.2))
   (winsvc (and (>= 1.0.1) (= :os "win32")))
+  (cmdliner (>= 1.1.0))
   logs
   fmt
   (conf-libev (<> :os "win32"))

examples/obuilder_pipeline.ml

@@ -56,7 +56,8 @@ let submission_service =
 
 let cmd =
   let doc = "Run an OBuilder build on a cluster." in
-  Term.(term_result (const main $ Current.Config.cmdliner $ Current_web.cmdliner $ submission_service)),
-  Term.info program_name ~doc
+  let info = Cmd.info program_name ~doc in
+  Cmd.v info
+    Term.(term_result (const main $ Current.Config.cmdliner $ Current_web.cmdliner $ submission_service))
 
-let () = Term.(exit @@ eval cmd)
+let () = exit @@ Cmd.eval cmd

ocluster.opam

@@ -28,6 +28,7 @@ depends: [
   "capnp-rpc-unix" {>= "1.2"}
   "extunix" {>= "0.3.2"}
   "winsvc" {>= "1.0.1" & os = "win32"}
+  "cmdliner" {>= "1.1.0"}
   "logs"
   "fmt"
   "conf-libev" {os != "win32"}

stress/stress.ml

@@ -86,7 +86,7 @@ open Cmdliner
 
 let cmd =
   let doc = "Test the scheduler" in
-  Term.(const main $ Prometheus_unix.opts),
-  Term.info "stress" ~doc
+  let info = Cmd.info "stress" ~doc in
+  Cmd.v info Term.(const main $ Prometheus_unix.opts)
 
-let () = Term.(exit @@ eval cmd)
+let () = exit @@ Cmd.eval cmd