Something went wrong. Try again.
My own corner of monopam
Something went wrong. Try again.
6.3 kB · 183 lines
OCaml
at main
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184(*--------------------------------------------------------------------------- Copyright (c) 2025 Thomas Gazagnaire. All rights reserved. SPDX-License-Identifier: ISC ---------------------------------------------------------------------------*)
(* SQLite's json1 value dialect (json.html). Parsing and validation reuse the {!Json} library (nox-json); this module adds what is sqlite-specific: the minified text serialisation sqlite3 emits (number and string formatting byte-compatible) and [$.a.b[2]] path navigation. The SQL functions in {!Query} build on it. *)
type t = | Null | Bool of bool | Int of int64 | Real of string (** the number's text, formatted by {!real} *) | Str of string | Arr of t list | Obj of (string * t) list
exception Error of string
let type_name = function | Null -> "null" | Bool true -> "true" | Bool false -> "false" | Int _ -> "integer" | Real _ -> "real" | Str _ -> "text" | Arr _ -> "array" | Obj _ -> "object"
(* ── Serialisation ───────────────────────────────────────────── *)
(* A real as sqlite3 renders it in JSON: C [%.15g] (shortest within 15 significant digits, trailing zeros stripped), then a forced decimal point -- "10000000000.0", "1.0e+15", "0.1" -- so it always reads back as a real. *)let real_text f = let s = Fmt.str "%.15g" f in match String.index_opt s 'e' with | Some i -> let mant = String.sub s 0 i and ex = String.sub s i (String.length s - i) in let mant = if String.contains mant '.' then mant else mant ^ ".0" in mant ^ ex | None -> if String.contains s '.' then s else s ^ ".0"
(* Build a real node from a SQL double, formatted as sqlite3 would. *)let real f = Real (real_text f)
let escape_into buf s = Buffer.add_char buf '"'; String.iter (fun c -> match c with | '"' -> Buffer.add_string buf "\\\"" | '\\' -> Buffer.add_string buf "\\\\" | '\n' -> Buffer.add_string buf "\\n" | '\r' -> Buffer.add_string buf "\\r" | '\t' -> Buffer.add_string buf "\\t" | '\b' -> Buffer.add_string buf "\\b" | '\012' -> Buffer.add_string buf "\\f" | c when Char.code c < 0x20 -> (* control characters as \u00XX; built directly to avoid a formatter allocation per character *) let hex = "0123456789abcdef" in Buffer.add_string buf "\\u00"; Buffer.add_char buf hex.[(Char.code c lsr 4) land 0xf]; Buffer.add_char buf hex.[Char.code c land 0xf] | c -> Buffer.add_char buf c) s; Buffer.add_char buf '"'
let to_string j = let buf = Buffer.create 64 in let rec go = function | Null -> Buffer.add_string buf "null" | Bool b -> Buffer.add_string buf (if b then "true" else "false") | Int i -> Buffer.add_string buf (Int64.to_string i) | Real s -> Buffer.add_string buf s | Str s -> escape_into buf s | Arr xs -> Buffer.add_char buf '['; List.iteri (fun i x -> if i > 0 then Buffer.add_char buf ','; go x) xs; Buffer.add_char buf ']' | Obj kvs -> Buffer.add_char buf '{'; List.iteri (fun i (k, v) -> if i > 0 then Buffer.add_char buf ','; escape_into buf k; Buffer.add_char buf ':'; go v) kvs; Buffer.add_char buf '}' in go j; Buffer.contents buf
let pp ppf j = Fmt.string ppf (to_string j)
(* ── Parsing (delegated to nox-json) ─────────────────────────── *)
(* Map a parsed nox-json value into the sqlite dialect tree. A number with a fraction/exponent (nox-json [Float]) is re-formatted via {!real}; sqlite3 preserves the original lexeme of such a number, which this does not (the one intentional divergence -- integers, strings, and structure are exact). *)let rec of_json (j : Json.t) : t = match j with | Json.Null _ -> Null | Json.Bool (b, _) -> Bool b | Json.Number (n, _) -> ( match n with | Json.Number.Int i | Json.Number.Uint i -> Int i | Json.Number.Float f | Json.Number.Decimal { value = f; _ } -> real f) | Json.String (s, _) -> Str s | Json.Array (xs, _) -> Arr (List.map of_json xs) | Json.Object (members, _) -> Obj (List.map (fun ((k, _), v) -> (k, of_json v)) members)
let of_string s = match Json.Value.of_string s with Ok v -> Some (of_json v) | Error _ -> None
let of_string_exn s = match of_string s with Some j -> j | None -> raise (Error "malformed JSON")
(* ── Path navigation ($.a.b[2]) ──────────────────────────────── *)
type step = Key of string | Index of int
(* Parse a path expression like [$.a.b[2]] or [$[0]] into steps. *)let parse_path p = let n = String.length p in if n = 0 || p.[0] <> '$' then None else begin let i = ref 1 and steps = ref [] and ok = ref true in while !ok && !i < n do match p.[!i] with | '.' -> incr i; let start = !i in while !i < n && match p.[!i] with '.' | '[' -> false | _ -> true do incr i done; steps := Key (String.sub p start (!i - start)) :: !steps | '[' -> incr i; let start = !i in while !i < n && p.[!i] <> ']' do incr i done; (match int_of_string_opt (String.sub p start (!i - start)) with | Some k -> steps := Index k :: !steps | None -> ok := false); if !i < n then incr i (* past ']' *) | _ -> ok := false done; if !ok then Some (List.rev !steps) else None end
let rec navigate j = function | [] -> Some j | Key k :: rest -> ( match j with | Obj kvs -> ( match List.assoc_opt k kvs with | Some v -> navigate v rest | None -> None) | _ -> None) | Index k :: rest -> ( match j with | Arr xs -> ( match List.nth_opt xs k with | Some v -> navigate v rest | None -> None) | _ -> None)
let lookup j path = match parse_path path with None -> None | Some steps -> navigate j steps