new functions in CCSexp.Traverse

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

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