diff --git a/CHANGES.md b/CHANGES.md index 588fedb8d8..799c974040 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -24,6 +24,7 @@ - Added a `--occurrences` argument to the `compile-index` command to output the number of occurrences of each entry of the index in the json output (@panglesd, #1076). +- Added a `compile-asset` command (@EmileTrotignon, @panglesd, #1170) ### Changed diff --git a/src/model/lang.ml b/src/model/lang.ml index f39ebb1a92..d4a95573fb 100644 --- a/src/model/lang.ml +++ b/src/model/lang.ml @@ -569,6 +569,11 @@ module rec SourceTree : sig end = SourceTree +module rec Asset : sig + type t = { name : Identifier.AssetFile.t; root : Root.t } +end = + Asset + let umty_of_mty : ModuleType.expr -> ModuleType.U.expr option = function | Signature sg -> Some (Signature sg) | Path { p_path; _ } -> Some (Path p_path) diff --git a/src/model/paths_types.ml b/src/model/paths_types.ml index e5daaf17bb..63b40e84f9 100644 --- a/src/model/paths_types.ml +++ b/src/model/paths_types.ml @@ -52,6 +52,7 @@ module Identifier = struct type odoc_id_pv = [ page_pv | source_page_pv + | asset_file_pv | `Root of container_page option * ModuleName.t | `Implementation of ModuleName.t ] (** @canonical Odoc_model.Paths.Identifier.OdocId.t_pv *) diff --git a/src/model/root.ml b/src/model/root.ml index 3763534cd7..4b0461a108 100644 --- a/src/model/root.ml +++ b/src/model/root.ml @@ -35,6 +35,7 @@ module Odoc_file = struct | Page of page | Compilation_unit of compilation_unit | Impl of string + | Asset of string let create_unit ~force_hidden name = let hidden = force_hidden || Names.contains_double_underscore name in @@ -45,11 +46,15 @@ module Odoc_file = struct let create_impl name = Impl name let name = function - | Page { name; _ } | Compilation_unit { name; _ } | Impl name -> name + | Page { name; _ } | Compilation_unit { name; _ } | Impl name | Asset name + -> + name let hidden = function - | Page _ | Impl _ -> false + | Page _ | Impl _ | Asset _ -> false | Compilation_unit m -> m.hidden + + let asset name = Asset name end type t = { @@ -86,6 +91,10 @@ let to_string t = | `Root (None, name) -> Format.fprintf fmt "%a" Names.ModuleName.fmt name | `Implementation name -> Format.fprintf fmt "impl(%a)" Names.ModuleName.fmt name + | `AssetFile (parent, name) -> + Format.fprintf fmt "%a::%s" pp + (parent :> Paths.Identifier.OdocId.t) + name in Format.asprintf "%a" pp t.id diff --git a/src/model/root.mli b/src/model/root.mli index 75efa5b266..2fe2d4f2c1 100644 --- a/src/model/root.mli +++ b/src/model/root.mli @@ -34,6 +34,7 @@ module Odoc_file : sig | Page of page | Compilation_unit of compilation_unit | Impl of string + | Asset of string val create_unit : force_hidden:bool -> string -> t @@ -41,6 +42,8 @@ module Odoc_file : sig val create_impl : string -> t + val asset : string -> t + val name : t -> string val hidden : t -> bool diff --git a/src/model_desc/lang_desc.ml b/src/model_desc/lang_desc.ml index ff0facc5ec..810a23f8a7 100644 --- a/src/model_desc/lang_desc.ml +++ b/src/model_desc/lang_desc.ml @@ -719,3 +719,11 @@ and source_tree_page_t = F ("digest", (fun t -> t.digest), Digest.t); F ("source_children", (fun t -> t.source_children), List identifier); ] + +and asset_t = + let open Lang.Asset in + Record + [ + F ("name", (fun t -> t.name), identifier); + F ("root", (fun t -> t.root), root); + ] diff --git a/src/odoc/asset.ml b/src/odoc/asset.ml new file mode 100644 index 0000000000..9ae597c022 --- /dev/null +++ b/src/odoc/asset.ml @@ -0,0 +1,23 @@ +let compile ~parent_id ~name ~output_dir = + let open Odoc_model in + let parent_id = Compile.mk_id parent_id in + let id = + Paths.Identifier.Mk.asset_file ((parent_id :> Paths.Identifier.Page.t), name) + in + let directory = + Compile.path_of_id output_dir parent_id + |> Fpath.to_string |> Fs.Directory.of_string + in + let name = "asset-" ^ name ^ ".odoc" in + let output = Fs.File.create ~directory ~name in + let digest = Digest.string name in + let root = + Root. + { + id = (id :> Paths.Identifier.OdocId.t); + digest; + file = Odoc_file.asset name; + } + in + let asset = Lang.Asset.{ name = id; root } in + Odoc_file.save_asset output ~warnings:[] asset diff --git a/src/odoc/asset.mli b/src/odoc/asset.mli new file mode 100644 index 0000000000..157cbbcea8 --- /dev/null +++ b/src/odoc/asset.mli @@ -0,0 +1 @@ +val compile : parent_id:string -> name:string -> output_dir:string -> unit diff --git a/src/odoc/bin/main.ml b/src/odoc/bin/main.ml index 41dddc29f4..66fa30775b 100644 --- a/src/odoc/bin/main.ml +++ b/src/odoc/bin/main.ml @@ -343,6 +343,47 @@ end = struct Term.info "compile" ~docs ~doc ~man end +module Compile_asset = struct + let compile_asset parent_id name output_dir = + Odoc_odoc.Asset.compile ~parent_id ~name ~output_dir + + let output_dir = + let doc = "Output file directory. " in + Arg.( + required + & opt (some string) None + & info ~docs ~docv:"PATH" ~doc [ "output-dir" ]) + + let cmd = + let asset_name = + let doc = "Name of the asset." in + Arg.( + required + & opt (some string) None + & info ~docs ~docv:"NAME" ~doc [ "name" ]) + in + let parent_id = + let doc = "Parent id." in + Arg.( + required + & opt (some string) None + & info ~docs ~docv:"PARENT" ~doc [ "parent-id" ]) + in + Term.(const compile_asset $ parent_id $ asset_name $ output_dir) + + let info ~docs = + let man = + [ + `S "DEPENDENCIES"; + `P + "There are no dependency for compile assets, in particular you do \ + not need the asset itself at this stage."; + ] + in + let doc = "Declare the name of an asset." in + Term.info "compile-asset" ~docs ~doc ~man +end + module Source_tree = struct let prefix = "srctree-" @@ -1555,6 +1596,7 @@ let () = Occurrences.Count.(cmd, info ~docs:section_pipeline); Occurrences.Aggregate.(cmd, info ~docs:section_pipeline); Compile.(cmd, info ~docs:section_pipeline); + Compile_asset.(cmd, info ~docs:section_pipeline); Odoc_link.(cmd, info ~docs:section_pipeline); Odoc_html.generate ~docs:section_pipeline; Support_files_command.(cmd, info ~docs:section_pipeline); diff --git a/src/odoc/compile.mli b/src/odoc/compile.mli index 04f82b3f2c..dfa17159b0 100644 --- a/src/odoc/compile.mli +++ b/src/odoc/compile.mli @@ -50,6 +50,7 @@ val resolve_parent_page : and its children as a list of reference. *) val mk_id : string -> Identifier.ContainerPage.t +val path_of_id : string -> Comment.Identifier.Id.container_page -> Fpath.t val compile : resolver:Resolver.t -> diff --git a/src/odoc/depends.ml b/src/odoc/depends.ml index 33c0a3c4e3..d6d610d129 100644 --- a/src/odoc/depends.ml +++ b/src/odoc/depends.ml @@ -88,7 +88,7 @@ let deps_of_imports ~deps imports = let deps_of_odoc_file ~deps input = Odoc_file.load input >>= fun unit -> match unit.content with - | Page_content _ | Source_tree_content _ -> + | Page_content _ | Source_tree_content _ | Asset_content _ -> Ok () (* XXX something should certainly be done here *) | Impl_content impl -> deps_of_imports ~deps impl.Odoc_model.Lang.Implementation.imports diff --git a/src/odoc/odoc_file.ml b/src/odoc/odoc_file.ml index eb8a4c38ba..8b9a9cb01d 100644 --- a/src/odoc/odoc_file.ml +++ b/src/odoc/odoc_file.ml @@ -24,6 +24,7 @@ type content = | Source_tree_content of Lang.SourceTree.t | Impl_content of Lang.Implementation.t | Unit_content of unit_content + | Asset_content of Lang.Asset.t type t = { content : content; warnings : Odoc_model.Error.t list } @@ -72,6 +73,16 @@ let save_impl file ~warnings impl = save_unit file impl.Lang.Implementation.root { content = Impl_content impl; warnings } +let save_asset file ~warnings asset = + let dir = Fs.File.dirname file in + let base = Fs.File.(to_string @@ basename file) in + let file = + if Astring.String.is_prefix ~affix:"asset-" base then file + else Fs.File.create ~directory:dir ~name:("asset-" ^ base) + in + let t = { content = Asset_content asset; warnings } in + save_unit file asset.root t + let save_unit file ~warnings m = save_unit file m.Lang.Compilation_unit.root { content = Unit_content m; warnings } diff --git a/src/odoc/odoc_file.mli b/src/odoc/odoc_file.mli index 8f3b58d9f0..1bd8ed56c0 100644 --- a/src/odoc/odoc_file.mli +++ b/src/odoc/odoc_file.mli @@ -27,6 +27,7 @@ type content = | Source_tree_content of Lang.SourceTree.t | Impl_content of Lang.Implementation.t | Unit_content of unit_content + | Asset_content of Lang.Asset.t type t = { content : content; warnings : Error.t list } @@ -62,3 +63,5 @@ val save_index : val load_index : Fs.File.t -> (Odoc_search.Entry.t Odoc_model.Lang.Index.t, [> msg ]) result (** Load a [.odoc-index] file. *) + +val save_asset : Fpath.t -> warnings:Error.t list -> Lang.Asset.t -> unit diff --git a/src/odoc/odoc_link.ml b/src/odoc/odoc_link.ml index 936cad9870..f9be0ec4b9 100644 --- a/src/odoc/odoc_link.ml +++ b/src/odoc/odoc_link.ml @@ -100,3 +100,6 @@ let from_odoc ~resolver ~warnings_options input output = >>= fun (m, warnings) -> Odoc_file.save_unit output ~warnings m; Ok (`Module m) + | Asset_content a -> + Odoc_file.save_asset output ~warnings:[] a; + Ok (`Asset a) diff --git a/src/odoc/rendering.ml b/src/odoc/rendering.ml index 41ff6e705d..d4497a5657 100644 --- a/src/odoc/rendering.ml +++ b/src/odoc/rendering.ml @@ -98,6 +98,7 @@ let documents_of_odocl ~warnings_options ~renderer ~extra ~source ~syntax input | Unit_content odoctree -> documents_of_unit ~warnings_options ~source ~syntax ~renderer ~extra ~filename odoctree + | Asset_content _ -> Ok [] (* TODO *) let documents_of_input ~renderer ~extra ~resolver ~warnings_options ~syntax input = @@ -109,6 +110,7 @@ let documents_of_input ~renderer ~extra ~resolver ~warnings_options ~syntax | `Module m -> documents_of_unit ~warnings_options ~source:None ~filename:"" ~syntax ~renderer ~extra m + | `Asset _ -> Ok [] (* TODO *) let render_document renderer ~sidebar ~output:root_dir ~extra_suffix ~extra doc = diff --git a/src/odoc/resolver.ml b/src/odoc/resolver.ml index 113e5905bf..8610476293 100644 --- a/src/odoc/resolver.ml +++ b/src/odoc/resolver.ml @@ -242,7 +242,8 @@ let unit_name ( Odoc_file.Unit_content { root; _ } | Page_content { root; _ } | Impl_content { root; _ } - | Source_tree_content { root; _ } ) = + | Source_tree_content { root; _ } + | Asset_content { root; _ } ) = root_name root let load_unit_from_file path = Odoc_file.load path >>= fun u -> Ok u.content @@ -300,7 +301,9 @@ let lookup_unit_by_name ap target_name = let first_unit u = match u with | Odoc_file.Unit_content m -> Some m - | Impl_content _ | Page_content _ | Source_tree_content _ -> None + | Impl_content _ | Page_content _ | Source_tree_content _ | Asset_content _ + -> + None in let rec find_ambiguous tl = match find_map first_unit tl with @@ -356,7 +359,9 @@ let lookup_page_by_name ap target_name = let is_page u = match u with | Odoc_file.Page_content p -> Some p - | Impl_content _ | Unit_content _ | Source_tree_content _ -> None + | Impl_content _ | Unit_content _ | Source_tree_content _ | Asset_content _ + -> + None in let units = load_units_from_name ap target_name in match find_map is_page units with @@ -369,7 +374,9 @@ let lookup_impl ap target_name = let is_impl u = match u with | Odoc_file.Impl_content p -> Some p - | Page_content _ | Unit_content _ | Source_tree_content _ -> None + | Page_content _ | Unit_content _ | Source_tree_content _ | Asset_content _ + -> + None in let units = load_units_from_name ap target_name in match find_map is_impl units with Some (p, _) -> Some p | None -> None @@ -382,7 +389,8 @@ let add_unit_to_cache u = | Odoc_file.Page_content _ -> "page-" | Impl_content _ -> "impl-" | Unit_content _ -> "" - | Source_tree_content _ -> "page-") + | Source_tree_content _ -> "page-" + | Asset_content _ -> "asset-") ^ unit_name u in Hashtbl.add unit_cache target_name [ u ] @@ -629,6 +637,6 @@ let resolve_import t target_name = | Ok root -> ( match root.Odoc_model.Root.file with | Compilation_unit _ -> Some root - | Impl _ | Page _ -> loop tl)) + | Impl _ | Page _ | Asset _ -> loop tl)) in loop (Accessible_paths.find t.ap target_name) diff --git a/test/odoc_print/odoc_print.ml b/test/odoc_print/odoc_print.ml index e935f7f357..45c2f4339e 100644 --- a/test/odoc_print/odoc_print.ml +++ b/test/odoc_print/odoc_print.ml @@ -252,6 +252,9 @@ let run inp short long_paths show_canonical show_expansions | false, None, _ -> print_json_desc Lang_desc.compilation_unit_t u; Ok ()) + | Asset_content a -> + print_json_desc Lang_desc.asset_t a; + Ok () open Compatcmdliner diff --git a/test/pages/new_assets.t/run.t b/test/pages/new_assets.t/run.t new file mode 100644 index 0000000000..6341bb6e03 --- /dev/null +++ b/test/pages/new_assets.t/run.t @@ -0,0 +1,12 @@ + $ odoc compile-asset --name img.png --parent-id root/test --output-dir odoc + + $ odoc_print odoc/root/test/asset-img.png.odoc + { + "name": { + "`AssetFile": [ + { "`Page": [ { "Some": { "`Page": [ "None", "root" ] } }, "test" ] }, + "img.png" + ] + }, + "root": "" + }