Skip to content

Commit

Permalink
Add ability to call generate commands on asset units
Browse files Browse the repository at this point in the history
  • Loading branch information
panglesd committed Aug 1, 2024
1 parent 468ab02 commit fc52c23
Show file tree
Hide file tree
Showing 5 changed files with 66 additions and 18 deletions.
4 changes: 4 additions & 0 deletions src/document/renderer.ml
Original file line number Diff line number Diff line change
Expand Up @@ -42,3 +42,7 @@ let document_of_compilation_unit ~syntax v =
match syntax with
| Reason -> Reason.compilation_unit v
| OCaml -> ML.compilation_unit v

let document_of_asset path (v : Odoc_model.Lang.Asset.t) =
let url = Url.Path.from_identifier v.name in
Types.Document.Asset { url; src = path }
13 changes: 10 additions & 3 deletions src/odoc/bin/main.ml
Original file line number Diff line number Diff line change
Expand Up @@ -935,11 +935,11 @@ end = struct
exit 1

let generate extra _hidden output_dir syntax extra_suffix input_file
warnings_options source_file source_root sidebar =
warnings_options source_file source_root sidebar asset_path =
let source = source_of_args source_root source_file in
let file = Fs.File.of_string input_file in
Rendering.generate_odoc ~renderer:R.renderer ~warnings_options ~syntax
~output:output_dir ~extra_suffix ~source ~sidebar extra file
~output:output_dir ~extra_suffix ~source ~sidebar ~asset_path extra file

let source_file =
let doc =
Expand Down Expand Up @@ -969,6 +969,13 @@ 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
Expand All @@ -982,7 +989,7 @@ end = struct
const handle_error
$ (const generate $ R.extra_args $ hidden $ dst ~create:true () $ syntax
$ extra_suffix $ input_odocl $ warnings_options $ source_file
$ source_root $ sidebar))
$ source_root $ sidebar $ asset_path))

let info ~docs =
let doc =
Expand Down
56 changes: 41 additions & 15 deletions src/odoc/rendering.ml
Original file line number Diff line number Diff line change
Expand Up @@ -22,24 +22,44 @@ let check_empty_source_arg source filename =
an implementation"
filename

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 ~source ~renderer ~extra
~filename unit =
~asset_path ~filename unit =
Error.catch_warnings (fun () ->
check_empty_source_arg source filename;
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 ~source ~filename ~asset_path unit =
Error.catch_warnings (fun () ->
check_empty_source_arg source filename;
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 ~source ~renderer ~extra
~filename page =
~asset_path ~filename page =
Error.catch_warnings (fun () ->
check_empty_source_arg source filename;
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_implementation ~warnings_options:_ ~syntax impl source =
let documents_of_implementation ~warnings_options ~syntax ~filename ~asset_path
impl source =
Error.catch_warnings (fun () -> check_empty_asset_path asset_path filename)
|> Error.handle_warnings ~warnings_options
>>= fun () ->
match (source, impl.Lang.Implementation.id) with
| Some source, Some source_id -> (
let source_file =
Expand Down Expand Up @@ -82,35 +102,39 @@ let documents_of_source_tree ~warnings_options ~syntax ~source ~filename srctree
|> Error.handle_warnings ~warnings_options
>>= fun () -> Ok (Renderer.documents_of_source_tree ~syntax srctree)

let documents_of_odocl ~warnings_options ~renderer ~extra ~source ~syntax input
=
let documents_of_odocl ~warnings_options ~renderer ~extra ~source ~syntax
~asset_path input =
Odoc_file.load input >>= fun unit ->
let filename = Fpath.to_string input in
match unit.content with
| Odoc_file.Page_content odoctree ->
documents_of_page ~warnings_options ~syntax ~source ~renderer ~extra
~filename odoctree
~asset_path ~filename odoctree
| Source_tree_content srctree ->
documents_of_source_tree ~warnings_options ~syntax ~source ~filename
srctree
| Impl_content impl ->
documents_of_implementation ~warnings_options ~syntax impl source
~asset_path ~filename
| Unit_content odoctree ->
documents_of_unit ~warnings_options ~source ~syntax ~renderer ~extra
~filename odoctree
| Asset_content _ -> Ok [] (* TODO *)
~asset_path ~filename odoctree
| Asset_content a ->
documents_of_asset ~warnings_options ~source ~filename ~asset_path a

let documents_of_input ~renderer ~extra ~resolver ~warnings_options ~syntax
input =
~asset_path input =
let output = Fs.File.(set_ext ".odocl" input) in
Odoc_link.from_odoc ~resolver ~warnings_options input output >>= function
| `Source_tree st -> Ok (Renderer.documents_of_source_tree ~syntax st)
| `Page page -> Ok [ Renderer.document_of_page ~syntax page ]
| `Impl impl -> Ok (Renderer.documents_of_implementation ~syntax impl [] "")
| `Module m ->
documents_of_unit ~warnings_options ~source:None ~filename:"" ~syntax
~renderer ~extra m
| `Asset _ -> Ok [] (* TODO *)
~asset_path ~renderer ~extra m
| `Asset a ->
documents_of_asset ~warnings_options ~source:None ~filename:"" ~asset_path
a

let render_document renderer ~sidebar ~output:root_dir ~extra_suffix ~extra doc
=
Expand Down Expand Up @@ -144,21 +168,23 @@ 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
~source ~sidebar extra file =
~source ~sidebar ~asset_path 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 ~renderer ~source ~extra ~syntax file
documents_of_odocl ~warnings_options ~renderer ~source ~extra ~syntax
~asset_path file
>>= fun docs ->
List.iter
(render_document renderer ~output ~sidebar ~extra_suffix ~extra)
Expand All @@ -170,10 +196,10 @@ let targets_odoc ~resolver ~warnings_options ~syntax ~renderer ~output:root_dir
let docs =
if Fpath.get_ext odoctree = ".odoc" then
documents_of_input ~renderer ~extra ~resolver ~warnings_options ~syntax
odoctree
~asset_path:None odoctree
else
documents_of_odocl ~warnings_options ~renderer ~extra ~syntax ~source
odoctree
~asset_path:None odoctree
in
docs >>= fun docs ->
List.iter
Expand Down
1 change: 1 addition & 0 deletions src/odoc/rendering.mli
Original file line number Diff line number Diff line change
Expand Up @@ -29,6 +29,7 @@ val generate_odoc :
extra_suffix:string option ->
source:source option ->
sidebar:Fpath.t option ->
asset_path:Fpath.t option ->
'a ->
Fpath.t ->
(unit, [> msg ]) result
Expand Down
10 changes: 10 additions & 0 deletions test/pages/new_assets.t/run.t
Original file line number Diff line number Diff line change
Expand Up @@ -10,3 +10,13 @@
},
"root": "<root>"
}

$ echo "Hello!" > img.png

$ odoc html-generate --output-dir _html --asset-path img.png odoc/root/test/asset-img.png.odoc

$ find _html -name img.png
_html/root/test/img.png

$ cat $(find _html -name img.png)
Hello!

0 comments on commit fc52c23

Please sign in to comment.