Asset cli

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
 

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)

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 *)

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

src/model/root.mli

@@ -34,13 +34,16 @@ 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
 
   val create_page : string -> Comment.link_content option -> t
 
   val create_impl : string -> t
 
+  val asset : string -> t
+
   val name : t -> string
 
   val hidden : t -> bool

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);
+    ]

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

src/odoc/asset.mli

@@ -0,0 +1 @@
+val compile : parent_id:string -> name:string -> output_dir:string -> unit

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);

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 ->

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

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 }

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

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)

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
     =

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)

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
 

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": "<root>"
+  }