Formatting and backwards compat

Author: jonludlam

src/loader/implementation.ml

@@ -505,6 +505,6 @@ let of_cmt (source_id : Odoc_model.Paths.Identifier.SourcePage.t)
 
 #else
 
-let of_cmt _ _ _ _ = []
+let of_cmt _ _ _ _ = (), []
 
 #endif

src/loader/implementation.mli

@@ -1,8 +1,10 @@
 val of_cmt :
   Odoc_model.Paths.Identifier.SourcePage.t ->
   Odoc_model.Paths.Identifier.RootModule.t ->
-  Typedtree.structure -> Warnings.loc Types.Uid.Tbl.t ->
-  Odoc_model.Paths.Identifier.Id.source_location Odoc_model.Compat.shape_uid_map * Odoc_model.Lang.Source_info.infos
+  Typedtree.structure ->
+  Odoc_model.Compat.uid_to_loc ->
+  Odoc_model.Paths.Identifier.Id.source_location Odoc_model.Compat.shape_uid_map
+  * Odoc_model.Lang.Source_info.infos
 (** Extract all implementation information from a [cmt]: the shape, and the
     {{!Odoc_model.Lang.Source_info.infos}source infos} (local and global
     definitions and occurrences).

src/loader/odoc_loader.ml

@@ -42,18 +42,25 @@ exception Not_an_interface
 
 exception Make_root_error of string
 
+#if OCAML_VERSION >= (4, 14, 0)
 (** [cmt_info.cmt_annots = Implementation _] *)
 let read_cmt_infos' source_id_opt id cmt_info =
   match Odoc_model.Compat.shape_of_cmt_infos cmt_info with
-  | Some shape -> begin
-    let uid_to_loc = cmt_info.cmt_uid_to_loc in
-    match source_id_opt, cmt_info.cmt_annots with
-    | Some source_id, Implementation impl ->
-      let (map, source_infos) = Implementation.of_cmt source_id id impl uid_to_loc in
-      (Some shape, map, Some { Odoc_model.Lang.Source_info.id=source_id; infos = source_infos})
-    | _, _ ->
-      (Some shape, Odoc_model.Compat.empty_map, None)
-    end
+  | Some shape -> (
+      let uid_to_loc = cmt_info.cmt_uid_to_loc in
+      match (source_id_opt, cmt_info.cmt_annots) with
+      | Some source_id, Implementation impl ->
+          let map, source_infos =
+            Implementation.of_cmt source_id id impl uid_to_loc
+          in
+          ( Some shape,
+            map,
+            Some
+              {
+                Odoc_model.Lang.Source_info.id = source_id;
+                infos = source_infos;
+              } )
+      | _, _ -> (Some shape, Odoc_model.Compat.empty_map, None))
   | None -> (None, Odoc_model.Compat.empty_map, None)
 
 let read_cmt_infos source_id_opt id ~filename () =
@@ -64,6 +71,13 @@ let read_cmt_infos source_id_opt id ~filename () =
       | Implementation _ -> read_cmt_infos' source_id_opt id cmt_info
       | _ -> raise Not_an_implementation)
 
+#else
+
+let read_cmt_infos _source_id_opt _id ~filename:_ () =
+  (None, Odoc_model.Compat.empty_map, None)
+
+#endif
+
 let make_compilation_unit ~make_root ~imports ~interface ?sourcefile ~name ~id
     ?canonical ?shape ~uid_to_id ~source_info content =
   let open Odoc_model.Lang.Compilation_unit in
@@ -106,6 +120,7 @@ let make_compilation_unit ~make_root ~imports ~interface ?sourcefile ~name ~id
     uid_to_id;
   }
 
+
 let compilation_unit_of_sig ~make_root ~imports ~interface ?sourcefile ~name ~id
     ?canonical ?shape ~uid_to_id sg =
   let content = Odoc_model.Lang.Compilation_unit.Module sg in
@@ -126,15 +141,15 @@ let read_cmti ~make_root ~parent ~filename ~cmt_filename_opt ~source_id_opt () =
               cmt_info.cmt_builddir )
           in
           let id, sg, canonical = Cmti.read_interface parent name intf in
-          let (shape, uid_to_id, source_info) =
+          let shape, uid_to_id, source_info =
             match cmt_filename_opt with
             | Some cmt_filename ->
-              read_cmt_infos source_id_opt id ~filename:cmt_filename ()
-            | None ->
-              (None, Odoc_model.Compat.empty_map, None)
+                read_cmt_infos source_id_opt id ~filename:cmt_filename ()
+            | None -> (None, Odoc_model.Compat.empty_map, None)
           in
           compilation_unit_of_sig ~make_root ~imports:cmt_info.cmt_imports
-            ~interface ~sourcefile ~name ~id ?shape ~uid_to_id ~source_info ?canonical sg)
+            ~interface ~sourcefile ~name ~id ?shape ~uid_to_id ~source_info
+            ?canonical sg)
   | _ -> raise Not_an_interface
 
 let read_cmt ~make_root ~parent ~filename ~source_id_opt () =
@@ -176,14 +191,15 @@ let read_cmt ~make_root ~parent ~filename ~source_id_opt () =
               items
           in
           let content = Odoc_model.Lang.Compilation_unit.Pack items in
-          make_compilation_unit ~make_root ~imports ~interface ~sourcefile
-              ~name ~id ~uid_to_id:Odoc_model.Compat.empty_map ~source_info:None content
+          make_compilation_unit ~make_root ~imports ~interface ~sourcefile ~name
+            ~id ~uid_to_id:Odoc_model.Compat.empty_map ~source_info:None content
       | Implementation impl ->
           let id, sg, canonical = Cmt.read_implementation parent name impl in
-          let (shape, uid_to_id, source_info) =
-            read_cmt_infos source_id_opt id ~filename () in
+          let shape, uid_to_id, source_info =
+            read_cmt_infos source_id_opt id ~filename ()
+          in
           compilation_unit_of_sig ~make_root ~imports ~interface ~sourcefile
-              ~name ~id ?canonical ?shape ~uid_to_id ~source_info sg
+            ~name ~id ?canonical ?shape ~uid_to_id ~source_info sg
       | _ -> raise Not_an_implementation)
 
 let read_cmi ~make_root ~parent ~filename () =
@@ -194,7 +210,8 @@ let read_cmi ~make_root ~parent ~filename () =
         Cmi.read_interface parent name
           (Odoc_model.Compat.signature cmi_info.cmi_sign)
       in
-      compilation_unit_of_sig ~make_root ~imports ~interface ~name ~id ~source_info:None ~uid_to_id:Odoc_model.Compat.empty_map sg
+      compilation_unit_of_sig ~make_root ~imports ~interface ~name ~id
+        ~source_info:None ~uid_to_id:Odoc_model.Compat.empty_map sg
   | _ -> raise Corrupted
 
 (** Catch errors from reading the object files and some internal errors *)
@@ -211,7 +228,8 @@ let wrap_errors ~filename f =
       | Make_root_error m -> error_msg filename m)
 
 let read_cmti ~make_root ~parent ~filename ~source_id_opt ~cmt_filename_opt =
-  wrap_errors ~filename (read_cmti ~make_root ~parent ~filename ~source_id_opt ~cmt_filename_opt)
+  wrap_errors ~filename
+    (read_cmti ~make_root ~parent ~filename ~source_id_opt ~cmt_filename_opt)
 
 let read_cmt ~make_root ~parent ~filename ~source_id_opt =
   wrap_errors ~filename (read_cmt ~make_root ~parent ~filename ~source_id_opt)

src/loader/odoc_loader.mli

@@ -26,9 +26,7 @@ val read_cmt :
   parent:Identifier.ContainerPage.t option ->
   filename:string ->
   source_id_opt:Identifier.SourcePage.t option ->
-  ( Lang.Compilation_unit.t,  Error.t )
-  result
-  Error.with_warnings
+  (Lang.Compilation_unit.t, Error.t) result Error.with_warnings
 
 val read_cmi :
   make_root:make_root ->

src/model/compat.cppo.ml

@@ -232,6 +232,7 @@ type shape = Shape.t
 
 type 'a shape_uid_map = 'a Shape.Uid.Map.t
 
+type uid_to_loc = Warnings.loc Types.Uid.Tbl.t
 let empty_map = Shape.Uid.Map.empty
 
 let shape_of_cmt_infos : Cmt_format.cmt_infos -> shape option = fun x -> x.cmt_impl_shape
@@ -242,6 +243,7 @@ type shape = unit
 
 type 'a shape_uid_map = unit
 
+type uid_to_loc = unit
 let empty_map = ()
 
 let shape_of_cmt_infos : Cmt_format.cmt_infos -> shape option = fun _ -> None

src/odoc/bin/main.ml

@@ -187,9 +187,7 @@ end = struct
               "Either --package or --parent should be specified, not both")
     in
     let source =
-      match
-        (source_parent_file, source_name)
-      with
+      match (source_parent_file, source_name) with
       | Some parent, Some name -> Ok (Some (parent, name))
       | Some _, None | None, Some _ ->
           Error
@@ -198,11 +196,10 @@ end = struct
                same time.")
       | None, None -> Ok None
     in
-    begin
-      if Fs.File.get_ext input = ".cmt" && cmt_filename_opt <> None then
-        Error (`Cli_error "--cmt is redundant if the input is a cmt file")
-      else Ok ()
-    end >>= fun () ->
+    (if Fs.File.get_ext input = ".cmt" && cmt_filename_opt <> None then
+       Error (`Cli_error "--cmt is redundant if the input is a cmt file")
+     else Ok ())
+    >>= fun () ->
     parent_cli_spec >>= fun parent_cli_spec ->
     source >>= fun source ->
     Fs.Directory.mkdir_p (Fs.File.dirname output);

src/odoc/compile.ml

@@ -97,13 +97,15 @@ let resolve_imports resolver imports =
     imports
 
 (** Raises warnings and errors. *)
-let resolve_and_substitute ~resolver ~make_root ~source_id_opt ~cmt_filename_opt ~hidden
-    (parent : Paths.Identifier.ContainerPage.t option) input_file input_type =
+let resolve_and_substitute ~resolver ~make_root ~source_id_opt ~cmt_filename_opt
+    ~hidden (parent : Paths.Identifier.ContainerPage.t option) input_file
+    input_type =
   let filename = Fs.File.to_string input_file in
   let unit =
     match input_type with
     | `Cmti ->
-        Odoc_loader.read_cmti ~make_root ~parent ~filename ~source_id_opt ~cmt_filename_opt 
+        Odoc_loader.read_cmti ~make_root ~parent ~filename ~source_id_opt
+          ~cmt_filename_opt
         |> Error.raise_errors_and_warnings
     | `Cmt ->
         Odoc_loader.read_cmt ~make_root ~parent ~filename ~source_id_opt
@@ -119,9 +121,7 @@ let resolve_and_substitute ~resolver ~make_root ~source_id_opt ~cmt_filename_opt
        else
          Printf.sprintf " Using %S while you should use the .cmti file" filename);
   (* Resolve imports, used by the [link-deps] command. *)
-  let unit =
-    { unit with imports = resolve_imports resolver unit.imports }
-  in
+  let unit = { unit with imports = resolve_imports resolver unit.imports } in
   let env = Resolver.build_compile_env_for_unit resolver unit in
   let compiled =
     Odoc_xref2.Compile.compile ~filename env unit |> Error.raise_warnings
@@ -254,9 +254,11 @@ let compile ~resolver ~parent_cli_spec ~hidden ~children ~output
   parent resolver parent_cli_spec >>= fun parent_spec ->
   let ext = Fs.File.get_ext input in
   if ext = ".mld" then
-    check_is_none "Not expecting source (--source-*) when compiling pages." source
+    check_is_none "Not expecting source (--source-*) when compiling pages."
+      source
     >>= fun () ->
-    check_is_none "Not expecting cmt filename (--cmt) when compiling pages." cmt_filename_opt
+    check_is_none "Not expecting cmt filename (--cmt) when compiling pages."
+      cmt_filename_opt
     >>= fun () -> mld ~parent_spec ~output ~warnings_options ~children input
   else
     check_is_empty "Not expecting children (--child) when compiling modules."
@@ -273,8 +275,7 @@ let compile ~resolver ~parent_cli_spec ~hidden ~children ~output
             match page.Lang.SourceTree.name with
             | { Paths.Identifier.iv = `Page _; _ } as parent_id ->
                 let id = Paths.Identifier.Mk.source_page (parent_id, name) in
-                if
-                  List.exists (Paths.Identifier.equal id) page.source_children
+                if List.exists (Paths.Identifier.equal id) page.source_children
                 then Ok (Some id)
                 else err_not_parent ()
             | { iv = `LeafPage _; _ } -> err_not_parent ())
@@ -294,8 +295,8 @@ let compile ~resolver ~parent_cli_spec ~hidden ~children ~output
     let make_root = root_of_compilation_unit ~parent_spec ~hidden ~output in
     let result =
       Error.catch_errors_and_warnings (fun () ->
-          resolve_and_substitute ~resolver ~make_root ~hidden ~source_id_opt ~cmt_filename_opt
-          parent input input_type)
+          resolve_and_substitute ~resolver ~make_root ~hidden ~source_id_opt
+            ~cmt_filename_opt parent input input_type)
     in
     (* Extract warnings to write them into the output file *)
     let _, warnings = Error.unpack_warnings result in

src/odoc/resolver.mli

@@ -37,15 +37,11 @@ val lookup_page : t -> string -> Odoc_model.Lang.Page.t option
 (** Helpers for creating xref2 env. *)
 
 val build_compile_env_for_unit :
-  t ->
-  Odoc_model.Lang.Compilation_unit.t ->
-  Odoc_xref2.Env.t
+  t -> Odoc_model.Lang.Compilation_unit.t -> Odoc_xref2.Env.t
 (** Initialize the environment for compiling the given module. *)
 
 val build_link_env_for_unit :
-  t ->
-  Odoc_model.Lang.Compilation_unit.t ->
-  Odoc_xref2.Env.t
+  t -> Odoc_model.Lang.Compilation_unit.t -> Odoc_xref2.Env.t
 (** Initialize the environment for linking the given module. *)
 
 val build_env_for_page : t -> Odoc_model.Lang.Page.t -> Odoc_xref2.Env.t

src/xref2/link.ml

@@ -9,7 +9,9 @@ end
 
 let locations env id locs =
   let id = (id :> Id.NonSrc.t) in
-  match locs with Some _ as locs -> locs | None -> Shape_tools.lookup_def env id
+  match locs with
+  | Some _ as locs -> locs
+  | None -> Shape_tools.lookup_def env id
 
 (** Equivalent to {!Comment.synopsis}. *)
 let synopsis_from_comment (docs : Component.CComment.docs) =