Commits

Anonymous committed e892228

successful JSON object parsing

Comments (0)

Files changed (1)

 let compose f g = fun x -> f (g x)
 let listify x = [x] 
 
+let assert_success (pr:'a parse_result) : unit =
+  match pr with
+    | Failure -> assert false
+    | Success _ -> ()
+
 (* primitive combinators *)
  
 let parse_pred (fn: char -> bool) : char parse_fun =
 let parse_json_null = parse_compose (fun x -> Null) (parse_word "null")
 let parse_json_string = parse_compose (fun s -> String s) parse_string
 let parse_json_int = parse_compose (fun i -> Int i) parse_int
+
+let parse_delimited (start:char) (last:char) (delim:char) p =
+  let parse_delim = parse_char delim in
+    parse_combine [
+      parse_ignore (parse_char start);
+      parse_kleene_star (
+	parse_compose (fun l -> List.nth l 0)
+	  (parse_combine [parse_compose listify p;
+			  parse_ignore parse_delim]));
+      parse_optional p;
+      parse_ignore (parse_char last)]
+
 let rec parse_json_list cs = 
-  let parse_comma = parse_char ',' in
-  let l : json list parse_fun = 
-    parse_combine [
-      parse_ignore (parse_char '[');
-      parse_kleene_star (
-	parse_compose (fun (l:json list) -> List.nth l 0)
-	  (parse_combine [parse_compose listify parse_json;
-			  parse_ignore parse_comma]));
-      parse_optional parse_json;
-      parse_ignore (parse_char ']')]
+  let l = parse_delimited '[' ']' ',' parse_json in
+    parse_compose (fun l -> Array l) l cs
+and parse_json_array cs =
+  let extract_pair p =
+    let k = 
+      match List.nth p 0 with
+	| String s -> s 
+	| _ -> raise (Invalid_argument "extract_pair")
+    in
+      (k, List.nth p 1)
   in
-    parse_compose (fun l -> Array l) l cs
+  let parse_pair = 
+    parse_compose extract_pair (
+      parse_combine [
+	parse_compose listify parse_json_string;
+	parse_ignore parse_wc;
+	parse_ignore (parse_char ':');
+	parse_ignore parse_wc;
+	parse_compose listify parse_json])
+  in
+    parse_compose build_dict (parse_delimited '{' '}' ',' parse_pair) cs
 and parse_json cs : json parse_result =
   parse_compose (fun x -> List.nth x 0)
     (parse_combine [parse_wc; parse_compose listify (parse_first [
 		   parse_json_null;
 		   parse_json_string;
 		   parse_json_int;
-		   parse_json_list]); parse_wc]) cs
+		   parse_json_list;
+		   parse_json_array]); parse_wc]) cs
 
 let quick_print (pr:'a parse_result) : unit =
   print_endline (match pr with
     | Success (result,rest) -> result
 
 let test =
-  print_endline (dump (loads_json "[true,false,1,    2, 256]"));
+  print_endline (dump (loads_json "[true,false,1,    2, 256, {\"a\":1}]"));