diff --git a/CHANGES.md b/CHANGES.md index 40d3e8f3..1996a48e 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -20,6 +20,8 @@ - Add an opam package `yojson-bench` to deal with benchmarks dependency (@tmcgilchrist, #117) +- Added utilitaries function `assoc_map`, `assoc_map_filter`, `add`, `update` + and `remove` to the `Utils` module (@panglesd, #127) ### Change diff --git a/lib/util.ml b/lib/util.ml index dfed227f..3deb6b4e 100644 --- a/lib/util.ml +++ b/lib/util.ml @@ -202,3 +202,49 @@ let combine (first : t) (second : t) = match (first, second) with | (`Assoc a, `Assoc b) -> (`Assoc (a @ b) : t) | (a, b) -> raise (Invalid_argument "Expected two objects, check inputs") + +let assoc_map f json = match json with + | `Assoc l -> + let rec map res l = match l with + [] -> res + | (k,v) :: q -> map ( (k,f (k,v)) :: res) q in + `Assoc (List.rev @@ map [] l) + | js -> typerr "Can't assoc_map over non-object type " js + +let assoc_map_filter f json = match json with + | `Assoc l -> + let rec map res l = match l with + [] -> res + | (k,v) :: q -> + match f (k,v) with + None -> map (res) q + | Some v -> map ( (k,v) :: res) q in + `Assoc (List.rev @@ map [] l) + | js -> typerr "Can't assoc_map_filter over non-object type " js + +let add json pair = match json with + | `Assoc l -> `Assoc (pair :: l) + | js -> typerr "Can't assoc_map_filter over non-object type " js + +let update json (key, value) = match json with + | `Assoc l -> + let rec map res l = match l with + [] -> List.rev res + | (k,v) :: q when k = key -> + List.rev_append res ((k, value) :: q) + | a :: q -> + map (a::res) q in + `Assoc (map [] l) + | js -> typerr "Can't update field of non-object type " js + +let remove json key = match json with + | `Assoc l -> + let rec map res l = match l with + [] -> List.rev res + | (k,v) :: q when k = key -> + List.rev_append res q + | a :: q -> + map (a::res) q in + `Assoc (map [] l) + | js -> typerr "Can't remove field on non-object type " js + diff --git a/lib/util.mli b/lib/util.mli index ab6e88b9..1363e145 100644 --- a/lib/util.mli +++ b/lib/util.mli @@ -74,6 +74,17 @@ val keys : t -> string list val values : t -> t list (** Return all the value in the given JSON object *) +val add : t -> (string * t) -> t + (** Add an entry to a JSON object *) + +val update : t -> (string * t) -> t + (** [update json (key, value)] updates the first field with key [key] of the + JSON object [json] to [value] *) + +val remove : t -> string -> t + (** [remove json key] remove the first field with key [key] of the + JSON object [json] *) + val combine : t -> t -> t (** Combine two JSON Objects together *) @@ -90,6 +101,15 @@ val map : (t -> t) -> t -> t (** [map f arr] calls the function [f] on each element of the JSON array [arr], and returns a JSON array containing the results. *) +val assoc_map : (string * t -> t) -> t -> t + (** [assoc_map f json] calls the function [f] on each [(key, value)] pair of + the JSON object [json], and returns a JSON object containing the updated + [(key, f (key, value))]. *) + +val assoc_map_filter : (string * t -> t option) -> t -> t + (** Same as [assoc_map] but filters the output of [f]. + *) + val to_assoc : t -> (string * t) list (** Extract the items of a JSON object or raise [Type_error]. *)