Add a source-root arg to html-generate

The relative path has already been given when the .cmt was originally compiled,
so to avoid having to pass it again this argument allows the root directory of
the source tree to be passed, and then odoc finds the actual source file by
looking up that relative file within the tree.

Author: jonludlam

src/compat/compatcmdliner.ml

@@ -60,6 +60,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 =
@@ -714,7 +730,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 =
@@ -725,19 +741,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 syntax_info =
@@ -56,7 +78,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 -> []
 
@@ -111,7 +133,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>