Add a source-root arg to html-generate

src/compat/compatcmdliner.ml

@@ -58,6 +58,8 @@ module Arg = struct
 
   let file = file
 
+  let dir = dir
+
   let bool = bool
 
   let ( & ) = ( & )

src/odoc/bin/main.ml

@@ -38,6 +38,22 @@ let convert_fpath =
   and print = Fpath.pp in
   Arg.conv (parse, print)
 
+let convert_src_fpath =
+  let parse inp =
+    match Arg.(conv_parser file) inp with
+    | Ok s -> Result.Ok (Html_page.File (Fs.File.of_string s))
+    | Error _ as e -> e
+  and print = Html_page.pp in
+  Arg.conv (parse, print)
+
+let convert_src_dir =
+  let parse inp =
+    match Arg.(conv_parser dir) inp with
+    | Ok s -> Result.Ok (Html_page.Root (Fs.File.of_string s))
+    | Error _ as e -> e
+  and print = Html_page.pp in
+  Arg.conv (parse, print)
+
 (** On top of the conversion 'string', split into segs. *)
 let convert_source_name =
   let parse inp =
@@ -703,7 +719,7 @@ module Odoc_html_args = struct
     in
     Arg.(
       value
-      & opt (some convert_fpath) None
+      & opt (some convert_src_fpath) None
       & info [ "source" ] ~doc ~docv:"file.ml")
 
   let assets =
@@ -714,19 +730,38 @@ module Odoc_html_args = struct
     Arg.(
       value & opt_all convert_fpath [] & info [ "asset" ] ~doc ~docv:"file.ext")
 
+  let source_root =
+    let doc =
+      "Source code root for the compilation unit. It must have been compiled \
+       with --source-parent passed."
+    in
+    Arg.(
+      value
+      & opt (some convert_src_dir) None
+      & info [ "source-root" ] ~doc ~docv:"dir")
+
   let extra_args =
     let config semantic_uris closed_details indent theme_uri support_uri flat
-        as_json source_file assets =
+        as_json source_file assets source_root =
       let open_details = not closed_details in
+      let source =
+        match (source_root, source_file) with
+        | Some x, None -> Some x
+        | None, Some x -> Some x
+        | None, None -> None
+        | Some _, Some _ ->
+            Printf.eprintf "ERROR: Can't use both source and source-root\n%!";
+            exit 1
+      in
       let html_config =
         Odoc_html.Config.v ~theme_uri ~support_uri ~semantic_uris ~indent ~flat
           ~open_details ~as_json ()
       in
-      { Html_page.html_config; source_file; assets }
+      { Html_page.html_config; source; assets }
     in
     Term.(
       const config $ semantic_uris $ closed_details $ indent $ theme_uri
-      $ support_uri $ flat $ as_json $ source_file $ assets)
+      $ support_uri $ flat $ as_json $ source_file $ assets $ source_root)
 end
 
 module Odoc_html = Make_renderer (Odoc_html_args)

src/odoc/html_page.ml

@@ -16,23 +16,45 @@
 
 open Odoc_model
 
+type source = File of Fpath.t | Root of Fpath.t
+
+let pp fmt = function
+  | File f -> Format.fprintf fmt "File: %a" Fpath.pp f
+  | Root f -> Format.fprintf fmt "File: %a" Fpath.pp f
+
+let to_string f = Format.asprintf "%a" pp f
+
 type args = {
   html_config : Odoc_html.Config.t;
-  source_file : Fpath.t option;
+  source : source option;
   assets : Fpath.t list;
 }
 
-let render { html_config; source_file = _; assets = _ } page =
+let render { html_config; source = _; assets = _ } page =
   Odoc_html.Generator.render ~config:html_config page
 
-let source_documents source_info source_file ~syntax =
-  match (source_info, source_file) with
+let source_documents source_info source ~syntax =
+  match (source_info, source) with
   | Some { Lang.Source_info.id; infos }, Some src -> (
-      match Fs.File.read src with
+      let file =
+        match src with
+        | File f -> f
+        | Root f ->
+            let open Odoc_model.Paths.Identifier in
+            let rec get_path_dir : SourceDir.t -> Fpath.t = function
+              | { iv = `SourceDir (d, f); _ } -> Fpath.(get_path_dir d / f)
+              | { iv = `Page _; _ } -> f
+            in
+            let get_path : SourcePage.t -> Fpath.t = function
+              | { iv = `SourcePage (d, f); _ } -> Fpath.(get_path_dir d / f)
+            in
+            get_path id
+      in
+      match Fs.File.read file with
       | Error (`Msg msg) ->
           Error.raise_warning
             (Error.filename_only "Couldn't load source file: %s" msg
-               (Fs.File.to_string src));
+               (Fs.File.to_string file));
           []
       | Ok source_code ->
           let infos = infos @ Odoc_loader.Source_info.of_source source_code in
@@ -54,7 +76,7 @@ let source_documents source_info source_file ~syntax =
         (Error.filename_only
            "--source argument is invalid on compilation unit that were not \
             compiled with --source-parent and --source-name"
-           (Fs.File.to_string src));
+           (to_string src));
       []
   | None, None -> []
 
@@ -109,7 +131,7 @@ let asset_documents parent_id children asset_paths =
 let extra_documents args input ~syntax =
   match input with
   | Odoc_document.Renderer.CU unit ->
-      source_documents unit.Lang.Compilation_unit.source_info args.source_file
+      source_documents unit.Lang.Compilation_unit.source_info args.source
         ~syntax
   | Page page -> asset_documents page.Lang.Page.name page.children args.assets
 

src/odoc/html_page.mli

@@ -16,9 +16,13 @@
 
 open Odoc_document
 
+type source = File of Fpath.t | Root of Fpath.t
+
+val pp : Format.formatter -> source -> unit
+
 type args = {
   html_config : Odoc_html.Config.t;
-  source_file : Fpath.t option;
+  source : source option;
   assets : Fpath.t list;
 }
 

test/sources/source_hierarchy_source_root.t/lib/a/a.ml

@@ -0,0 +1 @@
+let y = 1

test/sources/source_hierarchy_source_root.t/lib/b/b.ml

@@ -0,0 +1 @@
+let x = 0

test/sources/source_hierarchy_source_root.t/lib/main.ml

@@ -0,0 +1 @@
+let w = 5

test/sources/source_hierarchy_source_root.t/root.mld

@@ -0,0 +1 @@
+{0 Root}

test/sources/source_hierarchy_source_root.t/run.t

@@ -0,0 +1,80 @@
+A page can have source children.
+
+  $ odoc compile -c module-a -c module-b -c src-source root.mld
+
+  $ printf "lib/main.ml\nlib/b/b.ml\nlib/a/a.ml\n" > source.map
+  $ odoc source-tree -I . --parent page-root source.map
+
+Compile the modules:
+
+  $ ocamlc -c lib/a/a.ml -bin-annot
+  $ ocamlc -c lib/b/b.ml -bin-annot
+  $ ocamlc -c lib/main.ml -bin-annot
+
+Now, compile the pages with the --source option. The source-name must be included in the source-children of the source-parent:
+
+  $ odoc compile -I . --source-name lib/a/a.ml --source-parent-file src-source.odoc lib/a/a.cmt
+  $ odoc compile -I . --source-name lib/b/b.ml --source-parent-file src-source.odoc lib/b/b.cmt
+  $ odoc compile -I . --source-name lib/main.ml --source-parent-file src-source.odoc lib/main.cmt
+  $ odoc link -I . -I lib/a -I lib/b -I lib page-root.odoc
+  $ odoc link -I . lib/a/a.odoc
+  $ odoc link -I . lib/b/b.odoc
+  $ odoc link -I . lib/main.odoc
+  $ odoc link -I . src-source.odoc
+  $ odoc html-generate --indent -o html page-root.odocl
+  $ odoc html-generate --indent -o html src-source.odocl
+  $ odoc html-generate --source-root . --indent -o html lib/a/a.odocl
+  $ odoc html-generate --source-root . --indent -o html lib/b/b.odocl
+  $ odoc html-generate --source-root . --indent -o html lib/main.odocl
+
+Source pages and source directory pages are generated:
+
+  $ find html | sort
+  html
+  html/A
+  html/A/index.html
+  html/B
+  html/B/index.html
+  html/Main
+  html/Main/index.html
+  html/root
+  html/root/index.html
+  html/root/source
+  html/root/source/index.html
+  html/root/source/lib
+  html/root/source/lib/a
+  html/root/source/lib/a/a.ml.html
+  html/root/source/lib/a/index.html
+  html/root/source/lib/b
+  html/root/source/lib/b/b.ml.html
+  html/root/source/lib/b/index.html
+  html/root/source/lib/index.html
+  html/root/source/lib/main.ml.html
+
+A directory simply list its children:
+
+  $ cat html/root/source/lib/index.html
+  <!DOCTYPE html>
+  <html xmlns="http://www.w3.org/1999/xhtml">
+   <head><title>lib (root.source.lib)</title>
+    <link rel="stylesheet" href="../../../odoc.css"/><meta charset="utf-8"/>
+    <meta name="generator" content="odoc %%VERSION%%"/>
+    <meta name="viewport" content="width=device-width,initial-scale=1.0"/>
+    <script src="../../../highlight.pack.js"></script>
+    <script>hljs.initHighlightingOnLoad();</script>
+   </head>
+   <body class="odoc">
+    <nav class="odoc-nav"><a href="../index.html">Up</a> – 
+     <a href="../../index.html">root</a> &#x00BB; 
+     <a href="../index.html">source</a> &#x00BB; lib
+    </nav><header class="odoc-preamble"></header>
+    <div class="odoc-content"><h1>./lib/</h1>
+     <ul class="odoc-folder-list">
+      <li><span class="odoc-directory"><a href="a/index.html">a</a></span></li>
+      <li><span class="odoc-directory"><a href="b/index.html">b</a></span></li>
+      <li><span class="odoc-file"><a href="main.ml.html">main.ml</a></span>
+      </li>
+     </ul>
+    </div>
+   </body>
+  </html>