From f42fd067a329da36ef64f1f2cdac75967da60885 Mon Sep 17 00:00:00 2001 From: Jules Aguillon Date: Tue, 27 Jun 2023 18:14:32 +0200 Subject: [PATCH] Preview: Upgrade to ocamlformat 0.26.0 (unreleased) The aim of this commit is to gather feedback. Changelog can be found here: https://github.com/ocaml-ppx/ocamlformat/blob/main/CHANGES.md --- .ocamlformat | 2 +- doc/examples/markup.mli | 66 ++++++++++++++++++--------------------- src/document/url.ml | 2 +- src/ocamlary/ocamlary.mli | 38 ++++++++++------------ src/odoc/source_tree.ml | 2 +- src/xref2/env.ml | 26 +++++++-------- src/xref2/ref_tools.ml | 2 +- 7 files changed, 63 insertions(+), 75 deletions(-) diff --git a/.ocamlformat b/.ocamlformat index 33d067bf7e..b577e41de7 100644 --- a/.ocamlformat +++ b/.ocamlformat @@ -1,2 +1,2 @@ module-item-spacing=preserve -version=0.25.1 +version = 0.26.0 diff --git a/doc/examples/markup.mli b/doc/examples/markup.mli index 5766cb69a5..d27e92d966 100644 --- a/doc/examples/markup.mli +++ b/doc/examples/markup.mli @@ -52,46 +52,43 @@ module type Foo = sig val bar : string (** This comment is associated to bar. *) - class cl : - object - - (** Interesting information about cl *) - end + class cl : object + +(** Interesting information about cl *) + end (** The comment for class my_class *) - class my_class : - object - inherit cl - (** A comment to describe inheritance from cl *) + class my_class : object + inherit cl + (** A comment to describe inheritance from cl *) - val mutable tutu : string - (** The comment for attribute tutu *) + val mutable tutu : string + (** The comment for attribute tutu *) - val toto : int - (** The comment for attribute toto. *) + val toto : int + (** The comment for attribute toto. *) - (** This comment is not attached to titi since + (** This comment is not attached to titi since there is a blank line before titi, but is kept as a comment in the class. *) - val titi : string + val titi : string - method toto : string - (** Comment for method toto *) + method toto : string + (** Comment for method toto *) - method m : float -> int - (** Comment for method m *) - end + method m : float -> int + (** Comment for method m *) + end (** The comment for the class type my_class_type *) - class type my_class_type = - object - val mutable x : int - (** The comment for variable x. *) + class type my_class_type = object + val mutable x : int + (** The comment for variable x. *) - method m : int -> int - (** The comment for method m. *) - end + method m : int -> int + (** The comment for method m. *) + end (** The comment for module Foo *) module Foo : sig @@ -119,16 +116,15 @@ end module Stop : sig (** This module demonstrates the use of stop comments ([(**/**)]) *) - class type foo = - object - method m : string - (** comment for method m *) + class type foo = object + method m : string + (** comment for method m *) - (**/**) + (**/**) - method bar : int - (** This method won't appear in the documentation *) - end + method bar : int + (** This method won't appear in the documentation *) + end val foo : string (** This value appears in the documentation, since the Stop special comment diff --git a/src/document/url.ml b/src/document/url.ml index 3be65243d3..1c3d11d048 100644 --- a/src/document/url.ml +++ b/src/document/url.ml @@ -253,7 +253,7 @@ module Anchor = struct | None -> assert false (* We got a root, should never happen *) | Some page -> let anchor = Printf.sprintf "%s-%s" (Path.string_of_kind kind) name in - { page; anchor; kind = (kind :> kind) } + { page; anchor; kind :> kind } let add_suffix ~kind { page; anchor; _ } suffix = { page; anchor = anchor ^ "." ^ suffix; kind } diff --git a/src/ocamlary/ocamlary.mli b/src/ocamlary/ocamlary.mli index e9bed1aeb6..669103f3c8 100644 --- a/src/ocamlary/ocamlary.mli +++ b/src/ocamlary/ocamlary.mli @@ -575,23 +575,19 @@ type my_mod = (module COLLECTION) class empty_class : object end -class one_method_class : - object - method go : unit - end +class one_method_class : object + method go : unit +end -class two_method_class : - object - method one : one_method_class +class two_method_class : object + method one : one_method_class - method undo : unit - end + method undo : unit +end -class ['a] param_class : - 'a - -> object - method v : 'a - end +class ['a] param_class : 'a -> object + method v : 'a +end type my_unit_object = unit param_class @@ -605,10 +601,9 @@ type 'a my_unit_class = unit #param_class as 'a (* Test resolution of dependently typed modules *) module Dep1 : sig module type S = sig - class c : - object - method m : int - end + class c : object + method m : int + end end module X : sig @@ -722,10 +717,9 @@ module type Dep10 = Dep9(Dep8).T with type t = int module Dep11 : sig module type S = sig - class c : - object - method m : int - end + class c : object + method m : int + end end end diff --git a/src/odoc/source_tree.ml b/src/odoc/source_tree.ml index dbf736ee52..36879a1d9e 100644 --- a/src/odoc/source_tree.ml +++ b/src/odoc/source_tree.ml @@ -32,7 +32,7 @@ let compile ~resolver ~parent ~output ~warnings_options:_ input = parse_input_file input >>= fun (digest, source_tree) -> let root = let file = Root.Odoc_file.create_page root_name in - { Root.id = (id :> Id.OdocId.t); file; digest } + { Root.id :> Id.OdocId.t; file; digest } in let source_children = List.rev_map (source_child_id id) source_tree in let page = diff --git a/src/xref2/env.ml b/src/xref2/env.ml index 36c38be6fd..ab45f73956 100644 --- a/src/xref2/env.ml +++ b/src/xref2/env.ml @@ -527,15 +527,14 @@ let s_module : Component.Element.module_ scope = let s_any : Component.Element.any scope = make_scope ~root:lookup_page_or_root_module_fallback - ~check: - (fun env -> function - | `Label (id, _) -> ( - try - Some - (Identifier.Maps.Label.find id env.ambiguous_labels - :> Component.Element.any amb_err) - with Not_found -> None) - | _ -> None) + ~check:(fun env -> function + | `Label (id, _) -> ( + try + Some + (Identifier.Maps.Label.find id env.ambiguous_labels + :> Component.Element.any amb_err) + with Not_found -> None) + | _ -> None) (fun r -> Some r) let s_module_type : Component.Element.module_type scope = @@ -562,11 +561,10 @@ let s_value : Component.Element.value scope = let s_label : Component.Element.label scope = make_scope - ~check: - (fun env -> function - | `Label (id, _) -> ( - try Some (Identifier.Maps.Label.find id env.ambiguous_labels) - with Not_found -> None)) + ~check:(fun env -> function + | `Label (id, _) -> ( + try Some (Identifier.Maps.Label.find id env.ambiguous_labels) + with Not_found -> None)) (function #Component.Element.label as r -> Some r | _ -> None) let s_constructor : Component.Element.constructor scope = diff --git a/src/xref2/ref_tools.ml b/src/xref2/ref_tools.ml index 6143fb41f1..9987991a04 100644 --- a/src/xref2/ref_tools.ml +++ b/src/xref2/ref_tools.ml @@ -344,7 +344,7 @@ module L = struct | `Heading ( _, ({ Odoc_model.Paths.Identifier.iv = `Label (_, name'); _ } as - label), + label), _ ) when name = LabelName.to_string name' -> Ok (`Identifier label)