get building with odoc 2.0.2

bin/dune

@@ -1,9 +1,10 @@
 (executable
  (name main)
  (public_name odoc2docset)
- (libraries sqlite3 odoc.odoc odoc.model lambdasoup logs logs.fmt
-            logs.cli fmt.cli fmt.tty core cmdliner shell)
- (preprocess (pps ppx_jane)))
+ (libraries sqlite3 odoc.odoc odoc.model lambdasoup logs logs.fmt logs.cli
+   fmt.cli fmt.tty core cmdliner shell)
+ (preprocess
+  (pps ppx_jane)))
 
 ;(generate_sites_module
 ; (module mysites)

bin/ids.ml

@@ -18,21 +18,33 @@ and signature (x : Signature.t) =
     | Type (_, x) -> type_decl x
     | Exception x -> exception_ x
     | Value x -> value x
-    | External x -> external_ x
     | Class (_, x) -> class_ x
     | ClassType (_, x) -> class_type x
     | Include x -> include_ x
     | ModuleSubstitution x ->
         Logs.warn (fun m ->
             m "Ignoring module substitution: %s" @@ Paths.Identifier.name x.id);
         []
+    | ModuleTypeSubstitution x ->
+        Logs.warn (fun m ->
+            m "Ignoring module substitution: %s" @@ Paths.Identifier.name x.id);
+        []
     | TypeSubstitution _ ->
         Logs.warn (fun m -> m "Ignoring type substitution");
         []
     | TypExt x -> extension x
     | Open _ | Comment _ -> [])
 
-and include_ (x : Include.t) = signature x.expansion.content
+and include_ (x : Include.t) =
+  let status =
+    match x.status with
+    | `Closed -> "closed"
+    | `Open -> "open"
+    | `Inline -> "inline"
+    | `Default -> "default"
+  in
+  Logs.info (fun m -> m "Include %s %s" (Paths.Identifier.name x.parent) status);
+  signature x.expansion.content
 
 and module_ (x : Module.t) =
   let ids =
@@ -48,13 +60,23 @@ and simple_expansion = function
   | Functor (_, x) -> simple_expansion x
 
 and module_type (x : ModuleType.t) =
-  let ids = match x.expr with Some (Signature s) -> signature s | _ -> [] in
+  let ids = Option.map x.expr ~f:module_type_expr |> Option.value ~default:[] in
   any x.id :: ids
 
 and module_type_expr = function
   | Signature x -> signature x
   | Functor (_, x) -> module_type_expr x
-  | _ -> []
+  | With { w_expansion = Some exp; _ } -> simple_expansion exp
+  | With { w_expansion = None; _ } ->
+      Logs.warn (fun m -> m "Ignoring module type expr unexpanded with");
+      []
+  | Path { p_expansion = Some exp; _ } -> simple_expansion exp
+  | Path { p_expansion = None; _ } ->
+      Logs.warn (fun m -> m "Ignoring module type expr unexpanded path");
+      []
+  | TypeOf _ ->
+      Logs.warn (fun m -> m "Ignoring module type expr typeof");
+      []
 
 and type_decl (x : TypeDecl.t) =
   let ids =
@@ -67,11 +89,8 @@ and type_decl (x : TypeDecl.t) =
   any x.id :: ids
 
 and exception_ (x : Exception.t) = [ any x.id ]
-
 and value (x : Value.t) = [ any x.id ]
 
-and external_ (x : External.t) = [ any x.id ]
-
 and class_ (x : Class.t) =
   let ids = match x.expansion with Some cs -> class_signature cs | None -> [] in
   any x.id :: ids

bin/main.ml

@@ -28,11 +28,8 @@ let opam_prefix = Sys.getenv_exn "OPAM_SWITCH_PREFIX"
 
 module Odig = struct
   let htmldir pkg = opam_prefix / "var/cache/odig/html" / pkg
-
   let cachedir = opam_prefix / "var/cache/odig/odoc"
-
   let all_pkgs () = run_lines "odig" [ "pkg"; "--short" ]
-
   let theme_prefix = opam_prefix / "share/odig/odoc-theme"
 end
 
@@ -104,7 +101,7 @@ let id_to_string id =
   let open Names in
   let exception Not_printable in
   let rec i2s : Paths.Identifier.t -> _ = function
-    | `Root _ | `Page _ | `RootPage _ | `LeafPage _ | `Parameter _ | `Result _ -> ""
+    | `Root _ | `Page _ | `LeafPage _ | `Parameter _ | `Result _ -> ""
     | `CoreType x ->
         if TypeName.is_hidden x then raise Not_printable else TypeName.to_string x
     | `CoreException x -> ExceptionName.to_string x
@@ -156,7 +153,7 @@ let id_kind (id : Odoc_model.Paths.Identifier.t) =
   | `Label _ -> "Parameter"
   | `Exception _ | `CoreException _ -> "Exception"
   | `Class _ -> "Class"
-  | `RootPage _ | `Page _ | `LeafPage _ -> "Section"
+  | `Page _ | `LeafPage _ -> "Section"
   | `ClassType _ -> "Class"
   | `Value _ -> "Value"
   | `Constructor _ -> "Constructor"
@@ -218,7 +215,8 @@ let update_index db docu_dir ids =
              let name_ = Model.Paths.Identifier.name id in
              let new_anchor = sprintf "//apple_ref/cpp/%s/%s" type_ name_ in
              let anchor_elem =
-               Soup.create_element ~attributes:[ ("name", new_anchor) ]
+               Soup.create_element
+                 ~attributes:[ ("name", new_anchor) ]
                  ~class_:"dashAnchor" "a"
              in
              match Soup.select_one (sprintf {|a[href="#%s"]|} url.anchor) soup with
@@ -269,49 +267,43 @@ let create_db db_file =
   |> Sqlite3.Rc.ok_exn;
   db
 
-(** Load a compilation unit, resolve and expand it. Taken straight from
-   odoc/src/html_page.ml. *)
-let load_unit env path =
-  let open Result.Let_syntax in
-  let open Odoc in
-  let%bind unit = Compilation_unit.load (Fs.File.of_string path) in
-  let env = Env.build env (`Unit unit) in
-  Odoc_xref2.Link.link env unit
-  |> Odoc_xref2.Lookup_failures.handle_failures ~warn_error:true ~filename:path
-
-let load env input =
+let load ~resolver input =
   let open Odoc in
   let open Or_error in
-  Root.read input >>= fun root ->
-  let input_s = Fs.File.to_string input in
-  match root.file with
-  | Page _ -> Ok None
-  | Compilation_unit { hidden; _ } ->
-      if hidden then Ok None
+  let filename = Fs.File.to_string @@ Fs.File.basename input in
+  Odoc_file.load input >>= fun file ->
+  match file.content with
+  | Odoc_file.Page_content page ->
+      Logs.debug (fun m ->
+          m "Ignoring documentation page: %s"
+            (Model.Comment.Identifier.name page.name));
+      Ok None
+  | Unit_content unit ->
+      if Odoc_model.Root.Odoc_file.hidden unit.root.file then (
+        Logs.debug (fun m ->
+            m "Ignoring hidden unit: %s" (Model.Paths.Identifier.name unit.id));
+        Ok None)
       else
-        Compilation_unit.load input >>= fun unit ->
-        let env = Env.build env (`Unit unit) in
-        let linked = Odoc_xref2.Link.link env unit in
-        linked
-        |> Odoc_xref2.Lookup_failures.handle_failures ~warn_error:false
-             ~filename:input_s
-        >>= fun odoctree ->
+        let env = Resolver.build_env_for_unit ~linking:true resolver unit in
+        let linked = Odoc_xref2.Link.link ~filename env unit in
+        Model.Error.handle_warnings
+          ~warnings_options:{ warn_error = false; print_warnings = true }
+          linked
+        >>= fun unit ->
         Odoc_xref2.Tools.reset_caches ();
-        Caml.Hashtbl.clear Compilation_unit.units_cache;
-        Ok (Some odoctree)
+        Ok (Some unit)
 
 let odoc_files_exn d = run_lines "find" [ d; "-type"; "f"; "-name"; "*.odoc" ]
-
 let all_subdirs d = run_lines_warn "find" [ d; "-type"; "d" ]
 
 let populate_db include_dirs pkgs db docu_dir =
   List.iter include_dirs ~f:(fun d ->
       Logs.debug (fun m -> m "Include dir: %s" (Odoc.Fs.Directory.to_string d)));
-
-  let env =
-    Odoc.Env.create ~important_digests:true ~directories:include_dirs
+  let resolver =
+    Odoc.Resolver.create ~important_digests:true ~directories:include_dirs
       ~open_modules:[]
   in
+
   List.iter pkgs ~f:(fun pkg ->
       Logs.info (fun m -> m "Indexing %s." pkg);
 
@@ -321,7 +313,7 @@ let populate_db include_dirs pkgs db docu_dir =
         (odoc_files_exn (Odig.cachedir / pkg))
         ~f:(fun f ->
           Logs.debug (fun m -> m "Loading %s." f);
-          match load env @@ Odoc.Fs.File.of_string f with
+          match load ~resolver @@ Odoc.Fs.File.of_string f with
           | Ok (Some unit) ->
               let ids = ids_of_unit unit in
               update_index db docu_dir ids

dune

@@ -1,2 +1,3 @@
 (data_only_dirs docsets)
+
 (vendored_dirs vendor)