From 0ea44913edc5b5e8ddd09349440fc5576a0ff2d6 Mon Sep 17 00:00:00 2001
From: Guillaume Petiot <guillaume@tarides.com>
Date: Wed, 23 Aug 2023 15:56:29 +0100
Subject: [PATCH] Use the source rendering feature

---
 src/voodoo-do/do.ml         | 101 +++++++++++++++++++++++++++++-------
 src/voodoo-gen/main.ml      |  12 +++--
 src/voodoo-prep/dune        |   2 +-
 src/voodoo-prep/prep.ml     |  80 +++++++++++++++++++++++++---
 src/voodoo-prep/util.ml     |   4 ++
 src/voodoo-prep/util.mli    |   4 ++
 src/voodoo/dune.mli         |   9 +++-
 src/voodoo/dune_rules.ml    |  94 +++++++++++++++++++++++++++++++++
 src/voodoo/dune_rules.mli   |  15 ++++++
 src/voodoo/odoc.ml          |  27 +++++++++-
 src/voodoo/odoc.mli         |   8 +++
 src/voodoo/sourceinfo.ml    |   2 +
 src/voodoo/sourceinfo.mli   |   5 ++
 src/voodoo/src.ml           |  44 ++++++++++++++++
 src/voodoo/src.mli          |  18 +++++++
 src/voodoo/version.ml       |  13 +++--
 src/voodoo/version.mli      |   3 +-
 test/can-render-org-files.t |   8 ++-
 test/can-render-tables.t    |   8 ++-
 19 files changed, 418 insertions(+), 39 deletions(-)
 create mode 100644 src/voodoo/dune_rules.ml
 create mode 100644 src/voodoo/dune_rules.mli
 create mode 100644 src/voodoo/src.ml
 create mode 100644 src/voodoo/src.mli

diff --git a/src/voodoo-do/do.ml b/src/voodoo-do/do.ml
index 9e5f23c1..0698ab22 100644
--- a/src/voodoo-do/do.ml
+++ b/src/voodoo-do/do.ml
@@ -61,16 +61,29 @@ module IncludePaths = struct
     Index.M.fold (fun _ v acc -> Fpath.Set.add v acc) index.extern dirs
 end
 
-let get_source_info parent path =
+let get_source_info source_maps parent path =
   match Fpath.segs path with
-  | "prep" :: "universes" :: id :: pkg_name :: version :: _ -> (
+  | "prep" :: "universes" :: universe :: pkg_name :: version :: rest -> (
       match Odoc.compile_deps path with
       | Some (name, digest, deps) ->
+          let src_file =
+            match
+              List.assoc_opt
+                { Package.universe; name = pkg_name; version }
+                source_maps
+            with
+            | Some map ->
+                let path = String.concat "/" rest in
+                let p = Fpath.v path |> Fpath.set_ext ".cmt" in
+                Dune_rules.ml_of_cmt map p
+            | _ -> None
+          in
           [
             Sourceinfo.
               {
-                package = { universe = id; name = pkg_name; version };
+                package = { universe; name = pkg_name; version };
                 path;
+                src_file;
                 name;
                 digest;
                 deps;
@@ -141,6 +154,22 @@ let run pkg_name ~blessed ~failed =
       [] Paths.prep
     |> Result.get_ok
   in
+  let dune_rules =
+    Bos.OS.Dir.fold_contents ~dotfiles:false
+      (fun p acc ->
+        match Fpath.segs p with
+        | [ "prep"; "universes"; universe; name; version; "dune_rules" ] ->
+            if right_package p then
+              ({ Package.universe; name; version }, p) :: acc
+            else acc
+        | _ -> acc)
+      [] Paths.prep
+  in
+  let source_maps =
+    match dune_rules with
+    | Ok ps -> List.map (fun (pkg, rules) -> (pkg, Dune_rules.read rules)) ps
+    | _ -> []
+  in
   let modules =
     List.fold_left
       (fun acc f ->
@@ -150,6 +179,7 @@ let run pkg_name ~blessed ~failed =
       [] prep
   in
   let package = { Package.universe; name = pkg_name; version } in
+  let source_map = List.assoc_opt package source_maps in
   let output_path =
     if blessed then Fpath.(Paths.link / "p" / pkg_name / version)
     else Fpath.(Paths.link / "u" / universe / pkg_name / version)
@@ -188,14 +218,24 @@ let run pkg_name ~blessed ~failed =
 
   let error_log = Error_log.find package in
 
-  let parent =
-    Version.gen_parent package ~blessed ~modules ~dune ~libraries ~package_mlds
-      ~error_log ~failed
+  let src_files =
+    match source_map with
+    | Some map ->
+        Dune_rules.M.fold
+          (fun _cmt src acc -> Fpath.to_string src :: acc)
+          map.Dune_rules.src []
+    | None -> []
   in
 
-  let () = Package_info.gen ~output:output_path ~dune ~libraries in
+  let parent, src_parent =
+    Version.gen_parent package ~blessed ~modules ~src_files ~dune ~libraries
+      ~package_mlds ~error_log ~failed
+  in
 
-  let sis = Compat.List.concat_map (get_source_info parent) prep in
+  let src_parent_odoc = Src.output_file src_parent in
+
+  let () = Package_info.gen ~output:output_path ~dune ~libraries in
+  let sis = Compat.List.concat_map (get_source_info source_maps parent) prep in
   let this_index = InputSelect.select sis in
   Index.write this_index parent;
   let index = Index.combine this_index index in
@@ -212,7 +252,13 @@ let run pkg_name ~blessed ~failed =
       in
       let includes = IncludePaths.get index si in
       let output = Sourceinfo.output_file si in
-      Odoc.compile ~parent:parent.Mld.name ~output si.path ~includes
+      let source =
+        match si.src_file with
+        | Some fpath ->
+            Some (Fpath.to_string src_parent_odoc, Fpath.to_string fpath)
+        | None -> None
+      in
+      Odoc.compile ~parent:parent.Mld.name ~output si.path ~includes ?source
         ~children:[];
       si.path :: compiled
   in
@@ -226,32 +272,31 @@ let run pkg_name ~blessed ~failed =
   Util.mkdir_p output;
   Index.M.iter
     (fun _ si ->
-      if Sourceinfo.is_hidden si then ()
+      if Sourceinfo.is_hidden si then
+        let src = Sourceinfo.output_file si in
+        let dst = Sourceinfo.output_linked_odoc_for_src si in
+        let cmd = Bos.Cmd.(v "cp" % p src % p dst) in
+        Voodoo_lib.Util.run_silent cmd
       else
         Odoc.link
           (Sourceinfo.output_file si)
           ~includes:all_includes
           ~output:(Sourceinfo.output_odocl si))
     this_index.intern;
-  let odocls =
-    Index.M.fold
-      (fun _ si acc ->
-        if Sourceinfo.is_hidden si then acc
-        else Sourceinfo.output_odocl si :: acc)
-      this_index.intern []
-  in
   Odoc.link (Mld.output_file parent) ~includes:all_includes
     ~output:(Mld.output_odocl parent);
+  Odoc.link
+    (Src.output_file src_parent)
+    ~includes:all_includes
+    ~output:(Src.output_odocl src_parent);
   List.iter
     (fun mldv ->
       Odoc.link (Mld.output_file mldv) ~includes:all_includes
         ~output:(Mld.output_odocl mldv))
     mldvs;
-  let odocls = odocls @ List.map Mld.output_odocl (parent :: mldvs) in
   Format.eprintf "%d other files to copy\n%!" (List.length otherdocs);
   let otherdocs, _opam_file = Otherdocs.copy parent otherdocs opam_file in
   List.iter (fun p -> Format.eprintf "dest: %a\n%!" Fpath.pp p) otherdocs;
-  List.iter (Odoc.html ~output) odocls;
   let () =
     Bos.OS.File.delete (Fpath.v "compile/page-p.odoc") |> Result.get_ok
   in
@@ -262,6 +307,24 @@ let run pkg_name ~blessed ~failed =
     Bos.OS.File.delete (Fpath.v ("compile/p/page-" ^ pkg_name ^ ".odoc"))
     |> Result.get_ok
   in
+  (* copy source *)
+  let () =
+    let src_path =
+      Fpath.(Paths.prep / "universes" / universe / pkg_name / version / "src")
+    in
+    match Bos.OS.Dir.exists src_path with
+    | Ok true ->
+        let dst_path = output_path in
+        let cmd =
+          Bos.Cmd.(
+            v "rsync" % "-av" % Fpath.to_string src_path
+            % Fpath.to_string dst_path)
+        in
+        List.iter
+          (fun l -> Format.eprintf "%s\n%!" l)
+          (Util.lines_of_process cmd)
+    | _ -> ()
+  in
   if failed then
     Bos.OS.File.write Fpath.(output_path / "failed") "failed" |> Result.get_ok;
   ()
diff --git a/src/voodoo-gen/main.ml b/src/voodoo-gen/main.ml
index acdd22a9..fb620b38 100644
--- a/src/voodoo-gen/main.ml
+++ b/src/voodoo-gen/main.ml
@@ -68,6 +68,7 @@ let generate_pkgver output_dir name_filter version_filter =
             (fun p files ->
               match Fpath.get_ext p with
               | ".odocl" -> { files with odocls = p :: files.odocls }
+              | ".odoc" -> { files with odocls = p :: files.odocls }
               | _ -> (
                   match Fpath.basename p with
                   | "opam" -> files
@@ -101,10 +102,13 @@ let generate_pkgver output_dir name_filter version_filter =
               in
               Fpath.normalize @@ Odoc_odoc.Fs.File.append output_dir output_path
             in
-            let paths =
-              List.rev_map (Rendering.render ~output) files
-              |> List.rev_map Result.get_ok |> List.flatten
-            in
+            let root = Fpath.(pkg_path / "src") in
+            Voodoo_lib.Util.mkdir_p root;
+            let src_output = Odoc_odoc.Fs.Directory.to_string output_dir in
+            List.iter
+              (Voodoo_lib.Odoc.html_gen_source ~root ~output:src_output)
+              files;
+            let paths = [] in
             let foutput =
               Fpath.v (Odoc_odoc.Fs.Directory.to_string output_dir)
             in
diff --git a/src/voodoo-prep/dune b/src/voodoo-prep/dune
index c55d26f5..5ea07b4d 100644
--- a/src/voodoo-prep/dune
+++ b/src/voodoo-prep/dune
@@ -2,4 +2,4 @@
  (name main)
  (public_name voodoo-prep)
  (package voodoo-prep)
- (libraries cmdliner fpath bos opam-format))
+ (libraries cmdliner fpath bos.setup opam-format))
diff --git a/src/voodoo-prep/prep.ml b/src/voodoo-prep/prep.ml
index 9f96d87d..4179747d 100644
--- a/src/voodoo-prep/prep.ml
+++ b/src/voodoo-prep/prep.ml
@@ -1,10 +1,20 @@
 type actions = { copy : (Fpath.t * Fpath.t) list; objinfo : Fpath.t list }
 
+module Result = Bos_setup.R
+open Result.Infix
+
 (** [process_package root p files] copies some files among [files] to the
     [Package.prep_path p]. Store the [ocamlobjinfo] of the [.cma] files. *)
-let process_package : Fpath.t -> Package.t -> Fpath.t list -> unit =
- fun root package files ->
+let process_package :
+    Fpath.t ->
+    Package.t ->
+    Fpath.t list ->
+    (Fpath.t * Fpath.t) list ->
+    Fpath.t ->
+    unit =
+ fun root package files src_files build_path ->
   let dest = Package.prep_path package in
+  let src_dest = Fpath.(dest / "src") in
 
   (* Some packages produce ocaml artefacts that can't be processed with the switch's
       ocaml compiler - most notably the secondary compiler! This switch is intended to
@@ -44,7 +54,10 @@ let process_package : Fpath.t -> Package.t -> Fpath.t list -> unit =
     let objinfo = if is_cma then fpath :: acc.objinfo else acc.objinfo in
     { copy; objinfo }
   in
-  let actions = List.fold_right foldfn files { copy = []; objinfo = [] } in
+  let copy =
+    List.map (fun (fpath, rpath) -> Fpath.(fpath, src_dest // rpath)) src_files
+  in
+  let actions = List.fold_right foldfn files { copy; objinfo = [] } in
   List.iter
     (fun (src, dst) ->
       let dir, _ = Fpath.split_base dst in
@@ -58,7 +71,35 @@ let process_package : Fpath.t -> Package.t -> Fpath.t list -> unit =
           Bos.Cmd.(v "ocamlobjinfo" % Fpath.(to_string (root // fpath)))
       in
       Util.write_file Fpath.(dest // set_ext "ocamlobjinfo" fpath) lines)
-    actions.objinfo
+    actions.objinfo;
+  let lines =
+    Bos.OS.Dir.with_current build_path
+      (fun () ->
+        Bos.OS.File.exists (Fpath.v "dune-project") >>= fun exists ->
+        Bos.OS.Dir.exists (Fpath.v "_build/default") >>= fun exists' ->
+        if exists && exists' then
+          Bos.OS.Dir.fold_contents ~dotfiles:true
+            (fun p acc -> if Fpath.has_ext ".cmt" p then p :: acc else acc)
+            []
+            Fpath.(v "_build")
+          >>= function
+          | [] -> Ok []
+          | cmts ->
+              let cmd =
+                List.fold_left
+                  (fun acc cmt -> Bos.Cmd.(acc % p cmt))
+                  Bos.Cmd.(v "dune" % "rules" % "-p" % package.name)
+                  cmts
+              in
+              let lines = try Util.lines_of_process cmd with _ -> [] in
+              Ok lines
+        else Ok [])
+      ()
+  in
+  match lines with
+  | Ok (Ok []) -> ()
+  | Ok (Ok l) -> Util.write_file Fpath.(dest / "dune_rules") l
+  | _ -> ()
 
 let run (universes : (string * string) list) =
   let get_universe =
@@ -93,11 +134,38 @@ let run (universes : (string * string) list) =
          []
   in
   let root = Opam.prefix () |> Fpath.v in
+  let pkg_src build_path =
+    let src_root = build_path in
+    let src_files =
+      let dune_src_root = Fpath.(src_root / "_build" / "default") in
+      let root =
+        match Bos.OS.Dir.exists dune_src_root with
+        | Ok true -> dune_src_root
+        | _ -> src_root
+      in
+      Bos.OS.Dir.fold_contents
+        (fun p acc ->
+          if Fpath.has_ext ".ml" p then
+            (p, Fpath.relativize ~root p |> Option.get) :: acc
+          else acc)
+        [] dune_src_root
+    in
+    Util.R.value ~default:[] src_files
+  in
   let pkg_contents =
-    List.map (fun package -> (package, Opam.pkg_contents package)) packages
+    List.map
+      (fun package ->
+        let build_path =
+          Fpath.(
+            root / ".opam-switch" / "build"
+            / (package.Package.name ^ "." ^ package.version))
+        in
+        (package, Opam.pkg_contents package, pkg_src build_path, build_path))
+      packages
   in
   List.iter
-    (fun (package, files) -> process_package root package files)
+    (fun (package, files, src_files, build_path) ->
+      process_package root package files src_files build_path)
     pkg_contents;
   List.iter
     (fun package ->
diff --git a/src/voodoo-prep/util.ml b/src/voodoo-prep/util.ml
index eadf3f29..58013f1e 100644
--- a/src/voodoo-prep/util.ml
+++ b/src/voodoo-prep/util.ml
@@ -40,3 +40,7 @@ let write_file filename lines =
   close_out oc
 
 let cp src dst = assert (lines_of_process Cmd.(v "cp" % src % dst) = [])
+
+module R = struct
+  let value ~default = function Ok x -> x | Error _ -> default
+end
diff --git a/src/voodoo-prep/util.mli b/src/voodoo-prep/util.mli
index b5664de7..b0ba5cd7 100644
--- a/src/voodoo-prep/util.mli
+++ b/src/voodoo-prep/util.mli
@@ -12,3 +12,7 @@ val write_file : Fpath.t -> string list -> unit
 
 val cp : string -> string -> unit
 (** [cp src dst] copies [src] to [dst]. *)
+
+module R : sig
+  val value : default:'a -> ('a, 'b) result -> 'a
+end
diff --git a/src/voodoo/dune.mli b/src/voodoo/dune.mli
index cf90dbfc..8cc21a2b 100644
--- a/src/voodoo/dune.mli
+++ b/src/voodoo/dune.mli
@@ -22,7 +22,14 @@ end
 
 type t = { name : string; version : string option; libraries : Library.t list }
 
-val process_file : Fpath.t -> (t, [> `Msg of string ]) Bos_setup.result
+val assoc_list :
+  Sexplib.Sexp.t ->
+  ((string * Sexplib.Sexp.t list) list, [> Bos_setup.R.msg ]) Bos_setup.result
+
+val sexp_of_file :
+  Fpath.t -> (Sexplib.Sexp.t, [> Bos_setup.R.msg ]) Bos_setup.result
+
+val process_file : Fpath.t -> (t, [> Bos_setup.R.msg ]) Bos_setup.result
 (** [process_file f] processes the [dune-package] file located at [f]. *)
 
 val find : Package.t -> (Fpath.t, [> Bos_setup.R.msg ]) Bos_setup.result
diff --git a/src/voodoo/dune_rules.ml b/src/voodoo/dune_rules.ml
new file mode 100644
index 00000000..e53724b9
--- /dev/null
+++ b/src/voodoo/dune_rules.ml
@@ -0,0 +1,94 @@
+module M = Map.Make (Fpath)
+
+type t = { installed : Fpath.t M.t; src : Fpath.t M.t }
+
+open Sexplib.Sexp
+
+let parse_dep = function
+  | List [ Atom "File"; List [ Atom "In_build_dir"; Atom b ] ] ->
+      Some (Fpath.v b)
+  | List [ Atom "File"; List _ ] -> (* Not in build dir, this is OK *) None
+  | List (Atom "glob" :: _) -> (* Fine, external glob *) None
+  | _ -> None
+
+let parse_deps = function [ List l ] -> List.filter_map parse_dep l | _ -> []
+let parse_file = function Atom x -> Some (Fpath.v x) | _ -> None
+
+let parse_files = function
+  | List [ Atom "files"; List l ] -> List.filter_map parse_file l
+  | List [ Atom "directories"; List _ ] -> [] (* This is fine *)
+  | _ -> []
+
+let parse_targets = function
+  | [ List l ] -> List.map parse_files l |> List.flatten
+  | _ -> []
+
+let relativize p ~root = Fpath.(relativize ~root:(v root) p) |> Option.get
+
+let read path =
+  let init = { installed = M.empty; src = M.empty } in
+  let p =
+    match Dune.sexp_of_file path with
+    | Ok p -> p
+    | Error (`Msg m) ->
+        Format.eprintf "Failed to read '%a' (%s)\n%!" Fpath.pp path m;
+        List []
+  in
+  let rs = match p with List l -> l | _ -> [] in
+  let vs =
+    List.map (fun r -> Result.value ~default:[] (Dune.assoc_list r)) rs
+  in
+  List.fold_left
+    (fun acc r ->
+      try
+        let deps = List.assoc "deps" r |> parse_deps in
+        let targets = List.assoc "targets" r |> parse_targets in
+        let is_install_rule =
+          List.exists Fpath.(is_prefix (v "install/default")) targets
+        in
+        if is_install_rule then (
+          Format.eprintf "install rule\n%!";
+          match (targets, deps) with
+          | [ target ], [ dep ] ->
+              let t = relativize ~root:"install/default" target in
+              let d = relativize ~root:"_build/default" dep in
+              { acc with installed = M.add t d acc.installed }
+          | _, _ ->
+              Format.eprintf
+                "install rule with unexpected number of deps/targets\n\
+                 %a\n\
+                 %a\n\
+                 %!"
+                pp_hum
+                (List (List.assoc "deps" r))
+                pp_hum
+                (List (List.assoc "targets" r));
+              acc)
+        else
+          let cmt_target =
+            targets
+            |> List.find (Fpath.has_ext ".cmt")
+            |> relativize ~root:"default"
+          in
+          let ml_deps =
+            List.find_all (Fpath.mem_ext [ ".ml"; ".ml-gen" ]) deps
+          in
+          match ml_deps with
+          | [ ml_dep ] ->
+              let ml_dep = relativize ~root:"_build/default" ml_dep in
+              { acc with src = M.add cmt_target ml_dep acc.src }
+          | _ ->
+              Format.eprintf
+                "Unhandled, multiple ml files for a cmt dependency found: %a"
+                (Format.pp_print_list ~pp_sep:Format.pp_print_space Fpath.pp)
+                ml_deps;
+              acc
+      with _ -> acc)
+    init vs
+
+let ml_of_cmt t cmt_path =
+  try
+    let build_path = M.find cmt_path t.installed in
+    let src_path = M.find build_path t.src in
+    Some src_path
+  with _ -> None
diff --git a/src/voodoo/dune_rules.mli b/src/voodoo/dune_rules.mli
new file mode 100644
index 00000000..6a69f79e
--- /dev/null
+++ b/src/voodoo/dune_rules.mli
@@ -0,0 +1,15 @@
+module M : module type of Map.Make (Fpath)
+
+type t = {
+  installed : Fpath.t M.t;
+      (* Map from install location to source-tree location.
+         For the above, contains a binding mapping [either/either__Either_intf.cmt]
+         to [src/.either.objs/byte/either__Either_intf.cmt] *)
+  src : Fpath.t M.t;
+      (* Map from build tree location to ml file. For the above, contains
+         a binding mapping [src/.either.objs/byte/either__Either_intf.cmt]
+         to [src/either_intf.ml] *)
+}
+
+val read : Fpath.t -> t
+val ml_of_cmt : t -> Fpath.t -> Fpath.t option
diff --git a/src/voodoo/odoc.ml b/src/voodoo/odoc.ml
index 853e18c5..9caea466 100644
--- a/src/voodoo/odoc.ml
+++ b/src/voodoo/odoc.ml
@@ -52,7 +52,7 @@ let compile_deps file =
 
 type child = CModule of string | CPage of string | CSrc of string
 
-let compile ?parent ?output path ~includes ~children =
+let compile ?parent ?output ?source path ~includes ~children =
   let cmd = Bos.Cmd.(v "odoc" % "compile" % Fpath.to_string path) in
   let cmd =
     match output with
@@ -69,6 +69,12 @@ let compile ?parent ?output path ~includes ~children =
       (fun i c -> Bos.Cmd.(c % "-I" % Fpath.to_string i))
       includes cmd
   in
+  let cmd =
+    match source with
+    | Some (parent, file) ->
+        Bos.Cmd.(cmd % "--source-parent-file" % parent % "--source-name" % file)
+    | None -> cmd
+  in
   let cmd =
     List.fold_left
       (fun cmd c ->
@@ -84,6 +90,16 @@ let compile ?parent ?output path ~includes ~children =
   Format.eprintf "compile command: %a\n%!" Bos.Cmd.pp cmd;
   Util.run_silent cmd
 
+let source_tree ~parent path ~includes ~output =
+  let cmd =
+    Bos.Cmd.(
+      v "odoc" % "source-tree" % p path % "-o" % p output % "-I" % p includes
+      % "--parent"
+      % Printf.sprintf "page-\"%s\"" parent)
+  in
+  Format.eprintf "source-tree command: %a\n%!" Bos.Cmd.pp cmd;
+  Util.run_silent cmd
+
 let link path ~includes ~output =
   let cmd =
     Bos.Cmd.(
@@ -103,3 +119,12 @@ let html path ~output =
       % Fpath.to_string output)
   in
   Util.run_silent cmd
+
+let html_gen_source path ~output ~root =
+  let cmd =
+    Bos.Cmd.(
+      v "odoc" % "html-generate" % "--as-json" % "--source-root" % p root % "-o"
+      % output % p path)
+  in
+  Format.eprintf "html-generate command: %a\n%!" Bos.Cmd.pp cmd;
+  Util.run_silent cmd
diff --git a/src/voodoo/odoc.mli b/src/voodoo/odoc.mli
index 67a01297..0c5fd56f 100644
--- a/src/voodoo/odoc.mli
+++ b/src/voodoo/odoc.mli
@@ -21,6 +21,7 @@ type child =
 val compile :
   ?parent:string ->
   ?output:Fpath.t ->
+  ?source:string * string ->
   Fpath.t ->
   includes:Fpath.set ->
   children:child list ->
@@ -28,8 +29,15 @@ val compile :
 (** [compile p ?parent ?output ~includes ~children] runs [odoc compile] on path
     [p]. *)
 
+val source_tree :
+  parent:string -> Fpath.t -> includes:Fpath.t -> output:Fpath.t -> unit
+(** [source_tree ~parent p ~includes ~output] runs [odoc source-tree] on path
+    [p]. *)
+
 val link : Fpath.t -> includes:Fpath.set -> output:Fpath.t -> unit
 (** [link p ~includes ~output] runs [odoc link] on path [p]. *)
 
 val html : Fpath.t -> output:Fpath.t -> unit
 (** [html p ~output] runs [odoc html-generate] on path [p]. *)
+
+val html_gen_source : Fpath.t -> output:string -> root:Fpath.t -> unit
diff --git a/src/voodoo/sourceinfo.ml b/src/voodoo/sourceinfo.ml
index 49438a2c..cba6c1b3 100644
--- a/src/voodoo/sourceinfo.ml
+++ b/src/voodoo/sourceinfo.ml
@@ -1,6 +1,7 @@
 type t = {
   package : Package.t;
   path : Paths.t;
+  src_file : Fpath.t option;
   name : string;
   digest : string;
   parent : Mld.t;
@@ -21,4 +22,5 @@ let compile_dir = output_dir ~base:Paths.compile
 let link_dir = output_dir ~base:Paths.link
 let output_file si = Fpath.(compile_dir si / (si.name ^ ".odoc"))
 let output_odocl si = Fpath.(link_dir si / (si.name ^ ".odocl"))
+let output_linked_odoc_for_src si = Fpath.(link_dir si / (si.name ^ ".odoc"))
 let is_hidden t = Util.is_hidden t.name
diff --git a/src/voodoo/sourceinfo.mli b/src/voodoo/sourceinfo.mli
index 18852446..b4c25f5d 100644
--- a/src/voodoo/sourceinfo.mli
+++ b/src/voodoo/sourceinfo.mli
@@ -1,6 +1,7 @@
 type t = {
   package : Package.t;
   path : Fpath.t;
+  src_file : Fpath.t option;
   name : string;
   digest : string;
   parent : Mld.t;
@@ -19,4 +20,8 @@ val output_odocl : t -> Fpath.t
 (** [output_odocl x] returns the path of the [.odocl] file resulting of running
     [odoc link] on [x]. *)
 
+val output_linked_odoc_for_src : t -> Fpath.t
+(** [output_linked_odoc_for_src x] returns the path of the [.odoc] file for
+    source rendering. *)
+
 val is_hidden : t -> bool
diff --git a/src/voodoo/src.ml b/src/voodoo/src.ml
new file mode 100644
index 00000000..43a1923b
--- /dev/null
+++ b/src/voodoo/src.ml
@@ -0,0 +1,44 @@
+type t = {
+  path : Paths.t;
+  name : string;
+  contents : string list;
+  parent : Mld.t;
+}
+
+let output_dir ~base src =
+  let pdir = Mld.output_dir ~base src.parent in
+  Fpath.(pdir / src.parent.name)
+
+let compile_dir = output_dir ~base:Paths.compile
+let link_dir = output_dir ~base:Paths.link
+let output_file src = Fpath.(compile_dir src / ("src-" ^ src.name ^ ".odoc"))
+let output_odocl src = Fpath.(link_dir src / ("src-" ^ src.name ^ ".odocl"))
+
+let compile src =
+  let () = Bos.OS.File.delete (output_file src) |> Result.get_ok in
+  let includes, parent = (Mld.compile_dir src.parent, src.parent.name) in
+  Odoc.source_tree ~parent ~output:(output_file src) src.path ~includes
+
+let write src =
+  let contents = List.sort String.compare src.contents in
+  let oc = open_out Fpath.(to_string src.path) in
+  List.iter (fun line -> Printf.fprintf oc "%s\n" line) contents;
+  close_out oc
+
+let v dir name parent contents =
+  let path = Fpath.(dir / (name ^ ".map")) in
+  let src = { path; name; parent; contents } in
+  Util.mkdir_p dir;
+  src
+
+let remove name =
+  match Bos.OS.File.delete Fpath.(v (name ^ ".map")) with
+  | Ok x -> x
+  | Error (`Msg m) ->
+      Format.eprintf "Failed to remove file: %s.map - %s\n%!" name m;
+      ()
+
+let compile src =
+  remove src.name;
+  write src;
+  compile src
diff --git a/src/voodoo/src.mli b/src/voodoo/src.mli
new file mode 100644
index 00000000..39933087
--- /dev/null
+++ b/src/voodoo/src.mli
@@ -0,0 +1,18 @@
+type t = {
+  path : Paths.t;
+  name : string;
+  contents : string list;
+  parent : Mld.t;
+}
+
+val v : Fpath.t -> string -> Mld.t -> string list -> t
+(** [v path name contents parent] builds the source file. *)
+
+val output_file : t -> Fpath.t
+(** Path of the [.odoc] file resulting from the compilation. *)
+
+val output_odocl : t -> Fpath.t
+(** Path of the [.odocl] file resulting from the linking. *)
+
+val compile : t -> unit
+(** [compile src] calls [odoc source-tree] on [src]. *)
diff --git a/src/voodoo/version.ml b/src/voodoo/version.ml
index c0134223..06ae6c29 100644
--- a/src/voodoo/version.ml
+++ b/src/voodoo/version.ml
@@ -116,13 +116,15 @@ let gen_parent :
     Package.t ->
     blessed:bool ->
     modules:string list ->
+    src_files:string list ->
     dune:Dune.t option ->
     libraries:Ocamlobjinfo.t list ->
     package_mlds:Fpath.t list ->
     error_log:Error_log.t ->
     failed:bool ->
-    Mld.t =
- fun package ~blessed ~modules ~dune ~libraries ~package_mlds ~error_log ~failed ->
+    Mld.t * Src.t =
+ fun package ~blessed ~modules ~src_files ~dune ~libraries ~package_mlds
+     ~error_log ~failed ->
   let cwd = Fpath.v "." in
   let mld_index, mld_children =
     List.partition (fun mld -> Fpath.basename mld = "index.mld") package_mlds
@@ -168,7 +170,8 @@ let gen_parent :
   in
 
   let version =
-    Mld.v cwd package.version (Some pkg) [ Odoc.CPage "doc" ]
+    Mld.v cwd package.version (Some pkg)
+      [ Odoc.CPage "doc"; Odoc.CSrc "src" ]
       (Printf.sprintf "{0 %s}\n{!childpage:doc}\n" package.version)
   in
 
@@ -193,4 +196,6 @@ let gen_parent :
       (Printf.sprintf "{0 %s %s}\n%s\n" package.name package.version content)
   in
   Mld.compile doc;
-  doc
+  let src = Src.v cwd "src" version src_files in
+  Src.compile src;
+  (doc, src)
diff --git a/src/voodoo/version.mli b/src/voodoo/version.mli
index 1e4c0c50..7adf6b84 100644
--- a/src/voodoo/version.mli
+++ b/src/voodoo/version.mli
@@ -2,10 +2,11 @@ val gen_parent :
   Package.t ->
   blessed:bool ->
   modules:string list ->
+  src_files:string list ->
   dune:Dune.t option ->
   libraries:Ocamlobjinfo.t list ->
   package_mlds:Fpath.t list ->
   error_log:Error_log.t ->
   failed:bool ->
-  Mld.t
+  Mld.t * Src.t
 (** [gen_parent] generates the content of the version page. *)
diff --git a/test/can-render-org-files.t b/test/can-render-org-files.t
index 90a33c76..198e322f 100644
--- a/test/can-render-org-files.t
+++ b/test/can-render-org-files.t
@@ -12,7 +12,13 @@ Generate the can-render-org-files documentation
 
   $ voodoo-gen -o output
   0 other versions, 1 packages
-  Found 1 files
+  Found 2 files
+  html-generate command: odoc html-generate --as-json --source-root
+                           linked/p/can-render-org-files/1.0/src -o output/
+                           linked/p/can-render-org-files/1.0/page-doc.odocl
+  html-generate command: odoc html-generate --as-json --source-root
+                           linked/p/can-render-org-files/1.0/src -o output/
+                           linked/p/can-render-org-files/1.0/src-src.odocl
 
 Generates a status.json file
   $ cat output/p/$PKG/1.0/status.json | jq .
diff --git a/test/can-render-tables.t b/test/can-render-tables.t
index 6f025924..c2756a08 100644
--- a/test/can-render-tables.t
+++ b/test/can-render-tables.t
@@ -12,7 +12,13 @@ Generate the can-render-tables documentation
 
   $ voodoo-gen -o output
   0 other versions, 1 packages
-  Found 1 files
+  Found 2 files
+  html-generate command: odoc html-generate --as-json --source-root
+                           linked/p/can-render-tables/1.0/src -o output/
+                           linked/p/can-render-tables/1.0/page-doc.odocl
+  html-generate command: odoc html-generate --as-json --source-root
+                           linked/p/can-render-tables/1.0/src -o output/
+                           linked/p/can-render-tables/1.0/src-src.odocl
 
 Generates a status.json file
   $ cat output/p/$PKG/1.0/status.json | jq .