From 86768475b26c5f2e0674d374b383c95dfcc1d4ab Mon Sep 17 00:00:00 2001
From: Rudi Grinberg <rudi.grinberg@gmail.com>
Date: Fri, 16 Mar 2018 13:24:28 +0800
Subject: [PATCH] Install rules for mlds

---
 src/gen_rules.ml      | 45 ++++++++++++++++++++++++++++++++++++++++++-
 src/install_rules.ml  |  8 ++++++++
 src/install_rules.mli |  1 +
 src/super_context.ml  |  1 +
 4 files changed, 54 insertions(+), 1 deletion(-)

diff --git a/src/gen_rules.ml b/src/gen_rules.ml
index acca6087..72564e66 100644
--- a/src/gen_rules.ml
+++ b/src/gen_rules.ml
@@ -150,6 +150,25 @@ module Gen(P : Install_rules.Params) = struct
       modules
     end
 
+  let parse_mlds ~dir ~(all_mlds : string String_map.t) ~mlds_written_by_user =
+    if Ordered_set_lang.is_standard mlds_written_by_user then
+      all_mlds
+    else
+      let mlds =
+        Ordered_set_lang.String.eval_unordered
+          mlds_written_by_user
+          ~parse:(fun ~loc s ->
+            match String_map.find all_mlds s with
+            | Some s ->
+              s
+            | None ->
+              Loc.fail loc "%s.mld doesn't exist in %s" s
+                (Path.to_string_maybe_quoted
+                   (Path.drop_optional_build_context dir))
+          )
+          ~standard:all_mlds in
+      mlds
+
   (* +-----------------------------------------------------------------+
      | User rules & copy files                                         |
      +-----------------------------------------------------------------+ *)
@@ -292,6 +311,28 @@ module Gen(P : Install_rules.Params) = struct
         }
     )
 
+  let guess_mlds ~files =
+    String_set.to_list files
+    |> List.filter_map ~f:(fun fn ->
+      match String.lsplit2 fn ~on:'.' with
+      | Some (s, "mld") -> Some (s, fn)
+      | _ -> None)
+    |> String_map.of_list_exn
+
+  let mlds_by_dir =
+    let cache = Hashtbl.create 32 in
+    fun ~dir ->
+      Hashtbl.find_or_add cache dir ~f:(fun dir ->
+        let files = text_files ~dir in
+        guess_mlds ~files)
+
+  let mlds_of_dir (doc : Documentation.t) ~dir =
+    parse_mlds ~dir
+      ~all_mlds:(mlds_by_dir ~dir)
+      ~mlds_written_by_user:doc.mld_files
+    |> String_map.values
+    |> List.map ~f:(Path.relative dir)
+
   let modules_by_dir =
     let cache = Hashtbl.create 32 in
     fun ~dir ->
@@ -963,6 +1004,7 @@ module Gen(P : Install_rules.Params) = struct
       Install_rules.Gen(struct
         include P
         let module_names_of_lib = module_names_of_lib
+        let mlds_of_dir = mlds_of_dir
       end) in
     Install_rules.init ()
 end
@@ -1010,7 +1052,8 @@ let gen ~contexts ~build_system
              match (stanza : Stanza.t) with
              | Library { public = Some { package; _ }; _ }
              | Alias { package = Some package ;  _ }
-             | Install { package; _ } ->
+             | Install { package; _ }
+             | Documentation { package; _ } ->
                Package.Name.Set.mem pkgs package.name
              | _ -> true)))
     in
diff --git a/src/install_rules.ml b/src/install_rules.ml
index 61ad8b75..67a5f5b2 100644
--- a/src/install_rules.ml
+++ b/src/install_rules.ml
@@ -10,6 +10,7 @@ end
 module type Install_params = sig
   include Params
   val module_names_of_lib : Library.t -> dir:Path.t -> Module.t list
+  val mlds_of_dir : Documentation.t -> dir:Path.t -> Path.t list
 end
 
 module Archives(P : Params) = struct
@@ -269,6 +270,13 @@ module Gen(P : Install_params) = struct
             List.map files ~f:(fun { Install_conf. src; dst } ->
               (package.name,
                Install.Entry.make section (Path.relative dir src) ?dst))
+          | Documentation ({ package; _ } as d) ->
+            List.map ~f:(fun mld ->
+              (package.name,
+               (Install.Entry.make
+                  ~dst:(sprintf "odoc-pages/%s" (Path.basename mld))
+                  Install.Section.Doc mld))
+            ) (mlds_of_dir d ~dir)
           | _ -> [])
       |> Package.Name.Map.of_list_multi
     in
diff --git a/src/install_rules.mli b/src/install_rules.mli
index ceff660e..1b6fcb5d 100644
--- a/src/install_rules.mli
+++ b/src/install_rules.mli
@@ -11,6 +11,7 @@ end
 module type Install_params = sig
   include Params
   val module_names_of_lib : Jbuild.Library.t -> dir:Path.t -> Module.t list
+  val mlds_of_dir : Jbuild.Documentation.t -> dir:Path.t -> Path.t list
 end
 
 (** Generate install rules for META and .install files *)
diff --git a/src/super_context.ml b/src/super_context.ml
index b10c6b1e..214c423a 100644
--- a/src/super_context.ml
+++ b/src/super_context.ml
@@ -114,6 +114,7 @@ let create
           let keep =
             match (stanza : Stanza.t) with
             | Library lib -> Lib.DB.available (Scope.libs scope) lib.name
+            | Documentation _
             | Install _   -> true
             | _           -> false
           in