Attention une mise à jour du service Gitlab va être effectuée le mardi 18 janvier (et non lundi 17 comme annoncé précédemment) entre 18h00 et 18h30. Cette mise à jour va générer une interruption du service dont nous ne maîtrisons pas complètement la durée mais qui ne devrait pas excéder quelques minutes.

Commit ad6bcf3e authored by Andrei Paskevich's avatar Andrei Paskevich
Browse files

accept "simple families" without arguments in rc files

parent b0546113
......@@ -65,7 +65,8 @@ exception BoolExpected of string * rc_value
type t (** Rc parsed file *)
type section (** section in rc file *)
type family = (string * section) list (** A family in rc files *)
type family = (string * section) list (** A family in rc files *)
type simple_family = section list (** A family w/o arguments in rc files*)
val empty : t (** An empty Rc *)
val empty_section : section (** An empty section *)
......@@ -77,23 +78,35 @@ val get_section : t -> string -> section option
@raise ExtraParameters if [name] is a family in [rc] instead of a section
*)
val get_family : t -> string -> family
(** [get_family rc name] return all the sections of the family [name]
in [rc]
@raise MissingParameters if [name] correspond also too a section in [rc]
*)
val get_family : t -> string -> family
(** [get_family rc name] return all the sections of the family [name] in [rc]
@raise MissingParameters if [name] also corresponds to a section in [rc]
*)
val get_simple_family : t -> string -> simple_family
(** [get_simple_family rc name] return all the sections of the simple
family [name] in [rc]
@raise ExtraParameters if [name] also corresponds to family in [rc]
*)
val set_section : t -> string -> section -> t
(** [set_section rc name section] add a section [section] with name [name] in
[rc]. Remove former section [name] if present in [rc] *)
(** [set_section rc name section] add a section [section] with name [name]
in [rc]. Remove former section [name] if present in [rc]
*)
val set_family : t -> string -> family -> t
val set_family : t -> string -> family -> t
(** [set_family rc name family] add all the section in [family] using
the associated [string] as argument of the family [name] in the rc
file [rc]. Remove all the former sections of family [name] if
present in [rc] *)
the associated [string] as argument of the family [name] in [rc].
Remove all the former sections of family [name] if present in [rc].
*)
val set_simple_family : t -> string -> simple_family -> t
(** [set_simple_family rc name family] add all the section in [family]
using the associated [string] as argument of the family [name] in [rc].
Remove all the former sections of family [name] if present in [rc].
*)
val get_int : ?default:int -> section -> string -> int
val get_int : ?default:int -> section -> string -> int
(** [get_int ~default section key] one key to one value
@raise Bad_value_type if the value associated to [key] is not of type
......@@ -117,7 +130,7 @@ val get_intl : ?default:int list -> section -> string -> int list
associated to [key]
*)
val set_int :?default:int -> section -> string -> int -> section
val set_int : ?default:int -> section -> string -> int -> section
(** [set_int ?default section key value] add the association [key] to [value]
in the section if value is not default.
Remove all former associations with this [key]
......@@ -129,10 +142,10 @@ val set_intl : ?default:int list -> section -> string -> int list -> section
Remove all former associations with this [key]
*)
val get_bool : ?default:bool -> section -> string -> bool
val get_bool : ?default:bool -> section -> string -> bool
(** Same as {!get_int} but on bool *)
val get_booll : ?default:bool list -> section -> string -> bool list
val get_booll : ?default:bool list -> section -> string -> bool list
(** Same as {!get_intl} but on bool *)
val get_boolo : section -> string -> bool option
......@@ -144,10 +157,10 @@ val set_booll : ?default:bool list -> section -> string -> bool list -> section
(** Same as {!set_intl} but on bool *)
val get_string : ?default:string -> section -> string -> string
val get_string : ?default:string -> section -> string -> string
(** Same as {!get_int} but on string *)
val get_stringl : ?default:string list -> section -> string -> string list
val get_stringl : ?default:string list -> section -> string -> string list
(** Same as {!get_intl} but on string *)
val get_stringo : section -> string -> string option
......
......@@ -124,7 +124,9 @@ let () = Exn_printer.register (fun fmt e -> match e with
| e -> raise e)
type section = rc_value list Mstr.t
type family = (string * section) list
type family = (string * section) list
type simple_family = section list
type ofamily = (string option * section) list
type t = ofamily Mstr.t
......@@ -137,10 +139,10 @@ let make_t tl =
Mstr.add key (value::l) acc in
let add_section t (args,sectionl) =
let sname,arg = match args with
| [] -> assert false
| [sname] -> sname,None
| [] -> assert false
| [sname] -> sname,None
| [sname;arg] -> sname,Some arg
| sname::_ -> raise (ExtraParameters sname) in
| sname::_ -> raise (ExtraParameters sname) in
let m = List.fold_left add_key empty_section sectionl in
let m = Mstr.map List.rev m in
let l = Mstr.find_def [] sname t in
......@@ -165,6 +167,15 @@ let get_family t sname =
List.map get l
with Not_found -> []
let get_simple_family t sname =
try
let l = Mstr.find sname t in
let get (arg,section) =
(match arg with Some _ -> raise (ExtraParameters sname) | None ->
section) in
List.map get l
with Not_found -> []
let set_section t sname section =
Mstr.add sname [None,section] t
......@@ -174,6 +185,11 @@ let set_family t sname sections =
let set (arg,section) = (Some arg,section) in
Mstr.add sname (List.map set sections) t
let set_simple_family t sname sections =
if sections = [] then Mstr.remove sname t else
let set section = (None,section) in
Mstr.add sname (List.map set sections) t
let get_value read section key =
let l = Mstr.find key section in
match l with
......@@ -351,7 +367,7 @@ and string_val key = parse
{ Buffer.add_char buf c;
string_val key lexbuf }
| '\\' (['\\' '"' 'n' 'r' 't'] as c)
{ Buffer.add_char buf
{ Buffer.add_char buf
(match c with 'n' -> '\n' | 'r' -> '\r' | 't' -> '\t' | _ -> c);
string_val key lexbuf }
| '\\' '\n'
......@@ -395,8 +411,8 @@ let to_formatter fmt t =
let print_kv k fmt v = fprintf fmt "%s = %a" k print_rc_value v in
let print_kvl fmt k vl = Pp.print_list Pp.newline (print_kv k) fmt vl in
let print_section sname fmt (h,l) =
fprintf fmt "[%s %a]@\n%a"
sname (Pp.print_option Pp.string) h
fprintf fmt "[%s%a]@\n%a"
sname (Pp.print_option (fun fmt -> fprintf fmt " %s")) h
(Pp.print_iter22 Mstr.iter Pp.newline print_kvl) l in
let print_sectionl fmt sname l =
Pp.print_list Pp.newline2 (print_section sname) fmt l in
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment