(* Copyright 2012 Tony Garnock-Jones <tonygarnockjones@gmail.com>. *)

(* This file is part of Hop. *)

(* Hop is free software: you can redistribute it and/or modify it *)
(* under the terms of the GNU General Public License as published by the *)
(* Free Software Foundation, either version 3 of the License, or (at your *)
(* option) any later version. *)

(* Hop is distributed in the hope that it will be useful, but *)
(* WITHOUT ANY WARRANTY; without even the implied warranty of *)
(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU *)
(* General Public License for more details. *)

(* You should have received a copy of the GNU General Public License *)
(* along with Hop.  If not, see <http://www.gnu.org/licenses/>. *)

type 'a t =
  | Index of int
  | Field of bytes
  | Push

type 'a adapter_t = {
  get_index: 'a -> int -> 'a;
  set_index: 'a -> int -> 'a -> 'a;
  push: 'a -> 'a -> 'a;
  empty_array: unit -> 'a;

  get_field: bytes -> 'a -> 'a;
  set_field: bytes -> 'a -> 'a -> 'a;
  empty_record: unit -> 'a;
}

exception Syntax_error of string

let parse_fieldref b =
  let s = Ibuffer.until_pred (function Some x -> x = '[' || x = '.' | None -> true) b in
  Field s

let parse_single b =
  match Ibuffer.peek_char b with 
    | '[' ->
      Ibuffer.skip_byte b; (* drop the open bracket *)
      let istr = Ibuffer.until_char ']' b in
      Ibuffer.skip_byte b; (* drop the close bracket *)
      if istr = Bytes.of_string "+" then Push else Index (int_of_string (Bytes.to_string istr))
    | '.' ->
      Ibuffer.skip_byte b;
      parse_fieldref b
    | _ ->
      parse_fieldref b

let rec parse b =
  try
    let step = parse_single b in
    step :: parse b
  with End_of_file ->
    []

let of_string s = parse (Ibuffer.of_bytes (Bytes.of_string s))

let to_string ps =
  let rec walk is_first ps =
    match ps with
      | [] -> ""
      | Index i :: rest -> "[" ^ string_of_int i ^ "]" ^ walk false rest
      | Field s :: rest -> (if is_first then "" else ".") ^ (Bytes.to_string s) ^ walk false rest
      | Push :: rest -> "[+]" ^ walk false rest
  in walk true ps

let run1 adapter v p =
  match p with
    | Index i -> adapter.get_index v i
    | Field s -> adapter.get_field s v
    | Push -> failwith "Gpath.run1"

let run adapter ps v =
  List.fold_left (run1 adapter) v ps

let set adapter ps newval v =
  let rec walk ps v =
    match ps with
      | [] -> failwith "empty path in Gpath.set"
      | [Index i] -> adapter.set_index v i newval
      | [Field s] -> adapter.set_field s newval v
      | [Push] -> adapter.push v newval
      | (Index i) :: rest -> adapter.set_index v i (walk rest (adapter.get_index v i))
      | (Field s) :: rest ->
	(match try Some (adapter.get_field s v) with _ -> None with
	  | Some v' -> adapter.set_field s (walk rest v') v
	  | None -> adapter.set_field s (stub rest) v)
      | (Push) :: rest -> adapter.push v (stub rest)
  and stub ps =
    match ps with
      | [] -> newval
      | (Index 0) :: rest -> adapter.push (adapter.empty_array ()) (stub rest)
      | (Index _) :: rest -> failwith "non-zero index in stub in Gpath.set"
      | (Field s) :: rest -> adapter.set_field s (stub rest) (adapter.empty_record ())
      | (Push) :: rest -> adapter.push (adapter.empty_array ()) (stub rest)
  in walk ps v