101 lines
3.2 KiB
OCaml
101 lines
3.2 KiB
OCaml
(* 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
|