ocaml: format using make format with ocamlformat 0.28.1 (#6831)

We're changing the formatting of the ifs because of a bug in
ocamlformat, but otherwise the changes to jump to the newest version are
needed anyway

Author: edwintorok

.git-blame-ignore-revs

@@ -34,6 +34,7 @@ b12cf444edea15da6274975e1b2ca6a7fce2a090
 d8b4de9076531dd13bdffa20cc10c72290a52356
 bdf06bca7534fbc0c4fc3cee3408a51a22615226
 eefc649e17086fbc200e4da114ea673825e79864
+eb801de661df21e5f4837db12e9c4a90198f7136
 
 # ocp-indent
 d018d26d6acd4707a23288b327b49e44f732725e

.ocamlformat

@@ -1,6 +1,6 @@
 profile=ocamlformat
 indicate-multiline-delimiters=closing-on-separate-line
-if-then-else=fit-or-vertical
+if-then-else=k-r
 dock-collection-brackets=true
 break-struct=natural
 break-separators=before

ocaml/alerts/certificate/certificate_check.ml

@@ -68,14 +68,12 @@ let get_expiry = function
 let alert rpc session_id =
   get_certificates rpc session_id
   |> List.map (fun cert ->
-         let cls, obj_uuid =
-           alert_message_cls_and_obj_uuid rpc session_id cert
-         in
-         let obj_description = certificate_description cert in
-         let alert_conditions = alert_conditions cert in
-         let expiry = get_expiry cert in
-         Expiry_alert.{cls; obj_uuid; obj_description; alert_conditions; expiry}
-     )
+      let cls, obj_uuid = alert_message_cls_and_obj_uuid rpc session_id cert in
+      let obj_description = certificate_description cert in
+      let alert_conditions = alert_conditions cert in
+      let expiry = get_expiry cert in
+      Expiry_alert.{cls; obj_uuid; obj_description; alert_conditions; expiry}
+  )
   |> Expiry_alert.alert ~rpc ~session_id
 
 let maybe_generate_alert = Expiry_alert.maybe_generate_alert

ocaml/alerts/expiry_alert.ml

@@ -77,14 +77,14 @@ let filter_messages msg_name_list msg_obj_uuid alert all_msgs =
   let msg_body, (msg_name, msg_prio) = alert in
   all_msgs
   |> List.filter (fun (_ref, record) ->
-         record.API.message_obj_uuid = msg_obj_uuid
-         && List.mem record.API.message_name msg_name_list
-     )
+      record.API.message_obj_uuid = msg_obj_uuid
+      && List.mem record.API.message_name msg_name_list
+  )
   |> List.partition (fun (_ref, record) ->
-         record.API.message_body <> msg_body
-         || record.API.message_name <> msg_name
-         || record.API.message_priority <> msg_prio
-     )
+      record.API.message_body <> msg_body
+      || record.API.message_name <> msg_name
+      || record.API.message_priority <> msg_prio
+  )
 
 let alert ~rpc ~session_id raw_alerts =
   let now = Clock.Date.now () in
@@ -93,20 +93,20 @@ let alert ~rpc ~session_id raw_alerts =
     (fun {cls; obj_uuid; obj_description; alert_conditions; expiry} ->
       maybe_generate_alert now obj_description alert_conditions expiry
       |> Option.map (fun alert ->
-             let msg_name_list =
-               List.map (fun (_, (msg_name, _)) -> msg_name) alert_conditions
-             in
-             all_msgs |> filter_messages msg_name_list obj_uuid alert
-             |> fun (outdated, current) ->
-             List.iter
-               (fun (self, _) -> XenAPI.Message.destroy ~rpc ~session_id ~self)
-               outdated ;
-             if current = [] then
-               let body, (name, priority) = alert in
-               XenAPI.Message.create ~rpc ~session_id ~name ~priority ~cls
-                 ~obj_uuid ~body
-               |> ignore
-         )
+          let msg_name_list =
+            List.map (fun (_, (msg_name, _)) -> msg_name) alert_conditions
+          in
+          all_msgs |> filter_messages msg_name_list obj_uuid alert
+          |> fun (outdated, current) ->
+          List.iter
+            (fun (self, _) -> XenAPI.Message.destroy ~rpc ~session_id ~self)
+            outdated ;
+          if current = [] then
+            let body, (name, priority) = alert in
+            XenAPI.Message.create ~rpc ~session_id ~name ~priority ~cls
+              ~obj_uuid ~body
+            |> ignore
+      )
       |> ignore
     )
     raw_alerts

ocaml/cdrommon/cdrommon.ml

@@ -40,8 +40,7 @@ let check interval name =
       | _ ->
           ()
       ) ;
-      if !oldnotify then
-        disc_inserted name
+      if !oldnotify then disc_inserted name
     ) else
       match status with
       | Cdrom.DISC_OK ->

ocaml/database/block_device_io.ml

@@ -518,7 +518,10 @@ let action_writedb block_dev_fd client datasock target_response_time =
     (* If there's space, write some ASCII NULs over the next few bytes so that we trample on any data which may already exist on the block device *)
     let remaining_space = remaining_space - min_space_needed in
     let trample_size =
-      if size_size > remaining_space then remaining_space else size_size
+      if size_size > remaining_space then
+        remaining_space
+      else
+        size_size
     in
     Unixext.time_limited_write block_dev_fd trample_size
       (Bytes.make trample_size '\000')
@@ -606,7 +609,10 @@ let action_writedelta block_dev_fd client _datasock target_response_time =
     (* If there's space, write some ASCII NULs over the next few bytes so that we trample on any data which may already exist on the block device *)
     let available_space = available_space - str_len in
     let trample_size =
-      if size_size > available_space then available_space else size_size
+      if size_size > available_space then
+        available_space
+      else
+        size_size
     in
     let str = Bytes.concat Bytes.empty [str; Bytes.make trample_size '\000'] in
     (* Write the delta *)

ocaml/database/database_test.ml

@@ -294,7 +294,10 @@ functor
           (fun name _ table acc ->
             Db_cache_types.Table.fold_over_recent g
               (fun r {Db_cache_types.Stat.created; _} _ acc ->
-                if created >= g then (name, r) :: acc else acc
+                if created >= g then
+                  (name, r) :: acc
+                else
+                  acc
               )
               table acc
           )
@@ -321,7 +324,10 @@ functor
           (fun _ _ table acc ->
             Db_cache_types.Table.fold_over_deleted g
               (fun r {Db_cache_types.Stat.deleted; _} acc ->
-                if deleted > g then r :: acc else acc
+                if deleted > g then
+                  r :: acc
+                else
+                  acc
               )
               table acc
           )
@@ -730,11 +736,9 @@ functor
           ()
       ) ;
       let xs = Client.read_records_where t "VM" Db_filter_types.True in
-      if List.length xs <> 1 then
-        failwith "read_records_where <valid table> 2" ;
+      if List.length xs <> 1 then failwith "read_records_where <valid table> 2" ;
       let xs = Client.read_records_where t "VM" Db_filter_types.False in
-      if xs <> [] then
-        failwith "read_records_where <valid table> 3" ;
+      if xs <> [] then failwith "read_records_where <valid table> 3" ;
       expect_missing_tbl "Vm" (fun () ->
           let _ = Client.find_refs_with_filter t "Vm" Db_filter_types.True in
           failwith "find_refs_with_filter <invalid table>"
@@ -743,8 +747,7 @@ functor
       if List.length xs <> 1 then
         failwith "find_refs_with_filter <valid table> 1" ;
       let xs = Client.find_refs_with_filter t "VM" Db_filter_types.False in
-      if xs <> [] then
-        failwith "find_refs_with_filter <valid table> 2" ;
+      if xs <> [] then failwith "find_refs_with_filter <valid table> 2" ;
       expect_missing_tbl "Vm" (fun () ->
           Client.process_structured_field t ("", "") "Vm" "wibble" invalid_ref
             Db_cache_types.AddSet ;

ocaml/database/database_test.mli

@@ -13,5 +13,4 @@
  *)
 
 module Tests : functor (_ : Db_interface.DB_ACCESS) -> sig
-  val main : bool -> unit
-end
+  val main : bool -> unit end

ocaml/database/db_cache_impl.ml

@@ -68,8 +68,7 @@ let read_field t tblname fldname objref =
 let ensure_utf8_xml string =
   let length = String.length string in
   let prefix = Xapi_stdext_encodings.Utf8.XML.longest_valid_prefix string in
-  if length > String.length prefix then
-    warn "string truncated to: '%s'." prefix ;
+  if length > String.length prefix then warn "string truncated to: '%s'." prefix ;
   prefix
 
 let ensure_utf8_xml_and_share string = string |> ensure_utf8_xml |> Share.merge

ocaml/database/db_cache_types.ml

@@ -70,9 +70,7 @@ module StringMap = struct
   let add key v t = add (Share.merge key) v t
 end
 
-module type VAL = sig
-  type t
-end
+module type VAL = sig type t end
 
 module type MAP = sig
   type t
@@ -152,7 +150,10 @@ functor
     let fold_over_recent since f t initial =
       StringMap.fold
         (fun x y z ->
-          if y.stat.Stat.modified > since then f x y.stat y.v z else z
+          if y.stat.Stat.modified > since then
+            f x y.stat y.v z
+          else
+            z
         )
         t initial
   end
@@ -275,7 +276,10 @@ module Table = struct
             else
               acc
           in
-          if deleted <= since then new_acc else loop xs new_acc
+          if deleted <= since then
+            new_acc
+          else
+            loop xs new_acc
       | [] ->
           acc
     in
@@ -523,7 +527,12 @@ end
 (* Helper functions to deal with Sets and Maps *)
 let add_to_set key t =
   let t = Schema.Value.Unsafe_cast.set t in
-  Schema.Value.Set (if List.mem key t then t else key :: t)
+  Schema.Value.Set
+    ( if List.mem key t then
+        t
+      else
+        key :: t
+    )
 
 let remove_from_set key t =
   let t = Schema.Value.Unsafe_cast.set t in
@@ -704,15 +713,14 @@ let add_row tblname objref newval db =
   let g = db.Database.manifest.Manifest.generation_count in
   db
   |> Database.update_keymap (fun m ->
-         if Row.mem Db_names.uuid newval then
-           KeyMap.add_unique tblname Db_names.uuid
-             (Uuid
-                (Schema.Value.Unsafe_cast.string (Row.find Db_names.uuid newval))
-             )
-             (tblname, objref) m
-         else
-           m
-     )
+      if Row.mem Db_names.uuid newval then
+        KeyMap.add_unique tblname Db_names.uuid
+          (Uuid (Schema.Value.Unsafe_cast.string (Row.find Db_names.uuid newval))
+          )
+          (tblname, objref) m
+      else
+        m
+  )
   |> Database.update_keymap
        (KeyMap.add_unique tblname Db_names.ref (Ref objref) (tblname, objref))
   |> ((fun _ -> newval)
@@ -731,8 +739,8 @@ let remove_row tblname objref db =
   let g = db.Database.manifest.Manifest.generation_count in
   db
   |> Database.update_keymap (fun m ->
-         match uuid with Some u -> KeyMap.remove (Uuid u) m | None -> m
-     )
+      match uuid with Some u -> KeyMap.remove (Uuid u) m | None -> m
+  )
   |> Database.update_keymap (KeyMap.remove (Ref objref))
   |> update_many_to_many g tblname objref remove_from_set
   (* Update foreign (Set(Ref _)) fields *)