diff --git a/.ocamlformat b/.ocamlformat index e32751579c..9f28a3ffc2 100644 --- a/.ocamlformat +++ b/.ocamlformat @@ -1 +1 @@ -version=0.15.0 +version=0.17.0 diff --git a/src/document/codefmt.ml b/src/document/codefmt.ml index 37a4c486c2..e18997a335 100644 --- a/src/document/codefmt.ml +++ b/src/document/codefmt.ml @@ -25,7 +25,7 @@ module State = struct if Stack.is_empty state.context then List.rev state.current else ( leave state; - flush state ) + flush state) end (** Modern implementation using semantic tags, Only for 4.08+ *) @@ -172,7 +172,7 @@ let rec list ?sep ~f = function | x :: xs -> ( let hd = f x in let tl = list ?sep ~f xs in - match sep with None -> hd ++ tl | Some sep -> hd ++ sep ++ tl ) + match sep with None -> hd ++ tl | Some sep -> hd ++ sep ++ tl) let render f = spf "%t" f diff --git a/src/document/comment.ml b/src/document/comment.ml index bea7df0751..2db3f0d06f 100644 --- a/src/document/comment.ml +++ b/src/document/comment.ml @@ -102,7 +102,7 @@ module Reference = struct let s = source_of_code s in [ inline @@ Inline.Source s ] | Some s -> - [ inline @@ Inline.InternalLink (InternalLink.Unresolved s) ] ) + [ inline @@ Inline.InternalLink (InternalLink.Unresolved s) ]) | `Dot (parent, s) -> unresolved ?text (parent :> t) s | `Module (parent, s) -> unresolved ?text (parent :> t) (ModuleName.to_string s) @@ -145,7 +145,7 @@ module Reference = struct | Error exn -> (* FIXME: better error message *) Printf.eprintf "Id.href failed: %S\n%!" (Url.Error.to_string exn); - txt ) + txt) and unresolved : ?text:Inline.t -> Reference.t -> string -> Inline.t = fun ?text parent field -> diff --git a/src/document/doctree.ml b/src/document/doctree.ml index 827963f820..d09307d93c 100644 --- a/src/document/doctree.ml +++ b/src/document/doctree.ml @@ -17,7 +17,7 @@ module Take = struct | Rec x -> loop acc (x @ rest) | Accum v -> loop (List.rev_append v acc) rest | Stop_and_keep -> (List.rev acc, None, b :: rest) - | Stop_and_accum (v, e) -> (List.rev_append acc v, e, rest) ) + | Stop_and_accum (v, e) -> (List.rev_append acc v, e, rest)) in loop [] items end @@ -37,7 +37,7 @@ module Rewire = struct if level > current_level then let children, rest = loop level [] rest in loop current_level (node h children :: acc) rest - else (List.rev acc, l) ) + else (List.rev acc, l)) in let trees, rest = loop (-1) [] items in assert (rest = []); diff --git a/src/document/generator.ml b/src/document/generator.ml index 1552b7d9df..5944539eb5 100644 --- a/src/document/generator.ml +++ b/src/document/generator.ml @@ -126,7 +126,7 @@ module Make (Syntax : SYNTAX) = struct | Error (Url.Error.Not_linkable _) -> O.txt txt | Error exn -> Printf.eprintf "Id.href failed: %S\n%!" (Url.Error.to_string exn); - O.txt txt ) + O.txt txt) let dot prefix suffix = prefix ^ "." ^ suffix @@ -227,9 +227,9 @@ module Make (Syntax : SYNTAX) = struct | _ -> let arguments = style_arguments ~constant arguments in O.span - ( if Syntax.Type.Variant.parenthesize_params then - constr ++ arguments - else constr ++ O.txt " of " ++ arguments ) + (if Syntax.Type.Variant.parenthesize_params then + constr ++ arguments + else constr ++ O.txt " of " ++ arguments) in if add_pipe then O.txt " " ++ res else res in @@ -237,13 +237,13 @@ module Make (Syntax : SYNTAX) = struct in let elements = style_elements ~add_pipe:false t.elements in O.span - ( match t.kind with + (match t.kind with | Fixed -> O.txt "[ " ++ elements ++ O.txt " ]" | Open -> O.txt "[> " ++ elements ++ O.txt " ]" | Closed [] -> O.txt "[< " ++ elements ++ O.txt " ]" | Closed lst -> let constrs = String.concat " " lst in - O.txt "[< " ++ elements ++ O.txt (" " ^ constrs ^ " ]") ) + O.txt "[< " ++ elements ++ O.txt (" " ^ constrs ^ " ]")) and te_object (t : Odoc_model.Lang.TypeExpr.Object.t) = let fields = @@ -327,7 +327,7 @@ module Make (Syntax : SYNTAX) = struct O.txt (String.concat " " polyvars ^ ". ") ++ type_expr t | Package pkg -> enclose ~l:"(" ~r:")" - ( O.keyword "module" ++ O.txt " " + (O.keyword "module" ++ O.txt " " ++ Link.from_path (pkg.path :> Paths.Path.t) ++ match pkg.substitutions with @@ -336,7 +336,7 @@ module Make (Syntax : SYNTAX) = struct O.txt " " ++ O.keyword "with" ++ O.txt " " ++ O.list ~sep:(O.txt " " ++ O.keyword "and" ++ O.txt " ") - lst ~f:package_subst ) + lst ~f:package_subst) and package_subst ((frag_typ, te) : Paths.Fragment.Type.t * Odoc_model.Lang.TypeExpr.t) : @@ -383,11 +383,11 @@ module Make (Syntax : SYNTAX) = struct * [O.a ~a:[O.a_href ("#" ^ anchor); O.a_class ["anchor"]] [] * ; *) O.code - ( (if mutable_ then O.keyword "mutable" ++ O.txt " " else O.noop) + ((if mutable_ then O.keyword "mutable" ++ O.txt " " else O.noop) ++ O.txt name ++ O.txt Syntax.Type.annotation_separator ++ type_expr typ - ++ O.txt Syntax.Type.Record.field_separator ) + ++ O.txt Syntax.Type.Record.field_separator) (* ] *) in (url, attrs, cell) @@ -439,14 +439,14 @@ module Make (Syntax : SYNTAX) = struct ~f:(type_expr ~needs_parentheses:is_gadt) in O.documentedSrc - ( cstr - ++ ( if Syntax.Type.Variant.parenthesize_params then - O.txt "(" ++ params ++ O.txt ")" + (cstr + ++ (if Syntax.Type.Variant.parenthesize_params then + O.txt "(" ++ params ++ O.txt ")" else - ( if is_gadt then O.txt Syntax.Type.annotation_separator - else O.txt " " ++ O.keyword "of" ++ O.txt " " ) - ++ params ) - ++ ret_type ) + (if is_gadt then O.txt Syntax.Type.annotation_separator + else O.txt " " ++ O.keyword "of" ++ O.txt " ") + ++ params) + ++ ret_type) | Record fields -> if is_gadt then O.documentedSrc (cstr ++ O.txt Syntax.Type.annotation_separator) @@ -504,9 +504,9 @@ module Make (Syntax : SYNTAX) = struct let extension (t : Odoc_model.Lang.Extension.t) = let content = O.documentedSrc - ( O.keyword "type" ++ O.txt " " + (O.keyword "type" ++ O.txt " " ++ Link.from_path (t.type_path :> Paths.Path.t) - ++ O.txt " += " ) + ++ O.txt " += ") @ List.map extension_constructor t.constructors @ O.documentedSrc (if Syntax.Type.type_def_semicolon then O.txt ";" else O.noop) @@ -539,7 +539,7 @@ module Make (Syntax : SYNTAX) = struct | Constructor { constant; name; arguments; doc; _ } -> ( let cstr = "`" ^ name in ( "constructor", - ( match arguments with + (match arguments with | [] -> O.code (O.txt cstr) | _ -> (* Multiple arguments in a polymorphic variant constructor correspond @@ -560,12 +560,11 @@ module Make (Syntax : SYNTAX) = struct if constant then O.txt "& " ++ params else params in O.code - ( O.txt cstr + (O.txt cstr ++ if Syntax.Type.Variant.parenthesize_params then params - else O.txt " " ++ O.keyword "of" ++ O.txt " " ++ params ) - ), - match doc with [] -> None | _ -> Some (Comment.to_ir doc) ) ) + else O.txt " " ++ O.keyword "of" ++ O.txt " " ++ params)), + match doc with [] -> None | _ -> Some (Comment.to_ir doc) )) in try let url = Url.Anchor.polymorphic_variant ~type_ident item in @@ -617,14 +616,14 @@ module Make (Syntax : SYNTAX) = struct String.concat "" final in O.txt - ( match params with + (match params with | [] -> "" | [ x ] -> format_param x |> Syntax.Type.handle_format_params | lst -> ( let params = String.concat ", " (List.map format_param lst) in (match delim with `parens -> "(" | `brackets -> "[") ^ params - ^ match delim with `parens -> ")" | `brackets -> "]" ) ) + ^ match delim with `parens -> ")" | `brackets -> "]")) let format_constraints constraints = O.list constraints ~f:(fun (t1, t2) -> @@ -644,9 +643,9 @@ module Make (Syntax : SYNTAX) = struct | Some t -> let manifest = O.txt (if is_substitution then " := " else " = ") - ++ ( if private_ then - O.keyword Syntax.Type.private_keyword ++ O.txt " " - else O.noop ) + ++ (if private_ then + O.keyword Syntax.Type.private_keyword ++ O.txt " " + else O.noop) ++ type_expr t in (manifest, false) @@ -665,11 +664,11 @@ module Make (Syntax : SYNTAX) = struct in let manifest = O.documentedSrc - ( O.txt (if is_substitution then " := " else " = ") + (O.txt (if is_substitution then " := " else " = ") ++ if t.equation.private_ then O.keyword Syntax.Type.private_keyword ++ O.txt " " - else O.noop ) + else O.noop) @ code in (manifest, false) @@ -690,11 +689,11 @@ module Make (Syntax : SYNTAX) = struct | Record fields -> record fields in O.documentedSrc - ( O.txt " = " + (O.txt " = " ++ if need_private then O.keyword Syntax.Type.private_keyword ++ O.txt " " - else O.noop ) + else O.noop) @ content in let tconstr = @@ -734,11 +733,11 @@ module Make (Syntax : SYNTAX) = struct let name = Paths.Identifier.name t.id in let content = O.documentedSrc - ( O.keyword Syntax.Value.variable_keyword + (O.keyword Syntax.Value.variable_keyword ++ O.txt " " ++ O.txt name ++ O.txt Syntax.Type.annotation_separator ++ type_expr t.type_ - ++ if Syntax.Value.semicolon then O.txt ";" else O.noop ) + ++ if Syntax.Value.semicolon then O.txt ";" else O.noop) in let kind = Some "value" in let anchor = path_to_id t.id in @@ -749,11 +748,11 @@ module Make (Syntax : SYNTAX) = struct let name = Paths.Identifier.name t.id in let content = O.documentedSrc - ( O.keyword Syntax.Value.variable_keyword + (O.keyword Syntax.Value.variable_keyword ++ O.txt " " ++ O.txt name ++ O.txt Syntax.Type.annotation_separator ++ type_expr t.type_ - ++ if Syntax.Type.External.semicolon then O.txt ";" else O.noop ) + ++ if Syntax.Type.External.semicolon then O.txt ";" else O.noop) in let kind = Some "external" in let anchor = path_to_id t.id in @@ -801,7 +800,7 @@ module Make (Syntax : SYNTAX) = struct take_until_heading_or_end (element :: input_comment) in let item = Item.Text content in - loop input_comment (item :: acc) ) + loop input_comment (item :: acc)) in loop input0 [] @@ -852,9 +851,9 @@ module Make (Syntax : SYNTAX) = struct in let content = O.documentedSrc - ( O.keyword "method" ++ O.txt " " ++ private_ ++ virtual_ ++ O.txt name + (O.keyword "method" ++ O.txt " " ++ private_ ++ virtual_ ++ O.txt name ++ O.txt Syntax.Type.annotation_separator - ++ type_expr t.type_ ) + ++ type_expr t.type_) in let kind = Some "method" in let anchor = path_to_id t.id in @@ -871,9 +870,9 @@ module Make (Syntax : SYNTAX) = struct in let content = O.documentedSrc - ( O.keyword "val" ++ O.txt " " ++ mutable_ ++ virtual_ ++ O.txt name + (O.keyword "val" ++ O.txt " " ++ mutable_ ++ virtual_ ++ O.txt name ++ O.txt Syntax.Type.annotation_separator - ++ type_expr t.type_ ) + ++ type_expr t.type_) in let kind = Some "instance-variable" in let anchor = path_to_id t.id in @@ -917,7 +916,7 @@ module Make (Syntax : SYNTAX) = struct loop rest acc_items | Comment (`Docs c) -> let items = Sectioning.comment_items c in - loop rest (List.rev_append items acc_items) ) + loop rest (List.rev_append items acc_items)) in (* FIXME: use [t.self] *) loop c.items [] @@ -991,8 +990,8 @@ module Make (Syntax : SYNTAX) = struct let expr = attach_expansion (" = ", "object", "end") expansion summary in let content = O.documentedSrc - ( O.keyword "class" ++ O.txt " " ++ O.keyword "type" ++ O.txt " " - ++ virtual_ ++ params ++ O.txt " " ) + (O.keyword "class" ++ O.txt " " ++ O.keyword "type" ++ O.txt " " + ++ virtual_ ++ params ++ O.txt " ") @ cname @ expr in let kind = Some "class-type" in @@ -1067,7 +1066,7 @@ module Make (Syntax : SYNTAX) = struct loop rest acc_items | Comment (`Docs c) -> let items = Sectioning.comment_items c in - loop rest (List.rev_append items acc_items) ) + loop rest (List.rev_append items acc_items)) in loop s [] @@ -1191,7 +1190,7 @@ module Make (Syntax : SYNTAX) = struct | Functor (f_parameter, e) -> ( match simple_expansion_of e with | Some e -> Some (Functor (f_parameter, e)) - | None -> None ) + | None -> None) in match simple_expansion_of t with | None -> None @@ -1441,7 +1440,7 @@ module Make (Syntax : SYNTAX) = struct ++ match td.Lang.TypeDecl.Equation.manifest with | None -> assert false (* cf loader/cmti *) - | Some te -> type_expr te ) + | Some te -> type_expr te) and include_ (t : Odoc_model.Lang.Include.t) = let decl_hidden = @@ -1472,8 +1471,8 @@ module Make (Syntax : SYNTAX) = struct let content = signature t.expansion.content in let summary = O.render - ( O.keyword "include" ++ O.txt " " ++ include_decl - ++ if Syntax.Mod.include_semicolon then O.keyword ";" else O.noop ) + (O.keyword "include" ++ O.txt " " ++ include_decl + ++ if Syntax.Mod.include_semicolon then O.keyword ";" else O.noop) in let content = { Include.content; status; summary } in let kind = Some "include" in diff --git a/src/document/targets.ml b/src/document/targets.ml index 15972a46e3..08f7db8d3a 100644 --- a/src/document/targets.ml +++ b/src/document/targets.ml @@ -21,7 +21,7 @@ and signature (t : Odoc_model.Lang.Signature.t) = | Open _ | ModuleSubstitution _ | TypeSubstitution _ | Type _ | TypExt _ | Exception _ | Value _ | External _ | Class _ | ClassType _ | Comment (`Docs _) -> - add_items ~don't acc is ) + add_items ~don't acc is) in add_items ~don't:false [] t.items diff --git a/src/document/url.ml b/src/document/url.ml index 105f31ab0e..f3a3bada84 100644 --- a/src/document/url.ml +++ b/src/document/url.ml @@ -234,7 +234,7 @@ module Anchor = struct | { page; anchor = _; kind } -> (* Really ad-hoc and shitty, but it works. *) if kind = "page" then Ok { page; anchor; kind } - else Ok { page; anchor; kind = "" } ) + else Ok { page; anchor; kind = "" }) (* | _ -> Error (Unexpected_anchor ("label " ^ anchor)) *) @@ -259,7 +259,7 @@ module Anchor = struct | Constructor { name; _ } -> let kind = "constructor" in let suffix = name in - add_suffix ~kind url suffix ) + add_suffix ~kind url suffix) end type t = Anchor.t diff --git a/src/document/utils.ml b/src/document/utils.ml index d7be8bb497..326afd381b 100644 --- a/src/document/utils.ml +++ b/src/document/utils.ml @@ -6,7 +6,7 @@ let rec flatmap ?sep ~f = function | x :: xs -> ( let hd = f x in let tl = flatmap ?sep ~f xs in - match sep with None -> hd @ tl | Some sep -> hd @ sep @ tl ) + match sep with None -> hd @ tl | Some sep -> hd @ sep @ tl) let rec skip_until ~p = function | [] -> [] diff --git a/src/html/generator.ml b/src/html/generator.ml index 319bbf2757..202948ca32 100644 --- a/src/html/generator.ml +++ b/src/html/generator.ml @@ -174,9 +174,9 @@ let rec block ~resolve (l : Block.t) : flow Html.elt list = Html.dl ~a (Utils.list_concat_map l ~f:(fun (i, b) -> let i = - ( inline ~resolve i + (inline ~resolve i : phrasing Html.elt list - :> flow Html.elt list ) + :> flow Html.elt list) in [ Html.dt i; Html.dd (block ~resolve b) ])); ] @@ -307,8 +307,8 @@ and items ~resolve l : item Html.elt list = Html.div [ Html.div ~a - ( anchor_link - @ [ Html.div ~a:[ Html.a_class [ "doc" ] ] (docs @ content) ] ); + (anchor_link + @ [ Html.div ~a:[ Html.a_class [ "doc" ] ] (docs @ content) ]); ]; ] |> (continue_with [@tailcall]) rest @@ -336,9 +336,9 @@ module Toc = struct let rec section { Toc.url; text; children } = let text = inline_nolink text in let text = - ( text + (text : non_link_phrasing Html.elt list - :> Html_types.flow5_without_interactive Html.elt list ) + :> Html_types.flow5_without_interactive Html.elt list) in let href = Link.href ~resolve url in let link = Html.a ~a:[ Html.a_href href ] text in @@ -366,7 +366,7 @@ module Page = struct | `Include x -> ( match x.Include.status with | `Closed | `Open | `Default -> None - | `Inline -> Some 0 ) + | `Inline -> Some 0) let rec include_ ?theme_uri indent { Subpage.content; _ } = [ page ?theme_uri indent content ] diff --git a/src/html/link.ml b/src/html/link.ml index 6444364abf..d3463d5c6e 100644 --- a/src/html/link.ml +++ b/src/html/link.ml @@ -53,7 +53,7 @@ let href ~resolve t = match resolve with | Base xref_base_uri -> ( let page = xref_base_uri ^ String.concat "/" target_loc in - match anchor with "" -> page | anchor -> page ^ "#" ^ anchor ) + match anchor with "" -> page | anchor -> page ^ "#" ^ anchor) | Current path -> ( let current_loc = Path.for_linking path in @@ -88,4 +88,4 @@ let href ~resolve t = match (relative_target, anchor) with | [], "" -> "#" | page, "" -> String.concat "/" page - | page, anchor -> String.concat "/" page ^ "#" ^ anchor ) + | page, anchor -> String.concat "/" page ^ "#" ^ anchor) diff --git a/src/html/utils.ml b/src/html/utils.ml index d2467bc12e..6405866cf0 100644 --- a/src/html/utils.ml +++ b/src/html/utils.ml @@ -9,6 +9,6 @@ let rec list_concat_map ?sep ~f = function | x :: xs -> ( let hd = f x in let tl = list_concat_map ?sep ~f xs in - match sep with None -> hd @ tl | Some sep -> hd @ (sep :: tl) ) + match sep with None -> hd @ tl | Some sep -> hd @ sep :: tl) let optional_elt f ?a = function [] -> [] | l -> [ f ?a l ] diff --git a/src/latex/generator.ml b/src/latex/generator.ml index 9f0d9af7ce..9f707c100e 100644 --- a/src/latex/generator.ml +++ b/src/latex/generator.ml @@ -8,7 +8,7 @@ let rec list_concat_map ?sep ~f = function | x :: xs -> ( let hd = f x in let tl = list_concat_map ?sep ~f xs in - match sep with None -> hd @ tl | Some sep -> hd @ (sep :: tl) ) + match sep with None -> hd @ tl | Some sep -> hd @ sep :: tl) module Link = struct let rec flatten_path ppf (x : Odoc_document.Url.Path.t) = @@ -28,7 +28,7 @@ module Link = struct | "module" | "page" | "class" | "container-page" -> ( match url.parent with | None -> true - | Some url -> is_class_or_module_path url ) + | Some url -> is_class_or_module_path url) | _ -> false let should_inline status url = @@ -44,7 +44,7 @@ module Link = struct let pdir = dir p in match url.kind with | "container-page" -> Fpath.(pdir / url.name) - | _ -> pdir ) + | _ -> pdir) let file url = let rec l (url : Odoc_document.Url.Path.t) acc = @@ -55,7 +55,7 @@ module Link = struct | None -> assert false (* Only container-pages are allowed to have no parent *) - | Some p -> l p (url.name :: acc) ) + | Some p -> l p (url.name :: acc)) in String.concat "." (l url []) @@ -351,8 +351,8 @@ let rec documentedSrc (t : DocumentedSrc.t) = let code, _, rest = take_code t in non_empty_code_fragment code @ to_latex rest | Alternative (Expansion e) :: rest -> - ( if Link.should_inline e.status e.url then to_latex e.expansion - else non_empty_code_fragment e.summary ) + (if Link.should_inline e.status e.url then to_latex e.expansion + else non_empty_code_fragment e.summary) @ to_latex rest | Subpage subp :: rest -> Indented (items subp.content.items) :: to_latex rest diff --git a/src/manpage/generator.ml b/src/manpage/generator.ml index 5207d58974..c23d05c207 100644 --- a/src/manpage/generator.ml +++ b/src/manpage/generator.ml @@ -94,11 +94,11 @@ module Roff = struct let c = String.unsafe_get s i in if not (markup_text_need_esc c) then ( Bytes.unsafe_set b k c; - loop (i + 1) (k + 1) ) + loop (i + 1) (k + 1)) else ( Bytes.unsafe_set b k '\\'; Bytes.unsafe_set b (k + 1) c; - loop (i + 1) (k + 2) ) + loop (i + 1) (k + 2)) in loop 0 0 @@ -191,7 +191,7 @@ module Roff = struct | [] -> () | h :: t -> let is_macro = next_is_macro t in - ( match h with + (match h with | Concat l -> many ~indent ppf l | String s -> Format.pp_print_string ppf s | Font (s, t) -> pp_font ppf s "%a" (one ~indent) t @@ -209,7 +209,7 @@ module Roff = struct newline_if ppf (not is_macro) | Indent (i, content) -> let indent = indent + i in - one ~indent ppf content ); + one ~indent ppf content); many ~indent ppf t and one ~indent ppf x = many ~indent ppf @@ collapse x in Format.pp_set_margin ppf max_int; @@ -245,7 +245,7 @@ let strip l = loop acc t | Source code -> let acc = loop_source acc code in - loop acc t ) + loop acc t) and loop_source acc = function | [] -> acc | Source.Elt content :: t -> loop_source (List.rev_append content acc) t @@ -278,7 +278,7 @@ let rec source_code (s : Source.t) = match h with | Source.Elt i -> inline (strip i) ++ source_code t | Tag (None, s) -> source_code s ++ source_code t - | Tag (Some _, s) -> font "CB" (source_code s) ++ source_code t ) + | Tag (Some _, s) -> font "CB" (source_code s) ++ source_code t) and inline (l : Inline.t) = match l with @@ -303,7 +303,7 @@ and inline (l : Inline.t) = | InternalLink (Resolved (_, content) | Unresolved content) -> font "CI" (inline @@ strip content) ++ inline rest | Source content -> source_code content ++ inline rest - | Raw_markup t -> raw_markup t ++ inline rest ) + | Raw_markup t -> raw_markup t ++ inline rest) let rec block (l : Block.t) = match l with @@ -336,7 +336,7 @@ let rec block (l : Block.t) = | Source content -> env "EX" "EE" "" (source_code content) ++ continue rest | Verbatim content -> env "EX" "EE" "" (str "%s" content) ++ continue rest - | Raw_markup t -> raw_markup t ++ continue rest ) + | Raw_markup t -> raw_markup t ++ continue rest) let next_heading, reset_heading = let heading_stack = ref [] in @@ -400,7 +400,7 @@ let rec documentedSrc (l : DocumentedSrc.t) = if expansion_not_inlined url then let c, rest = take_code l in source_code c ++ continue rest - else documentedSrc expansion ) + else documentedSrc expansion) | Subpage p -> subpage p.content ++ continue rest | Documented _ | Nested _ -> let lines, _, rest = @@ -427,7 +427,7 @@ let rec documentedSrc (l : DocumentedSrc.t) = content ++ doc in let l = list ~sep:break (List.map f lines) in - indent 2 (break ++ l) ++ break_if_nonempty rest ++ continue rest ) + indent 2 (break ++ l) ++ break_if_nonempty rest ++ continue rest) and subpage { title = _; header = _; items; url = _ } = let content = items in @@ -467,7 +467,7 @@ and item ~nested (l : Item.t list) = | [] -> s | doc -> s ++ indent 2 (break ++ block doc) in - d ++ continue rest ) + d ++ continue rest) let on_sub subp = match subp with diff --git a/src/manpage/link.ml b/src/manpage/link.ml index dcd5570f2a..4d0f48ec59 100644 --- a/src/manpage/link.ml +++ b/src/manpage/link.ml @@ -34,7 +34,7 @@ let rec is_class_or_module_path (url : Url.Path.t) = | "module" | "page" | "container-page" | "class" -> ( match url.parent with | None -> true - | Some url -> is_class_or_module_path url ) + | Some url -> is_class_or_module_path url) | _ -> false let should_inline x = not @@ is_class_or_module_path x diff --git a/src/model/paths.ml b/src/model/paths.ml index 4f2df88889..f41681ee9c 100644 --- a/src/model/paths.ml +++ b/src/model/paths.ml @@ -633,7 +633,7 @@ module Path = struct | `Module (p, n) -> ( match canonical_ident p with | Some x -> Some (`Module ((x :> Identifier.Signature.t), n)) - | None -> None ) + | None -> None) | `Canonical (_, `Resolved p) -> Some (identifier p) | `Canonical (_, _) -> None | `Apply (_, _) -> None @@ -660,7 +660,7 @@ module Path = struct | `ModuleType (p, n) -> ( match Module.canonical_ident p with | Some x -> Some (`ModuleType ((x :> Identifier.Signature.t), n)) - | None -> None ) + | None -> None) | `SubstT (_, _) -> None | `OpaqueModuleType m -> canonical_ident (m :> t) end @@ -757,7 +757,7 @@ module Fragment = struct | `Module (p, name) -> ( match split_parent p with | Base i -> Branch (name, `Root i) - | Branch (base, m) -> Branch (base, `Module (m, name)) ) + | Branch (base, m) -> Branch (base, `Module (m, name))) module Signature = struct type t = Paths_types.Resolved_fragment.signature @@ -771,7 +771,7 @@ module Fragment = struct match split_parent m with | Base _ -> (ModuleName.to_string name, None) | Branch (base, m) -> - (ModuleName.to_string base, Some (`Module (m, name))) ) + (ModuleName.to_string base, Some (`Module (m, name)))) let rec identifier : t -> Identifier.Signature.t = function | `Root (`ModuleType i) -> @@ -796,7 +796,7 @@ module Fragment = struct match split_parent m with | Base _ -> (ModuleName.to_string name, None) | Branch (base, m) -> - (ModuleName.to_string base, Some (`Module (m, name))) ) + (ModuleName.to_string base, Some (`Module (m, name)))) | `OpaqueModule m -> split m end @@ -808,17 +808,17 @@ module Fragment = struct match split_parent m with | Base _ -> (TypeName.to_string name, None) | Branch (base, m) -> - (ModuleName.to_string base, Some (`Type (m, name))) ) + (ModuleName.to_string base, Some (`Type (m, name)))) | `Class (m, name) -> ( match split_parent m with | Base _ -> (ClassName.to_string name, None) | Branch (base, m) -> - (ModuleName.to_string base, Some (`Class (m, name))) ) + (ModuleName.to_string base, Some (`Class (m, name)))) | `ClassType (m, name) -> ( match split_parent m with | Base _ -> (ClassTypeName.to_string name, None) | Branch (base, m) -> - (ModuleName.to_string base, Some (`ClassType (m, name))) ) + (ModuleName.to_string base, Some (`ClassType (m, name)))) end type leaf = Paths_types.Resolved_fragment.leaf @@ -827,7 +827,8 @@ module Fragment = struct | `Root (`ModuleType _r) -> assert false | `Root (`Module _r) -> assert false | `Subst (s, _) -> Path.Resolved.identifier (s :> Path.Resolved.t) - | `SubstAlias (p, _) -> (Path.Resolved.Module.identifier p :> Identifier.t) + | `SubstAlias (p, _) -> + (Path.Resolved.Module.identifier p :> Identifier.t) | `Module (m, n) -> `Module (Signature.identifier m, n) | `Type (m, n) -> `Type (Signature.identifier m, n) | `Class (m, n) -> `Class (Signature.identifier m, n) @@ -855,13 +856,13 @@ module Fragment = struct | `Resolved r -> ( match Resolved.split_parent r with | Resolved.Base i -> Base (Some i) - | Resolved.Branch (base, m) -> Branch (base, `Resolved m) ) + | Resolved.Branch (base, m) -> Branch (base, `Resolved m)) | `Dot (m, name) -> ( match split_parent m with | Base None -> Branch (ModuleName.of_string name, `Root) | Base (Some i) -> Branch (ModuleName.of_string name, `Resolved (`Root i)) - | Branch (base, m) -> Branch (base, `Dot (m, name)) ) + | Branch (base, m) -> Branch (base, `Dot (m, name))) module Signature = struct type t = Paths_types.Fragment.signature @@ -876,7 +877,7 @@ module Fragment = struct match split_parent m with | Base _ -> (name, None) | Branch (base, m) -> - (ModuleName.to_string base, Some (`Dot (m, name))) ) + (ModuleName.to_string base, Some (`Dot (m, name)))) end module Module = struct @@ -891,7 +892,7 @@ module Fragment = struct match split_parent m with | Base _ -> (name, None) | Branch (base, m) -> - (ModuleName.to_string base, Some (`Dot (m, name))) ) + (ModuleName.to_string base, Some (`Dot (m, name)))) end module Type = struct @@ -906,7 +907,7 @@ module Fragment = struct match split_parent m with | Base _ -> (name, None) | Branch (base, m) -> - (ModuleName.to_string base, Some (`Dot (m, name))) ) + (ModuleName.to_string base, Some (`Dot (m, name)))) end type leaf = Paths_types.Fragment.leaf diff --git a/src/model/predefined.ml b/src/model/predefined.ml index 973eb16999..acb30cbc40 100644 --- a/src/model/predefined.ml +++ b/src/model/predefined.ml @@ -577,19 +577,17 @@ let floatarray_decl = let doc = [ `Paragraph - ( words [ "This"; "type"; "is"; "used"; "to"; "implement"; "the" ] - @ [ - `Space; - `Reference - ( `Module - ( `Root ("Array", `TModule), - ModuleName.of_string "Floatarray" ), - [] ); - `Space; - ] - @ words - [ "module."; "It"; "should"; "not"; "be"; "used"; "directly." ] - |> List.map (Location_.at predefined_location) ); + (words [ "This"; "type"; "is"; "used"; "to"; "implement"; "the" ] + @ [ + `Space; + `Reference + ( `Module + (`Root ("Array", `TModule), ModuleName.of_string "Floatarray"), + [] ); + `Space; + ] + @ words [ "module."; "It"; "should"; "not"; "be"; "used"; "directly." ] + |> List.map (Location_.at predefined_location)); ] |> List.map (Location_.at predefined_location) in diff --git a/src/odoc/bin/main.ml b/src/odoc/bin/main.ml index 24a3c8d1fb..97bb1ae13f 100644 --- a/src/odoc/bin/main.ml +++ b/src/odoc/bin/main.ml @@ -91,7 +91,7 @@ end = struct "ERROR: the name of the .odoc file produced from a .mld must start \ with 'page-'\n\ %!"; - exit 1 ); + exit 1); output | None -> let output = @@ -180,9 +180,9 @@ end = struct in Term.( const handle_error - $ ( const compile $ hidden $ odoc_file_directories $ resolve_fwd_refs - $ dst $ package_opt $ parent_opt $ open_modules $ children $ input - $ warn_error )) + $ (const compile $ hidden $ odoc_file_directories $ resolve_fwd_refs $ dst + $ package_opt $ parent_opt $ open_modules $ children $ input $ warn_error + )) let info = Term.info "compile" @@ -296,8 +296,8 @@ end = struct in Term.( const handle_error - $ ( const process $ R.extra_args $ hidden $ odoc_file_directories - $ dst ~create:true () $ syntax $ input $ warn_error )) + $ (const process $ R.extra_args $ hidden $ odoc_file_directories + $ dst ~create:true () $ syntax $ input $ warn_error)) let info = let doc = @@ -325,8 +325,8 @@ end = struct in Term.( const handle_error - $ ( const generate $ R.extra_args $ hidden $ dst ~create:true () - $ syntax $ input )) + $ (const generate $ R.extra_args $ hidden $ dst ~create:true () $ syntax + $ input)) let info = let doc = @@ -466,8 +466,8 @@ end = struct in Term.( const handle_error - $ ( const html_fragment $ odoc_file_directories $ xref_base_uri $ output - $ input $ warn_error )) + $ (const html_fragment $ odoc_file_directories $ xref_base_uri $ output + $ input $ warn_error)) let info = Term.info ~doc:"Generates an html fragment file from an mld one" diff --git a/src/odoc/compilation_unit.ml b/src/odoc/compilation_unit.ml index 1de5a8415b..265dd55206 100644 --- a/src/odoc/compilation_unit.ml +++ b/src/odoc/compilation_unit.ml @@ -44,4 +44,4 @@ let load file = Printf.sprintf "Error while unmarshalling %S: %s\n%!" file (match exn with Failure s -> s | _ -> Printexc.to_string exn) in - Error (`Msg msg) ) + Error (`Msg msg)) diff --git a/src/odoc/compile.ml b/src/odoc/compile.ml index 53d97afb07..f2785beed5 100644 --- a/src/odoc/compile.ml +++ b/src/odoc/compile.ml @@ -40,7 +40,7 @@ let parent directories parent_cli_spec = | `Root (p, `TPage) | `Root (p, `TUnknown) -> ( match Env.lookup_page ap p with | Some r -> Ok r - | None -> Error (`Msg "Couldn't find specified parent page") ) + | None -> Error (`Msg "Couldn't find specified parent page")) | _ -> Error (`Msg "Expecting page as parent") in let extract_parent = function @@ -65,10 +65,9 @@ let resolve_and_substitute ~env ~output ~warn_error parent input_file read_file >>= fun unit -> if not unit.Odoc_model.Lang.Compilation_unit.interface then Printf.eprintf "WARNING: not processing the \"interface\" file.%s\n%!" - ( if not (Filename.check_suffix filename "cmt") then "" (* ? *) + (if not (Filename.check_suffix filename "cmt") then "" (* ? *) else - Printf.sprintf " Using %S while you should use the .cmti file" filename - ); + Printf.sprintf " Using %S while you should use the .cmti file" filename); let env = Env.build env (`Unit unit) in Odoc_xref2.Compile.compile env unit @@ -183,13 +182,13 @@ let compile ~env ~directories ~parent_cli_spec ~hidden ~children ~output let ext = Fs.File.get_ext input in if ext = ".mld" then mld ~parent_spec ~output ~warn_error ~children input else - ( match ext with + (match ext with | ".cmti" -> Ok Odoc_loader.read_cmti | ".cmt" -> Ok Odoc_loader.read_cmt | ".cmi" -> Ok Odoc_loader.read_cmi | _ -> Error - (`Msg "Unknown extension, expected one of: cmti, cmt, cmi or mld.") ) + (`Msg "Unknown extension, expected one of: cmti, cmt, cmi or mld.")) >>= fun loader -> let parent = match parent_spec with diff --git a/src/odoc/env.ml b/src/odoc/env.ml index 7056100caf..c066b7a8eb 100644 --- a/src/odoc/env.ml +++ b/src/odoc/env.ml @@ -62,7 +62,7 @@ module Accessible_paths = struct let ufile = Fs.File.create ~directory ~name:uname in match Unix.stat (Fs.File.to_string ufile) with | _ -> loop (ufile :: acc) dirs - | exception Unix.Unix_error _ -> loop acc dirs ) ) + | exception Unix.Unix_error _ -> loop acc dirs)) in loop [] t.directories @@ -175,17 +175,17 @@ let lookup_unit ~important_digests ap target_name import_map = (* If we can't find a module that matches the digest, return Not_found *) handle_root @@ List.find (fun root -> root.Odoc_model.Root.digest = d) roots - with Not_found -> Odoc_xref2.Env.Not_found ) + with Not_found -> Odoc_xref2.Env.Not_found) in match StringMap.find target_name import_map with | Odoc_model.Lang.Compilation_unit.Import.Unresolved (_, digest) -> ( match digest with | None when important_digests -> Odoc_xref2.Env.Forward_reference - | _ -> find_root ~digest ) + | _ -> find_root ~digest) | Odoc_model.Lang.Compilation_unit.Import.Resolved (root, _) -> ( match root.file with | Compilation_unit { hidden; _ } -> Found { root; hidden } - | Page _ -> assert false ) + | Page _ -> assert false) | exception Not_found -> if important_digests then Odoc_xref2.Env.Not_found else find_root ~digest:None @@ -243,8 +243,8 @@ let create ?(important_digests = true) ~directories ~open_modules : builder = | Page _ -> assert false | Compilation_unit { name; hidden } when target_name = name -> Found { root; hidden } - | Compilation_unit _ -> Not_found ) - | x -> x ) + | Compilation_unit _ -> Not_found) + | x -> x) in let fetch_unit root : (Odoc_model.Lang.Compilation_unit.t, _) Result.result = diff --git a/src/odoc/html_fragment.ml b/src/odoc/html_fragment.ml index 78692fd8ce..acc0d3c177 100644 --- a/src/odoc/html_fragment.ml +++ b/src/odoc/html_fragment.ml @@ -34,6 +34,6 @@ let from_mld ~xref_base_uri ~env ~output ~warn_error input = |> Odoc_model.Error.handle_errors_and_warnings ~warn_error >>= function | `Docs content -> to_html content - | `Stop -> to_html [] ) + | `Stop -> to_html []) (* TODO: Error? *) diff --git a/src/odoc/page.ml b/src/odoc/page.ml index 654e744d74..f0814be830 100644 --- a/src/odoc/page.ml +++ b/src/odoc/page.ml @@ -53,4 +53,4 @@ let load = Printf.sprintf "Error while unmarshalling %S: %s\n%!" file (match exn with Failure s -> s | _ -> Printexc.to_string exn) in - Error (`Msg msg) ) + Error (`Msg msg)) diff --git a/src/parser/reference.ml b/src/parser/reference.ml index 6af952a56f..b1d860497b 100644 --- a/src/parser/reference.ml +++ b/src/parser/reference.ml @@ -80,7 +80,7 @@ let match_reference_kind warnings location s : | Some kind -> kind | None -> Parse_error.unknown_reference_qualifier s location - |> Error.raise_exception ) + |> Error.raise_exception) (* The string is scanned right-to-left, because we are interested in right-most hyphens. The tokens are also returned in right-to-left order, because the @@ -165,7 +165,7 @@ let parse warnings whole_reference_location s : `Root (identifier, kind) | _ -> expected [ "module"; "module-type" ] location - |> Error.raise_exception ) + |> Error.raise_exception) | next_token :: tokens -> ( match kind with | `TUnknown -> @@ -178,7 +178,7 @@ let parse warnings whole_reference_location s : (signature next_token tokens, ModuleTypeName.of_string identifier) | _ -> expected [ "module"; "module-type" ] location - |> Error.raise_exception ) + |> Error.raise_exception) and parent (kind, identifier, location) tokens : Parent.t = let kind = match_reference_kind warnings location kind in match tokens with @@ -191,7 +191,7 @@ let parse warnings whole_reference_location s : expected [ "module"; "module-type"; "type"; "class"; "class-type" ] location - |> Error.raise_exception ) + |> Error.raise_exception) | next_token :: tokens -> ( match kind with | `TUnknown -> @@ -213,7 +213,7 @@ let parse warnings whole_reference_location s : expected [ "module"; "module-type"; "type"; "class"; "class-type" ] location - |> Error.raise_exception ) + |> Error.raise_exception) in let class_signature (kind, identifier, location) tokens : ClassSignature.t = @@ -245,14 +245,14 @@ let parse warnings whole_reference_location s : | [] -> ( match kind with | (`TUnknown | `TType) as kind -> `Root (identifier, kind) - | _ -> expected [ "type" ] location |> Error.raise_exception ) + | _ -> expected [ "type" ] location |> Error.raise_exception) | next_token :: tokens -> ( match kind with | `TUnknown -> `Dot ((parent next_token tokens :> LabelParent.t), identifier) | `TType -> `Type (signature next_token tokens, TypeName.of_string identifier) - | _ -> expected [ "type" ] location |> Error.raise_exception ) + | _ -> expected [ "type" ] location |> Error.raise_exception) in let rec label_parent (kind, identifier, location) tokens : LabelParent.t = @@ -267,7 +267,7 @@ let parse warnings whole_reference_location s : expected [ "module"; "module-type"; "type"; "class"; "class-type"; "page" ] location - |> Error.raise_exception ) + |> Error.raise_exception) | next_token :: tokens -> ( match kind with | `TUnknown -> `Dot (label_parent next_token tokens, identifier) @@ -288,7 +288,7 @@ let parse warnings whole_reference_location s : expected [ "module"; "module-type"; "type"; "class"; "class-type" ] location - |> Error.raise_exception ) + |> Error.raise_exception) in let start_from_last_component (kind, identifier, location) old_kind tokens = @@ -304,14 +304,14 @@ let parse warnings whole_reference_location s : match new_kind with | `TUnknown -> old_kind | _ -> - ( if old_kind <> new_kind then - let new_kind_string = - match kind with Some s -> s | None -> "" - in - Parse_error.reference_kinds_do_not_match old_kind_string - new_kind_string whole_reference_location - |> Error.warning warnings ); - new_kind ) + (if old_kind <> new_kind then + let new_kind_string = + match kind with Some s -> s | None -> "" + in + Parse_error.reference_kinds_do_not_match old_kind_string + new_kind_string whole_reference_location + |> Error.warning warnings); + new_kind) in match tokens with @@ -371,7 +371,7 @@ let parse warnings whole_reference_location s : Parse_error.not_allowed ~what:"Page label" ~in_what:"the last component of a reference path" ~suggestion location - |> Error.raise_exception ) + |> Error.raise_exception) in let old_kind, s, location = @@ -381,7 +381,7 @@ let parse warnings whole_reference_location s : | ')' -> ( match String.rindex_from s index '(' with | index -> find_old_reference_kind_separator (index - 1) - | exception (Not_found as exn) -> raise exn ) + | exception (Not_found as exn) -> raise exn) | _ -> find_old_reference_kind_separator (index - 1) | exception Invalid_argument _ -> raise Not_found in diff --git a/src/parser/semantics.ml b/src/parser/semantics.ml index c2d25bbfac..003985c38b 100644 --- a/src/parser/semantics.ml +++ b/src/parser/semantics.ml @@ -47,7 +47,7 @@ let leaf_inline_element : Error.warning status.warnings (Parse_error.default_raw_markup_target_not_supported location); Location.same element (`Code_span s) - | Some target -> Location.same element (`Raw_markup (target, s)) ) + | Some target -> Location.same element (`Raw_markup (target, s))) let rec non_link_inline_element : status -> @@ -57,8 +57,8 @@ let rec non_link_inline_element : fun status ~surrounding element -> match element with | { value = #ast_leaf_inline_element; _ } as element -> - ( leaf_inline_element status element - :> Comment.non_link_inline_element with_location ) + (leaf_inline_element status element + :> Comment.non_link_inline_element with_location) | { value = `Styled (style, content); _ } -> `Styled (style, non_link_inline_elements status ~surrounding content) |> Location.same element @@ -83,8 +83,8 @@ let rec inline_element : fun status element -> match element with | { value = #ast_leaf_inline_element; _ } as element -> - ( leaf_inline_element status element - :> Comment.inline_element with_location ) + (leaf_inline_element status element + :> Comment.inline_element with_location) | { value = `Styled (style, content); location } -> `Styled (style, inline_elements status content) |> Location.at location | { value = `Reference (kind, target, content) as value; location } -> ( @@ -102,7 +102,7 @@ let rec inline_element : | `Simple -> `Code_span target | `With_text -> `Styled (`Emphasis, content) in - inline_element status (Location.at location placeholder) ) + inline_element status (Location.at location placeholder)) | { value = `Link (target, content) as value; location } -> `Link (target, non_link_inline_elements status ~surrounding:value content) |> Location.at location @@ -162,7 +162,7 @@ let tag : Error.warning status.warnings e; let placeholder = [ `Word "@canonical"; `Space " "; `Code_span s ] in let placeholder = List.map (Location.at location) placeholder in - Error (Location.at location (`Paragraph placeholder)) ) + Error (Location.at location (`Paragraph placeholder))) | `Deprecated content -> ok (`Deprecated (nestable_block_elements status content)) | `Param (name, content) -> @@ -273,14 +273,14 @@ let section_heading : (* Implicitly promote to level-5. *) `Subparagraph in - ( match top_heading_level with + (match top_heading_level with | Some top_level when status.sections_allowed = `All && level <= top_level && level <= 5 -> Error.warning status.warnings (Parse_error.heading_level_should_be_lower_than_top_level level top_level location) - | _ -> () ); + | _ -> ()); let element = `Heading (level', label, content) in let element = Location.at location element in let top_heading_level = @@ -296,7 +296,7 @@ let validate_first_page_heading status ast_element = | _invalid_ast_element -> let filename = Odoc_model.Names.PageName.to_string name ^ ".mld" in Error.warning status.warnings - (Parse_error.page_heading_required filename) ) + (Parse_error.page_heading_required filename)) | _not_a_page -> () let top_level_block_elements : @@ -332,7 +332,7 @@ let top_level_block_elements : ast_elements | Result.Error placeholder -> traverse ~top_heading_level comment_elements_acc - (placeholder :: ast_elements) ) + (placeholder :: ast_elements)) | { value = `Heading _ as heading; _ } -> let top_heading_level, element = section_heading status ~top_heading_level @@ -340,7 +340,7 @@ let top_level_block_elements : in traverse ~top_heading_level (element :: comment_elements_acc) - ast_elements ) + ast_elements) in let top_heading_level = (* Non-page documents have a generated title. *) diff --git a/src/parser/syntax.ml b/src/parser/syntax.ml index 1cb3417a05..919071361e 100644 --- a/src/parser/syntax.ml +++ b/src/parser/syntax.ml @@ -253,15 +253,15 @@ and delimited_inline_element_list : let element = Location.same next_token (`Space ws) in consume_elements ~at_start_of_line:true (element :: acc) | (`Minus | `Plus) as bullet -> - ( if at_start_of_line then - let suggestion = - Printf.sprintf "move %s so it isn't the first thing on the line." - (Token.print bullet) - in - Parse_error.not_allowed ~what:(Token.describe bullet) - ~in_what:(Token.describe parent_markup) - ~suggestion next_token.location - |> Error.warning input.warnings ); + (if at_start_of_line then + let suggestion = + Printf.sprintf "move %s so it isn't the first thing on the line." + (Token.print bullet) + in + Parse_error.not_allowed ~what:(Token.describe bullet) + ~in_what:(Token.describe parent_markup) + ~suggestion next_token.location + |> Error.warning input.warnings); let acc = inline_element input next_token.location bullet :: acc in consume_elements ~at_start_of_line:false acc @@ -565,7 +565,7 @@ let rec block_element_list : | Top_level -> (List.rev acc, next_token, where_in_line) | In_shorthand_list -> (List.rev acc, next_token, where_in_line) | In_explicit_list -> (List.rev acc, next_token, where_in_line) - | In_tag -> (List.rev acc, next_token, where_in_line) ) + | In_tag -> (List.rev acc, next_token, where_in_line)) (* Whitespace. This can terminate some kinds of block elements. It is also necessary to track it to interpret [`Minus] and [`Plus] correctly, as well as to ensure that all block elements begin on their own line. *) @@ -583,7 +583,7 @@ let rec block_element_list : (* Otherwise, blank lines are pretty much like single newlines. *) | _ -> junk input; - consume_block_elements ~parsed_a_tag `At_start_of_line acc ) + consume_block_elements ~parsed_a_tag `At_start_of_line acc) (* Explicit list items ([{li ...}] and [{- ...}]) can never appear directly in block content. They can only appear inside [{ul ...}] and [{ol ...}]. So, catch those. *) @@ -714,7 +714,7 @@ let rec block_element_list : | (`Inline | `Open | `Closed) as tag -> let tag = Location.at location (`Tag tag) in consume_block_elements ~parsed_a_tag:true `After_text - (tag :: acc) ) ) + (tag :: acc))) | { value = #token_that_always_begins_an_inline_element; _ } as next_token -> warn_if_after_tags next_token; @@ -805,12 +805,12 @@ let rec block_element_list : let acc = block :: acc in consume_block_elements ~parsed_a_tag `After_text acc | { value = (`Minus | `Plus) as token; location } as next_token -> ( - ( match where_in_line with + (match where_in_line with | `After_text | `After_shorthand_bullet -> Parse_error.should_begin_on_its_own_line ~what:(Token.describe token) location |> Error.warning input.warnings - | _ -> () ); + | _ -> ()); warn_if_after_tags next_token; @@ -831,7 +831,7 @@ let rec block_element_list : let block = accepted_in_all_contexts context block in let block = Location.at location block in let acc = block :: acc in - consume_block_elements ~parsed_a_tag where_in_line acc ) + consume_block_elements ~parsed_a_tag where_in_line acc) | { value = `Begin_section_heading (level, label) as token; location } as next_token -> ( warn_if_after_tags next_token; @@ -892,7 +892,7 @@ let rec block_element_list : let heading = `Heading (level, label, content) in let heading = Location.at location heading in let acc = heading :: acc in - consume_block_elements ~parsed_a_tag `After_text acc ) + consume_block_elements ~parsed_a_tag `After_text acc) in let where_in_line = @@ -947,7 +947,7 @@ and shorthand_list_items : |> Error.warning input.warnings; let acc = content :: acc in - consume_list_items stream_head where_in_line acc ) + consume_list_items stream_head where_in_line acc) else (List.rev acc, where_in_line) in @@ -993,26 +993,26 @@ and explicit_list_items : (* '{li', represented by [`Begin_list_item `Li], must be followed by whitespace. *) - ( if kind = `Li then - match (peek input).value with - | `Space _ | `Single_newline _ | `Blank_line _ | `Right_brace -> - () - (* The presence of [`Right_brace] above requires some explanation: - - - It is better to be silent about missing whitespace if the next - token is [`Right_brace], because the error about an empty list - item will be generated below, and that error is more important to - the user. - - The [`Right_brace] token also happens to include all whitespace - before it, as a convenience for the rest of the parser. As a - result, not ignoring it could be wrong: there could in fact be - whitespace in the concrete syntax immediately after '{li', just - it is not represented as [`Space], [`Single_newline], or - [`Blank_line]. *) - | _ -> - Parse_error.should_be_followed_by_whitespace next_token.location - ~what:(Token.print token) - |> Error.warning input.warnings ); + (if kind = `Li then + match (peek input).value with + | `Space _ | `Single_newline _ | `Blank_line _ | `Right_brace -> + () + (* The presence of [`Right_brace] above requires some explanation: + + - It is better to be silent about missing whitespace if the next + token is [`Right_brace], because the error about an empty list + item will be generated below, and that error is more important to + the user. + - The [`Right_brace] token also happens to include all whitespace + before it, as a convenience for the rest of the parser. As a + result, not ignoring it could be wrong: there could in fact be + whitespace in the concrete syntax immediately after '{li', just + it is not represented as [`Space], [`Single_newline], or + [`Blank_line]. *) + | _ -> + Parse_error.should_be_followed_by_whitespace next_token.location + ~what:(Token.print token) + |> Error.warning input.warnings); let content, token_after_list_item, _where_in_line = block_element_list In_explicit_list ~parent_markup:token input @@ -1023,13 +1023,13 @@ and explicit_list_items : ~what:(Token.describe token) |> Error.warning input.warnings; - ( match token_after_list_item.value with + (match token_after_list_item.value with | `Right_brace -> junk input | `End -> Parse_error.not_allowed token_after_list_item.location ~what:(Token.describe `End) ~in_what:(Token.describe token) - |> Error.warning input.warnings ); + |> Error.warning input.warnings); let acc = content :: acc in consume_list_items acc @@ -1077,6 +1077,6 @@ let parse warnings tokens = in junk input; - elements @ (block :: parse_block_elements ()) + elements @ block :: parse_block_elements () in parse_block_elements () diff --git a/src/xref2/cfrag.ml b/src/xref2/cfrag.ml index 9b9bfff1c3..82ba01f45b 100644 --- a/src/xref2/cfrag.ml +++ b/src/xref2/cfrag.ml @@ -48,7 +48,7 @@ let rec resolved_signature_split_parent : | `Module (p, name) -> ( match resolved_signature_split_parent p with | RBase i -> RBranch (name, `Module (`Root i, name)) - | RBranch (base, m) -> RBranch (base, `Module (m, name)) ) + | RBranch (base, m) -> RBranch (base, `Module (m, name))) (* Note that this returns an unresolved fragment by design *) let rec signature_split_parent : signature -> base_name = function @@ -56,11 +56,11 @@ let rec signature_split_parent : signature -> base_name = function | `Resolved r -> ( match resolved_signature_split_parent r with | RBase _ -> Base None - | RBranch (base, m) -> Branch (base, `Resolved m) ) + | RBranch (base, m) -> Branch (base, `Resolved m)) | `Dot (m, name) -> ( match signature_split_parent m with | Base _ -> Branch (ModuleName.of_string name, `Root) - | Branch (base, m) -> Branch (base, `Dot (m, name)) ) + | Branch (base, m) -> Branch (base, `Dot (m, name))) let rec resolved_module_split : resolved_module -> string * resolved_module option = function @@ -70,7 +70,7 @@ let rec resolved_module_split : match resolved_signature_split_parent m with | RBase _ -> (ModuleName.to_string name, None) | RBranch (base, m) -> - (ModuleName.to_string base, Some (`Module (m, name))) ) + (ModuleName.to_string base, Some (`Module (m, name)))) | `OpaqueModule m -> resolved_module_split m let module_split : module_ -> string * module_ option = function @@ -81,7 +81,7 @@ let module_split : module_ -> string * module_ option = function | `Dot (m, name) -> ( match signature_split_parent m with | Base _ -> (name, None) - | Branch (base, m) -> (ModuleName.to_string base, Some (`Dot (m, name))) ) + | Branch (base, m) -> (ModuleName.to_string base, Some (`Dot (m, name)))) let resolved_type_split : resolved_type -> string * resolved_type option = function @@ -99,7 +99,7 @@ let resolved_type_split : resolved_type -> string * resolved_type option = match resolved_signature_split_parent m with | RBase _ -> (ClassTypeName.to_string name, None) | RBranch (base, m) -> - (ModuleName.to_string base, Some (`ClassType (m, name))) ) + (ModuleName.to_string base, Some (`ClassType (m, name)))) let type_split : type_ -> string * type_ option = function | `Resolved r -> @@ -109,7 +109,7 @@ let type_split : type_ -> string * type_ option = function | `Dot (m, name) -> ( match signature_split_parent m with | Base _ -> (name, None) - | Branch (base, m) -> (ModuleName.to_string base, Some (`Dot (m, name))) ) + | Branch (base, m) -> (ModuleName.to_string base, Some (`Dot (m, name)))) let rec unresolve_module : resolved_module -> module_ = function | `OpaqueModule m | `Subst (_, m) | `SubstAlias (_, m) -> unresolve_module m diff --git a/src/xref2/compile.ml b/src/xref2/compile.ml index 6644a8a84d..f8833da1fc 100644 --- a/src/xref2/compile.ml +++ b/src/xref2/compile.ml @@ -19,7 +19,7 @@ let type_path : Env.t -> Paths.Path.Type.t -> Paths.Path.Type.t = let cp = Component.Of_Lang.(type_path empty p) in match Tools.resolve_type_path env cp with | Ok p' -> `Resolved (Cpath.resolved_type_path_of_cpath p') - | Error _ -> p ) + | Error _ -> p) and module_type_path : Env.t -> Paths.Path.ModuleType.t -> Paths.Path.ModuleType.t = @@ -30,7 +30,7 @@ and module_type_path : let cp = Component.Of_Lang.(module_type_path empty p) in match Tools.resolve_module_type_path env cp with | Ok p' -> `Resolved (Cpath.resolved_module_type_path_of_cpath p') - | Error _ -> p ) + | Error _ -> p) and module_path : Env.t -> Paths.Path.Module.t -> Paths.Path.Module.t = fun env p -> @@ -40,7 +40,7 @@ and module_path : Env.t -> Paths.Path.Module.t -> Paths.Path.Module.t = let cp = Component.Of_Lang.(module_path empty p) in match Tools.resolve_module_path env cp with | Ok p' -> `Resolved (Cpath.resolved_module_path_of_cpath p') - | Error _ -> p ) + | Error _ -> p) and class_type_path : Env.t -> Paths.Path.ClassType.t -> Paths.Path.ClassType.t = @@ -51,7 +51,7 @@ and class_type_path : Env.t -> Paths.Path.ClassType.t -> Paths.Path.ClassType.t let cp = Component.Of_Lang.(class_type_path empty p) in match Tools.resolve_class_type_path env cp with | Ok p' -> `Resolved (Cpath.resolved_class_type_path_of_cpath p') - | Error _ -> Cpath.class_type_path_of_cpath cp ) + | Error _ -> Cpath.class_type_path_of_cpath cp) let rec unit (resolver : Env.resolver) t = let open Compilation_unit in @@ -473,7 +473,7 @@ and module_type_expr_sub id ~fragment_root (sg_res, env, subs) lsub = in match sg_and_sub with | Ok (sg', sub') -> (Ok sg', env, sub' :: subs) - | Error _ -> (sg_res, env, lsub :: subs) ) + | Error _ -> (sg_res, env, lsub :: subs)) and module_type_map_subs env id cexpr subs = let rec find_parent : Component.ModuleType.U.expr -> Cfrag.root option = @@ -507,7 +507,7 @@ and module_type_map_subs env id cexpr subs = (Ok sg, env, []) subs in let subs = List.rev subs in - Some subs ) + Some subs) and u_module_type_expr : Env.t -> Id.Signature.t -> ModuleType.U.expr -> ModuleType.U.expr = @@ -537,8 +537,8 @@ and u_module_type_expr : in match expansion with | Ok sg -> Signature Lang_of.(signature id empty sg) - | _ -> result ) - | _ -> result ) + | _ -> result) + | _ -> result) | TypeOf { t_desc; t_expansion } -> let t_desc = match t_desc with @@ -563,7 +563,7 @@ and module_type_expr : Some (simple_expansion env id e) | Error e -> Errors.report ~what:(`Module_type_expr ce) ~tools_error:e `Expand; - None ) + None) in match expr with | Signature s -> Signature (signature env id s) @@ -583,7 +583,7 @@ and module_type_expr : let subs' = module_type_map_subs env id cexpr w_substitutions in match subs' with | None -> With { w_substitutions; w_expansion; w_expr } - | Some s -> With { w_substitutions = s; w_expansion; w_expr } ) ) + | Some s -> With { w_substitutions = s; w_expansion; w_expr })) | Functor (param, res) -> let param' = functor_parameter env param in let env' = Env.add_functor_parameter param env in @@ -703,7 +703,7 @@ and type_expression_package env parent p = { path = module_type_path env p.path; substitutions = List.map substitution p.substitutions; - } ) + }) | Error _ -> { p with path = Cpath.module_type_path_of_cpath cp } and type_expression : Env.t -> Id.Parent.t -> _ -> _ = @@ -725,7 +725,7 @@ and type_expression : Env.t -> Id.Parent.t -> _ -> _ = | Ok (_cp, `FType_removed (_, x, _eq)) -> (* Substitute type variables ? *) Lang_of.(type_expr empty parent x) - | Error _ -> Constr (Cpath.type_path_of_cpath cp, ts) ) + | Error _ -> Constr (Cpath.type_path_of_cpath cp, ts)) | Polymorphic_variant v -> Polymorphic_variant (type_expression_polyvar env parent v) | Object o -> Object (type_expression_object env parent o) diff --git a/src/xref2/component.ml b/src/xref2/component.ml index 00ab1b5d71..924f129364 100644 --- a/src/xref2/component.ml +++ b/src/xref2/component.ml @@ -828,7 +828,7 @@ module Fmt = struct | Constr (p, args) -> ( match args with | [] -> Format.fprintf ppf "%a" type_path p - | _ -> Format.fprintf ppf "[%a] %a" type_expr_list args type_path p ) + | _ -> Format.fprintf ppf "[%a] %a" type_expr_list args type_path p) | Polymorphic_variant poly -> Format.fprintf ppf "(poly_var %a)" type_expr_polymorphic_variant poly | Object x -> type_object ppf x @@ -1591,8 +1591,8 @@ module Of_Lang = struct | #Paths.Identifier.Module.t as id -> (Maps.Module.find id ident_map.modules :> Ident.path_module) | #Paths.Identifier.FunctorParameter.t as id -> - ( Maps.FunctorParameter.find id ident_map.functor_parameters - :> Ident.path_module ) + (Maps.FunctorParameter.find id ident_map.functor_parameters + :> Ident.path_module) | _ -> raise Not_found let rec resolved_module_path : @@ -1658,7 +1658,7 @@ module Of_Lang = struct | `Identifier (i, b) -> ( match identifier find_any_module ident_map i with | `Identifier i -> `Identifier (i, b) - | `Local i -> `Local (i, b) ) + | `Local i -> `Local (i, b)) | `Dot (path', x) -> `Dot (module_path ident_map path', x) | `Apply (p1, p2) -> `Apply (module_path ident_map p1, module_path ident_map p2) @@ -1673,7 +1673,7 @@ module Of_Lang = struct | `Identifier (i, b) -> ( match identifier Maps.ModuleType.find ident_map.module_types i with | `Identifier i -> `Identifier (i, b) - | `Local i -> `Local (i, b) ) + | `Local i -> `Local (i, b)) | `Dot (path', x) -> `Dot (module_path ident_map path', x) and type_path : _ -> Odoc_model.Paths.Path.Type.t -> Cpath.type_ = @@ -1683,7 +1683,7 @@ module Of_Lang = struct | `Identifier (i, b) -> ( match identifier Maps.Path.Type.find ident_map.path_types i with | `Identifier i -> `Identifier (i, b) - | `Local i -> `Local (i, b) ) + | `Local i -> `Local (i, b)) | `Dot (path', x) -> `Dot (module_path ident_map path', x) and class_type_path : @@ -1696,7 +1696,7 @@ module Of_Lang = struct identifier Maps.Path.ClassType.find ident_map.path_class_types i with | `Identifier i -> `Identifier (i, b) - | `Local i -> `Local (i, b) ) + | `Local i -> `Local (i, b)) | `Dot (path', x) -> `Dot (module_path ident_map path', x) let rec resolved_signature_fragment : diff --git a/src/xref2/component.mli b/src/xref2/component.mli index e71f011831..e193443084 100644 --- a/src/xref2/component.mli +++ b/src/xref2/component.mli @@ -678,8 +678,8 @@ module Of_Lang : sig val canonical : map -> - ( Odoc_model.Paths_types.Path.module_ - * Odoc_model.Paths_types.Reference.module_ ) + (Odoc_model.Paths_types.Path.module_ + * Odoc_model.Paths_types.Reference.module_) option -> (Cpath.module_ * Odoc_model.Paths_types.Reference.module_) option diff --git a/src/xref2/cpath.ml b/src/xref2/cpath.ml index 822f35b01f..fc1e8ba895 100644 --- a/src/xref2/cpath.ml +++ b/src/xref2/cpath.ml @@ -451,15 +451,15 @@ and module_of_module_reference : Reference.Module.t -> module_ = function | `Resolved r -> `Resolved (resolved_module_of_resolved_module_reference r) | `Root (_, _) -> failwith "unhandled" | `Dot - ( ( ( `Resolved (`Identifier #Identifier.Module.t) - | `Dot (_, _) - | `Module (_, _) ) as parent ), + ( (( `Resolved (`Identifier #Identifier.Module.t) + | `Dot (_, _) + | `Module (_, _) ) as parent), name ) -> `Dot (module_of_module_reference parent, name) | `Module - ( ( ( `Resolved (`Identifier #Identifier.Module.t) - | `Dot (_, _) - | `Module (_, _) ) as parent ), + ( (( `Resolved (`Identifier #Identifier.Module.t) + | `Dot (_, _) + | `Module (_, _) ) as parent), name ) -> `Dot (module_of_module_reference parent, ModuleName.to_string name) | _ -> failwith "Not a module reference" diff --git a/src/xref2/env.ml b/src/xref2/env.ml index 5b37dfec80..53445cd697 100644 --- a/src/xref2/env.ml +++ b/src/xref2/env.ml @@ -11,10 +11,10 @@ type lookup_unit_result = type root = | Resolved of - ( Digest.t + (Digest.t * Odoc_model.Paths.Identifier.Module.t * bool - * Component.Module.t Component.Delayed.t ) + * Component.Module.t Component.Delayed.t) | Forward type resolver = { @@ -124,8 +124,8 @@ let add_label identifier env = { env with id = - ( incr unique_id; - !unique_id ); + (incr unique_id; + !unique_id); elts = add_to_elts (Odoc_model.Paths.Identifier.name identifier) @@ -136,8 +136,8 @@ let add_label_title label elts env = { env with id = - ( incr unique_id; - !unique_id ); + (incr unique_id; + !unique_id); titles = Maps.Label.add label elts env.titles; } @@ -171,9 +171,9 @@ let add_module identifier m docs env = { env with id = - ( incr unique_id; - (*Format.fprintf Format.err_formatter "unique_id=%d\n%!" !unique_id; *) - !unique_id ); + (incr unique_id; + (*Format.fprintf Format.err_formatter "unique_id=%d\n%!" !unique_id; *) + !unique_id); elts = add_to_elts (Odoc_model.Paths.Identifier.name identifier) @@ -218,8 +218,8 @@ let add_type identifier t env = { env with id = - ( incr unique_id; - !unique_id ); + (incr unique_id; + !unique_id); elts = add_to_elts (Odoc_model.Paths.Identifier.name identifier) @@ -232,8 +232,8 @@ let add_module_type identifier t env = { env with id = - ( incr unique_id; - !unique_id ); + (incr unique_id; + !unique_id); elts = add_to_elts (Odoc_model.Paths.Identifier.name identifier) @@ -246,8 +246,8 @@ let add_value identifier t env = { env with id = - ( incr unique_id; - !unique_id ); + (incr unique_id; + !unique_id); elts = add_to_elts (Odoc_model.Paths.Identifier.name identifier) @@ -260,8 +260,8 @@ let add_external identifier t env = { env with id = - ( incr unique_id; - !unique_id ); + (incr unique_id; + !unique_id); elts = add_to_elts (Odoc_model.Paths.Identifier.name identifier) @@ -274,8 +274,8 @@ let add_class identifier t env = { env with id = - ( incr unique_id; - !unique_id ); + (incr unique_id; + !unique_id); elts = add_to_elts (Odoc_model.Paths.Identifier.name identifier) @@ -288,8 +288,8 @@ let add_class_type identifier t env = { env with id = - ( incr unique_id; - !unique_id ); + (incr unique_id; + !unique_id); elts = add_to_elts (Odoc_model.Paths.Identifier.name identifier) @@ -306,8 +306,8 @@ let add_exception identifier e env = { env with id = - ( incr unique_id; - !unique_id ); + (incr unique_id; + !unique_id); elts = add_to_elts (Odoc_model.Paths.Identifier.name identifier) @@ -320,8 +320,8 @@ let add_extension_constructor identifier ec env = { env with id = - ( incr unique_id; - !unique_id ); + (incr unique_id; + !unique_id); elts = add_to_elts (Odoc_model.Paths.Identifier.name identifier) @@ -377,15 +377,15 @@ let lookup_root_module name env = module_of_unit unit) in Some (Resolved (u.root.digest, id, u.hidden, m)) - | _ -> failwith "Expecting root module!" ) ) + | _ -> failwith "Expecting root module!")) in - ( match (env.recorder, result) with + (match (env.recorder, result) with | Some r, Some Forward -> r.lookups <- RootModule (name, Some `Forward) :: r.lookups | Some r, Some (Resolved (digest, _, _, _)) -> r.lookups <- RootModule (name, Some (`Resolved digest)) :: r.lookups | Some r, None -> r.lookups <- RootModule (name, None) :: r.lookups - | None, _ -> () ); + | None, _ -> ()); result type value_or_external = @@ -431,7 +431,7 @@ let lookup_by_name scope name env = record_lookup_results results; Error (`Ambiguous (x, tl)) | [] -> ( - match scope.root name env with Some x -> Ok x | None -> Error `Not_found ) + match scope.root name env with Some x -> Ok x | None -> Error `Not_found) open Odoc_model.Paths @@ -462,7 +462,7 @@ let lookup_by_id (scope : 'a scope) id env : 'a option = match (result :> Component.Element.any) with | `Module (id, _) -> r.lookups <- Module id :: r.lookups | `ModuleType (id, _) -> r.lookups <- ModuleType id :: r.lookups - | _ -> () ) + | _ -> ()) | None -> () in match disam_id id (lookup_by_name' scope (Identifier.name id) env) with @@ -472,7 +472,7 @@ let lookup_by_id (scope : 'a scope) id env : 'a option = | None -> ( match (id :> Identifier.t) with | `Root (_, name) -> scope.root (ModuleName.to_string name) env - | _ -> None ) + | _ -> None) let lookup_root_module_fallback name t = match lookup_root_module name t with @@ -566,7 +566,7 @@ let lookup_page name env = | Some r -> ( match r.lookup_page name with | None -> None - | Some root -> Some (r.resolve_page root) ) + | Some root -> Some (r.resolve_page root)) let add_functor_parameter : Odoc_model.Lang.FunctorParameter.t -> t -> t = fun p t -> @@ -748,7 +748,7 @@ let initial_env : | Found x -> let name = Names.ModuleName.of_string str in (Import.Resolved (x.root, name) :: imports, env) - | Not_found -> (import :: imports, env) )) + | Not_found -> (import :: imports, env))) t.imports ([], initial_env) let modules_of env = @@ -772,14 +772,14 @@ let verify_lookups env lookups = match r.lookup_unit name with | Forward_reference -> Some `Forward | Not_found -> None - | Found u -> Some (`Resolved u.root.digest) ) + | Found u -> Some (`Resolved u.root.digest)) in match (res, actual_result) with | None, None -> false | Some `Forward, Some `Forward -> false | Some (`Resolved digest1), Some (`Resolved digest2) -> digest1 <> digest2 - | _ -> true ) + | _ -> true) | ModuleType id -> let actually_found = match lookup_by_id s_module_type id env with @@ -793,8 +793,7 @@ let verify_lookups env lookups = | Error `Not_found -> false | Error (`Ambiguous (hd, tl)) -> not - (List.exists (fun (`Module (id', _)) -> result = id') (hd :: tl)) - ) + (List.exists (fun (`Module (id', _)) -> result = id') (hd :: tl))) | FragmentRoot _i -> true (* begin try @@ -807,7 +806,7 @@ let verify_lookups env lookups = let result = not (List.exists bad_lookup lookups) in (* If we're recording lookups, make sure it looks like we looked all this stuff up *) - ( match (result, env.recorder) with + (match (result, env.recorder) with | true, Some r -> r.lookups <- r.lookups @ lookups - | _ -> () ); + | _ -> ()); result diff --git a/src/xref2/env.mli b/src/xref2/env.mli index e97c9a30cb..c666059829 100644 --- a/src/xref2/env.mli +++ b/src/xref2/env.mli @@ -9,10 +9,10 @@ type lookup_unit_result = type root = | Resolved of - ( Digest.t + (Digest.t * Odoc_model.Paths.Identifier.Module.t * bool - * Component.Module.t Component.Delayed.t ) + * Component.Module.t Component.Delayed.t) | Forward type resolver = { @@ -198,8 +198,8 @@ val initial_env : val modules_of : t -> - ( Odoc_model.Paths.Identifier.Path.Module.t - * Component.Module.t Component.Delayed.t ) + (Odoc_model.Paths.Identifier.Path.Module.t + * Component.Module.t Component.Delayed.t) list val len : int ref diff --git a/src/xref2/errors.ml b/src/xref2/errors.ml index affac442ea..bb70e560dd 100644 --- a/src/xref2/errors.ml +++ b/src/xref2/errors.ml @@ -176,7 +176,7 @@ let rec kind_of_module_cpath = function | `Apply (a, b) -> ( match kind_of_module_cpath a with | Some _ as a -> a - | None -> kind_of_module_cpath b ) + | None -> kind_of_module_cpath b) | _ -> None let rec kind_of_module_type_cpath = function @@ -225,7 +225,7 @@ let report ~(what : what) ?tools_error action = match what with | `Include (Component.Include.Alias cp) -> kind_of_module_cpath cp | `Module (`Root _) -> Some `Root - | _ -> None ) + | _ -> None) in let action = match action with diff --git a/src/xref2/expand_tools.ml b/src/xref2/expand_tools.ml index 18c55e5bb8..537b8e9f03 100644 --- a/src/xref2/expand_tools.ml +++ b/src/xref2/expand_tools.ml @@ -77,7 +77,7 @@ and aux_expansion_of_module_alias env ~strengthen path = Component.Fmt.signature sg Component.Fmt.signature sg'; *) Ok (Signature { sg' with items = Comment (`Docs docs) :: sg'.items }) - | Ok (Functor _ as x), _ -> Ok x ) + | Ok (Functor _ as x), _ -> Ok x) | Error e -> Error (`UnresolvedPath (`Module (path, e))) (* We need to reresolve fragments in expansions as the root of the fragment @@ -178,16 +178,16 @@ and handle_expansion env id expansion = | Signature sg -> Ok ( env, - ( Component.ModuleType.Signature sg - : Component.ModuleType.simple_expansion ) ) + (Component.ModuleType.Signature sg + : Component.ModuleType.simple_expansion) ) | Functor (arg, expr) -> let env', expr' = handle_argument id arg expr env in aux_expansion_of_module_type_expr env' expr' >>= fun res -> expand (`Result id) env res >>= fun (env, res) -> Ok ( env, - ( Component.ModuleType.Functor (arg, res) - : Component.ModuleType.simple_expansion ) ) + (Component.ModuleType.Functor (arg, res) + : Component.ModuleType.simple_expansion) ) in expand id env expansion @@ -227,7 +227,7 @@ let rec type_expr map t = try List.assoc v map with _ -> Format.eprintf "Failed to list assoc %s\n%!" v; - failwith "bah" ) + failwith "bah") | Any -> Any | Alias (t, s) -> if List.mem_assoc s map then raise Clash else Alias (type_expr map t, s) @@ -283,7 +283,7 @@ let collapse_eqns eqn1 eqn2 params = { eqn1 with Equation.manifest = - ( match eqn2.manifest with + (match eqn2.manifest with | None -> None - | Some t -> Some (type_expr map t) ); + | Some t -> Some (type_expr map t)); } diff --git a/src/xref2/find.ml b/src/xref2/find.ml index a09a618ae2..7e5de87f10 100644 --- a/src/xref2/find.ml +++ b/src/xref2/find.ml @@ -57,7 +57,7 @@ type any_in_class_sig = [ instance_variable | method_ ] module N = Ident.Name let rec find_map f = function - | hd :: tl -> ( match f hd with Some _ as x -> x | None -> find_map f tl ) + | hd :: tl -> ( match f hd with Some _ as x -> x | None -> find_map f tl) | [] -> None let find_in_sig sg f = @@ -65,8 +65,8 @@ let find_in_sig sg f = | Signature.Include i :: tl -> ( match inner f i.Include.expansion_.items with | Some _ as x -> x - | None -> inner f tl ) - | hd :: tl -> ( match f hd with Some _ as x -> x | None -> inner f tl ) + | None -> inner f tl) + | hd :: tl -> ( match f hd with Some _ as x -> x | None -> inner f tl) | [] -> None in inner f sg.Signature.items @@ -76,7 +76,7 @@ let filter_in_sig sg f = | Signature.Include i :: tl -> inner f i.Include.expansion_.items @ inner f tl | hd :: tl -> ( - match f hd with Some x -> x :: inner f tl | None -> inner f tl ) + match f hd with Some x -> x :: inner f tl | None -> inner f tl) | [] -> [] in inner f sg.Signature.items @@ -192,7 +192,7 @@ let any_in_comment d name = match elt.Odoc_model.Location_.value with | `Heading (_, label, _) when Ident.Name.label label = name -> Some (`FLabel label) - | _ -> inner rest ) + | _ -> inner rest) | [] -> None in inner d @@ -222,7 +222,7 @@ let any_in_sig sg name = let typ = Delayed.get t in match any_in_type typ name with | Some r -> Some (`In_type (N.type' id, typ, r)) - | None -> None ) + | None -> None) | TypExt typext -> any_in_typext typext name | Comment (`Docs d) -> any_in_comment d name | _ -> None) @@ -290,14 +290,14 @@ let any_in_type_in_sig sg name = let t = Delayed.get t in match any_in_type t name with | Some x -> Some (`In_type (N.type' id, t, x)) - | None -> None ) + | None -> None) | _ -> None) let filter_in_class_signature cs f = let rec inner = function | ClassSignature.Inherit ct_expr :: tl -> inner_inherit ct_expr @ inner tl | it :: tl -> ( - match f it with Some x -> x :: inner tl | None -> inner tl ) + match f it with Some x -> x :: inner tl | None -> inner tl) | [] -> [] and inner_inherit = function | Constr _ -> [] diff --git a/src/xref2/lang_of.ml b/src/xref2/lang_of.ml index a00b176bd6..307330ee55 100644 --- a/src/xref2/lang_of.ml +++ b/src/xref2/lang_of.ml @@ -59,9 +59,9 @@ module Path = struct | `Substituted x -> module_ map x | `Local (id, b) -> `Identifier - ( ( try lookup_module map id - with Not_found -> - failwith (Format.asprintf "Not_found: %a" Ident.fmt id) ), + ( (try lookup_module map id + with Not_found -> + failwith (Format.asprintf "Not_found: %a" Ident.fmt id)), b ) | `Identifier (i, b) -> `Identifier (i, b) | `Resolved x -> `Resolved (resolved_module map x) @@ -126,9 +126,9 @@ module Path = struct match p with | `Local id -> `Identifier - ( try lookup_module map id - with Not_found -> - failwith (Format.asprintf "Not_found: %a" Ident.fmt id) ) + (try lookup_module map id + with Not_found -> + failwith (Format.asprintf "Not_found: %a" Ident.fmt id)) | `Substituted x -> resolved_module map x | `Identifier y -> `Identifier y | `Subst (mty, m) -> @@ -149,7 +149,7 @@ module Path = struct | `FragmentRoot -> ( match map.fragment_root with | Some r -> resolved_parent map (r :> Cpath.Resolved.parent) - | None -> failwith "Invalid" ) + | None -> failwith "Invalid") and resolved_module_type map (p : Cpath.Resolved.module_type) : Odoc_model.Paths.Path.Resolved.ModuleType.t = @@ -228,8 +228,8 @@ module Path = struct | `Root (`ModuleType p) -> `Root (`ModuleType (resolved_module_type map p)) | `Root (`Module p) -> `Root (`Module (resolved_module map p)) | (`OpaqueModule _ | `Subst _ | `SubstAlias _ | `Module _) as x -> - ( resolved_module_fragment map x - :> Odoc_model.Paths.Fragment.Resolved.Signature.t ) + (resolved_module_fragment map x + :> Odoc_model.Paths.Fragment.Resolved.Signature.t) and resolved_type_fragment : maps -> Cfrag.resolved_type -> Odoc_model.Paths.Fragment.Resolved.Type.t = @@ -373,18 +373,18 @@ let rec signature_items id map items = (Odoc_model.Lang.Signature.Module (r, module_ map parent id m) :: acc) | ModuleType (id, m) :: rest -> inner rest - ( Odoc_model.Lang.Signature.ModuleType (module_type map parent id m) - :: acc ) + (Odoc_model.Lang.Signature.ModuleType (module_type map parent id m) + :: acc) | Type (id, r, t) :: rest -> let t = Component.Delayed.get t in inner rest (Type (r, type_decl map parent id t) :: acc) | Exception (id', e) :: rest -> inner rest - ( Exception - (exception_ map - (id :> Odoc_model.Paths_types.Identifier.signature) - id' e) - :: acc ) + (Exception + (exception_ map + (id :> Odoc_model.Paths_types.Identifier.signature) + id' e) + :: acc) | TypExt t :: rest -> inner rest (TypExt (typ_ext map id t) :: acc) | Value (id, v) :: rest -> let v = Component.Delayed.get v in @@ -629,7 +629,8 @@ and module_ map parent id m = try let open Component.Module in let id = - (Component.ModuleMap.find id map.module_ :> Paths_types.Identifier.module_) + (Component.ModuleMap.find id map.module_ + :> Paths_types.Identifier.module_) in let identifier = (id :> Odoc_model.Paths_types.Identifier.signature) in let canonical = function @@ -951,7 +952,7 @@ and block_element parent with Not_found -> Format.fprintf Format.err_formatter "Failed to find id: %a\n" Ident.fmt id; - raise Not_found ) + raise Not_found) | `Tag t -> `Tag t | #Odoc_model.Comment.nestable_block_element as n -> n in diff --git a/src/xref2/link.ml b/src/xref2/link.ml index c378584d49..35600f88b9 100644 --- a/src/xref2/link.ml +++ b/src/xref2/link.ml @@ -63,7 +63,7 @@ let type_path : Env.t -> Paths.Path.Type.t -> Paths.Path.Type.t = `Resolved (Cpath.resolved_type_path_of_cpath result) | Error e -> Errors.report ~what:(`Type_path cp) ~tools_error:e `Lookup; - Cpath.type_path_of_cpath cp ) + Cpath.type_path_of_cpath cp) and module_type_path : Env.t -> Paths.Path.ModuleType.t -> Paths.Path.ModuleType.t = @@ -74,8 +74,8 @@ and module_type_path : match cp with | `Resolved p -> `Resolved - ( Tools.reresolve_module_type env p - |> Cpath.resolved_module_type_path_of_cpath ) + (Tools.reresolve_module_type env p + |> Cpath.resolved_module_type_path_of_cpath) | _ -> ( match Tools.resolve_module_type_path env cp with | Ok p' -> @@ -83,7 +83,7 @@ and module_type_path : `Resolved (Cpath.resolved_module_type_path_of_cpath result) | Error e -> Errors.report ~what:(`Module_type_path cp) ~tools_error:e `Resolve; - Cpath.module_type_path_of_cpath cp ) + Cpath.module_type_path_of_cpath cp) and module_path : Env.t -> Paths.Path.Module.t -> Paths.Path.Module.t = fun env p -> @@ -102,7 +102,7 @@ and module_path : Env.t -> Paths.Path.Module.t -> Paths.Path.Module.t = | Error _ when is_forward p -> p | Error e -> Errors.report ~what:(`Module_path cp) ~tools_error:e `Resolve; - Cpath.module_path_of_cpath cp ) + Cpath.module_path_of_cpath cp) let rec unit (resolver : Env.resolver) t = let open Compilation_unit in @@ -153,12 +153,12 @@ and comment_inline_element : `Reference (`Resolved x, []) | None -> (* Format.fprintf Format.err_formatter "XXXXXXXXXX FAILED to resolve reference: %a\n%!" (Component.Fmt.model_reference) r; *) - `Reference (r, []) ) + `Reference (r, [])) | `Reference (r, content) as orig -> ( (* Format.fprintf Format.err_formatter "XXXXXXXXXX about to resolve contentful reference: %a\n" (Component.Fmt.model_reference) r; *) match Ref_tools.resolve_reference env r with | Some x -> `Reference (`Resolved x, content) - | None -> orig ) + | None -> orig) | y -> y and comment_nestable_block_element env (x : Comment.nestable_block_element) = @@ -349,14 +349,14 @@ and extract_doc : Module.decl -> Comment.docs * Module.decl = in function | Alias (p, expansion) -> ( - match map_expansion expansion with d, e -> (d, Alias (p, e)) ) + match map_expansion expansion with d, e -> (d, Alias (p, e))) | ModuleType (Path { p_path; p_expansion }) -> ( match map_expansion p_expansion with - | d, e -> (d, ModuleType (Path { p_path; p_expansion = e })) ) + | d, e -> (d, ModuleType (Path { p_path; p_expansion = e }))) | ModuleType (With { w_substitutions; w_expansion; w_expr }) -> ( match map_expansion w_expansion with | d, e -> - (d, ModuleType (With { w_substitutions; w_expansion = e; w_expr })) ) + (d, ModuleType (With { w_substitutions; w_expansion = e; w_expr }))) | mty -> ([], mty) and module_ : Env.t -> Module.t -> Module.t = @@ -491,8 +491,8 @@ and handle_fragments env id sg subs = Component.Of_Lang.(resolved_module_fragment empty f) in `Resolved - ( Tools.reresolve_module_fragment env cfrag - |> Lang_of.(Path.resolved_module_fragment empty) ) + (Tools.reresolve_module_fragment env cfrag + |> Lang_of.(Path.resolved_module_fragment empty)) | _ -> frag in let sg' = @@ -509,8 +509,8 @@ and handle_fragments env id sg subs = Component.Of_Lang.(resolved_type_fragment empty f) in `Resolved - ( Tools.reresolve_type_fragment env cfrag - |> Lang_of.(Path.resolved_type_fragment empty) ) + (Tools.reresolve_type_fragment env cfrag + |> Lang_of.(Path.resolved_type_fragment empty)) | _ -> frag in let sg' = @@ -527,8 +527,8 @@ and handle_fragments env id sg subs = Component.Of_Lang.(resolved_module_fragment empty f) in `Resolved - ( Tools.reresolve_module_fragment env cfrag - |> Lang_of.(Path.resolved_module_fragment empty) ) + (Tools.reresolve_module_fragment env cfrag + |> Lang_of.(Path.resolved_module_fragment empty)) | _ -> frag in let sg' = @@ -545,8 +545,8 @@ and handle_fragments env id sg subs = Component.Of_Lang.(resolved_type_fragment empty f) in `Resolved - ( Tools.reresolve_type_fragment env cfrag - |> Lang_of.(Path.resolved_type_fragment empty) ) + (Tools.reresolve_type_fragment env cfrag + |> Lang_of.(Path.resolved_type_fragment empty)) | _ -> frag in let sg' = @@ -574,7 +574,7 @@ and u_module_type_expr : With (handle_fragments env id sg subs, u_module_type_expr env id expr) | Error e -> Errors.report ~what:(`Module_type_U cexpr) ~tools_error:e `Resolve; - unresolved ) + unresolved) | TypeOf { t_desc = StructInclude p; t_expansion } -> TypeOf { t_desc = StructInclude (module_path env p); t_expansion } | TypeOf { t_desc = ModPath p; t_expansion } -> @@ -609,7 +609,7 @@ and module_type_expr : } | Error e -> Errors.report ~what:(`Module_type_U cexpr) ~tools_error:e `Expand; - unresolved ) + unresolved) | Functor (arg, res) -> let arg' = functor_argument env arg in let env = Env.add_functor_parameter arg env in @@ -671,13 +671,13 @@ and type_decl : Env.t -> Id.Signature.t -> TypeDecl.t -> TypeDecl.t = { default with equation = - ( try - Expand_tools.collapse_eqns default.equation - (Lang_of.type_decl_equation Lang_of.empty - (parent :> Id.Parent.t) - t'.equation) - params - with _ -> default.equation ); + (try + Expand_tools.collapse_eqns default.equation + (Lang_of.type_decl_equation Lang_of.empty + (parent :> Id.Parent.t) + t'.equation) + params + with _ -> default.equation); } | Ok (`FClass _ | `FClassType _ | `FType_removed _) | Error _ -> default ) @@ -730,9 +730,9 @@ and type_expression_polyvar env parent visited v = let element = function | Type t -> Type - ( match type_expression env parent visited t with + (match type_expression env parent visited t with | Constr _ as x -> x - | _ -> t ) + | _ -> t) (* These have to remain Constrs *) | Constructor c -> Constructor (constructor c) in @@ -814,7 +814,7 @@ and type_expression : Env.t -> Id.Signature.t -> _ -> _ = declaration (%s)\n\ %!" (Printexc.to_string e); - Constr (`Resolved p, ts) ) + Constr (`Resolved p, ts)) | _ -> Constr (`Resolved p, ts) else Constr (`Resolved p, ts) | Ok (cp', (`FClass _ | `FClassType _)) -> @@ -823,7 +823,7 @@ and type_expression : Env.t -> Id.Signature.t -> _ -> _ = | Ok (_cp, `FType_removed (_, x, _eq)) -> (* Type variables ? *) Lang_of.(type_expr empty (parent :> Id.Parent.t) x) - | Error _ -> Constr (Cpath.type_path_of_cpath cp, ts) ) + | Error _ -> Constr (Cpath.type_path_of_cpath cp, ts)) | Polymorphic_variant v -> Polymorphic_variant (type_expression_polyvar env parent visited v) | Object o -> Object (type_expression_object env parent visited o) diff --git a/src/xref2/ref_tools.ml b/src/xref2/ref_tools.ml index 9b3a77de59..b0d08dd691 100644 --- a/src/xref2/ref_tools.ml +++ b/src/xref2/ref_tools.ml @@ -191,7 +191,7 @@ module M = struct | None -> ( match Env.lookup_root_module name env with | Some (Env.Resolved (_, id, _, m)) -> of_element env (`Module (id, m)) - | _ -> None ) + | _ -> None) end module MT = struct @@ -410,11 +410,11 @@ module F = struct >>= function | `In_type (_, _, `FConstructor _) -> None | `In_type (typ_name, _, `FField _) -> - Some (`Field (`Type (parent', typ_name), name)) ) + Some (`Field (`Type (parent', typ_name), name))) | `T (parent', t) -> ( Find.any_in_type t (FieldName.to_string name) >>= function | `FConstructor _ -> None - | `FField _ -> Some (`Field ((parent' :> Resolved.Parent.t), name)) ) + | `FField _ -> Some (`Field ((parent' :> Resolved.Parent.t), name))) | `C _ | `CT _ | `Page _ -> None let of_component _env parent name : t option = @@ -597,7 +597,7 @@ and resolve_signature_reference : module_type_lookup_to_signature_lookup env (MT.of_component env mt (`ModuleType (parent_cp, name)) - (`ModuleType (parent, name))) ) + (`ModuleType (parent, name)))) in resolve env' @@ -676,7 +676,7 @@ let resolve_reference_dot_sg env ~parent_path ~parent_ref ~parent_sg name = let parent = `Type (parent_ref, typ_name) in match r with | `FConstructor _ -> CS.of_component env parent name >>= resolved1 - | `FField _ -> F.of_component env parent name >>= resolved1 ) + | `FField _ -> F.of_component env parent name >>= resolved1) | `FModule_subst _ | `FType_subst _ -> None let resolve_reference_dot_page env page name = @@ -723,16 +723,16 @@ let resolve_reference : Env.t -> t -> Resolved.t option = | `Constructor (id, _) -> identifier id | `Exception (id, _) -> identifier id | `Extension (id, _) -> identifier id - | `Field (id, _) -> identifier id ) + | `Field (id, _) -> identifier id) | `Root (name, `TChildPage) -> ( match Env.lookup_page name env with | Some p -> Some (`Identifier (p.name :> Identifier.t)) - | None -> None ) + | None -> None) | `Root (name, `TChildModule) -> ( match Env.lookup_root_module name env with | Some (Resolved (_, id, _, _)) -> Some (`Identifier (id :> Identifier.t)) - | Some Forward | None -> None ) + | Some Forward | None -> None) | `Resolved r -> Some r | `Root (name, `TModule) -> M.in_env env name >>= resolved | `Module (parent, name) -> @@ -768,7 +768,7 @@ let resolve_reference : Env.t -> t -> Resolved.t option = match Env.lookup_page name env with | Some p -> Some (`Identifier (p.Odoc_model.Lang.Page.name :> Identifier.t)) - | None -> None ) + | None -> None) | `Dot (parent, name) -> resolve_reference_dot env parent name | `Root (name, `TConstructor) -> CS.in_env env name >>= resolved1 | `Constructor (parent, name) -> diff --git a/src/xref2/strengthen.ml b/src/xref2/strengthen.ml index 6601120439..2fd529251b 100644 --- a/src/xref2/strengthen.ml +++ b/src/xref2/strengthen.ml @@ -42,8 +42,7 @@ let rec signature : in match module_ ?canonical (`Dot (prefix, name)) (get m) with | None -> (item :: items, s) - | Some m' -> (Module (id, r, put (fun () -> m')) :: items, id :: s) - ) + | Some m' -> (Module (id, r, put (fun () -> m')) :: items, id :: s)) | ModuleType (id, mt) -> ( ModuleType ( id, diff --git a/src/xref2/subst.ml b/src/xref2/subst.ml index 1c0c9373e1..683b07c361 100644 --- a/src/xref2/subst.ml +++ b/src/xref2/subst.ml @@ -135,7 +135,7 @@ let rename_class_type : Ident.path_class_type -> Ident.path_class_type -> t -> t let rec substitute_vars vars t = let open TypeExpr in match t with - | Var s -> ( try List.assoc s vars with Not_found -> t ) + | Var s -> ( try List.assoc s vars with Not_found -> t) | Any -> Any | Alias (t, str) -> Alias (substitute_vars vars t, str) | Arrow (lbl, t1, t2) -> @@ -187,7 +187,7 @@ let rec resolved_module_path : | Some (`Renamed x) -> `Local x | Some (`Prefixed (_p, rp)) -> rp | Some `Substituted -> `Substituted p - | None -> p ) + | None -> p) | `Identifier _ -> p | `Apply (p1, p2) -> `Apply (resolved_module_path s p1, resolved_module_path s p2) @@ -218,7 +218,7 @@ and module_path : t -> Cpath.module_ -> Cpath.module_ = try `Resolved (resolved_module_path s p') with Invalidated -> let path' = Cpath.unresolve_resolved_module_path p' in - module_path s path' ) + module_path s path') | `Dot (p', str) -> `Dot (module_path s p', str) | `Module (p', str) -> `Module (resolved_parent_path s p', str) | `Apply (p1, p2) -> `Apply (module_path s p1, module_path s p2) @@ -230,7 +230,7 @@ and module_path : t -> Cpath.module_ -> Cpath.module_ = | Some (`Prefixed (p, _rp)) -> p | Some (`Renamed x) -> `Local (x, b) | Some `Substituted -> `Substituted p - | None -> `Local (id, b) ) + | None -> `Local (id, b)) | `Identifier _ -> p | `Substituted p -> `Substituted (module_path s p) | `Forward _ -> p @@ -244,7 +244,7 @@ and resolved_module_type_path : match try Some (ModuleTypeMap.find id s.module_type) with _ -> None with | Some (`Prefixed (_p, rp)) -> rp | Some (`Renamed x) -> `Local x - | None -> `Local id ) + | None -> `Local id) | `Identifier _ -> p | `Substituted p -> `Substituted (resolved_module_type_path s p) | `ModuleType (p, n) -> `ModuleType (resolved_parent_path s p, n) @@ -261,13 +261,13 @@ and module_type_path : t -> Cpath.module_type -> Cpath.module_type = try `Resolved (resolved_module_type_path s r) with Invalidated -> let path' = Cpath.unresolve_resolved_module_type_path r in - module_type_path s path' ) + module_type_path s path') | `Substituted p -> `Substituted (module_type_path s p) | `Local (id, b) -> ( match try Some (ModuleTypeMap.find id s.module_type) with _ -> None with | Some (`Prefixed (p, _rp)) -> p | Some (`Renamed x) -> `Local (x, b) - | None -> `Local (id, b) ) + | None -> `Local (id, b)) | `Identifier _ -> p | `Dot (p, n) -> `Dot (module_path s p, n) | `ModuleType (p', str) -> `ModuleType (resolved_parent_path s p', str) @@ -285,7 +285,7 @@ and resolved_type_path : with | Some (`Prefixed (_p, rp)) -> Not_replaced rp | Some (`Renamed x) -> Not_replaced (`Local x) - | None -> Not_replaced (`Local id) ) + | None -> Not_replaced (`Local id)) | `Identifier _ -> Not_replaced p | `Substituted p -> resolved_type_path s p |> map_replaced (fun p -> `Substituted p) @@ -300,7 +300,7 @@ and type_path : t -> Cpath.type_ -> Cpath.type_ or_replaced = try resolved_type_path s r |> map_replaced (fun r -> `Resolved r) with Invalidated -> let path' = Cpath.unresolve_resolved_type_path r in - type_path s path' ) + type_path s path') | `Substituted p -> type_path s p |> map_replaced (fun r -> `Substituted r) | `Local (id, b) -> ( if PathTypeMap.mem id s.type_replacement then @@ -311,7 +311,7 @@ and type_path : t -> Cpath.type_ -> Cpath.type_ or_replaced = with | Some (`Prefixed (p, _rp)) -> Not_replaced p | Some (`Renamed x) -> Not_replaced (`Local (x, b)) - | None -> Not_replaced (`Local (id, b)) ) + | None -> Not_replaced (`Local (id, b))) | `Identifier _ -> Not_replaced p | `Dot (p, n) -> Not_replaced (`Dot (module_path s p, n)) | `Type (p, n) -> Not_replaced (`Type (resolved_parent_path s p, n)) @@ -328,7 +328,7 @@ and resolved_class_type_path : with | Some (`Prefixed (_p, rp)) -> rp | Some (`Renamed x) -> `Local x - | None -> `Local id ) + | None -> `Local id) | `Identifier _ -> p | `Substituted p -> `Substituted (resolved_class_type_path s p) | `ClassType (p, n) -> `ClassType (resolved_parent_path s p, n) @@ -341,14 +341,14 @@ and class_type_path : t -> Cpath.class_type -> Cpath.class_type = try `Resolved (resolved_class_type_path s r) with Invalidated -> let path' = Cpath.unresolve_resolved_class_type_path r in - class_type_path s path' ) + class_type_path s path') | `Local (id, b) -> ( match try Some (PathClassTypeMap.find id s.class_type) with _ -> None with | Some (`Prefixed (p, _rp)) -> p | Some (`Renamed x) -> `Local (x, b) - | None -> `Local (id, b) ) + | None -> `Local (id, b)) | `Identifier _ -> p | `Substituted p -> `Substituted (class_type_path s p) | `Dot (p, n) -> `Dot (module_path s p, n) @@ -396,7 +396,7 @@ let rec module_fragment : t -> Cfrag.module_ -> Cfrag.module_ = try `Resolved (resolved_module_fragment t r) with Invalidated -> let frag' = Cfrag.unresolve_module r in - module_fragment t frag' ) + module_fragment t frag') | `Dot (sg, n) -> `Dot (signature_fragment t sg, n) let rec type_fragment : t -> Cfrag.type_ -> Cfrag.type_ = @@ -406,7 +406,7 @@ let rec type_fragment : t -> Cfrag.type_ -> Cfrag.type_ = try `Resolved (resolved_type_fragment t r) with Invalidated -> let frag' = Cfrag.unresolve_type r in - type_fragment t frag' ) + type_fragment t frag') | `Dot (sg, n) -> `Dot (signature_fragment t sg, n) let option_ conv s x = match x with Some x -> Some (conv s x) | None -> None @@ -446,7 +446,7 @@ and type_poly_var s v = | Type t -> ( match type_expr s t with | Polymorphic_variant v -> v.elements - | x -> [ Type x ] ) + | x -> [ Type x ]) | Constructor c -> [ Constructor (map_constr c) ] in @@ -486,7 +486,7 @@ and type_expr s t = in let vars = List.fold_left2 mk_var [] ts eq.params in substitute_vars vars t - | Not_replaced p -> Constr (p, List.map (type_expr s) ts) ) + | Not_replaced p -> Constr (p, List.map (type_expr s) ts)) | Polymorphic_variant v -> Polymorphic_variant (type_poly_var s v) | Object o -> Object (type_object s o) | Class (p, ts) -> Class (class_type_path s p, List.map (type_expr s) ts) @@ -577,7 +577,7 @@ and u_module_type_expr s t = t_desc = module_type_type_of_desc s t_desc; t_expansion = Some (Signature (apply_sig_map_sg s e)); } - with MTOInvalidated -> u_module_type_expr s (Signature e) ) + with MTOInvalidated -> u_module_type_expr s (Signature e)) | TypeOf { t_expansion = Some (Functor _); _ } -> assert false | TypeOf { t_desc; t_expansion = None } -> TypeOf @@ -617,7 +617,7 @@ and module_type_expr s t = t_expansion = Some (simple_expansion s e); } with MTOInvalidated -> - module_type_expr s (module_type_of_simple_expansion e) ) + module_type_expr s (module_type_of_simple_expansion e)) | TypeOf { t_desc; t_expansion = None } -> TypeOf { t_desc = module_type_type_of_desc_noexn s t_desc; t_expansion = None } @@ -868,25 +868,25 @@ and rename_bound_idents s sg = rename_bound_idents s [] i.Component.Include.expansion_.items in rename_bound_idents s - ( Include - { - i with - Component.Include.expansion_ = - { items; removed = []; compiled = i.expansion_.compiled }; - } - :: sg ) + (Include + { + i with + Component.Include.expansion_ = + { items; removed = []; compiled = i.expansion_.compiled }; + } + :: sg) rest | Open o :: rest -> let s, items = rename_bound_idents s [] o.Component.Open.expansion.items in rename_bound_idents s - ( Open - { - Component.Open.expansion = - { items; removed = []; compiled = o.expansion.compiled }; - } - :: sg ) + (Open + { + Component.Open.expansion = + { items; removed = []; compiled = o.expansion.compiled }; + } + :: sg) rest | (Comment _ as item) :: rest -> rename_bound_idents s (item :: sg) rest @@ -899,7 +899,7 @@ and removed_items s items = match PathModuleMap.find (id :> Ident.path_module) s.module_ with | `Prefixed (_, x) -> RModule (id, x) | _ -> x - with Not_found -> x ) + with Not_found -> x) | x -> x) items @@ -917,29 +917,29 @@ and apply_sig_map s items removed compiled = | [] -> List.rev acc | Module (id, r, m) :: rest -> inner rest - ( Module - ( id, - r, - Component.Delayed.put (fun () -> - module_ s (Component.Delayed.get m)) ) - :: acc ) + (Module + ( id, + r, + Component.Delayed.put (fun () -> + module_ s (Component.Delayed.get m)) ) + :: acc) | ModuleSubstitution (id, m) :: rest -> inner rest (ModuleSubstitution (id, module_substitution s m) :: acc) | ModuleType (id, mt) :: rest -> inner rest - ( ModuleType - ( id, - Component.Delayed.put (fun () -> - module_type s (Component.Delayed.get mt)) ) - :: acc ) + (ModuleType + ( id, + Component.Delayed.put (fun () -> + module_type s (Component.Delayed.get mt)) ) + :: acc) | Type (id, r, t) :: rest -> inner rest - ( Type - ( id, - r, - Component.Delayed.put (fun () -> - type_ s (Component.Delayed.get t)) ) - :: acc ) + (Type + ( id, + r, + Component.Delayed.put (fun () -> + type_ s (Component.Delayed.get t)) ) + :: acc) | TypeSubstitution (id, t) :: rest -> inner rest (TypeSubstitution (id, type_ s t) :: acc) | Exception (id, e) :: rest -> @@ -947,11 +947,11 @@ and apply_sig_map s items removed compiled = | TypExt e :: rest -> inner rest (TypExt (extension s e) :: acc) | Value (id, v) :: rest -> inner rest - ( Value - ( id, - Component.Delayed.put (fun () -> - value s (Component.Delayed.get v)) ) - :: acc ) + (Value + ( id, + Component.Delayed.put (fun () -> + value s (Component.Delayed.get v)) ) + :: acc) | External (id, e) :: rest -> inner rest (External (id, external_ s e) :: acc) | Class (id, r, c) :: rest -> inner rest (Class (id, r, class_ s c) :: acc) diff --git a/src/xref2/tools.ml b/src/xref2/tools.ml index 01d5657ae5..e4645c6a48 100644 --- a/src/xref2/tools.ml +++ b/src/xref2/tools.ml @@ -160,7 +160,7 @@ let simplify_resolved_module_path : | `Module ((#Odoc_model.Paths_types.Identifier.module_ as parent), name) -> `Module (`Module (check_ident parent), name) - | _ -> failwith "Bad canonical path" ) + | _ -> failwith "Bad canonical path") in check_ident id @@ -310,7 +310,7 @@ let rec handle_apply ~mark_substituted env func_path arg_path m = match resolve_module_type ~mark_substituted:false env p_path with | Ok (_, { Component.ModuleType.expr = Some mty'; _ }) -> find_functor mty' - | _ -> Error `OpaqueModule ) + | _ -> Error `OpaqueModule) | _ -> Error `ApplyNotFunctor in module_type_expr_of_module env m >>= fun mty' -> @@ -340,7 +340,7 @@ and add_canonical_path : | _ -> ( match m.Component.Module.canonical with | Some (cp, _cr) -> `Canonical (p, cp) - | None -> p ) + | None -> p) and get_substituted_module_type : Env.t -> Component.ModuleType.expr -> Cpath.Resolved.module_type option = @@ -378,11 +378,11 @@ and get_module_path_modifiers : resolve_module ~mark_substituted:true ~add_canonical env alias_path with | Ok (resolved_alias_path, _) -> Some (`Aliased resolved_alias_path) - | Error _ -> None ) + | Error _ -> None) | ModuleType t -> ( match get_substituted_module_type env t with | Some s -> Some (`SubstMT s) - | None -> None ) + | None -> None) and process_module_path env ~add_canonical m p = let p = if m.Component.Module.hidden then `Hidden p else p in @@ -650,8 +650,8 @@ and resolve_module : let m = Component.Delayed.get m in match handle_apply ~mark_substituted env func_path' arg_path' m with | Ok (p, m) -> Ok (p, Component.Delayed.put_val m) - | Error e -> Error (`Parent (`Parent_expr e)) ) - | _ -> Error `Unresolved_apply ) + | Error e -> Error (`Parent (`Parent_expr e))) + | _ -> Error `Unresolved_apply) | `Identifier (i, hidden) -> of_option ~error:(`Lookup_failure i) (Env.(lookup_by_id s_module) i env) >>= fun (`Module (_, m)) -> @@ -680,7 +680,7 @@ and resolve_module : Error (`Parent (`Parent_sig `UnresolvedForwardPath)) | None -> (* Format.fprintf Format.err_formatter "Unresolved!\n%!"; *) - Error (`Lookup_failure_root r) ) + Error (`Lookup_failure_root r)) | `Forward f -> resolve_module ~mark_substituted ~add_canonical env (`Root f) |> map_error (fun e -> `Parent (`Parent_module e)) @@ -898,7 +898,7 @@ and reresolve_module : Env.t -> Cpath.Resolved.module_ -> Cpath.Resolved.module_ ( reresolve_module env p, `Resolved (simplify_resolved_module_path env p2') ) | Error _ -> `Canonical (reresolve_module env p, p2) - | exception _ -> `Canonical (reresolve_module env p, p2) ) + | exception _ -> `Canonical (reresolve_module env p, p2)) | `OpaqueModule m -> `OpaqueModule (reresolve_module env m) and reresolve_module_type : @@ -955,7 +955,7 @@ and module_type_expr_of_module_decl : module_type_expr_of_module env m | Error _ when Cpath.is_module_forward path -> Error `UnresolvedForwardPath - | Error e -> Error (`UnresolvedPath (`Module (path, e))) ) + | Error e -> Error (`UnresolvedPath (`Module (path, e)))) | Component.Module.ModuleType expr -> Ok expr and module_type_expr_of_module : @@ -1004,7 +1004,7 @@ and signature_of_u_module_type_expr : | Component.ModuleType.U.Path p -> ( match resolve_module_type ~mark_substituted env p with | Ok (_, mt) -> signature_of_module_type env mt - | Error e -> Error (`UnresolvedPath (`ModuleType (p, e))) ) + | Error e -> Error (`UnresolvedPath (`ModuleType (p, e)))) | Signature s -> Ok s | With (subs, s) -> signature_of_u_module_type_expr ~mark_substituted env s >>= fun sg -> @@ -1029,7 +1029,7 @@ and signature_of_module_type_expr : | Component.ModuleType.Path { p_path; _ } -> ( match resolve_module_type ~mark_substituted env p_path with | Ok (_, mt) -> signature_of_module_type env mt - | Error e -> Error (`UnresolvedPath (`ModuleType (p_path, e))) ) + | Error e -> Error (`UnresolvedPath (`ModuleType (p_path, e)))) | Component.ModuleType.Signature s -> Ok s | Component.ModuleType.With { w_expansion = Some e; _ } -> Ok (signature_of_simple_expansion e) @@ -1164,7 +1164,7 @@ and fragmap : ( items, true, subbed_modules, - Component.Signature.RType (id, texpr, eq) :: removed ) ) + Component.Signature.RType (id, texpr, eq) :: removed )) | Component.Signature.Module (id, r, m), _, Some (id', fn) when Ident.Name.module_ id = id' -> ( fn (Component.Delayed.get m) >>= function @@ -1181,7 +1181,7 @@ and fragmap : ( items, true, subbed_modules, - Component.Signature.RModule (id, y) :: removed ) ) + Component.Signature.RModule (id, y) :: removed )) | Component.Signature.Include ({ expansion_; _ } as i), _, _ -> map_signature tymap modmap expansion_.items >>= fun (items', handled', subbed_modules', removed') -> @@ -1230,7 +1230,7 @@ and fragmap : in Ok (Left { m with Component.Module.type_ }) in - map_signature None (Some (name, mapfn)) sg.items ) + map_signature None (Some (name, mapfn)) sg.items) | ModuleSubst (frag, p) -> ( match Cfrag.module_split frag with | name, Some frag' -> @@ -1247,7 +1247,7 @@ and fragmap : "failed to resolve path: %a\n%!" Component.Fmt.module_path p; Error (`UnresolvedPath (`Module (p, e))) in - map_signature None (Some (name, mapfn)) sg.items ) + map_signature None (Some (name, mapfn)) sg.items) | TypeEq (frag, equation) -> ( match Cfrag.type_split frag with | name, Some frag' -> @@ -1255,7 +1255,7 @@ and fragmap : handle_intermediate name new_subst | name, None -> let mapfn t = Ok (Left { t with Component.TypeDecl.equation }) in - map_signature (Some (name, mapfn)) None sg.items ) + map_signature (Some (name, mapfn)) None sg.items) | TypeSubst ( frag, ({ Component.TypeDecl.Equation.manifest = Some x; _ } as equation) ) @@ -1266,7 +1266,7 @@ and fragmap : handle_intermediate name new_subst | name, None -> let mapfn _t = Ok (Right (x, equation)) in - map_signature (Some (name, mapfn)) None sg.items ) + map_signature (Some (name, mapfn)) None sg.items) | TypeSubst (_, { Component.TypeDecl.Equation.manifest = None; _ }) -> failwith "Unhandled condition: TypeSubst with no manifest" in @@ -1331,7 +1331,7 @@ and find_external_module_path : | Some x, Some y -> Some (`SubstAlias (x, y)) | Some x, None -> Some x | None, Some x -> Some x - | None, None -> None ) + | None, None -> None) | `Canonical (x, y) -> find_external_module_path x >>= fun x -> Some (`Canonical (x, y)) | `Hidden x -> find_external_module_path x >>= fun x -> Some (`Hidden x) @@ -1340,7 +1340,7 @@ and find_external_module_path : | Some x, Some y -> Some (`Alias (x, y)) | Some x, None -> Some x | None, Some x -> Some x - | None, None -> None ) + | None, None -> None) | `Apply (x, y) -> find_external_module_path x >>= fun x -> find_external_module_path y >>= fun y -> Some (`Apply (x, y)) @@ -1380,11 +1380,11 @@ and fixup_module_cfrag (f : Cfrag.resolved_module) : Cfrag.resolved_module = | `Subst (path, frag) -> ( match find_external_module_type_path path with | Some p -> `Subst (p, frag) - | None -> frag ) + | None -> frag) | `SubstAlias (path, frag) -> ( match find_external_module_path path with | Some p -> `SubstAlias (p, frag) - | None -> frag ) + | None -> frag) | `Module (parent, name) -> `Module (fixup_signature_cfrag parent, name) | `OpaqueModule m -> `OpaqueModule (fixup_module_cfrag m) @@ -1554,7 +1554,7 @@ and class_signature_of_class_type_expr : match resolve_type env (p :> Cpath.type_) with | Ok (_, `FClass (_, c)) -> class_signature_of_class env c | Ok (_, `FClassType (_, c)) -> class_signature_of_class_type env c - | _ -> None ) + | _ -> None) and class_signature_of_class_type : Env.t -> Component.ClassType.t -> Component.ClassSignature.t option = @@ -1572,7 +1572,7 @@ let resolve_module_path env p = | Ok _ -> Ok p | Error `OpaqueModule -> Ok (`OpaqueModule p) | Error (`UnresolvedForwardPath | `UnresolvedPath _) -> Ok p - | Error (`UnexpandedTypeOf _) -> Ok p ) + | Error (`UnexpandedTypeOf _) -> Ok p) let resolve_module_type_path env p = resolve_module_type ~mark_substituted:true env p >>= fun (p, mt) -> diff --git a/src/xref2/type_of.ml b/src/xref2/type_of.ml index 137726abe1..414446b2a8 100644 --- a/src/xref2/type_of.ml +++ b/src/xref2/type_of.ml @@ -76,7 +76,7 @@ and module_type_expr env (id : Id.Signature.t) expr = -> again := true; expr - | Error _e -> expr ) + | Error _e -> expr) and u_module_type_expr env id expr = match expr with @@ -93,7 +93,7 @@ and u_module_type_expr env id expr = -> again := true; expr - | Error _e -> expr ) + | Error _e -> expr) and functor_parameter env p = { p with expr = module_type_expr env (p.id :> Id.Signature.t) p.expr } diff --git a/test/html/test.ml b/test/html/test.ml index 6269a448a0..56e9cba2b2 100644 --- a/test/html/test.ml +++ b/test/html/test.ml @@ -229,11 +229,11 @@ let make_test_case ?theme_uri ?syntax case = pretty_print_html_in_place actual_file; (* Run HTML validation on output files. *) - ( if Tidy.is_present_in_path then - let issues = Tidy.validate actual_file in - if issues <> [] then ( - List.iter prerr_endline issues; - Alcotest.fail "Tidy validation error" ) ); + (if Tidy.is_present_in_path then + let issues = Tidy.validate actual_file in + if issues <> [] then ( + List.iter prerr_endline issues; + Alcotest.fail "Tidy validation error")); (* Diff the actual outputs with the expected outputs. *) diff output) diff --git a/test/odoc_print/type_desc_to_yojson.ml b/test/odoc_print/type_desc_to_yojson.ml index e051cb7f2f..3f951850cc 100644 --- a/test/odoc_print/type_desc_to_yojson.ml +++ b/test/odoc_print/type_desc_to_yojson.ml @@ -13,7 +13,7 @@ let rec to_yojson : type a. a t -> a -> yojson = | Variant get -> ( match get a with | C0 name -> `String name - | C (name, a', t) -> `Assoc [ (name, to_yojson t a') ] ) + | C (name, a', t) -> `Assoc [ (name, to_yojson t a') ]) | Pair (t1, t2) -> let a1, a2 = a in `List [ to_yojson t1 a1; to_yojson t2 a2 ] @@ -24,6 +24,6 @@ let rec to_yojson : type a. a t -> a -> yojson = | Option t -> ( match a with | Some a' -> `Assoc [ ("Some", to_yojson t a') ] - | None -> `String "None" ) + | None -> `String "None") | To_string to_string -> `String (to_string a) | Indirect (f, t) -> to_yojson t (f a) diff --git a/test/parser/test.ml b/test/parser/test.ml index 20061bd74d..bcb06a76d4 100644 --- a/test/parser/test.ml +++ b/test/parser/test.ml @@ -1187,7 +1187,7 @@ let () = ] |> suggest_commands actual_root_directory; - Alcotest.fail "document tree incorrect" ) + Alcotest.fail "document tree incorrect") in (case.name, `Quick, run_test_case) diff --git a/test/print/print.ml b/test/print/print.ml index 8284b7a292..31c6f9687c 100644 --- a/test/print/print.ml +++ b/test/print/print.ml @@ -24,8 +24,8 @@ module Identifier_to_sexp = struct traverse (List [ Atom "parent" ] :: acc) (parent :> Identifier.t) | `ModuleType (parent, s) -> traverse - ( List [ Atom "module_type"; Atom (ModuleTypeName.to_string s) ] - :: acc ) + (List [ Atom "module_type"; Atom (ModuleTypeName.to_string s) ] + :: acc) (parent :> Identifier.t) | `Type (parent, s) -> traverse @@ -35,8 +35,8 @@ module Identifier_to_sexp = struct List (List [ Atom "core_type"; Atom (TypeName.to_string s) ] :: acc) | `Constructor (parent, s) -> traverse - ( List [ Atom "constructor"; Atom (ConstructorName.to_string s) ] - :: acc ) + (List [ Atom "constructor"; Atom (ConstructorName.to_string s) ] + :: acc) (parent :> Identifier.t) | `Field (parent, s) -> traverse @@ -52,8 +52,8 @@ module Identifier_to_sexp = struct (parent :> Identifier.t) | `CoreException s -> List - ( List [ Atom "core_exception"; Atom (ExceptionName.to_string s) ] - :: acc ) + (List [ Atom "core_exception"; Atom (ExceptionName.to_string s) ] + :: acc) | `Value (parent, s) -> traverse (List [ Atom "value"; Atom (ValueName.to_string s) ] :: acc) @@ -72,12 +72,12 @@ module Identifier_to_sexp = struct (parent :> Identifier.t) | `InstanceVariable (parent, s) -> traverse - ( List - [ - Atom "instance_variable"; - Atom (InstanceVariableName.to_string s); - ] - :: acc ) + (List + [ + Atom "instance_variable"; + Atom (InstanceVariableName.to_string s); + ] + :: acc) (parent :> Identifier.t) | `Label (parent, s) -> traverse @@ -112,7 +112,9 @@ module Path_to_sexp = struct | `Subst (mt, m) -> List [ - Atom "subst"; resolved (mt :> Resolved.t); resolved (m :> Resolved.t); + Atom "subst"; + resolved (mt :> Resolved.t); + resolved (m :> Resolved.t); ] | `SubstAlias (m, m') -> List @@ -166,7 +168,9 @@ module Path_to_sexp = struct | `Alias (m, m') -> List [ - Atom "alias"; resolved (m :> Resolved.t); resolved (m' :> Resolved.t); + Atom "alias"; + resolved (m :> Resolved.t); + resolved (m' :> Resolved.t); ] | `SubstT (m, m') -> List @@ -514,8 +518,8 @@ module Comment_to_sexp = struct | `Document -> "document" in List - ( [ Atom "@see"; Atom kind; Atom s ] - @ List.map (at nestable_block_element) es ) + ([ Atom "@see"; Atom kind; Atom s ] + @ List.map (at nestable_block_element) es) | `Since s -> List [ Atom "@since"; Atom s ] | `Before (s, es) -> List