From 27ebca99c83f84c5a3915695e3f78b36c4fbcedf Mon Sep 17 00:00:00 2001 From: Stefano Zacchiroli Date: Tue, 24 Feb 2004 13:15:48 +0000 Subject: [PATCH] - added support for boolean parameters - added support for optional parameters --- helm/ocaml/registry/helm_registry.ml | 26 +++++++++++++------ helm/ocaml/registry/helm_registry.mli | 37 +++++++++++++++++++++------ 2 files changed, 47 insertions(+), 16 deletions(-) diff --git a/helm/ocaml/registry/helm_registry.ml b/helm/ocaml/registry/helm_registry.ml index 969644b01..91fcb67b5 100644 --- a/helm/ocaml/registry/helm_registry.ml +++ b/helm/ocaml/registry/helm_registry.ml @@ -69,6 +69,11 @@ let dot_rex = Str.regexp "\\." let spaces_rex = Str.regexp "[ \t\n\r]+" let heading_spaces_rex = Str.regexp "^[ \t\n\r]+" +let split s = + (* trailing blanks are removed per default by split *) + Str.split spaces_rex (Str.global_replace heading_spaces_rex "" s) +let merge l = String.concat " " l + (* escapes for xml configuration file *) let (escape, unescape) = let (in_enc, out_enc) = (`Enc_utf8, `Enc_utf8) in @@ -93,6 +98,8 @@ let set' registry ~key ~value = value_is_valid ~key ~value; Hashtbl.replace registry key value +let unset = Hashtbl.remove registry + let env_var_of_key key = (* Pcre.replace ~rex:dot_rex ~templ:"__" (String.uppercase key) *) Str.global_replace dot_rex "__" (String.uppercase key) @@ -135,12 +142,6 @@ let get key = let set = set' registry -let string_list_of_string s = - (* trailing blanks are removed per default by split *) -(* Pcre.split ~res:spaces_rex (Pcre.replace ~rex:heading_spaces_rex s) *) - Str.split spaces_rex (Str.global_replace heading_spaces_rex "" s) -let string_of_string_list l = String.concat " " l - let mk_get_set type_name (from_string: string -> 'a) (to_string: 'a -> string) = let getter key = let value = get key in @@ -155,8 +156,17 @@ let mk_get_set type_name (from_string: string -> 'a) (to_string: 'a -> string) = let (get_string, set_string) = (get, set) let (get_int, set_int) = mk_get_set "int" int_of_string string_of_int let (get_float, set_float) = mk_get_set "float" float_of_string string_of_float -let (get_string_list, set_string_list) = - mk_get_set "string list" string_list_of_string string_of_string_list +let (get_bool, set_bool) = mk_get_set "bool" bool_of_string string_of_bool +let (get_string_list, set_string_list) = mk_get_set "string list" split merge + +let get_opt getter key = + try + Some (getter key) + with Key_not_found _ -> None +let set_opt setter ~key ~value = + match value with + | None -> unset key + | Some value -> setter ~key ~value (* let save_to = diff --git a/helm/ocaml/registry/helm_registry.mli b/helm/ocaml/registry/helm_registry.mli index 76c5d6f16..f50d9b4a9 100644 --- a/helm/ocaml/registry/helm_registry.mli +++ b/helm/ocaml/registry/helm_registry.mli @@ -97,22 +97,43 @@ exception Invalid_value of (string * string) * string val get: string -> string val set: key:string -> value:string -> unit + (** remove a key from the current environment, next get over this key will + * raise Key_not_found until the key will be redefined *) +val unset: string -> unit + (** {2 Typed interface} * Three basic types are supported: strings, int and strings list. Strings * correspond literally to what is written inside double quotes; int to the * parsing of an integer number from ; strings list to the splitting at blanks * of it (heading and trailing blanks are removed before splitting) *) -val get_string: string -> string (* alias for bare "get" above *) -val get_int: string -> int -val get_float: string -> float -val get_string_list: string -> string list +val get_string: string -> string (* alias for bare "get" above *) +val get_int: string -> int +val get_float: string -> float +val get_bool: string -> bool +val get_string_list: string -> string list (* alias for bare "set" above *) -val set_string: key:string -> value:string -> unit -val set_int: key:string -> value:int -> unit -val set_float: key:string -> value:float -> unit -val set_string_list: key:string -> value:string list -> unit +val set_string: key:string -> value:string -> unit +val set_int: key:string -> value:int -> unit +val set_float: key:string -> value:float -> unit +val set_bool: key:string -> value:bool -> unit +val set_string_list: key:string -> value:string list -> unit + +(** {3 Optional values interface} + * Functions below took as first argument respectively a "getter" and a "setter" + * function. A getter is one of the get_* function above, a setter is one of the + * set_* function above. Returned value is a get (set) function typed as the + * given getter (setter) whith optional values. None is returned for missing + * keys and None can be assigned to a key removing it from the registry. + *) + +val get_opt: + (string -> 'a) (* getter *) -> + string -> 'a option +val set_opt: + (key:string -> value:'a -> unit) (* setter *) -> + key:string -> value:'a option -> unit (** {2 Validators} * Each key may have zero or more associated validators, that are predicates -- 2.39.2