T7046: add merge_reference_tree_cache and cache i/o

To support addon packages with separate interface-definitions dirs,
refactor reference_tree_to_json.

2 files changed, 44 insertions, 0 deletions

diff --git a/src/generate.ml b/src/generate.ml
index 632c678..28f0be1 100644
--- a/src/generate.ml
+++ b/src/generate.ml
@@ -22,6 +22,47 @@ let load_interface_definitions dir =
         | Error msg -> Error msg end
     with Bad_interface_definition msg -> Error msg
 
+let interface_definitions_to_cache from_dir cache_path =
+    let ref_tree_result =
+        load_interface_definitions from_dir
+    in
+    let ref_tree =
+    match ref_tree_result with
+        | Ok ref -> ref
+        | Error msg -> raise (Load_error msg)
+    in
+    I.write_internal ref_tree cache_path
+
+let reference_tree_cache_to_json cache_path render_file =
+    let ref_tree =
+        I.read_internal cache_path
+    in
+    let out = Reference_tree.render_json ref_tree in
+    let oc =
+        try
+            open_out render_file
+        with Sys_error msg -> raise (Write_error msg)
+    in
+    Printf.fprintf oc "%s" out;
+    close_out oc
+
+let merge_reference_tree_cache cache_dir primary_name result_name =
+    let file_arr = Sys.readdir cache_dir in
+    let file_list' = Array.to_list file_arr in
+    let file_list =
+        List.filter (fun x -> x <> primary_name && x <> result_name) file_list' in
+    let file_path_list =
+        List.map (FilePath.concat cache_dir) file_list in
+    let primary_tree = I.read_internal (FilePath.concat cache_dir primary_name) in
+    let ref_trees = List.map I.read_internal file_path_list in
+    match ref_trees with
+    | [] ->
+        I.write_internal primary_tree (FilePath.concat cache_dir result_name)
+    | _ ->
+        let f _ v = v in
+        let res = List.fold_left (fun p r -> Tree_alg.RefAlg.tree_union r p f) primary_tree ref_trees in
+        I.write_internal res (FilePath.concat cache_dir result_name)
+
 let reference_tree_to_json ?(internal_cache="") from_dir to_file =
     let ref_tree_result =
         load_interface_definitions from_dir
diff --git a/src/generate.mli b/src/generate.mli
index 6f8e775..4243ef0 100644
--- a/src/generate.mli
+++ b/src/generate.mli
@@ -3,3 +3,6 @@ exception Write_error of string
 
 val load_interface_definitions : string -> (Reference_tree.t, string) result
 val reference_tree_to_json : ?internal_cache:string -> string -> string -> unit
+val interface_definitions_to_cache : string -> string -> unit
+val reference_tree_cache_to_json : string -> string -> unit
+val merge_reference_tree_cache : string -> string -> string -> unit