Merge pull request #3 from samoht/fmt

Use the same ocamlformat paramaters as in Irmin

.ocamlformat

@@ -1,2 +1,5 @@
-version=0.15.0
-margin=100
+version = 0.19.0
+profile = conventional
+break-infix = fit-or-vertical
+parse-docstrings = true
+module-item-spacing = compact

src/api/solver.ml

@@ -9,21 +9,24 @@ module Log = struct
   let pp_timestamp f x =
     let open Unix in
     let tm = gmtime x in
-    Fmt.pf f "%04d-%02d-%02d %02d:%02d.%02d" (tm.tm_year + 1900) (tm.tm_mon + 1) tm.tm_mday
-      tm.tm_hour tm.tm_min tm.tm_sec
+    Fmt.pf f "%04d-%02d-%02d %02d:%02d.%02d" (tm.tm_year + 1900) (tm.tm_mon + 1)
+      tm.tm_mday tm.tm_hour tm.tm_min tm.tm_sec
 
   let write t msg =
     let open X.Write in
     let message_size = 150 + String.length msg in
-    let request, params = Capability.Request.create ~message_size Params.init_pointer in
+    let request, params =
+      Capability.Request.create ~message_size Params.init_pointer
+    in
     Params.msg_set params msg;
     Capability.call_for_unit_exn t method_id request
 
   let info t fmt =
     let now = Unix.gettimeofday () in
     let k msg =
       let thread = write t msg in
-      Lwt.on_failure thread (fun ex -> Format.eprintf "Log.info(%S) failed: %a@." msg Fmt.exn ex)
+      Lwt.on_failure thread (fun ex ->
+          Format.eprintf "Log.info(%S) failed: %a@." msg Fmt.exn ex)
     in
     Fmt.kstr k ("%a [INFO] @[" ^^ fmt ^^ "@]@.") pp_timestamp now
 end
@@ -35,9 +38,11 @@ type t = X.t Capability.t
 let solve t ~log reqs =
   let open X.Solve in
   let request, params = Capability.Request.create Params.init_pointer in
-  Params.request_set params (Worker.Solve_request.to_yojson reqs |> Yojson.Safe.to_string);
+  Params.request_set params
+    (Worker.Solve_request.to_yojson reqs |> Yojson.Safe.to_string);
   Params.log_set params (Some log);
-  Capability.call_for_value_exn t method_id request >|= Results.response_get >|= fun json ->
+  Capability.call_for_value_exn t method_id request >|= Results.response_get
+  >|= fun json ->
   match Worker.Solve_response.of_yojson (Yojson.Safe.from_string json) with
   | Ok x -> x
   | Error ex -> failwith ex

src/api/worker.ml

@@ -17,7 +17,8 @@ module Selection = struct
   type t = {
     id : string;  (** The platform ID from the request. *)
     packages : string list;  (** The selected packages ("name.version"). *)
-    commits : (string * string) list;  (** Commits in opam-repositories to use. *)
+    commits : (string * string) list;
+        (** Commits in opam-repositories to use. *)
   }
   [@@deriving yojson, ord]
 end
@@ -28,15 +29,17 @@ module Solve_request = struct
     opam_repos_folders : (string * string * string) list;
         (** Opam repositories to use: name, folder, commit *)
     pkgs : string list;  (** Name of packages to solve. *)
-    constraints : (string * string) list;  (** Version locks: package, version *)
+    constraints : (string * string) list;
+        (** Version locks: package, version *)
     platforms : (string * Vars.t) list;  (** Possible build platforms, by ID. *)
   }
   [@@deriving yojson]
 end
 
 (** The response from the solver. *)
 module Solve_response = struct
-  type ('a, 'b) result = ('a, 'b) Stdlib.result = Ok of 'a | Error of 'b [@@deriving yojson]
+  type ('a, 'b) result = ('a, 'b) Stdlib.result = Ok of 'a | Error of 'b
+  [@@deriving yojson]
 
   type t = (Selection.t list, [ `Msg of string ]) result [@@deriving yojson]
 end

src/lib/config.ml

@@ -8,22 +8,26 @@ let profile =
 let to_obuilder_job build_spec =
   let open Current.Syntax in
   let+ build_spec = build_spec in
-  let spec_str = Fmt.to_to_string Obuilder_spec.pp (build_spec |> Spec.finish) in
+  let spec_str =
+    Fmt.to_to_string Obuilder_spec.pp (build_spec |> Spec.finish)
+  in
   let open Cluster_api.Obuilder_job.Spec in
   { spec = `Contents spec_str }
 
 let to_docker_job build_spec =
   let open Current.Syntax in
   let spec_str =
     let+ build_spec = build_spec in
-    Obuilder_spec.Docker.dockerfile_of_spec ~buildkit:true (build_spec |> Spec.finish)
+    Obuilder_spec.Docker.dockerfile_of_spec ~buildkit:true
+      (build_spec |> Spec.finish)
   in
   `Contents spec_str
 
 let build ?label ?cache_hint t ~pool ~src spec =
   match profile with
   | `Production | `Dev ->
-      to_obuilder_job spec |> Current_ocluster.build_obuilder ?label ?cache_hint t ~pool ~src
+      to_obuilder_job spec
+      |> Current_ocluster.build_obuilder ?label ?cache_hint t ~pool ~src
   | `Docker ->
       let options =
         {
@@ -33,4 +37,5 @@ let build ?label ?cache_hint t ~pool ~src spec =
           include_git = true;
         }
       in
-      to_docker_job spec |> Current_ocluster.build ~options ?label ?cache_hint t ~pool ~src
+      to_docker_job spec
+      |> Current_ocluster.build ~options ?label ?cache_hint t ~pool ~src

src/lib/current_solver.ml

@@ -1,5 +1,4 @@
 type resolution = { name : string; version : string } [@@deriving yojson]
-
 type t = { resolutions : resolution list; repos : Repository.t list }
 
 let solver = Solver_pool.spawn_local ()
@@ -33,8 +32,10 @@ module Op = struct
         `Assoc
           [
             ( "repos",
-              `List (List.map (fun (_, commit) -> `String (Current_git.Commit.hash commit)) repos)
-            );
+              `List
+                (List.map
+                   (fun (_, commit) -> `String (Current_git.Commit.hash commit))
+                   repos) );
             ("packages", `List (List.map (fun p -> `String p) packages));
             ("system", `String (Fmt.str "%a" Platform.pp_system system));
           ]
@@ -43,17 +44,15 @@ module Op = struct
   end
 
   module Value = struct
-    type t = { resolutions : resolution list; repos : (string * string) list } [@@deriving yojson]
+    type t = { resolutions : resolution list; repos : (string * string) list }
+    [@@deriving yojson]
 
     let marshal t = t |> to_yojson |> Yojson.Safe.to_string
-
     let unmarshal t = t |> Yojson.Safe.from_string |> of_yojson |> Result.get_ok
   end
 
   let auto_cancel = true
-
   let id = "mirage-ci-solver"
-
   let pp f _ = Fmt.string f "Opam solver"
 
   open Lwt.Syntax
@@ -62,15 +61,18 @@ module Op = struct
     let rec aux acc = function
       | [] -> fn (List.rev acc)
       | commit :: next ->
-          Current_git.with_checkout ~job commit (fun tmpdir -> aux (tmpdir :: acc) next)
+          Current_git.with_checkout ~job commit (fun tmpdir ->
+              aux (tmpdir :: acc) next)
     in
     aux [] commits
 
   let build No_context job { Key.repos; packages; system } =
     let* () = Current.Job.start ~level:Harmless job in
     let repos_git = List.map snd repos in
     with_checkouts ~job repos_git @@ fun dirs ->
-    let constraints = [ ("ocaml", Fmt.to_to_string Platform.pp_exact_ocaml system.ocaml) ] in
+    let constraints =
+      [ ("ocaml", Fmt.to_to_string Platform.pp_exact_ocaml system.ocaml) ]
+    in
     let opam_repos_folders =
       List.combine dirs repos
       |> List.map (fun (dir, (name, repo)) ->

src/lib/current_solver.mli

@@ -1,11 +1,10 @@
 type resolution = { name : string; version : string }
-
 type t = { resolutions : resolution list; repos : Repository.t list }
 
 val v :
   system:Platform.system ->
   repos:Repository.fetched list Current.t ->
   packages:string list ->
   t Current.t
-(** [v ~system ~repos ~packages] resolves the requested [packages] using the 
-  given [repos] on the platform [system]. The arch is hardcoded to x86_64. *)
+(** [v ~system ~repos ~packages] resolves the requested [packages] using the
+    given [repos] on the platform [system]. The arch is hardcoded to x86_64. *)

src/lib/git_store.ml

@@ -13,7 +13,8 @@ open Cmdliner
 let git_ssh_host =
   Arg.required
   @@ Arg.opt Arg.(some string) None
-  @@ Arg.info ~doc:"The git SSH host to store the transient data" ~docv:"HOST" [ "git-ssh-host" ]
+  @@ Arg.info ~doc:"The git SSH host to store the transient data" ~docv:"HOST"
+       [ "git-ssh-host" ]
 
 let git_ssh_port =
   Arg.value
@@ -23,23 +24,28 @@ let git_ssh_port =
 let git_ssh_repository =
   Arg.required
   @@ Arg.opt Arg.(some string) None
-  @@ Arg.info ~doc:"The git repository to store the transient data on the specified host"
+  @@ Arg.info
+       ~doc:
+         "The git repository to store the transient data on the specified host"
        ~docv:"REPO" [ "git-ssh-repo" ]
 
 let git_http_remote =
   Arg.required
   @@ Arg.opt Arg.(some string) None
-  @@ Arg.info ~doc:"The public http remote for the storage repository" ~docv:"HOST" [ "git-http-remote" ]
-
+  @@ Arg.info ~doc:"The public http remote for the storage repository"
+       ~docv:"HOST" [ "git-http-remote" ]
+
 let private_key_file =
   Arg.required
   @@ Arg.opt Arg.(some string) None
-  @@ Arg.info ~doc:"A private key to use to access the remote" ~docv:"FILE" [ "privkey" ]
+  @@ Arg.info ~doc:"A private key to use to access the remote" ~docv:"FILE"
+       [ "privkey" ]
 
 let public_key_file =
   Arg.required
   @@ Arg.opt Arg.(some string) None
-  @@ Arg.info ~doc:"A public key to use to access the remote" ~docv:"FILE" [ "pubkey" ]
+  @@ Arg.info ~doc:"A public key to use to access the remote" ~docv:"FILE"
+       [ "pubkey" ]
 
 let load_file path =
   try
@@ -49,7 +55,8 @@ let load_file path =
     close_in ch;
     data
   with ex ->
-    if Sys.file_exists path then failwith @@ Fmt.str "Error loading %S: %a" path Fmt.exn ex
+    if Sys.file_exists path then
+      failwith @@ Fmt.str "Error loading %S: %a" path Fmt.exn ex
     else failwith @@ Fmt.str "File %S does not exist" path
 
 let v ssh_host ssh_port ssh_repo http_remote private_key_file public_key_file =
@@ -65,20 +72,26 @@ let v ssh_host ssh_port ssh_repo http_remote private_key_file public_key_file =
 
 let cmdliner =
   Term.(
-    const v $ git_ssh_host $ git_ssh_port $ git_ssh_repository $ git_http_remote
-    $ private_key_file $ public_key_file)
-
-let v ~ssh_host ?ssh_port ~ssh_repo ~http_remote ~private_key_file ~public_key_file =
+    const v
+    $ git_ssh_host
+    $ git_ssh_port
+    $ git_ssh_repository
+    $ git_http_remote
+    $ private_key_file
+    $ public_key_file)
+
+let v ~ssh_host ?ssh_port ~ssh_repo ~http_remote ~private_key_file
+    ~public_key_file =
   v ssh_host ssh_port ssh_repo http_remote private_key_file public_key_file
 
 let remote t = Fmt.str "git@%s:%s" t.ssh_host t.ssh_repo
-
 let http_remote t = t.http_remote
 
 let git_checkout_or_create b =
   Fmt.str
-    "(git remote set-branches --add origin %s && git fetch origin %s && git checkout --track \
-     origin/%s) || (git checkout -b %s && git push --set-upstream origin %s)"
+    "(git remote set-branches --add origin %s && git fetch origin %s && git \
+     checkout --track origin/%s) || (git checkout -b %s && git push \
+     --set-upstream origin %s)"
     b b b b b
 
 module Cluster = struct
@@ -104,27 +117,29 @@ module Cluster = struct
 
   let clone ~branch ~directory t =
     Obuilder_spec.run ~network:[ "host" ] ~secrets
-      "git clone --single-branch %s %s && cd %s && (%s)" (remote t) directory directory
+      "git clone --single-branch %s %s && cd %s && (%s)" (remote t) directory
+      directory
       (git_checkout_or_create branch)
 
   let push ?(force = false) _ =
-    Obuilder_spec.run ~network:[ "host" ] ~secrets (if force then "git push -f" else "git push")
+    Obuilder_spec.run ~network:[ "host" ] ~secrets
+      (if force then "git push -f" else "git push")
 
   let secrets t =
-    [ ("ssh_privkey", t.private_key); ("ssh_pubkey", t.public_key); ("ssh_config", config t) ]
+    [
+      ("ssh_privkey", t.private_key);
+      ("ssh_pubkey", t.public_key);
+      ("ssh_config", config t);
+    ]
 end
 
 module type Reader = sig
   type t
 
   val pp : t Fmt.t
-
   val id : string
-
   val fn : Fpath.t -> t Lwt.t
-
   val marshal : t -> string
-
   val unmarshal : string -> t
 end
 
@@ -152,10 +167,13 @@ let sync ~job t =
   let* () = Current.Job.use_pool ~switch job t.pool in
   let* result =
     match Bos.OS.Path.exists state_folder with
-    | Error _ -> Fmt.failwith "Failed to look for git folder %a" Fpath.pp state_folder
+    | Error _ ->
+        Fmt.failwith "Failed to look for git folder %a" Fpath.pp state_folder
     | Ok false ->
         Current.Process.exec ~cancellable:false ~job
-          ("", [| "git"; "clone"; "--bare"; repo; Fpath.to_string state_folder |])
+          ( "",
+            [| "git"; "clone"; "--bare"; repo; Fpath.to_string state_folder |]
+          )
     | Ok true ->
         Current.Process.exec ~cwd:state_folder ~cancellable:false ~job
           ("", [| "git"; "fetch"; "-f"; "origin"; "*:*" |])
@@ -172,7 +190,11 @@ let with_clone ~job ~branch store fn =
     Current.Process.exec ~cancellable:false ~job
       ( "",
         [|
-          "git"; "clone"; "--single-branch"; Fpath.to_string state_folder; Fpath.to_string tmpdir;
+          "git";
+          "clone";
+          "--single-branch";
+          Fpath.to_string state_folder;
+          Fpath.to_string tmpdir;
         |] )
   in
   let** () =
@@ -187,11 +209,9 @@ let with_clone ~job ~branch store fn =
 
 module ReadOp (R : Reader) = struct
   type store = t
-
   type t = No_context
 
   let pp f _ = Fmt.pf f "git store"
-
   let id = "git-store-" ^ R.id
 
   module Key = struct
@@ -217,7 +237,8 @@ module ReadOp (R : Reader) = struct
     Lwt.return_ok result
 end
 
-let read (type a) ~branch (module R : Reader with type t = a) store key : a Current.t =
+let read (type a) ~branch (module R : Reader with type t = a) store key :
+    a Current.t =
   let module Read = ReadOp (R) in
   let module Cache = Current_cache.Make (Read) in
   let open Current.Syntax in