Merge pull request #1060 from Julow/compat-402

Julow · web-flow · commit c80f0cdeb09b · 2023-12-12T11:51:04.000+01:00
Compatibility with 4.02
diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml
@@ -10,15 +10,22 @@ jobs:
     strategy:
       matrix:
         os:
-          - macos-latest
           - ubuntu-latest
-          # - windows-latest Windows doesn't work yet
         ocaml-compiler:
-          # Don't include every versions. OCaml-CI already covers that
+          - 4.02.x
+          - 4.04.x
+          - 4.06.x
+          - 4.08.x
+          - 4.10.x
+          - 4.12.x
           - 4.14.x
         include:
-          - os: ubuntu-latest # Enable coverage only on a single build
+          - os: ubuntu-latest
+            ocaml-compiler: 4.14.x
+            # We don't need to compute coverage for more than one build
             send-coverage: true
+            # Mdx tests Mdx tests
+            run-mdx: true
       fail-fast: false
 
     runs-on: ${{ matrix.os }}
@@ -40,21 +47,19 @@ jobs:
       - name: Install dependencies
         run: opam install -y --deps-only -t ./odoc.opam ./odoc-parser.opam
 
-      - name: Install bisect_ppx
-        run: opam install bisect_ppx
-
       - name: dune runtest
         run: opam exec -- dune runtest
 
-      # Run Mdx tests that are disabled by default.
       - name: Mdx tests
+        if: matrix.run-mdx == true
         run: |
           opam install -y mdx
           opam exec -- dune build @runmdx
 
       - name: Send coverage stats to Coveralls
         if: matrix.send-coverage == true
         run: |
+          opam install bisect_ppx
           opam exec -- dune runtest --instrument-with bisect_ppx --force
           opam exec -- bisect-ppx-report send-to Coveralls
         env:
diff --git a/src/html/config.mli b/src/html/config.mli
@@ -3,9 +3,7 @@
 type t
 
 val v :
-  ?search_result:bool
-    (** Indicates whether this is a summary for a search result.
-     In that case, the links will be printed as regular text. *) ->
+  ?search_result:bool ->
   ?theme_uri:Types.uri ->
   ?support_uri:Types.uri ->
   ?search_uris:Types.file_uri list ->
@@ -16,6 +14,8 @@ val v :
   as_json:bool ->
   unit ->
   t
+(** [search_result] indicates whether this is a summary for a search result. In
+    that case, the links will be printed as regular text. *)
 
 val theme_uri : t -> Types.uri
 
diff --git a/src/html_support_files/dune b/src/html_support_files/dune
@@ -3,8 +3,6 @@
 
 (rule
  (aliases runtest support-files)
- (enabled_if
-  (> %{ocaml_version} 4.08))
  (target odoc_html_support_files.ml)
  (deps
   (glob_files *.js)
@@ -29,8 +27,7 @@
     -o
     odoc_html_support_files.ml
     -m
-    plain
-    -s))))
+    plain))))
 
 (library
  (name odoc_html_support_files)
diff --git a/src/odoc/bin/main.ml b/src/odoc/bin/main.ml
@@ -405,7 +405,7 @@ module Indexing = struct
     let output = output_file ~dst in
     match (inputs_in_file, inputs) with
     | [], [] ->
-        Error
+        Result.Error
           (`Msg
             "At least one of --file-list or an .odocl file must be passed to \
              odoc compile-index")
@@ -762,8 +762,7 @@ module Odoc_html_args = struct
              else Relative (conv_rel_file str))
       in
       let printer ppf = function
-        | Odoc_html.Types.((Absolute uri : file_uri)) ->
-            Format.pp_print_string ppf uri
+        | Odoc_html.Types.Absolute uri -> Format.pp_print_string ppf uri
         | Odoc_html.Types.Relative _uri -> Format.pp_print_string ppf ""
       in
       (parser, printer)
diff --git a/src/search/html.ml b/src/search/html.ml
@@ -14,7 +14,7 @@ let url id =
           ~indent:false ~flat:false ~open_details:false ~as_json:false ()
       in
       let url = Odoc_html.Link.href ~config ~resolve:(Base "") url in
-      Ok url
+      Result.Ok url
   | Error _ as e -> e
 
 let map_option f = function Some x -> Some (f x) | None -> None
diff --git a/src/search/html.mli b/src/search/html.mli
@@ -6,7 +6,7 @@ val of_entry : Entry.t -> html list
 
 val url :
   Odoc_model.Paths.Identifier.Any.t ->
-  (string, Odoc_document.Url.Error.t) result
+  (string, Odoc_document.Url.Error.t) Result.result
 
 (** The below is intended for search engine that do not use the Json output but
     Odoc as a library. Most search engine will use their own representation 
diff --git a/src/search/json_index/json_display.ml b/src/search/json_index/json_display.ml
@@ -2,12 +2,12 @@ open Odoc_search
 
 let of_entry { Entry.id; doc = _; kind = _ } h =
   match Html.url id with
-  | Ok url ->
+  | Result.Ok url ->
       let html =
         h
         |> List.map (fun html ->
                Format.asprintf "%a" (Tyxml.Html.pp_elt ()) html)
         |> String.concat ""
       in
-      Ok (`Object [ ("url", `String url); ("html", `String html) ])
+      Result.Ok (`Object [ ("url", `String url); ("html", `String html) ])
   | Error _ as e -> e
diff --git a/src/search/json_index/json_display.mli b/src/search/json_index/json_display.mli
@@ -3,4 +3,4 @@ open Odoc_search
 val of_entry :
   Entry.t ->
   Html.html list ->
-  (Odoc_html.Json.json, Odoc_document.Url.Error.t) result
+  (Odoc_html.Json.json, Odoc_document.Url.Error.t) Result.result
diff --git a/src/search/json_index/json_search.ml b/src/search/json_index/json_search.ml
@@ -168,8 +168,8 @@ let of_entry ({ Entry.id; doc; kind } as entry) html =
           ]
   in
   match Json_display.of_entry entry html with
-  | Ok display ->
-      Ok
+  | Result.Ok display ->
+      Result.Ok
         (`Object
           [ ("id", j_id); ("doc", doc); ("kind", kind); ("display", display) ])
   | Error _ as e -> e
diff --git a/src/xref2/compile.ml b/src/xref2/compile.ml
@@ -21,26 +21,26 @@ let type_path : Env.t -> Paths.Path.Type.t -> Paths.Path.Type.t =
       | Ok p' -> `Resolved Lang_of.(Path.resolved_type (empty ()) p')
       | Error _ -> p)
 
-and value_path : Env.t -> Paths.Path.Value.t -> Paths.Path.Value.t =
- fun env p ->
-  match p with
-  | `Resolved _ -> p
-  | _ -> (
-      let cp = Component.Of_Lang.(value_path (empty ()) p) in
-      match Tools.resolve_value_path env cp with
-      | Ok p' -> `Resolved Lang_of.(Path.resolved_value (empty ()) p')
-      | Error _ -> p)
-
-and constructor_path :
-    Env.t -> Paths.Path.Constructor.t -> Paths.Path.Constructor.t =
- fun env p ->
-  match p with
-  | `Resolved _ -> p
-  | _ -> (
-      let cp = Component.Of_Lang.(constructor_path (empty ()) p) in
-      match Tools.resolve_constructor_path env cp with
-      | Ok p' -> `Resolved Lang_of.(Path.resolved_constructor (empty ()) p')
-      | Error _ -> p)
+(* and value_path : Env.t -> Paths.Path.Value.t -> Paths.Path.Value.t = *)
+(*  fun env p -> *)
+(*   match p with *)
+(*   | `Resolved _ -> p *)
+(*   | _ -> ( *)
+(*       let cp = Component.Of_Lang.(value_path (empty ()) p) in *)
+(*       match Tools.resolve_value_path env cp with *)
+(*       | Ok p' -> `Resolved Lang_of.(Path.resolved_value (empty ()) p') *)
+(*       | Error _ -> p) *)
+
+(* and constructor_path : *)
+(*     Env.t -> Paths.Path.Constructor.t -> Paths.Path.Constructor.t = *)
+(*  fun env p -> *)
+(*   match p with *)
+(*   | `Resolved _ -> p *)
+(*   | _ -> ( *)
+(*       let cp = Component.Of_Lang.(constructor_path (empty ()) p) in *)
+(*       match Tools.resolve_constructor_path env cp with *)
+(*       | Ok p' -> `Resolved Lang_of.(Path.resolved_constructor (empty ()) p') *)
+(*       | Error _ -> p) *)
 
 and module_type_path :
     Env.t -> Paths.Path.ModuleType.t -> Paths.Path.ModuleType.t =
@@ -74,11 +74,6 @@ and class_type_path : Env.t -> Paths.Path.ClassType.t -> Paths.Path.ClassType.t
       | Ok p' -> `Resolved Lang_of.(Path.resolved_class_type (empty ()) p')
       | Error _ -> p)
 
-let () =
-  (* Until those are used *)
-  ignore value_path;
-  ignore constructor_path
-
 let rec unit env t =
   let open Compilation_unit in
   let source_info =
diff --git a/src/xref2/link.ml b/src/xref2/link.ml
@@ -129,11 +129,11 @@ let rec should_reresolve : Paths.Path.Resolved.t -> bool =
 and should_resolve : Paths.Path.t -> bool =
  fun p -> match p with `Resolved p -> should_reresolve p | _ -> true
 
-and should_resolve_constructor : Paths.Path.Constructor.t -> bool =
- fun p ->
-  match p with
-  | `Resolved p -> should_reresolve (p :> Paths.Path.Resolved.t)
-  | _ -> true
+(* and should_resolve_constructor : Paths.Path.Constructor.t -> bool = *)
+(*  fun p -> *)
+(*   match p with *)
+(*   | `Resolved p -> should_reresolve (p :> Paths.Path.Resolved.t) *)
+(*   | _ -> true *)
 
 let type_path : Env.t -> Paths.Path.Type.t -> Paths.Path.Type.t =
  fun env p ->
@@ -153,47 +153,42 @@ let type_path : Env.t -> Paths.Path.Type.t -> Paths.Path.Type.t =
             Errors.report ~what:(`Type_path cp) ~tools_error:e `Lookup;
             p)
 
-let value_path : Env.t -> Paths.Path.Value.t -> Paths.Path.Value.t =
- fun env p ->
-  if not (should_resolve (p :> Paths.Path.t)) then p
-  else
-    let cp = Component.Of_Lang.(value_path (empty ()) p) in
-    match cp with
-    | `Resolved p ->
-        let result = Tools.reresolve_value env p in
-        `Resolved Lang_of.(Path.resolved_value (empty ()) result)
-    | _ -> (
-        match Tools.resolve_value_path env cp with
-        | Ok p' ->
-            let result = Tools.reresolve_value env p' in
-            `Resolved Lang_of.(Path.resolved_value (empty ()) result)
-        | Error e ->
-            Errors.report ~what:(`Value_path cp) ~tools_error:e `Lookup;
-            p)
-
-let constructor_path :
-    Env.t -> Paths.Path.Constructor.t -> Paths.Path.Constructor.t =
- fun env p ->
-  if not (should_resolve_constructor p) then p
-  else
-    let cp = Component.Of_Lang.(constructor_path (empty ()) p) in
-    match cp with
-    | `Resolved p ->
-        let result = Tools.reresolve_constructor env p in
-        `Resolved Lang_of.(Path.resolved_constructor (empty ()) result)
-    | _ -> (
-        match Tools.resolve_constructor_path env cp with
-        | Ok p' ->
-            let result = Tools.reresolve_constructor env p' in
-            `Resolved Lang_of.(Path.resolved_constructor (empty ()) result)
-        | Error e ->
-            Errors.report ~what:(`Constructor_path cp) ~tools_error:e `Lookup;
-            p)
-
-let () =
-  (* Until those are used *)
-  ignore value_path;
-  ignore constructor_path
+(* let value_path : Env.t -> Paths.Path.Value.t -> Paths.Path.Value.t = *)
+(*  fun env p -> *)
+(*   if not (should_resolve (p :> Paths.Path.t)) then p *)
+(*   else *)
+(*     let cp = Component.Of_Lang.(value_path (empty ()) p) in *)
+(*     match cp with *)
+(*     | `Resolved p -> *)
+(*         let result = Tools.reresolve_value env p in *)
+(*         `Resolved Lang_of.(Path.resolved_value (empty ()) result) *)
+(*     | _ -> ( *)
+(*         match Tools.resolve_value_path env cp with *)
+(*         | Ok p' -> *)
+(*             let result = Tools.reresolve_value env p' in *)
+(*             `Resolved Lang_of.(Path.resolved_value (empty ()) result) *)
+(*         | Error e -> *)
+(*             Errors.report ~what:(`Value_path cp) ~tools_error:e `Lookup; *)
+(*             p) *)
+
+(* let constructor_path : *)
+(*     Env.t -> Paths.Path.Constructor.t -> Paths.Path.Constructor.t = *)
+(*  fun env p -> *)
+(*   if not (should_resolve_constructor p) then p *)
+(*   else *)
+(*     let cp = Component.Of_Lang.(constructor_path (empty ()) p) in *)
+(*     match cp with *)
+(*     | `Resolved p -> *)
+(*         let result = Tools.reresolve_constructor env p in *)
+(*         `Resolved Lang_of.(Path.resolved_constructor (empty ()) result) *)
+(*     | _ -> ( *)
+(*         match Tools.resolve_constructor_path env cp with *)
+(*         | Ok p' -> *)
+(*             let result = Tools.reresolve_constructor env p' in *)
+(*             `Resolved Lang_of.(Path.resolved_constructor (empty ()) result) *)
+(*         | Error e -> *)
+(*             Errors.report ~what:(`Constructor_path cp) ~tools_error:e `Lookup; *)
+(*             p) *)
 
 let class_type_path : Env.t -> Paths.Path.ClassType.t -> Paths.Path.ClassType.t
     =
diff --git a/src/xref2/tools.ml b/src/xref2/tools.ml
@@ -1254,7 +1254,7 @@ and resolve_type :
 and resolve_datatype :
     Env.t -> add_canonical:bool -> Cpath.datatype -> resolve_datatype_result =
  fun env ~add_canonical p ->
-  let ( >>> ) = Option.bind in
+  let ( >>> ) = OptionMonad.bind in
   let rec id_datatype_of_type (id : Odoc_model.Comment.Identifier.Id.path_type)
       : Odoc_model.Comment.Identifier.Id.path_datatype option =
     match id with
diff --git a/test/generators/gen_rules/gen_rules.ml b/test/generators/gen_rules/gen_rules.ml
@@ -55,6 +55,7 @@ let constraints =
     ("bugs_pre_410.ml", Max "4.09");
     ("module_type_subst.mli", Min "4.13");
     ("class_comments.mli", Min "4.08");
+    ("functor_ml.ml", Min "4.14");
   ]
 
 let test_cases_dir = Fpath.v "cases"
@@ -73,7 +74,8 @@ let make_test_case case_name =
     let odoc = Fpath.set_ext ".odoc" base_out_path in
     let odocl = Fpath.set_ext ".odocl" base_out_path in
     let enabledif =
-      try Some (List.assoc case_name constraints) with Not_found -> None
+      try Some (List.assoc case_name constraints)
+      with Not_found -> Some (Min "4.04")
     in
     { Gen_rules_lib.input; cmt; odoc; odocl; enabledif }
   in
diff --git a/test/generators/link.dune.inc b/test/generators/link.dune.inc
diff --git a/test/search/dune b/test/search/dune
diff --git a/test/search/html_search.t/run.t b/test/search/html_search.t/run.t
