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
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)
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
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 =
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