Enable remapping of links to ocaml.org

When running in this mode, e.g. `odoc_driver opam -p odoc --remap`, only the
documentation for the selected packages -- odoc in this case -- will be
generated. Links to other packages will be remapped to point to that package's
documentation pages on ocaml.org.

src/driver/common_args.ml

@@ -52,6 +52,10 @@ let generate_grep =
   let doc = "Show html-generate commands containing the string" in
   Arg.(value & opt (some string) None & info [ "html-grep" ] ~doc)
 
+let remap =
+  let doc = "Remap paths in non-selected packages to ocaml.org" in
+  Arg.(value & flag & info [ "remap" ] ~doc)
+
 type t = {
   verbose : bool;
   odoc_dir : Fpath.t;
@@ -65,6 +69,7 @@ type t = {
   compile_grep : string option;
   link_grep : string option;
   generate_grep : string option;
+  remap : bool;
 }
 
 let term =
@@ -82,7 +87,8 @@ let term =
   and+ odoc_bin = odoc_bin
   and+ compile_grep = compile_grep
   and+ link_grep = link_grep
-  and+ generate_grep = generate_grep in
+  and+ generate_grep = generate_grep
+  and+ remap = remap in
   {
     verbose;
     odoc_dir;
@@ -96,4 +102,5 @@ let term =
     compile_grep;
     link_grep;
     generate_grep;
+    remap;
   }

src/driver/compile.ml

@@ -242,7 +242,7 @@ let link : compiled list -> _ =
         c
     | _ ->
         Logs.debug (fun m -> m "linking %a" Fpath.pp c.odoc_file);
-        link c.odoc_file c.odocl_file c.enable_warnings;
+        if c.to_output then link c.odoc_file c.odocl_file c.enable_warnings;
         (match c.kind with
         | `Intf _ -> Atomic.incr Stats.stats.linked_units
         | `Mld -> Atomic.incr Stats.stats.linked_mlds
@@ -262,7 +262,7 @@ let sherlodoc_index_one ~output_dir (index : Odoc_unit.index) =
   Sherlodoc.index ~format:`js ~inputs ~dst ();
   rel_path
 
-let html_generate ~occurrence_file output_dir linked =
+let html_generate ~occurrence_file ~remaps output_dir linked =
   let tbl = Hashtbl.create 10 in
   let _ = OS.Dir.create output_dir |> Result.get_ok in
   Sherlodoc.js Fpath.(output_dir // Sherlodoc.js_file);
@@ -289,34 +289,43 @@ let html_generate ~occurrence_file output_dir linked =
         rel_path
     | Some p -> Promise.await p
   in
-  let html_generate : linked -> unit =
-   fun l ->
-    let output_dir = Fpath.to_string output_dir in
-    let input_file = l.odocl_file in
-    match l.kind with
-    | `Intf { hidden = true; _ } -> ()
-    | `Impl { src_path; _ } ->
-        Odoc.html_generate_source ~search_uris:[] ~output_dir ~input_file
-          ~source:src_path ();
-        Odoc.html_generate_source ~search_uris:[] ~output_dir ~input_file
-          ~source:src_path ~as_json:true ();
-        Atomic.incr Stats.stats.generated_units
-    | `Asset ->
-        Odoc.html_generate_asset ~output_dir ~input_file:l.odoc_file
-          ~asset_path:l.input_file ()
-    | _ ->
-        let search_uris, index =
-          match l.index with
-          | None -> (None, None)
-          | Some index ->
-              let db_path = compile_index index in
-              let search_uris = [ db_path; Sherlodoc.js_file ] in
-              let index = index.output_file in
-              (Some search_uris, Some index)
-        in
-        Odoc.html_generate ?search_uris ?index ~output_dir ~input_file ();
-        Odoc.html_generate ?search_uris ?index ~output_dir ~input_file
-          ~as_json:true ();
-        Atomic.incr Stats.stats.generated_units
+  let html_generate : Fpath.t option -> linked -> unit =
+   fun remap_file l ->
+    (if l.to_output then
+       let output_dir = Fpath.to_string output_dir in
+       let input_file = l.odocl_file in
+       match l.kind with
+       | `Intf { hidden = true; _ } -> ()
+       | `Impl { src_path; _ } ->
+           Odoc.html_generate_source ~search_uris:[] ~output_dir ~input_file
+             ~source:src_path ();
+           Odoc.html_generate_source ~search_uris:[] ~output_dir ~input_file
+             ~source:src_path ~as_json:true ();
+           Atomic.incr Stats.stats.generated_units
+       | `Asset ->
+           Odoc.html_generate_asset ~output_dir ~input_file:l.odoc_file
+             ~asset_path:l.input_file ()
+       | _ ->
+           let search_uris, index =
+             match l.index with
+             | None -> (None, None)
+             | Some index ->
+                 let db_path = compile_index index in
+                 let search_uris = [ db_path; Sherlodoc.js_file ] in
+                 let index = index.output_file in
+                 (Some search_uris, Some index)
+           in
+           Odoc.html_generate ?search_uris ?index ~remap:remap_file ~output_dir
+             ~input_file ();
+           Odoc.html_generate ?search_uris ?index ~output_dir ~input_file
+             ~as_json:true ());
+    Atomic.incr Stats.stats.generated_units
   in
-  Fiber.List.iter html_generate linked
+  if List.length remaps = 0 then Fiber.List.iter (html_generate None) linked
+  else
+    Bos.OS.File.with_tmp_oc "remap.%s.txt"
+      (fun fpath oc () ->
+        List.iter (fun (a, b) -> Printf.fprintf oc "%s:%s\n%!" a b) remaps;
+        Fiber.List.iter (html_generate (Some fpath)) linked)
+      ()
+    |> ignore

src/driver/compile.mli

@@ -14,4 +14,9 @@ type linked
 
 val link : compiled list -> linked list
 
-val html_generate : occurrence_file:Fpath.t -> Fpath.t -> linked list -> unit
+val html_generate :
+  occurrence_file:Fpath.t ->
+  remaps:(string * string) list ->
+  Fpath.t ->
+  linked list ->
+  unit

src/driver/dune_style.ml

@@ -122,7 +122,8 @@ let of_dune_build dir =
                       assets =
                         []
                         (* When dune has a notion of doc assets, do something *);
-                      enable_warnings = false;
+                      selected = false;
+                      remaps = [];
                       pkg_dir;
                       other_docs = [];
                       config = Global_config.empty;

src/driver/landing_pages.ml

@@ -18,6 +18,7 @@ let make_index ~dirs ~rel_dir ?index ~content () =
     odoc_file;
     odocl_file;
     enable_warnings = false;
+    to_output = true;
     kind = `Mld;
     index;
   }

src/driver/odoc.ml

@@ -180,7 +180,7 @@ let compile_index ?(ignore_output = false) ~output_file ?occurrence_file ~json
   ignore @@ Cmd_outputs.submit log desc cmd (Some output_file)
 
 let html_generate ~output_dir ?index ?(ignore_output = false)
-    ?(search_uris = []) ?(as_json = false) ~input_file:file () =
+    ?(search_uris = []) ?(remap = None) ?(as_json = false) ~input_file:file () =
   let open Cmd in
   let index =
     match index with None -> empty | Some idx -> v "--index" % p idx
@@ -193,6 +193,9 @@ let html_generate ~output_dir ?index ?(ignore_output = false)
   let cmd =
     !odoc % "html-generate" % p file %% index %% search_uris % "-o" % output_dir
   in
+  let cmd =
+    match remap with None -> cmd | Some f -> cmd % "--remap-file" % p f
+  in
   let cmd = if as_json then cmd % "--as-json" else cmd in
   let desc = Printf.sprintf "Generating HTML for %s" (Fpath.to_string file) in
   let log =

src/driver/odoc.mli

@@ -55,6 +55,7 @@ val html_generate :
   ?index:Fpath.t ->
   ?ignore_output:bool ->
   ?search_uris:Fpath.t list ->
+  ?remap:Fpath.t option ->
   ?as_json:bool ->
   input_file:Fpath.t ->
   unit ->

src/driver/odoc_driver.ml

@@ -133,6 +133,7 @@ let run mode
       compile_grep;
       link_grep;
       generate_grep;
+      remap;
     } =
   Option.iter (fun odoc_bin -> Odoc.odoc := Bos.Cmd.v odoc_bin) odoc_bin;
   let _ = Voodoo.find_universe_and_version "foo" in
@@ -195,6 +196,14 @@ let run mode
         | _ -> failwith "Error, expecting singleton library in voodoo mode")
     | _ -> None
   in
+  let remaps =
+    if remap then
+      List.concat_map
+        (fun (_, pkg) -> pkg.Packages.remaps)
+        (Util.StringMap.bindings all)
+    else []
+  in
+  Logs.debug (fun m -> m "XXXX Remaps length: %d" (List.length remaps));
   let () =
     Eio.Fiber.both
       (fun () ->
@@ -204,7 +213,7 @@ let run mode
             let odocl_dir = Option.value odocl_dir ~default:odoc_dir in
             { Odoc_unit.odoc_dir; odocl_dir; index_dir; mld_dir }
           in
-          Odoc_units_of.packages ~dirs ~extra_paths all
+          Odoc_units_of.packages ~dirs ~extra_paths ~remap all
         in
         Compile.init_stats units;
         let compiled =
@@ -229,7 +238,9 @@ let run mode
               let () = Odoc.count_occurrences ~input:[ odoc_dir ] ~output in
               output
             in
-            let () = Compile.html_generate ~occurrence_file html_dir linked in
+            let () =
+              Compile.html_generate ~occurrence_file ~remaps html_dir linked
+            in
             let _ = Odoc.support_files html_dir in
             ())
       (fun () -> render_stats env nb_workers)

src/driver/odoc_unit.ml

@@ -58,6 +58,7 @@ type 'a unit = {
   pkgname : string option;
   index : index option;
   enable_warnings : bool;
+  to_output : bool;
   kind : 'a;
 }
 

src/driver/odoc_unit.mli

@@ -33,6 +33,7 @@ type 'a unit = {
   pkgname : string option;
   index : index option;
   enable_warnings : bool;
+  to_output : bool;
   kind : 'a;
 }
 

src/driver/odoc_units_of.ml

@@ -1,6 +1,6 @@
 open Odoc_unit
 
-let packages ~dirs ~extra_paths (pkgs : Packages.t list) : t list =
+let packages ~dirs ~extra_paths ~remap (pkgs : Packages.t list) : t list =
   let { odoc_dir; odocl_dir; index_dir; mld_dir = _ } = dirs in
   (* [module_of_hash] Maps a hash to the corresponding [Package.t], library name and
      [Packages.modulety]. [lib_dirs] maps a library name to the odoc dir containing its
@@ -88,7 +88,9 @@ let packages ~dirs ~extra_paths (pkgs : Packages.t list) : t list =
   in
 
   let make_unit ~name ~kind ~rel_dir ~input_file ~pkg ~lib_deps ~enable_warnings
-      : _ unit =
+      ~to_output : _ unit =
+    let to_output = to_output || not remap in
+    (* If we haven't got active remapping, we output everything *)
     let ( // ) = Fpath.( // ) in
     let ( / ) = Fpath.( / ) in
     let pkg_args = args_of pkg lib_deps in
@@ -109,6 +111,7 @@ let packages ~dirs ~extra_paths (pkgs : Packages.t list) : t list =
       odoc_file;
       odocl_file;
       kind;
+      to_output;
       enable_warnings;
       index = Some (index_of pkg);
     }
@@ -142,7 +145,7 @@ let packages ~dirs ~extra_paths (pkgs : Packages.t list) : t list =
         in
         let name = intf.mif_path |> Fpath.rem_ext |> Fpath.basename in
         make_unit ~name ~kind ~rel_dir ~input_file:intf.mif_path ~pkg ~lib_deps
-          ~enable_warnings:pkg.enable_warnings
+          ~enable_warnings:pkg.selected ~to_output:pkg.selected
       in
       match Hashtbl.find_opt intf_cache intf.mif_hash with
       | Some unit -> unit
@@ -170,7 +173,7 @@ let packages ~dirs ~extra_paths (pkgs : Packages.t list) : t list =
         in
         let unit =
           make_unit ~name ~kind ~rel_dir ~input_file:impl.mip_path ~pkg
-            ~lib_deps ~enable_warnings:pkg.enable_warnings
+            ~lib_deps ~enable_warnings:pkg.selected ~to_output:pkg.selected
         in
         Some unit
   in
@@ -185,9 +188,13 @@ let packages ~dirs ~extra_paths (pkgs : Packages.t list) : t list =
   in
   let of_lib pkg (lib : Packages.libty) =
     let lib_deps = Util.StringSet.add lib.lib_name lib.lib_deps in
-    let index = index_of pkg in
-    let landing_page :> t = Landing_pages.library ~dirs ~pkg ~index lib in
-    landing_page :: List.concat_map (of_module pkg lib lib_deps) lib.modules
+    let landing_page :> t list =
+      if pkg.Packages.selected then
+        let index = index_of pkg in
+        [ Landing_pages.library ~dirs ~pkg ~index lib ]
+      else []
+    in
+    landing_page @ List.concat_map (of_module pkg lib lib_deps) lib.modules
   in
   let of_mld pkg (mld : Packages.mld) : mld unit list =
     let open Fpath in
@@ -202,7 +209,7 @@ let packages ~dirs ~extra_paths (pkgs : Packages.t list) : t list =
     in
     let unit =
       make_unit ~name ~kind ~rel_dir ~input_file:mld_path ~pkg ~lib_deps
-        ~enable_warnings:pkg.enable_warnings
+        ~enable_warnings:pkg.selected ~to_output:pkg.selected
     in
     [ unit ]
   in
@@ -216,7 +223,7 @@ let packages ~dirs ~extra_paths (pkgs : Packages.t list) : t list =
         let lib_deps = Util.StringSet.empty in
         let unit =
           make_unit ~name ~kind ~rel_dir ~input_file:md ~pkg ~lib_deps
-            ~enable_warnings:pkg.enable_warnings
+            ~enable_warnings:pkg.selected ~to_output:pkg.selected
         in
         [ unit ]
     | _ ->
@@ -233,7 +240,7 @@ let packages ~dirs ~extra_paths (pkgs : Packages.t list) : t list =
     let unit =
       let name = asset_path |> Fpath.basename |> ( ^ ) "asset-" in
       make_unit ~name ~kind ~rel_dir ~input_file:asset_path ~pkg
-        ~lib_deps:Util.StringSet.empty ~enable_warnings:false
+        ~lib_deps:Util.StringSet.empty ~enable_warnings:false ~to_output:true
     in
     [ unit ]
   in
@@ -252,7 +259,7 @@ let packages ~dirs ~extra_paths (pkgs : Packages.t list) : t list =
               (Fpath.normalize (Fpath.v "./index.mld")))
           pkg.mlds
       in
-      if has_index_page then []
+      if has_index_page || not pkg.selected then []
       else
         let index = index_of pkg in
         [ Landing_pages.package ~dirs ~pkg ~index ]

src/driver/odoc_units_of.mli

@@ -1,4 +1,8 @@
 open Odoc_unit
 
 val packages :
-  dirs:dirs -> extra_paths:Voodoo.extra_paths -> Packages.t list -> t list
+  dirs:dirs ->
+  extra_paths:Voodoo.extra_paths ->
+  remap:bool ->
+  Packages.t list ->
+  t list