Separate html-generate and html-generate-asset

panglesd · panglesd · commit 1e9cf372d55e · 2024-08-22T17:27:56.000+02:00
diff --git a/src/odoc/bin/main.ml b/src/odoc/bin/main.ml
@@ -784,6 +784,8 @@ module Make_renderer (R : S) : sig
   val generate : docs:string -> unit Term.t * Term.info
 
   val generate_source : docs:string -> unit Term.t * Term.info
+
+  val generate_asset : docs:string -> unit Term.t * Term.info
 end = struct
   let input_odoc =
     let doc = "Input file." in
@@ -832,10 +834,10 @@ end = struct
 
   module Generate = struct
     let generate extra _hidden output_dir syntax extra_suffix input_file
-        warnings_options sidebar asset_path =
+        warnings_options sidebar =
       let file = Fs.File.of_string input_file in
       Rendering.generate_odoc ~renderer:R.renderer ~warnings_options ~syntax
-        ~output:output_dir ~extra_suffix ~sidebar ~asset_path extra file
+        ~output:output_dir ~extra_suffix ~sidebar extra file
 
     let sidebar =
       let doc = "A .odoc-index file, used eg to generate the sidebar." in
@@ -844,13 +846,6 @@ end = struct
         & opt (some convert_fpath) None
         & info [ "index" ] ~doc ~docv:"FILE.odoc-index")
 
-    let asset_path =
-      let doc = "The path to the asset file, when generating an asset unit." in
-      Arg.(
-        value
-        & opt (some convert_fpath) None
-        & info [ "asset-path" ] ~doc ~docv:"path/to/asset.ext")
-
     let cmd =
       let syntax =
         let doc = "Available options: ml | re" in
@@ -863,8 +858,7 @@ end = struct
       Term.(
         const handle_error
         $ (const generate $ R.extra_args $ hidden $ dst ~create:true () $ syntax
-         $ extra_suffix $ input_odocl $ warnings_options $ sidebar $ asset_path
-          ))
+         $ extra_suffix $ input_odocl $ warnings_options $ sidebar))
 
     let info ~docs =
       let doc =
@@ -919,6 +913,42 @@ end = struct
 
   let generate_source ~docs = Generate_source.(cmd, info ~docs)
 
+  module Generate_asset = struct
+    let generate extra output_dir extra_suffix input_file warnings_options
+        asset_file =
+      Rendering.generate_asset_odoc ~renderer:R.renderer ~warnings_options
+        ~output:output_dir ~extra_suffix ~asset_file extra input_file
+
+    let input_odocl =
+      let doc = "Odoc asset unit." in
+      Arg.(
+        required
+        & opt (some convert_fpath) None
+        & info [ "asset-unit" ] ~doc ~docv:"asset-file.odocl")
+
+    let asset_file =
+      let doc = "The asset file" in
+      Arg.(
+        required
+        & pos 0 (some convert_fpath) None
+        & info ~doc ~docv:"FILE.ext" [])
+
+    let cmd =
+      Term.(
+        const handle_error
+        $ (const generate $ R.extra_args $ dst ~create:true () $ extra_suffix
+         $ input_odocl $ warnings_options $ asset_file))
+
+    let info ~docs =
+      let doc =
+        Format.sprintf "Generate %s files from a $(i,impl-*.odocl)."
+          R.renderer.name
+      in
+      Term.info ~docs ~doc (R.renderer.name ^ "-generate-asset")
+  end
+
+  let generate_asset ~docs = Generate_asset.(cmd, info ~docs)
+
   module Targets = struct
     let list_targets output_dir directories extra odoc_file =
       let odoc_file = Fs.File.of_string odoc_file in
@@ -1548,6 +1578,7 @@ let () =
       Odoc_link.(cmd, info ~docs:section_pipeline);
       Odoc_html.generate ~docs:section_pipeline;
       Odoc_html.generate_source ~docs:section_pipeline;
+      Odoc_html.generate_asset ~docs:section_pipeline;
       Support_files_command.(cmd, info ~docs:section_pipeline);
       Compile_impl.(cmd, info ~docs:section_pipeline);
       Indexing.(cmd, info ~docs:section_pipeline);
diff --git a/src/odoc/rendering.ml b/src/odoc/rendering.ml
@@ -2,67 +2,53 @@ open Odoc_document
 open Or_error
 open Odoc_model
 
-let check_empty_asset_path asset_path filename =
-  if asset_path <> None then
-    Error.raise_warning
-    @@ Error.filename_only
-         "--asset-path only has an effect when generating from an asset"
-         filename
-
-let documents_of_unit ~warnings_options ~syntax ~renderer ~extra ~asset_path
-    ~filename unit =
+let documents_of_unit ~warnings_options ~syntax ~renderer ~extra unit =
   Error.catch_warnings (fun () ->
-      check_empty_asset_path asset_path filename;
       renderer.Renderer.extra_documents extra (CU unit))
   |> Error.handle_warnings ~warnings_options
   >>= fun extra_docs ->
   Ok (Renderer.document_of_compilation_unit ~syntax unit :: extra_docs)
 
-let documents_of_asset ~warnings_options ~asset_path unit =
-  Error.catch_warnings (fun () ->
-      match asset_path with None -> failwith "TODO" | Some a -> a)
-  |> Error.handle_warnings ~warnings_options
-  >>= fun asset_path -> Ok [ Renderer.document_of_asset asset_path unit ]
-
-let documents_of_page ~warnings_options ~syntax ~renderer ~extra ~asset_path
-    ~filename page =
+let documents_of_page ~warnings_options ~syntax ~renderer ~extra page =
   Error.catch_warnings (fun () ->
-      check_empty_asset_path asset_path filename;
       renderer.Renderer.extra_documents extra (Page page))
   |> Error.handle_warnings ~warnings_options
   >>= fun extra_docs -> Ok (Renderer.document_of_page ~syntax page :: extra_docs)
 
-let documents_of_odocl ~warnings_options ~filename ~renderer ~extra ~syntax
-    ~asset_path input =
+let documents_of_odocl ~warnings_options ~renderer ~extra ~syntax input =
   Odoc_file.load input >>= fun unit ->
   match unit.content with
   | Odoc_file.Page_content odoctree ->
-      documents_of_page ~warnings_options ~syntax ~renderer ~extra ~asset_path
-        ~filename odoctree
+      documents_of_page ~warnings_options ~syntax ~renderer ~extra odoctree
+  | Unit_content odoctree ->
+      documents_of_unit ~warnings_options ~syntax ~renderer ~extra odoctree
   | Impl_content _ ->
       Error
         (`Msg
           "Wrong kind of unit: Expected a page or module unit, got an \
            implementation. Use the dedicated command for implementation.")
-  | Unit_content odoctree ->
-      documents_of_unit ~warnings_options ~syntax ~renderer ~extra ~asset_path
-        ~filename odoctree
-  | Asset_content a -> documents_of_asset ~warnings_options ~asset_path a
+  | Asset_content _ ->
+      Error
+        (`Msg
+          "Wrong kind of unit: Expected a page or module unit, got an asset \
+           unit. Use the dedicated command for assets.")
 
 let documents_of_input ~renderer ~extra ~resolver ~warnings_options ~syntax
-    ~asset_path input =
+    input =
   let output = Fs.File.(set_ext ".odocl" input) in
   Odoc_link.from_odoc ~resolver ~warnings_options input output >>= function
   | `Page page -> Ok [ Renderer.document_of_page ~syntax page ]
-  | `Impl _impl ->
+  | `Module m -> documents_of_unit ~warnings_options ~syntax ~renderer ~extra m
+  | `Impl _ ->
       Error
         (`Msg
           "Wrong kind of unit: Expected a page or module unit, got an \
            implementation. Use the dedicated command for implementation.")
-  | `Module m ->
-      documents_of_unit ~warnings_options ~filename:"" ~syntax ~asset_path
-        ~renderer ~extra m
-  | `Asset a -> documents_of_asset ~warnings_options ~asset_path a
+  | `Asset _ ->
+      Error
+        (`Msg
+          "Wrong kind of unit: Expected a page or module unit, got an asset \
+           unit. Use the dedicated command for assets.")
 
 let render_document renderer ~sidebar ~output:root_dir ~extra_suffix ~extra doc
     =
@@ -96,24 +82,21 @@ let render_odoc ~resolver ~warnings_options ~syntax ~renderer ~output extra file
     =
   let extra_suffix = None in
   documents_of_input ~renderer ~extra ~resolver ~warnings_options ~syntax file
-    ~asset_path:None
   >>= fun docs ->
   List.iter
     (render_document renderer ~sidebar:None ~output ~extra_suffix ~extra)
     docs;
   Ok ()
 
 let generate_odoc ~syntax ~warnings_options ~renderer ~output ~extra_suffix
-    ~sidebar ~asset_path extra file =
-  let filename = Fpath.filename file in
+    ~sidebar extra file =
   (match sidebar with
   | None -> Ok None
   | Some x ->
       Odoc_file.load_index x >>= fun (sidebar, _) ->
       Ok (Some (Odoc_document.Sidebar.of_lang sidebar)))
   >>= fun sidebar ->
-  documents_of_odocl ~warnings_options ~filename ~renderer ~extra ~syntax
-    ~asset_path file
+  documents_of_odocl ~warnings_options ~renderer ~extra ~syntax file
   >>= fun docs ->
   List.iter
     (render_document renderer ~output ~sidebar ~extra_suffix ~extra)
@@ -152,16 +135,24 @@ let generate_source_odoc ~syntax ~warnings_options ~renderer ~output
   | Page_content _ | Unit_content _ | Asset_content _ ->
       Error (`Msg "Expected an implementation unit")
 
+let generate_asset_odoc ~warnings_options:_ ~renderer ~output ~asset_file
+    ~extra_suffix extra file =
+  Odoc_file.load file >>= fun unit ->
+  match unit.content with
+  | Odoc_file.Asset_content unit ->
+      let doc = Renderer.document_of_asset asset_file unit in
+      render_document renderer ~output ~sidebar:None ~extra_suffix ~extra doc;
+      Ok ()
+  | Page_content _ | Unit_content _ | Impl_content _ ->
+      Error (`Msg "Expected an asset unit")
+
 let targets_odoc ~resolver ~warnings_options ~syntax ~renderer ~output:root_dir
     ~extra odoctree =
-  let filename = Fpath.filename odoctree in
   let docs =
     if Fpath.get_ext odoctree = ".odoc" then
       documents_of_input ~renderer ~extra ~resolver ~warnings_options ~syntax
-        ~asset_path:None odoctree
-    else
-      documents_of_odocl ~warnings_options ~renderer ~extra ~syntax ~filename
-        ~asset_path:None odoctree
+        odoctree
+    else documents_of_odocl ~warnings_options ~renderer ~extra ~syntax odoctree
   in
   docs >>= fun docs ->
   List.iter
diff --git a/src/odoc/rendering.mli b/src/odoc/rendering.mli
@@ -18,7 +18,6 @@ val generate_odoc :
   output:Fs.directory ->
   extra_suffix:string option ->
   sidebar:Fpath.t option ->
-  asset_path:Fpath.t option ->
   'a ->
   Fpath.t ->
   (unit, [> msg ]) result
@@ -34,6 +33,16 @@ val generate_source_odoc :
   Fpath.t ->
   (unit, [> msg ]) result
 
+val generate_asset_odoc :
+  warnings_options:Odoc_model.Error.warnings_options ->
+  renderer:'a Renderer.t ->
+  output:Fs.directory ->
+  asset_file:Fs.file ->
+  extra_suffix:string option ->
+  'a ->
+  Fs.file ->
+  (unit, [> Or_error.msg ]) result
+
 val targets_odoc :
   resolver:Resolver.t ->
   warnings_options:Odoc_model.Error.warnings_options ->
diff --git a/test/pages/new_assets.t/run.t b/test/pages/new_assets.t/run.t
@@ -13,7 +13,7 @@
 
   $ echo "Hello!" > img.png
 
-  $ odoc html-generate --output-dir _html --asset-path img.png odoc/root/test/asset-img.png.odoc
+  $ odoc html-generate-asset --output-dir _html --asset-unit odoc/root/test/asset-img.png.odoc img.png
 
   $ find _html -name img.png
   _html/root/test/img.png
diff --git a/test/sources/recursive_module.t/run.t b/test/sources/recursive_module.t/run.t
@@ -6,11 +6,7 @@ Checking that source links exists inside recursive modules.
   $ odoc link -I . impl-main.odoc
   $ odoc link -I . main.odoc
   $ odoc html-generate --indent -o html main.odocl
-  $ odoc html-generate-impl --source main.ml --indent -o html impl-main.odocl
-  odoc: unknown command 'html-generate-impl', must be one of 'aggregate-occurrences', 'classify', 'compile', 'compile-asset', 'compile-deps', 'compile-impl', 'compile-index', 'compile-targets', 'count-occurrences', 'css', 'errors', 'html', 'html-deps', 'html-fragment', 'html-generate', 'html-generate-source', 'html-targets', 'html-targets-source', 'html-url', 'latex', 'latex-generate', 'latex-targets', 'latex-url', 'link', 'link-deps', 'man', 'man-generate', 'man-targets', 'support-files' or 'support-files-targets'.
-  Usage: odoc [COMMAND] …
-  Try 'odoc --help' for more information.
-  [2]
+  $ odoc html-generate-source --impl impl-main.odocl --indent -o html main.ml
 
 Both modules should contain source links
 
