Add --cmt to compile, in addition to other source-related options

Signed-off-by: Paul-Elliot <[email protected]>

src/odoc/bin/main.ml

@@ -168,7 +168,7 @@ end = struct
 
   let compile hidden directories resolve_fwd_refs dst package_opt
       parent_name_opt open_modules children input warnings_options
-      source_parent_file source_name =
+      source_parent_file source_name source_cmt =
     let open Or_error in
     let resolver =
       Resolver.create ~important_digests:(not resolve_fwd_refs) ~directories
@@ -188,7 +188,7 @@ end = struct
     in
     let source =
       match (source_parent_file, source_name) with
-      | Some parent, Some name -> Ok (Some (parent, name))
+      | Some parent, Some name -> Ok (Some (parent, name, source_cmt))
       | Some _, None | None, Some _ ->
           Error
             (`Cli_error
@@ -245,6 +245,13 @@ end = struct
       & opt (some convert_source_name) None
       & info [ "source-name" ] ~doc ~docv:"NAME")
 
+  let source_cmt =
+    let doc =
+      "The .cmt file to use for source code related operations, such as source \
+       code rendering."
+    in
+    Arg.(value & opt (some file) None & info [ "cmt" ] ~doc ~docv:"CMT")
+
   let cmd =
     let package_opt =
       let doc =
@@ -270,7 +277,7 @@ end = struct
       const handle_error
       $ (const compile $ hidden $ odoc_file_directories $ resolve_fwd_refs $ dst
        $ package_opt $ parent_opt $ open_modules $ children $ input
-       $ warnings_options $ source_parent_file $ source_name))
+       $ warnings_options $ source_parent_file $ source_name $ source_cmt))
 
   let info ~docs =
     let man =

src/odoc/compile.ml

@@ -120,17 +120,19 @@ let resolve_and_substitute ~resolver ~make_root ~source ~hidden
   let filename = Fs.File.to_string input_file in
   (* [impl_shape] is used to lookup locations in the implementation. It is
      useless if no source code is given on command line. *)
-  let should_read_impl_shape = source <> None in
   let unit, cmt_infos =
     match input_type with
     | `Cmti ->
         let unit =
           Odoc_loader.read_cmti ~make_root ~parent ~filename
           |> Error.raise_errors_and_warnings
         and cmt_infos =
-          if should_read_impl_shape then
-            lookup_implementation_of_cmti input_file
-          else None
+          match source with
+          | None -> None
+          | Some (_, None) -> lookup_implementation_of_cmti input_file
+          | Some (_, Some filename) ->
+              Odoc_loader.read_cmt_infos ~filename
+              |> Error.raise_errors_and_warnings
         in
         (unit, cmt_infos)
     | `Cmt ->
@@ -149,7 +151,7 @@ let resolve_and_substitute ~resolver ~make_root ~source ~hidden
   in
   let source_info =
     match source with
-    | Some id ->
+    | Some (id, _) ->
         let infos =
           match cmt_infos with
           | Some (_, local_jmp) ->
@@ -306,7 +308,7 @@ let compile ~resolver ~parent_cli_spec ~hidden ~children ~output
       children
     >>= fun () ->
     (match source with
-    | Some (parent, name) -> (
+    | Some (parent, name, cmt) -> (
         Odoc_file.load parent >>= fun parent ->
         let err_not_parent () =
           Error (`Msg "Specified source-parent is not a parent of the source.")
@@ -318,7 +320,7 @@ let compile ~resolver ~parent_cli_spec ~hidden ~children ~output
                 let name = Paths.Identifier.Mk.source_page (parent_id, name) in
                 if
                   List.exists (Paths.Identifier.equal name) page.source_children
-                then Ok (Some name)
+                then Ok (Some (name, cmt))
                 else err_not_parent ()
             | { iv = `LeafPage _; _ } -> err_not_parent ())
         | Unit_content _ | Odoc_file.Page_content _ ->

src/odoc/compile.mli

@@ -45,7 +45,7 @@ val compile :
   children:string list ->
   output:Fs.File.t ->
   warnings_options:Odoc_model.Error.warnings_options ->
-  source:(Fpath.t * string list) option ->
+  source:(Fpath.t * string list * string option) option ->
   Fs.File.t ->
   (unit, [> msg ]) result
 (** Produces .odoc files out of [.cm{i,t,ti}] or .mld files. *)

test/sources/source.t/b.ml

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

test/sources/source.t/b.mli

@@ -0,0 +1 @@
+val x : int

test/sources/source.t/run.t

@@ -24,7 +24,7 @@ Files containing some values:
 
 Source pages require a parent:
 
-  $ odoc compile -c module-a -c src-source root.mld
+  $ odoc compile -c module-a -c src-source -c src-source2 root.mld
 
 Compile the modules:
 
@@ -153,3 +153,28 @@ Ids generated in the source code:
   id="def-12"
   id="def-14"
   id="def-15"
+
+Another example, with a cmti file:
+
+  $ printf "b.ml\n" > source_tree.map
+  $ odoc source-tree -I . --parent page-root -o src-source2.odoc source_tree.map
+
+  $ ocamlc -bin-annot b.mli
+  $ ocamlc -bin-annot b.ml
+
+When giving a .cmti with the source-name and source-parent option, the cmt file
+is looked up automatically:
+
+  $ odoc compile -I . --source-name b.ml --source-parent-file src-source2.odoc b.cmti
+  $ odoc link -I . b.odoc
+
+The --cmt option can be used to explicitely give the cmt:
+
+  $ mv b.cmt new_b.cmt
+
+  $ odoc compile -I . --source-name b.ml --source-parent-file src-source2.odoc b.cmti
+  File "b.cmti":
+  Warning: No implementation file found for the given interface
+  $ odoc compile -I . --cmt new_b.cmt --source-name b.ml --source-parent-file src-source2.odoc b.cmti
+  $ odoc link -I . b.odoc
+