Extension for handling Yojson data with code positions

examples/.gitignore

@@ -0,0 +1,5 @@
+filtering
+filtering_pos
+*.cmi
+*.cmx
+*.o

examples/filtering.json

@@ -1,4 +1,4 @@
-{                                     
+{
   "id": "398eb027",
   "name": "John Doe",
   "pages": [

examples/filtering_broken.json

@@ -0,0 +1,22 @@
+{
+  "id": "398eb027",
+  "name": "John Doe",
+  "pages": [
+    {
+      "id": 1,
+      "title": "The Art of Flipping Coins",
+      "url": "http://example.com/398eb027/1"
+    },
+    { "id": 2, "deleted": true },
+    {
+      "id": 3,
+        "title": { "foo": "an example of broken value" },
+      "url": "http://example.com/398eb027/3"
+    },
+    {
+      "id": 4,
+      "title": "Flying Bananas",
+      "url": "http://example.com/398eb027/4"
+    }
+  ]
+}

examples/filtering_pos.ml

@@ -0,0 +1,51 @@
+open Yojson.SafePos.Util
+open Format
+
+let pp_position ppf pos =
+  let open Yojson in
+  let fnamestr =
+    match pos.file_name with
+    | None -> ""
+    | Some(x) -> " in '" ^ x ^ "'"
+  in
+  let lnum1 = pos.start_line in
+  let lnum2 = pos.end_line in
+  if lnum1 = lnum2 then
+    fprintf ppf "line %d, column %d-%d%s"
+      lnum1 pos.start_column pos.end_column fnamestr
+  else
+    fprintf ppf "line %d column %d to line %d, column %d"
+      lnum1 pos.start_column lnum2 pos.end_column
+
+let print_with_pos pp ((pos, _) as a) =
+  printf "%a (%a)@," pp a pp_position pos
+
+let pp_object ppf _ =
+  fprintf ppf "<obj>"
+
+let extract_titles json =
+  let objs =
+    [json]
+      |> filter_member "pages"
+      |> flatten
+  in
+  List.iter (print_with_pos pp_object) objs;
+  objs
+    |> filter_member "title"
+    |> List.map to_string
+
+let main () =
+  printf "@[<v0>";
+  begin
+    try
+      let json = Yojson.SafePos.from_channel stdin in
+      List.iter (printf "%s@,") (extract_titles json);
+    with
+    | Yojson.SafePos.Util.Type_error(msg, json) ->
+        printf "! [ERROR] %s:@," msg;
+        printf "! ";
+        print_with_pos Yojson.SafePos.pretty_print json
+  end;
+  printf "@]"
+
+let () = main ()

examples/run-examples.sh

@@ -3,3 +3,10 @@
 echo "----- Example 1: filtering -----"
 ocamlfind ocamlopt -o filtering filtering.ml -package yojson -linkpkg
 ./filtering < filtering.json
+
+echo "----- Example 2: filtering_pos -----"
+ocamlfind ocamlopt -o filtering_pos filtering_pos.ml -package yojson -linkpkg
+echo "..... Example 2.1 ....."
+./filtering_pos < filtering.json
+echo "..... Example 2.2 ....."
+./filtering_pos < filtering_broken.json

lib/common.ml

@@ -72,13 +72,6 @@ let code_of_surrogate_pair i j =
 let utf8_of_surrogate_pair buf i j =
   utf8_of_code buf (code_of_surrogate_pair i j)
 
-let is_object_or_array x =
-  match x with
-      `List _
-    | `Assoc _ -> true
-    | _ -> false
-
-
 type lexer_state = {
   buf : Bi_outbuf.t;
     (* Buffer used to accumulate substrings *)
@@ -116,3 +109,11 @@ let init_lexer ?buf ?fname ?(lnum = 1) () =
     bol = 0;
     fname = fname
   }
+
+type position = {
+  file_name : string option;
+  start_line : int;
+  start_column : int;
+  end_line : int;
+  end_column : int;
+}

lib/common.mli

@@ -36,6 +36,14 @@ val init_lexer :
   unit -> lexer_state
   (** Create a fresh lexer_state record. *)
 
+type position = {
+  file_name : string option;
+  start_line : int;
+  start_column : int;
+  end_line : int;
+  end_column : int;
+}
+  (** The type for code positions. *)
 
 (**/**)
 (* begin undocumented section *)

lib/jbuild

@@ -13,7 +13,8 @@
     write2.ml
     common.ml
     util.ml
-    type.ml))
+    type.ml
+    position.ml))
   (action (run cppo ${<} -o ${@}))))
 
 (rule

lib/position.ml

@@ -0,0 +1,57 @@
+#ifdef POSITION
+  let project (_, x) = x
+
+  let inject x =
+    let dummy =
+      {
+        file_name = Some "(dummy)";
+        start_line = 0;
+        start_column = 0;
+        end_line = 0;
+        end_column = 0;
+      }
+    in
+    (dummy, x)
+
+  let rec forget_positions ((_, x) : json) =
+    match x with
+    | `Null -> `Null
+    | `Bool b -> `Bool b
+  #ifdef INT
+    | `Int i -> `Int i
+  #endif
+  #ifdef INTLIT
+    | `Intlit s -> `Intlit s
+  #endif
+  #ifdef FLOAT
+    | `Float r -> `Float r
+  #endif
+  #ifdef FLOATLIT
+    | `Floatlit s -> `Floatlit s
+  #endif
+  #ifdef STRING
+    | `String s -> `String s
+  #endif
+  #ifdef STRINGLIT
+    | `Stringlit s -> `Stringlit s
+  #endif
+    | `Assoc assoc -> `Assoc (assoc |> List.map (fun (k, v) -> (k, forget_positions v)))
+    | `List js -> `List (js |> List.map forget_positions)
+  #ifdef TUPLE
+    | `Tuple js -> `Tuple (js |> List.map forget_positions)
+  #endif
+  #ifdef VARIANT
+    | `Variant (s, jopt) ->
+        begin
+          match jopt with
+          | None -> `Variant (s, None)
+          | Some(j) -> `Variant (s, Some(forget_positions j))
+        end
+  #endif
+#else
+  let project x = x
+
+  let inject x = x
+
+  let forget_positions x = x
+#endif