diff --git a/core/CCSexp.ml b/core/CCSexp.ml index 4ef41483..c446b374 100644 --- a/core/CCSexp.ml +++ b/core/CCSexp.ml @@ -583,6 +583,8 @@ end (** {6 Traversal of S-exp} *) module Traverse = struct + type 'a conv = t -> 'a option + let return x = Some x let (>|=) e f = match e with @@ -593,6 +595,15 @@ module Traverse = struct | None -> None | Some x -> f x + let map_opt f l = + let rec recurse acc l = match l with + | [] -> Some (List.rev acc) + | x::l' -> + match f x with + | None -> None + | Some y -> recurse (y::acc) l' + in recurse [] l + let rec _list_any f l = match l with | [] -> None | x::tl -> @@ -628,14 +639,31 @@ module Traverse = struct | `List [x;y] -> Some (x,y) | _ -> None + let to_pair_with f1 f2 e = + to_pair e >>= fun (x,y) -> + f1 x >>= fun x -> + f2 y >>= fun y -> + return (x,y) + let to_triple e = match e with | `List [x;y;z] -> Some (x,y,z) | _ -> None + let to_triple_with f1 f2 f3 e = + to_triple e >>= fun (x,y,z) -> + f1 x >>= fun x -> + f2 y >>= fun y -> + f3 z >>= fun z -> + return (x,y,z) + let to_list e = match e with | `List l -> Some l | `Atom _ -> None + let to_list_with f (e:t) = match e with + | `List l -> map_opt f l + | `Atom _ -> None + let rec _get_field name l = match l with | `List [`Atom n; x] :: _ when name=n -> Some x | _ :: tl -> _get_field name tl @@ -648,6 +676,15 @@ module Traverse = struct let field name f e = get_field name e >>= f + let rec _get_field_list name l = match l with + | `List (`Atom n :: tl) :: _ when name=n -> Some tl + | _ :: tl -> _get_field_list name tl + | [] -> None + + let field_list name f e = match e with + | `List l -> _get_field_list name l >>= f + | `Atom _ -> None + let rec _get_variant s args l = match l with | [] -> None | (s', f) :: _ when s=s' -> f args diff --git a/core/CCSexp.mli b/core/CCSexp.mli index 7ed78c57..152b4b8e 100644 --- a/core/CCSexp.mli +++ b/core/CCSexp.mli @@ -250,40 +250,72 @@ Sexp.Traverse.list_all pt_of_sexp sexp;; *) module Traverse : sig - val list_any : (t -> 'a option) -> t -> 'a option + type 'a conv = t -> 'a option + (** A converter from S-expressions to 'a is a function [sexp -> 'a option]. + @since NEXT_RELEASE *) + + val map_opt : ('a -> 'b option) -> 'a list -> 'b list option + (** Map over a list, failing as soon as the function fails on any element + @since NEXT_RELEASE *) + + val list_any : 'a conv -> t -> 'a option (** [list_any f (List l)] tries [f x] for every element [x] in [List l], and returns the first non-None result (if any). *) - val list_all : (t -> 'a option) -> t -> 'a list + val list_all : 'a conv -> t -> 'a list (** [list_all f (List l)] returns the list of all [y] such that [x] in [l] and [f x = Some y] *) - val to_int : t -> int option + val to_int : int conv + (** Expect an integer *) - val to_string : t -> string option + val to_string : string conv + (** Expect a string (an atom) *) - val to_bool : t -> bool option + val to_bool : bool conv + (** Expect a boolean *) - val to_float : t -> float option + val to_float : float conv + (** Expect a float *) - val to_list : t -> t list option + val to_list : t list conv + (** Expect a list *) - val to_pair : t -> (t * t) option + val to_list_with : (t -> 'a option) -> 'a list conv + (** Expect a list, applies [f] to all the elements of the list, and succeeds + only if [f] succeeded on every element + @since NEXT_RELEASE *) - val to_triple : t -> (t * t * t) option + val to_pair : (t * t) conv + (** Expect a list of two elements *) - val get_field : string -> t -> t option + val to_pair_with : 'a conv -> 'b conv -> ('a * 'b) conv + (** Same as {!to_pair} but applies conversion functions + @since NEXT_RELEASE *) + + val to_triple : (t * t * t) conv + + val to_triple_with : 'a conv -> 'b conv -> 'c conv -> ('a * 'b * 'c) conv + (* @since NEXT_RELEASE *) + + val get_field : string -> t conv (** [get_field name e], when [e = List [(n1,x1); (n2,x2) ... ]], extracts the [xi] such that [name = ni], if it can find it. *) - val field : string -> (t -> 'a option) -> t -> 'a option + val field : string -> 'a conv -> 'a conv (** Enriched version of {!get_field}, with a converter as argument *) - val get_variant : (string * (t list -> 'a option)) list -> t -> 'a option + val get_variant : (string * (t list -> 'a option)) list -> 'a conv (** [get_variant l e] checks whether [e = List (Atom s :: args)], and if some pair of [l] is [s, f]. In this case, it calls [f args] and returns its result, otherwise it returns None. *) + val field_list : string -> (t list -> 'a option) -> 'a conv + (** [field_list name f "(... (name a b c d) ...record)"] + will look for a field based on the given [name], and expect it to have a + list of arguments dealt with by [f] (here, "a b c d"). + @since NEXT_RELEASE *) + val (>>=) : 'a option -> ('a -> 'b option) -> 'b option val (>|=) : 'a option -> ('a -> 'b) -> 'b option