diff options
Diffstat (limited to 'src/generate.ml')
| -rw-r--r-- | src/generate.ml | 50 |
1 files changed, 48 insertions, 2 deletions
diff --git a/src/generate.ml b/src/generate.ml index e7801c5..28f0be1 100644 --- a/src/generate.ml +++ b/src/generate.ml @@ -2,6 +2,8 @@ exception Load_error of string exception Write_error of string +module I = Internal.Make(Reference_tree) + let load_interface_definitions dir = let open Reference_tree in let dir_paths = FileUtil.ls dir in @@ -20,7 +22,7 @@ let load_interface_definitions dir = | Error msg -> Error msg end with Bad_interface_definition msg -> Error msg -let reference_tree_to_json from_dir to_file = +let interface_definitions_to_cache from_dir cache_path = let ref_tree_result = load_interface_definitions from_dir in @@ -29,11 +31,55 @@ let reference_tree_to_json from_dir to_file = | 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 to_file + 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 + in + let ref_tree = + match ref_tree_result with + | Ok ref -> ref + | Error msg -> raise (Load_error msg) + in + let out = Reference_tree.render_json ref_tree in + let oc = + try + open_out to_file + with Sys_error msg -> raise (Write_error msg) + in + Printf.fprintf oc "%s" out; + close_out oc; + match internal_cache with + | "" -> () + | _ -> I.write_internal ref_tree internal_cache |