exception Cyclic_definition of string
exception Type_error of string (* expected type, value, msg *)
exception Parse_error of string * int * int * string (* file, line, col, msg *)
exception Cyclic_definition of string
exception Type_error of string (* expected type, value, msg *)
exception Parse_error of string * int * int * string (* file, line, col, msg *)
(* root XML tag: used by save_to, ignored by load_from *)
let root_tag = "helm_registry"
(* root XML tag: used by save_to, ignored by load_from *)
let root_tag = "helm_registry"
-let set' registry ~key ~value =
- debug_print (sprintf "Setting %s = %s" key value);
+let set' ?(replace=false) registry ~key ~value =
+ debug_print (lazy(sprintf "Setting (replace: %b) %s = %s" replace key value));
let get_list registry unmarshaller key =
try
List.map unmarshaller (get registry key)
with Key_not_found _ -> []
let get_list registry unmarshaller key =
try
List.map unmarshaller (get registry key)
with Key_not_found _ -> []
+let get_pair registry fst_unmarshaller snd_unmarshaller key =
+ let v = singleton (get registry key) in
+ match Str.split spaces_rex v with
+ | [fst; snd] -> fst_unmarshaller fst, snd_unmarshaller snd
+ | _ -> raise (Type_error "not a pair")
+
-let load_from_absolute registry fname =
- let path = ref [] in (* <section> elements entered so far *)
+let rec load_from_absolute ?path registry fname =
+ let _path = ref (match path with None -> [] | Some p -> p)in
+ (* <section> elements entered so far *)
let in_key = ref false in (* have we entered a <key> element? *)
let cdata = ref "" in (* collected cdata (inside <key> *)
let in_key = ref false in (* have we entered a <key> element? *)
let cdata = ref "" in (* collected cdata (inside <key> *)
let start_element tag attrs =
match tag, attrs with
| "section", ["name", name] -> push_path name
| "key", ["name", name] -> in_key := true; push_path name
| "helm_registry", _ -> ()
let start_element tag attrs =
match tag, attrs with
| "section", ["name", name] -> push_path name
| "key", ["name", name] -> in_key := true; push_path name
| "helm_registry", _ -> ()
| tag, _ ->
raise (Parse_error (fname, ~-1, ~-1,
(sprintf "unexpected element <%s> or wrong attribute set" tag)))
| tag, _ ->
raise (Parse_error (fname, ~-1, ~-1,
(sprintf "unexpected element <%s> or wrong attribute set" tag)))
let has = has default_registry
let fold ?prefix ?interpolate f init =
fold default_registry ?prefix ?interpolate f init
let has = has default_registry
let fold ?prefix ?interpolate f init =
fold default_registry ?prefix ?interpolate f init
let get_opt unmarshaller = get_opt default_registry unmarshaller
let get_opt_default unmarshaller = get_opt_default default_registry unmarshaller
let get_list unmarshaller = get_list default_registry unmarshaller
let get_opt unmarshaller = get_opt default_registry unmarshaller
let get_opt_default unmarshaller = get_opt_default default_registry unmarshaller
let get_list unmarshaller = get_list default_registry unmarshaller
let set_typed marshaller = set_typed default_registry marshaller
let set_opt unmarshaller = set_opt default_registry unmarshaller
let set_list marshaller = set_list default_registry marshaller
let unset = unset default_registry
let save_to = save_to default_registry
let load_from = load_from default_registry
let set_typed marshaller = set_typed default_registry marshaller
let set_opt unmarshaller = set_opt default_registry unmarshaller
let set_list marshaller = set_list default_registry marshaller
let unset = unset default_registry
let save_to = save_to default_registry
let load_from = load_from default_registry