json_path_gadt.ml

type json = [
  | `Bool of bool
  | `Int of int
  | `Object of (string * json) list
]

type _ path =
  | Bool : bool path
  | Int : int path
  | Field : string * 'a path -> 'a path

let rec find : type a . json -> a path -> a option = fun json path ->
  match json, path with
  | `Bool b, Bool -> Some b
  | `Int i, Int -> Some i
  | `Object l, Field (k, p) ->
      (try
         let v = List.assoc k l in
         find v p
       with Not_found ->
         None
      )
  | _ ->
      None

let json = `Object [ "x", `Bool true;
                     "y", `Int 123 ]

let x = find json (Field ("x", Bool))         (* Some true *)
let y = find json (Field ("y", Int))          (* Some 123 *)
let nothing = find json (Field ("y", Bool))   (* None *)