Driver: Process markdown files installed in opam doc dir

Author: jonludlam

src/driver/compile.ml

@@ -38,7 +38,7 @@ let init_stats (units : Odoc_unit.t list) =
           | `Intf { hidden = false; _ } -> non_hidden + 1
           | _ -> non_hidden
         in
-        let mlds = match unit.kind with `Mld -> mlds + 1 | _ -> mlds in
+        let mlds = match unit.kind with `Mld | `Md -> mlds + 1 | _ -> mlds in
         (total, total_impl, non_hidden, mlds, assets, indexes))
       (0, 0, 0, 0, 0, Fpath.Set.empty)
       units
@@ -182,6 +182,11 @@ let compile ?partial ~partial_dir (all : Odoc_unit.t list) =
           ~includes ~parent_id:unit.parent_id;
         Atomic.incr Stats.stats.compiled_mlds;
         Ok [ unit ]
+    | `Md ->
+        Odoc.compile_md ~output_dir:unit.output_dir ~input_file:unit.input_file
+          ~parent_id:unit.parent_id;
+        Atomic.incr Stats.stats.compiled_mlds;
+        Ok [ unit ]
   in
   let res = Fiber.List.map compile all in
   (* For voodoo mode, we need to keep which modules successfully compiled *)
@@ -231,7 +236,8 @@ let link : compiled list -> _ =
         | `Intf _ -> Atomic.incr Stats.stats.linked_units
         | `Mld -> Atomic.incr Stats.stats.linked_mlds
         | `Asset -> ()
-        | `Impl _ -> Atomic.incr Stats.stats.linked_impls);
+        | `Impl _ -> Atomic.incr Stats.stats.linked_impls
+        | `Md -> Atomic.incr Stats.stats.linked_mlds);
         c
   in
   Fiber.List.map link compiled

src/driver/odoc.ml

@@ -22,6 +22,8 @@ type compile_deps = { digest : Digest.t; deps : (string * Digest.t) list }
 
 let odoc = ref (Cmd.v "odoc")
 
+let odoc_md = ref (Cmd.v "odoc-md")
+
 let compile_deps f =
   let cmd = Cmd.(!odoc % "compile-deps" % Fpath.to_string f) in
   let desc = Printf.sprintf "Compile deps for %s" (Fpath.to_string f) in
@@ -54,6 +56,22 @@ let compile ~output_dir ~input_file:file ~includes ~parent_id =
        (Some (`Compile, Fpath.to_string file))
        desc cmd output_file
 
+let compile_md ~output_dir ~input_file:file ~parent_id =
+  let open Cmd in
+  let output_file =
+    let _, f = Fpath.split_base file in
+    Some Fpath.(output_dir // Id.to_fpath parent_id // set_ext "odoc" f)
+  in
+  let cmd =
+    !odoc_md % Fpath.to_string file % "--output-dir" % p output_dir
+  in
+  let cmd = cmd % "--parent-id" % Id.to_string parent_id in
+  let desc = Printf.sprintf "Compiling Markdown %s" (Fpath.to_string file) in
+  let lines = Cmd_outputs.submit desc cmd output_file in
+  Cmd_outputs.(
+    add_prefixed_output cmd compile_output (Fpath.to_string file) lines)
+
+        
 let compile_asset ~output_dir ~name ~parent_id =
   let open Cmd in
   let output_file =

src/driver/odoc.mli

@@ -25,6 +25,7 @@ val compile :
   includes:Fpath.set ->
   parent_id:Id.t ->
   unit
+val compile_md : output_dir:Fpath.t -> input_file:Fpath.t -> parent_id:Id.t -> unit
 
 val compile_asset : output_dir:Fpath.t -> name:string -> parent_id:Id.t -> unit
 

src/driver/odoc_unit.ml

@@ -70,10 +70,10 @@ type impl_extra = { src_id : Odoc.Id.t; src_path : Fpath.t }
 type impl = [ `Impl of impl_extra ]
 
 type mld = [ `Mld ]
-
+type md = [ `Md ]
 type asset = [ `Asset ]
 
-type all_kinds = [ impl | intf | mld | asset ]
+type all_kinds = [ impl | intf | mld | asset | md ]
 type t = all_kinds unit
 
 let rec pp_kind : all_kinds Fmt.t =
@@ -82,6 +82,7 @@ let rec pp_kind : all_kinds Fmt.t =
   | `Intf x -> Format.fprintf fmt "`Intf %a" pp_intf_extra x
   | `Impl x -> Format.fprintf fmt "`Impl %a" pp_impl_extra x
   | `Mld -> Format.fprintf fmt "`Mld"
+  | `Md -> Format.fprintf fmt "`Md"
   | `Asset -> Format.fprintf fmt "`Asset"
 
 and pp_intf_extra fmt x =

src/driver/odoc_unit.mli

@@ -44,10 +44,10 @@ type impl_extra = { src_id : Odoc.Id.t; src_path : Fpath.t }
 type impl = [ `Impl of impl_extra ]
 
 type mld = [ `Mld ]
-
+type md = [`Md]
 type asset = [ `Asset ]
 
-type t = [ impl | intf | mld | asset ] unit
+type t = [ impl | intf | mld | asset | md ] unit
 
 val pp : t Fmt.t
 

src/driver/odoc_units_of.ml

@@ -214,6 +214,20 @@ let packages ~dirs ~extra_libs_paths (pkgs : Packages.t list) : t list =
     in
     [ unit ]
   in
+  let of_md pkg (md :Fpath.t) : md unit list =
+    let ext = Fpath.get_ext md in
+    match ext with
+    | ".md" ->
+      let rel_dir = doc_dir pkg in
+      let kind = `Md in
+      let name = md |> Fpath.rem_ext |> Fpath.basename |> ( ^ ) "page-" in
+      let lib_deps = Util.StringSet.empty in
+      let unit = make_unit ~name ~kind ~rel_dir ~input_file:md ~pkg ~include_dirs:Fpath.Set.empty ~lib_deps in
+      [ unit ]
+    | _ ->
+      Logs.debug (fun m -> m "Skipping non-markdown doc file %a" Fpath.pp md);
+      []
+  in
   let of_asset pkg (asset : Packages.asset) : asset unit list =
     let open Fpath in
     let { Packages.asset_path; asset_rel_path } = asset in
@@ -234,6 +248,7 @@ let packages ~dirs ~extra_libs_paths (pkgs : Packages.t list) : t list =
     let lib_units :> t list list = List.map (of_lib pkg) pkg.libraries in
     let mld_units :> t list list = List.map (of_mld pkg) pkg.mlds in
     let asset_units :> t list list = List.map (of_asset pkg) pkg.assets in
+    let md_units :> t list list = Fpath.Set.fold (fun md acc -> of_md pkg md :: acc) pkg.other_docs [] in
     let pkg_index :> t list =
       let has_index_page =
         List.exists
@@ -248,7 +263,7 @@ let packages ~dirs ~extra_libs_paths (pkgs : Packages.t list) : t list =
         let index = index_of pkg in
         [ Landing_pages.package ~dirs ~pkg ~index ]
     in
-    List.concat ((pkg_index :: lib_units) @ mld_units @ asset_units)
+    List.concat ((pkg_index :: lib_units) @ mld_units @ asset_units @ md_units)
   in
 
   let pkg_list :> t = Landing_pages.package_list ~dirs pkgs in