Native OCaml Rego/OPA policy engine
ocaml-rego: json.filter walks the source structurally
+43
-6
+43
-6
lib/eval.ml
+43
-6
lib/eval.ml
···
1209
1209
| _ -> tree)
1210
1210
| _ -> tree)
1211
1211
1212
+
(** Build a filtered subtree of [doc] keeping only branches that match one of
1213
+
[paths]. Walks [doc] structurally so arrays stay arrays and only the kept
1214
+
positions are populated; the array's intermediate items are kept as-is when
1215
+
a deeper path passes through them. *)
1212
1216
let json_filter doc paths =
1213
-
List.fold_left
1214
-
(fun acc path ->
1215
-
match json_lookup doc path with
1216
-
| Some v -> json_insert acc path v
1217
-
| None -> acc)
1218
-
(Value.Object []) paths
1217
+
let rec walk doc paths =
1218
+
if List.mem [] paths then doc
1219
+
else
1220
+
match doc with
1221
+
| Value.Object pairs ->
1222
+
let kept =
1223
+
List.filter_map
1224
+
(fun (k, v) ->
1225
+
let key =
1226
+
match k with
1227
+
| Value.String s -> s
1228
+
| Value.Number n -> string_of_float_int n
1229
+
| _ -> ""
1230
+
in
1231
+
let sub_paths =
1232
+
List.filter_map
1233
+
(function p :: rest when p = key -> Some rest | _ -> None)
1234
+
paths
1235
+
in
1236
+
if sub_paths = [] then None else Some (k, walk v sub_paths))
1237
+
pairs
1238
+
in
1239
+
Value.Object kept
1240
+
| Value.Array xs ->
1241
+
List.mapi
1242
+
(fun i v ->
1243
+
let key = string_of_int i in
1244
+
let sub_paths =
1245
+
List.filter_map
1246
+
(function p :: rest when p = key -> Some rest | _ -> None)
1247
+
paths
1248
+
in
1249
+
if sub_paths = [] then None else Some (walk v sub_paths))
1250
+
xs
1251
+
|> List.filter_map (fun x -> x)
1252
+
|> fun ys -> Value.Array ys
1253
+
| _ -> doc
1254
+
in
1255
+
walk doc paths
1219
1256
1220
1257
let json_remove doc paths =
1221
1258
List.fold_left (fun acc path -> json_delete acc path) doc paths