Refactor resolver

src/model/root.ml

@@ -47,6 +47,8 @@ module Odoc_file = struct
   let create_page name = Page name
 
   let name = function Page name | Compilation_unit { name; _ } -> name
+
+  let hidden = function Page _ -> false | Compilation_unit m -> m.hidden
 end
 
 type t = {

src/model/root.mli

@@ -35,6 +35,8 @@ module Odoc_file : sig
   val create_page : string -> t
 
   val name : t -> string
+
+  val hidden : t -> bool
 end
 
 type t = {

src/odoc/bin/main.ml

@@ -107,8 +107,8 @@ end = struct
   let compile hidden directories resolve_fwd_refs dst package_opt
       parent_name_opt open_modules children input warn_error =
     let open Or_error in
-    let env =
-      Env.create ~important_digests:(not resolve_fwd_refs) ~directories
+    let resolver =
+      Resolver.create ~important_digests:(not resolve_fwd_refs) ~directories
         ~open_modules
     in
     let input = Fs.File.of_string input in
@@ -125,7 +125,7 @@ end = struct
     in
     parent_cli_spec >>= fun parent_cli_spec ->
     Fs.Directory.mkdir_p (Fs.File.dirname output);
-    Compile.compile ~env ~directories ~parent_cli_spec ~hidden ~children ~output
+    Compile.compile ~resolver ~parent_cli_spec ~hidden ~children ~output
       ~warn_error input
 
   let input =
@@ -231,10 +231,10 @@ end = struct
   let link directories input_file output_file warn_error =
     let input = Fs.File.of_string input_file in
     let output = get_output_file ~output_file ~input in
-    let env =
-      Env.create ~important_digests:false ~directories ~open_modules:[]
+    let resolver =
+      Resolver.create ~important_digests:false ~directories ~open_modules:[]
     in
-    Odoc_link.from_odoc ~env ~warn_error input output
+    Odoc_link.from_odoc ~resolver ~warn_error input output
 
   let dst =
     let doc =
@@ -278,11 +278,11 @@ end = struct
   module Process = struct
     let process extra _hidden directories output_dir syntax input_file
         warn_error =
-      let env =
-        Env.create ~important_digests:false ~directories ~open_modules:[]
+      let resolver =
+        Resolver.create ~important_digests:false ~directories ~open_modules:[]
       in
       let file = Fs.File.of_string input_file in
-      Rendering.render_odoc ~renderer:R.renderer ~env ~warn_error ~syntax
+      Rendering.render_odoc ~renderer:R.renderer ~resolver ~warn_error ~syntax
         ~output:output_dir extra file
 
     let cmd =
@@ -340,10 +340,10 @@ end = struct
   module Targets = struct
     let list_targets output_dir directories extra odoc_file =
       let odoc_file = Fs.File.of_string odoc_file in
-      let env =
-        Env.create ~important_digests:false ~directories ~open_modules:[]
+      let resolver =
+        Resolver.create ~important_digests:false ~directories ~open_modules:[]
       in
-      Rendering.targets_odoc ~env ~warn_error:false ~syntax:OCaml
+      Rendering.targets_odoc ~resolver ~warn_error:false ~syntax:OCaml
         ~renderer:R.renderer ~output:output_dir ~extra odoc_file
 
     let back_compat =
@@ -432,8 +432,8 @@ module Html_fragment : sig
 end = struct
   let html_fragment directories xref_base_uri output_file input_file warn_error
       =
-    let env =
-      Env.create ~important_digests:false ~directories ~open_modules:[]
+    let resolver =
+      Resolver.create ~important_digests:false ~directories ~open_modules:[]
     in
     let input_file = Fs.File.of_string input_file in
     let output_file = Fs.File.of_string output_file in
@@ -443,8 +443,8 @@ end = struct
         let last_char = xref_base_uri.[String.length xref_base_uri - 1] in
         if last_char <> '/' then xref_base_uri ^ "/" else xref_base_uri
     in
-    Html_fragment.from_mld ~env ~xref_base_uri ~output:output_file ~warn_error
-      input_file
+    Html_fragment.from_mld ~resolver ~xref_base_uri ~output:output_file
+      ~warn_error input_file
 
   let cmd =
     let output =

src/odoc/compile.ml

@@ -29,15 +29,14 @@ type parent_cli_spec =
   | CliPackage of string
   | CliNoparent
 
-let parent directories parent_cli_spec =
-  let ap = Env.Accessible_paths.create ~directories in
+let parent resolver parent_cli_spec =
   let find_parent :
       Odoc_model.Paths.Reference.t ->
-      (Odoc_model.Root.t, [> `Msg of string ]) Result.result =
+      (Odoc_model.Lang.Page.t, [> `Msg of string ]) Result.result =
    fun r ->
     match r with
     | `Root (p, `TPage) | `Root (p, `TUnknown) -> (
-        match Env.lookup_page ap p with
+        match Resolver.lookup_page resolver p with
         | Some r -> Ok r
         | None -> Error (`Msg "Couldn't find specified parent page"))
     | _ -> Error (`Msg "Expecting page as parent")
@@ -49,14 +48,25 @@ let parent directories parent_cli_spec =
   match parent_cli_spec with
   | CliParent f ->
       Odoc_model.Semantics.parse_reference f >>= fun r ->
-      find_parent r >>= fun r ->
-      extract_parent r.id >>= fun parent ->
-      Env.fetch_page ap r >>= fun page -> Ok (Explicit (parent, page.children))
+      find_parent r >>= fun page ->
+      extract_parent page.name >>= fun parent ->
+      Ok (Explicit (parent, page.children))
   | CliPackage package -> Ok (Package (`RootPage (PageName.make_std package)))
   | CliNoparent -> Ok Noparent
 
-let resolve_and_substitute ~env ~output ~warn_error parent input_file read_file
-    =
+let resolve_imports resolver imports =
+  let open Odoc_model in
+  List.map
+    (function
+      | Lang.Compilation_unit.Import.Resolved _ as resolved -> resolved
+      | Unresolved (name, _) as unresolved -> (
+          match Resolver.resolve_import resolver name with
+          | Some root -> Resolved (root, Names.ModuleName.make_std name)
+          | None -> unresolved))
+    imports
+
+let resolve_and_substitute ~resolver ~output ~warn_error parent input_file
+    read_file =
   let filename = Fs.File.to_string input_file in
 
   read_file ~parent ~filename
@@ -67,7 +77,9 @@ let resolve_and_substitute ~env ~output ~warn_error parent input_file read_file
       (if not (Filename.check_suffix filename "cmt") then "" (* ? *)
       else
         Printf.sprintf " Using %S while you should use the .cmti file" filename);
-  let env = Env.build env (`Unit unit) in
+  (* Resolve imports, used by the [link-deps] command. *)
+  let unit = { unit with imports = resolve_imports resolver unit.imports } in
+  let env = Resolver.build_env_for_unit resolver unit in
 
   Odoc_xref2.Compile.compile env unit
   |> Odoc_xref2.Lookup_failures.handle_failures ~warn_error:false ~filename
@@ -79,7 +91,7 @@ let resolve_and_substitute ~env ~output ~warn_error parent input_file read_file
      working on. *)
   (*    let expand_env = Env.build env (`Unit resolved) in*)
   (*    let expanded = Odoc_xref2.Expand.expand (Env.expander expand_env) resolved in *)
-  Compilation_unit.save output compiled;
+  Odoc_file.save_unit output compiled;
   Ok ()
 
 let root_of_compilation_unit ~parent_spec ~hidden ~output ~module_name ~digest =
@@ -88,15 +100,8 @@ let root_of_compilation_unit ~parent_spec ~hidden ~output ~module_name ~digest =
     Filename.chop_extension Fs.File.(to_string @@ basename output)
   in
   let result parent =
-    let file_representation : Odoc_file.t =
-      Odoc_file.create_unit ~force_hidden:hidden module_name
-    in
-    Ok
-      {
-        id = `Root (parent, ModuleName.make_std module_name);
-        file = file_representation;
-        digest;
-      }
+    let file = Odoc_file.create_unit ~force_hidden:hidden module_name in
+    Ok { id = `Root (parent, ModuleName.make_std module_name); file; digest }
   in
   let check_child : Odoc_model.Paths.Reference.t -> bool =
    fun c ->
@@ -166,7 +171,7 @@ let mld ~parent_spec ~output ~children ~warn_error input =
       Odoc_model.Lang.Page.
         { name; root; children; content; digest; linked = false }
     in
-    Page.save output page;
+    Odoc_file.save_page output page;
     Ok ()
   in
   Fs.File.read input >>= fun str ->
@@ -178,9 +183,9 @@ let mld ~parent_spec ~output ~children ~warn_error input =
   | `Stop -> resolve [] (* TODO: Error? *)
   | `Docs content -> resolve content
 
-let compile ~env ~directories ~parent_cli_spec ~hidden ~children ~output
-    ~warn_error input =
-  parent directories parent_cli_spec >>= fun parent_spec ->
+let compile ~resolver ~parent_cli_spec ~hidden ~children ~output ~warn_error
+    input =
+  parent resolver parent_cli_spec >>= fun parent_spec ->
   let ext = Fs.File.get_ext input in
   if ext = ".mld" then mld ~parent_spec ~output ~warn_error ~children input
   else
@@ -200,5 +205,5 @@ let compile ~env ~directories ~parent_cli_spec ~hidden ~children ~output
     in
     parent >>= fun parent ->
     let make_root = root_of_compilation_unit ~parent_spec ~hidden ~output in
-    resolve_and_substitute ~env ~output ~warn_error parent input
+    resolve_and_substitute ~resolver ~output ~warn_error parent input
       (loader ~make_root)

src/odoc/compile.mli

@@ -24,8 +24,7 @@ type parent_cli_spec =
 (** Produces .odoc files out of [.cm{i,t,ti}] or .mld files. *)
 
 val compile :
-  env:Env.builder ->
-  directories:Fs.Directory.t list ->
+  resolver:Resolver.t ->
   parent_cli_spec:parent_cli_spec ->
   hidden:bool ->
   children:string list ->

src/odoc/depends.ml

@@ -64,13 +64,10 @@ end = struct
 end
 
 let deps_of_odoc_file ~deps input =
-  Root.read input >>= function
-  | { file = Page _; _ } ->
-      Ok () (* XXX something should certainly be done here *)
-  | { file = Compilation_unit _; _ } ->
-      Compilation_unit.load input >>= fun odoctree ->
-      List.iter odoctree.Odoc_model.Lang.Compilation_unit.imports
-        ~f:(fun import ->
+  Odoc_file.load input >>= function
+  | Page_content _ -> Ok () (* XXX something should certainly be done here *)
+  | Unit_content unit ->
+      List.iter unit.Odoc_model.Lang.Compilation_unit.imports ~f:(fun import ->
           match import with
           | Odoc_model.Lang.Compilation_unit.Import.Unresolved _ -> ()
           | Odoc_model.Lang.Compilation_unit.Import.Resolved (root, _) ->