diff options
| -rw-r--r-- | src/generate.ml | 41 | ||||
| -rw-r--r-- | src/generate.mli | 3 |
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 |