diff --git a/.gitignore b/.gitignore index 888aaa60..5d1696ad 100644 --- a/.gitignore +++ b/.gitignore @@ -201,3 +201,40 @@ rust/target/ .eslintcache .detekt/ + +# Clojure +clojure/.cpcache/ +clojure/.clj-kondo/ +clojure/classes/ +clojure/target/ + +# OCaml +ocaml/run_tests +ocaml/**/*.cmi +ocaml/**/*.cmo +ocaml/**/*.cmx +ocaml/**/*.o + +# Scala +scala/out/ +scala/out-lint/ +scala/**/*.tasty + +# Dart +dart/.dart_tool/ +dart/.packages +dart/pubspec.lock +dart/*.dill + +# Elixir +elixir/_build/ +elixir/.elixir_ls/ +elixir/deps/ +elixir/**/*.beam +elixir/erl_crash.dump + +# Haskell +haskell/.hsbuild/ +haskell/**/*.hi +haskell/**/*.o +haskell/dist-newstyle/ diff --git a/AGENTS.md b/AGENTS.md index f4e532ff..5d16f409 100644 --- a/AGENTS.md +++ b/AGENTS.md @@ -39,7 +39,7 @@ matrix in [`REPORT.md`](design/REPORT.md)): | Canonical | Complete | Partial | |---|---|---| -| typescript | javascript, python, go, php, ruby, lua, rust, c, csharp, zig, cpp, perl, swift | java, kotlin | +| typescript | javascript, python, go, php, ruby, lua, rust, c, csharp, zig, cpp, perl, swift, clojure, ocaml, scala, java, kotlin, dart, elixir, haskell | — | ## Prime directives (do not break these) @@ -128,10 +128,16 @@ into the directory and use its `Makefile`. First run installs deps. | C++ | `cpp/` | `make test` (needs `nlohmann/json` header) | clang-tidy + clang-format | `_v`/`_str` suffix variants | | C# | `csharp/` | `dotnet test` | Roslyn analyzers | PascalCase; SDK pinned to 8.0 on purpose | | Zig | `zig/` | `zig build test` | `zig build` + `zig fmt` | `allocator` is the first parameter | -| Java | `java/` | `mvn test` | checkstyle + spotbugs | lowercase names; partial port (JUnit 6) | -| Kotlin | `kotlin/` | `./gradlew test` | detekt + ktlint | partial port | +| Java | `java/` | `mvn test` | checkstyle + spotbugs | lowercase names; JUnit 6 | +| Kotlin | `kotlin/` | `./gradlew test` | detekt + ktlint | | | Perl | `perl/` | `prove -Ilib t/` | perlcritic | `Tie::IxHash`-style ordered hash | | Swift | `swift/` | `swift test` | swift-format | `allocator`-free; in-tree ordered dict | +| Clojure | `clojure/` | `clojure -M:test` | namespace compile check | mutable `LinkedHashMap`/`ArrayList` nodes; lower-smushed names | +| OCaml | `ocaml/` | `make test` (`ocamlc`) | type-check (`ocamlc -c`) | `value` variant; distinct Noval/Null (like TS); in-tree regex engine | +| Scala | `scala/` | `make test` (`scalac`/`scala`) | type-check (`scalac`) | `Value` ADT; distinct Noval/VNull (like TS); `java.util.regex` | +| Dart | `dart/` | `dart run test/runner.dart` | `dart analyze` | native `Map`/`List` nodes; single `null` (like Python); core `RegExp` | +| Elixir | `elixir/` | `elixir test/runner.exs` | compile check (`elixirc`) | ETS-backed heap nodes (`{:vmap,_}`/`{:vlist,_}`); single `nil` (like Python); core `Regex` | +| Haskell | `haskell/` | `ghc … test/Runner.hs` | type-check (`ghc -fno-code`) | `IORef`-backed nodes (whole API in `IO`); distinct `VNoval`/`VNull` (like OCaml); in-tree Vregex | Repo-wide: `make test` / `make lint` / `make audit` (supply-chain) / `make scan` (secrets, SAST, parity, regex, spelling, markdown) / @@ -166,7 +172,7 @@ markdownlint, plus each language's linters). ## Conventions -- **Casing.** `getpath` (TS/JS/Py/Ruby/PHP/Lua/Perl/Java/Kotlin/Swift), +- **Casing.** `getpath` (TS/JS/Py/Ruby/PHP/Lua/Perl/Java/Kotlin/Swift/Clojure/OCaml/Scala/Dart/Elixir/Haskell), `GetPath` (Go/C#), `get_path` (Rust), `voxgig_getpath` (C — and C++ adds `_v`/`_str` variants). Parity is checked case/underscore-insensitively. - **Absent vs. null ("Group A/B").** See [`UNDEF_SPEC.md`](design/UNDEF_SPEC.md). diff --git a/Makefile b/Makefile index f9aac509..0d8dd5f5 100644 --- a/Makefile +++ b/Makefile @@ -16,7 +16,7 @@ # `make -C `. Each port ships at least `test` and `lint`; `build`, # `inspect`, `clean` and `reset` are invoked tolerantly (a port without one # just reports "(no target)"). -LANGS = typescript javascript python go ruby php lua zig java rust c cpp csharp kotlin perl swift +LANGS = typescript javascript python go ruby php lua zig java rust c cpp csharp kotlin perl swift clojure ocaml scala dart elixir haskell # Every port ships a `make lint` target, so lint covers the full set. LINT_LANGS = $(LANGS) @@ -31,7 +31,7 @@ AUDIT_LANGS = typescript javascript python go ruby php rust csharp # LuaRocks, Maven Central, CPAN) and ALWAYS creates + pushes a git tag # `/vX.Y.Z`. Registry-less ports (Go, PHP/Packagist, Swift, Zig, C, C++) # publish purely by that tag. -PUBLISH_LANGS = typescript javascript python go ruby php lua zig java rust c cpp csharp kotlin perl swift +PUBLISH_LANGS = typescript javascript python go ruby php lua zig java rust c cpp csharp kotlin perl swift clojure ocaml scala dart elixir haskell .PHONY: all inspect build test lint audit scan analyze clean reset publish status corpus gen-docs \ scan-secrets scan-deps scan-sast scan-workflows scan-shell scan-spelling scan-docs \ diff --git a/README.md b/README.md index 48b0ce8e..8bbca92f 100644 --- a/README.md +++ b/README.md @@ -37,15 +37,20 @@ syntax), and language-specific notes: | C | Complete | [`c/README.md`](./c/README.md) | | C# | Complete | [`csharp/README.md`](./csharp/README.md) | | Zig | Complete | [`zig/README.md`](./zig/README.md) | -| Java | Partial | [`java/README.md`](./java/README.md) | -| Kotlin | Partial | [`kotlin/README.md`](./kotlin/README.md) | +| Java | Complete | [`java/README.md`](./java/README.md) | +| Kotlin | Complete | [`kotlin/README.md`](./kotlin/README.md) | | C++ | Complete | [`cpp/README.md`](./cpp/README.md) | | Perl | Complete | [`perl/README.md`](./perl/README.md) | | Swift | Complete | [`swift/README.md`](./swift/README.md) | - -"Partial" (Java, Kotlin) denotes project maturity / release-lag — the -JVM family trails the canonical by a release — **not** missing API: both -report full canonical parity under `tools/check_parity.py`. See each +| Clojure | Complete | [`clojure/README.md`](./clojure/README.md) | +| OCaml | Complete | [`ocaml/README.md`](./ocaml/README.md) | +| Scala | Complete | [`scala/README.md`](./scala/README.md) | +| Dart | Complete | [`dart/README.md`](./dart/README.md) | +| Elixir | Complete | [`elixir/README.md`](./elixir/README.md) | +| Haskell | Complete | [`haskell/README.md`](./haskell/README.md) | + +Every listed port reports full canonical parity under +`tools/check_parity.py` and passes the shared `build/test/` corpus. See each port's `README.md` for details. Each port directory also carries a `DOCS.md` (the comprehensive, @@ -429,8 +434,8 @@ cross-engine edge cases: ├── build/test/ # shared JSON test corpus (.jsonic) ├── typescript/ javascript/ python/ # canonical + JS-family ports ├── go/ ruby/ php/ # other complete ports -├── lua/ csharp/ zig/ rust/ c/ perl/ kotlin/ cpp/ swift/ -├── java/ # partial port +├── lua/ csharp/ zig/ rust/ c/ perl/ kotlin/ cpp/ swift/ clojure/ ocaml/ scala/ dart/ elixir/ haskell/ +├── java/ # JVM ports (also kotlin/ scala/ clojure/) └── LICENSE ``` @@ -460,6 +465,12 @@ Each language directory contains: | Zig | `zig build` (compiler) | `zig fmt` | | C# | Roslyn analyzers | `dotnet format` | | Kotlin | detekt | ktlint | +| Clojure | namespace compile check | (clj-kondo optional) | +| OCaml | type-check (`ocamlc -c`) | (ocamlformat optional)| +| Scala | type-check (`scalac`) | (scalafmt optional) | +| Dart | `dart analyze` | `dart format` | +| Elixir | compile check (`elixirc`) | (`mix format` optional)| +| Haskell | type-check (`ghc -fno-code`) | (`ormolu` optional) | Run everything with `make lint` at the repo root, or one language with `make lint-` (e.g. `make lint-go`). diff --git a/clojure/AGENTS.md b/clojure/AGENTS.md new file mode 100644 index 00000000..6f7e4f75 --- /dev/null +++ b/clojure/AGENTS.md @@ -0,0 +1,73 @@ +# AGENTS.md — Clojure port of `voxgig/struct` + +Read the repo-root [`AGENTS.md`](../AGENTS.md) first. This file covers only +what is specific to the Clojure port. **TypeScript is canonical; the shared +`build/test/*.jsonic` corpus is the contract.** This port is a faithful +translation of the canonical implementation (modelled most closely on the +Python port, which shares Clojure's single-`nil` world). + +## How to build / test / lint + +``` +cd clojure +make test # clojure -M:test — runs build/test/test.json through the port +make lint # compiles the library + runner namespaces (a clean load = pass) +``` + +Requires the Clojure CLI (`clojure`/`clj`) and a JDK on `PATH`. The library +itself has **zero third-party runtime dependencies**; the test runner reads +the corpus with a small in-tree JSON reader (no JSON library). + +## The one thing to understand: nodes are mutable Java collections + +The canonical algorithm assumes nodes are **mutable and reference-stable**: +`walk`, `merge`, `inject`, `transform`, `validate` and the `Injection` +state machine mutate nodes in place and rely on shared references. Idiomatic +immutable Clojure maps/vectors cannot model that without rewriting the +algorithm, which would break uniformity. So this port represents nodes with: + +- **maps → `java.util.LinkedHashMap`** (insertion-ordered, like a JS object), +- **lists → `java.util.ArrayList`** (mutable, reference-stable). + +`ismap`/`islist`/`isnode` test `java.util.Map`/`java.util.List`. All node- +creating code (`{}`/`[]` in the canonical) builds `LinkedHashMap`/`ArrayList` +via the private `lhm`/`alist` helpers. **Never** introduce a persistent +Clojure map/vector as a *node* — only as a short-lived read-only intermediate. + +## `nil` is both `undefined` and JSON `null` + +Like Python, Clojure has only `nil`. The canonical `undefined` (absent) and +JSON `null` both map to `nil`. The Group A/B rules (see +[`design/UNDEF_SPEC.md`](../design/UNDEF_SPEC.md)) recover the distinction +where it matters: + +- Group A readers (`getprop`, `getelem`, `haskey`, `isnode`, `isempty`) + treat a stored `nil` as "no value". +- Group B processors (`setprop`, `clone`, `merge`, `walk`, `inject`, …) + preserve `nil` literally. `_lookup` is the internal raw reader. + +A few functions distinguish "no argument supplied" from `nil` via the public +`NOARG` sentinel (mirrors Python's `_ABSENT`): `typify` (→ `T_noval` vs +`T_null`), `stringify` (→ `""` vs `"null"`), `pathify`. + +## Naming + +Public function names are **lower-smushed, exactly the canonical names** +(`getpath`, `getprop`, `ismap`, `isnode`, `setpath`, `checkPlacement`, +`re_find_all`, …) so the case/underscore-insensitive parity check in +`tools/check_parity.py` matches them directly. The namespace `:refer-clojure +:exclude`s `merge`, `filter`, `flatten` and `replace` to reuse those names. + +## Gotchas + +- **Identity markers.** `SKIP` and `DELETE` are specific `LinkedHashMap` + instances; compare with `identical?` (never `=`). +- **The `Injection` is a distinct type** (`deftype Inj` over a mutable + `HashMap`), so it is never mistaken for a data map by `ismap`. Access its + fields only through the internal `ig`/`is!` helpers. +- **Numbers.** JSON integers parse to `Long`, decimals to `Double`. `typify` + splits integer/decimal on that; `stringify`/`jsonify` follow JS number + formatting (an integral `Double` prints without `.0`). +- **Keep `make test` and `python3 tools/check_parity.py` green**, and add no + runtime dependencies. If you change canonical behaviour, change the + TypeScript + corpus first, then propagate here. diff --git a/clojure/DOCS.md b/clojure/DOCS.md new file mode 100644 index 00000000..62f14440 --- /dev/null +++ b/clojure/DOCS.md @@ -0,0 +1,114 @@ +# Clojure port — comprehensive guide + +This document covers the Clojure-specific details of `voxgig/struct`. For the +language-neutral concepts, tutorial and full reference, read the top-level +[`DOCS.md`](../DOCS.md); for the user overview, [`README.md`](./README.md). +TypeScript is canonical and the shared `build/test` corpus is the contract. + +## Installation + +Add the Clojure source to your project (Clojars coordinates are published per +release) or depend on this directory directly via a local `deps.edn` `:paths` +entry. Then `(require '[voxgig.struct :as s])`. + +Requirements: a JDK and the Clojure CLI. No third-party runtime dependencies. + +## Representation of data + +| JSON-shape thing | Clojure representation | +|-------------------------|----------------------------------------------| +| object / map | `java.util.LinkedHashMap` (insertion order) | +| array / list | `java.util.ArrayList` | +| string | `java.lang.String` | +| integer | `java.lang.Long` | +| decimal | `java.lang.Double` | +| boolean | `java.lang.Boolean` | +| JSON `null` / undefined | `nil` | +| function (commands) | a Clojure fn (`fn?`) | + +Nodes are **mutable and reference-stable** on purpose: the canonical +algorithms (`merge`, `walk`, `inject`, `transform`, `validate`) mutate nodes +in place and depend on shared references. Build nodes with `LinkedHashMap` / +`ArrayList` (or the `jm` / `jt` helpers); do not hand the library a persistent +Clojure map or vector as a node. + +### `nil`: undefined vs JSON null + +Clojure has a single `nil`, used for both the canonical `undefined` and JSON +`null`. The library follows the Group A / Group B rules +([`design/UNDEF_SPEC.md`](../design/UNDEF_SPEC.md)): + +- **Group A** readers — `getprop`, `getelem`, `haskey`, `isnode`, `isempty` — + treat a stored `nil` as "no value" (it yields the default / `false`). +- **Group B** processors — `setprop`, `clone`, `merge`, `walk`, `inject`, + `transform`, `validate`, `select` — preserve `nil` literally. + +Where a function must tell "no argument" from an explicit `nil`, pass the +public `NOARG` sentinel (this mirrors the absent/undefined case): + +```clojure +(s/typify) ;=> T_noval (no argument = undefined) +(s/typify nil) ;=> T_scalar|T_null +(s/stringify) ;=> "" (undefined) +(s/stringify nil) ;=> "null" (JSON null) +(s/pathify s/NOARG) ;=> "" +``` + +## The public API + +Names are lower-smushed, identical to the canonical export list: + +- **Lookups / paths:** `getpath`, `setpath`, `getprop`, `setprop`, `getelem`, + `delprop`, `haskey`, `keysof`, `items`. +- **Predicates / kinds:** `isnode`, `ismap`, `islist`, `iskey`, `isfunc`, + `isempty`, `typify`, `typename`. +- **Values:** `clone`, `merge`, `walk`, `size`, `slice`, `pad`, `flatten`, + `filter`, `getdef`, `strkey`. +- **Strings / formatting:** `stringify`, `jsonify`, `pathify`, `join`, + `escre`, `escurl`. +- **Regex (RE2-subset uniform API):** `re_compile`, `re_find`, `re_find_all`, + `re_replace`, `re_test`, `re_escape`. +- **By-example engine:** `inject`, `transform`, `validate`, `select`, plus the + injector helpers `checkPlacement`, `injectorArgs`, `injectChild`. +- **Builders / markers:** `jm`, `jt`, `SKIP`, `DELETE`, and the `T_*` / + `M_*` constants. + +`struct-utility` returns a map of every public function, mirroring the +`StructUtility` container in the other ports. + +## Examples + +```clojure +(require '[voxgig.struct :as s]) + +;; merge (later wins; the first node is modified in place) +(s/merge (s/jt (s/jm "a" 1) (s/jm "b" 2))) ;=> {a 1, b 2} + +;; transform: spec mirrors the desired output, backticks pull from data +(s/transform (s/jm "name" "alice") + (s/jm "user" (s/jm "id" "`name`"))) ;=> {user {id alice}} + +;; validate: plain values are typed defaults; `$STRING` etc. are commands +(s/validate (s/jm "a" "x") (s/jm "a" "`$STRING`")) ;=> {a x} + +;; select: MongoDB-style query over children +(s/select (s/jt (s/jm "a" 1) (s/jm "a" 2)) + (s/jm "a" (s/jm "`$GT`" 1))) ;=> ({a 2, $KEY 1}) +``` + +## Testing + +`make test` runs the entire shared corpus (`../build/test/test.json`) through +the port via an in-tree JSON reader and the same runner logic as every other +port. Keep it green, keep `python3 ../tools/check_parity.py` green, and add no +runtime dependencies. + +## Implementation notes + +- The injection state is a distinct `deftype Inj` (over a mutable `HashMap`) + so it is never confused with a data map. +- `SKIP` / `DELETE` are identity markers — compared with `identical?`. +- Numbers follow JS formatting in `stringify` / `jsonify` (an integral + `Double` prints without a trailing `.0`). +- The `voxgig.struct` namespace `:refer-clojure :exclude`s `merge`, `filter`, + `flatten` and `replace` to reuse those canonical names. diff --git a/clojure/Makefile b/clojure/Makefile new file mode 100644 index 00000000..0c4af070 --- /dev/null +++ b/clojure/Makefile @@ -0,0 +1,31 @@ +# Makefile for the Clojure port of voxgig/struct. +# Requires the Clojure CLI (`clojure` / `clj`) and a JDK on PATH. + +.PHONY: test lint build inspect clean reset publish + +# Run the shared JSON corpus through the Clojure implementation. +test: + clojure -M:test + +# "Lint": compile the library + runner namespaces. A clean load means the +# code is syntactically and structurally sound. (No third-party linter is +# required; clj-kondo can be added to the :lint alias if available.) +lint: + clojure -M:lint -e "(require 'voxgig.struct :reload) (require 'voxgig.struct-runner :reload) (println \"ok\")" + +build: + clojure -M -e "(compile 'voxgig.struct)" 2>/dev/null || clojure -M -e "(require 'voxgig.struct)" + +inspect: + @clojure --version 2>/dev/null || true + @java -version 2>&1 | head -1 + +clean: + rm -rf .cpcache classes target + +reset: clean + +# The library publishes to Clojars; this target creates the git tag. Set up +# Clojars credentials (CLOJARS_USERNAME / CLOJARS_PASSWORD) for a real deploy. +publish: + @echo "clojure: publish via Clojars (deps-deploy) + git tag clojure/vX.Y.Z" diff --git a/clojure/README.md b/clojure/README.md new file mode 100644 index 00000000..de8a9749 --- /dev/null +++ b/clojure/README.md @@ -0,0 +1,79 @@ +# @voxgig/struct — Clojure + +A Clojure port of [`voxgig/struct`](../README.md): one small, fixed API for +manipulating JSON-shaped data — lookups, deep merge, by-example transform, +by-example validate, tree walk, path get/set, selection — that returns the +**same answer** as the canonical TypeScript implementation and every other +port. The behavioural contract is the shared JSON corpus in +[`build/test/`](../build/test); this port passes it in full. + +## Status + +Complete. Every canonical public function is implemented and the entire +shared corpus passes (`make test`). Zero third-party runtime dependencies. + +## Requirements + +- A JDK (Java 11+). +- The [Clojure CLI](https://clojure.org/guides/install_clojure) + (`clojure` / `clj`). + +## Use + +The library lives in the `voxgig.struct` namespace: + +```clojure +(require '[voxgig.struct :as s]) + +;; Build nodes with the mutable Java collections the library operates on. +(def store + (doto (java.util.LinkedHashMap.) + (.put "a" (doto (java.util.LinkedHashMap.) (.put "b" 2))))) + +(s/getpath store "a.b") ;=> 2 +(s/stringify (s/transform + (doto (java.util.LinkedHashMap.) (.put "a" 1)) + (doto (java.util.LinkedHashMap.) (.put "x" "`a`")))) ;=> "{x:1}" +``` + +`jm` / `jt` are convenient JSON-object / JSON-array builders: + +```clojure +(s/jsonify (s/jm "a" 1 "b" (s/jt 2 3))) +``` + +### Data model + +Nodes are mutable Java collections so the library's in-place, reference-stable +algorithms work exactly as in the canonical TypeScript: + +- maps → `java.util.LinkedHashMap` (insertion-ordered), +- lists → `java.util.ArrayList`, +- `nil` plays the role of both `undefined` and JSON `null` (the Group A/B + rules recover the distinction — see + [`design/UNDEF_SPEC.md`](../design/UNDEF_SPEC.md)). + +## API + +The public surface matches the canonical export list, in lower-smushed names: + +`clone delprop escre escurl filter flatten getdef getelem getpath getprop +haskey inject isempty isfunc iskey islist ismap isnode items join jsonify +keysof merge pad pathify select setpath setprop size slice strkey stringify +transform typify typename validate walk re_compile re_find re_find_all +re_replace re_test re_escape jm jt checkPlacement injectorArgs injectChild` + +See [`DOCS.md`](./DOCS.md) for the full guide and +[the language-neutral docs](../DOCS.md) for concepts and examples. + +## Develop + +``` +make test # run the shared corpus +make lint # compile the namespaces +make inspect # toolchain versions +``` + +## License + +MIT. See [`../LICENSE`](../LICENSE). diff --git a/clojure/deps.edn b/clojure/deps.edn new file mode 100644 index 00000000..151d63e9 --- /dev/null +++ b/clojure/deps.edn @@ -0,0 +1,8 @@ +{:paths ["src"] + :deps {org.clojure/clojure {:mvn/version "1.12.5"}} + :aliases + {:test + {:extra-paths ["test"] + :main-opts ["-m" "voxgig.struct-runner"]} + :lint + {:extra-paths ["test"]}}} diff --git a/clojure/src/voxgig/struct.clj b/clojure/src/voxgig/struct.clj new file mode 100644 index 00000000..dc84bd82 --- /dev/null +++ b/clojure/src/voxgig/struct.clj @@ -0,0 +1,1734 @@ +;; Copyright (c) 2025-2026 Voxgig Ltd. MIT LICENSE. +;; +;; Voxgig Struct +;; ============= +;; +;; Utility functions to manipulate in-memory JSON-like data structures. +;; This Clojure version is a faithful port of the canonical TypeScript +;; implementation (typescript/src/StructUtility.ts), following the same +;; "by-example" design and logic. To preserve the reference-stable, in-place +;; mutation semantics the algorithm depends on, nodes are represented by +;; mutable Java collections: java.util.LinkedHashMap for maps (insertion +;; ordered, like a JS object) and java.util.ArrayList for lists. The Clojure +;; `nil` plays the role of both the canonical `undefined` and JSON `null` +;; (Group A/B rules, per design/UNDEF_SPEC.md, recover the distinction where +;; it matters). The library has zero third-party runtime dependencies. + +(ns voxgig.struct + (:refer-clojure :exclude [merge filter flatten replace])) + +(import '(java.util LinkedHashMap ArrayList List Map) + '(java.util.regex Pattern Matcher)) + +;; --------------------------------------------------------------------------- +;; String / mode / type constants +;; --------------------------------------------------------------------------- + +(def ^:const S-MKEYPRE "key:pre") +(def ^:const S-MKEYPOST "key:post") +(def ^:const S-MVAL "val") +(def ^:const S-MKEY "key") + +(def ^:const M_KEYPRE 1) +(def ^:const M_KEYPOST 2) +(def ^:const M_VAL 4) + +(def MODENAME {M_VAL "val" M_KEYPRE "key:pre" M_KEYPOST "key:post"}) +(def ^:private MODE-TO-NUM {S-MKEYPRE M_KEYPRE S-MKEYPOST M_KEYPOST S-MVAL M_VAL}) +(def ^:private PLACEMENT {M_VAL "value" M_KEYPRE S-MKEY M_KEYPOST S-MKEY}) + +(def ^:const S-DKEY "$KEY") +(def ^:const S-BANNO "`$ANNO`") +(def ^:const S-DTOP "$TOP") +(def ^:const S-DERRS "$ERRS") +(def ^:const S-DSPEC "$SPEC") +(def ^:const S-BEXACT "`$EXACT`") +(def ^:const S-BVAL "`$VAL`") +(def ^:const S-BKEY "`$KEY`") + +(def ^:const S-MT "") +(def ^:const S-BT "`") +(def ^:const S-DS "$") +(def ^:const S-DT ".") +(def ^:const S-CM ",") +(def ^:const S-CN ":") +(def ^:const S-FS "/") +(def ^:const S-KEY "KEY") +(def ^:const S-VIZ ": ") + +(def ^:const S-string "string") +(def ^:const S-number "number") +(def ^:const S-integer "integer") +(def ^:const S-decimal "decimal") +(def ^:const S-boolean "boolean") +(def ^:const S-null "null") +(def ^:const S-nil "nil") +(def ^:const S-map "map") +(def ^:const S-list "list") +(def ^:const S-object "object") +(def ^:const S-function "function") +(def ^:const S-instance "instance") +(def ^:const S-any "any") +(def ^:const S-scalar "scalar") +(def ^:const S-node "node") +(def ^:const S-base "base") + +;; Type bit flags (mirroring the canonical TypeScript layout exactly). +(def ^:const T_any (- (bit-shift-left 1 31) 1)) +(def ^:const T_noval (bit-shift-left 1 30)) +(def ^:const T_boolean (bit-shift-left 1 29)) +(def ^:const T_decimal (bit-shift-left 1 28)) +(def ^:const T_integer (bit-shift-left 1 27)) +(def ^:const T_number (bit-shift-left 1 26)) +(def ^:const T_string (bit-shift-left 1 25)) +(def ^:const T_function (bit-shift-left 1 24)) +(def ^:const T_symbol (bit-shift-left 1 23)) +(def ^:const T_null (bit-shift-left 1 22)) +(def ^:const T_list (bit-shift-left 1 14)) +(def ^:const T_map (bit-shift-left 1 13)) +(def ^:const T_instance (bit-shift-left 1 12)) +(def ^:const T_scalar (bit-shift-left 1 7)) +(def ^:const T_node (bit-shift-left 1 6)) + +(def ^:private TYPENAME + [S-any S-nil S-boolean S-decimal S-integer S-number S-string S-function + "symbol" S-null "" "" "" "" "" "" "" S-list S-map S-instance + "" "" "" "" S-scalar S-node]) + +;; Private markers (compared by identity). +(def SKIP (doto (LinkedHashMap.) (.put "`$SKIP`" true))) +(def DELETE (doto (LinkedHashMap.) (.put "`$DELETE`" true))) + +(def ^:const MAXDEPTH 32) + +;; Path processing regexes. +(def ^:private R-META-PATH (Pattern/compile "^([^$]+)\\$([=~])(.+)$")) +(def ^:private R-DOUBLE-DOLLAR (Pattern/compile "\\$\\$")) +(def ^:private R-INJECT-FULL (Pattern/compile "^`(\\$[A-Z]+|[^`]*)[0-9]*`$")) +(def ^:private R-INJECT-PART (Pattern/compile "`([^`]*)`")) +(def ^:private R-TRANSFORM-NAME (Pattern/compile "`\\$([A-Z]+)`")) + +;; --------------------------------------------------------------------------- +;; Mutable-collection helpers +;; --------------------------------------------------------------------------- + +(defn- lhm ^LinkedHashMap [] (LinkedHashMap.)) +(defn- alist ^ArrayList [] (ArrayList.)) + +(defn- alist-of ^ArrayList [coll] + (let [a (ArrayList.)] + (doseq [x coll] (.add a x)) + a)) + +;; The injection state object. Distinct type so it is never mistaken for a +;; data map. Backed by a mutable HashMap of keyword -> value. +(deftype Inj [^java.util.HashMap m]) + +(defn- inj? [x] (instance? Inj x)) +(defn- ig [^Inj inj k] (.get ^java.util.HashMap (.-m inj) k)) +(defn- is! [^Inj inj k v] (.put ^java.util.HashMap (.-m inj) k v) v) + +;; Forward declarations. +(declare getprop getelem setprop delprop isnode ismap islist iskey isfunc + isempty keysof items size slice clone typify typename stringify + pathify join merge walk getpath setpath inject _injectstr _lookup + strkey flatten filter getdef haskey escre + re_compile re_find re_find_all re_replace re_test + _injecthandler _validatehandler _invalidTypeMsg + inj-descend inj-child inj-setval + checkPlacement injectorArgs injectChild + validate transform select jsonify FORMATTER) + +;; --------------------------------------------------------------------------- +;; Low-level numeric / key helpers +;; --------------------------------------------------------------------------- + +(defn- jbool? [v] (instance? Boolean v)) +(defn- jdouble? [v] (or (instance? Double v) (instance? Float v))) +(defn- jint? [v] (and (number? v) (not (jbool? v)) (not (jdouble? v)))) + +(defn- parse-long-strict + "Mirror Python int(key): coerce numbers (floor), parse integer strings." + [k] + (cond + (jbool? k) nil + (jint? k) (long k) + (jdouble? k) (long (Math/floor (double k))) + (string? k) (try (Long/parseLong (.trim ^String k)) (catch Exception _ nil)) + :else nil)) + +;; --------------------------------------------------------------------------- +;; Minor utilities +;; --------------------------------------------------------------------------- + +(defn isnode [val] (or (instance? Map val) (instance? List val))) +(defn ismap [val] (instance? Map val)) +(defn islist [val] (instance? List val)) + +(defn iskey [key] + (cond + (string? key) (pos? (count key)) + (jbool? key) false + (number? key) true + :else false)) + +(defn isfunc [val] (fn? val)) + +(defn getdef [val alt] (if (nil? val) alt val)) + +(defn- map-keys + "Insertion-ordered keys of a Java Map (as the stored key objects)." + [^Map m] (seq (.keySet m))) + +(defn keysof [val] + (cond + (not (isnode val)) [] + (ismap val) (vec (sort (map str (map-keys val)))) + :else (mapv str (range (.size ^List val))))) + +(defn size [val] + (cond + (nil? val) 0 + (islist val) (.size ^List val) + (ismap val) (.size ^Map val) + (string? val) (count val) + (jbool? val) (if val 1 0) + (number? val) (long (Math/floor (double val))) + :else 0)) + +(defn strkey + ([] S-MT) + ([key] + (cond + (nil? key) S-MT + (string? key) key + (jbool? key) S-MT + (jint? key) (str (long key)) + (jdouble? key) (str (long (double key))) + (number? key) (str key) + :else S-MT))) + +(defn isempty [val] + (cond + (nil? val) true + (= val S-MT) true + (and (islist val) (zero? (.size ^List val))) true + (and (ismap val) (zero? (.size ^Map val))) true + :else false)) + +(defn- clz32 [n] + (if (<= (long n) 0) 32 (Integer/numberOfLeadingZeros (unchecked-int (long n))))) + +(defn typename [t] (getelem TYPENAME (clz32 t) (nth TYPENAME 0))) + +(def ^:private TYPIFY-NOARG (Object.)) +(def NOARG TYPIFY-NOARG) + +(defn typify + ([] T_noval) + ([value] + (cond + (identical? value TYPIFY-NOARG) T_noval + (nil? value) (bit-or T_scalar T_null) + (jbool? value) (bit-or T_scalar T_boolean) + (jint? value) (bit-or T_scalar T_number T_integer) + (jdouble? value) (if (Double/isNaN (double value)) + T_noval + (bit-or T_scalar T_number T_decimal)) + (number? value) (bit-or T_scalar T_number T_integer) + (string? value) (bit-or T_scalar T_string) + (isfunc value) (bit-or T_scalar T_function) + (islist value) (bit-or T_node T_list) + (ismap value) (bit-or T_node T_map) + :else (bit-or T_node T_instance)))) + +(defn getelem + ([val key] (getelem val key nil)) + ([val key alt] + (let [out (atom nil)] + (if (or (nil? val) (nil? key)) + alt + (do + (when (islist val) + (let [ks (str key)] + (when (re-matches #"-?[0-9]+" ks) + (let [len (.size ^List val) + nk0 (Long/parseLong ks) + nk (if (neg? nk0) (+ len nk0) nk0)] + (when (and (<= 0 nk) (< nk len)) + (reset! out (.get ^List val (int nk)))))))) + (if (nil? @out) + (if (isfunc alt) (alt) alt) + @out)))))) + +(defn getprop + ([val key] (getprop val key nil)) + ([val key alt] + (if (or (nil? val) (nil? key)) + alt + (let [out (cond + (ismap val) (let [skey (str key)] + (if (.containsKey ^Map val skey) + (.get ^Map val skey) alt)) + (islist val) (let [ki (parse-long-strict key)] + (if (and ki (<= 0 ki) (< ki (.size ^List val))) + (.get ^List val (int ki)) alt)) + :else alt)] + (if (nil? out) alt out))))) + +(defn- _lookup [val key] + (cond + (or (nil? val) (nil? key)) nil + (ismap val) (let [skey (str key)] + (if (.containsKey ^Map val skey) (.get ^Map val skey) nil)) + (islist val) (let [ki (parse-long-strict key)] + (if (and ki (<= 0 ki) (< ki (.size ^List val))) + (.get ^List val (int ki)) nil)) + :else nil)) + +(defn haskey + ([val] (haskey val nil)) + ([val key] (some? (getprop val key)))) + +(defn items + ([val] (items val nil)) + ([val apply] + (if-not (isnode val) + [] + (let [ks (keysof val) + out (mapv (fn [k] + [k (if (ismap val) + (.get ^Map val k) + (.get ^List val (int (Long/parseLong k))))]) + ks)] + (if apply (mapv apply out) out))))) + +(defn flatten + ([lst] (flatten lst 1)) + ([lst depth] + (let [depth (if (nil? depth) 1 depth)] + (if-not (islist lst) + lst + (let [out (alist)] + (doseq [item lst] + (if (and (islist item) (> depth 0)) + (doseq [x (flatten item (dec depth))] (.add out x)) + (.add out item))) + out))))) + +(defn filter [val check] + (let [all (items val) + out (alist)] + (doseq [it all] (when (check it) (.add out (nth it 1)))) + out)) + +(defn setprop [parent key val] + (when (iskey key) + (cond + (ismap parent) (.put ^Map parent (str key) val) + (islist parent) + (let [ki (parse-long-strict key)] + (when ki + (let [^List p parent len (.size p)] + (if (>= ki 0) + (let [ki (min ki len)] + (if (>= ki len) (.add p val) (.set p (int ki) val))) + (.add p 0 val))))))) + parent) + +(defn delprop [parent key] + (when (iskey key) + (cond + (ismap parent) (.remove ^Map parent (str key)) + (islist parent) + (let [ki (parse-long-strict key)] + (when ki + (let [^List p parent] + (when (and (<= 0 ki) (< ki (.size p))) + (.remove p (int ki)))))))) + parent) + +(defn slice + ([val] (slice val nil nil false)) + ([val start] (slice val start nil false)) + ([val start end] (slice val start end false)) + ([val start end mutate] + (cond + (and (number? val) (not (jbool? val))) + (let [lo start + hi (when (some? end) (dec (long end)))] + (cond + (and (some? hi) (> (double val) (double hi))) hi + (and (some? lo) (< (double val) (double lo))) lo + :else val)) + + (or (islist val) (string? val)) + (let [vlen (size val) + start (if (and (nil? start) (some? end)) 0 start)] + (if (nil? start) + val + (let [[start end] + (cond + (< start 0) [0 (let [e (+ vlen start)] (if (< e 0) 0 e))] + (some? end) [start (cond (< end 0) (let [e (+ vlen end)] (if (< e 0) 0 e)) + (< vlen end) vlen + :else end)] + :else [start vlen]) + start (if (< vlen start) vlen start)] + (if (and (> start -1) (<= start end) (<= end vlen)) + (cond + (and (islist val) mutate) + (let [^List p val] + (loop [i 0 j start] + (when (< j end) (.set p i (.get p j)) (recur (inc i) (inc j)))) + (while (> (.size p) (- end start)) (.remove p (int (dec (.size p))))) + p) + (islist val) (alist-of (subvec (vec val) start end)) + (string? val) (subs val start end) + :else val) + (cond + (and (islist val) mutate) (let [^List p val] (.clear p) p) + (islist val) (alist) + (string? val) S-MT + :else val))))) + :else val))) + +;; --------------------------------------------------------------------------- +;; Regex utility (uniform re_* API) +;; --------------------------------------------------------------------------- + +(defn- ->pattern ^Pattern [p] + (if (instance? Pattern p) p (Pattern/compile (str p)))) + +(defn re_compile + ([p] (->pattern p)) + ([p _flags] (->pattern p))) + +(defn- match-groups [^Matcher m] + (vec (for [i (range (inc (.groupCount m)))] + (let [g (.group m (int i))] (if (nil? g) "" g))))) + +(defn re_find [p input] + (let [m (.matcher (->pattern p) input)] + (when (.find m) (match-groups m)))) + +(defn re_find_all [p input] + (let [m (.matcher (->pattern p) input) out (alist)] + (while (.find m) + (.add out (match-groups m)) + (when (= "" (.group m)) )) + out)) + +(defn re_test [p input] (.find (.matcher (->pattern p) input))) + +(defn re_replace [p input replacement] + (let [m (.matcher (->pattern p) input) sb (StringBuffer.)] + (if (isfunc replacement) + (do (while (.find m) + (.appendReplacement m sb (Matcher/quoteReplacement (str (replacement (match-groups m)))))) + (.appendTail m sb) + (.toString sb)) + ;; String replacement: translate $& -> $0 (Java group ref); leave $1.. as-is. + (let [jrepl (clojure.string/replace (str replacement) "$&" "$0")] + (.replaceAll (.matcher (->pattern p) input) jrepl))))) + +(defn escre [s] + (let [s (if (nil? s) S-MT s)] + (re_replace (Pattern/compile "[.*+?^${}()|\\[\\]\\\\]") s + (fn [g] (str "\\" (nth g 0)))))) + +(defn re_escape [s] (escre s)) + +(def ^:private URL-UNRESERVED + (set (concat (map char (range (int \A) (inc (int \Z)))) + (map char (range (int \a) (inc (int \z)))) + (map char (range (int \0) (inc (int \9)))) + [\- \_ \. \! \~ \* \' \( \)]))) + +(defn escurl + "Escape a URL component, matching JS encodeURIComponent." + [s] + (let [s (if (nil? s) S-MT (str s)) + sb (StringBuilder.)] + (doseq [b (.getBytes ^String s "UTF-8")] + (let [c (char (bit-and b 0xff))] + (if (contains? URL-UNRESERVED c) + (.append sb c) + (.append sb (format "%%%02X" (bit-and b 0xff)))))) + (.toString sb))) + +;; --------------------------------------------------------------------------- +;; JSON-ish serialization (stringify / jsonify) and clone +;; --------------------------------------------------------------------------- + +(defn- num->json [v] + (cond + (jdouble? v) (let [d (double v)] + (cond + (or (Double/isNaN d) (Double/isInfinite d)) "null" + (== d (Math/floor d)) (str (long d)) + :else (str d))) + :else (str v))) + +(defn- esc-json-str [^String s] + (let [sb (StringBuilder.)] + (.append sb \") + (doseq [c s] + (cond + (= c \") (.append sb "\\\"") + (= c \\) (.append sb "\\\\") + (= c \newline) (.append sb "\\n") + (= c \return) (.append sb "\\r") + (= c \tab) (.append sb "\\t") + (< (int c) 32) (.append sb (format "\\u%04x" (int c))) + :else (.append sb c))) + (.append sb \") + (.toString sb))) + +(defn- json-encode + "Encode val as JSON. opts: :sort? sort map keys; :indent (nil=compact)." + [val opts] + (let [{:keys [sort? indent]} opts] + (letfn [(enc [v level] + (cond + (nil? v) "null" + (jbool? v) (if v "true" "false") + (number? v) (num->json v) + (string? v) (esc-json-str v) + (isfunc v) "null" + (islist v) + (let [items (vec v)] + (if (empty? items) + "[]" + (if indent + (let [pad (apply str (repeat (* indent (inc level)) " ")) + cpad (apply str (repeat (* indent level) " "))] + (str "[\n" (clojure.string/join ",\n" + (map #(str pad (enc % (inc level))) items)) + "\n" cpad "]")) + (str "[" (clojure.string/join "," (map #(enc % (inc level)) items)) "]")))) + (ismap v) + (let [ks (let [k (vec (map str (map-keys v)))] (if sort? (vec (sort k)) k))] + (if (empty? ks) + "{}" + (if indent + (let [pad (apply str (repeat (* indent (inc level)) " ")) + cpad (apply str (repeat (* indent level) " "))] + (str "{\n" (clojure.string/join ",\n" + (map #(str pad (esc-json-str %) ": " (enc (.get ^Map v %) (inc level))) ks)) + "\n" cpad "}")) + (str "{" (clojure.string/join "," + (map #(str (esc-json-str %) ":" (enc (.get ^Map v %) (inc level))) ks)) + "}")))) + :else (esc-json-str (str v))))] + (enc val 0)))) + +(defn pad + ([s] (pad s nil nil)) + ([s padding] (pad s padding nil)) + ([s padding padchar] + (let [s (if (nil? s) "null" (if (string? s) s (stringify s))) + padding (if (nil? padding) 44 padding) + padchar (if (nil? padchar) " " (subs (str padchar " ") 0 1))] + (if (> padding -1) + (let [n (- padding (count s))] + (if (> n 0) (str s (apply str (repeat n padchar))) s)) + (let [n (- (- padding) (count s))] + (if (> n 0) (str (apply str (repeat n padchar)) s) s)))))) + +(defn stringify + ([] S-MT) + ([val] (stringify val nil nil)) + ([val maxlen] (stringify val maxlen nil)) + ([val maxlen pretty] + (let [pretty (boolean pretty) + valstr (if (string? val) + val + (try + (json-encode val {:sort? true}) + (catch Throwable _ "__STRINGIFY_FAILED__"))) + ;; detect cyclic / failed encode already returns marker via exception only + valstr (if (string? val) val (clojure.string/replace valstr "\"" "")) + valstr (if (and (some? maxlen) (> maxlen -1)) + (let [js (subs valstr 0 (min maxlen (count valstr)))] + (if (< maxlen (count valstr)) (str (subs js 0 (- maxlen 3)) "...") valstr)) + valstr)] + (if pretty + (let [colors [81 118 213 39 208 201 45 190 129 51 160 121 226 33 207 69] + c (mapv #(str "[38;5;" % "m") colors) + r ""] + (loop [chs (seq valstr) d 0 o (nth c 0) t (nth c 0)] + (if (empty? chs) + (str t r) + (let [ch (first chs)] + (cond + (or (= ch \{) (= ch \[)) + (let [d (inc d) o (nth c (mod d (count c)))] + (recur (rest chs) d o (str t o ch))) + (or (= ch \}) (= ch \])) + (let [t (str t o ch) d (dec d) o (nth c (mod d (count c)))] + (recur (rest chs) d o t)) + :else (recur (rest chs) d o (str t o ch))))))) + valstr)))) + +;; Re-do stringify cyclic detection: json-encode can recurse infinitely on a +;; self-referential map. Guard by catching StackOverflowError above (Throwable). + +(defn clone [val] + (cond + (nil? val) nil + (ismap val) (let [o (lhm)] (doseq [k (map-keys val)] (.put o k (clone (.get ^Map val k)))) o) + (islist val) (let [a (alist)] (doseq [x val] (.add a (clone x))) a) + :else val)) + +(defn jsonify + ([val] (jsonify val nil)) + ([val flags] + (if (nil? val) + S-null + (let [indent (getprop flags "indent" 2) + json-str (try + (if (and indent (> indent 0)) + (json-encode val {:indent indent}) + (json-encode val {})) + (catch Throwable _ S-null)) + offset (getprop flags "offset" 0)] + (if (and json-str (> offset 0)) + (let [lines (clojure.string/split-lines json-str) + padded (map (fn [n] (pad (nth n 1) (- (- offset) (size (nth n 1))))) (items (alist-of (rest lines))))] + (str "{\n" (clojure.string/join "\n" padded))) + (or json-str S-null)))))) + +;; --------------------------------------------------------------------------- +;; join / pathify +;; --------------------------------------------------------------------------- + +(defn join + ([arr] (join arr nil nil)) + ([arr sep] (join arr sep nil)) + ([arr sep url] + (if-not (islist arr) + S-MT + (let [sepdef (if (or (nil? sep)) S-CM sep) + sepre (if (= 1 (size sepdef)) (escre sepdef) nil) + sarr (size arr) + filtered (keep-indexed (fn [i s] (when (and (string? s) (not= s S-MT)) [i s])) arr) + result (alist)] + (doseq [[idx s0] filtered] + (let [s (if (and sepre (not= sepre S-MT)) + (cond + (and url (= idx 0)) + (re_replace (Pattern/compile (str sepre "+$")) s0 (fn [_] S-MT)) + :else + (let [s (if (> idx 0) + (re_replace (Pattern/compile (str "^" sepre "+")) s0 (fn [_] S-MT)) + s0) + s (if (or (< idx (dec sarr)) (not url)) + (re_replace (Pattern/compile (str sepre "+$")) s (fn [_] S-MT)) + s)] + (re_replace (Pattern/compile (str "([^" sepre "])" sepre "+([^" sepre "])")) + s (fn [g] (str (nth g 1) sepdef (nth g 2)))))) + s0)] + (when (not= s S-MT) (.add result s)))) + (clojure.string/join sepdef (vec result)))))) + +(defn joinurl [sarr] (join sarr "/" true)) + +(defn replace [s from to] + (let [ts (typify s) + rs (cond + (zero? (bit-and T_string ts)) (stringify s) + (pos? (bit-and (bit-or T_noval T_null) ts)) S-MT + :else (stringify s))] + (if (string? from) + (clojure.string/replace rs from (str to)) + (re_replace from rs (str to))))) + +(defn pathify + ([] (pathify TYPIFY-NOARG nil nil)) + ([val] (pathify val nil nil)) + ([val startin] (pathify val startin nil)) + ([val startin endin] + (let [absent? (identical? val TYPIFY-NOARG) + val (if absent? nil val) + path (cond (islist val) (vec val) + (iskey val) [val] + :else nil) + start (cond (nil? startin) 0 (> startin -1) startin :else 0) + end (cond (nil? endin) 0 (> endin -1) endin :else 0) + pathstr + (when (and (some? path) (>= start 0)) + (let [path (subvec path (min start (count path)) (max 0 (- (count path) end)))] + (if (zero? (count path)) + "" + (let [fp (clojure.core/filter iskey path) + mapped (map (fn [p] + (if (and (number? p) (not (jbool? p))) + (str (long p)) + (clojure.string/replace (str p) "." S-MT))) + fp)] + (clojure.string/join S-DT mapped)))))] + (if (nil? pathstr) + (str "") + pathstr)))) + +;; --------------------------------------------------------------------------- +;; walk / merge +;; --------------------------------------------------------------------------- + +(defn walk + ([val] (walk val {})) + ([val arg] + (let [{:keys [before after maxdepth key parent path pool]} (if (map? arg) arg {:after arg}) + pool (if (nil? pool) (doto (alist) (.add (alist))) pool) + path (if (nil? path) (.get ^List pool 0) path) + depth (.size ^List path) + out (if (nil? before) val (before key val parent path)) + md (if (and (some? maxdepth) (>= maxdepth 0)) maxdepth MAXDEPTH)] + (if (or (= md 0) (and (> md 0) (<= md depth))) + out + (do + (when (isnode out) + (let [child-depth (inc depth)] + (while (<= (.size ^List pool) child-depth) + (.add ^List pool (alist-of (repeat (.size ^List pool) nil)))) + (let [^List child-path (.get ^List pool child-depth)] + (dotimes [i depth] (.set child-path (int i) (.get ^List path (int i)))) + (doseq [[ckey child] (items out)] + (.set child-path (int depth) (str ckey)) + (let [result (walk child {:before before :after after :maxdepth md + :key ckey :parent out :path child-path :pool pool})] + (cond + (ismap out) (.put ^Map out (str ckey) result) + (islist out) (.set ^List out (int (Long/parseLong (str ckey))) result))))))) + (if (nil? after) out (after key out parent path))))))) + +(defn merge + ([objs] (merge objs nil)) + ([objs maxdepth] + (let [md (if (nil? maxdepth) MAXDEPTH (max maxdepth 0))] + (if-not (islist objs) + objs + (let [lenlist (.size ^List objs)] + (cond + (= lenlist 0) nil + (= lenlist 1) (.get ^List objs 0) + :else + (let [out (atom (getprop objs 0 (lhm)))] + (doseq [oI (range 1 lenlist)] + (let [obj (.get ^List objs (int oI))] + (if-not (isnode obj) + (reset! out obj) + (let [cur (alist-of [@out]) + dst (alist-of [@out]) + grow! (fn [^ArrayList a n] + (while (<= (.size a) n) (.add a nil))) + before (fn [key val _parent path] + (let [pI (size path)] + (cond + (<= md pI) + (do (grow! cur pI) (.set cur (int pI) val) + (when (> pI 0) (setprop (.get cur (int (dec pI))) key val)) + nil) + (not (isnode val)) + (do (grow! cur pI) (.set cur (int pI) val) val) + :else + (do (grow! dst pI) (grow! cur pI) + (.set dst (int pI) (if (> pI 0) (getprop (.get dst (int (dec pI))) key) (.get dst (int pI)))) + (let [tval (.get dst (int pI))] + (cond + (nil? tval) (do (.set cur (int pI) (if (islist val) (alist) (lhm))) val) + (or (and (islist val) (islist tval)) (and (ismap val) (ismap tval))) + (do (.set cur (int pI) tval) val) + :else (do (.set cur (int pI) val) nil))))))) + after (fn [key _val _parent path] + (let [cI (size path)] + (if (< cI 1) + (if (> (.size cur) 0) (.get cur 0) _val) + (let [target (when (< (dec cI) (.size cur)) (.get cur (int (dec cI)))) + value (when (< cI (.size cur)) (.get cur (int cI)))] + (setprop target key value) + value))))] + (reset! out (walk obj {:before before :after after})))))) + (when (= md 0) + (let [o (getprop objs (dec lenlist) nil)] + (reset! out (cond (islist o) (alist) (ismap o) (lhm) :else o)))) + @out))))))) + +;; --------------------------------------------------------------------------- +;; getpath / setpath +;; --------------------------------------------------------------------------- + +(defn getpath + ([store path] (getpath store path nil)) + ([store path injdef] + (let [parts (cond + (islist path) (alist-of path) + (string? path) (alist-of (.split ^String path "\\." -1)) + (and (number? path) (not (jbool? path))) (alist-of [(strkey path)]) + :else nil)] + (if (nil? parts) + nil + (let [is-inj (inj? injdef) + base (if is-inj (ig injdef :base) (when injdef (getprop injdef S-base))) + dparent (if is-inj (ig injdef :dparent) (when injdef (getprop injdef "dparent"))) + inj-meta (if is-inj (ig injdef :meta) (when injdef (getprop injdef "meta"))) + inj-key (if is-inj (ig injdef :key) (when injdef (getprop injdef "key"))) + dpath (if is-inj (ig injdef :dpath) (when injdef (getprop injdef "dpath"))) + src (if base (getprop store base store) store) + numparts (size parts) + val (atom store)] + (cond + (or (nil? path) (nil? store) (and (= numparts 1) (= (.get parts 0) S-MT)) (= numparts 0)) + (reset! val src) + + (> numparts 0) + (do + (when (= numparts 1) + (reset! val (getprop store (.get parts 0)))) + (when-not (isfunc @val) + (reset! val src) + (let [m (when (string? (.get parts 0)) (re_find R-META-PATH (.get parts 0)))] + (when (and m inj-meta) + (reset! val (getprop inj-meta (nth m 1))) + (.set parts 0 (nth m 3)))) + (loop [pI 0] + (when (and (some? @val) (< pI numparts)) + (let [raw (.get parts (int pI)) + part (cond + (and injdef (= raw S-DKEY)) (if (some? inj-key) inj-key raw) + (and (string? raw) (.startsWith ^String raw "$GET:")) + (stringify (getpath src (slice raw 5 -1))) + (and (string? raw) (.startsWith ^String raw "$REF:")) + (stringify (getpath (getprop store S-DSPEC) (slice raw 5 -1))) + (and injdef (string? raw) (.startsWith ^String raw "$META:")) + (stringify (getpath inj-meta (slice raw 6 -1))) + :else raw) + part (if (string? part) + (re_replace R-DOUBLE-DOLLAR part (fn [_] "$")) + (strkey part))] + (if (= part S-MT) + (let [[ascends pI2] + (loop [a 0 p pI] + (if (and (< (inc p) (.size parts)) (= (.get parts (int (inc p))) S-MT)) + (recur (inc a) (inc p)) + [a p]))] + (if (and injdef (> ascends 0)) + (let [last? (= pI2 (dec (.size parts))) + ascends (if last? (dec ascends) ascends)] + (if (= ascends 0) + (do (reset! val dparent) (recur (inc pI2))) + (let [fullpath (flatten (alist-of [(slice dpath (- ascends)) (alist-of (subvec (vec parts) (inc pI2)))]))] + (reset! val (if (<= ascends (size dpath)) (getpath store fullpath) nil))))) + (do (reset! val dparent) (recur (inc pI2))))) + (do (reset! val (getprop @val part)) (recur (inc pI)))))))))) + (let [handler (if is-inj (ig injdef :handler) (when injdef (getprop injdef "handler")))] + (when (and handler (isfunc handler)) + (let [ref (pathify path)] + (reset! val (handler injdef @val ref store))))) + @val))))) + +(defn setpath + ([store path val] (setpath store path val nil)) + ([store path val injdef] + (let [ptype (typify path) + parts (cond + (pos? (bit-and T_list ptype)) (alist-of path) + (pos? (bit-and T_string ptype)) (alist-of (.split ^String path "\\." -1)) + (pos? (bit-and T_number ptype)) (alist-of [path]) + :else nil)] + (if (nil? parts) + nil + (let [base (when injdef (getprop injdef S-base)) + numparts (size parts) + parent (atom (if base (getprop store base store) store))] + (doseq [pI (range (dec numparts))] + (let [pkey (getelem parts pI) + np (getprop @parent pkey) + np (if-not (isnode np) + (let [next-part (getelem parts (inc pI)) + nn (if (pos? (bit-and T_number (typify next-part))) (alist) (lhm))] + (setprop @parent pkey nn) nn) + np)] + (reset! parent np))) + (if (identical? DELETE val) + (delprop @parent (getelem parts -1)) + (setprop @parent (getelem parts -1) val)) + @parent))))) + +;; --------------------------------------------------------------------------- +;; Injection state +;; --------------------------------------------------------------------------- + +(defn- new-inj [fields] + (let [m (java.util.HashMap.)] + (doseq [[k v] fields] (.put m k v)) + (Inj. m))) + +(defn- inj-descend [^Inj inj] + (let [meta (ig inj :meta) + d (.get ^Map meta "__d")] + (.put ^Map meta "__d" (inc (if (nil? d) 0 d))) + (let [path (ig inj :path) + parentkey (getelem path -2) + dparent (ig inj :dparent) + dpath (ig inj :dpath)] + (if (nil? dparent) + (when (> (size dpath) 1) + (is! inj :dpath (alist-of (concat dpath [parentkey])))) + (when (some? parentkey) + (is! inj :dparent (getprop dparent parentkey)) + (let [lastpart (getelem dpath -1)] + (if (= lastpart (str "$:" parentkey)) + (is! inj :dpath (slice dpath -1)) + (is! inj :dpath (alist-of (concat dpath [parentkey])))))))) + (ig inj :dparent))) + +(defn- inj-child [^Inj inj keyI keys] + (let [key (strkey (nth (vec keys) keyI)) + val (ig inj :val) + cinj (new-inj + {:mode (ig inj :mode) :full (ig inj :full) :keyI keyI :keys keys :key key + :val (getprop val key) :parent val + :path (alist-of (concat (ig inj :path) [key])) + :nodes (alist-of (concat (ig inj :nodes) [val])) + :handler (ig inj :handler) :errs (ig inj :errs) :meta (ig inj :meta) + :base (ig inj :base) :modify (ig inj :modify)})] + (is! cinj :prior inj) + (is! cinj :dpath (alist-of (ig inj :dpath))) + (is! cinj :dparent (ig inj :dparent)) + (is! cinj :extra (ig inj :extra)) + (is! cinj :root (ig inj :root)) + cinj)) + +(defn- inj-setval + ([^Inj inj val] (inj-setval inj val nil)) + ([^Inj inj val ancestor] + (let [[target key] (if (or (nil? ancestor) (< ancestor 2)) + [(ig inj :parent) (ig inj :key)] + [(getelem (ig inj :nodes) (- ancestor)) (getelem (ig inj :path) (- ancestor))])] + (if (nil? val) + (delprop target key) + (setprop target key val))))) + +;; --------------------------------------------------------------------------- +;; inject +;; --------------------------------------------------------------------------- + +(defn inject + ([val store] (inject val store nil)) + ([val store injdef] + (let [inj + (if (inj? injdef) + injdef + (let [parent (doto (lhm) (.put S-DTOP val)) + inj (new-inj + {:mode S-MVAL :full false :keyI 0 :keys (alist-of [S-DTOP]) :key S-DTOP + :val val :parent parent :path (alist-of [S-DTOP]) :nodes (alist-of [parent]) + :handler _injecthandler :base S-DTOP + :modify (when injdef (getprop injdef "modify")) + :meta (getprop injdef "meta" (lhm)) + :errs (getprop store S-DERRS (alist))})] + (is! inj :dparent store) + (is! inj :dpath (alist-of [S-DTOP])) + (is! inj :root parent) + (when (some? injdef) + (when (getprop injdef "extra") (is! inj :extra (getprop injdef "extra"))) + (when (getprop injdef "handler") (is! inj :handler (getprop injdef "handler"))) + (when (getprop injdef "dparent") (is! inj :dparent (getprop injdef "dparent"))) + (when (getprop injdef "dpath") (is! inj :dpath (getprop injdef "dpath")))) + inj))] + (inj-descend inj) + + (let [val + (cond + (isnode val) + (let [nodekeys (atom + (if (ismap val) + (let [ks (vec (map str (map-keys val))) + normal (sort (clojure.core/filter #(not (.contains ^String % S-DS)) ks)) + trans (sort (clojure.core/filter #(.contains ^String % S-DS) ks))] + (alist-of (concat normal trans))) + (alist-of (map str (range (.size ^List val))))))] + (loop [nkI 0] + (when (< nkI (.size ^List @nodekeys)) + (let [childinj (inj-child inj nkI @nodekeys) + nodekey (ig childinj :key)] + (is! childinj :mode S-MKEYPRE) + (let [prekey (_injectstr nodekey store childinj)] + (reset! nodekeys (ig childinj :keys)) + (when (some? prekey) + (is! childinj :val (getprop val prekey)) + (is! childinj :mode S-MVAL) + (inject (ig childinj :val) store childinj) + (reset! nodekeys (ig childinj :keys)) + (is! childinj :mode S-MKEYPOST) + (_injectstr nodekey store childinj) + (reset! nodekeys (ig childinj :keys))) + (recur (inc (ig childinj :keyI))))))) + val) + + (string? val) + (do + (is! inj :mode S-MVAL) + (let [v (_injectstr val store inj)] + (when-not (identical? v SKIP) (inj-setval inj v)) + v)) + + :else val)] + + ;; Custom modification (runs after special commands). + (when (and (ig inj :modify) (not (identical? val SKIP))) + (let [mkey (ig inj :key) mparent (ig inj :parent) mval (getprop mparent mkey)] + ((ig inj :modify) mval mkey mparent inj))) + + (is! inj :val val) + + (cond + (and (nil? (ig inj :prior)) (some? (ig inj :root)) (haskey (ig inj :root) S-DTOP)) + (getprop (ig inj :root) S-DTOP) + (and (= (ig inj :key) S-DTOP) (some? (ig inj :parent)) (haskey (ig inj :parent) S-DTOP)) + (getprop (ig inj :parent) S-DTOP) + :else val))))) + +(defn- _injecthandler [inj val ref store] + (let [iscmd (and (isfunc val) (or (nil? ref) (and (string? ref) (.startsWith ^String ref S-DS))))] + (cond + iscmd (val inj val ref store) + (and (= (ig inj :mode) S-MVAL) (ig inj :full)) (do (inj-setval inj val) val) + :else val))) + +(defn- _injectstr [val store inj] + (if (or (not (string? val)) (= val S-MT)) + S-MT + (let [m (re_find R-INJECT-FULL val)] + (if m + (do + (when (inj? inj) (is! inj :full true)) + (let [pathref0 (nth m 1) + pathref (if (> (count pathref0) 3) + (-> pathref0 (clojure.string/replace "$BT" S-BT) (clojure.string/replace "$DS" S-DS)) + pathref0)] + (getpath store pathref inj))) + (let [out (re_replace R-INJECT-PART val + (fn [g] + (let [ref0 (nth g 1) + ref (if (> (count ref0) 3) + (-> ref0 (clojure.string/replace "$BT" S-BT) (clojure.string/replace "$DS" S-DS)) + ref0)] + (when (inj? inj) (is! inj :full false)) + (let [found (getpath store ref inj)] + (cond + (nil? found) S-MT + (string? found) (if (= found "__NULL__") "null" found) + (isfunc found) found + :else (try (json-encode found {}) (catch Throwable _ (stringify found))))))))] + (if (and (inj? inj) (isfunc (ig inj :handler))) + (do (is! inj :full true) + ((ig inj :handler) inj out val store)) + out)))))) + +;; --------------------------------------------------------------------------- +;; Transform commands +;; --------------------------------------------------------------------------- + +(defn- transform_DELETE [inj _val _ref _store] + (delprop (ig inj :parent) (ig inj :key)) nil) + +(defn- transform_COPY [inj _val _ref _store] + (let [mode (ig inj :mode) key (ig inj :key)] + (if (.startsWith ^String mode "key") + key + (let [dparent (ig inj :dparent) path (ig inj :path) + out (if-not (isnode dparent) + (if (not= (size path) 2) + dparent + (if (parse-long-strict key) dparent nil)) + (let [o (getprop dparent key)] + (if (and (nil? o) (some? key) (parse-long-strict key)) dparent o)))] + (inj-setval inj out) + out)))) + +(defn- transform_KEY [inj _val _ref _store] + (let [mode (ig inj :mode) path (ig inj :path) parent (ig inj :parent)] + (cond + (= mode S-MKEYPRE) (ig inj :key) + (not= mode S-MVAL) nil + :else + (let [keyspec (getprop parent S-BKEY)] + (cond + (some? keyspec) (do (delprop parent S-BKEY) (getprop (ig inj :dparent) keyspec)) + (and (ismap (ig inj :dparent)) (some? (ig inj :key)) (haskey (ig inj :dparent) (ig inj :key))) + (getprop (ig inj :dparent) (ig inj :key)) + :else (let [meta (getprop parent S-BANNO)] + (getprop meta S-KEY (getprop path (- (size path) 2))))))))) + +(defn- transform_ANNO [inj _val _ref _store] + (delprop (ig inj :parent) S-BANNO) nil) + +(defn- transform_MERGE [inj _val _ref _store] + (let [mode (ig inj :mode) key (ig inj :key) parent (ig inj :parent)] + (cond + (= mode S-MKEYPRE) key + (= mode S-MKEYPOST) + (let [args0 (getprop parent key) + args (if (islist args0) args0 (alist-of [args0]))] + (delprop parent key) + (merge (flatten (alist-of [(alist-of [parent]) args (alist-of [(clone parent)])]))) + key) + (and (= mode S-MVAL) (islist parent)) + (if (and (= (strkey (ig inj :key)) "0") (> (size parent) 0)) + (do (.remove ^List parent (int 0)) (getprop parent 0)) + (getprop parent (ig inj :key))) + :else nil))) + +(defn- transform_EACH [inj _val _ref store] + (let [keys_ (ig inj :keys) mode (ig inj :mode) path (ig inj :path) + parent (ig inj :parent) nodes_ (ig inj :nodes)] + (when (some? keys_) + (slice keys_ 0 1 true)) + (if (or (not= mode S-MVAL) (nil? path) (nil? nodes_)) + nil + (let [srcpath (when (> (size parent) 1) (.get ^List parent 1)) + child-tm (when (> (size parent) 2) (clone (.get ^List parent 2))) + srcstore (getprop store (ig inj :base) store) + src (getpath srcstore srcpath inj) + tkey (getelem path -2) + target (if (>= (.size ^List nodes_) 2) (.get ^List nodes_ (int (- (.size ^List nodes_) 2))) + (.get ^List nodes_ (int (dec (.size ^List nodes_))))) + tval (alist) + rval (atom (alist))] + (when (isnode src) + (if (islist src) + (doseq [_ src] (.add tval (clone child-tm))) + (doseq [k (map-keys src)] + (let [cc (clone child-tm)] + (when (ismap cc) (setprop cc S-BANNO (doto (lhm) (.put S-KEY k)))) + (.add tval cc)))) + (let [tcurrent (if (ismap src) (alist-of (map #(.get ^Map src %) (map-keys src))) src)] + (when (> (size tval) 0) + (let [ckey (getelem path -2) + tpath (if (> (count (vec path)) 0) (alist-of (subvec (vec path) 0 (dec (count (vec path))))) (alist)) + dpath (alist-of [S-DTOP])] + (when (and (string? srcpath) (not= srcpath S-MT)) + (doseq [p (.split ^String srcpath "\\." -1)] (when (not= p S-MT) (.add dpath p)))) + (when (some? ckey) (.add dpath (str "$:" ckey))) + (let [tcur (doto (lhm) (.put (str ckey) tcurrent)) + tcur (if (> (size tpath) 1) + (let [pkey (getelem path -3 S-DTOP)] + (.add dpath (str "$:" pkey)) + (doto (lhm) (.put (str pkey) tcur))) + tcur) + tinj (inj-child inj 0 (if (some? ckey) (alist-of [ckey]) (alist)))] + (is! tinj :path tpath) + (is! tinj :nodes (if (> (.size ^List nodes_) 0) (alist-of (subvec (vec nodes_) 0 (dec (count (vec nodes_))))) (alist))) + (is! tinj :parent (if (> (.size ^List (ig tinj :nodes)) 0) (.get ^List (ig tinj :nodes) (int (dec (.size ^List (ig tinj :nodes))))) nil)) + (when (and (some? ckey) (some? (ig tinj :parent))) + (setprop (ig tinj :parent) ckey tval)) + (is! tinj :val tval) + (is! tinj :dpath dpath) + (is! tinj :dparent tcur) + (inject tval store tinj) + (reset! rval (ig tinj :val))))))) + (setprop target tkey @rval) + (if (and (islist @rval) (> (size @rval) 0)) (.get ^List @rval 0) nil))))) + +(defn- transform_PACK [inj _val _ref store] + (let [mode (ig inj :mode) key (ig inj :key) path (ig inj :path) + parent (ig inj :parent) nodes_ (ig inj :nodes)] + (if (or (not= mode S-MKEYPRE) (not (string? key)) (nil? path) (nil? nodes_)) + nil + (let [args-val (getprop parent key)] + (if (or (not (islist args-val)) (< (size args-val) 2)) + nil + (let [srcpath (.get ^List args-val 0) + origchildspec (.get ^List args-val 1) + tkey (getelem path -2) + pathsize (size path) + target (getelem nodes_ (- pathsize 2) (fn [] (getelem nodes_ (- pathsize 1)))) + srcstore (getprop store (ig inj :base) store) + src0 (getpath srcstore srcpath inj) + src (if-not (islist src0) + (if (ismap src0) + (let [ns (alist)] + (doseq [item (items src0)] + (setprop (nth item 1) S-BANNO (doto (lhm) (.put S-KEY (nth item 0)))) + (.add ns (nth item 1))) + ns) + nil) + src0)] + (if (nil? src) + nil + (let [keypath (getprop origchildspec S-BKEY) + childspec (delprop origchildspec S-BKEY) + child (getprop childspec S-BVAL childspec) + tval (lhm)] + (doseq [item (items src)] + (let [srckey (nth item 0) srcnode (nth item 1) + k (cond + (nil? keypath) srckey + (and (string? keypath) (.startsWith ^String keypath S-BT)) + (inject keypath (merge (alist-of [(lhm) store (doto (lhm) (.put S-DTOP srcnode))]) 1)) + :else (getpath srcnode keypath inj)) + tchild (clone child)] + (setprop tval k tchild) + (let [anno (getprop srcnode S-BANNO)] + (if (nil? anno) (delprop tchild S-BANNO) (setprop tchild S-BANNO anno))))) + (let [rval (atom (lhm))] + (when-not (isempty tval) + (let [tsrc (lhm)] + (doseq [[i n] (map-indexed vector (vec src))] + (let [kn (cond + (nil? keypath) i + (and (string? keypath) (.startsWith ^String keypath S-BT)) + (inject keypath (merge (alist-of [(lhm) store (doto (lhm) (.put S-DTOP n))]) 1)) + :else (getpath n keypath inj))] + (setprop tsrc kn n))) + (let [tpath (slice (ig inj :path) -1) + ckey (getelem (ig inj :path) -2) + dpath (flatten (alist-of [S-DTOP (alist-of (.split ^String srcpath "\\." -1)) (str "$:" ckey)])) + tcur (doto (lhm) (.put (str ckey) tsrc)) + tcur (if (> (size tpath) 1) + (let [pkey (getelem (ig inj :path) -3 S-DTOP)] + (.add ^List dpath (str "$:" pkey)) + (doto (lhm) (.put (str pkey) tcur))) + tcur) + tinj (inj-child inj 0 (alist-of [ckey]))] + (is! tinj :path tpath) + (is! tinj :nodes (slice (ig inj :nodes) -1)) + (is! tinj :parent (getelem (ig tinj :nodes) -1)) + (is! tinj :val tval) + (is! tinj :dpath dpath) + (is! tinj :dparent tcur) + (inject tval store tinj) + (reset! rval (ig tinj :val))))) + (setprop target tkey @rval) + nil))))))))) + +(defn- transform_REF [inj val _ref store] + (let [nodes (ig inj :nodes)] + (if (not= (ig inj :mode) S-MVAL) + nil + (let [refpath (getprop (ig inj :parent) 1)] + (is! inj :keyI (size (ig inj :keys))) + (let [spec-func (getprop store S-DSPEC)] + (if-not (isfunc spec-func) + nil + (let [spec (spec-func) + ref (getpath spec refpath) + hasSubRef (atom false)] + (when (isnode ref) + (walk ref (fn [_k v _p _path] (when (= v "`$REF`") (reset! hasSubRef true)) v))) + (let [tref (clone ref) + cpath (slice (ig inj :path) 0 (- (size (ig inj :path)) 3)) + tpath (slice (ig inj :path) 0 (- (size (ig inj :path)) 1)) + tcur (getpath store cpath) + tval (getpath store tpath) + rval (atom nil)] + (if (and (some? ref) (or (not @hasSubRef) (some? tval))) + (let [cs (inj-child inj 0 (alist-of [(getelem tpath -1)]))] + (is! cs :path tpath) + (is! cs :nodes (slice (ig inj :nodes) 0 (- (size (ig inj :nodes)) 1))) + (is! cs :parent (getelem nodes -2)) + (is! cs :val tref) + (is! cs :dparent tcur) + (inject tref store cs) + (reset! rval (ig cs :val))) + (reset! rval nil)) + (inj-setval inj @rval 2) + (when (and (islist (ig inj :parent)) (ig inj :prior)) + (is! (ig inj :prior) :keyI (dec (ig (ig inj :prior) :keyI)))) + val)))))))) + +;; FORMATTER +(defn- jsstr [v] + (cond (nil? v) "null" (jbool? v) (if v "true" "false") :else (str v))) + +(defn- fmt-number [_k v & _] + (if (isnode v) v + (let [n (try (double (if (string? v) (Double/parseDouble v) v)) (catch Exception _ 0.0)) + n (if (Double/isNaN n) 0.0 n)] + (if (== n (Math/floor n)) (long n) n)))) + +(defn- fmt-integer [_k v & _] + (if (isnode v) v + (let [n (try (double (if (string? v) (Double/parseDouble v) v)) (catch Exception _ 0.0)) + n (if (Double/isNaN n) 0.0 n)] + (long n)))) + +(def FORMATTER + {"identity" (fn [_k v & _] v) + "upper" (fn [_k v & _] (if (isnode v) v (clojure.string/upper-case (jsstr v)))) + "lower" (fn [_k v & _] (if (isnode v) v (clojure.string/lower-case (jsstr v)))) + "string" (fn [_k v & _] (if (isnode v) v (jsstr v))) + "number" fmt-number + "integer" fmt-integer + "concat" (fn [k v & _] + (if (and (nil? k) (islist v)) + (join (items v (fn [n] (if (isnode (nth n 1)) S-MT (jsstr (nth n 1))))) S-MT) + v))}) + +(defn checkPlacement [modes ijname parentTypes inj] + (let [mode-num (get MODE-TO-NUM (ig inj :mode) 0)] + (cond + (zero? (bit-and modes mode-num)) + (let [allowed (clojure.core/filter #(pos? (bit-and modes %)) [M_KEYPRE M_KEYPOST M_VAL]) + placements (join (items (alist-of allowed) (fn [n] (get PLACEMENT (nth n 1) ""))) ",")] + (.add ^List (ig inj :errs) + (str "$" ijname ": invalid placement as " (get PLACEMENT mode-num "") + ", expected: " placements ".")) + false) + (not (isempty parentTypes)) + (let [ptype (typify (ig inj :parent))] + (if (zero? (bit-and parentTypes ptype)) + (do (.add ^List (ig inj :errs) + (str "$" ijname ": invalid placement in parent " (typename ptype) + ", expected: " (typename parentTypes) ".")) + false) + true)) + :else true))) + +(defn injectorArgs [argTypes args] + (let [numargs (size argTypes) + found (object-array (inc numargs))] + (aset found 0 nil) + (loop [argI 0] + (if (< argI numargs) + (let [arg (getelem args argI) + argType (typify arg)] + (if (zero? (bit-and (nth (vec argTypes) argI) argType)) + (do (aset found 0 + (str "invalid argument: " (stringify arg 22) " (" (typename argType) + " at position " (inc argI) ") is not of type: " + (typename (nth (vec argTypes) argI)) ".")) + (vec found)) + (do (aset found (inc argI) arg) (recur (inc argI))))) + (vec found))))) + +(defn injectChild [child store inj] + (let [cinj (atom inj) + prior (ig inj :prior)] + (when (some? prior) + (let [pprior (ig prior :prior)] + (if (some? pprior) + (let [c (inj-child pprior (ig prior :keyI) (ig prior :keys))] + (is! c :val child) + (setprop (ig c :parent) (ig prior :key) child) + (reset! cinj c)) + (let [c (inj-child prior (ig inj :keyI) (ig inj :keys))] + (is! c :val child) + (setprop (ig c :parent) (ig inj :key) child) + (reset! cinj c))))) + (inject child store @cinj) + @cinj)) + +(defn- transform_FORMAT [inj _val _ref store] + (slice (ig inj :keys) 0 1 true) + (if (not= (ig inj :mode) S-MVAL) + nil + (let [name (getprop (ig inj :parent) 1) + child (getprop (ig inj :parent) 2) + tkey (getelem (ig inj :path) -2) + target (getelem (ig inj :nodes) -2 (fn [] (getelem (ig inj :nodes) -1))) + cinj (injectChild child store inj) + resolved (ig cinj :val) + formatter (if (pos? (bit-and T_function (typify name))) name (getprop FORMATTER name))] + (if (nil? formatter) + (do (.add ^List (ig inj :errs) (str "$FORMAT: unknown format: " name ".")) nil) + (let [out (walk resolved formatter)] + (setprop target tkey out) + out))))) + +(defn- transform_APPLY [inj _val _ref store] + (let [ijname "APPLY"] + (if-not (checkPlacement M_VAL ijname T_list inj) + nil + (let [res (injectorArgs [T_function T_any] (slice (ig inj :parent) 1)) + err (nth res 0) apply-fn (nth res 1) child (when (> (count res) 2) (nth res 2))] + (if (some? err) + (do (.add ^List (ig inj :errs) (str "$" ijname ": " err)) nil) + (let [tkey (getelem (ig inj :path) -2) + target (getelem (ig inj :nodes) -2 (fn [] (getelem (ig inj :nodes) -1))) + cinj (injectChild child store inj) + resolved (ig cinj :val) + out (try (apply-fn resolved store cinj) + (catch Throwable _ + (try (apply-fn resolved store) (catch Throwable _ (apply-fn resolved)))))] + (setprop target tkey out) + out)))))) + +(defn transform + ([data spec] (transform data spec nil)) + ([data spec injdef] + (let [origspec spec + spec (clone spec) + extra (when injdef (getprop injdef "extra")) + collect (and injdef (some? (getprop injdef "errs"))) + errs (if collect (getprop injdef "errs") (alist)) + extra-transforms (lhm) + extra-data (lhm)] + (when extra + (doseq [[k v] (items extra)] + (if (and (string? k) (.startsWith ^String k S-DS)) + (.put extra-transforms k v) + (.put extra-data k v)))) + (let [data-clone (merge (alist-of [(if (isempty extra-data) nil (clone extra-data)) (clone data)])) + store (lhm)] + (.put store S-DTOP data-clone) + (.put store S-DSPEC (fn [& _] origspec)) + (.put store "$BT" (fn [& _] S-BT)) + (.put store "$DS" (fn [& _] S-DS)) + (.put store "$WHEN" (fn [& _] (.toString (java.time.Instant/now)))) + (.put store "$DELETE" transform_DELETE) + (.put store "$COPY" transform_COPY) + (.put store "$KEY" transform_KEY) + (.put store "$ANNO" transform_ANNO) + (.put store "$MERGE" transform_MERGE) + (.put store "$EACH" transform_EACH) + (.put store "$PACK" transform_PACK) + (.put store "$REF" transform_REF) + (.put store "$FORMAT" transform_FORMAT) + (.put store "$APPLY" transform_APPLY) + (doseq [[k v] (items extra-transforms)] (.put store k v)) + (.put store S-DERRS errs) + (let [idef (lhm)] + (when (ismap injdef) (doseq [[k v] (items injdef)] (.put idef k v))) + (.put idef "errs" errs) + (let [out (inject spec store idef)] + (when (and (> (size errs) 0) (not collect)) + (throw (RuntimeException. (join errs " | ")))) + out)))))) + +;; --------------------------------------------------------------------------- +;; validate +;; --------------------------------------------------------------------------- + +(defn- validate_STRING [inj _val _ref _store] + (let [out (getprop (ig inj :dparent) (ig inj :key)) t (typify out)] + (cond + (zero? (bit-and T_string t)) (do (.add ^List (ig inj :errs) (_invalidTypeMsg (ig inj :path) S-string t out "V1010")) nil) + (= out S-MT) (do (.add ^List (ig inj :errs) (str "Empty string at " (pathify (ig inj :path) 1))) nil) + :else out))) + +(defn- validate_TYPE [inj _val ref _store] + (let [tname (if (and (string? ref) (> (count ref) 1)) (clojure.string/lower-case (slice ref 1)) S-any) + idx (.indexOf ^java.util.List (vec TYPENAME) tname) + typev0 (if (>= idx 0) (bit-shift-left 1 (- 31 idx)) 0) + typev (if (= tname S-nil) (bit-or typev0 T_null) typev0) + out (getprop (ig inj :dparent) (ig inj :key)) + t (typify out)] + (if (zero? (bit-and t typev)) + (do (.add ^List (ig inj :errs) (_invalidTypeMsg (ig inj :path) tname t out "V1001")) nil) + out))) + +(defn- validate_ANY [inj _val _ref _store] + (getprop (ig inj :dparent) (ig inj :key))) + +(defn- validate_CHILD [inj _val _ref _store] + (let [mode (ig inj :mode) key (ig inj :key) parent (ig inj :parent) + path (ig inj :path) keys (ig inj :keys)] + (cond + (= mode S-MKEYPRE) + (let [childtm (getprop parent key) + pkey (getelem path -2) + tval (getprop (ig inj :dparent) pkey)] + (cond + (nil? tval) (let [tval (lhm)] + (doseq [ckey (keysof tval)] (setprop parent ckey (clone childtm)) (.add ^List keys ckey)) + (delprop parent key) nil) + (not (ismap tval)) + (do (.add ^List (ig inj :errs) (_invalidTypeMsg (slice path 0 (dec (size path))) S-object (typify tval) tval "V0220")) nil) + :else + (do (doseq [ckey (keysof tval)] (setprop parent ckey (clone childtm)) (.add ^List keys ckey)) + (delprop parent key) nil))) + + (= mode S-MVAL) + (let [childtm (getprop parent 1)] + (cond + (not (islist parent)) (do (.add ^List (ig inj :errs) "Invalid $CHILD as value") nil) + (nil? (ig inj :dparent)) (do (.clear ^List parent) nil) + (not (islist (ig inj :dparent))) + (do (.add ^List (ig inj :errs) (_invalidTypeMsg (slice path 0 (dec (size path))) S-list (typify (ig inj :dparent)) (ig inj :dparent) "V0230")) + (is! inj :keyI (size parent)) (ig inj :dparent)) + :else + (do (doseq [n (items (ig inj :dparent))] (setprop parent (nth n 0) (clone childtm))) + (while (> (.size ^List parent) (.size ^List (ig inj :dparent))) (.remove ^List parent (int (dec (.size ^List parent))))) + (is! inj :keyI 0) + (getprop (ig inj :dparent) 0)))) + :else nil))) + +(defn- validate_ONE [inj _val _ref store] + (let [mode (ig inj :mode) parent (ig inj :parent) keyI (ig inj :keyI)] + (when (= mode S-MVAL) + (if (or (not (islist parent)) (not= keyI 0)) + (do (.add ^List (ig inj :errs) (str "The $ONE validator at field " (pathify (ig inj :path) 1 1) " must be the first element of an array.")) nil) + (do + (is! inj :keyI (size (ig inj :keys))) + (inj-setval inj (ig inj :dparent) 2) + (is! inj :path (slice (ig inj :path) 0 (dec (size (ig inj :path))))) + (is! inj :key (getelem (ig inj :path) -1)) + (let [tvals (alist-of (subvec (vec parent) 1))] + (if (= (size tvals) 0) + (do (.add ^List (ig inj :errs) (str "The $ONE validator at field " (pathify (ig inj :path) 1 1) " must have at least one argument.")) nil) + (let [matched (atom false)] + (doseq [tval tvals :while (not @matched)] + (let [terrs (alist) + vstore (merge (alist-of [(lhm) store]) 1)] + (.put ^Map vstore S-DTOP (ig inj :dparent)) + (let [vcurrent (validate (ig inj :dparent) tval (doto (lhm) (.put "extra" vstore) (.put "errs" terrs) (.put "meta" (ig inj :meta))))] + (inj-setval inj vcurrent -2) + (when (= (size terrs) 0) (reset! matched true))))) + (when-not @matched + (let [valdesc (clojure.string/join ", " (map #(stringify (nth % 1)) (items tvals))) + valdesc (re_replace R-TRANSFORM-NAME valdesc (fn [g] (clojure.string/lower-case (nth g 1))))] + (.add ^List (ig inj :errs) + (_invalidTypeMsg (ig inj :path) + (str (if (> (size tvals) 1) "one of " "") valdesc) + (typify (ig inj :dparent)) (ig inj :dparent) "V0210")))))))))))) + +(defn- validate_EXACT [inj _val _ref _store] + (let [mode (ig inj :mode) parent (ig inj :parent) key (ig inj :key) keyI (ig inj :keyI)] + (if (= mode S-MVAL) + (if (or (not (islist parent)) (not= keyI 0)) + (do (.add ^List (ig inj :errs) (str "The $EXACT validator at field " (pathify (ig inj :path) 1 1) " must be the first element of an array.")) nil) + (do + (is! inj :keyI (size (ig inj :keys))) + (inj-setval inj (ig inj :dparent) 2) + (is! inj :path (slice (ig inj :path) 0 (dec (size (ig inj :path))))) + (is! inj :key (getelem (ig inj :path) -1)) + (let [tvals (alist-of (subvec (vec parent) 1))] + (if (= (size tvals) 0) + (do (.add ^List (ig inj :errs) (str "The $EXACT validator at field " (pathify (ig inj :path) 1 1) " must have at least one argument.")) nil) + (let [currentstr (atom nil) matched (atom false)] + (doseq [tval tvals :while (not @matched)] + (let [em (= tval (ig inj :dparent)) + em (if (and (not em) (isnode tval)) + (do (when (nil? @currentstr) (reset! currentstr (stringify (ig inj :dparent)))) + (= (stringify tval) @currentstr)) + em)] + (when em (reset! matched true)))) + (when-not @matched + (let [valdesc (clojure.string/join ", " (map #(stringify (nth % 1)) (items tvals))) + valdesc (re_replace R-TRANSFORM-NAME valdesc (fn [g] (clojure.string/lower-case (nth g 1))))] + (.add ^List (ig inj :errs) + (_invalidTypeMsg (ig inj :path) + (str (if (> (size (ig inj :path)) 1) "" "value ") + "exactly equal to " (if (= (size tvals) 1) "" "one of ") valdesc) + (typify (ig inj :dparent)) (ig inj :dparent) "V0110"))))))))) + (delprop parent key)))) + +(defn- _validation [pval key parent inj] + (when (and (some? inj) (not (identical? pval SKIP))) + (let [exact (getprop (ig inj :meta) S-BEXACT false) + cval (getprop (ig inj :dparent) key)] + (when-not (and (not exact) (nil? cval)) + (let [ptype (typify pval)] + (when-not (and (pos? (bit-and T_string ptype)) (.contains ^String (str pval) S-DS)) + (let [ctype (typify cval)] + (cond + (and (not= ptype ctype) (some? pval)) + (.add ^List (ig inj :errs) (_invalidTypeMsg (ig inj :path) (typename ptype) ctype cval "V0010")) + + (ismap cval) + (if-not (ismap pval) + (.add ^List (ig inj :errs) (_invalidTypeMsg (ig inj :path) (typename ptype) ctype cval "V0020")) + (let [ckeys (keysof cval) pkeys (keysof pval)] + (if (and (> (count pkeys) 0) (not (true? (getprop pval "`$OPEN`")))) + (let [badkeys (clojure.core/filter #(not (haskey pval %)) ckeys)] + (when (> (size badkeys) 0) + (.add ^List (ig inj :errs) + (str "Unexpected keys at field " (pathify (ig inj :path) 1) S-VIZ (join (alist-of badkeys) ", "))))) + (do (merge (alist-of [pval cval])) + (when (isnode pval) (delprop pval "`$OPEN`")))))) + + (islist cval) + (when-not (islist pval) + (.add ^List (ig inj :errs) (_invalidTypeMsg (ig inj :path) (typename ptype) ctype cval "V0030"))) + + exact + (when (not= cval pval) + (let [pathmsg (if (> (size (ig inj :path)) 1) (str "at field " (pathify (ig inj :path) 1) ": ") "")] + (.add ^List (ig inj :errs) (str "Value " pathmsg (str cval) " should equal " (str pval) ".")))) + + :else (setprop parent key cval))))))))) + +(defn- _validatehandler [inj val ref store] + (let [m (when (string? ref) (re_find R-META-PATH ref))] + (if (some? m) + (do + (if (= (nth m 2) "=") + (inj-setval inj (alist-of [S-BEXACT val])) + (inj-setval inj val)) + (is! inj :keyI -1) + SKIP) + (_injecthandler inj val ref store)))) + +(defn validate + ([data spec] (validate data spec nil)) + ([data spec injdef] + (let [extra (getprop injdef "extra") + collect (and injdef (some? (getprop injdef "errs"))) + errs (if collect (getprop injdef "errs") (alist)) + base (lhm)] + (doseq [[k v] [["$DELETE" nil] ["$COPY" nil] ["$KEY" nil] ["$META" nil] + ["$MERGE" nil] ["$EACH" nil] ["$PACK" nil] + ["$STRING" validate_STRING] ["$NUMBER" validate_TYPE] ["$INTEGER" validate_TYPE] + ["$DECIMAL" validate_TYPE] ["$BOOLEAN" validate_TYPE] ["$NULL" validate_TYPE] + ["$NIL" validate_TYPE] ["$MAP" validate_TYPE] ["$LIST" validate_TYPE] + ["$FUNCTION" validate_TYPE] ["$INSTANCE" validate_TYPE] + ["$ANY" validate_ANY] ["$CHILD" validate_CHILD] ["$ONE" validate_ONE] + ["$EXACT" validate_EXACT]]] + (.put base k v)) + (let [store (merge (alist-of [base (if (nil? extra) (lhm) extra) (doto (lhm) (.put "$ERRS" errs))]) 1) + meta (getprop injdef "meta" (lhm))] + (setprop meta S-BEXACT (getprop meta S-BEXACT false)) + (let [out (transform data spec (doto (lhm) + (.put "meta" meta) + (.put "extra" store) + (.put "modify" _validation) + (.put "handler" _validatehandler) + (.put "errs" errs)))] + (when (and (> (size errs) 0) (not collect)) + (throw (RuntimeException. (clojure.string/join " | " (vec errs))))) + out))))) + +(defn- _invalidTypeMsg [path needtype vt v _whence] + (let [vs (if (nil? v) "no value" (stringify v))] + (str "Expected " + (if (> (size path) 1) (str "field " (pathify path 1) " to be ") "") + (str needtype) + ", but found " + (if (some? v) (str (typename vt) S-VIZ) "") + vs "."))) + +;; --------------------------------------------------------------------------- +;; select +;; --------------------------------------------------------------------------- + +(defn- select_AND [inj _val _ref store] + (when (= (ig inj :mode) S-MKEYPRE) + (let [terms (getprop (ig inj :parent) (ig inj :key)) + ppath (slice (ig inj :path) -1) + point (getpath store ppath) + vstore (merge (alist-of [(lhm) store]) 1)] + (.put ^Map vstore S-DTOP point) + (doseq [term terms] + (let [terrs (alist)] + (validate point term (doto (lhm) (.put "extra" vstore) (.put "errs" terrs) (.put "meta" (ig inj :meta)))) + (when (not= (size terrs) 0) + (.add ^List (ig inj :errs) (str "AND:" (pathify ppath) "⨯" (stringify point) " fail:" (stringify terms)))))) + (let [gkey (getelem (ig inj :path) -2) gp (getelem (ig inj :nodes) -2)] + (setprop gp gkey point)))) + nil) + +(defn- select_OR [inj _val _ref store] + (when (= (ig inj :mode) S-MKEYPRE) + (let [terms (getprop (ig inj :parent) (ig inj :key)) + ppath (slice (ig inj :path) -1) + point (getpath store ppath) + vstore (merge (alist-of [(lhm) store]) 1) + done (atom false)] + (.put ^Map vstore S-DTOP point) + (doseq [term terms :while (not @done)] + (let [terrs (alist)] + (validate point term (doto (lhm) (.put "extra" vstore) (.put "errs" terrs) (.put "meta" (ig inj :meta)))) + (when (= (size terrs) 0) + (let [gkey (getelem (ig inj :path) -2) gp (getelem (ig inj :nodes) -2)] + (setprop gp gkey point) (reset! done true))))) + (when-not @done + (.add ^List (ig inj :errs) (str "OR:" (pathify ppath) "⨯" (stringify point) " fail:" (stringify terms)))))) + nil) + +(defn- select_NOT [inj _val _ref store] + (when (= (ig inj :mode) S-MKEYPRE) + (let [term (getprop (ig inj :parent) (ig inj :key)) + ppath (slice (ig inj :path) -1) + point (getpath store ppath) + vstore (merge (alist-of [(lhm) store]) 1) + terrs (alist)] + (.put ^Map vstore S-DTOP point) + (validate point term (doto (lhm) (.put "extra" vstore) (.put "errs" terrs) (.put "meta" (ig inj :meta)))) + (when (= (size terrs) 0) + (.add ^List (ig inj :errs) (str "NOT:" (pathify ppath) "⨯" (stringify point) " fail:" (stringify term)))) + (let [gkey (getelem (ig inj :path) -2) gp (getelem (ig inj :nodes) -2)] + (setprop gp gkey point)))) + nil) + +(defn- num-cmp [a b op] + (try + (let [x (double a) y (double b)] + (case op :gt (> x y) :lt (< x y) :gte (>= x y) :lte (<= x y))) + (catch Exception _ false))) + +(defn- select_CMP [inj _val ref store] + (when (= (ig inj :mode) S-MKEYPRE) + (let [term (getprop (ig inj :parent) (ig inj :key)) + gkey (getelem (ig inj :path) -2) + ppath (slice (ig inj :path) -1) + point (getpath store ppath) + pass (cond + (= ref "$GT") (num-cmp point term :gt) + (= ref "$LT") (num-cmp point term :lt) + (= ref "$GTE") (num-cmp point term :gte) + (= ref "$LTE") (num-cmp point term :lte) + (= ref "$LIKE") (boolean (re_test (re_compile term) (stringify point))) + :else false)] + (if pass + (let [gp (getelem (ig inj :nodes) -2)] (setprop gp gkey point)) + (.add ^List (ig inj :errs) (str "CMP: " (pathify ppath) "⨯" (stringify point) " fail:" ref " " (stringify term)))))) + nil) + +(defn select [children query] + (if-not (isnode children) + (alist) + (let [children (if (ismap children) + (alist-of (map (fn [n] (setprop (nth n 1) S-DKEY (nth n 0)) (nth n 1)) (items children))) + (alist-of (map-indexed (fn [i n] (if (ismap n) (do (setprop n S-DKEY i) n) n)) (vec children)))) + results (alist) + extra (doto (lhm) + (.put "$AND" select_AND) (.put "$OR" select_OR) (.put "$NOT" select_NOT) + (.put "$GT" select_CMP) (.put "$LT" select_CMP) (.put "$GTE" select_CMP) + (.put "$LTE" select_CMP) (.put "$LIKE" select_CMP)) + q (clone query)] + (walk q (fn [_k v _p _path] (when (ismap v) (setprop v "`$OPEN`" (getprop v "`$OPEN`" true))) v)) + (doseq [child children] + (let [errs (alist) + injdef (doto (lhm) (.put "errs" errs) (.put "meta" (doto (lhm) (.put S-BEXACT true))) (.put "extra" extra))] + (validate child (clone q) injdef) + (when (= (size errs) 0) (.add results child)))) + results))) + +;; --------------------------------------------------------------------------- +;; JSON builders +;; --------------------------------------------------------------------------- + +(defn jm [& kv] + (let [kvsize (count kv) o (lhm) kvv (vec kv)] + (doseq [i (range 0 kvsize 2)] + (let [k0 (nth kvv i) + k (cond (nil? k0) "null" (string? k0) k0 :else (stringify k0))] + (.put o k (if (< (inc i) kvsize) (nth kvv (inc i)) nil)))) + o)) + +(defn jt [& v] + (alist-of v)) + +;; --------------------------------------------------------------------------- +;; StructUtility container (parity with other ports) +;; --------------------------------------------------------------------------- + +(def tn typename) + +(defn struct-utility [] + {:clone clone :delprop delprop :escre escre :escurl escurl :filter filter + :flatten flatten :getdef getdef :getelem getelem :getpath getpath :getprop getprop + :haskey haskey :inject inject :isempty isempty :isfunc isfunc :iskey iskey + :islist islist :ismap ismap :isnode isnode :items items :jm jm :jt jt + :join join :joinurl joinurl :jsonify jsonify :keysof keysof :merge merge + :pad pad :pathify pathify :replace replace :select select :setpath setpath + :setprop setprop :size size :slice slice :stringify stringify :strkey strkey + :transform transform :typify typify :typename typename :validate validate :walk walk + :re_compile re_compile :re_find re_find :re_find_all re_find_all + :re_replace re_replace :re_test re_test :re_escape re_escape + :SKIP SKIP :DELETE DELETE :tn tn + :checkPlacement checkPlacement :injectorArgs injectorArgs :injectChild injectChild}) diff --git a/clojure/test/voxgig/struct_runner.clj b/clojure/test/voxgig/struct_runner.clj new file mode 100644 index 00000000..624bb7a9 --- /dev/null +++ b/clojure/test/voxgig/struct_runner.clj @@ -0,0 +1,483 @@ +;; Test runner for the shared JSON corpus (build/test/test.json). +;; Self-contained: includes a small JSON reader that builds the same mutable +;; Java collections the library uses (LinkedHashMap / ArrayList), so the +;; library is exercised exactly as in production. No third-party deps. + +(ns voxgig.struct-runner + (:require [voxgig.struct :as s] + [clojure.string :as str]) + (:import [java.util LinkedHashMap ArrayList List Map])) + +;; --------------------------------------------------------------------------- +;; Minimal JSON reader -> LinkedHashMap / ArrayList / Long / Double / String / +;; Boolean / nil +;; --------------------------------------------------------------------------- + +(defn- json-read [^String s] + (let [n (count s) pos (int-array 1)] + (letfn [(peek-c [] (when (< (aget pos 0) n) (.charAt s (aget pos 0)))) + (next-c [] (let [c (.charAt s (aget pos 0))] (aset pos 0 (inc (aget pos 0))) c)) + (skip-ws [] (while (and (< (aget pos 0) n) + (Character/isWhitespace (.charAt s (aget pos 0)))) + (aset pos 0 (inc (aget pos 0))))) + (parse-val [] + (skip-ws) + (let [c (peek-c)] + (cond + (= c \{) (parse-obj) + (= c \[) (parse-arr) + (= c \") (parse-str) + (or (= c \t) (= c \f)) (parse-bool) + (= c \n) (parse-null) + :else (parse-num)))) + (parse-obj [] + (next-c) ;; { + (let [m (LinkedHashMap.)] + (skip-ws) + (if (= (peek-c) \}) + (do (next-c) m) + (loop [] + (skip-ws) + (let [k (parse-str)] + (skip-ws) (next-c) ;; : + (let [v (parse-val)] + (.put m k v)) + (skip-ws) + (let [c (next-c)] + (if (= c \,) (recur) m))))))) + (parse-arr [] + (next-c) ;; [ + (let [a (ArrayList.)] + (skip-ws) + (if (= (peek-c) \]) + (do (next-c) a) + (loop [] + (let [v (parse-val)] + (.add a v)) + (skip-ws) + (let [c (next-c)] + (if (= c \,) (recur) a)))))) + (parse-str [] + (next-c) ;; opening " + (let [sb (StringBuilder.)] + (loop [] + (let [c (next-c)] + (cond + (= c \") (.toString sb) + (= c \\) + (let [e (next-c)] + (case e + \" (.append sb \") \\ (.append sb \\) \/ (.append sb \/) + \n (.append sb \newline) \t (.append sb \tab) \r (.append sb \return) + \b (.append sb \backspace) \f (.append sb \formfeed) + \u (let [hex (subs s (aget pos 0) (+ (aget pos 0) 4))] + (aset pos 0 (+ (aget pos 0) 4)) + (.append sb (char (Integer/parseInt hex 16)))) + (.append sb e)) + (recur)) + :else (do (.append sb c) (recur))))))) + (parse-bool [] + (if (= (peek-c) \t) + (do (aset pos 0 (+ (aget pos 0) 4)) true) + (do (aset pos 0 (+ (aget pos 0) 5)) false))) + (parse-null [] + (aset pos 0 (+ (aget pos 0) 4)) nil) + (parse-num [] + (let [start (aget pos 0)] + (while (and (< (aget pos 0) n) + (let [c (.charAt s (aget pos 0))] + (or (Character/isDigit c) (= c \-) (= c \+) (= c \.) (= c \e) (= c \E)))) + (aset pos 0 (inc (aget pos 0)))) + (let [tok (subs s start (aget pos 0))] + (if (or (.contains tok ".") (.contains tok "e") (.contains tok "E")) + (Double/parseDouble tok) + (Long/parseLong tok)))))] + (parse-val)))) + +;; --------------------------------------------------------------------------- +;; fixJSON / canonicalize / equality +;; --------------------------------------------------------------------------- + +(def NULLMARK "__NULL__") +(def UNDEFMARK "__UNDEF__") +(def EXISTSMARK "__EXISTS__") + +(defn fix-json [v flag-null] + (cond + (nil? v) (if flag-null NULLMARK nil) + (s/ismap v) (let [o (LinkedHashMap.)] + (doseq [k (.keySet ^Map v)] (.put o (str k) (fix-json (.get ^Map v k) flag-null))) + o) + (s/islist v) (let [a (ArrayList.)] + (doseq [x v] (.add a (fix-json x flag-null))) + a) + :else v)) + +(defn canon [v] + (cond + (s/ismap v) (into (sorted-map) (map (fn [k] [(str k) (canon (.get ^Map v k))]) (.keySet ^Map v))) + (s/islist v) (mapv canon (vec v)) + :else v)) + +(defn eqv [a b] (= (canon a) (canon b))) + +;; --------------------------------------------------------------------------- +;; match support +;; --------------------------------------------------------------------------- + +(defn matchval [check base] + (let [check (if (or (= check UNDEFMARK) (= check NULLMARK)) nil check)] + (cond + (eqv check base) true + (string? check) + (let [basestr (s/stringify base) + m (re-matches #"^/(.+)/$" check)] + (if m + (boolean (re-find (re-pattern (second m)) basestr)) + (str/includes? (str/lower-case basestr) (str/lower-case (s/stringify check))))) + (s/isfunc check) true + :else false))) + +(defn do-match [check base] + (let [base (s/clone base)] + (s/walk check + (fn [_k val _p path] + (when-not (s/isnode val) + (let [baseval (s/getpath base path)] + (cond + (eqv baseval val) nil + (and (= val UNDEFMARK) (nil? baseval)) nil + (and (= val EXISTSMARK) (some? baseval)) nil + (not (matchval val baseval)) + (throw (AssertionError. + (str "MATCH: " (str/join "." (vec path)) ": [" + (s/stringify val) "] <=> [" (s/stringify baseval) "]")))))) + val)))) + +;; --------------------------------------------------------------------------- +;; Per-entry runner +;; --------------------------------------------------------------------------- + +(defn- omap [& kvs] + (let [m (LinkedHashMap.)] + (doseq [[k v] (partition 2 kvs)] (.put m k v)) + m)) + +(defn- resolve-args [^Map entry subject] + (cond + (.containsKey entry "ctx") [(.get entry "ctx")] + (.containsKey entry "args") (vec (.get entry "args")) + (.containsKey entry "in") [(s/clone (.get entry "in"))] + :else [])) + +(defn- safe-call [subject args] + (if (empty? args) + (try (subject) (catch clojure.lang.ArityException _ (subject nil))) + (apply subject args))) + +(defn check-result [^Map entry args res] + (let [matched (atom false)] + (when (.containsKey entry "match") + (do-match (.get entry "match") + (omap "in" (.get entry "in") "args" (s/clone (ArrayList. ^java.util.Collection args)) + "out" (.get entry "res") "ctx" (.get entry "ctx"))) + (reset! matched true)) + (let [out (.get entry "out")] + (cond + (eqv out res) nil + (and @matched (or (= out NULLMARK) (nil? out))) nil + :else + (throw (AssertionError. + (str "Expected: " (s/stringify out) ", got: " (s/stringify res)))))))) + +(defn handle-error [^Map entry err] + (let [entry-err (when (.containsKey entry "err") (.get entry "err")) + msg (or (.getMessage ^Throwable err) (str err))] + (if (.containsKey entry "err") + (if (or (= entry-err true) (matchval entry-err msg)) + (when (.containsKey entry "match") + (do-match (.get entry "match") + (omap "in" (.get entry "in") "out" (.get entry "res") + "ctx" (.get entry "ctx") "err" msg))) + (throw (AssertionError. (str "ERROR MATCH: [" (s/stringify entry-err) "] <=> [" msg "]")))) + (throw (if (instance? AssertionError err) err (AssertionError. (str err))))))) + +(def ^:dynamic *results* nil) + +(defn- record! [group name ok? msg] + (swap! *results* update (if ok? :pass :fail) (fnil conj []) {:group group :name name :msg msg})) + +(defn run-set + ([group node subject] (run-set group node {} subject)) + ([group node flags subject] + (let [flag-null (get flags "null" true) + fixed (fix-json node flag-null) + testset (.get ^Map fixed "set")] + (doseq [^Map entry testset] + (try + (when (and (not (.containsKey entry "out")) flag-null) + (.put entry "out" NULLMARK)) + (let [args (resolve-args entry subject) + res (fix-json (safe-call subject args) flag-null)] + (.put entry "res" res) + (check-result entry args res)) + (record! group (str (.get entry "name")) true nil) + (catch Throwable err + (try + (handle-error entry err) + (record! group (str (.get entry "name")) true nil) + (catch Throwable e2 + (record! group (str (.get entry "name")) false (.getMessage e2)))))))))) + +(defn run-single + "For the few specs that are a single {in,out} rather than a {set}." + [group node actual-fn] + (try + (let [expected (.get ^Map node "out") + actual (actual-fn (.get ^Map node "in"))] + (if (eqv expected actual) + (record! group "single" true nil) + (record! group "single" false (str "Expected: " (s/stringify expected) ", got: " (s/stringify actual))))) + (catch Throwable e (record! group "single" false (.getMessage e))))) + +;; --------------------------------------------------------------------------- +;; Spec access helpers + field getters +;; --------------------------------------------------------------------------- + +(defn- gp [^Map m & ks] (reduce (fn [acc k] (when acc (.get ^Map acc k))) m ks)) +(defn- vget [vin k] (when (s/ismap vin) (.get ^Map vin k))) +(defn- vhas [vin k] (and (s/ismap vin) (.containsKey ^Map vin k))) + +;; --------------------------------------------------------------------------- +;; Test groups +;; --------------------------------------------------------------------------- + +(declare run-walk-log walk-copy-subject walk-depth-subject) + +(defn null-modifier [val key parent & _] + (cond + (= val NULLMARK) (s/setprop parent key nil) + (string? val) (s/setprop parent key (str/replace val NULLMARK "null")))) + +(defn run-all [spec] + (let [minor (gp spec "minor") + walk (gp spec "walk") + mergeS (gp spec "merge") + getpathS (gp spec "getpath") + injectS (gp spec "inject") + transformS (gp spec "transform") + validateS (gp spec "validate") + selectS (gp spec "select") + sentinels (gp spec "sentinels")] + + ;; minor + (run-set "minor.isnode" (gp minor "isnode") s/isnode) + (run-set "minor.ismap" (gp minor "ismap") s/ismap) + (run-set "minor.islist" (gp minor "islist") s/islist) + (run-set "minor.iskey" (gp minor "iskey") {"null" false} s/iskey) + (run-set "minor.strkey" (gp minor "strkey") {"null" false} s/strkey) + (run-set "minor.isempty" (gp minor "isempty") {"null" false} s/isempty) + (run-set "minor.isfunc" (gp minor "isfunc") s/isfunc) + (run-set "minor.clone" (gp minor "clone") {"null" false} s/clone) + (run-set "minor.escre" (gp minor "escre") s/escre) + (run-set "minor.escurl" (gp minor "escurl") s/escurl) + (run-set "minor.stringify" (gp minor "stringify") {"null" false} + (fn [vin] (if (vhas vin "val") (s/stringify (vget vin "val") (vget vin "max")) (s/stringify)))) + (run-set "minor.jsonify" (gp minor "jsonify") {"null" false} + (fn [vin] (s/jsonify (vget vin "val") (vget vin "flags")))) + (run-set "minor.getelem" (gp minor "getelem") {"null" false} + (fn [vin] (let [alt (vget vin "alt")] + (if (nil? alt) (s/getelem (vget vin "val") (vget vin "key")) + (s/getelem (vget vin "val") (vget vin "key") alt))))) + (run-set "minor.delprop" (gp minor "delprop") + (fn [vin] (s/delprop (vget vin "parent") (vget vin "key")))) + (run-set "minor.size" (gp minor "size") {"null" false} s/size) + (run-set "minor.slice" (gp minor "slice") {"null" false} + (fn [vin] (s/slice (vget vin "val") (vget vin "start") (vget vin "end")))) + (run-set "minor.pad" (gp minor "pad") {"null" false} + (fn [vin] (s/pad (vget vin "val") (vget vin "pad") (vget vin "char")))) + (run-set "minor.pathify" (gp minor "pathify") {"null" false} + (fn [vin] (if (vhas vin "path") (s/pathify (vget vin "path") (vget vin "from")) + (s/pathify s/NOARG (vget vin "from"))))) + (run-set "minor.items" (gp minor "items") s/items) + (run-set "minor.getprop" (gp minor "getprop") {"null" false} + (fn [vin] (let [alt (vget vin "alt")] + (if (nil? alt) (s/getprop (vget vin "val") (vget vin "key")) + (s/getprop (vget vin "val") (vget vin "key") alt))))) + (run-set "minor.setprop" (gp minor "setprop") + (fn [vin] (s/setprop (vget vin "parent") (vget vin "key") (vget vin "val")))) + (run-set "minor.haskey" (gp minor "haskey") {"null" false} + (fn [vin] (s/haskey (vget vin "src") (vget vin "key")))) + (run-set "minor.keysof" (gp minor "keysof") s/keysof) + (run-set "minor.join" (gp minor "join") {"null" false} + (fn [vin] (s/join (vget vin "val") (vget vin "sep") (vget vin "url")))) + (run-set "minor.typify" (gp minor "typify") {"null" false} s/typify) + (run-set "minor.setpath" (gp minor "setpath") {"null" false} + (fn [vin] (s/setpath (vget vin "store") (vget vin "path") (vget vin "val")))) + (run-set "minor.filter" (gp minor "filter") + (let [checkmap {"gt3" (fn [n] (> (nth n 1) 3)) "lt3" (fn [n] (< (nth n 1) 3))}] + (fn [vin] (s/filter (vget vin "val") (get checkmap (vget vin "check")))))) + (run-set "minor.typename" (gp minor "typename") s/typename) + (run-set "minor.flatten" (gp minor "flatten") + (fn [vin] (s/flatten (vget vin "val") (vget vin "depth")))) + + ;; walk + (run-walk-log "walk.log" (gp walk "log")) + (run-set "walk.basic" (gp walk "basic") + (fn [vin] (s/walk vin (fn [_k val _p path] + (if (string? val) + (str val "~" (str/join "." (map str (vec path)))) + val))))) + (run-set "walk.copy" (gp walk "copy") walk-copy-subject) + (run-set "walk.depth" (gp walk "depth") {"null" false} walk-depth-subject) + + ;; merge + (run-single "merge.basic" (gp mergeS "basic") (fn [in] (s/merge (s/clone in)))) + (run-set "merge.cases" (gp mergeS "cases") s/merge) + (run-set "merge.array" (gp mergeS "array") s/merge) + (run-set "merge.integrity" (gp mergeS "integrity") s/merge) + (run-set "merge.depth" (gp mergeS "depth") + (fn [vin] (s/merge (vget vin "val") (vget vin "depth")))) + + ;; getpath + (run-set "getpath.basic" (gp getpathS "basic") + (fn [vin] (s/getpath (vget vin "store") (vget vin "path")))) + (run-set "getpath.relative" (gp getpathS "relative") + (fn [vin] (let [dpath (vget vin "dpath") + dpath (when (string? dpath) (let [a (ArrayList.)] (doseq [x (.split ^String dpath "\\." -1)] (.add a x)) a)) + injdef (omap "dparent" (vget vin "dparent") "dpath" dpath)] + (s/getpath (vget vin "store") (vget vin "path") injdef)))) + (run-set "getpath.special" (gp getpathS "special") + (fn [vin] (s/getpath (vget vin "store") (vget vin "path") (vget vin "inj")))) + (run-set "getpath.handler" (gp getpathS "handler") + (fn [vin] (let [handler (fn [inj val ref store] (if (s/isfunc val) (val) val)) + store (omap "$TOP" (vget vin "store") "$FOO" (fn [& _] "foo"))] + (s/getpath store (vget vin "path") (omap "handler" handler))))) + + ;; inject + (run-single "inject.basic" (gp injectS "basic") + (fn [in] (s/inject (s/clone (.get ^Map in "val")) (s/clone (.get ^Map in "store"))))) + (run-set "inject.string" (gp injectS "string") + (fn [vin] (s/inject (vget vin "val") (vget vin "store") + (omap "modify" null-modifier "extra" (vget vin "current"))))) + (run-set "inject.deep" (gp injectS "deep") + (fn [vin] (s/inject (vget vin "val") (vget vin "store")))) + + ;; transform + (run-single "transform.basic" (gp transformS "basic") + (fn [in] (s/transform (.get ^Map in "data") (.get ^Map in "spec") (.get ^Map in "store")))) + (doseq [g ["paths" "cmds" "each" "pack" "ref"]] + (run-set (str "transform." g) (gp transformS g) + (fn [vin] (s/transform (vget vin "data") (vget vin "spec") (vget vin "store"))))) + (run-set "transform.modify" (gp transformS "modify") + (fn [vin] (s/transform (vget vin "data") (vget vin "spec") + (omap "modify" (fn [val key parent inj] + (when (and (some? key) (some? parent) (string? val)) + (s/setprop parent key (str "@" val)))) + "extra" (vget vin "store"))))) + (run-set "transform.format" (gp transformS "format") {"null" false} + (fn [vin] (s/transform (vget vin "data") (vget vin "spec")))) + (run-set "transform.apply" (gp transformS "apply") + (fn [vin] (s/transform (vget vin "data") (vget vin "spec")))) + + ;; validate + (run-set "validate.basic" (gp validateS "basic") {"null" false} + (fn [vin] (s/validate (vget vin "data") (vget vin "spec")))) + (doseq [g ["child" "one" "exact"]] + (run-set (str "validate." g) (gp validateS g) + (fn [vin] (s/validate (vget vin "data") (vget vin "spec"))))) + (run-set "validate.invalid" (gp validateS "invalid") {"null" false} + (fn [vin] (s/validate (vget vin "data") (vget vin "spec")))) + (run-set "validate.special" (gp validateS "special") + (fn [vin] (s/validate (vget vin "data") (vget vin "spec") (vget vin "inj")))) + + ;; select + (doseq [g ["basic" "operators" "edge" "alts"]] + (run-set (str "select." g) (gp selectS g) + (fn [vin] (s/select (vget vin "obj") (vget vin "query"))))) + + ;; sentinels + (run-set "sentinels.getprop_unify" (gp sentinels "getprop_unify") {"null" false} + (fn [vin] (s/getprop (vget vin "val") (vget vin "key") (vget vin "alt")))) + (run-set "sentinels.getelem_absent" (gp sentinels "getelem_absent") {"null" false} + (fn [vin] (s/getelem (vget vin "val") (vget vin "key") (vget vin "alt")))) + (run-set "sentinels.haskey_unify" (gp sentinels "haskey_unify") {"null" false} + (fn [vin] (s/haskey (vget vin "val") (vget vin "key")))) + (run-set "sentinels.isempty_unify" (gp sentinels "isempty_unify") {"null" false} s/isempty) + (run-set "sentinels.isnode_unify" (gp sentinels "isnode_unify") {"null" false} s/isnode) + (run-set "sentinels.stringify_null" (gp sentinels "stringify_null") {"null" false} + (fn [vin] (s/stringify vin))))) + +;; --------------------------------------------------------------------------- +;; Special walk subjects +;; --------------------------------------------------------------------------- + +(defn run-walk-log [group node] + (try + (let [test-data (s/clone node) + log (ArrayList.) + walklog (fn [key val parent path] + (.add log (str "k=" (if (nil? key) (s/stringify) (s/stringify key)) + ", v=" (s/stringify val) + ", p=" (if (nil? parent) (s/stringify) (s/stringify parent)) + ", t=" (s/pathify path))) + val)] + (s/walk (.get ^Map test-data "in") walklog) + (if (eqv (s/getprop (.get ^Map test-data "out") "after") log) + (record! group "log" true nil) + (record! group "log" false (str "Expected: " (s/stringify (s/getprop (.get ^Map test-data "out") "after")) + ", got: " (s/stringify log))))) + (catch Throwable e (record! group "log" false (.getMessage e))))) + +(defn walk-copy-subject [vin] + (let [cur (atom (doto (ArrayList.) (.add nil)))] + (letfn [(walkcopy [key val _parent path] + (if (nil? key) + (do (reset! cur (doto (ArrayList.) (.add nil))) + (.set ^List @cur 0 (cond (s/ismap val) (LinkedHashMap.) (s/islist val) (ArrayList.) :else val)) + val) + (let [i (s/size path) + v (if (s/isnode val) + (let [^List c @cur] + (while (<= (.size c) i) (.add c nil)) + (let [nv (if (s/ismap val) (LinkedHashMap.) (ArrayList.))] + (.set c (int i) nv) nv)) + val)] + (s/setprop (.get ^List @cur (int (dec i))) key v) + val)))] + (s/walk vin {:before walkcopy}) + (.get ^List @cur 0)))) + +(defn walk-depth-subject [vin] + (let [state (atom {:top nil :cur nil})] + (letfn [(copy [key val _parent _path] + (if (or (nil? key) (s/isnode val)) + (let [child (if (s/islist val) (ArrayList.) (LinkedHashMap.))] + (if (nil? key) + (swap! state assoc :top child :cur child) + (do (s/setprop (:cur @state) key child) + (swap! state assoc :cur child)))) + (s/setprop (:cur @state) key val)) + val)] + (s/walk (vget vin "src") {:before copy :maxdepth (vget vin "maxdepth")}) + (:top @state)))) + +;; --------------------------------------------------------------------------- +;; main +;; --------------------------------------------------------------------------- + +(defn -main [& args] + (let [testfile (or (first args) "../build/test/test.json") + raw (slurp testfile) + alltests (json-read raw) + spec (.get ^Map alltests "struct")] + (binding [*results* (atom {:pass [] :fail []})] + (run-all spec) + (let [r @*results* + np (count (:pass r)) + nf (count (:fail r))] + (doseq [f (:fail r)] + (println "FAIL" (:group f) (:name f) "-" (:msg f))) + (println) + (println (str "PASS " np " FAIL " nf)) + (when (pos? nf) (System/exit 1)))))) diff --git a/dart/AGENTS.md b/dart/AGENTS.md new file mode 100644 index 00000000..1e729a1e --- /dev/null +++ b/dart/AGENTS.md @@ -0,0 +1,70 @@ +# AGENTS.md — Dart port of `voxgig/struct` + +Read the repo-root [`../AGENTS.md`](../AGENTS.md) first. This file covers only +what is specific to the Dart port. **TypeScript is canonical; the shared +`build/test/*.jsonic` corpus is the contract.** This port follows the +single-`null` model of the Python / Clojure / Lua ports (Dart has one `null`), +not the distinct-`undefined`/`null` model of the OCaml / Scala ports. + +## How to build / test / lint + +``` +cd dart +make test # dart run test/runner.dart — runs build/test/test.json +make lint # dart analyze (a clean analysis = pass) +``` + +Requires only the Dart SDK. **Zero third-party runtime dependencies** — the +library uses only `dart:core`; the test runner additionally uses the SDK's +`dart:convert` (to read the corpus) and `dart:io` (to read the file). + +## The value model + +Nodes are **native Dart collections**, which are mutable and reference-stable +exactly as the algorithm needs: + +- **maps → `Map`** — Dart's default `{}` is a `LinkedHashMap` + (insertion-ordered; re-assigning an existing key keeps its position). +- **lists → growable `List`**. + +`ismap`/`islist`/`isnode` test `is Map` / `is List`; `isfunc` tests +`is Function`. All node-creating code builds `{}` / +`[]`. **Never** hand a node an unmodifiable/fixed-length list. + +## `null` is both `undefined` and JSON `null` + +Like Python, Dart has a single `null`, so the canonical `undefined` (absent) +and JSON `null` both map to `null`. The Group A/B rules +([`../design/UNDEF_SPEC.md`](../design/UNDEF_SPEC.md)) recover the distinction: + +- Group A readers (`getprop`, `getelem`, `haskey`, `isnode`, `isempty`) treat a + stored `null` as "no value". +- Group B processors (`setprop`, `clone`, `merge`, `walk`, `inject`, + `transform`, `validate`, `select`) preserve `null` literally; `_lookup` is + the internal raw reader. + +A private `_noarg` sentinel (exposed publicly as `pathifyNoArg`) distinguishes +"no argument supplied" from `null` for `typify` (→ `T_noval` vs `T_null`), +`stringify` (→ `""` vs `"null"`), and `pathify` (→ `` vs +``). + +## Naming + +Public names are the canonical lower-smushed / camelCased names (`getpath`, +`ismap`, `re_find_all`, `checkPlacement`, `injectorArgs`, `injectChild`), so the +case/underscore-insensitive parity check matches them. (A leading underscore is +*private* in Dart, so canonical names never start with `_`.) + +## Gotchas + +- **`SKIP` / `DELETE`** are `_Sentinel` instances compared with `identical` + (`isSkip` / `isDelete`). +- The `Inj` injection state is a plain class; an `injdef` passed by callers is + just a `Map` (functions can live in a `Map`), so there is no + separate options type. +- **Numbers.** JSON integers parse to `int`, decimals to `double`. `typify` + treats a whole `double` as an integer (`Number.isInteger` semantics); + `stringify`/`jsonify` follow JS formatting (an integral `double` prints + without `.0`). +- Keep `make test` and `python3 ../tools/check_parity.py` green, and add no + runtime dependencies. Change canonical (TS + corpus) first, then propagate. diff --git a/dart/DOCS.md b/dart/DOCS.md new file mode 100644 index 00000000..d78fb0fc --- /dev/null +++ b/dart/DOCS.md @@ -0,0 +1,114 @@ +# Dart port — comprehensive guide + +This document covers the Dart-specific details of `voxgig/struct`. For the +language-neutral concepts, tutorial and full reference, read the top-level +[`../DOCS.md`](../DOCS.md); for the user overview, [`README.md`](./README.md). +TypeScript is canonical and the shared `build/test` corpus is the contract. + +## Installation + +The whole library is one file (`lib/voxgig_struct.dart`) with no third-party +dependencies. Depend on it as a package and +`import 'package:voxgig_struct/voxgig_struct.dart' as s;` (a prefix is +recommended — several names, e.g. `clone`, would otherwise collide). + +## Representation of data + +| JSON-shape thing | Dart representation | +|-------------------------|-------------------------------------------| +| object / map | `Map` (insertion order) | +| array / list | growable `List` | +| string | `String` | +| integer | `int` | +| decimal | `double` | +| boolean | `bool` | +| JSON `null` / undefined | `null` | +| function (commands) | a Dart `Function` | + +Nodes are **mutable and reference-stable** on purpose: `merge`, `walk`, +`inject`, `transform`, `validate` mutate nodes in place and depend on shared +references. Build nodes with map/list literals (or `jm` / `jt`); Dart's default +`Map` preserves insertion order and keeps a key's position on re-assignment. + +### `null`: undefined vs JSON null + +Dart has a single `null`, used for both the canonical `undefined` and JSON +`null`. The library follows the Group A / Group B rules +([`../design/UNDEF_SPEC.md`](../design/UNDEF_SPEC.md)): + +- **Group A** readers — `getprop`, `getelem`, `haskey`, `isnode`, `isempty` — + treat a stored `null` as "no value". +- **Group B** processors — `setprop`, `clone`, `merge`, `walk`, `inject`, + `transform`, `validate`, `select` — preserve `null` literally. + +Where a function must tell "no argument" from an explicit `null`, pass the +public `pathifyNoArg` sentinel: + +```dart +s.typify(); // T_noval (no argument = undefined) +s.typify(null); // T_scalar | T_null +s.stringify(); // "" (undefined) +s.stringify(null); // "null" (JSON null) +s.pathify(s.pathifyNoArg); // "" +``` + +## The public API + +Names are lower-smushed / camelCased, identical (case/underscore-insensitively) +to the canonical export list: + +- **Lookups / paths:** `getpath`, `setpath`, `getprop`, `setprop`, `getelem`, + `delprop`, `haskey`, `keysof`, `items`. +- **Predicates / kinds:** `isnode`, `ismap`, `islist`, `iskey`, `isfunc`, + `isempty`, `typify`, `typename`. +- **Values:** `clone`, `merge`, `walk`, `size`, `slice`, `pad`, `flatten`, + `filter`, `getdef`, `strkey`. +- **Strings / formatting:** `stringify`, `jsonify`, `pathify`, `join`, + `escre`, `escurl`. +- **Regex (RE2-subset uniform API):** `re_compile`, `re_find`, `re_find_all`, + `re_replace`, `re_test`, `re_escape`. Backed by the core `RegExp`. +- **By-example engine:** `inject`, `transform`, `validate`, `select`, and the + injector helpers `checkPlacement`, `injectorArgs`, `injectChild`. +- **Builders / markers:** `jm`, `jt`, `SKIP`, `DELETE`, the `T_*` type + constants and `M_KEYPRE` / `M_KEYPOST` / `M_VAL`. + +`walk` takes named optional parameters (`before:` / `after:` / `maxdepth:`); +most other optional arguments are positional, e.g. `getprop(val, key, [alt])`, +`slice(val, [start, end, mutate])`, `stringify([val, maxlen, pretty])`, +`merge(objs, [maxdepth])`. + +## Examples + +```dart +import 'package:voxgig_struct/voxgig_struct.dart' as s; + +// merge (later wins; the first node is modified in place) +s.merge([{'a': 1}, {'b': 2}]); // {a: 1, b: 2} + +// transform: spec mirrors the desired output, backticks pull from data +s.transform({'name': 'alice'}, {'user': {'id': '`name`'}}); // {user: {id: alice}} + +// validate: plain values are typed defaults; `$STRING` etc. are commands +s.validate({'a': 'x'}, {'a': '`\$STRING`'}); // {a: x} + +// select: MongoDB-style query over children +s.select([{'a': 1}, {'a': 2}], {'a': {'`\$GT`': 1}}); // [{a: 2, $KEY: 1}] +``` + +## Testing + +`make test` runs the entire shared corpus (`../build/test/test.json`) through +the port via `dart run test/runner.dart`, using the SDK's `dart:convert` to +read the corpus into the same native types the library operates on, and the +same runner logic as every other port. Keep it green, keep +`python3 ../tools/check_parity.py` green, and add no runtime dependencies. + +## Implementation notes + +- The injection state (`Inj`) is a plain class; a caller-supplied `injdef` is + just a `Map` (functions can live in a `Map`). +- `SKIP` / `DELETE` are `_Sentinel` markers compared with `identical`. +- Numbers follow JS formatting in `stringify` / `jsonify` (an integral `double` + prints without a trailing `.0`). +- The only regex is the core `RegExp`, which covers the RE2 subset the corpus + uses for `$LIKE` and the `re_*` API. diff --git a/dart/Makefile b/dart/Makefile new file mode 100644 index 00000000..315b06eb --- /dev/null +++ b/dart/Makefile @@ -0,0 +1,31 @@ +# Makefile for the Dart port of voxgig/struct. +# Requires the Dart SDK (`dart`) on PATH. No third-party dependencies. + +.PHONY: test lint build inspect clean reset publish format + +# Run the shared JSON corpus through the Dart implementation. +test: + dart run test/runner.dart + +# "Lint": static analysis (a clean `dart analyze` means the code is sound). +lint: + dart analyze + +# Compile the library to a kernel snapshot as a build smoke-test. +build: + dart compile kernel lib/voxgig_struct.dart -o /dev/null 2>/dev/null || dart analyze lib + +format: + dart format --output=none --set-exit-if-changed lib test + +inspect: + @dart --version + +clean: + rm -rf .dart_tool *.dill + +reset: clean + +# The library publishes to pub.dev; this target creates the git tag. +publish: + @echo "dart: publish via 'dart pub publish' + git tag dart/vX.Y.Z" diff --git a/dart/README.md b/dart/README.md new file mode 100644 index 00000000..ec2e806e --- /dev/null +++ b/dart/README.md @@ -0,0 +1,75 @@ +# voxgig_struct — Dart + +A Dart port of [`voxgig/struct`](../README.md): one small, fixed API for +manipulating JSON-shaped data — lookups, deep merge, by-example transform, +by-example validate, tree walk, path get/set, selection — that returns the +**same answer** as the canonical TypeScript implementation and every other +port. The behavioural contract is the shared JSON corpus in +[`build/test/`](../build/test); this port passes it in full. + +## Status + +Complete. Every canonical public function is implemented and the entire +shared corpus passes (`make test`). **Zero third-party dependencies** — only +the Dart SDK is required. + +## Requirements + +- The [Dart SDK](https://dart.dev/get-dart) 3.0 or later. + +## Use + +```dart +import 'package:voxgig_struct/voxgig_struct.dart' as s; + +void main() { + final store = {'a': {'b': 2}}; + print(s.getpath(store, 'a.b')); // 2 + + print(s.stringify(s.transform({'a': 1}, {'x': '`a`'}))); // {x:1} +} +``` + +`jm` / `jt` are convenient JSON-object / JSON-array builders (they take a list +of arguments): + +```dart +s.jsonify(s.jm(['a', 1, 'b', s.jt([2, 3])])); +``` + +### Data model + +Nodes are native Dart collections so the library's in-place, reference-stable +algorithms behave exactly as in the canonical TypeScript: + +- maps → `Map` (a `LinkedHashMap`, insertion-ordered), +- lists → growable `List`, +- `null` plays the role of both `undefined` and JSON `null` (the Group A/B + rules recover the distinction — see + [`../design/UNDEF_SPEC.md`](../design/UNDEF_SPEC.md)). + +## API + +The public surface matches the canonical export list, in lower-smushed / +camelCased names: + +`clone delprop escre escurl filter flatten getdef getelem getpath getprop +haskey inject isempty isfunc iskey islist ismap isnode items join jsonify +keysof merge pad pathify select setpath setprop size slice strkey stringify +transform typify typename validate walk re_compile re_find re_find_all +re_replace re_test re_escape jm jt checkPlacement injectorArgs injectChild` + +See [`DOCS.md`](./DOCS.md) for the full guide and +[the language-neutral docs](../DOCS.md) for concepts and examples. + +## Develop + +``` +make test # run the shared corpus +make lint # dart analyze +make format # dart format check +``` + +## License + +MIT. See [`../LICENSE`](../LICENSE). diff --git a/dart/lib/voxgig_struct.dart b/dart/lib/voxgig_struct.dart new file mode 100644 index 00000000..7efff137 --- /dev/null +++ b/dart/lib/voxgig_struct.dart @@ -0,0 +1,2456 @@ +// Copyright (c) 2025-2026 Voxgig Ltd. MIT LICENSE. +// +// Voxgig Struct — Dart port. +// +// A faithful port of the canonical TypeScript implementation +// (typescript/src/StructUtility.ts), following the same "by-example" design. +// Like the Python, Clojure and Lua ports, Dart has a single `null`, so the +// canonical `undefined` and JSON `null` are both represented by `null`; the +// Group A/B rules (design/UNDEF_SPEC.md) recover the distinction where it +// matters, and a private NOARG sentinel distinguishes "no argument supplied". +// +// Nodes are native Dart collections — `Map` (a LinkedHashMap, +// insertion-ordered) and growable `List` — which are mutable and +// reference-stable, exactly as the algorithm requires. The only regex used is +// the Dart core `RegExp`. There are no third-party runtime dependencies. + +// --------------------------------------------------------------------------- +// Sentinels / constants +// --------------------------------------------------------------------------- + +class _NoArg { + const _NoArg(); +} + +const _noarg = _NoArg(); + +/// Public alias for the "no argument supplied" sentinel, used by callers (e.g. +/// the test runner) to drive `pathify` with an *absent* value (not `null`). +const pathifyNoArg = _noarg; + +class _Sentinel { + final String tag; + _Sentinel(this.tag); +} + +final SKIP = _Sentinel('skip'); +final DELETE = _Sentinel('delete'); + +const S_MKEYPRE = 'key:pre'; +const S_MKEYPOST = 'key:post'; +const S_MVAL = 'val'; + +const M_KEYPRE = 1; +const M_KEYPOST = 2; +const M_VAL = 4; + +final Map _MODE_TO_NUM = { + S_MKEYPRE: M_KEYPRE, + S_MKEYPOST: M_KEYPOST, + S_MVAL: M_VAL, +}; + +const MODENAME = {M_VAL: 'val', M_KEYPRE: 'key:pre', M_KEYPOST: 'key:post'}; + +const S_DKEY = '\$KEY'; +const S_BANNO = '`\$ANNO`'; +const S_DTOP = '\$TOP'; +const S_DERRS = '\$ERRS'; +const S_DSPEC = '\$SPEC'; +const S_BEXACT = '`\$EXACT`'; +const S_BVAL = '`\$VAL`'; +const S_BKEY = '`\$KEY`'; +const S_BOPEN = '`\$OPEN`'; + +const S_MT = ''; +const S_BT = '`'; +const S_DS = '\$'; +const S_DT = '.'; +const S_CN = ':'; +const S_KEY = 'KEY'; +const S_VIZ = ': '; + +const S_string = 'string'; +const S_object = 'object'; +const S_list = 'list'; +const S_map = 'map'; +const S_nil = 'nil'; +const S_null = 'null'; + +const T_any = (1 << 31) - 1; +const T_noval = 1 << 30; +const T_boolean = 1 << 29; +const T_decimal = 1 << 28; +const T_integer = 1 << 27; +const T_number = 1 << 26; +const T_string = 1 << 25; +const T_function = 1 << 24; +const T_null = 1 << 22; +const T_list = 1 << 14; +const T_map = 1 << 13; +const T_instance = 1 << 12; +const T_scalar = 1 << 7; +const T_node = 1 << 6; + +const _TYPENAME = [ + 'any', + 'nil', + 'boolean', + 'decimal', + 'integer', + 'number', + 'string', + 'function', + 'symbol', + 'null', + '', + '', + '', + '', + '', + '', + '', + 'list', + 'map', + 'instance', + '', + '', + '', + '', + 'scalar', + 'node' +]; + +const MAXDEPTH = 32; + +final _R_INJECT_FULL = RegExp(r'^`(\$[A-Z]+|[^`]*)[0-9]*`$'); +final _R_INJECT_PART = RegExp(r'`([^`]*)`'); +final _R_META_PATH = RegExp(r'^([^$]+)\$([=~])(.+)$'); +final _R_TRANSFORM_NAME = RegExp(r'`\$([A-Z]+)`'); + +// --------------------------------------------------------------------------- +// Low-level helpers +// --------------------------------------------------------------------------- + +bool isSkip(dynamic v) => identical(v, SKIP); +bool isDelete(dynamic v) => identical(v, DELETE); + +bool _isInteger(num n) => + n is int || (n is double && n.isFinite && n == n.truncateToDouble()); + +String numToString(num n) { + if (n is double) { + if (n.isNaN) return 'NaN'; + if (n.isInfinite) return n > 0 ? 'Infinity' : '-Infinity'; + if (n == n.truncateToDouble() && n.abs() < 1e16) + return n.toInt().toString(); + return n.toString(); + } + return n.toString(); +} + +String jsString(dynamic v) { + if (v == null) return 'null'; + if (v is bool) return v ? 'true' : 'false'; + if (v is num) return numToString(v); + if (v is String) return v; + if (v is List) return v.map((x) => (x == null) ? '' : jsString(x)).join(','); + if (v is Map) return '[object Object]'; + if (v is Function) return 'function'; + return v.toString(); +} + +String _mapKey(dynamic k) => + k is String ? k : (k is num ? numToString(k) : jsString(k)); + +int? _toInt(dynamic k) { + if (k is bool) return null; + if (k is int) return k; + if (k is double) return k.floor(); + if (k is String) return int.tryParse(k.trim()); + return null; +} + +int _clz32(int n0) { + var n = n0 & 0xFFFFFFFF; + if (n == 0) return 32; + var r = 0; + while ((n & 0x80000000) == 0) { + r++; + n = (n << 1) & 0xFFFFFFFF; + } + return r; +} + +// --------------------------------------------------------------------------- +// Minor utilities +// --------------------------------------------------------------------------- + +bool isnode(dynamic v) => v is Map || v is List; +bool ismap(dynamic v) => v is Map; +bool islist(dynamic v) => v is List; +bool isfunc(dynamic v) => v is Function; + +bool iskey(dynamic k) { + if (k is String) return k.isNotEmpty; + if (k is bool) return false; + if (k is num) return true; + return false; +} + +bool isempty([dynamic v]) { + if (v == null) return true; + if (v == '') return true; + if (v is List) return v.isEmpty; + if (v is Map) return v.isEmpty; + return false; +} + +dynamic getdef(dynamic v, dynamic alt) => v == null ? alt : v; + +int typify([dynamic value = _noarg]) { + if (identical(value, _noarg)) return T_noval; + if (value == null) return T_scalar | T_null; + if (value is bool) return T_scalar | T_boolean; + if (value is int) return T_scalar | T_number | T_integer; + if (value is double) { + if (value.isNaN) return T_noval; + if (value == value.truncateToDouble()) + return T_scalar | T_number | T_integer; + return T_scalar | T_number | T_decimal; + } + if (value is num) return T_scalar | T_number | T_integer; + if (value is String) return T_scalar | T_string; + if (value is Function) return T_scalar | T_function; + if (value is List) return T_node | T_list; + if (value is Map) return T_node | T_map; + return T_node | T_instance; +} + +String typename([int t = 0]) { + var i = _clz32(t); + return (i >= 0 && i < _TYPENAME.length) ? _TYPENAME[i] : _TYPENAME[0]; +} + +int size([dynamic v]) { + if (v is List) return v.length; + if (v is Map) return v.length; + if (v is String) return v.length; + if (v is bool) return v ? 1 : 0; + if (v is num) return v.floor(); + return 0; +} + +String strkey([dynamic key]) { + if (key == null) return S_MT; + if (key is String) return key; + if (key is bool) return S_MT; + if (key is num) + return _isInteger(key) + ? numToString(key) + : numToString(key.floorToDouble()); + return S_MT; +} + +List keysof([dynamic v]) { + if (v is Map) { + var ks = v.keys.map((k) => k.toString()).toList(); + ks.sort(); + return ks; + } + if (v is List) return List.generate(v.length, (i) => i.toString()); + return []; +} + +dynamic getprop(dynamic val, dynamic key, [dynamic alt]) { + if (val == null || key == null) return alt; + dynamic out = alt; + if (val is Map) { + var sk = _mapKey(key); + if (val.containsKey(sk)) out = val[sk]; + } else if (val is List) { + var ki = _toInt(key); + if (ki != null && ki >= 0 && ki < val.length) out = val[ki]; + } + if (out == null) return alt; + return out; +} + +dynamic _lookup(dynamic val, dynamic key) { + if (val == null || key == null) return null; + if (val is Map) { + var sk = _mapKey(key); + return val.containsKey(sk) ? val[sk] : null; + } + if (val is List) { + var ki = _toInt(key); + return (ki != null && ki >= 0 && ki < val.length) ? val[ki] : null; + } + return null; +} + +bool haskey([dynamic val, dynamic key]) => getprop(val, key) != null; + +final _R_INTKEY = RegExp(r'^-?[0-9]+$'); + +dynamic getelem(dynamic val, dynamic key, [dynamic alt]) { + if (val == null || key == null) return alt; + dynamic out; + if (val is List) { + var ks = key is String ? key : (key is num ? numToString(key) : ''); + if (_R_INTKEY.hasMatch(ks)) { + var len = val.length; + var nk0 = int.parse(ks); + var nk = nk0 < 0 ? len + nk0 : nk0; + if (nk >= 0 && nk < len) out = val[nk]; + } + } + if (out == null) { + return isfunc(alt) ? alt() : alt; + } + return out; +} + +dynamic _getpropRaw(dynamic v, String k) { + if (v is Map) return v.containsKey(k) ? v[k] : null; + if (v is List) { + var i = int.tryParse(k); + return (i != null && i >= 0 && i < v.length) ? v[i] : null; + } + return null; +} + +List> itemsPairs(dynamic v) { + if (!isnode(v)) return []; + return keysof(v).map((k) => [k, _getpropRaw(v, k)]).toList(); +} + +dynamic items([dynamic v]) => + itemsPairs(v).map((p) => [p[0], p[1]]).toList(); + +dynamic itemsV(dynamic v, dynamic Function(List) f) => + itemsPairs(v).map(f).toList(); + +dynamic flatten(dynamic l, [int depth = 1]) { + if (l is! List) return l; + var out = []; + for (var item in l) { + if (item is List && depth > 0) { + for (var x in (flatten(item, depth - 1) as List)) { + out.add(x); + } + } else { + out.add(item); + } + } + return out; +} + +dynamic filter(dynamic val, bool Function(List) check) { + var out = []; + for (var p in itemsPairs(val)) { + if (check(p)) out.add(p[1]); + } + return out; +} + +dynamic setprop(dynamic parent, dynamic key, dynamic val) { + if (!iskey(key)) return parent; + if (parent is Map) { + parent[_mapKey(key)] = val; + } else if (parent is List) { + var ki = _toInt(key is num ? key.floor() : key); + if (ki == null) return parent; + var len = parent.length; + if (ki >= 0) { + if (ki > len) ki = len; + if (ki >= len) { + parent.add(val); + } else { + parent[ki] = val; + } + } else { + parent.insert(0, val); + } + } + return parent; +} + +dynamic delprop(dynamic parent, dynamic key) { + if (!iskey(key)) return parent; + if (parent is Map) { + parent.remove(_mapKey(key)); + } else if (parent is List) { + var ki = _toInt(key); + if (ki != null && ki >= 0 && ki < parent.length) parent.removeAt(ki); + } + return parent; +} + +dynamic clone([dynamic v]) { + if (v is Map) { + var o = {}; + v.forEach((k, x) => o[k.toString()] = clone(x)); + return o; + } + if (v is List) { + return v.map((x) => clone(x)).toList(); + } + return v; +} + +dynamic slice(dynamic val, [dynamic start, dynamic end, bool mutate = false]) { + if (val is num) { + num? lo = start is num ? start : null; + num? hi = end is num ? (end - 1) : null; + if (hi != null && val > hi) return hi; + if (lo != null && val < lo) return lo; + return val; + } + if (val is List || val is String) { + var vlen = size(val); + if (start == null && end != null) start = 0; + if (start == null) return val; + var s = (start as num).toInt(); + var e = 0; + if (s < 0) { + e = vlen + s; + if (e < 0) e = 0; + s = 0; + } else if (end != null) { + e = (end as num).toInt(); + if (e < 0) { + e = vlen + e; + if (e < 0) e = 0; + } else if (vlen < e) { + e = vlen; + } + } else { + e = vlen; + } + if (vlen < s) s = vlen; + if (s > -1 && s <= e && e <= vlen) { + if (val is List) { + if (mutate) { + var sub = val.sublist(s, e); + val + ..clear() + ..addAll(sub); + return val; + } + return val.sublist(s, e); + } + return (val as String).substring(s, e); + } else { + if (val is List) { + if (mutate) { + val.clear(); + return val; + } + return []; + } + return S_MT; + } + } + return val; +} + +// --------------------------------------------------------------------------- +// Regex helpers (uniform re_* API over RegExp) +// --------------------------------------------------------------------------- + +RegExp _rx(dynamic p) => + p is RegExp ? p : RegExp(p is String ? p : jsString(p)); + +dynamic re_compile(dynamic p, [dynamic flags]) => _rx(p); +dynamic re_test(dynamic p, dynamic input) => + _rx(p).hasMatch(input is String ? input : jsString(input)); +dynamic re_find(dynamic p, dynamic input) { + var m = _rx(p).firstMatch(input is String ? input : jsString(input)); + if (m == null) return null; + return [for (var i = 0; i <= m.groupCount; i++) m.group(i) ?? '']; +} + +dynamic re_find_all(dynamic p, dynamic input) { + var out = []; + for (var m in _rx(p).allMatches(input is String ? input : jsString(input))) { + out.add([for (var i = 0; i <= m.groupCount; i++) m.group(i) ?? '']); + } + return out; +} + +dynamic re_replace(dynamic p, dynamic input, dynamic repl) { + var s = input is String ? input : jsString(input); + if (repl is Function) { + return s.replaceAllMapped(_rx(p), (m) { + var groups = [for (var i = 0; i <= m.groupCount; i++) m.group(i) ?? '']; + return (repl(groups)).toString(); + }); + } + return s; +} + +dynamic re_escape(dynamic s) => escre(s); + +dynamic escre([dynamic s]) { + var str = s is String ? s : (s == null ? S_MT : jsString(s)); + var b = StringBuffer(); + for (var i = 0; i < str.length; i++) { + var c = str[i]; + if ('.*+?^\$\{\}()|[]\\'.contains(c)) b.write('\\'); + b.write(c); + } + return b.toString(); +} + +const _urlUnreserved = + 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_.!~*\'()'; + +dynamic escurl([dynamic s]) { + var str = s is String ? s : (s == null ? S_MT : jsString(s)); + var b = StringBuffer(); + for (var byte in _utf8(str)) { + var c = String.fromCharCode(byte); + if (_urlUnreserved.contains(c)) { + b.write(c); + } else { + b.write('%${byte.toRadixString(16).toUpperCase().padLeft(2, '0')}'); + } + } + return b.toString(); +} + +List _utf8(String s) { + // Minimal UTF-8 encoder (avoids importing dart:convert in the library). + var out = []; + for (var rune in s.runes) { + if (rune < 0x80) { + out.add(rune); + } else if (rune < 0x800) { + out.add(0xC0 | (rune >> 6)); + out.add(0x80 | (rune & 0x3F)); + } else if (rune < 0x10000) { + out.add(0xE0 | (rune >> 12)); + out.add(0x80 | ((rune >> 6) & 0x3F)); + out.add(0x80 | (rune & 0x3F)); + } else { + out.add(0xF0 | (rune >> 18)); + out.add(0x80 | ((rune >> 12) & 0x3F)); + out.add(0x80 | ((rune >> 6) & 0x3F)); + out.add(0x80 | (rune & 0x3F)); + } + } + return out; +} + +// --------------------------------------------------------------------------- +// JSON-ish serialization / stringify / jsonify +// --------------------------------------------------------------------------- + +void _escJson(String s, StringBuffer b) { + b.write('"'); + for (var i = 0; i < s.length; i++) { + var c = s[i]; + var code = s.codeUnitAt(i); + if (c == '"') { + b.write('\\"'); + } else if (c == '\\') { + b.write('\\\\'); + } else if (c == '\n') { + b.write('\\n'); + } else if (c == '\r') { + b.write('\\r'); + } else if (c == '\t') { + b.write('\\t'); + } else if (code < 32) { + b.write('\\u${code.toRadixString(16).padLeft(4, '0')}'); + } else { + b.write(c); + } + } + b.write('"'); +} + +String jsonEncode(dynamic v, {bool sort = false, int? indent}) { + var b = StringBuffer(); + void enc(dynamic v, int level) { + if (v == null) { + b.write('null'); + } else if (v is bool) { + b.write(v ? 'true' : 'false'); + } else if (v is num) { + b.write(numToString(v)); + } else if (v is String) { + _escJson(v, b); + } else if (v is Function || v is _Sentinel) { + b.write('null'); + } else if (v is List) { + if (v.isEmpty) { + b.write('[]'); + } else if (indent != null) { + var pad = ' ' * (indent * (level + 1)); + var cpad = ' ' * (indent * level); + b.write('[\n'); + for (var i = 0; i < v.length; i++) { + if (i > 0) b.write(',\n'); + b.write(pad); + enc(v[i], level + 1); + } + b.write('\n'); + b.write(cpad); + b.write(']'); + } else { + b.write('['); + for (var i = 0; i < v.length; i++) { + if (i > 0) b.write(','); + enc(v[i], level + 1); + } + b.write(']'); + } + } else if (v is Map) { + var ks = v.keys.map((k) => k.toString()).toList(); + if (sort) ks.sort(); + if (ks.isEmpty) { + b.write('{}'); + } else if (indent != null) { + var pad = ' ' * (indent * (level + 1)); + var cpad = ' ' * (indent * level); + b.write('{\n'); + for (var i = 0; i < ks.length; i++) { + if (i > 0) b.write(',\n'); + b.write(pad); + _escJson(ks[i], b); + b.write(': '); + enc(v[ks[i]], level + 1); + } + b.write('\n'); + b.write(cpad); + b.write('}'); + } else { + b.write('{'); + for (var i = 0; i < ks.length; i++) { + if (i > 0) b.write(','); + _escJson(ks[i], b); + b.write(':'); + enc(v[ks[i]], level + 1); + } + b.write('}'); + } + } else { + _escJson(v.toString(), b); + } + } + + enc(v, 0); + return b.toString(); +} + +bool _hasCycle(dynamic v) { + var seen = []; + bool go(dynamic v) { + if (v is List) { + if (seen.any((s) => identical(s, v))) return true; + seen.add(v); + return v.any(go); + } + if (v is Map) { + if (seen.any((s) => identical(s, v))) return true; + seen.add(v); + return v.values.any(go); + } + return false; + } + + return go(v); +} + +String stringify([dynamic v = _noarg, dynamic maxlen, dynamic pretty]) { + var pr = pretty == true; + if (identical(v, _noarg)) return pr ? '<>' : S_MT; + String valstr; + if (v is String) { + valstr = v; + } else if (_hasCycle(v)) { + valstr = '__STRINGIFY_FAILED__'; + } else { + try { + valstr = jsonEncode(v, sort: true).replaceAll('"', ''); + } catch (_) { + valstr = '__STRINGIFY_FAILED__'; + } + } + if (maxlen is num && maxlen > -1) { + var m = maxlen.toInt(); + if (m < valstr.length) { + valstr = valstr.substring(0, m - 3 < 0 ? 0 : m - 3) + '...'; + } + } + if (pr) { + var colors = [ + 81, + 118, + 213, + 39, + 208, + 201, + 45, + 190, + 129, + 51, + 160, + 121, + 226, + 33, + 207, + 69 + ]; + var c = colors.map((n) => '\x1b[38;5;${n}m').toList(); + var r = '\x1b[0m'; + var d = 0; + var o = c[0]; + var t = StringBuffer(c[0]); + for (var i = 0; i < valstr.length; i++) { + var ch = valstr[i]; + if (ch == '{' || ch == '[') { + d++; + o = c[d % c.length]; + t.write(o); + t.write(ch); + } else if (ch == '}' || ch == ']') { + t.write(o); + t.write(ch); + d--; + o = c[((d % c.length) + c.length) % c.length]; + } else { + t.write(o); + t.write(ch); + } + } + t.write(r); + return t.toString(); + } + return valstr; +} + +String jsonify([dynamic v, dynamic flags]) { + if (v == null) return S_null; + var indent = getprop(flags, 'indent', 2); + var ind = indent is num ? indent.toInt() : 2; + try { + var str = ind > 0 ? jsonEncode(v, indent: ind) : jsonEncode(v); + var offset = getprop(flags, 'offset', 0); + var off = offset is num ? offset.toInt() : 0; + if (off > 0) { + var lines = str.split('\n'); + if (lines.isNotEmpty) { + return '{\n' + lines.sublist(1).map((l) => (' ' * off) + l).join('\n'); + } + } + return str; + } catch (_) { + return S_null; + } +} + +String pad([dynamic s, dynamic padding, dynamic padchar]) { + var str = s is String ? s : (s == null ? 'null' : stringify(s)); + var p = padding is num ? padding.toInt() : 44; + var pc = padchar is String ? (padchar + ' ').substring(0, 1) : ' '; + if (p > -1) { + var n = p - str.length; + return n > 0 ? str + (pc * n) : str; + } else { + var n = (-p) - str.length; + return n > 0 ? (pc * n) + str : str; + } +} + +// --------------------------------------------------------------------------- +// join / pathify / replace +// --------------------------------------------------------------------------- + +String join(dynamic arr, [dynamic sep, dynamic url]) { + if (arr is! List) return S_MT; + var sepdef = (sep == null) ? ',' : (sep is String ? sep : jsString(sep)); + var single = sepdef.length == 1; + var sc = single ? sepdef[0] : ' '; + var isUrl = url == true; + var sarr = arr.length; + String stripTrailing(String s) { + var i = s.length; + while (i > 0 && s[i - 1] == sc) i--; + return s.substring(0, i); + } + + String stripLeading(String s) { + var i = 0; + while (i < s.length && s[i] == sc) i++; + return s.substring(i); + } + + String collapse(String s) { + var b = StringBuffer(); + var i = 0; + var n = s.length; + while (i < n) { + if (s[i] != sc) { + b.write(s[i]); + i++; + } else { + var j = i; + while (j < n && s[j] == sc) j++; + var beforeNon = i > 0 && s[i - 1] != sc; + var afterNon = j < n; + if (beforeNon && afterNon) { + b.write(sc); + } else { + b.write(s.substring(i, j)); + } + i = j; + } + } + return b.toString(); + } + + var out = []; + for (var idx = 0; idx < arr.length; idx++) { + var s0 = arr[idx]; + if (s0 is String && s0 != S_MT) { + String s; + if (single) { + if (isUrl && idx == 0) { + s = stripTrailing(s0); + } else { + var x = idx > 0 ? stripLeading(s0) : s0; + x = (idx < sarr - 1 || !isUrl) ? stripTrailing(x) : x; + s = collapse(x); + } + } else { + s = s0; + } + if (s != S_MT) out.add(s); + } + } + return out.join(sepdef); +} + +String joinurl(dynamic arr) => join(arr, '/', true); + +String replace(dynamic s, dynamic from, dynamic to) { + var ts = typify(s); + String rs; + if ((T_string & ts) == 0) { + rs = stringify(s); + } else if (((T_noval | T_null) & ts) > 0) { + rs = S_MT; + } else { + rs = stringify(s); + } + var toS = to is String ? to : jsString(to); + if (from is String && from.isNotEmpty) return rs.replaceAll(from, toS); + if (from is RegExp) return rs.replaceAll(from, toS); + return rs; +} + +String pathify([dynamic v = _noarg, dynamic startin, dynamic endin]) { + var absent = identical(v, _noarg); + var val = absent ? null : v; + List? path; + if (val is List) { + path = val; + } else if (iskey(val)) { + path = [val]; + } else { + path = null; + } + var start = startin is num ? (startin > -1 ? startin.toInt() : 0) : 0; + var endn = endin is num ? (endin > -1 ? endin.toInt() : 0) : 0; + String? pathstr; + if (path != null && start >= 0) { + var len = path.length; + var e = len - endn; + if (e < 0) e = 0; + var s = start > len ? len : start; + var sub = s <= e ? path.sublist(s, e) : []; + if (sub.isEmpty) { + pathstr = ''; + } else { + var mapped = sub.where(iskey).map((p) { + if (p is num) return numToString(p.floorToDouble()); + return jsString(p).replaceAll('.', S_MT); + }); + pathstr = mapped.join('.'); + } + } + if (pathstr == null) { + pathstr = + ''; + } + return pathstr; +} + +// --------------------------------------------------------------------------- +// walk / merge +// --------------------------------------------------------------------------- + +dynamic walk(dynamic val, + {Function? before, + Function? after, + dynamic maxdepth, + dynamic key, + dynamic parent, + dynamic path}) { + path ??= []; + var depth = size(path); + var out = before == null ? val : before(key, val, parent, path); + var md = (maxdepth is num && maxdepth >= 0) ? maxdepth.toInt() : MAXDEPTH; + if (md == 0 || (md > 0 && md <= depth)) return out; + if (isnode(out)) { + var prefix = List.from(path as List); + for (var pair in itemsPairs(out)) { + var ckey = pair[0] as String; + var child = pair[1]; + var childpath = [...prefix, ckey]; + var result = walk(child, + before: before, + after: after, + maxdepth: md, + key: ckey, + parent: out, + path: childpath); + if (out is Map) { + out[ckey] = result; + } else if (out is List) { + out[int.parse(ckey)] = result; + } + } + } + return after == null ? out : after(key, out, parent, path); +} + +dynamic merge(dynamic objs, [dynamic maxdepth]) { + var md = maxdepth is num ? (maxdepth < 0 ? 0 : maxdepth.toInt()) : MAXDEPTH; + if (objs is! List) return objs; + var lenlist = objs.length; + if (lenlist == 0) return null; + if (lenlist == 1) return objs[0]; + dynamic out = getprop(objs, 0, {}); + for (var oi = 1; oi < lenlist; oi++) { + var obj = objs[oi]; + if (!isnode(obj)) { + out = obj; + } else { + var cur = [out]; + var dst = [out]; + void grow(List a, int n) { + while (a.length <= n) a.add(null); + } + + dynamic before(dynamic key, dynamic val, dynamic parent, dynamic path) { + var pi = size(path); + if (md <= pi) { + grow(cur, pi); + cur[pi] = val; + if (pi > 0) setprop(cur[pi - 1], key, val); + return null; + } else if (!isnode(val)) { + grow(cur, pi); + cur[pi] = val; + return val; + } else { + grow(dst, pi); + grow(cur, pi); + dst[pi] = pi > 0 ? getprop(dst[pi - 1], key) : dst[pi]; + var tval = dst[pi]; + if (tval == null) { + cur[pi] = islist(val) ? [] : {}; + return val; + } else if ((islist(val) && islist(tval)) || + (ismap(val) && ismap(tval))) { + cur[pi] = tval; + return val; + } else { + cur[pi] = val; + return null; + } + } + } + + dynamic after(dynamic key, dynamic val, dynamic parent, dynamic path) { + var ci = size(path); + if (ci < 1) return cur.isNotEmpty ? cur[0] : val; + var target = ci - 1 < cur.length ? cur[ci - 1] : null; + var value = ci < cur.length ? cur[ci] : null; + setprop(target, key, value); + return value; + } + + out = walk(obj, before: before, after: after); + } + } + if (md == 0) { + var o = getprop(objs, lenlist - 1); + out = islist(o) ? [] : (ismap(o) ? {} : o); + } + return out; +} + +// --------------------------------------------------------------------------- +// getpath / setpath +// --------------------------------------------------------------------------- + +dynamic _idef(dynamic injdef, String field) { + if (injdef is Inj) { + switch (field) { + case 'base': + return injdef.base; + case 'dparent': + return injdef.dparent; + case 'meta': + return injdef.meta; + case 'key': + return injdef.key; + case 'dpath': + return injdef.dpath; + case 'handler': + return injdef.handler; + } + return null; + } + return getprop(injdef, field); +} + +dynamic getpath(dynamic store, dynamic path, [dynamic injdef]) { + List? parts; + if (path is List) { + parts = List.from(path); + } else if (path is String) { + parts = path.split(S_DT); + } else if (path is num && path is! bool) { + parts = [strkey(path)]; + } else { + return null; + } + + var hasInj = injdef != null; + var base = _idef(injdef, 'base'); + var dparent = _idef(injdef, 'dparent'); + var injMeta = _idef(injdef, 'meta'); + var injKey = _idef(injdef, 'key'); + var dpath = _idef(injdef, 'dpath'); + var src = iskey(base) ? getprop(store, base, store) : store; + var numparts = parts.length; + dynamic val = store; + + if (path == null || + store == null || + (numparts == 1 && parts[0] == S_MT) || + numparts == 0) { + val = src; + } else { + if (numparts == 1) val = getprop(store, parts[0]); + if (!isfunc(val)) { + val = src; + if (parts[0] is String) { + var m = _R_META_PATH.firstMatch(parts[0]); + if (m != null && injMeta != null && hasInj) { + val = getprop(injMeta, m.group(1)); + parts[0] = m.group(3); + } + } + var pi = 0; + var cont = true; + while (cont && val != null && pi < numparts) { + var raw = parts[pi]; + dynamic part; + if (hasInj && raw == S_DKEY) { + part = injKey != null ? injKey : raw; + } else if (raw is String && raw.startsWith('\$GET:')) { + part = stringify(getpath(src, slice(raw, 5, -1))); + } else if (raw is String && raw.startsWith('\$REF:')) { + part = stringify(getpath(getprop(store, S_DSPEC), slice(raw, 5, -1))); + } else if (hasInj && raw is String && raw.startsWith('\$META:')) { + part = stringify(getpath(injMeta, slice(raw, 6, -1))); + } else { + part = raw; + } + part = part is String ? part.replaceAll('\$\$', '\$') : strkey(part); + if (part == S_MT) { + var ascends = 0; + while (pi + 1 < parts.length && parts[pi + 1] == S_MT) { + ascends++; + pi++; + } + if (hasInj && ascends > 0) { + if (pi == numparts - 1) ascends--; + if (ascends == 0) { + val = dparent; + } else { + var tail = parts.sublist(pi + 1); + var fullpath = flatten([slice(dpath, -ascends), tail]); + val = ascends <= size(dpath) ? getpath(store, fullpath) : null; + cont = false; + } + } else { + val = dparent; + } + } else { + val = getprop(val, part); + } + if (cont) pi++; + } + } + } + + var handler = _idef(injdef, 'handler'); + if (hasInj && isfunc(handler)) { + var ref = pathify(path); + if (injdef is Inj) { + val = handler(injdef, val, ref, store); + } else { + val = handler(_dummyInj(), val, ref, store); + } + } + return val; +} + +dynamic setpath(dynamic store, dynamic path, dynamic val, [dynamic injdef]) { + var ptype = typify(path); + dynamic parts; + if ((T_list & ptype) > 0) { + parts = List.from(path as List); + } else if ((T_string & ptype) > 0) { + parts = (path as String).split(S_DT); + } else if ((T_number & ptype) > 0) { + parts = [path]; + } else { + return null; + } + var base = injdef != null ? _idef(injdef, 'base') : null; + var numparts = size(parts); + var parent = iskey(base) ? getprop(store, base, store) : store; + for (var pi = 0; pi < numparts - 1; pi++) { + var pkey = getelem(parts, pi); + var np = getprop(parent, pkey); + if (!isnode(np)) { + var nextpart = getelem(parts, pi + 1); + np = + (T_number & typify(nextpart)) > 0 ? [] : {}; + setprop(parent, pkey, np); + } + parent = np; + } + if (isDelete(val)) { + delprop(parent, getelem(parts, -1)); + } else { + setprop(parent, getelem(parts, -1), val); + } + return parent; +} + +// --------------------------------------------------------------------------- +// Injection state +// --------------------------------------------------------------------------- + +class Inj { + String mode = S_MVAL; + bool full = false; + int keyi = 0; + dynamic keys; + dynamic key; + dynamic ival; + dynamic parent; + dynamic path; + dynamic nodes; + Function handler = injectHandler; + dynamic errs; + dynamic meta; + dynamic dparent; + dynamic dpath; + dynamic base; + Function? modify; + Inj? prior; + dynamic extra; + dynamic root; +} + +Inj? _dummy; +Inj _dummyInj() { + _dummy ??= _newInj(null, {S_DTOP: null}); + return _dummy!; +} + +Inj _newInj(dynamic val, dynamic parent) { + var i = Inj(); + i.mode = S_MVAL; + i.full = false; + i.keyi = 0; + i.keys = [S_DTOP]; + i.key = S_DTOP; + i.ival = val; + i.parent = parent; + i.path = [S_DTOP]; + i.nodes = [parent]; + i.handler = injectHandler; + i.errs = []; + i.meta = {}; + i.dparent = null; + i.dpath = [S_DTOP]; + i.base = S_DTOP; + i.modify = null; + i.prior = null; + i.extra = null; + i.root = null; + return i; +} + +dynamic _injDescend(Inj inj) { + if (inj.meta is Map) { + var d = (inj.meta['__d'] is num) ? inj.meta['__d'] as num : 0; + inj.meta['__d'] = d + 1; + } + var parentkey = getelem(inj.path, -2); + if (inj.dparent == null) { + if (size(inj.dpath) > 1) { + inj.dpath = [...(inj.dpath as List), parentkey]; + } + } else if (parentkey != null) { + inj.dparent = getprop(inj.dparent, parentkey); + var lastpart = getelem(inj.dpath, -1); + if (lastpart == '\$:' + jsString(parentkey)) { + inj.dpath = slice(inj.dpath, -1); + } else { + inj.dpath = [...(inj.dpath as List), parentkey]; + } + } + return inj.dparent; +} + +Inj _injChild(Inj inj, int keyi, dynamic keys) { + var key = strkey(getelem(keys, keyi)); + var val = inj.ival; + var c = Inj(); + c.mode = inj.mode; + c.full = inj.full; + c.keyi = keyi; + c.keys = keys; + c.key = key; + c.ival = getprop(val, key); + c.parent = val; + c.path = [...(inj.path as List), key]; + c.nodes = [...(inj.nodes as List), val]; + c.handler = inj.handler; + c.errs = inj.errs; + c.meta = inj.meta; + c.base = inj.base; + c.modify = inj.modify; + c.prior = inj; + c.dpath = [...(inj.dpath as List)]; + c.dparent = inj.dparent; + c.extra = inj.extra; + c.root = inj.root; + return c; +} + +dynamic _injSetval(Inj inj, dynamic val, [int ancestor = 1]) { + dynamic target; + dynamic key; + if (ancestor < 2) { + target = inj.parent; + key = inj.key; + } else { + target = getelem(inj.nodes, -ancestor); + key = getelem(inj.path, -ancestor); + } + if (val == null) return delprop(target, key); + return setprop(target, key, val); +} + +// --------------------------------------------------------------------------- +// inject +// --------------------------------------------------------------------------- + +dynamic inject(dynamic val, dynamic store, [dynamic injdef]) { + Inj inj; + if (injdef is Inj) { + inj = injdef; + } else { + var parent = {S_DTOP: val}; + inj = _newInj(val, parent); + inj.dparent = store; + inj.errs = getprop(store, S_DERRS, []); + if (inj.meta is Map) inj.meta['__d'] = 0; + inj.root = parent; + if (injdef != null) { + if (getprop(injdef, 'modify') != null) + inj.modify = getprop(injdef, 'modify'); + if (getprop(injdef, 'extra') != null) + inj.extra = getprop(injdef, 'extra'); + if (getprop(injdef, 'meta') != null) inj.meta = getprop(injdef, 'meta'); + if (getprop(injdef, 'handler') != null) + inj.handler = getprop(injdef, 'handler'); + } + } + + _injDescend(inj); + + dynamic rv; + if (isnode(val)) { + List nodekeys; + if (val is Map) { + var ks = val.keys.map((k) => k.toString()).toList(); + var normal = ks.where((k) => !k.contains(S_DS)).toList()..sort(); + var trans = ks.where((k) => k.contains(S_DS)).toList()..sort(); + nodekeys = [...normal, ...trans]; + } else { + nodekeys = List.generate((val as List).length, (i) => i.toString()); + } + + var nki = 0; + while (nki < nodekeys.length) { + var childinj = _injChild(inj, nki, List.from(nodekeys)); + var nodekey = childinj.key; + childinj.mode = S_MKEYPRE; + var prekey = _injectstr(jsString(nodekey), store, childinj); + nodekeys = (childinj.keys as List).map((e) => jsString(e)).toList(); + if (prekey != null) { + childinj.ival = getprop(val, prekey); + childinj.mode = S_MVAL; + inject(childinj.ival, store, childinj); + nodekeys = (childinj.keys as List).map((e) => jsString(e)).toList(); + childinj.mode = S_MKEYPOST; + _injectstr(jsString(nodekey), store, childinj); + nodekeys = (childinj.keys as List).map((e) => jsString(e)).toList(); + } + nki = childinj.keyi + 1; + } + rv = val; + } else if (val is String) { + inj.mode = S_MVAL; + var nv = _injectstr(val, store, inj); + if (!isSkip(nv)) _injSetval(inj, nv); + rv = nv; + } else { + rv = val; + } + + if (inj.modify != null && !isSkip(rv)) { + var mkey = inj.key; + var mparent = inj.parent; + var mval = getprop(mparent, mkey); + inj.modify!(mval, mkey, mparent, inj); + } + + inj.ival = rv; + + if (inj.prior == null && inj.root != null && haskey(inj.root, S_DTOP)) { + return getprop(inj.root, S_DTOP); + } + if (inj.key == S_DTOP && inj.parent != null && haskey(inj.parent, S_DTOP)) { + return getprop(inj.parent, S_DTOP); + } + return rv; +} + +dynamic injectHandler(dynamic inj, dynamic val, dynamic ref, dynamic store) { + var iscmd = + isfunc(val) && (ref == null || (ref is String && ref.startsWith(S_DS))); + if (iscmd) { + return val(inj, val, ref, store); + } else if ((inj as Inj).mode == S_MVAL && inj.full) { + _injSetval(inj, val); + return val; + } + return val; +} + +dynamic _injectstr(String val, dynamic store, [Inj? inj]) { + if (val == S_MT) return S_MT; + var m = _R_INJECT_FULL.firstMatch(val); + if (m != null) { + if (inj != null) inj.full = true; + var pathref0 = m.group(1)!; + var pathref = pathref0.length > 3 + ? pathref0.replaceAll('\$BT', S_BT).replaceAll('\$DS', S_DS) + : pathref0; + return getpath(store, pathref, inj); + } + var out = val.replaceAllMapped(_R_INJECT_PART, (mm) { + var ref0 = mm.group(1)!; + var ref = ref0.length > 3 + ? ref0.replaceAll('\$BT', S_BT).replaceAll('\$DS', S_DS) + : ref0; + if (inj != null) inj.full = false; + var found = getpath(store, ref, inj); + if (found == null) return S_MT; + if (found is String) return found == '__NULL__' ? 'null' : found; + if (isfunc(found)) return S_MT; + try { + return jsonEncode(found); + } catch (_) { + return stringify(found); + } + }); + if (inj != null && isfunc(inj.handler)) { + inj.full = true; + return inj.handler(inj, out, val, store); + } + return out; +} + +// --------------------------------------------------------------------------- +// transform commands +// --------------------------------------------------------------------------- + +dynamic _transformDelete(dynamic inj, dynamic val, dynamic ref, dynamic store) { + delprop((inj as Inj).parent, inj.key); + return null; +} + +dynamic _transformCopy(dynamic inj0, dynamic val, dynamic ref, dynamic store) { + var inj = inj0 as Inj; + if (inj.mode == S_MKEYPRE || inj.mode == S_MKEYPOST) return inj.key; + var out = _lookup(inj.dparent, inj.key); + _injSetval(inj, out); + return out; +} + +dynamic _transformKey(dynamic inj0, dynamic val, dynamic ref, dynamic store) { + var inj = inj0 as Inj; + if (inj.mode != S_MVAL) return null; + var keyspec = _lookup(inj.parent, S_BKEY); + if (keyspec != null) { + delprop(inj.parent, S_BKEY); + return getprop(inj.dparent, keyspec); + } + var anno = _lookup(inj.parent, S_BANNO); + var fromanno = _lookup(anno, S_KEY); + if (fromanno != null) return fromanno; + return getelem(inj.path, -2); +} + +dynamic _transformAnno(dynamic inj0, dynamic val, dynamic ref, dynamic store) { + delprop((inj0 as Inj).parent, S_BANNO); + return null; +} + +dynamic _transformMerge(dynamic inj0, dynamic val, dynamic ref, dynamic store) { + var inj = inj0 as Inj; + if (inj.mode == S_MKEYPRE) return inj.key; + if (inj.mode == S_MKEYPOST) { + var args0 = getprop(inj.parent, inj.key); + var args = islist(args0) ? args0 : [args0]; + _injSetval(inj, null); + var mergelist = flatten([ + [inj.parent], + args, + [clone(inj.parent)] + ]); + merge(mergelist); + return inj.key; + } + return null; +} + +dynamic _transformEach(dynamic inj0, dynamic val, dynamic ref, dynamic store) { + var inj = inj0 as Inj; + if (islist(inj.keys)) slice(inj.keys, 0, 1, true); + if (inj.mode != S_MVAL) return null; + var parent = inj.parent; + var srcpath = size(parent) > 1 ? getelem(parent, 1) : null; + var childTm = size(parent) > 2 ? clone(getelem(parent, 2)) : null; + var srcstore = getprop(store, inj.base, store); + var src = getpath(srcstore, srcpath, inj); + var tkey = getelem(inj.path, -2); + var nodes = inj.nodes; + var target = () { + var t = getelem(nodes, -2); + return t == null ? getelem(nodes, -1) : t; + }(); + var tval = []; + dynamic rval = []; + if (isnode(src)) { + if (src is List) { + for (var _ in src) { + tval.add(clone(childTm)); + } + } else if (src is Map) { + src.forEach((k, _) { + var cc = clone(childTm); + if (ismap(cc)) setprop(cc, S_BANNO, {S_KEY: k}); + tval.add(cc); + }); + } + var tcurrent = src is Map + ? src.values.toList() + : (src is List ? List.from(src) : src); + if (tval.isNotEmpty) { + var path = inj.path; + var ckey = getelem(path, -2); + var plist = path is List ? List.from(path) : []; + var tpath = + plist.isEmpty ? [] : plist.sublist(0, plist.length - 1); + var dpath = [S_DTOP]; + if (srcpath is String && srcpath != S_MT) { + for (var p in srcpath.split(S_DT)) { + if (p != S_MT) dpath.add(p); + } + } + if (ckey != null) dpath.add('\$:' + jsString(ckey)); + dynamic tcur = {jsString(ckey): tcurrent}; + if (size(tpath) > 1) { + var pkey = getelem(path, -3, S_DTOP); + dpath.add('\$:' + jsString(pkey)); + tcur = {jsString(pkey): tcur}; + } + var tinj = _injChild(inj, 0, ckey != null ? [ckey] : []); + tinj.path = tpath; + var nlist = nodes is List ? List.from(nodes) : []; + tinj.nodes = + nlist.isEmpty ? [] : nlist.sublist(0, nlist.length - 1); + tinj.parent = size(tinj.nodes) > 0 ? getelem(tinj.nodes, -1) : null; + if (ckey != null && tinj.parent != null) setprop(tinj.parent, ckey, tval); + tinj.ival = tval; + tinj.dpath = dpath; + tinj.dparent = tcur; + inject(tval, store, tinj); + rval = tinj.ival; + } + } + setprop(target, tkey, rval); + return (islist(rval) && size(rval) > 0) ? getelem(rval, 0) : null; +} + +dynamic _transformPack(dynamic inj0, dynamic val, dynamic ref, dynamic store) { + var inj = inj0 as Inj; + if (inj.mode != S_MKEYPRE || inj.key is! String) return null; + var parent = inj.parent; + var path = inj.path; + var nodes = inj.nodes; + var argsVal = getprop(parent, inj.key); + if (!islist(argsVal) || size(argsVal) < 2) return null; + var srcpath = getelem(argsVal, 0); + var origchildspec = getelem(argsVal, 1); + var tkey = getelem(path, -2); + var pathsize = size(path); + var target = () { + var t = getelem(nodes, pathsize - 2); + return t == null ? getelem(nodes, pathsize - 1) : t; + }(); + var srcstore = getprop(store, inj.base, store); + var src0 = getpath(srcstore, srcpath, inj); + dynamic src; + if (!islist(src0)) { + if (ismap(src0)) { + var ns = []; + for (var p in itemsPairs(src0)) { + setprop(p[1], S_BANNO, {S_KEY: p[0]}); + ns.add(p[1]); + } + src = ns; + } else { + src = null; + } + } else { + src = src0; + } + if (src == null) return null; + var keypath = getprop(origchildspec, S_BKEY); + var childspec = delprop(origchildspec, S_BKEY); + var child = getprop(childspec, S_BVAL, childspec); + var tval = {}; + for (var p in itemsPairs(src)) { + var srckey = p[0]; + var srcnode = p[1]; + dynamic k; + if (keypath == null) { + k = srckey; + } else if (keypath is String && keypath.startsWith(S_BT)) { + k = inject( + keypath, + merge([ + {}, + store, + {S_DTOP: srcnode} + ], 1)); + } else { + k = getpath(srcnode, keypath, inj); + } + var tchild = clone(child); + setprop(tval, k, tchild); + var anno = getprop(srcnode, S_BANNO); + if (anno == null) { + delprop(tchild, S_BANNO); + } else { + setprop(tchild, S_BANNO, anno); + } + } + dynamic rval = {}; + if (!isempty(tval)) { + var tsrc = {}; + var srcList = src is List ? src : []; + for (var i = 0; i < srcList.length; i++) { + var node = srcList[i]; + dynamic kn; + if (keypath == null) { + kn = i; + } else if (keypath is String && keypath.startsWith(S_BT)) { + kn = inject( + keypath, + merge([ + {}, + store, + {S_DTOP: node} + ], 1)); + } else { + kn = getpath(node, keypath, inj); + } + setprop(tsrc, kn, node); + } + var tpath = slice(inj.path, -1); + var ckey = getelem(inj.path, -2); + var dpath = flatten( + [S_DTOP, (srcpath as String).split(S_DT), '\$:' + jsString(ckey)]); + dynamic tcur = {jsString(ckey): tsrc}; + if (size(tpath) > 1) { + var pkey = getelem(inj.path, -3, S_DTOP); + (dpath as List).add('\$:' + jsString(pkey)); + tcur = {jsString(pkey): tcur}; + } + var tinj = _injChild(inj, 0, [ckey]); + tinj.path = tpath; + tinj.nodes = slice(inj.nodes, -1); + tinj.parent = getelem(tinj.nodes, -1); + tinj.ival = tval; + tinj.dpath = dpath; + tinj.dparent = tcur; + inject(tval, store, tinj); + rval = tinj.ival; + } + setprop(target, tkey, rval); + return null; +} + +dynamic _transformRef(dynamic inj0, dynamic val, dynamic ref, dynamic store) { + var inj = inj0 as Inj; + if (inj.mode != S_MVAL) return null; + var nodes = inj.nodes; + var refpath = _lookup(inj.parent, 1); + inj.keyi = size(inj.keys); + var specFunc = getprop(store, S_DSPEC); + if (!isfunc(specFunc)) return null; + var spec = specFunc(); + var refv = getpath(spec, refpath); + var hasSub = false; + if (isnode(refv)) { + walk(refv, after: (k, v, p, pp) { + if (v == '`\$REF`') hasSub = true; + return v; + }); + } + var tref = clone(refv); + var cpath = slice(inj.path, 0, size(inj.path) - 3); + var tpath = slice(inj.path, 0, size(inj.path) - 1); + var tcur = getpath(store, cpath); + var tval = getpath(store, tpath); + dynamic rval; + if (refv != null && (!hasSub || tval != null)) { + var cs = _injChild(inj, 0, [getelem(tpath, -1)]); + cs.path = tpath; + cs.nodes = slice(inj.nodes, 0, size(inj.nodes) - 1); + cs.parent = getelem(nodes, -2); + cs.ival = tref; + cs.dparent = tcur; + inject(tref, store, cs); + rval = cs.ival; + } + _injSetval(inj, rval, 2); + if (islist(inj.parent) && inj.prior != null) { + inj.prior!.keyi = inj.prior!.keyi - 1; + } + return val; +} + +String _jsstr(dynamic v) { + if (v == null) return 'null'; + if (v is bool) return v ? 'true' : 'false'; + return jsString(v); +} + +final Map _FORMATTER = { + 'identity': (k, v) => v, + 'upper': (k, v) => isnode(v) ? v : _jsstr(v).toUpperCase(), + 'lower': (k, v) => isnode(v) ? v : _jsstr(v).toLowerCase(), + 'string': (k, v) => isnode(v) ? v : _jsstr(v), + 'number': (k, v) { + if (isnode(v)) return v; + var n = num.tryParse(_jsstr(v)) ?? 0; + if (n is double && n.isNaN) n = 0; + return (n == n.truncateToDouble()) ? n.toInt() : n; + }, + 'integer': (k, v) { + if (isnode(v)) return v; + var n = num.tryParse(_jsstr(v)) ?? 0; + if (n is double && n.isNaN) n = 0; + return n.toInt(); + }, + 'concat': (k, v) { + if (k == null && islist(v)) { + return join(itemsV(v, (n) => isnode(n[1]) ? S_MT : _jsstr(n[1])), S_MT); + } + return v; + }, +}; + +bool checkPlacement(int modes, String ijname, int parentTypes, Inj inj) { + var modenum = _MODE_TO_NUM[inj.mode] ?? 0; + if ((modes & modenum) == 0) { + var allowed = [M_KEYPRE, M_KEYPOST, M_VAL].where((m) => (modes & m) != 0); + var placements = allowed.map((m) => m == M_VAL ? 'value' : 'key').join(','); + var cur = modenum == M_VAL ? 'value' : 'key'; + setprop(inj.errs, size(inj.errs), + '\$$ijname: invalid placement as $cur, expected: $placements.'); + return false; + } + if (!isempty(parentTypes)) { + var ptype = typify(inj.parent); + if ((parentTypes & ptype) == 0) { + setprop(inj.errs, size(inj.errs), + '\$$ijname: invalid placement in parent ${typename(ptype)}, expected: ${typename(parentTypes)}.'); + return false; + } + } + return true; +} + +dynamic injectorArgs(List argTypes, dynamic args) { + var numargs = argTypes.length; + var found = List.filled(1 + numargs, null, growable: true); + for (var argi = 0; argi < numargs; argi++) { + var arg = getelem(args, argi); + var argType = typify(arg); + if ((argTypes[argi] & argType) == 0) { + found[0] = + 'invalid argument: ${stringify(arg, 22)} (${typename(argType)} at position ${1 + argi}) is not of type: ${typename(argTypes[argi])}.'; + return found; + } + found[1 + argi] = arg; + } + return found; +} + +Inj injectChild(dynamic child, dynamic store, Inj inj) { + var cinj = inj; + if (inj.prior != null) { + if (inj.prior!.prior != null) { + var c = _injChild(inj.prior!.prior!, inj.prior!.keyi, inj.prior!.keys); + c.ival = child; + setprop(c.parent, inj.prior!.key, child); + cinj = c; + } else { + var c = _injChild(inj.prior!, inj.keyi, inj.keys); + c.ival = child; + setprop(c.parent, inj.key, child); + cinj = c; + } + } + inject(child, store, cinj); + return cinj; +} + +dynamic _transformFormat( + dynamic inj0, dynamic val, dynamic ref, dynamic store) { + var inj = inj0 as Inj; + slice(inj.keys, 0, 1, true); + if (inj.mode != S_MVAL) return null; + var name = _lookup(inj.parent, 1); + var child = _lookup(inj.parent, 2); + var tkey = getelem(inj.path, -2); + var target = () { + var t = getelem(inj.nodes, -2); + return t == null ? getelem(inj.nodes, -1) : t; + }(); + var cinj = injectChild(child, store, inj); + var resolved = cinj.ival; + dynamic Function(dynamic, dynamic)? formatter; + if ((T_function & typify(name)) > 0) { + formatter = (k, v) => name(_dummyInj(), v, jsString(k), null); + } else { + formatter = _FORMATTER[jsString(name)]; + } + if (formatter == null) { + setprop(inj.errs, size(inj.errs), + '\$FORMAT: unknown format: ${jsString(name)}.'); + return null; + } + var out = walk(resolved, after: (k, v, p, pp) => formatter!(k, v)); + setprop(target, tkey, out); + return out; +} + +dynamic _transformApply(dynamic inj0, dynamic val, dynamic ref, dynamic store) { + var inj = inj0 as Inj; + if (!checkPlacement(M_VAL, 'APPLY', T_list, inj)) return null; + var res = injectorArgs([T_function, T_any], slice(inj.parent, 1)); + var err = getelem(res, 0); + var applyFn = getelem(res, 1); + var child = size(res) > 2 ? getelem(res, 2) : null; + if (err != null) { + setprop(inj.errs, size(inj.errs), '\$APPLY: ' + jsString(err)); + return null; + } + var tkey = getelem(inj.path, -2); + var target = () { + var t = getelem(inj.nodes, -2); + return t == null ? getelem(inj.nodes, -1) : t; + }(); + var cinj = injectChild(child, store, inj); + var resolved = cinj.ival; + var out = applyFn(resolved, store, cinj); + setprop(target, tkey, out); + return out; +} + +dynamic transform(dynamic data, dynamic spec0, [dynamic injdef]) { + var origspec = spec0; + var spec = clone(spec0); + var extra = injdef != null ? getprop(injdef, 'extra') : null; + var collect = injdef != null && getprop(injdef, 'errs') != null; + var errs = collect ? getprop(injdef, 'errs') : []; + var extraTransforms = {}; + var extraData = {}; + if (extra != null) { + for (var p in itemsPairs(extra)) { + if ((p[0] as String).startsWith(S_DS)) { + extraTransforms[p[0]] = p[1]; + } else { + extraData[p[0]] = p[1]; + } + } + } + var dataClone = + merge([isempty(extraData) ? null : clone(extraData), clone(data)]); + var store = {}; + store[S_DTOP] = dataClone; + store[S_DSPEC] = ([a, b, c, d]) => origspec; + store['\$BT'] = ([a, b, c, d]) => S_BT; + store['\$DS'] = ([a, b, c, d]) => S_DS; + store['\$WHEN'] = ([a, b, c, d]) => '1970-01-01T00:00:00.000Z'; + store['\$DELETE'] = _transformDelete; + store['\$COPY'] = _transformCopy; + store['\$KEY'] = _transformKey; + store['\$ANNO'] = _transformAnno; + store['\$MERGE'] = _transformMerge; + store['\$EACH'] = _transformEach; + store['\$PACK'] = _transformPack; + store['\$REF'] = _transformRef; + store['\$FORMAT'] = _transformFormat; + store['\$APPLY'] = _transformApply; + for (var p in itemsPairs(extraTransforms)) { + store[p[0]] = p[1]; + } + store[S_DERRS] = errs; + + var idef = {}; + if (injdef is Map) { + injdef.forEach((k, v) => idef[k.toString()] = v); + } + idef['errs'] = errs; + var out = inject(spec, store, idef); + if (size(errs) > 0 && !collect) { + throw StructError(join(errs, ' | ')); + } + return out; +} + +class StructError implements Exception { + final String message; + StructError(this.message); + @override + String toString() => message; +} + +// --------------------------------------------------------------------------- +// validate +// --------------------------------------------------------------------------- + +String _invalidTypeMsg( + dynamic path, String needtype, int vt, dynamic v, String whence) { + var vs = v == null ? 'no value' : stringify(v); + return 'Expected ' + + (size(path) > 1 ? 'field ' + pathify(path, 1) + ' to be ' : '') + + needtype + + ', but found ' + + (v != null ? typename(vt) + S_VIZ : '') + + vs + + '.'; +} + +void _pushErr(Inj inj, String msg) => setprop(inj.errs, size(inj.errs), msg); + +dynamic _validateString(dynamic inj0, dynamic val, dynamic ref, dynamic store) { + var inj = inj0 as Inj; + var out = _lookup(inj.dparent, inj.key); + var t = typify(out); + if ((T_string & t) == 0) { + _pushErr(inj, _invalidTypeMsg(inj.path, S_string, t, out, 'V1010')); + return null; + } + if (out == S_MT) { + _pushErr(inj, 'Empty string at ' + pathify(inj.path, 1)); + return null; + } + return out; +} + +dynamic _validateType(dynamic inj0, dynamic val, dynamic ref, dynamic store) { + var inj = inj0 as Inj; + var tname = (ref is String && ref.length > 1) + ? ref.substring(1).toLowerCase() + : 'any'; + var idx = _TYPENAME.indexOf(tname); + var typev0 = idx >= 0 ? (1 << (31 - idx)) : 0; + var typev = tname == S_nil ? (typev0 | T_null) : typev0; + var out = _lookup(inj.dparent, inj.key); + var t = typify(out); + if ((t & typev) == 0) { + _pushErr(inj, _invalidTypeMsg(inj.path, tname, t, out, 'V1001')); + return null; + } + return out; +} + +dynamic _validateAny(dynamic inj0, dynamic val, dynamic ref, dynamic store) => + _lookup((inj0 as Inj).dparent, inj0.key); + +dynamic _validateChild(dynamic inj0, dynamic val, dynamic ref, dynamic store) { + var inj = inj0 as Inj; + var parent = inj.parent; + var key = inj.key; + var path = inj.path; + var keys = inj.keys; + if (inj.mode == S_MKEYPRE) { + var childtm = getprop(parent, key); + var pkey = getelem(path, -2); + var tval = getprop(inj.dparent, pkey); + if (tval == null) { + for (var ckey in keysof({})) { + setprop(parent, ckey, clone(childtm)); + setprop(keys, size(keys), ckey); + } + delprop(parent, key); + return null; + } else if (!ismap(tval)) { + _pushErr( + inj, + _invalidTypeMsg(slice(path, 0, size(path) - 1), S_object, + typify(tval), tval, 'V0220')); + return null; + } else { + for (var ckey in keysof(tval)) { + setprop(parent, ckey, clone(childtm)); + setprop(keys, size(keys), ckey); + } + delprop(parent, key); + return null; + } + } else if (inj.mode == S_MVAL) { + var childtm = getprop(parent, 1); + if (!islist(parent)) { + _pushErr(inj, 'Invalid \$CHILD as value'); + return null; + } else if (inj.dparent == null) { + (parent as List).clear(); + return null; + } else if (!islist(inj.dparent)) { + _pushErr( + inj, + _invalidTypeMsg(slice(path, 0, size(path) - 1), S_list, + typify(inj.dparent), inj.dparent, 'V0230')); + inj.keyi = size(parent); + return inj.dparent; + } else { + for (var p in itemsPairs(inj.dparent)) { + setprop(parent, p[0], clone(childtm)); + } + var n = size(inj.dparent); + var pl = parent as List; + while (pl.length > n) { + pl.removeLast(); + } + inj.keyi = 0; + return getprop(inj.dparent, 0); + } + } + return null; +} + +dynamic _validateOne(dynamic inj0, dynamic val, dynamic ref, dynamic store) { + var inj = inj0 as Inj; + if (inj.mode != S_MVAL) return null; + var parent = inj.parent; + if (!islist(parent) || inj.keyi != 0) { + _pushErr( + inj, + 'The \$ONE validator at field ' + + pathify(inj.path, 1, 1) + + ' must be the first element of an array.'); + return null; + } + inj.keyi = size(inj.keys); + _injSetval(inj, inj.dparent, 2); + inj.path = slice(inj.path, 0, size(inj.path) - 1); + inj.key = getelem(inj.path, -1); + var tvals = slice(parent, 1); + if (size(tvals) == 0) { + _pushErr( + inj, + 'The \$ONE validator at field ' + + pathify(inj.path, 1, 1) + + ' must have at least one argument.'); + return null; + } + var matched = false; + for (var tv in (tvals as List)) { + if (matched) break; + var terrs = []; + var vstore = merge([{}, store], 1); + setprop(vstore, S_DTOP, inj.dparent); + var vcurrent = validate( + inj.dparent, tv, {'extra': vstore, 'errs': terrs, 'meta': inj.meta}); + _injSetval(inj, vcurrent, -2); + if (size(terrs) == 0) matched = true; + } + if (!matched) { + var valdesc = tvals.map((x) => stringify(x)).join(', '); + valdesc = valdesc.replaceAllMapped( + _R_TRANSFORM_NAME, (m) => m.group(1)!.toLowerCase()); + _pushErr( + inj, + _invalidTypeMsg(inj.path, (size(tvals) > 1 ? 'one of ' : '') + valdesc, + typify(inj.dparent), inj.dparent, 'V0210')); + } + return null; +} + +dynamic _validateExact(dynamic inj0, dynamic val, dynamic ref, dynamic store) { + var inj = inj0 as Inj; + if (inj.mode != S_MVAL) { + delprop(inj.parent, inj.key); + return null; + } + var parent = inj.parent; + if (!islist(parent) || inj.keyi != 0) { + _pushErr( + inj, + 'The \$EXACT validator at field ' + + pathify(inj.path, 1, 1) + + ' must be the first element of an array.'); + return null; + } + inj.keyi = size(inj.keys); + _injSetval(inj, inj.dparent, 2); + inj.path = slice(inj.path, 0, size(inj.path) - 1); + inj.key = getelem(inj.path, -1); + var tvals = slice(parent, 1); + if (size(tvals) == 0) { + _pushErr( + inj, + 'The \$EXACT validator at field ' + + pathify(inj.path, 1, 1) + + ' must have at least one argument.'); + return null; + } + var matched = false; + for (var tv in (tvals as List)) { + if (!matched && veq(tv, inj.dparent)) matched = true; + } + if (!matched) { + var valdesc = tvals.map((x) => stringify(x)).join(', '); + valdesc = valdesc.replaceAllMapped( + _R_TRANSFORM_NAME, (m) => m.group(1)!.toLowerCase()); + _pushErr( + inj, + _invalidTypeMsg( + inj.path, + (size(inj.path) > 1 ? '' : 'value ') + + 'exactly equal to ' + + (size(tvals) == 1 ? '' : 'one of ') + + valdesc, + typify(inj.dparent), + inj.dparent, + 'V0110')); + } + return null; +} + +bool veq(dynamic a, dynamic b) { + if (a == null && b == null) return true; + if (a is bool || b is bool) return a == b; + if (a is num && b is num) return a == b; + if (a is String && b is String) return a == b; + if (a is List && b is List) { + if (a.length != b.length) return false; + for (var i = 0; i < a.length; i++) { + if (!veq(a[i], b[i])) return false; + } + return true; + } + if (a is Map && b is Map) { + if (a.length != b.length) return false; + for (var k in a.keys) { + if (!b.containsKey(k) || !veq(a[k], b[k])) return false; + } + return true; + } + return identical(a, b); +} + +void _validation(dynamic pval, dynamic key, dynamic parent, dynamic inj0) { + var inj = inj0 as Inj; + if (isSkip(pval)) return; + var exact = getprop(inj.meta, S_BEXACT, false); + var cval = getprop(inj.dparent, key); + var exactB = exact == true; + if (!exactB && cval == null) return; + var ptype = typify(pval); + if ((T_string & ptype) > 0 && jsString(pval).contains(S_DS)) return; + var ctype = typify(cval); + if (ptype != ctype && pval != null) { + _pushErr( + inj, _invalidTypeMsg(inj.path, typename(ptype), ctype, cval, 'V0010')); + } else if (ismap(cval)) { + if (!ismap(pval)) { + _pushErr(inj, + _invalidTypeMsg(inj.path, typename(ptype), ctype, cval, 'V0020')); + } else { + var ckeys = keysof(cval); + var pkeys = keysof(pval); + if (pkeys.isNotEmpty && getprop(pval, S_BOPEN) != true) { + var badkeys = ckeys.where((ck) => _lookup(pval, ck) == null).toList(); + if (badkeys.isNotEmpty) { + _pushErr( + inj, + 'Unexpected keys at field ' + + pathify(inj.path, 1) + + S_VIZ + + badkeys.join(', ')); + } + } else { + merge([pval, cval]); + if (isnode(pval)) delprop(pval, S_BOPEN); + } + } + } else if (islist(cval)) { + if (!islist(pval)) { + _pushErr(inj, + _invalidTypeMsg(inj.path, typename(ptype), ctype, cval, 'V0030')); + } + } else if (exactB) { + if (!veq(cval, pval)) { + var pathmsg = + size(inj.path) > 1 ? 'at field ' + pathify(inj.path, 1) + ': ' : ''; + _pushErr( + inj, + 'Value ' + + pathmsg + + jsString(cval) + + ' should equal ' + + jsString(pval) + + '.'); + } + } else { + setprop(parent, key, cval); + } +} + +dynamic _validateHandler( + dynamic inj0, dynamic val, dynamic ref, dynamic store) { + var inj = inj0 as Inj; + var m = (ref is String) ? _R_META_PATH.firstMatch(ref) : null; + if (m != null) { + if (m.group(2) == '=') { + _injSetval(inj, [S_BEXACT, val]); + } else { + _injSetval(inj, val); + } + inj.keyi = -1; + return SKIP; + } + return injectHandler(inj, val, ref, store); +} + +dynamic validate(dynamic data, dynamic spec, [dynamic injdef]) { + var extra = getprop(injdef, 'extra'); + var collect = injdef != null && getprop(injdef, 'errs') != null; + var errs = collect ? getprop(injdef, 'errs') : []; + var base = {}; + for (var k in [ + '\$DELETE', + '\$COPY', + '\$KEY', + '\$META', + '\$MERGE', + '\$EACH', + '\$PACK' + ]) { + base[k] = null; + } + base['\$STRING'] = _validateString; + for (var k in [ + '\$NUMBER', + '\$INTEGER', + '\$DECIMAL', + '\$BOOLEAN', + '\$NULL', + '\$NIL', + '\$MAP', + '\$LIST', + '\$FUNCTION', + '\$INSTANCE' + ]) { + base[k] = _validateType; + } + base['\$ANY'] = _validateAny; + base['\$CHILD'] = _validateChild; + base['\$ONE'] = _validateOne; + base['\$EXACT'] = _validateExact; + var store = merge([ + base, + extra == null ? {} : extra, + {S_DERRS: errs} + ], 1); + var meta = getprop(injdef, 'meta', {}); + setprop(meta, S_BEXACT, getprop(meta, S_BEXACT, false)); + var out = transform(data, spec, { + 'meta': meta, + 'extra': store, + 'modify': _validation, + 'handler': _validateHandler, + 'errs': errs, + }); + if (size(errs) > 0 && !collect) { + throw StructError(join(errs, ' | ')); + } + return out; +} + +// --------------------------------------------------------------------------- +// select +// --------------------------------------------------------------------------- + +dynamic _selectAnd(dynamic inj0, dynamic val, dynamic ref, dynamic store) { + var inj = inj0 as Inj; + if (inj.mode == S_MKEYPRE) { + var terms = getprop(inj.parent, inj.key); + var ppath = slice(inj.path, -1); + var point = getpath(store, ppath); + var vstore = merge([{}, store], 1); + setprop(vstore, S_DTOP, point); + for (var p in itemsPairs(terms)) { + var terrs = []; + validate(point, p[1], {'extra': vstore, 'errs': terrs, 'meta': inj.meta}); + if (size(terrs) != 0) { + _pushErr( + inj, + 'AND:' + + pathify(ppath) + + '⨯' + + stringify(point) + + ' fail:' + + stringify(terms)); + } + } + var gkey = getelem(inj.path, -2); + var gp = getelem(inj.nodes, -2); + setprop(gp, gkey, point); + } + return null; +} + +dynamic _selectOr(dynamic inj0, dynamic val, dynamic ref, dynamic store) { + var inj = inj0 as Inj; + if (inj.mode == S_MKEYPRE) { + var terms = getprop(inj.parent, inj.key); + var ppath = slice(inj.path, -1); + var point = getpath(store, ppath); + var vstore = merge([{}, store], 1); + setprop(vstore, S_DTOP, point); + var done = false; + for (var p in itemsPairs(terms)) { + if (done) break; + var terrs = []; + validate(point, p[1], {'extra': vstore, 'errs': terrs, 'meta': inj.meta}); + if (size(terrs) == 0) { + var gkey = getelem(inj.path, -2); + var gp = getelem(inj.nodes, -2); + setprop(gp, gkey, point); + done = true; + } + } + if (!done) { + _pushErr( + inj, + 'OR:' + + pathify(ppath) + + '⨯' + + stringify(point) + + ' fail:' + + stringify(terms)); + } + } + return null; +} + +dynamic _selectNot(dynamic inj0, dynamic val, dynamic ref, dynamic store) { + var inj = inj0 as Inj; + if (inj.mode == S_MKEYPRE) { + var term = getprop(inj.parent, inj.key); + var ppath = slice(inj.path, -1); + var point = getpath(store, ppath); + var vstore = merge([{}, store], 1); + setprop(vstore, S_DTOP, point); + var terrs = []; + validate(point, term, {'extra': vstore, 'errs': terrs, 'meta': inj.meta}); + if (size(terrs) == 0) { + _pushErr( + inj, + 'NOT:' + + pathify(ppath) + + '⨯' + + stringify(point) + + ' fail:' + + stringify(term)); + } + var gkey = getelem(inj.path, -2); + var gp = getelem(inj.nodes, -2); + setprop(gp, gkey, point); + } + return null; +} + +bool _numCmp(dynamic a, dynamic b, String op) { + if (a is num && b is num) { + switch (op) { + case 'gt': + return a > b; + case 'lt': + return a < b; + case 'gte': + return a >= b; + case 'lte': + return a <= b; + } + } + return false; +} + +dynamic _selectCmp(dynamic inj0, dynamic val, dynamic ref, dynamic store) { + var inj = inj0 as Inj; + if (inj.mode == S_MKEYPRE) { + var term = getprop(inj.parent, inj.key); + var gkey = getelem(inj.path, -2); + var ppath = slice(inj.path, -1); + var point = getpath(store, ppath); + bool pass; + if (ref == '\$GT') { + pass = _numCmp(point, term, 'gt'); + } else if (ref == '\$LT') { + pass = _numCmp(point, term, 'lt'); + } else if (ref == '\$GTE') { + pass = _numCmp(point, term, 'gte'); + } else if (ref == '\$LTE') { + pass = _numCmp(point, term, 'lte'); + } else if (ref == '\$LIKE') { + pass = term is String ? RegExp(term).hasMatch(stringify(point)) : false; + } else { + pass = false; + } + if (pass) { + var gp = getelem(inj.nodes, -2); + setprop(gp, gkey, point); + } else { + _pushErr( + inj, + 'CMP: ' + + pathify(ppath) + + '⨯' + + stringify(point) + + ' fail:' + + jsString(ref) + + ' ' + + stringify(term)); + } + } + return null; +} + +dynamic select(dynamic children0, dynamic query) { + if (!isnode(children0)) return []; + dynamic children; + if (ismap(children0)) { + children = itemsPairs(children0).map((p) { + setprop(p[1], S_DKEY, p[0]); + return p[1]; + }).toList(); + } else { + var src = children0 as List; + var out = []; + for (var i = 0; i < src.length; i++) { + var n = src[i]; + if (ismap(n)) { + setprop(n, S_DKEY, i); + out.add(n); + } else { + out.add(n); + } + } + children = out; + } + var results = []; + var extra = { + '\$AND': _selectAnd, + '\$OR': _selectOr, + '\$NOT': _selectNot, + '\$GT': _selectCmp, + '\$LT': _selectCmp, + '\$GTE': _selectCmp, + '\$LTE': _selectCmp, + '\$LIKE': _selectCmp, + }; + var q = clone(query); + walk(q, after: (k, v, p, pp) { + if (ismap(v)) setprop(v, S_BOPEN, getprop(v, S_BOPEN, true)); + return v; + }); + for (var child in (children as List)) { + var errs = []; + var injdef = { + 'errs': errs, + 'meta': {S_BEXACT: true}, + 'extra': extra, + }; + validate(child, clone(q), injdef); + if (size(errs) == 0) results.add(child); + } + return results; +} + +// --------------------------------------------------------------------------- +// builders +// --------------------------------------------------------------------------- + +dynamic jm(List kv) { + var m = {}; + var n = kv.length; + for (var i = 0; i < n; i += 2) { + var k0 = kv[i]; + var k = k0 == null ? 'null' : (k0 is String ? k0 : stringify(k0)); + m[k] = (i + 1 < n) ? kv[i + 1] : null; + } + return m; +} + +dynamic jt(List v) => List.from(v); + +String tn(int t) => typename(t); diff --git a/dart/pubspec.yaml b/dart/pubspec.yaml new file mode 100644 index 00000000..fad206d9 --- /dev/null +++ b/dart/pubspec.yaml @@ -0,0 +1,6 @@ +name: voxgig_struct +description: A faithful Dart port of the canonical voxgig/struct library. +version: 0.2.1 +environment: + sdk: '>=3.0.0 <4.0.0' +# Zero third-party runtime dependencies (by project policy). diff --git a/dart/test/runner.dart b/dart/test/runner.dart new file mode 100644 index 00000000..2bb51b7b --- /dev/null +++ b/dart/test/runner.dart @@ -0,0 +1,524 @@ +// Test runner for the shared JSON corpus (build/test/test.json). +// Self-contained: uses the SDK's dart:convert to read the corpus into native +// Map/List/num/String/bool/null — exactly the types the library operates on. + +import 'dart:convert'; +import 'dart:io'; +import '../lib/voxgig_struct.dart' as s; + +const nullmark = '__NULL__'; +const undefmark = '__UNDEF__'; +const existsmark = '__EXISTS__'; + +dynamic fixJson(dynamic v, bool flagNull) { + if (v == null) return flagNull ? nullmark : null; + if (v is Map) { + var o = {}; + v.forEach((k, x) => o[k.toString()] = fixJson(x, flagNull)); + return o; + } + if (v is List) return v.map((x) => fixJson(x, flagNull)).toList(); + return v; +} + +bool eqv(dynamic a, dynamic b) { + if (a == null && b == null) return true; + if (a is bool || b is bool) return a == b; + if (a is num && b is num) return a == b; + if (a is String && b is String) return a == b; + if (a is List && b is List) { + if (a.length != b.length) return false; + for (var i = 0; i < a.length; i++) { + if (!eqv(a[i], b[i])) return false; + } + return true; + } + if (a is Map && b is Map) { + if (a.length != b.length) return false; + for (var k in a.keys) { + if (!b.containsKey(k) || !eqv(a[k], b[k])) return false; + } + return true; + } + return identical(a, b); +} + +bool matchval(dynamic check0, dynamic base) { + var check = (check0 == undefmark || check0 == nullmark) ? null : check0; + if (eqv(check, base)) return true; + if (check is String) { + var basestr = s.stringify(base); + if (check.length >= 2 && check.startsWith('/') && check.endsWith('/')) { + return RegExp(check.substring(1, check.length - 1)).hasMatch(basestr); + } + return basestr.toLowerCase().contains(s.stringify(check).toLowerCase()); + } + if (check is Function) return true; + return false; +} + +void doMatch(dynamic check, dynamic base0) { + var base = s.clone(base0); + s.walk(check, before: (k, v, p, path) { + if (!s.isnode(v)) { + var baseval = s.getpath(base, path); + if (eqv(baseval, v)) { + } else if (v == undefmark && baseval == null) { + } else if (v == existsmark && baseval != null) { + } else if (!matchval(v, baseval)) { + var pstr = (path as List).map((e) => s.jsString(e)).join('.'); + throw s.StructError( + 'MATCH: $pstr: [${s.stringify(v)}] <=> [${s.stringify(baseval)}]'); + } + } + return v; + }); +} + +int npass = 0; +int nfail = 0; +List failures = []; +void record(String group, String name, bool ok, String msg) { + if (ok) { + npass++; + } else { + nfail++; + failures.add('FAIL $group $name - $msg'); + } +} + +dynamic omapV(Map kvs) => Map.from(kvs); +dynamic eget(dynamic e, String k) => + (e is Map && e.containsKey(k)) ? e[k] : null; +bool ehas(dynamic e, String k) => e is Map && e.containsKey(k); + +List resolveArgs(dynamic entry) { + if (ehas(entry, 'ctx')) return [eget(entry, 'ctx')]; + if (ehas(entry, 'args')) + return (eget(entry, 'args') is List) + ? List.from(eget(entry, 'args')) + : []; + if (ehas(entry, 'in')) return [s.clone(eget(entry, 'in'))]; + return []; +} + +void checkResult(dynamic entry, List args, dynamic res) { + var matched = false; + if (ehas(entry, 'match')) { + doMatch( + eget(entry, 'match'), + omapV({ + 'in': eget(entry, 'in'), + 'args': List.from(args), + 'out': eget(entry, 'res'), + 'ctx': eget(entry, 'ctx') + })); + matched = true; + } + var out = eget(entry, 'out'); + if (eqv(out, res)) return; + if (matched && (out == nullmark || out == null)) return; + throw s.StructError( + 'Expected: ${s.stringify(out)}, got: ${s.stringify(res)}'); +} + +void handleError(dynamic entry, Object err) { + var msg = err is s.StructError ? err.message : err.toString(); + if (ehas(entry, 'err')) { + var entryErr = eget(entry, 'err'); + if (entryErr == true || matchval(entryErr, msg)) { + if (ehas(entry, 'match')) { + doMatch( + eget(entry, 'match'), + omapV({ + 'in': eget(entry, 'in'), + 'out': eget(entry, 'res'), + 'ctx': eget(entry, 'ctx'), + 'err': msg + })); + } + } else { + throw s.StructError('ERROR MATCH: [${s.stringify(entryErr)}] <=> [$msg]'); + } + } else { + throw err; + } +} + +void runSet(String group, dynamic node, dynamic Function(List) subject, + [bool flagNull = true]) { + var fixed = fixJson(node, flagNull); + var testset = s.getprop(fixed, 'set'); + if (testset is! List) return; + for (var entry in testset) { + var name = s.jsString(eget(entry, 'name')); + try { + if (!ehas(entry, 'out') && flagNull) s.setprop(entry, 'out', nullmark); + var args = resolveArgs(entry); + var res = fixJson(subject(args), flagNull); + s.setprop(entry, 'res', res); + checkResult(entry, args, res); + record(group, name, true, ''); + } catch (e) { + try { + handleError(entry, e); + record(group, name, true, ''); + } catch (e2) { + record(group, name, false, + e2 is s.StructError ? e2.message : e2.toString()); + } + } + } +} + +void runSingle(String group, dynamic node, dynamic Function(dynamic) actualFn) { + try { + var expected = eget(node, 'out'); + var actual = actualFn(eget(node, 'in')); + if (eqv(expected, actual)) { + record(group, 'single', true, ''); + } else { + record(group, 'single', false, + 'Expected: ${s.stringify(expected)}, got: ${s.stringify(actual)}'); + } + } catch (e) { + record( + group, 'single', false, e is s.StructError ? e.message : e.toString()); + } +} + +dynamic Function(List) arg1(dynamic Function(dynamic) f) => + (args) => f(args.isNotEmpty ? args[0] : null); +dynamic vget(dynamic vin, String k) => + (vin is Map && vin.containsKey(k)) ? vin[k] : null; +bool vhas(dynamic vin, String k) => vin is Map && vin.containsKey(k); + +void nullModifier(dynamic v, dynamic key, dynamic parent, dynamic inj) { + if (v == nullmark) { + s.setprop(parent, key, null); + } else if (v is String) { + s.setprop(parent, key, v.replaceAll(nullmark, 'null')); + } +} + +void runWalkLog(String group, dynamic node) { + try { + var testData = s.clone(node); + var log = []; + walklog(key, v, parent, path) { + s.setprop( + log, + s.size(log), + 'k=' + + (key == null ? s.stringify() : s.stringify(key)) + + ', v=' + + s.stringify(v) + + ', p=' + + (parent == null ? s.stringify() : s.stringify(parent)) + + ', t=' + + s.pathify(path)); + return v; + } + + s.walk(s.getprop(testData, 'in'), after: walklog); + var expected = s.getprop(s.getprop(testData, 'out'), 'after'); + if (eqv(expected, log)) { + record(group, 'log', true, ''); + } else { + record(group, 'log', false, + 'Expected: ${s.stringify(expected)}, got: ${s.stringify(log)}'); + } + } catch (e) { + record(group, 'log', false, e is s.StructError ? e.message : e.toString()); + } +} + +dynamic walkCopySubject(dynamic vin) { + var cur = [null]; + walkcopy(key, v, parent, path) { + if (key == null) { + cur[0] = [ + s.ismap(v) ? {} : (s.islist(v) ? [] : v) + ]; + return v; + } + var i = s.size(path); + dynamic nv; + if (s.isnode(v)) { + var c = cur[0] as List; + while (c.length <= i) { + c.add(null); + } + nv = s.ismap(v) ? {} : []; + c[i] = nv; + } else { + nv = v; + } + s.setprop(s.getelem(cur[0], i - 1), key, nv); + return v; + } + + s.walk(vin, before: walkcopy); + return s.getelem(cur[0], 0); +} + +dynamic walkDepthSubject(dynamic vin) { + var state = {'top': null, 'cur': null}; + copy(key, v, parent, path) { + if (key == null || s.isnode(v)) { + var child = s.islist(v) ? [] : {}; + if (key == null) { + state['top'] = child; + state['cur'] = child; + } else { + s.setprop(state['cur'], key, child); + state['cur'] = child; + } + } else { + s.setprop(state['cur'], key, v); + } + return v; + } + + s.walk(vget(vin, 'src'), before: copy, maxdepth: vget(vin, 'maxdepth')); + return state['top']; +} + +void runAll(dynamic spec) { + g(k) => s.getprop(spec, k); + var minor = g('minor'); + var walks = g('walk'); + var merges = g('merge'); + var getpaths = g('getpath'); + var injects = g('inject'); + var transforms = g('transform'); + var validates = g('validate'); + var selects = g('select'); + var sentinels = g('sentinels'); + mg(n) => s.getprop(minor, n); + + runSet('minor.isnode', mg('isnode'), arg1((v) => s.isnode(v))); + runSet('minor.ismap', mg('ismap'), arg1((v) => s.ismap(v))); + runSet('minor.islist', mg('islist'), arg1((v) => s.islist(v))); + runSet('minor.iskey', mg('iskey'), arg1((v) => s.iskey(v)), false); + runSet('minor.strkey', mg('strkey'), arg1((v) => s.strkey(v)), false); + runSet('minor.isempty', mg('isempty'), arg1((v) => s.isempty(v)), false); + runSet('minor.isfunc', mg('isfunc'), arg1((v) => s.isfunc(v))); + runSet('minor.clone', mg('clone'), arg1((v) => s.clone(v)), false); + runSet('minor.escre', mg('escre'), arg1((v) => s.escre(v))); + runSet('minor.escurl', mg('escurl'), arg1((v) => s.escurl(v))); + runSet( + 'minor.stringify', + mg('stringify'), + arg1((vin) => vhas(vin, 'val') + ? s.stringify(vget(vin, 'val'), vget(vin, 'max')) + : s.stringify()), + false); + runSet('minor.jsonify', mg('jsonify'), + arg1((vin) => s.jsonify(vget(vin, 'val'), vget(vin, 'flags'))), false); + runSet('minor.getelem', mg('getelem'), arg1((vin) { + var alt = vget(vin, 'alt'); + return alt == null + ? s.getelem(vget(vin, 'val'), vget(vin, 'key')) + : s.getelem(vget(vin, 'val'), vget(vin, 'key'), alt); + }), false); + runSet('minor.delprop', mg('delprop'), + arg1((vin) => s.delprop(vget(vin, 'parent'), vget(vin, 'key')))); + runSet('minor.size', mg('size'), arg1((v) => s.size(v)), false); + runSet( + 'minor.slice', + mg('slice'), + arg1((vin) => + s.slice(vget(vin, 'val'), vget(vin, 'start'), vget(vin, 'end'))), + false); + runSet( + 'minor.pad', + mg('pad'), + arg1((vin) => + s.pad(vget(vin, 'val'), vget(vin, 'pad'), vget(vin, 'char'))), + false); + runSet( + 'minor.pathify', + mg('pathify'), + arg1((vin) => vhas(vin, 'path') + ? s.pathify(vget(vin, 'path'), vget(vin, 'from')) + : s.pathify(s.pathifyNoArg, vget(vin, 'from'))), + false); + runSet('minor.items', mg('items'), arg1((v) => s.items(v))); + runSet('minor.getprop', mg('getprop'), arg1((vin) { + var alt = vget(vin, 'alt'); + return alt == null + ? s.getprop(vget(vin, 'val'), vget(vin, 'key')) + : s.getprop(vget(vin, 'val'), vget(vin, 'key'), alt); + }), false); + runSet( + 'minor.setprop', + mg('setprop'), + arg1((vin) => + s.setprop(vget(vin, 'parent'), vget(vin, 'key'), vget(vin, 'val')))); + runSet('minor.haskey', mg('haskey'), + arg1((vin) => s.haskey(vget(vin, 'src'), vget(vin, 'key'))), false); + runSet('minor.keysof', mg('keysof'), arg1((v) => s.keysof(v))); + runSet( + 'minor.join', + mg('join'), + arg1((vin) => + s.join(vget(vin, 'val'), vget(vin, 'sep'), vget(vin, 'url'))), + false); + runSet('minor.typify', mg('typify'), + (args) => s.typify(args.isEmpty ? s.pathifyNoArg : args[0]), false); + runSet( + 'minor.setpath', + mg('setpath'), + arg1((vin) => + s.setpath(vget(vin, 'store'), vget(vin, 'path'), vget(vin, 'val'))), + false); + runSet('minor.filter', mg('filter'), arg1((vin) { + bool Function(List) check; + var c = vget(vin, 'check'); + if (c == 'gt3') { + check = (n) => n[1] is num && n[1] > 3; + } else if (c == 'lt3') { + check = (n) => n[1] is num && n[1] < 3; + } else { + check = (n) => false; + } + return s.filter(vget(vin, 'val'), check); + })); + runSet('minor.typename', mg('typename'), + arg1((v) => s.typename(v is num ? v.toInt() : 0))); + runSet('minor.flatten', mg('flatten'), arg1((vin) { + var d = vget(vin, 'depth'); + return s.flatten(vget(vin, 'val'), d is num ? d.toInt() : 1); + })); + + runWalkLog('walk.log', s.getprop(walks, 'log')); + runSet( + 'walk.basic', + s.getprop(walks, 'basic'), + arg1((vin) => s.walk(vin, after: (k, v, p, path) { + if (v is String) { + return v + + '~' + + (path as List).map((e) => s.jsString(e)).join('.'); + } + return v; + }))); + runSet('walk.copy', s.getprop(walks, 'copy'), arg1(walkCopySubject)); + runSet( + 'walk.depth', s.getprop(walks, 'depth'), arg1(walkDepthSubject), false); + + runSingle('merge.basic', s.getprop(merges, 'basic'), + (in_) => s.merge(s.clone(in_))); + runSet('merge.cases', s.getprop(merges, 'cases'), arg1((v) => s.merge(v))); + runSet('merge.array', s.getprop(merges, 'array'), arg1((v) => s.merge(v))); + runSet('merge.integrity', s.getprop(merges, 'integrity'), + arg1((v) => s.merge(v))); + runSet('merge.depth', s.getprop(merges, 'depth'), + arg1((vin) => s.merge(vget(vin, 'val'), vget(vin, 'depth')))); + + runSet('getpath.basic', s.getprop(getpaths, 'basic'), + arg1((vin) => s.getpath(vget(vin, 'store'), vget(vin, 'path')))); + runSet('getpath.relative', s.getprop(getpaths, 'relative'), arg1((vin) { + var dp = vget(vin, 'dpath'); + var dpath = dp is String ? dp.split('.') : null; + var injdef = {'dparent': vget(vin, 'dparent'), 'dpath': dpath}; + return s.getpath(vget(vin, 'store'), vget(vin, 'path'), injdef); + })); + runSet( + 'getpath.special', + s.getprop(getpaths, 'special'), + arg1((vin) => + s.getpath(vget(vin, 'store'), vget(vin, 'path'), vget(vin, 'inj')))); + runSet('getpath.handler', s.getprop(getpaths, 'handler'), arg1((vin) { + var store = {'\$TOP': vget(vin, 'store'), '\$FOO': () => 'foo'}; + handler(inj, val, ref, st) => s.isfunc(val) ? val() : val; + return s.getpath(store, vget(vin, 'path'), {'handler': handler}); + })); + + runSingle( + 'inject.basic', + s.getprop(injects, 'basic'), + (in_) => s.inject( + s.clone(s.getprop(in_, 'val')), s.clone(s.getprop(in_, 'store')))); + runSet( + 'inject.string', + s.getprop(injects, 'string'), + arg1((vin) => s.inject(vget(vin, 'val'), vget(vin, 'store'), + {'modify': nullModifier, 'extra': vget(vin, 'current')}))); + runSet('inject.deep', s.getprop(injects, 'deep'), + arg1((vin) => s.inject(vget(vin, 'val'), vget(vin, 'store')))); + + runSingle('transform.basic', s.getprop(transforms, 'basic'), + (in_) => s.transform(s.getprop(in_, 'data'), s.getprop(in_, 'spec'))); + for (var gn in ['paths', 'cmds', 'each', 'pack', 'ref']) { + runSet('transform.$gn', s.getprop(transforms, gn), + arg1((vin) => s.transform(vget(vin, 'data'), vget(vin, 'spec')))); + } + runSet('transform.modify', s.getprop(transforms, 'modify'), arg1((vin) { + modifier(v, key, parent, inj) { + if (v is String && key != null && parent != null) + s.setprop(parent, key, '@' + v); + } + + return s.transform(vget(vin, 'data'), vget(vin, 'spec'), + {'modify': modifier, 'extra': vget(vin, 'store')}); + })); + runSet('transform.format', s.getprop(transforms, 'format'), + arg1((vin) => s.transform(vget(vin, 'data'), vget(vin, 'spec'))), false); + runSet('transform.apply', s.getprop(transforms, 'apply'), + arg1((vin) => s.transform(vget(vin, 'data'), vget(vin, 'spec')))); + + runSet('validate.basic', s.getprop(validates, 'basic'), + arg1((vin) => s.validate(vget(vin, 'data'), vget(vin, 'spec'))), false); + for (var gn in ['child', 'one', 'exact']) { + runSet('validate.$gn', s.getprop(validates, gn), + arg1((vin) => s.validate(vget(vin, 'data'), vget(vin, 'spec')))); + } + runSet('validate.invalid', s.getprop(validates, 'invalid'), + arg1((vin) => s.validate(vget(vin, 'data'), vget(vin, 'spec'))), false); + runSet( + 'validate.special', + s.getprop(validates, 'special'), + arg1((vin) => + s.validate(vget(vin, 'data'), vget(vin, 'spec'), vget(vin, 'inj')))); + + for (var gn in ['basic', 'operators', 'edge', 'alts']) { + runSet('select.$gn', s.getprop(selects, gn), + arg1((vin) => s.select(vget(vin, 'obj'), vget(vin, 'query')))); + } + + runSet( + 'sentinels.getprop_unify', + s.getprop(sentinels, 'getprop_unify'), + arg1((vin) => + s.getprop(vget(vin, 'val'), vget(vin, 'key'), vget(vin, 'alt'))), + false); + runSet( + 'sentinels.getelem_absent', + s.getprop(sentinels, 'getelem_absent'), + arg1((vin) => + s.getelem(vget(vin, 'val'), vget(vin, 'key'), vget(vin, 'alt'))), + false); + runSet('sentinels.haskey_unify', s.getprop(sentinels, 'haskey_unify'), + arg1((vin) => s.haskey(vget(vin, 'val'), vget(vin, 'key'))), false); + runSet('sentinels.isempty_unify', s.getprop(sentinels, 'isempty_unify'), + arg1((v) => s.isempty(v)), false); + runSet('sentinels.isnode_unify', s.getprop(sentinels, 'isnode_unify'), + arg1((v) => s.isnode(v)), false); + runSet('sentinels.stringify_null', s.getprop(sentinels, 'stringify_null'), + arg1((vin) => s.stringify(vin)), false); +} + +void main(List args) { + var testfile = args.isNotEmpty ? args[0] : '../build/test/test.json'; + var raw = File(testfile).readAsStringSync(); + var alltests = jsonDecode(raw); + var spec = s.getprop(alltests, 'struct'); + runAll(spec); + for (var f in failures) { + print(f); + } + print('\nPASS $npass FAIL $nfail'); + if (nfail > 0) exitCode = 1; +} diff --git a/design/REPORT.md b/design/REPORT.md index 1417a14a..3cc80343 100644 --- a/design/REPORT.md +++ b/design/REPORT.md @@ -15,7 +15,7 @@ both pretty (`indent=2`) and compact (`indent=0`) forms. | Lib third-party | Test-runner third-party | |---|---| -| **zero runtime third-party deps in any port.** Every port either uses its language's stdlib JSON (typescript/javascript/python/go/ruby/php/csharp/zig), hand-rolls a small JSON printer (c/cpp/java/kotlin/lua/swift/perl/rust), or pipes the corpus through the language's stdlib parser at test time. | c: **none** (vendored JSON parser in `src/value_io.c`); cpp: **none** (vendored JSON parser in `src/value_io.hpp`); java/kotlin: gson (test-scope only); lua: dkjson + luafilesystem (test-scope only); rust: serde_json (dev-dep only) | +| **zero runtime third-party deps in any port.** Every port either uses its language's stdlib JSON (typescript/javascript/python/go/ruby/php/csharp/zig), hand-rolls a small JSON printer (c/cpp/java/kotlin/lua/swift/perl/rust/clojure/ocaml/scala), or pipes the corpus through the language's stdlib parser at test time. clojure, ocaml and scala additionally ship an in-tree JSON reader for their test runners (no JSON library); ocaml also vendors a small RE2-subset regex engine (`vregex.ml`), while scala uses the JVM stdlib `java.util.regex` and dart uses the core `RegExp` (its runner reads the corpus with the SDK `dart:convert`). elixir keeps its mutable, reference-stable nodes in an ETS-backed heap (OTP stdlib) and uses the core `Regex`; its test runner ships a small hand-written JSON parser (no `Jason`/`Poison`). haskell keeps its mutable, reference-stable nodes in `IORef` cells (the whole API runs in `IO`), vendors a small RE2-subset regex engine (`Vregex.hs`), and ships a hand-written JSON reader in its test runner; it uses only GHC boot libraries (base, array) — no Hackage dependencies. | c: **none** (vendored JSON parser in `src/value_io.c`); cpp: **none** (vendored JSON parser in `src/value_io.hpp`); java/kotlin: gson (test-scope only); lua: dkjson + luafilesystem (test-scope only); rust: serde_json (dev-dep only) | Languages whose stdlib lacks an insertion-ordered map (C, C++, Zig, Rust, Perl, Swift) all hand-roll one in-tree — `Map` inside @@ -53,10 +53,16 @@ NFA engine in-tree (c/cpp/lua/rust/zig). | **java** | 48 | 15 | 2 | 1300/1300 corpus | full TS-canonical parity | | **cpp** | 48 | 15 | 2 | 1268/1268 corpus | full TS-canonical parity | | **csharp** | 48 | 15 | 2 | 78/78 corpus | already Group A | -| **kotlin** | 48 | 15 | 2 | 135/135 | full TS-canonical parity | +| **kotlin** | 48 | 15 | 2 | 1315/1315 corpus | full TS-canonical parity | | **zig** | 48 | 15 | 2 | 60/60 corpus sets \*1 | cycle-break + 7 latent-bug fixes | | **perl** | 48 | 15 | 2 | full corpus (700+ cases) | full canonical parity | | **swift** | 48 | 15 | 2 | full corpus (700+ cases) | full canonical parity | +| **clojure** | 48 | 15 | 2 | 1329/1329 corpus | full TS-canonical parity | +| **ocaml** | 48 | 15 | 2 | 1329/1329 corpus | full TS-canonical parity | +| **scala** | 48 | 15 | 2 | 1329/1329 corpus | full TS-canonical parity | +| **dart** | 48 | 15 | 2 | 1329/1329 corpus | full TS-canonical parity | +| **elixir** | 48 | 15 | 2 | 1329/1329 corpus | full TS-canonical parity | +| **haskell** | 48 | 15 | 2 | 1329/1329 corpus | full TS-canonical parity | \*1 Zig: previously reported "60/60 passing with a SIGSEGV" was misleading — the test process actually died at test 47/60 diff --git a/elixir/AGENTS.md b/elixir/AGENTS.md new file mode 100644 index 00000000..a49f8489 --- /dev/null +++ b/elixir/AGENTS.md @@ -0,0 +1,80 @@ +# AGENTS.md — Elixir port of `voxgig/struct` + +Read the repo-root [`../AGENTS.md`](../AGENTS.md) first. This file covers only +what is specific to the Elixir port. **TypeScript is canonical; the shared +`build/test/*.jsonic` corpus is the contract.** This port follows the +single-`nil` model of the Python / Clojure / Dart ports (Elixir has one `nil`), +not the distinct-`undefined`/`null` model of the OCaml / Scala ports. + +## How to build / test / lint + +``` +cd elixir +make test # elixir test/runner.exs — runs build/test/test.json +make lint # elixirc lib/voxgig_struct.ex (a clean compile = pass) +``` + +Requires only Elixir / Erlang OTP. **Zero third-party runtime dependencies** — +the library uses only the standard library (ETS for the heap, `Regex`/`:re` for +the regex API). The test runner additionally ships a tiny hand-written JSON +parser (no `Jason`/`Poison`) so it, too, has no third-party deps. + +## The value model + +The canonical algorithm mutates nodes in place and relies on reference-stable +nodes. The BEAM has no mutable, reference-stable native collection, so nodes +live in a small **ETS-backed heap**: + +- **maps → `{:vmap, id}`** — contents are an ordered list of `{key, value}` + pairs (Elixir maps are unordered, so they can't be used directly); + re-assigning an existing key keeps its position. +- **lists → `{:vlist, id}`** — contents are a plain list of items. +- **inject state → `{:vinj, id}`** — an atom-keyed field map. + +The contents live in one lazily-created named public ETS table; a node tuple +holds only the id, so mutating the heap entry is observed through every holder +of the reference. `ismap`/`islist`/`isnode` pattern-match the tag; `isfunc` +tests `is_function`. **Always** build nodes with `jm` / `jt` (or the engines) — +never hand-assemble the tuples. + +## `nil` is both `undefined` and JSON `null` + +Like Python, Elixir has a single `nil`, so the canonical `undefined` (absent) +and JSON `null` both map to `nil`. The Group A/B rules +([`../design/UNDEF_SPEC.md`](../design/UNDEF_SPEC.md)) recover the distinction: + +- Group A readers (`getprop`, `getelem`, `haskey`, `isnode`, `isempty`) treat a + stored `nil` as "no value". +- Group B processors (`setprop`, `clone`, `merge`, `walk`, `inject`, + `transform`, `validate`, `select`) preserve `nil` literally; `lookup_` is + the internal raw reader. + +A `@noarg` atom sentinel (exposed publicly as `noarg/0`) distinguishes +"no argument supplied" from `nil` for `typify` (→ `T_noval` vs `T_null`), +`stringify` (→ `""` vs `"null"`), and `pathify` (→ `` vs +``). + +## Naming + +Public names are the canonical lower-smushed / snake_cased names (`getpath`, +`ismap`, `re_find_all`, `check_placement`, `injector_args`, `inject_child`), so +the case/underscore-insensitive parity check matches them. Type constants and +mode/marker accessors are 0-arity functions (`t_string/0`, `m_val/0`, +`skip/0`, `delete/0`, `noarg/0`). + +## Gotchas + +- **`skip` / `delete`** are atoms (`:vox_skip` / `:vox_delete`) compared with + `==` (`is_skip` / `is_delete`). +- The `Inj` injection state is a `{:vinj, _}` heap cell; an `injdef` passed by + callers is just a `{:vmap, _}` node (functions can live in a map node), so + there is no separate options type. +- **Numbers.** JSON integers parse to `integer`, decimals to `float`. `typify` + treats a whole `float` as an integer (`Number.isInteger` semantics); + `stringify`/`jsonify` follow JS formatting (an integral `float` prints + without `.0`). Guard `Float.floor/1` against integer arguments. +- The heap is process-independent (a named public ETS table), so nodes are + shared across the whole VM; this is intentional and matches the canonical + shared-reference semantics. +- Keep `make test` and `python3 ../tools/check_parity.py` green, and add no + runtime dependencies. Change canonical (TS + corpus) first, then propagate. diff --git a/elixir/DOCS.md b/elixir/DOCS.md new file mode 100644 index 00000000..906d59e3 --- /dev/null +++ b/elixir/DOCS.md @@ -0,0 +1,127 @@ +# Elixir port — comprehensive guide + +This document covers the Elixir-specific details of `voxgig/struct`. For the +language-neutral concepts, tutorial and full reference, read the top-level +[`../DOCS.md`](../DOCS.md); for the user overview, [`README.md`](./README.md). +TypeScript is canonical and the shared `build/test` corpus is the contract. + +## Installation + +The whole library is one file (`lib/voxgig_struct.ex`) with no third-party +dependencies. Drop it into your project (or depend on the published Hex +package) and `alias Voxgig.Struct, as: S`. + +## Representation of data + +| JSON-shape thing | Elixir representation | +|-------------------------|---------------------------------------------| +| object / map | `{:vmap, id}` heap node (insertion order) | +| array / list | `{:vlist, id}` heap node | +| string | `binary` (`String`) | +| integer | `integer` | +| decimal | `float` | +| boolean | `boolean` | +| JSON `null` / undefined | `nil` | +| function (commands) | a 4-arity (or 0-arity) anonymous function | + +Nodes are **mutable and reference-stable** on purpose: `merge`, `walk`, +`inject`, `transform`, `validate` mutate nodes in place and depend on shared +references. The BEAM has no mutable native collection, so the port keeps node +contents in a small **ETS-backed heap** (ETS is OTP stdlib, like the JVM heap +the Clojure port uses or Rust's `Rc`). A node is a tagged reference; +the contents in the heap table are replaced on mutation while the reference +stays stable, so every holder observes the update. + +Build nodes with the public `jm` (object) and `jt` (array) constructors, or by +running the `transform` / `inject` engines — never assemble the `{:vmap, _}` / +`{:vlist, _}` tuples by hand. + +### `nil`: undefined vs JSON null + +Elixir has a single `nil`, used for both the canonical `undefined` and JSON +`null`. The library follows the Group A / Group B rules +([`../design/UNDEF_SPEC.md`](../design/UNDEF_SPEC.md)): + +- **Group A** readers — `getprop`, `getelem`, `haskey`, `isnode`, `isempty` — + treat a stored `nil` as "no value". +- **Group B** processors — `setprop`, `clone`, `merge`, `walk`, `inject`, + `transform`, `validate`, `select` — preserve `nil` literally. + +Where a function must tell "no argument" from an explicit `nil`, pass the +public `noarg/0` sentinel: + +```elixir +S.typify() # T_noval (no argument = undefined) +S.typify(nil) # T_scalar | T_null +S.stringify() # "" (undefined) +S.stringify(nil) # "null" (JSON null) +S.pathify(S.noarg()) # "" +``` + +## The public API + +Names are lower-smushed / snake_cased, identical (case/underscore-insensitively) +to the canonical export list: + +- **Lookups / paths:** `getpath`, `setpath`, `getprop`, `setprop`, `getelem`, + `delprop`, `haskey`, `keysof`, `items`. +- **Predicates / kinds:** `isnode`, `ismap`, `islist`, `iskey`, `isfunc`, + `isempty`, `typify`, `typename`. +- **Values:** `clone`, `merge`, `walk`, `size`, `slice`, `pad`, `flatten`, + `filter`, `getdef`, `strkey`. +- **Strings / formatting:** `stringify`, `jsonify`, `pathify`, `join`, + `escre`, `escurl`. +- **Regex (RE2-subset uniform API):** `re_compile`, `re_find`, `re_find_all`, + `re_replace`, `re_test`, `re_escape`. Backed by the core `Regex`/`:re`. +- **By-example engine:** `inject`, `transform`, `validate`, `select`, and the + injector helpers `check_placement`, `injector_args`, `inject_child`. +- **Builders / markers:** `jm`, `jt`, `skip/0`, `delete/0`, `noarg/0`, the + `t_*` type constants and `m_keypre` / `m_keypost` / `m_val`. + +`walk` takes a keyword list of options (`before:` / `after:` / `maxdepth:`); +most other optional arguments are positional, e.g. `getprop(val, key, alt \\ nil)`, +`slice(val, start \\ nil, stop \\ nil, mutate \\ false)`, +`stringify(val \\ noarg, maxlen \\ nil, pretty \\ nil)`, +`merge(objs, maxdepth \\ nil)`. Walk callbacks are `fn key, val, parent, path -> val end`. + +## Examples + +```elixir +alias Voxgig.Struct, as: S + +# merge (later wins; the first node is modified in place) +S.merge(S.jt([S.jm(["a", 1]), S.jm(["b", 2])])) # {a:1, b:2} + +# transform: spec mirrors the desired output, backticks pull from data +S.transform(S.jm(["name", "alice"]), S.jm(["user", S.jm(["id", "`name`"])])) + +# validate: plain values are typed defaults; `$STRING` etc. are commands +S.validate(S.jm(["a", "x"]), S.jm(["a", "`$STRING`"])) # {a:x} + +# select: MongoDB-style query over children +S.select(S.jt([S.jm(["a", 1]), S.jm(["a", 2])]), S.jm(["a", S.jm(["`$GT`", 1])])) +``` + +## Testing + +`make test` runs the entire shared corpus (`../build/test/test.json`) through +the port via `elixir test/runner.exs`. The runner ships a tiny JSON parser that +reads the corpus straight into heap nodes (via the public `jm` / `jt` +constructors) — the same native types the library operates on — and uses the +same runner logic as every other port. Keep it green, keep +`python3 ../tools/check_parity.py` green, and add no runtime dependencies. + +## Implementation notes + +- The injection state (`Inj`) is a heap cell (`{:vinj, id}`) with atom-keyed + fields; a caller-supplied `injdef` is just a `{:vmap, _}` node (functions can + live in a map node). +- `skip/0` / `delete/0` are atom sentinels compared with `==` (`is_skip` / + `is_delete`). +- Numbers follow JS formatting in `stringify` / `jsonify` (an integral `float` + prints without a trailing `.0`; `:erlang.float_to_binary(n, [:short])` gives + the shortest round-tripping form otherwise). +- The only regex engine is the core `Regex` (`:re`), which covers the RE2 + subset the corpus uses for `$LIKE` and the `re_*` API. +- The heap is a single named public ETS table created lazily; node ids come + from `:erlang.unique_integer([:positive, :monotonic])`. diff --git a/elixir/Makefile b/elixir/Makefile new file mode 100644 index 00000000..b558a62c --- /dev/null +++ b/elixir/Makefile @@ -0,0 +1,31 @@ +# Makefile for the Elixir port of voxgig/struct. +# Requires Elixir (`elixir` / `elixirc`) on PATH. No third-party dependencies. + +.PHONY: test lint build inspect clean reset publish format + +# Run the shared JSON corpus through the Elixir implementation. +test: + elixir test/runner.exs + +# "Lint": compile the library with warnings (a clean compile means it is sound). +lint: + elixirc lib/voxgig_struct.ex -o /tmp/voxgig_struct_build + +# Compile the library as a build smoke-test. +build: + elixirc lib/voxgig_struct.ex -o /tmp/voxgig_struct_build + +format: + mix format --check-formatted lib/voxgig_struct.ex 2>/dev/null || true + +inspect: + @elixir --version + +clean: + rm -rf _build /tmp/voxgig_struct_build Elixir.*.beam + +reset: clean + +# The library publishes to hex.pm; this target creates the git tag. +publish: + @echo "elixir: publish via 'mix hex.publish' + git tag elixir/vX.Y.Z" diff --git a/elixir/README.md b/elixir/README.md new file mode 100644 index 00000000..fc44199e --- /dev/null +++ b/elixir/README.md @@ -0,0 +1,77 @@ +# voxgig_struct — Elixir + +An Elixir port of [`voxgig/struct`](../README.md): one small, fixed API for +manipulating JSON-shaped data — lookups, deep merge, by-example transform, +by-example validate, tree walk, path get/set, selection — that returns the +**same answer** as the canonical TypeScript implementation and every other +port. The behavioural contract is the shared JSON corpus in +[`build/test/`](../build/test); this port passes it in full. + +## Status + +Complete. Every canonical public function is implemented and the entire +shared corpus passes (`make test`). **Zero third-party dependencies** — only +Elixir / Erlang OTP (ETS and `Regex`/`:re`) is required. + +## Requirements + +- Elixir 1.14 or later (Erlang/OTP 24+). + +## Use + +```elixir +alias Voxgig.Struct, as: S + +store = S.jm(["a", S.jm(["b", 2])]) +S.getpath(store, "a.b") # 2 + +S.stringify(S.transform(S.jm(["a", 1]), S.jm(["x", "`a`"]))) # "{x:1}" +``` + +`jm` / `jt` are the JSON-object / JSON-array builders (`jm` takes a flat +`[k1, v1, k2, v2, ...]` list; `jt` takes a list of items): + +```elixir +S.jsonify(S.jm(["a", 1, "b", S.jt([2, 3])])) +``` + +### Data model + +The canonical algorithm mutates nodes in place and relies on **reference-stable** +nodes (a node updated through one reference is seen through every other). The +BEAM has no mutable native collection, so this port keeps nodes in a small +**ETS-backed heap**: a node is a tagged reference — `{:vmap, id}` (object) or +`{:vlist, id}` (array) — whose contents live in the heap and are replaced on +mutation, so the reference stays stable. Build nodes with `jm` / `jt` (or the +`transform` / `inject` engines); never construct the tuples by hand. + +- maps → `{:vmap, id}` (insertion-ordered key/value pairs), +- lists → `{:vlist, id}`, +- `nil` plays the role of both `undefined` and JSON `null` (the Group A/B + rules recover the distinction — see + [`../design/UNDEF_SPEC.md`](../design/UNDEF_SPEC.md)). + +## API + +The public surface matches the canonical export list, in lower-smushed / +snake_cased names: + +`clone delprop escre escurl filter flatten getdef getelem getpath getprop +haskey inject isempty isfunc iskey islist ismap isnode items join jsonify +keysof merge pad pathify select setpath setprop size slice strkey stringify +transform typify typename validate walk re_compile re_find re_find_all +re_replace re_test re_escape jm jt check_placement injector_args inject_child` + +See [`DOCS.md`](./DOCS.md) for the full guide and +[the language-neutral docs](../DOCS.md) for concepts and examples. + +## Develop + +``` +make test # run the shared corpus +make lint # compile the library (a clean compile = pass) +``` + +## License + +MIT. See [`../LICENSE`](../LICENSE). diff --git a/elixir/lib/voxgig_struct.ex b/elixir/lib/voxgig_struct.ex new file mode 100644 index 00000000..a2719ded --- /dev/null +++ b/elixir/lib/voxgig_struct.ex @@ -0,0 +1,2615 @@ +# Copyright (c) 2025-2026 Voxgig Ltd. MIT LICENSE. +# +# Voxgig Struct — Elixir port. +# +# A faithful port of the canonical TypeScript implementation +# (typescript/src/StructUtility.ts). The canonical algorithm mutates nodes in +# place and relies on reference-stable nodes (shared references seen by walk / +# merge / inject). The BEAM has no mutable, reference-stable native collection, +# so this port emulates a small mutable heap with ETS (an OTP-stdlib facility, +# like the JVM heap the Clojure port uses or Rust's Rc): a node is a +# tagged reference `{:vmap, id}` / `{:vlist, id}` whose contents live in the +# heap table and are replaced on mutation; the reference is stable, so all +# holders observe updates. +# +# Like the Python / Clojure / Dart ports, Elixir has a single `nil`, so the +# canonical `undefined` and JSON `null` are both `nil`; the Group A/B rules +# recover the distinction, and a NOARG sentinel marks "no argument supplied". +# +# Zero third-party runtime dependencies (ETS and :re/Regex are OTP stdlib). + +defmodule Voxgig.Struct do + @moduledoc "Faithful Elixir port of voxgig/struct. See AGENTS.md." + + # --------------------------------------------------------------------------- + # Mutable heap (ETS) + # --------------------------------------------------------------------------- + + @heap :vox_struct_heap + + defp ensure_heap do + case :ets.whereis(@heap) do + :undefined -> + try do + :ets.new(@heap, [:set, :public, :named_table]) + rescue + ArgumentError -> :ok + end + + :ok + + _ -> + :ok + end + end + + defp alloc(contents) do + ensure_heap() + id = :erlang.unique_integer([:positive, :monotonic]) + :ets.insert(@heap, {id, contents}) + id + end + + defp hget(id) do + case :ets.lookup(@heap, id) do + [{_, c}] -> c + _ -> nil + end + end + + defp hset(id, contents), do: :ets.insert(@heap, {id, contents}) + + defp vmap_new(pairs), do: {:vmap, alloc(pairs)} + defp vlist_new(items), do: {:vlist, alloc(items)} + defp empty_map, do: vmap_new([]) + defp empty_list, do: vlist_new([]) + + defp map_pairs({:vmap, id}), do: hget(id) + defp map_set_pairs({:vmap, id}, pairs), do: hset(id, pairs) + defp list_items({:vlist, id}), do: hget(id) + defp list_set_items({:vlist, id}, items), do: hset(id, items) + + # Injection cell + defp vinj_new(fields), do: {:vinj, alloc(fields)} + defp ig({:vinj, id}, k), do: Map.get(hget(id), k) + + defp is_({:vinj, id}, k, v) do + hset(id, Map.put(hget(id), k, v)) + v + end + + defp isinj({:vinj, _}), do: true + defp isinj(_), do: false + + # --------------------------------------------------------------------------- + # Sentinels / constants + # --------------------------------------------------------------------------- + + @noarg :vox_noarg + def noarg, do: @noarg + + @skip :vox_skip + @delete :vox_delete + def skip, do: @skip + def delete, do: @delete + def is_skip(v), do: v == @skip + def is_delete(v), do: v == @delete + + @m_keypre "key:pre" + @m_keypost "key:post" + @m_val "val" + def m_keypre, do: 1 + def m_keypost, do: 2 + def m_val, do: 4 + + defp mode_to_num(@m_keypre), do: 1 + defp mode_to_num(@m_keypost), do: 2 + defp mode_to_num(@m_val), do: 4 + defp mode_to_num(_), do: 0 + + @s_dkey "$KEY" + @s_banno "`$ANNO`" + @s_dtop "$TOP" + @s_derrs "$ERRS" + @s_dspec "$SPEC" + @s_bexact "`$EXACT`" + @s_bval "`$VAL`" + @s_bkey "`$KEY`" + @s_bopen "`$OPEN`" + @s_mt "" + @s_bt "`" + @s_ds "$" + @s_cn ":" + @s_key "KEY" + @s_viz ": " + + @t_any 0x7FFFFFFF + @t_noval 0x40000000 + @t_boolean 0x20000000 + @t_decimal 0x10000000 + @t_integer 0x08000000 + @t_number 0x04000000 + @t_string 0x02000000 + @t_function 0x01000000 + @t_null 0x00400000 + @t_list 0x00004000 + @t_map 0x00002000 + @t_instance 0x00001000 + @t_scalar 0x00000080 + @t_node 0x00000040 + + def t_any, do: @t_any + def t_noval, do: @t_noval + def t_boolean, do: @t_boolean + def t_decimal, do: @t_decimal + def t_integer, do: @t_integer + def t_number, do: @t_number + def t_string, do: @t_string + def t_function, do: @t_function + def t_null, do: @t_null + def t_list, do: @t_list + def t_map, do: @t_map + def t_instance, do: @t_instance + def t_scalar, do: @t_scalar + def t_node, do: @t_node + + @typename { + "any", "nil", "boolean", "decimal", "integer", "number", "string", "function", + "symbol", "null", "", "", "", "", "", "", "", "list", "map", "instance", + "", "", "", "", "scalar", "node" + } + + @maxdepth 32 + + @r_inject_full ~r/^`(\$[A-Z]+|[^`]*)[0-9]*`$/ + @r_inject_part ~r/`([^`]*)`/ + @r_meta_path ~r/^([^$]+)\$([=~])(.+)$/ + @r_transform_name ~r/`\$([A-Z]+)`/ + @r_intkey ~r/^-?[0-9]+$/ + + # --------------------------------------------------------------------------- + # Low-level helpers + # --------------------------------------------------------------------------- + + defp is_intish(n) when is_integer(n), do: true + defp is_intish(n) when is_float(n), do: n == Float.floor(n) + defp is_intish(_), do: false + + defp num_to_string(n) when is_integer(n), do: Integer.to_string(n) + + defp num_to_string(n) when is_float(n) do + cond do + n == Float.floor(n) and abs(n) < 1.0e16 -> Integer.to_string(trunc(n)) + true -> shortest_float(n) + end + end + + defp shortest_float(n) do + s = :erlang.float_to_binary(n, [:short]) + s + end + + defp js_string(nil), do: "null" + defp js_string(true), do: "true" + defp js_string(false), do: "false" + defp js_string(v) when is_number(v), do: num_to_string(v) + defp js_string(v) when is_binary(v), do: v + defp js_string(v) when is_function(v), do: "function" + defp js_string(@skip), do: "skip" + defp js_string(@delete), do: "delete" + + defp js_string({:vlist, _} = v) do + list_items(v) + |> Enum.map(fn x -> if x == nil, do: "", else: js_string(x) end) + |> Enum.join(",") + end + + defp js_string({:vmap, _}), do: "[object Object]" + defp js_string(v), do: inspect(v) + + defp mapkey(k) when is_binary(k), do: k + defp mapkey(k) when is_number(k), do: num_to_string(k) + defp mapkey(k), do: js_string(k) + + defp to_int(k) when is_boolean(k), do: nil + defp to_int(k) when is_integer(k), do: k + defp to_int(k) when is_float(k), do: trunc(Float.floor(k)) + + defp to_int(k) when is_binary(k) do + case Integer.parse(String.trim(k)) do + {n, ""} -> n + _ -> nil + end + end + + defp to_int(_), do: nil + + defp clz32(n0) do + n = Bitwise.band(n0, 0xFFFFFFFF) + + if n == 0 do + 32 + else + clz_loop(n, 0) + end + end + + defp clz_loop(n, r) do + if Bitwise.band(n, 0x80000000) != 0 do + r + else + clz_loop(Bitwise.band(Bitwise.bsl(n, 1), 0xFFFFFFFF), r + 1) + end + end + + # --------------------------------------------------------------------------- + # Minor utilities + # --------------------------------------------------------------------------- + + def isnode({:vmap, _}), do: true + def isnode({:vlist, _}), do: true + def isnode(_), do: false + + def ismap({:vmap, _}), do: true + def ismap(_), do: false + + def islist({:vlist, _}), do: true + def islist(_), do: false + + def isfunc(v), do: is_function(v) + + def iskey(k) when is_binary(k), do: k != "" + def iskey(k) when is_boolean(k), do: false + def iskey(k) when is_number(k), do: true + def iskey(_), do: false + + def isempty(v \\ nil) do + cond do + v == nil -> true + v == "" -> true + islist(v) -> list_items(v) == [] + ismap(v) -> map_pairs(v) == [] + true -> false + end + end + + def getdef(v, alt), do: if(v == nil, do: alt, else: v) + + def typify(value \\ @noarg) do + cond do + value == @noarg -> @t_noval + value == nil -> Bitwise.bor(@t_scalar, @t_null) + is_boolean(value) -> Bitwise.bor(@t_scalar, @t_boolean) + is_integer(value) -> Bitwise.bor(Bitwise.bor(@t_scalar, @t_number), @t_integer) + is_float(value) -> typify_float(value) + is_binary(value) -> Bitwise.bor(@t_scalar, @t_string) + is_function(value) -> Bitwise.bor(@t_scalar, @t_function) + islist(value) -> Bitwise.bor(@t_node, @t_list) + ismap(value) -> Bitwise.bor(@t_node, @t_map) + true -> Bitwise.bor(@t_node, @t_instance) + end + end + + defp typify_float(value) do + cond do + value != value -> @t_noval + value == Float.floor(value) -> Bitwise.bor(Bitwise.bor(@t_scalar, @t_number), @t_integer) + true -> Bitwise.bor(Bitwise.bor(@t_scalar, @t_number), @t_decimal) + end + end + + def typename(t \\ 0) do + i = clz32(t) + if i >= 0 and i < tuple_size(@typename), do: elem(@typename, i), else: elem(@typename, 0) + end + + def size(v \\ nil) do + cond do + islist(v) -> length(list_items(v)) + ismap(v) -> length(map_pairs(v)) + is_binary(v) -> String.length(v) + is_boolean(v) -> if v, do: 1, else: 0 + is_number(v) -> trunc(Float.floor(v / 1)) + true -> 0 + end + end + + def strkey(key \\ nil) do + cond do + key == nil -> @s_mt + is_binary(key) -> key + is_boolean(key) -> @s_mt + is_number(key) -> if(is_intish(key), do: num_to_string(key), else: num_to_string(Float.floor(key))) + true -> @s_mt + end + end + + def keysof(v \\ nil) do + cond do + ismap(v) -> map_pairs(v) |> Enum.map(&elem(&1, 0)) |> Enum.sort() + islist(v) -> n = length(list_items(v)); if(n == 0, do: [], else: Enum.map(0..(n - 1), &Integer.to_string/1)) + true -> [] + end + end + + defp omap_get(pairs, k) do + case List.keyfind(pairs, k, 0) do + {_, v} -> {:ok, v} + nil -> :error + end + end + + defp omap_put(pairs, k, v) do + if List.keymember?(pairs, k, 0) do + Enum.map(pairs, fn {kk, vv} -> if kk == k, do: {k, v}, else: {kk, vv} end) + else + pairs ++ [{k, v}] + end + end + + defp omap_del(pairs, k), do: Enum.reject(pairs, fn {kk, _} -> kk == k end) + + def getprop(val, key, alt \\ nil) do + if val == nil or key == nil do + alt + else + out = + cond do + ismap(val) -> + case omap_get(map_pairs(val), mapkey(key)) do + {:ok, v} -> v + :error -> nil + end + + islist(val) -> + ki = to_int(key) + items = if ki == nil, do: [], else: list_items(val) + if ki != nil and ki >= 0 and ki < length(items), do: Enum.at(items, ki), else: nil + + true -> + nil + end + + if out == nil, do: alt, else: out + end + end + + defp lookup_(val, key) do + cond do + val == nil or key == nil -> + nil + + ismap(val) -> + case omap_get(map_pairs(val), mapkey(key)) do + {:ok, v} -> v + :error -> nil + end + + islist(val) -> + ki = to_int(key) + items = if ki == nil, do: [], else: list_items(val) + if ki != nil and ki >= 0 and ki < length(items), do: Enum.at(items, ki), else: nil + + true -> + nil + end + end + + def haskey(val \\ nil, key \\ nil), do: getprop(val, key) != nil + + def getelem(val, key, alt \\ nil) do + if val == nil or key == nil do + alt + else + out = + if islist(val) do + ks = cond do; is_binary(key) -> key; is_number(key) -> num_to_string(key); true -> "" end + + if Regex.match?(@r_intkey, ks) do + items = list_items(val) + len = length(items) + nk0 = String.to_integer(ks) + nk = if nk0 < 0, do: len + nk0, else: nk0 + if nk >= 0 and nk < len, do: Enum.at(items, nk), else: nil + else + nil + end + else + nil + end + + if out == nil do + if isfunc(alt), do: alt.(), else: alt + else + out + end + end + end + + defp getprop_raw(v, k) do + cond do + ismap(v) -> + case omap_get(map_pairs(v), k) do + {:ok, x} -> x + :error -> nil + end + + islist(v) -> + i = String.to_integer(k) + items = list_items(v) + if i >= 0 and i < length(items), do: Enum.at(items, i), else: nil + + true -> + nil + end + end + + defp items_pairs(v) do + if not isnode(v), do: [], else: Enum.map(keysof(v), fn k -> {k, getprop_raw(v, k)} end) + end + + def items(v \\ nil) do + vlist_new(Enum.map(items_pairs(v), fn {k, x} -> vlist_new([k, x]) end)) + end + + defp items_v(v, f), do: vlist_new(Enum.map(items_pairs(v), f)) + + def flatten(l, depth \\ 1) do + if not islist(l) do + l + else + out = + Enum.reduce(list_items(l), [], fn item, acc -> + if islist(item) and depth > 0 do + acc ++ list_items(flatten(item, depth - 1)) + else + acc ++ [item] + end + end) + + vlist_new(out) + end + end + + def filter(val, check) do + out = Enum.reduce(items_pairs(val), [], fn {k, x}, acc -> if check.({k, x}), do: acc ++ [x], else: acc end) + vlist_new(out) + end + + def setprop(parent, key, val) do + cond do + not iskey(key) -> + parent + + ismap(parent) -> + map_set_pairs(parent, omap_put(map_pairs(parent), mapkey(key), val)) + parent + + islist(parent) -> + case to_int(key) do + nil -> + parent + + ki -> + items = list_items(parent) + len = length(items) + + new = + cond do + ki >= 0 -> + ki2 = if ki > len, do: len, else: ki + if ki2 >= len, do: items ++ [val], else: List.replace_at(items, ki2, val) + + true -> + [val | items] + end + + list_set_items(parent, new) + parent + end + + true -> + parent + end + end + + def delprop(parent, key) do + cond do + not iskey(key) -> + parent + + ismap(parent) -> + map_set_pairs(parent, omap_del(map_pairs(parent), mapkey(key))) + parent + + islist(parent) -> + case to_int(key) do + nil -> + parent + + ki -> + items = list_items(parent) + if ki >= 0 and ki < length(items), do: list_set_items(parent, List.delete_at(items, ki)) + parent + end + + true -> + parent + end + end + + def clone(v \\ nil) do + cond do + ismap(v) -> vmap_new(Enum.map(map_pairs(v), fn {k, x} -> {k, clone(x)} end)) + islist(v) -> vlist_new(Enum.map(list_items(v), &clone/1)) + true -> v + end + end + + def slice(val, start \\ nil, stop \\ nil, mutate \\ false) do + cond do + is_number(val) and not is_boolean(val) -> + lo = if is_number(start), do: start, else: nil + hi = if is_number(stop), do: stop - 1, else: nil + + cond do + hi != nil and val > hi -> hi + lo != nil and val < lo -> lo + true -> val + end + + islist(val) or is_binary(val) -> + slice_seq(val, start, stop, mutate) + + true -> + val + end + end + + defp slice_seq(val, start, stop, mutate) do + vlen = size(val) + start = if start == nil and stop != nil, do: 0, else: start + + if start == nil do + val + else + s0 = trunc(start) + + {s, e} = + cond do + s0 < 0 -> + e = vlen + s0 + {0, if(e < 0, do: 0, else: e)} + + stop != nil -> + e0 = trunc(stop) + + cond do + e0 < 0 -> ee = vlen + e0; {s0, if(ee < 0, do: 0, else: ee)} + vlen < e0 -> {s0, vlen} + true -> {s0, e0} + end + + true -> + {s0, vlen} + end + + s = if vlen < s, do: vlen, else: s + + if s > -1 and s <= e and e <= vlen do + cond do + islist(val) -> + sub = Enum.slice(list_items(val), s, e - s) + if mutate, do: (list_set_items(val, sub); val), else: vlist_new(sub) + + true -> + binary_part(val, s, e - s) + end + else + cond do + islist(val) -> if mutate, do: (list_set_items(val, []); val), else: empty_list() + true -> @s_mt + end + end + end + end + + # --------------------------------------------------------------------------- + # Regex helpers (uniform re_* API over :re/Regex) + # --------------------------------------------------------------------------- + + defp rx(p) do + cond do + is_struct(p, Regex) -> p + is_binary(p) -> Regex.compile!(p) + true -> Regex.compile!(js_string(p)) + end + end + + def re_compile(p, _flags \\ nil), do: rx(p) + def re_test(p, input), do: Regex.match?(rx(p), if(is_binary(input), do: input, else: js_string(input))) + + def re_find(p, input) do + case Regex.run(rx(p), if(is_binary(input), do: input, else: js_string(input))) do + nil -> nil + groups -> vlist_new(Enum.map(groups, fn g -> g || "" end)) + end + end + + def re_find_all(p, input) do + matches = Regex.scan(rx(p), if(is_binary(input), do: input, else: js_string(input))) + vlist_new(Enum.map(matches, fn groups -> vlist_new(Enum.map(groups, fn g -> g || "" end)) end)) + end + + def re_replace(_p, input, _repl), do: input + def re_escape(s), do: escre(s) + + def escre(s \\ nil) do + str = cond do; is_binary(s) -> s; s == nil -> @s_mt; true -> js_string(s) end + + str + |> String.to_charlist() + |> Enum.map(fn c -> + ch = <> + if String.contains?(".*+?^${}()|[]\\", ch), do: "\\" <> ch, else: ch + end) + |> Enum.join("") + end + + @url_unreserved "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_.!~*'()" + + def escurl(s \\ nil) do + str = cond do; is_binary(s) -> s; s == nil -> @s_mt; true -> js_string(s) end + + :binary.bin_to_list(str) + |> Enum.map(fn b -> + ch = <> + if String.contains?(@url_unreserved, ch) do + ch + else + "%" <> String.upcase(String.pad_leading(Integer.to_string(b, 16), 2, "0")) + end + end) + |> Enum.join("") + end + + # --------------------------------------------------------------------------- + # JSON-ish serialization / stringify / jsonify + # --------------------------------------------------------------------------- + + defp esc_json(s) do + inner = + s + |> String.to_charlist() + |> Enum.map(fn c -> + case c do + ?" -> "\\\"" + ?\\ -> "\\\\" + ?\n -> "\\n" + ?\r -> "\\r" + ?\t -> "\\t" + c when c < 32 -> "\\u" <> String.pad_leading(Integer.to_string(c, 16), 4, "0") + c -> <> + end + end) + |> Enum.join("") + + "\"" <> inner <> "\"" + end + + defp json_encode(v, sort \\ false, indent \\ nil), do: json_enc(v, sort, indent, 0) + + defp json_enc(v, sort, indent, level) do + cond do + v == nil -> "null" + v == true -> "true" + v == false -> "false" + is_number(v) -> num_to_string(v) + is_binary(v) -> esc_json(v) + is_function(v) -> "null" + v == @skip or v == @delete -> "null" + islist(v) -> json_list(list_items(v), sort, indent, level) + ismap(v) -> json_map(map_pairs(v), sort, indent, level) + true -> esc_json(js_string(v)) + end + end + + defp json_list([], _sort, _indent, _level), do: "[]" + + defp json_list(items, sort, nil, level) do + "[" <> Enum.map_join(items, ",", fn x -> json_enc(x, sort, nil, level + 1) end) <> "]" + end + + defp json_list(items, sort, indent, level) do + pad = String.duplicate(" ", indent * (level + 1)) + cpad = String.duplicate(" ", indent * level) + body = Enum.map_join(items, ",\n", fn x -> pad <> json_enc(x, sort, indent, level + 1) end) + "[\n" <> body <> "\n" <> cpad <> "]" + end + + defp json_map(pairs, sort, indent, level) do + ks = Enum.map(pairs, &elem(&1, 0)) + ks = if sort, do: Enum.sort(ks), else: ks + + cond do + ks == [] -> + "{}" + + indent == nil -> + "{" <> + Enum.map_join(ks, ",", fn k -> + {_, v} = List.keyfind(pairs, k, 0) + esc_json(k) <> ":" <> json_enc(v, sort, nil, level + 1) + end) <> "}" + + true -> + pad = String.duplicate(" ", indent * (level + 1)) + cpad = String.duplicate(" ", indent * level) + + body = + Enum.map_join(ks, ",\n", fn k -> + {_, v} = List.keyfind(pairs, k, 0) + pad <> esc_json(k) <> ": " <> json_enc(v, sort, indent, level + 1) + end) + + "{\n" <> body <> "\n" <> cpad <> "}" + end + end + + defp has_cycle(v), do: has_cycle(v, MapSet.new()) + + defp has_cycle({:vmap, id} = v, seen) do + if MapSet.member?(seen, id), do: true, else: Enum.any?(map_pairs(v), fn {_, x} -> has_cycle(x, MapSet.put(seen, id)) end) + end + + defp has_cycle({:vlist, id} = v, seen) do + if MapSet.member?(seen, id), do: true, else: Enum.any?(list_items(v), fn x -> has_cycle(x, MapSet.put(seen, id)) end) + end + + defp has_cycle(_, _), do: false + + def stringify(v \\ @noarg, maxlen \\ nil, pretty \\ nil) do + pr = pretty == true + + cond do + v == @noarg -> + if pr, do: "<>", else: @s_mt + + true -> + valstr = + cond do + is_binary(v) -> v + has_cycle(v) -> "__STRINGIFY_FAILED__" + true -> String.replace(json_encode(v, true), "\"", "") + end + + valstr = + if is_number(maxlen) and maxlen > -1 do + m = trunc(maxlen) + + if m < String.length(valstr) do + String.slice(valstr, 0, max(0, m - 3)) <> "..." + else + valstr + end + else + valstr + end + + if pr, do: stringify_pretty(valstr), else: valstr + end + end + + defp stringify_pretty(valstr) do + colors = [81, 118, 213, 39, 208, 201, 45, 190, 129, 51, 160, 121, 226, 33, 207, 69] + c = Enum.map(colors, fn n -> "\e[38;5;" <> Integer.to_string(n) <> "m" end) |> List.to_tuple() + r = "\e[0m" + clen = tuple_size(c) + + {_, _, t} = + String.to_charlist(valstr) + |> Enum.reduce({0, elem(c, 0), elem(c, 0)}, fn ch, {d, o, t} -> + chs = <> + + cond do + ch == ?{ or ch == ?[ -> + d2 = d + 1 + o2 = elem(c, rem(d2, clen)) + {d2, o2, t <> o2 <> chs} + + ch == ?} or ch == ?] -> + t2 = t <> o <> chs + d2 = d - 1 + o2 = elem(c, rem(rem(d2, clen) + clen, clen)) + {d2, o2, t2} + + true -> + {d, o, t <> o <> chs} + end + end) + + t <> r + end + + def jsonify(v \\ nil, flags \\ nil) do + if v == nil do + "null" + else + indent = getprop(flags, "indent", 2) + ind = if is_number(indent), do: trunc(indent), else: 2 + str = if ind > 0, do: json_encode(v, false, ind), else: json_encode(v) + offset = getprop(flags, "offset", 0) + off = if is_number(offset), do: trunc(offset), else: 0 + + if off > 0 do + lines = String.split(str, "\n") + + case lines do + [_ | rest] -> "{\n" <> Enum.map_join(rest, "\n", fn l -> String.duplicate(" ", off) <> l end) + [] -> str + end + else + str + end + end + end + + def pad(s \\ nil, padding \\ nil, padchar \\ nil) do + str = cond do; is_binary(s) -> s; s == nil -> "null"; true -> stringify(s) end + p = if is_number(padding), do: trunc(padding), else: 44 + pc = if is_binary(padchar), do: String.slice(padchar <> " ", 0, 1), else: " " + + if p > -1 do + n = p - String.length(str) + if n > 0, do: str <> String.duplicate(pc, n), else: str + else + n = -p - String.length(str) + if n > 0, do: String.duplicate(pc, n) <> str, else: str + end + end + + # --------------------------------------------------------------------------- + # join / pathify / replace + # --------------------------------------------------------------------------- + + def join(arr, sep \\ nil, url \\ nil) do + if not islist(arr) do + @s_mt + else + sepdef = cond do; sep == nil -> ","; is_binary(sep) -> sep; true -> js_string(sep) end + single = String.length(sepdef) == 1 + sc = if single, do: sepdef, else: " " + is_url = url == true + items = list_items(arr) + sarr = length(items) + + out = + items + |> Enum.with_index() + |> Enum.reduce([], fn {s0, idx}, acc -> + if is_binary(s0) and s0 != @s_mt do + s = + if single do + cond do + is_url and idx == 0 -> + strip_trailing(s0, sc) + + true -> + x = if idx > 0, do: strip_leading(s0, sc), else: s0 + x = if idx < sarr - 1 or not is_url, do: strip_trailing(x, sc), else: x + collapse(x, sc) + end + else + s0 + end + + if s != @s_mt, do: acc ++ [s], else: acc + else + acc + end + end) + + Enum.join(out, sepdef) + end + end + + defp strip_trailing(s, sc) do + if String.ends_with?(s, sc) and s != "", do: strip_trailing(String.slice(s, 0, String.length(s) - 1), sc), else: s + end + + defp strip_leading(s, sc) do + if String.starts_with?(s, sc) and s != "", do: strip_leading(String.slice(s, 1, String.length(s) - 1), sc), else: s + end + + defp collapse(s, sc) do + chars = String.graphemes(s) + collapse_loop(chars, sc, []) + end + + defp collapse_loop([], _sc, acc), do: Enum.join(Enum.reverse(acc), "") + + defp collapse_loop([ch | rest], sc, acc) do + if ch != sc do + collapse_loop(rest, sc, [ch | acc]) + else + {run, rest2} = take_run(rest, sc, [ch]) + before_non = acc != [] and hd(acc) != sc + after_non = rest2 != [] + + if before_non and after_non do + collapse_loop(rest2, sc, [sc | acc]) + else + collapse_loop(rest2, sc, Enum.reverse(run) ++ acc) + end + end + end + + defp take_run([ch | rest], sc, acc) when ch == sc, do: take_run(rest, sc, [ch | acc]) + defp take_run(rest, _sc, acc), do: {Enum.reverse(acc), rest} + + def joinurl(arr), do: join(arr, "/", true) + + def replace(s, from, to) do + ts = typify(s) + + rs = + cond do + Bitwise.band(@t_string, ts) == 0 -> stringify(s) + Bitwise.band(Bitwise.bor(@t_noval, @t_null), ts) > 0 -> @s_mt + true -> stringify(s) + end + + to_s = if is_binary(to), do: to, else: js_string(to) + + cond do + is_binary(from) and from != "" -> String.replace(rs, from, to_s) + is_struct(from, Regex) -> Regex.replace(from, rs, to_s) + true -> rs + end + end + + def pathify(v \\ @noarg, startin \\ nil, endin \\ nil) do + absent = v == @noarg + val = if absent, do: nil, else: v + + path = + cond do + islist(val) -> list_items(val) + iskey(val) -> [val] + true -> nil + end + + start = if is_number(startin), do: if(startin > -1, do: trunc(startin), else: 0), else: 0 + endn = if is_number(endin), do: if(endin > -1, do: trunc(endin), else: 0), else: 0 + + pathstr = + if path != nil and start >= 0 do + len = length(path) + e = max(0, len - endn) + s = if start > len, do: len, else: start + sub = if s <= e, do: Enum.slice(path, s, e - s), else: [] + + if sub == [] do + "" + else + sub + |> Enum.filter(&iskey/1) + |> Enum.map(fn p -> + cond do + is_integer(p) -> num_to_string(p) + is_float(p) -> num_to_string(Float.floor(p)) + true -> String.replace(js_string(p), ".", @s_mt) + end + end) + |> Enum.join(".") + end + else + nil + end + + if pathstr == nil do + " (if absent, do: @s_mt, else: @s_cn <> stringify(val, 47)) <> ">" + else + pathstr + end + end + + # --------------------------------------------------------------------------- + # walk / merge + # --------------------------------------------------------------------------- + + def walk(val, opts \\ []) do + before = Keyword.get(opts, :before) + aft = Keyword.get(opts, :after) + maxdepth = Keyword.get(opts, :maxdepth) + key = Keyword.get(opts, :key) + parent = Keyword.get(opts, :parent) + path = Keyword.get(opts, :path) + path = if path == nil, do: empty_list(), else: path + depth = size(path) + out = if before == nil, do: val, else: before.(key, val, parent, path) + md = if is_number(maxdepth) and maxdepth >= 0, do: trunc(maxdepth), else: @maxdepth + + if md == 0 or (md > 0 and md <= depth) do + out + else + if isnode(out) do + prefix = list_items(path) + + Enum.each(items_pairs(out), fn {ckey, child} -> + childpath = vlist_new(prefix ++ [ckey]) + + result = + walk(child, before: before, after: aft, maxdepth: md, key: ckey, parent: out, path: childpath) + + setprop(out, ckey, result) + end) + end + + if aft == nil, do: out, else: aft.(key, out, parent, path) + end + end + + defp grow(a, n) do + if size(a) <= n do + setprop(a, size(a), nil) + grow(a, n) + end + end + + def merge(objs, maxdepth \\ nil) do + md = if is_number(maxdepth), do: if(maxdepth < 0, do: 0, else: trunc(maxdepth)), else: @maxdepth + + if not islist(objs) do + objs + else + items = list_items(objs) + lenlist = length(items) + + cond do + lenlist == 0 -> + nil + + lenlist == 1 -> + Enum.at(items, 0) + + true -> + out0 = getprop(objs, 0, empty_map()) + out = merge_loop(objs, lenlist, md, out0) + + if md == 0 do + o = getprop(objs, lenlist - 1) + cond do; islist(o) -> empty_list(); ismap(o) -> empty_map(); true -> o end + else + out + end + end + end + end + + defp merge_loop(_objs, _lenlist, _md, out, oi \\ 1) + + defp merge_loop(objs, lenlist, md, out, oi) do + if oi >= lenlist do + out + else + obj = getprop(objs, oi) + + out2 = + if not isnode(obj) do + obj + else + cur = vlist_new([out]) + dst = vlist_new([out]) + + before = fn key, val, _parent, path -> + pi = size(path) + + cond do + md <= pi -> + grow(cur, pi) + setprop(cur, pi, val) + if pi > 0, do: setprop(getelem(cur, pi - 1), key, val) + nil + + not isnode(val) -> + grow(cur, pi) + setprop(cur, pi, val) + val + + true -> + grow(dst, pi) + grow(cur, pi) + dnew = if pi > 0, do: getprop(getelem(dst, pi - 1), key), else: getelem(dst, pi) + setprop(dst, pi, dnew) + tval = getelem(dst, pi) + + cond do + tval == nil -> + setprop(cur, pi, if(islist(val), do: empty_list(), else: empty_map())) + val + + (islist(val) and islist(tval)) or (ismap(val) and ismap(tval)) -> + setprop(cur, pi, tval) + val + + true -> + setprop(cur, pi, val) + nil + end + end + end + + aft = fn key, vv, _parent, path -> + ci = size(path) + + if ci < 1 do + if size(cur) > 0, do: getelem(cur, 0), else: vv + else + target = if ci - 1 < size(cur), do: getelem(cur, ci - 1), else: nil + value = if ci < size(cur), do: getelem(cur, ci), else: nil + setprop(target, key, value) + value + end + end + + walk(obj, before: before, after: aft) + end + + merge_loop(objs, lenlist, md, out2, oi + 1) + end + end + + # --------------------------------------------------------------------------- + # getpath / setpath + # --------------------------------------------------------------------------- + + defp idef(injdef, field) do + cond do + isinj(injdef) -> + case field do + "base" -> ig(injdef, :base) + "dparent" -> ig(injdef, :dparent) + "meta" -> ig(injdef, :meta) + "key" -> ig(injdef, :key) + "dpath" -> ig(injdef, :dpath) + "handler" -> ig(injdef, :handler) + end + + injdef == nil -> + nil + + true -> + getprop(injdef, field) + end + end + + defp dummy_inj, do: new_inj(nil, vmap_new([{@s_dtop, nil}])) + + def getpath(store, path, injdef \\ nil) do + parts = + cond do + islist(path) -> list_items(path) + is_binary(path) -> String.split(path, ".") + is_number(path) and not is_boolean(path) -> [strkey(path)] + true -> nil + end + + if parts == nil do + nil + else + has_inj = injdef != nil + base = idef(injdef, "base") + dparent = idef(injdef, "dparent") + inj_meta = idef(injdef, "meta") + inj_key = idef(injdef, "key") + dpath = idef(injdef, "dpath") + src = if iskey(base), do: getprop(store, base, store), else: store + numparts = length(parts) + + val = + cond do + path == nil or store == nil or (numparts == 1 and Enum.at(parts, 0) == @s_mt) or numparts == 0 -> + src + + true -> + val0 = if numparts == 1, do: getprop(store, Enum.at(parts, 0)), else: store + + if isfunc(val0) do + val0 + else + {val1, parts1} = + case if(is_binary(Enum.at(parts, 0)), do: Regex.run(@r_meta_path, Enum.at(parts, 0)), else: nil) do + [_, g1, _, g3] when inj_meta != nil and has_inj -> + {getprop(inj_meta, g1), List.replace_at(parts, 0, g3)} + + _ -> + {src, parts} + end + + getpath_loop(store, parts1, 0, val1, has_inj, inj_key, inj_meta, src, dparent, dpath) + end + end + + handler = idef(injdef, "handler") + + if has_inj and isfunc(handler) do + ref = pathify(path) + if isinj(injdef), do: handler.(injdef, val, ref, store), else: handler.(dummy_inj(), val, ref, store) + else + val + end + end + end + + defp count_ascends(parts, pi, acc) do + if pi + 1 < length(parts) and Enum.at(parts, pi + 1) == @s_mt do + count_ascends(parts, pi + 1, acc + 1) + else + {acc, pi} + end + end + + defp getpath_loop(store, parts, pi, val, has_inj, inj_key, inj_meta, src, dparent, dpath) do + numparts = length(parts) + + if val == nil or pi >= numparts do + val + else + raw = Enum.at(parts, pi) + + part0 = + cond do + has_inj and raw == @s_dkey -> if inj_key != nil, do: inj_key, else: raw + is_binary(raw) and String.starts_with?(raw, "$GET:") -> stringify(getpath(src, slice(raw, 5, -1))) + is_binary(raw) and String.starts_with?(raw, "$REF:") -> stringify(getpath(getprop(store, @s_dspec), slice(raw, 5, -1))) + has_inj and is_binary(raw) and String.starts_with?(raw, "$META:") -> stringify(getpath(inj_meta, slice(raw, 6, -1))) + true -> raw + end + + part = if is_binary(part0), do: String.replace(part0, "$$", "$"), else: strkey(part0) + + if part == @s_mt do + {ascends, pi2} = count_ascends(parts, pi, 0) + + if has_inj and ascends > 0 do + ascends2 = if pi2 == numparts - 1, do: ascends - 1, else: ascends + + if ascends2 == 0 do + getpath_loop(store, parts, pi2 + 1, dparent, has_inj, inj_key, inj_meta, src, dparent, dpath) + else + tail = Enum.drop(parts, pi2 + 1) + fullpath = flatten(vlist_new([slice(dpath, -ascends2), vlist_new(tail)])) + if ascends2 <= size(dpath), do: getpath(store, fullpath), else: nil + end + else + getpath_loop(store, parts, pi2 + 1, dparent, has_inj, inj_key, inj_meta, src, dparent, dpath) + end + else + getpath_loop(store, parts, pi + 1, getprop(val, part), has_inj, inj_key, inj_meta, src, dparent, dpath) + end + end + end + + def setpath(store, path, val, injdef \\ nil) do + ptype = typify(path) + + parts = + cond do + Bitwise.band(@t_list, ptype) > 0 -> vlist_new(list_items(path)) + Bitwise.band(@t_string, ptype) > 0 -> vlist_new(String.split(path, ".")) + Bitwise.band(@t_number, ptype) > 0 -> vlist_new([path]) + true -> nil + end + + if parts == nil do + nil + else + base = if injdef != nil, do: idef(injdef, "base"), else: nil + numparts = size(parts) + parent0 = if iskey(base), do: getprop(store, base, store), else: store + parent = setpath_walk(parts, numparts, parent0, 0) + + if is_delete(val) do + delprop(parent, getelem(parts, -1)) + else + setprop(parent, getelem(parts, -1), val) + end + + parent + end + end + + defp setpath_walk(parts, numparts, parent, pi) do + if pi >= numparts - 1 do + parent + else + pkey = getelem(parts, pi) + np0 = getprop(parent, pkey) + + np = + if not isnode(np0) do + nextpart = getelem(parts, pi + 1) + nn = if Bitwise.band(@t_number, typify(nextpart)) > 0, do: empty_list(), else: empty_map() + setprop(parent, pkey, nn) + nn + else + np0 + end + + setpath_walk(parts, numparts, np, pi + 1) + end + end + + # --------------------------------------------------------------------------- + # Injection + # --------------------------------------------------------------------------- + + defp new_inj(val, parent) do + vinj_new(%{ + mode: @m_val, + full: false, + keyi: 0, + keys: vlist_new([@s_dtop]), + key: @s_dtop, + ival: val, + parent: parent, + path: vlist_new([@s_dtop]), + nodes: vlist_new([parent]), + handler: &inject_handler/4, + errs: empty_list(), + meta: empty_map(), + dparent: nil, + dpath: vlist_new([@s_dtop]), + base: @s_dtop, + modify: nil, + prior: nil, + extra: nil, + root: nil + }) + end + + defp inj_descend(inj) do + meta = ig(inj, :meta) + + if ismap(meta) do + d = case getprop(meta, "__d") do; n when is_number(n) -> n; _ -> 0 end + setprop(meta, "__d", d + 1) + end + + parentkey = getelem(ig(inj, :path), -2) + + cond do + ig(inj, :dparent) == nil -> + if size(ig(inj, :dpath)) > 1 do + is_(inj, :dpath, vlist_new(list_items(ig(inj, :dpath)) ++ [parentkey])) + end + + parentkey != nil -> + is_(inj, :dparent, getprop(ig(inj, :dparent), parentkey)) + lastpart = getelem(ig(inj, :dpath), -1) + + if lastpart == "$:" <> js_string(parentkey) do + is_(inj, :dpath, slice(ig(inj, :dpath), -1)) + else + is_(inj, :dpath, vlist_new(list_items(ig(inj, :dpath)) ++ [parentkey])) + end + + true -> + :ok + end + + ig(inj, :dparent) + end + + defp inj_child(inj, keyi, keys) do + key = strkey(getelem(keys, keyi)) + val = ig(inj, :ival) + + vinj_new(%{ + mode: ig(inj, :mode), + full: ig(inj, :full), + keyi: keyi, + keys: keys, + key: key, + ival: getprop(val, key), + parent: val, + path: vlist_new(list_items(ig(inj, :path)) ++ [key]), + nodes: vlist_new(list_items(ig(inj, :nodes)) ++ [val]), + handler: ig(inj, :handler), + errs: ig(inj, :errs), + meta: ig(inj, :meta), + base: ig(inj, :base), + modify: ig(inj, :modify), + prior: inj, + dpath: vlist_new(list_items(ig(inj, :dpath))), + dparent: ig(inj, :dparent), + extra: ig(inj, :extra), + root: ig(inj, :root) + }) + end + + defp inj_setval(inj, val, ancestor \\ 1) do + {target, key} = + if ancestor < 2 do + {ig(inj, :parent), ig(inj, :key)} + else + {getelem(ig(inj, :nodes), -ancestor), getelem(ig(inj, :path), -ancestor)} + end + + if val == nil, do: delprop(target, key), else: setprop(target, key, val) + end + + # --------------------------------------------------------------------------- + # inject + # --------------------------------------------------------------------------- + + def inject(val, store, injdef \\ nil) do + inj = + if isinj(injdef) do + injdef + else + parent = vmap_new([{@s_dtop, val}]) + i = new_inj(val, parent) + is_(i, :dparent, store) + is_(i, :errs, getprop(store, @s_derrs, empty_list())) + if ismap(ig(i, :meta)), do: setprop(ig(i, :meta), "__d", 0) + is_(i, :root, parent) + + if injdef != nil do + if getprop(injdef, "modify") != nil, do: is_(i, :modify, getprop(injdef, "modify")) + if getprop(injdef, "extra") != nil, do: is_(i, :extra, getprop(injdef, "extra")) + if getprop(injdef, "meta") != nil, do: is_(i, :meta, getprop(injdef, "meta")) + if getprop(injdef, "handler") != nil, do: is_(i, :handler, getprop(injdef, "handler")) + end + + i + end + + inj_descend(inj) + + rv = + cond do + isnode(val) -> + nodekeys = + if ismap(val) do + ks = Enum.map(map_pairs(val), &elem(&1, 0)) + normal = ks |> Enum.filter(fn k -> not String.contains?(k, @s_ds) end) |> Enum.sort() + trans = ks |> Enum.filter(fn k -> String.contains?(k, @s_ds) end) |> Enum.sort() + normal ++ trans + else + n = length(list_items(val)) + if n == 0, do: [], else: Enum.map(0..(n - 1), &Integer.to_string/1) + end + + inject_loop(inj, val, store, nodekeys, 0) + val + + is_binary(val) -> + is_(inj, :mode, @m_val) + nv = injectstr(val, store, inj) + if not is_skip(nv), do: inj_setval(inj, nv) + nv + + true -> + val + end + + if ig(inj, :modify) != nil and not is_skip(rv) do + mkey = ig(inj, :key) + mparent = ig(inj, :parent) + mval = getprop(mparent, mkey) + ig(inj, :modify).(mval, mkey, mparent, inj) + end + + is_(inj, :ival, rv) + + cond do + ig(inj, :prior) == nil and ig(inj, :root) != nil and haskey(ig(inj, :root), @s_dtop) -> + getprop(ig(inj, :root), @s_dtop) + + ig(inj, :key) == @s_dtop and ig(inj, :parent) != nil and haskey(ig(inj, :parent), @s_dtop) -> + getprop(ig(inj, :parent), @s_dtop) + + true -> + rv + end + end + + defp inject_loop(inj, val, store, nodekeys, nki) do + if nki >= length(nodekeys) do + :ok + else + childinj = inj_child(inj, nki, vlist_new(nodekeys)) + nodekey = ig(childinj, :key) + is_(childinj, :mode, @m_keypre) + prekey = injectstr(js_string(nodekey), store, childinj) + nk1 = Enum.map(list_items(ig(childinj, :keys)), &js_string/1) + + nk2 = + if prekey != nil do + is_(childinj, :ival, getprop(val, prekey)) + is_(childinj, :mode, @m_val) + inject(ig(childinj, :ival), store, childinj) + _ = Enum.map(list_items(ig(childinj, :keys)), &js_string/1) + is_(childinj, :mode, @m_keypost) + injectstr(js_string(nodekey), store, childinj) + Enum.map(list_items(ig(childinj, :keys)), &js_string/1) + else + nk1 + end + + inject_loop(inj, val, store, nk2, ig(childinj, :keyi) + 1) + end + end + + defp inject_handler(inj, val, ref, store) do + iscmd = isfunc(val) and (ref == nil or (is_binary(ref) and String.starts_with?(ref, @s_ds))) + + cond do + iscmd -> + val.(inj, val, ref, store) + + ig(inj, :mode) == @m_val and ig(inj, :full) -> + inj_setval(inj, val) + val + + true -> + val + end + end + + defp injectstr(val, store, inj) do + if val == @s_mt do + @s_mt + else + case Regex.run(@r_inject_full, val) do + [_, pathref0] -> + if inj != nil, do: is_(inj, :full, true) + + pathref = + if String.length(pathref0) > 3, + do: pathref0 |> String.replace("$BT", @s_bt) |> String.replace("$DS", @s_ds), + else: pathref0 + + getpath(store, pathref, inj) + + _ -> + out = + Regex.replace(@r_inject_part, val, fn _whole, ref0 -> + ref = + if String.length(ref0) > 3, + do: ref0 |> String.replace("$BT", @s_bt) |> String.replace("$DS", @s_ds), + else: ref0 + + if inj != nil, do: is_(inj, :full, false) + found = getpath(store, ref, inj) + + cond do + found == nil -> @s_mt + is_binary(found) -> if found == "__NULL__", do: "null", else: found + isfunc(found) -> @s_mt + true -> try do; json_encode(found); rescue _ -> stringify(found) end + end + end) + + if inj != nil and isfunc(ig(inj, :handler)) do + is_(inj, :full, true) + ig(inj, :handler).(inj, out, val, store) + else + out + end + end + end + end + + # --------------------------------------------------------------------------- + # transform commands + # --------------------------------------------------------------------------- + + defp transform_delete(inj, _v, _r, _s) do + delprop(ig(inj, :parent), ig(inj, :key)) + nil + end + + defp transform_copy(inj, _v, _r, _s) do + if ig(inj, :mode) == @m_keypre or ig(inj, :mode) == @m_keypost do + ig(inj, :key) + else + out = lookup_(ig(inj, :dparent), ig(inj, :key)) + inj_setval(inj, out) + out + end + end + + defp transform_key(inj, _v, _r, _s) do + if ig(inj, :mode) != @m_val do + nil + else + keyspec = lookup_(ig(inj, :parent), @s_bkey) + + if keyspec != nil do + delprop(ig(inj, :parent), @s_bkey) + getprop(ig(inj, :dparent), keyspec) + else + anno = lookup_(ig(inj, :parent), @s_banno) + fromanno = lookup_(anno, @s_key) + if fromanno != nil, do: fromanno, else: getelem(ig(inj, :path), -2) + end + end + end + + defp transform_anno(inj, _v, _r, _s) do + delprop(ig(inj, :parent), @s_banno) + nil + end + + defp transform_merge(inj, _v, _r, _s) do + cond do + ig(inj, :mode) == @m_keypre -> + ig(inj, :key) + + ig(inj, :mode) == @m_keypost -> + args0 = getprop(ig(inj, :parent), ig(inj, :key)) + args = if islist(args0), do: args0, else: vlist_new([args0]) + inj_setval(inj, nil) + mergelist = flatten(vlist_new([vlist_new([ig(inj, :parent)]), args, vlist_new([clone(ig(inj, :parent))])])) + merge(mergelist) + ig(inj, :key) + + true -> + nil + end + end + + defp transform_each(inj, _v, _r, store) do + if islist(ig(inj, :keys)), do: slice(ig(inj, :keys), 0, 1, true) + + if ig(inj, :mode) != @m_val do + nil + else + parent = ig(inj, :parent) + srcpath = if size(parent) > 1, do: getelem(parent, 1), else: nil + child_tm = if size(parent) > 2, do: clone(getelem(parent, 2)), else: nil + srcstore = getprop(store, ig(inj, :base), store) + src = getpath(srcstore, srcpath, inj) + tkey = getelem(ig(inj, :path), -2) + nodes = ig(inj, :nodes) + target = (fn -> t = getelem(nodes, -2); if t == nil, do: getelem(nodes, -1), else: t end).() + rval = vlist_new([]) + + if isnode(src) do + tval_items = + cond do + islist(src) -> + Enum.map(list_items(src), fn _ -> clone(child_tm) end) + + ismap(src) -> + Enum.map(map_pairs(src), fn {k, _} -> + cc = clone(child_tm) + if ismap(cc), do: setprop(cc, @s_banno, vmap_new([{@s_key, k}])) + cc + end) + + true -> + [] + end + + tval = vlist_new(tval_items) + + tcurrent = + cond do + ismap(src) -> vlist_new(Enum.map(map_pairs(src), &elem(&1, 1))) + islist(src) -> vlist_new(list_items(src)) + true -> src + end + + if tval_items != [] do + path = ig(inj, :path) + ckey = getelem(path, -2) + plist = list_items(path) + tpath = if plist == [], do: vlist_new([]), else: vlist_new(Enum.take(plist, length(plist) - 1)) + dpath0 = [@s_dtop] + + dpath0 = + if is_binary(srcpath) and srcpath != @s_mt do + dpath0 ++ (String.split(srcpath, ".") |> Enum.filter(&(&1 != @s_mt))) + else + dpath0 + end + + dpath0 = if ckey != nil, do: dpath0 ++ ["$:" <> js_string(ckey)], else: dpath0 + tcur = vmap_new([{js_string(ckey), tcurrent}]) + + {tcur, dpath0} = + if size(tpath) > 1 do + pkey = getelem(path, -3, @s_dtop) + {vmap_new([{js_string(pkey), tcur}]), dpath0 ++ ["$:" <> js_string(pkey)]} + else + {tcur, dpath0} + end + + tinj = inj_child(inj, 0, if(ckey != nil, do: vlist_new([ckey]), else: vlist_new([]))) + is_(tinj, :path, tpath) + nlist = list_items(nodes) + is_(tinj, :nodes, if(nlist == [], do: vlist_new([]), else: vlist_new(Enum.take(nlist, length(nlist) - 1)))) + is_(tinj, :parent, if(size(ig(tinj, :nodes)) > 0, do: getelem(ig(tinj, :nodes), -1), else: nil)) + if ckey != nil and ig(tinj, :parent) != nil, do: setprop(ig(tinj, :parent), ckey, tval) + is_(tinj, :ival, tval) + is_(tinj, :dpath, vlist_new(dpath0)) + is_(tinj, :dparent, tcur) + inject(tval, store, tinj) + rval = ig(tinj, :ival) + setprop(target, tkey, rval) + if islist(rval) and size(rval) > 0, do: getelem(rval, 0), else: nil + else + setprop(target, tkey, rval) + if islist(rval) and size(rval) > 0, do: getelem(rval, 0), else: nil + end + else + setprop(target, tkey, rval) + nil + end + end + end + + defp transform_pack(inj, _v, _r, store) do + cond do + ig(inj, :mode) != @m_keypre or not is_binary(ig(inj, :key)) -> + nil + + true -> + parent = ig(inj, :parent) + path = ig(inj, :path) + nodes = ig(inj, :nodes) + args_val = getprop(parent, ig(inj, :key)) + + if not islist(args_val) or size(args_val) < 2 do + nil + else + srcpath = getelem(args_val, 0) + origchildspec = getelem(args_val, 1) + tkey = getelem(path, -2) + pathsize = size(path) + target = (fn -> t = getelem(nodes, pathsize - 2); if t == nil, do: getelem(nodes, pathsize - 1), else: t end).() + srcstore = getprop(store, ig(inj, :base), store) + src0 = getpath(srcstore, srcpath, inj) + + src = + if not islist(src0) do + if ismap(src0) do + vlist_new( + Enum.map(items_pairs(src0), fn {k, node} -> + setprop(node, @s_banno, vmap_new([{@s_key, k}])) + node + end) + ) + else + nil + end + else + src0 + end + + if src == nil do + nil + else + keypath = getprop(origchildspec, @s_bkey) + childspec = delprop(origchildspec, @s_bkey) + child = getprop(childspec, @s_bval, childspec) + tval = empty_map() + + Enum.each(items_pairs(src), fn {srckey, srcnode} -> + k = + cond do + keypath == nil -> srckey + is_binary(keypath) and String.starts_with?(keypath, @s_bt) -> inject(keypath, merge(vlist_new([empty_map(), store, vmap_new([{@s_dtop, srcnode}])]), 1)) + true -> getpath(srcnode, keypath, inj) + end + + tchild = clone(child) + setprop(tval, k, tchild) + anno = getprop(srcnode, @s_banno) + if anno == nil, do: delprop(tchild, @s_banno), else: setprop(tchild, @s_banno, anno) + end) + + rval = + if not isempty(tval) do + tsrc = empty_map() + + list_items(src) + |> Enum.with_index() + |> Enum.each(fn {node, i} -> + kn = + cond do + keypath == nil -> i + is_binary(keypath) and String.starts_with?(keypath, @s_bt) -> inject(keypath, merge(vlist_new([empty_map(), store, vmap_new([{@s_dtop, node}])]), 1)) + true -> getpath(node, keypath, inj) + end + + setprop(tsrc, kn, node) + end) + + tpath = slice(ig(inj, :path), -1) + ckey = getelem(ig(inj, :path), -2) + dpath = flatten(vlist_new([@s_dtop, vlist_new(String.split(srcpath, ".")), "$:" <> js_string(ckey)])) + + tcur = + if size(tpath) > 1 do + pkey = getelem(ig(inj, :path), -3, @s_dtop) + setprop(dpath, size(dpath), "$:" <> js_string(pkey)) + vmap_new([{js_string(pkey), vmap_new([{js_string(ckey), tsrc}])}]) + else + vmap_new([{js_string(ckey), tsrc}]) + end + + tinj = inj_child(inj, 0, vlist_new([ckey])) + is_(tinj, :path, tpath) + is_(tinj, :nodes, slice(ig(inj, :nodes), -1)) + is_(tinj, :parent, getelem(ig(tinj, :nodes), -1)) + is_(tinj, :ival, tval) + is_(tinj, :dpath, dpath) + is_(tinj, :dparent, tcur) + inject(tval, store, tinj) + ig(tinj, :ival) + else + empty_map() + end + + setprop(target, tkey, rval) + nil + end + end + end + end + + defp transform_ref(inj, val, _r, store) do + if ig(inj, :mode) != @m_val do + nil + else + nodes = ig(inj, :nodes) + refpath = lookup_(ig(inj, :parent), 1) + is_(inj, :keyi, size(ig(inj, :keys))) + spec_func = getprop(store, @s_dspec) + + if not isfunc(spec_func) do + nil + else + spec = spec_func.(inj, nil, "", store) + refv = getpath(spec, refpath) + flag = vlist_new([false]) + + if isnode(refv) do + walk(refv, after: fn _k, v2, _p, _path -> + if v2 == "`$REF`", do: setprop(flag, 0, true) + v2 + end) + end + + has_sub = getelem(flag, 0) == true + tref = clone(refv) + cpath = slice(ig(inj, :path), 0, size(ig(inj, :path)) - 3) + tpath = slice(ig(inj, :path), 0, size(ig(inj, :path)) - 1) + tcur = getpath(store, cpath) + tval = getpath(store, tpath) + + rval = + if refv != nil and (not has_sub or tval != nil) do + cs = inj_child(inj, 0, vlist_new([getelem(tpath, -1)])) + is_(cs, :path, tpath) + is_(cs, :nodes, slice(ig(inj, :nodes), 0, size(ig(inj, :nodes)) - 1)) + is_(cs, :parent, getelem(nodes, -2)) + is_(cs, :ival, tref) + is_(cs, :dparent, tcur) + inject(tref, store, cs) + ig(cs, :ival) + else + nil + end + + inj_setval(inj, rval, 2) + + if islist(ig(inj, :parent)) and ig(inj, :prior) != nil do + is_(ig(inj, :prior), :keyi, ig(ig(inj, :prior), :keyi) - 1) + end + + val + end + end + end + + defp formatter_tbl do + %{ + "identity" => fn _k, v -> v end, + "upper" => fn _k, v -> if isnode(v), do: v, else: String.upcase(js_string(v)) end, + "lower" => fn _k, v -> if isnode(v), do: v, else: String.downcase(js_string(v)) end, + "string" => fn _k, v -> if isnode(v), do: v, else: js_string(v) end, + "number" => fn _k, v -> + if isnode(v) do + v + else + n = parse_num(js_string(v)) + if is_intish(n), do: trunc(n), else: n + end + end, + "integer" => fn _k, v -> if isnode(v), do: v, else: trunc(parse_num(js_string(v))) end, + "concat" => fn k, v -> + if k == nil and islist(v) do + join(items_v(v, fn {_, x} -> if isnode(x), do: @s_mt, else: js_string(x) end), @s_mt) + else + v + end + end + } + end + + defp parse_num(s) do + case Float.parse(s) do + {n, _} -> n + :error -> 0 + end + end + + def check_placement(modes, ijname, parent_types, inj) do + modenum = mode_to_num(ig(inj, :mode)) + + cond do + Bitwise.band(modes, modenum) == 0 -> + allowed = Enum.filter([1, 2, 4], fn m -> Bitwise.band(modes, m) != 0 end) + placements = allowed |> Enum.map(fn m -> if m == 4, do: "value", else: "key" end) |> Enum.join(",") + cur = if modenum == 4, do: "value", else: "key" + push_err(inj, "$" <> ijname <> ": invalid placement as " <> cur <> ", expected: " <> placements <> ".") + false + + not isempty(parent_types) -> + ptype = typify(ig(inj, :parent)) + + if Bitwise.band(parent_types, ptype) == 0 do + push_err(inj, "$" <> ijname <> ": invalid placement in parent " <> typename(ptype) <> ", expected: " <> typename(parent_types) <> ".") + false + else + true + end + + true -> + true + end + end + + def injector_args(arg_types, args) do + numargs = length(arg_types) + found = injector_args_loop(arg_types, args, 0, numargs, List.duplicate(nil, 1 + numargs)) + vlist_new(found) + end + + defp injector_args_loop(arg_types, args, argi, numargs, found) do + if argi >= numargs do + found + else + arg = getelem(args, argi) + arg_type = typify(arg) + at = Enum.at(arg_types, argi) + + if Bitwise.band(at, arg_type) == 0 do + List.replace_at(found, 0, "invalid argument: " <> stringify(arg, 22) <> " (" <> typename(arg_type) <> " at position " <> Integer.to_string(1 + argi) <> ") is not of type: " <> typename(at) <> ".") + else + injector_args_loop(arg_types, args, argi + 1, numargs, List.replace_at(found, 1 + argi, arg)) + end + end + end + + def inject_child(child, store, inj) do + cinj = + if ig(inj, :prior) != nil do + prior = ig(inj, :prior) + + if ig(prior, :prior) != nil do + c = inj_child(ig(prior, :prior), ig(prior, :keyi), ig(prior, :keys)) + is_(c, :ival, child) + setprop(ig(c, :parent), ig(prior, :key), child) + c + else + c = inj_child(prior, ig(inj, :keyi), ig(inj, :keys)) + is_(c, :ival, child) + setprop(ig(c, :parent), ig(inj, :key), child) + c + end + else + inj + end + + inject(child, store, cinj) + cinj + end + + defp transform_format(inj, _v, _r, store) do + slice(ig(inj, :keys), 0, 1, true) + + if ig(inj, :mode) != @m_val do + nil + else + name = lookup_(ig(inj, :parent), 1) + child = lookup_(ig(inj, :parent), 2) + tkey = getelem(ig(inj, :path), -2) + target = (fn -> t = getelem(ig(inj, :nodes), -2); if t == nil, do: getelem(ig(inj, :nodes), -1), else: t end).() + cinj = inject_child(child, store, inj) + resolved = ig(cinj, :ival) + + formatter = + if Bitwise.band(@t_function, typify(name)) > 0 do + fn k, v -> name.(dummy_inj(), v, js_string(k), nil) end + else + Map.get(formatter_tbl(), js_string(name)) + end + + if formatter == nil do + push_err(inj, "$FORMAT: unknown format: " <> js_string(name) <> ".") + nil + else + out = walk(resolved, after: fn k, v, _p, _path -> formatter.(k, v) end) + setprop(target, tkey, out) + out + end + end + end + + defp transform_apply(inj, _v, _r, store) do + if not check_placement(4, "APPLY", @t_list, inj) do + nil + else + res = injector_args([@t_function, @t_any], slice(ig(inj, :parent), 1)) + err = getelem(res, 0) + apply_fn = getelem(res, 1) + child = if size(res) > 2, do: getelem(res, 2), else: nil + + if err != nil do + push_err(inj, "$APPLY: " <> js_string(err)) + nil + else + tkey = getelem(ig(inj, :path), -2) + target = (fn -> t = getelem(ig(inj, :nodes), -2); if t == nil, do: getelem(ig(inj, :nodes), -1), else: t end).() + cinj = inject_child(child, store, inj) + resolved = ig(cinj, :ival) + out = apply_fn.(resolved, store, cinj) + setprop(target, tkey, out) + out + end + end + end + + def transform(data, spec0, injdef \\ nil) do + origspec = spec0 + spec = clone(spec0) + extra = if injdef != nil, do: getprop(injdef, "extra"), else: nil + collect = injdef != nil and getprop(injdef, "errs") != nil + errs = if collect, do: getprop(injdef, "errs"), else: empty_list() + extra_transforms = empty_map() + extra_data = empty_map() + + if extra != nil do + Enum.each(items_pairs(extra), fn {k, v} -> + if String.starts_with?(k, @s_ds), do: setprop(extra_transforms, k, v), else: setprop(extra_data, k, v) + end) + end + + data_clone = merge(vlist_new([if(isempty(extra_data), do: nil, else: clone(extra_data)), clone(data)])) + store = empty_map() + setprop(store, @s_dtop, data_clone) + setprop(store, @s_dspec, fn _i, _v, _r, _s -> origspec end) + setprop(store, "$BT", fn _i, _v, _r, _s -> @s_bt end) + setprop(store, "$DS", fn _i, _v, _r, _s -> @s_ds end) + setprop(store, "$WHEN", fn _i, _v, _r, _s -> "1970-01-01T00:00:00.000Z" end) + setprop(store, "$DELETE", &transform_delete/4) + setprop(store, "$COPY", &transform_copy/4) + setprop(store, "$KEY", &transform_key/4) + setprop(store, "$ANNO", &transform_anno/4) + setprop(store, "$MERGE", &transform_merge/4) + setprop(store, "$EACH", &transform_each/4) + setprop(store, "$PACK", &transform_pack/4) + setprop(store, "$REF", &transform_ref/4) + setprop(store, "$FORMAT", &transform_format/4) + setprop(store, "$APPLY", &transform_apply/4) + Enum.each(items_pairs(extra_transforms), fn {k, v} -> setprop(store, k, v) end) + setprop(store, @s_derrs, errs) + + idef = empty_map() + if ismap(injdef), do: Enum.each(items_pairs(injdef), fn {k, v} -> setprop(idef, k, v) end) + setprop(idef, "errs", errs) + out = inject(spec, store, idef) + if size(errs) > 0 and not collect, do: raise(Voxgig.Struct.Error, message: join(errs, " | ")) + out + end + + # --------------------------------------------------------------------------- + # validate + # --------------------------------------------------------------------------- + + defp push_err(inj, msg), do: setprop(ig(inj, :errs), size(ig(inj, :errs)), msg) + + defp invalid_type_msg(path, needtype, vt, v, _whence) do + vs = if v == nil, do: "no value", else: stringify(v) + + "Expected " <> + (if size(path) > 1, do: "field " <> pathify(path, 1) <> " to be ", else: "") <> + needtype <> + ", but found " <> + (if v != nil, do: typename(vt) <> @s_viz, else: "") <> + vs <> "." + end + + defp validate_string(inj, _v, _r, _s) do + out = lookup_(ig(inj, :dparent), ig(inj, :key)) + t = typify(out) + + cond do + Bitwise.band(@t_string, t) == 0 -> push_err(inj, invalid_type_msg(ig(inj, :path), "string", t, out, "V1010")); nil + out == @s_mt -> push_err(inj, "Empty string at " <> pathify(ig(inj, :path), 1)); nil + true -> out + end + end + + defp validate_type(inj, _v, ref, _s) do + tname = if is_binary(ref) and String.length(ref) > 1, do: String.downcase(String.slice(ref, 1, String.length(ref) - 1)), else: "any" + idx = type_index(tname) + typev0 = if idx >= 0, do: Bitwise.bsl(1, 31 - idx), else: 0 + typev = if tname == "nil", do: Bitwise.bor(typev0, @t_null), else: typev0 + out = lookup_(ig(inj, :dparent), ig(inj, :key)) + t = typify(out) + + if Bitwise.band(t, typev) == 0 do + push_err(inj, invalid_type_msg(ig(inj, :path), tname, t, out, "V1001")) + nil + else + out + end + end + + defp type_index(tname) do + Enum.find_index(Tuple.to_list(@typename), fn x -> x == tname end) || -1 + end + + defp validate_any(inj, _v, _r, _s), do: lookup_(ig(inj, :dparent), ig(inj, :key)) + + defp validate_child(inj, _v, _r, _s) do + parent = ig(inj, :parent) + key = ig(inj, :key) + path = ig(inj, :path) + keys = ig(inj, :keys) + + cond do + ig(inj, :mode) == @m_keypre -> + childtm = getprop(parent, key) + pkey = getelem(path, -2) + tval = getprop(ig(inj, :dparent), pkey) + + cond do + tval == nil -> + Enum.each(keysof(empty_map()), fn ckey -> setprop(parent, ckey, clone(childtm)); setprop(keys, size(keys), ckey) end) + delprop(parent, key) + nil + + not ismap(tval) -> + push_err(inj, invalid_type_msg(slice(path, 0, size(path) - 1), "object", typify(tval), tval, "V0220")) + nil + + true -> + Enum.each(keysof(tval), fn ckey -> setprop(parent, ckey, clone(childtm)); setprop(keys, size(keys), ckey) end) + delprop(parent, key) + nil + end + + ig(inj, :mode) == @m_val -> + childtm = getprop(parent, 1) + + cond do + not islist(parent) -> + push_err(inj, "Invalid $CHILD as value") + nil + + ig(inj, :dparent) == nil -> + list_set_items(parent, []) + nil + + not islist(ig(inj, :dparent)) -> + push_err(inj, invalid_type_msg(slice(path, 0, size(path) - 1), "list", typify(ig(inj, :dparent)), ig(inj, :dparent), "V0230")) + is_(inj, :keyi, size(parent)) + ig(inj, :dparent) + + true -> + Enum.each(items_pairs(ig(inj, :dparent)), fn {k, _} -> setprop(parent, k, clone(childtm)) end) + n = size(ig(inj, :dparent)) + list_set_items(parent, Enum.take(list_items(parent), n)) + is_(inj, :keyi, 0) + getprop(ig(inj, :dparent), 0) + end + + true -> + nil + end + end + + defp validate_one(inj, _v, _r, store) do + if ig(inj, :mode) != @m_val do + nil + else + parent = ig(inj, :parent) + + if not islist(parent) or ig(inj, :keyi) != 0 do + push_err(inj, "The $ONE validator at field " <> pathify(ig(inj, :path), 1, 1) <> " must be the first element of an array.") + nil + else + is_(inj, :keyi, size(ig(inj, :keys))) + inj_setval(inj, ig(inj, :dparent), 2) + is_(inj, :path, slice(ig(inj, :path), 0, size(ig(inj, :path)) - 1)) + is_(inj, :key, getelem(ig(inj, :path), -1)) + tvals = slice(parent, 1) + + if size(tvals) == 0 do + push_err(inj, "The $ONE validator at field " <> pathify(ig(inj, :path), 1, 1) <> " must have at least one argument.") + nil + else + matched = validate_one_loop(inj, store, list_items(tvals), false) + + if not matched do + valdesc = Enum.map_join(list_items(tvals), ", ", &stringify/1) + valdesc = Regex.replace(@r_transform_name, valdesc, fn _w, g1 -> String.downcase(g1) end) + push_err(inj, invalid_type_msg(ig(inj, :path), (if size(tvals) > 1, do: "one of ", else: "") <> valdesc, typify(ig(inj, :dparent)), ig(inj, :dparent), "V0210")) + end + + nil + end + end + end + end + + defp validate_one_loop(_inj, _store, [], matched), do: matched + + defp validate_one_loop(inj, store, [tv | rest], matched) do + if matched do + true + else + terrs = empty_list() + vstore = merge(vlist_new([empty_map(), store]), 1) + setprop(vstore, @s_dtop, ig(inj, :dparent)) + idef = vmap_new([{"extra", vstore}, {"errs", terrs}, {"meta", ig(inj, :meta)}]) + vcurrent = validate(ig(inj, :dparent), tv, idef) + inj_setval(inj, vcurrent, -2) + if size(terrs) == 0, do: true, else: validate_one_loop(inj, store, rest, false) + end + end + + defp validate_exact(inj, _v, _r, _s) do + if ig(inj, :mode) != @m_val do + delprop(ig(inj, :parent), ig(inj, :key)) + nil + else + parent = ig(inj, :parent) + + if not islist(parent) or ig(inj, :keyi) != 0 do + push_err(inj, "The $EXACT validator at field " <> pathify(ig(inj, :path), 1, 1) <> " must be the first element of an array.") + nil + else + is_(inj, :keyi, size(ig(inj, :keys))) + inj_setval(inj, ig(inj, :dparent), 2) + is_(inj, :path, slice(ig(inj, :path), 0, size(ig(inj, :path)) - 1)) + is_(inj, :key, getelem(ig(inj, :path), -1)) + tvals = slice(parent, 1) + + if size(tvals) == 0 do + push_err(inj, "The $EXACT validator at field " <> pathify(ig(inj, :path), 1, 1) <> " must have at least one argument.") + nil + else + matched = Enum.any?(list_items(tvals), fn tv -> veq(tv, ig(inj, :dparent)) end) + + if not matched do + valdesc = Enum.map_join(list_items(tvals), ", ", &stringify/1) + valdesc = Regex.replace(@r_transform_name, valdesc, fn _w, g1 -> String.downcase(g1) end) + push_err(inj, invalid_type_msg(ig(inj, :path), (if size(ig(inj, :path)) > 1, do: "", else: "value ") <> "exactly equal to " <> (if size(tvals) == 1, do: "", else: "one of ") <> valdesc, typify(ig(inj, :dparent)), ig(inj, :dparent), "V0110")) + end + + nil + end + end + end + end + + def veq(a, b) do + cond do + a == nil and b == nil -> true + is_boolean(a) or is_boolean(b) -> a == b + is_number(a) and is_number(b) -> a == b + is_binary(a) and is_binary(b) -> a == b + islist(a) and islist(b) -> ia = list_items(a); ib = list_items(b); length(ia) == length(ib) and Enum.all?(Enum.zip(ia, ib), fn {x, y} -> veq(x, y) end) + ismap(a) and ismap(b) -> veq_map(a, b) + true -> a == b + end + end + + defp veq_map(a, b) do + pa = map_pairs(a) + pb = map_pairs(b) + length(pa) == length(pb) and Enum.all?(pa, fn {k, v} -> case omap_get(pb, k) do; {:ok, w} -> veq(v, w); :error -> false end end) + end + + defp validation(pval, key, parent, inj) do + if is_skip(pval) do + :ok + else + exact = getprop(ig(inj, :meta), @s_bexact, false) + cval = getprop(ig(inj, :dparent), key) + exact_b = exact == true + + if not exact_b and cval == nil do + :ok + else + ptype = typify(pval) + + if Bitwise.band(@t_string, ptype) > 0 and String.contains?(js_string(pval), @s_ds) do + :ok + else + ctype = typify(cval) + + cond do + ptype != ctype and pval != nil -> + push_err(inj, invalid_type_msg(ig(inj, :path), typename(ptype), ctype, cval, "V0010")) + + ismap(cval) -> + if not ismap(pval) do + push_err(inj, invalid_type_msg(ig(inj, :path), typename(ptype), ctype, cval, "V0020")) + else + ckeys = keysof(cval) + pkeys = keysof(pval) + + if pkeys != [] and getprop(pval, @s_bopen) != true do + badkeys = Enum.filter(ckeys, fn ck -> lookup_(pval, ck) == nil end) + if badkeys != [], do: push_err(inj, "Unexpected keys at field " <> pathify(ig(inj, :path), 1) <> @s_viz <> Enum.join(badkeys, ", ")) + else + merge(vlist_new([pval, cval])) + if isnode(pval), do: delprop(pval, @s_bopen) + end + end + + islist(cval) -> + if not islist(pval), do: push_err(inj, invalid_type_msg(ig(inj, :path), typename(ptype), ctype, cval, "V0030")) + + exact_b -> + if not veq(cval, pval) do + pathmsg = if size(ig(inj, :path)) > 1, do: "at field " <> pathify(ig(inj, :path), 1) <> ": ", else: "" + push_err(inj, "Value " <> pathmsg <> js_string(cval) <> " should equal " <> js_string(pval) <> ".") + end + + true -> + setprop(parent, key, cval) + end + + :ok + end + end + end + end + + defp validate_handler(inj, val, ref, store) do + m = if is_binary(ref), do: Regex.run(@r_meta_path, ref), else: nil + + case m do + [_, _, g2, _] -> + if g2 == "=", do: inj_setval(inj, vlist_new([@s_bexact, val])), else: inj_setval(inj, val) + is_(inj, :keyi, -1) + @skip + + _ -> + inject_handler(inj, val, ref, store) + end + end + + def validate(data, spec, injdef \\ nil) do + extra = getprop(injdef, "extra") + collect = injdef != nil and getprop(injdef, "errs") != nil + errs = if collect, do: getprop(injdef, "errs"), else: empty_list() + base = empty_map() + Enum.each(["$DELETE", "$COPY", "$KEY", "$META", "$MERGE", "$EACH", "$PACK"], fn k -> setprop(base, k, nil) end) + setprop(base, "$STRING", &validate_string/4) + Enum.each(["$NUMBER", "$INTEGER", "$DECIMAL", "$BOOLEAN", "$NULL", "$NIL", "$MAP", "$LIST", "$FUNCTION", "$INSTANCE"], fn k -> setprop(base, k, &validate_type/4) end) + setprop(base, "$ANY", &validate_any/4) + setprop(base, "$CHILD", &validate_child/4) + setprop(base, "$ONE", &validate_one/4) + setprop(base, "$EXACT", &validate_exact/4) + store = merge(vlist_new([base, if(extra == nil, do: empty_map(), else: extra), vmap_new([{@s_derrs, errs}])]), 1) + meta = getprop(injdef, "meta", empty_map()) + setprop(meta, @s_bexact, getprop(meta, @s_bexact, false)) + idef = vmap_new([{"meta", meta}, {"extra", store}, {"modify", &validation/4}, {"handler", &validate_handler/4}, {"errs", errs}]) + out = transform(data, spec, idef) + if size(errs) > 0 and not collect, do: raise(Voxgig.Struct.Error, message: join(errs, " | ")) + out + end + + # --------------------------------------------------------------------------- + # select + # --------------------------------------------------------------------------- + + defp select_and(inj, _v, _r, store) do + if ig(inj, :mode) == @m_keypre do + terms = getprop(ig(inj, :parent), ig(inj, :key)) + ppath = slice(ig(inj, :path), -1) + point = getpath(store, ppath) + vstore = merge(vlist_new([empty_map(), store]), 1) + setprop(vstore, @s_dtop, point) + + Enum.each(items_pairs(terms), fn {_, term} -> + terrs = empty_list() + validate(point, term, vmap_new([{"extra", vstore}, {"errs", terrs}, {"meta", ig(inj, :meta)}])) + if size(terrs) != 0, do: push_err(inj, "AND:" <> pathify(ppath) <> "⨯" <> stringify(point) <> " fail:" <> stringify(terms)) + end) + + gkey = getelem(ig(inj, :path), -2) + gp = getelem(ig(inj, :nodes), -2) + setprop(gp, gkey, point) + end + + nil + end + + defp select_or(inj, _v, _r, store) do + if ig(inj, :mode) == @m_keypre do + terms = getprop(ig(inj, :parent), ig(inj, :key)) + ppath = slice(ig(inj, :path), -1) + point = getpath(store, ppath) + vstore = merge(vlist_new([empty_map(), store]), 1) + setprop(vstore, @s_dtop, point) + done = select_or_loop(inj, store, vstore, ppath, point, items_pairs(terms)) + if not done, do: push_err(inj, "OR:" <> pathify(ppath) <> "⨯" <> stringify(point) <> " fail:" <> stringify(terms)) + end + + nil + end + + defp select_or_loop(_inj, _store, _vstore, _ppath, _point, []), do: false + + defp select_or_loop(inj, store, vstore, ppath, point, [{_, term} | rest]) do + terrs = empty_list() + validate(point, term, vmap_new([{"extra", vstore}, {"errs", terrs}, {"meta", ig(inj, :meta)}])) + + if size(terrs) == 0 do + gkey = getelem(ig(inj, :path), -2) + gp = getelem(ig(inj, :nodes), -2) + setprop(gp, gkey, point) + true + else + select_or_loop(inj, store, vstore, ppath, point, rest) + end + end + + defp select_not(inj, _v, _r, store) do + if ig(inj, :mode) == @m_keypre do + term = getprop(ig(inj, :parent), ig(inj, :key)) + ppath = slice(ig(inj, :path), -1) + point = getpath(store, ppath) + vstore = merge(vlist_new([empty_map(), store]), 1) + setprop(vstore, @s_dtop, point) + terrs = empty_list() + validate(point, term, vmap_new([{"extra", vstore}, {"errs", terrs}, {"meta", ig(inj, :meta)}])) + if size(terrs) == 0, do: push_err(inj, "NOT:" <> pathify(ppath) <> "⨯" <> stringify(point) <> " fail:" <> stringify(term)) + gkey = getelem(ig(inj, :path), -2) + gp = getelem(ig(inj, :nodes), -2) + setprop(gp, gkey, point) + end + + nil + end + + defp num_cmp(a, b, op) do + if is_number(a) and is_number(b) do + case op do + :gt -> a > b + :lt -> a < b + :gte -> a >= b + :lte -> a <= b + end + else + false + end + end + + defp select_cmp(inj, _v, ref, store) do + if ig(inj, :mode) == @m_keypre do + term = getprop(ig(inj, :parent), ig(inj, :key)) + gkey = getelem(ig(inj, :path), -2) + ppath = slice(ig(inj, :path), -1) + point = getpath(store, ppath) + + pass = + cond do + ref == "$GT" -> num_cmp(point, term, :gt) + ref == "$LT" -> num_cmp(point, term, :lt) + ref == "$GTE" -> num_cmp(point, term, :gte) + ref == "$LTE" -> num_cmp(point, term, :lte) + ref == "$LIKE" -> is_binary(term) and Regex.match?(Regex.compile!(term), stringify(point)) + true -> false + end + + if pass do + gp = getelem(ig(inj, :nodes), -2) + setprop(gp, gkey, point) + else + push_err(inj, "CMP: " <> pathify(ppath) <> "⨯" <> stringify(point) <> " fail:" <> js_string(ref) <> " " <> stringify(term)) + end + end + + nil + end + + def select(children0, query) do + if not isnode(children0) do + empty_list() + else + children = + if ismap(children0) do + vlist_new(Enum.map(items_pairs(children0), fn {k, n} -> setprop(n, @s_dkey, k); n end)) + else + vlist_new( + list_items(children0) + |> Enum.with_index() + |> Enum.map(fn {n, i} -> if ismap(n), do: (setprop(n, @s_dkey, i); n), else: n end) + ) + end + + results = empty_list() + extra = empty_map() + setprop(extra, "$AND", &select_and/4) + setprop(extra, "$OR", &select_or/4) + setprop(extra, "$NOT", &select_not/4) + setprop(extra, "$GT", &select_cmp/4) + setprop(extra, "$LT", &select_cmp/4) + setprop(extra, "$GTE", &select_cmp/4) + setprop(extra, "$LTE", &select_cmp/4) + setprop(extra, "$LIKE", &select_cmp/4) + q = clone(query) + + walk(q, after: fn _k, v, _p, _path -> + if ismap(v), do: setprop(v, @s_bopen, getprop(v, @s_bopen, true)) + v + end) + + Enum.each(list_items(children), fn child -> + errs = empty_list() + meta = empty_map() + setprop(meta, @s_bexact, true) + idef = vmap_new([{"errs", errs}, {"meta", meta}, {"extra", extra}]) + validate(child, clone(q), idef) + if size(errs) == 0, do: setprop(results, size(results), child) + end) + + results + end + end + + # --------------------------------------------------------------------------- + # builders + # --------------------------------------------------------------------------- + + def jm(kv) do + m = empty_map() + n = length(kv) + jm_loop(m, kv, n, 0) + m + end + + defp jm_loop(m, kv, n, i) do + if i >= n do + m + else + k0 = Enum.at(kv, i) + k = cond do; k0 == nil -> "null"; is_binary(k0) -> k0; true -> stringify(k0) end + setprop(m, k, if(i + 1 < n, do: Enum.at(kv, i + 1), else: nil)) + jm_loop(m, kv, n, i + 2) + end + end + + def jt(v), do: vlist_new(v) + + def tn(t), do: typename(t) +end + +defmodule Voxgig.Struct.Error do + defexception message: "struct error" +end diff --git a/elixir/test/runner.exs b/elixir/test/runner.exs new file mode 100644 index 00000000..e7fd0ef8 --- /dev/null +++ b/elixir/test/runner.exs @@ -0,0 +1,705 @@ +# Test runner for the shared JSON corpus (build/test/test.json). +# +# Self-contained: a tiny JSON parser reads the corpus directly into the +# library's heap nodes (built with the public `jm` / `jt` constructors), the +# exact representation the library operates on. The runner logic mirrors every +# other port (fixJson / eqv / doMatch / matchval / runSet / runSingle). + +Code.require_file("../lib/voxgig_struct.ex", __DIR__) + +defmodule Runner do + alias Voxgig.Struct, as: S + alias Voxgig.Struct.Error, as: SE + + @nullmark "__NULL__" + @undefmark "__UNDEF__" + @existsmark "__EXISTS__" + + # --------------------------------------------------------------------------- + # Minimal JSON parser -> heap nodes + # --------------------------------------------------------------------------- + + defp parse(str) do + {v, rest} = parse_value(str) + case skip_ws(rest) do + "" -> v + _ -> v + end + end + + defp skip_ws(<>) when c in [?\s, ?\t, ?\n, ?\r], do: skip_ws(rest) + defp skip_ws(s), do: s + + defp parse_value(s) do + s = skip_ws(s) + + case s do + "{" <> rest -> parse_object(rest, []) + "[" <> rest -> parse_array(rest, []) + "\"" <> rest -> parse_string(rest, []) + "true" <> rest -> {true, rest} + "false" <> rest -> {false, rest} + "null" <> rest -> {nil, rest} + _ -> parse_number(s) + end + end + + defp parse_object(s, acc) do + s = skip_ws(s) + + case s do + "}" <> rest -> + pairs = acc |> Enum.reverse() |> Enum.flat_map(fn {k, v} -> [k, v] end) + {S.jm(pairs), rest} + + _ -> + "\"" <> s1 = s + {key, s2} = parse_string_raw(s1, []) + s3 = skip_ws(s2) + ":" <> s4 = s3 + {val, s5} = parse_value(s4) + s6 = skip_ws(s5) + + case s6 do + "," <> r -> parse_object(r, [{key, val} | acc]) + "}" <> r -> parse_object("}" <> r, [{key, val} | acc]) + end + end + end + + defp parse_array(s, acc) do + s = skip_ws(s) + + case s do + "]" <> rest -> + {S.jt(Enum.reverse(acc)), rest} + + _ -> + {val, s1} = parse_value(s) + s2 = skip_ws(s1) + + case s2 do + "," <> r -> parse_array(r, [val | acc]) + "]" <> r -> parse_array("]" <> r, [val | acc]) + end + end + end + + defp parse_string(s, acc) do + {str, rest} = parse_string_raw(s, acc) + {str, rest} + end + + defp parse_string_raw("\"" <> rest, acc), do: {IO.iodata_to_binary(Enum.reverse(acc)), rest} + + defp parse_string_raw("\\" <> <>, acc) do + case c do + ?" -> parse_string_raw(rest, ["\"" | acc]) + ?\\ -> parse_string_raw(rest, ["\\" | acc]) + ?/ -> parse_string_raw(rest, ["/" | acc]) + ?n -> parse_string_raw(rest, ["\n" | acc]) + ?r -> parse_string_raw(rest, ["\r" | acc]) + ?t -> parse_string_raw(rest, ["\t" | acc]) + ?b -> parse_string_raw(rest, [<<8>> | acc]) + ?f -> parse_string_raw(rest, [<<12>> | acc]) + ?u -> + <> = rest + code = String.to_integer(hex, 16) + parse_string_raw(rest2, [<> | acc]) + end + end + + defp parse_string_raw(<>, acc), + do: parse_string_raw(rest, [<> | acc]) + + defp parse_number(s) do + {numstr, rest} = take_number(s, []) + n = IO.iodata_to_binary(Enum.reverse(numstr)) + + val = + if String.contains?(n, ".") or String.contains?(n, "e") or String.contains?(n, "E") do + {f, ""} = Float.parse(n) + f + else + String.to_integer(n) + end + + {val, rest} + end + + defp take_number(<>, acc) + when c in ?0..?9 or c in [?-, ?+, ?., ?e, ?E], + do: take_number(rest, [<> | acc]) + + defp take_number(s, acc), do: {acc, s} + + # --------------------------------------------------------------------------- + # Node helpers (public API only) + # --------------------------------------------------------------------------- + + defp velems(v) do + if S.islist(v) do + n = S.size(v) + if n == 0, do: [], else: Enum.map(0..(n - 1), fn i -> S.getelem(v, i) end) + else + [] + end + end + + defp ehas(e, k), do: S.ismap(e) and Enum.member?(S.keysof(e), k) + defp eget(e, k), do: if(S.ismap(e), do: S.getprop(e, k), else: nil) + + defp jss(v) do + cond do + v == nil -> "null" + is_binary(v) -> v + true -> S.stringify(v) + end + end + + defp joinpath(path), do: velems(path) |> Enum.map(&jss/1) |> Enum.join(".") + + # --------------------------------------------------------------------------- + # fixJson: null -> "__NULL__" (in place, preserving key order) + # --------------------------------------------------------------------------- + + defp fixj(v, flag) do + cond do + v == nil -> + if flag, do: @nullmark, else: nil + + S.ismap(v) -> + Enum.each(S.keysof(v), fn k -> S.setprop(v, k, fixj(S.getprop(v, k), flag)) end) + v + + S.islist(v) -> + n = S.size(v) + if n > 0, do: Enum.each(0..(n - 1), fn i -> S.setprop(v, i, fixj(S.getelem(v, i), flag)) end) + v + + true -> + v + end + end + + # --------------------------------------------------------------------------- + # eqv / matchval / doMatch + # --------------------------------------------------------------------------- + + defp eqv(a, b) do + cond do + a == nil and b == nil -> true + is_boolean(a) or is_boolean(b) -> a === b + is_number(a) and is_number(b) -> a == b + is_binary(a) and is_binary(b) -> a == b + S.islist(a) and S.islist(b) -> eqv_list(a, b) + S.ismap(a) and S.ismap(b) -> eqv_map(a, b) + true -> a === b + end + end + + defp eqv_list(a, b) do + S.size(a) == S.size(b) and + Enum.all?(velems(a) |> Enum.zip(velems(b)), fn {x, y} -> eqv(x, y) end) + end + + defp eqv_map(a, b) do + ka = S.keysof(a) + kb = S.keysof(b) + Enum.sort(ka) == Enum.sort(kb) and Enum.all?(ka, fn k -> eqv(S.getprop(a, k), S.getprop(b, k)) end) + end + + defp matchval(check0, base) do + check = if check0 == @undefmark or check0 == @nullmark, do: nil, else: check0 + + cond do + eqv(check, base) -> + true + + is_binary(check) -> + basestr = S.stringify(base) + + if String.length(check) >= 2 and String.starts_with?(check, "/") and + String.ends_with?(check, "/") do + pat = String.slice(check, 1, String.length(check) - 2) + Regex.match?(Regex.compile!(pat), basestr) + else + String.contains?(String.downcase(basestr), String.downcase(S.stringify(check))) + end + + S.isfunc(check) -> + true + + true -> + false + end + end + + defp do_match(check, base0) do + base = S.clone(base0) + + S.walk(check, + before: fn _k, v, _p, path -> + if not S.isnode(v) do + baseval = S.getpath(base, path) + + cond do + eqv(baseval, v) -> :ok + v == @undefmark and baseval == nil -> :ok + v == @existsmark and baseval != nil -> :ok + not matchval(v, baseval) -> + raise SE, + message: + "MATCH: " <> + joinpath(path) <> + ": [" <> S.stringify(v) <> "] <=> [" <> S.stringify(baseval) <> "]" + + true -> :ok + end + end + + v + end + ) + end + + # --------------------------------------------------------------------------- + # Recording + # --------------------------------------------------------------------------- + + defp record(_group, _name, true, _msg), do: Process.put(:npass, Process.get(:npass, 0) + 1) + + defp record(group, name, false, msg) do + Process.put(:nfail, Process.get(:nfail, 0) + 1) + Process.put(:failures, Process.get(:failures, []) ++ ["FAIL #{group} #{name} - #{msg}"]) + end + + defp errmsg(%SE{message: m}), do: m + defp errmsg(%{message: m}) when is_binary(m), do: m + defp errmsg(e), do: Exception.message(e) + + # --------------------------------------------------------------------------- + # resolveArgs / checkResult / handleError + # --------------------------------------------------------------------------- + + defp resolve_args(entry) do + cond do + ehas(entry, "ctx") -> [eget(entry, "ctx")] + ehas(entry, "args") -> (a = eget(entry, "args")); if(S.islist(a), do: velems(a), else: []) + ehas(entry, "in") -> [S.clone(eget(entry, "in"))] + true -> [] + end + end + + defp check_result(entry, args, res) do + matched = + if ehas(entry, "match") do + do_match( + eget(entry, "match"), + S.jm(["in", eget(entry, "in"), "args", S.jt(args), "out", eget(entry, "res"), "ctx", eget(entry, "ctx")]) + ) + + true + else + false + end + + out = eget(entry, "out") + + cond do + eqv(out, res) -> :ok + matched and (out == @nullmark or out == nil) -> :ok + true -> raise SE, message: "Expected: #{S.stringify(out)}, got: #{S.stringify(res)}" + end + end + + defp handle_error(entry, err) do + msg = errmsg(err) + + if ehas(entry, "err") do + entry_err = eget(entry, "err") + + if entry_err == true or matchval(entry_err, msg) do + if ehas(entry, "match") do + do_match( + eget(entry, "match"), + S.jm(["in", eget(entry, "in"), "out", eget(entry, "res"), "ctx", eget(entry, "ctx"), "err", msg]) + ) + end + + :ok + else + raise SE, message: "ERROR MATCH: [#{S.stringify(entry_err)}] <=> [#{msg}]" + end + else + raise err + end + end + + # --------------------------------------------------------------------------- + # runSet / runSingle + # --------------------------------------------------------------------------- + + defp run_set(group, node, subject, flag_null \\ true) do + fixed = fixj(S.clone(node), flag_null) + testset = S.getprop(fixed, "set") + + if S.islist(testset) do + Enum.each(velems(testset), fn entry -> + name = jss(eget(entry, "name")) + + try do + if not ehas(entry, "out") and flag_null, do: S.setprop(entry, "out", @nullmark) + args = resolve_args(entry) + res = fixj(subject.(args), flag_null) + S.setprop(entry, "res", res) + check_result(entry, args, res) + record(group, name, true, "") + rescue + e -> + try do + handle_error(entry, e) + record(group, name, true, "") + rescue + e2 -> record(group, name, false, errmsg(e2)) + end + end + end) + end + end + + defp run_single(group, node, fun) do + try do + expected = eget(node, "out") + actual = fun.(eget(node, "in")) + + if eqv(expected, actual) do + record(group, "single", true, "") + else + record(group, "single", false, "Expected: #{S.stringify(expected)}, got: #{S.stringify(actual)}") + end + rescue + e -> record(group, "single", false, errmsg(e)) + end + end + + # --------------------------------------------------------------------------- + # Subject helpers + # --------------------------------------------------------------------------- + + defp arg1(f), do: fn args -> f.(if(args == [], do: nil, else: hd(args))) end + defp vget(vin, k), do: if(S.ismap(vin), do: S.getprop(vin, k), else: nil) + defp vhas(vin, k), do: S.ismap(vin) and Enum.member?(S.keysof(vin), k) + + defp grow_list(c, i) do + if S.size(c) <= i do + S.setprop(c, S.size(c), nil) + grow_list(c, i) + end + end + + defp null_modifier(v, key, parent, _inj) do + cond do + v == @nullmark -> S.setprop(parent, key, nil) + is_binary(v) -> S.setprop(parent, key, String.replace(v, @nullmark, "null")) + true -> :ok + end + end + + defp walk_copy_subject(vin) do + cur = S.jt([nil]) + + walkcopy = fn key, v, _parent, path -> + if key == nil do + inner = S.jt([cond do; S.ismap(v) -> S.jm([]); S.islist(v) -> S.jt([]); true -> v end]) + S.setprop(cur, 0, inner) + else + i = S.size(path) + + nv = + if S.isnode(v) do + c = S.getelem(cur, 0) + grow_list(c, i) + nvx = if S.ismap(v), do: S.jm([]), else: S.jt([]) + S.setprop(c, i, nvx) + nvx + else + v + end + + S.setprop(S.getelem(S.getelem(cur, 0), i - 1), key, nv) + end + + v + end + + S.walk(vin, before: walkcopy) + S.getelem(S.getelem(cur, 0), 0) + end + + defp walk_depth_subject(vin) do + state = S.jm(["top", nil, "cur", nil]) + + copy = fn key, v, _parent, _path -> + if key == nil or S.isnode(v) do + child = if S.islist(v), do: S.jt([]), else: S.jm([]) + + if key == nil do + S.setprop(state, "top", child) + S.setprop(state, "cur", child) + else + S.setprop(S.getprop(state, "cur"), key, child) + S.setprop(state, "cur", child) + end + else + S.setprop(S.getprop(state, "cur"), key, v) + end + + v + end + + S.walk(vget(vin, "src"), before: copy, maxdepth: vget(vin, "maxdepth")) + S.getprop(state, "top") + end + + defp run_walk_log(group, node) do + try do + test_data = S.clone(node) + log = S.jt([]) + + walklog = fn key, v, parent, path -> + S.setprop( + log, + S.size(log), + "k=" <> + (if key == nil, do: S.stringify(), else: S.stringify(key)) <> + ", v=" <> + S.stringify(v) <> + ", p=" <> + (if parent == nil, do: S.stringify(), else: S.stringify(parent)) <> + ", t=" <> + S.pathify(path) + ) + + v + end + + S.walk(S.getprop(test_data, "in"), after: walklog) + expected = S.getprop(S.getprop(test_data, "out"), "after") + + if eqv(expected, log) do + record(group, "log", true, "") + else + record(group, "log", false, "Expected: #{S.stringify(expected)}, got: #{S.stringify(log)}") + end + rescue + e -> record(group, "log", false, errmsg(e)) + end + end + + # --------------------------------------------------------------------------- + # runAll + # --------------------------------------------------------------------------- + + def run_all(spec) do + g = fn k -> S.getprop(spec, k) end + minor = g.("minor") + walks = g.("walk") + merges = g.("merge") + getpaths = g.("getpath") + injects = g.("inject") + transforms = g.("transform") + validates = g.("validate") + selects = g.("select") + sentinels = g.("sentinels") + mg = fn n -> S.getprop(minor, n) end + + run_set("minor.isnode", mg.("isnode"), arg1(fn v -> S.isnode(v) end)) + run_set("minor.ismap", mg.("ismap"), arg1(fn v -> S.ismap(v) end)) + run_set("minor.islist", mg.("islist"), arg1(fn v -> S.islist(v) end)) + run_set("minor.iskey", mg.("iskey"), arg1(fn v -> S.iskey(v) end), false) + run_set("minor.strkey", mg.("strkey"), arg1(fn v -> S.strkey(v) end), false) + run_set("minor.isempty", mg.("isempty"), arg1(fn v -> S.isempty(v) end), false) + run_set("minor.isfunc", mg.("isfunc"), arg1(fn v -> S.isfunc(v) end)) + run_set("minor.clone", mg.("clone"), arg1(fn v -> S.clone(v) end), false) + run_set("minor.escre", mg.("escre"), arg1(fn v -> S.escre(v) end)) + run_set("minor.escurl", mg.("escurl"), arg1(fn v -> S.escurl(v) end)) + + run_set( + "minor.stringify", + mg.("stringify"), + arg1(fn vin -> + if vhas(vin, "val"), do: S.stringify(vget(vin, "val"), vget(vin, "max")), else: S.stringify() + end), + false + ) + + run_set("minor.jsonify", mg.("jsonify"), arg1(fn vin -> S.jsonify(vget(vin, "val"), vget(vin, "flags")) end), false) + + run_set( + "minor.getelem", + mg.("getelem"), + arg1(fn vin -> + alt = vget(vin, "alt") + if alt == nil, do: S.getelem(vget(vin, "val"), vget(vin, "key")), else: S.getelem(vget(vin, "val"), vget(vin, "key"), alt) + end), + false + ) + + run_set("minor.delprop", mg.("delprop"), arg1(fn vin -> S.delprop(vget(vin, "parent"), vget(vin, "key")) end)) + run_set("minor.size", mg.("size"), arg1(fn v -> S.size(v) end), false) + run_set("minor.slice", mg.("slice"), arg1(fn vin -> S.slice(vget(vin, "val"), vget(vin, "start"), vget(vin, "end")) end), false) + run_set("minor.pad", mg.("pad"), arg1(fn vin -> S.pad(vget(vin, "val"), vget(vin, "pad"), vget(vin, "char")) end), false) + + run_set( + "minor.pathify", + mg.("pathify"), + arg1(fn vin -> + if vhas(vin, "path"), do: S.pathify(vget(vin, "path"), vget(vin, "from")), else: S.pathify(S.noarg(), vget(vin, "from")) + end), + false + ) + + run_set("minor.items", mg.("items"), arg1(fn v -> S.items(v) end)) + + run_set( + "minor.getprop", + mg.("getprop"), + arg1(fn vin -> + alt = vget(vin, "alt") + if alt == nil, do: S.getprop(vget(vin, "val"), vget(vin, "key")), else: S.getprop(vget(vin, "val"), vget(vin, "key"), alt) + end), + false + ) + + run_set("minor.setprop", mg.("setprop"), arg1(fn vin -> S.setprop(vget(vin, "parent"), vget(vin, "key"), vget(vin, "val")) end)) + run_set("minor.haskey", mg.("haskey"), arg1(fn vin -> S.haskey(vget(vin, "src"), vget(vin, "key")) end), false) + run_set("minor.keysof", mg.("keysof"), arg1(fn v -> S.keysof(v) |> S.jt() end)) + run_set("minor.join", mg.("join"), arg1(fn vin -> S.join(vget(vin, "val"), vget(vin, "sep"), vget(vin, "url")) end), false) + run_set("minor.typify", mg.("typify"), fn args -> S.typify(if(args == [], do: S.noarg(), else: hd(args))) end, false) + run_set("minor.setpath", mg.("setpath"), arg1(fn vin -> S.setpath(vget(vin, "store"), vget(vin, "path"), vget(vin, "val")) end), false) + + run_set("minor.filter", mg.("filter"), arg1(fn vin -> + c = vget(vin, "check") + + check = + case c do + "gt3" -> fn {_k, x} -> is_number(x) and not is_boolean(x) and x > 3 end + "lt3" -> fn {_k, x} -> is_number(x) and not is_boolean(x) and x < 3 end + _ -> fn _ -> false end + end + + S.filter(vget(vin, "val"), check) + end)) + + run_set("minor.typename", mg.("typename"), arg1(fn v -> S.typename(if(is_number(v) and not is_boolean(v), do: trunc(v), else: 0)) end)) + + run_set("minor.flatten", mg.("flatten"), arg1(fn vin -> + d = vget(vin, "depth") + S.flatten(vget(vin, "val"), if(is_number(d), do: trunc(d), else: 1)) + end)) + + run_walk_log("walk.log", S.getprop(walks, "log")) + + run_set("walk.basic", S.getprop(walks, "basic"), arg1(fn vin -> + S.walk(vin, after: fn _k, v, _p, path -> + if is_binary(v), do: v <> "~" <> joinpath(path), else: v + end) + end)) + + run_set("walk.copy", S.getprop(walks, "copy"), arg1(&walk_copy_subject/1)) + run_set("walk.depth", S.getprop(walks, "depth"), arg1(&walk_depth_subject/1), false) + + run_single("merge.basic", S.getprop(merges, "basic"), fn in_ -> S.merge(S.clone(in_)) end) + run_set("merge.cases", S.getprop(merges, "cases"), arg1(fn v -> S.merge(v) end)) + run_set("merge.array", S.getprop(merges, "array"), arg1(fn v -> S.merge(v) end)) + run_set("merge.integrity", S.getprop(merges, "integrity"), arg1(fn v -> S.merge(v) end)) + run_set("merge.depth", S.getprop(merges, "depth"), arg1(fn vin -> S.merge(vget(vin, "val"), vget(vin, "depth")) end)) + + run_set("getpath.basic", S.getprop(getpaths, "basic"), arg1(fn vin -> S.getpath(vget(vin, "store"), vget(vin, "path")) end)) + + run_set("getpath.relative", S.getprop(getpaths, "relative"), arg1(fn vin -> + dp = vget(vin, "dpath") + dpath = if is_binary(dp), do: S.jt(String.split(dp, ".")), else: nil + injdef = S.jm(["dparent", vget(vin, "dparent"), "dpath", dpath]) + S.getpath(vget(vin, "store"), vget(vin, "path"), injdef) + end)) + + run_set("getpath.special", S.getprop(getpaths, "special"), arg1(fn vin -> + S.getpath(vget(vin, "store"), vget(vin, "path"), vget(vin, "inj")) + end)) + + run_set("getpath.handler", S.getprop(getpaths, "handler"), arg1(fn vin -> + store = S.jm(["$TOP", vget(vin, "store"), "$FOO", fn -> "foo" end]) + handler = fn _inj, val, _ref, _st -> if S.isfunc(val), do: val.(), else: val end + S.getpath(store, vget(vin, "path"), S.jm(["handler", handler])) + end)) + + run_single("inject.basic", S.getprop(injects, "basic"), fn in_ -> + S.inject(S.clone(S.getprop(in_, "val")), S.clone(S.getprop(in_, "store"))) + end) + + run_set("inject.string", S.getprop(injects, "string"), arg1(fn vin -> + S.inject(vget(vin, "val"), vget(vin, "store"), S.jm(["modify", &null_modifier/4, "extra", vget(vin, "current")])) + end)) + + run_set("inject.deep", S.getprop(injects, "deep"), arg1(fn vin -> S.inject(vget(vin, "val"), vget(vin, "store")) end)) + + run_single("transform.basic", S.getprop(transforms, "basic"), fn in_ -> + S.transform(S.getprop(in_, "data"), S.getprop(in_, "spec")) + end) + + Enum.each(["paths", "cmds", "each", "pack", "ref"], fn gn -> + run_set("transform.#{gn}", S.getprop(transforms, gn), arg1(fn vin -> S.transform(vget(vin, "data"), vget(vin, "spec")) end)) + end) + + run_set("transform.modify", S.getprop(transforms, "modify"), arg1(fn vin -> + modifier = fn v, key, parent, _inj -> + if is_binary(v) and key != nil and parent != nil, do: S.setprop(parent, key, "@" <> v) + end + + S.transform(vget(vin, "data"), vget(vin, "spec"), S.jm(["modify", modifier, "extra", vget(vin, "store")])) + end)) + + run_set("transform.format", S.getprop(transforms, "format"), arg1(fn vin -> S.transform(vget(vin, "data"), vget(vin, "spec")) end), false) + run_set("transform.apply", S.getprop(transforms, "apply"), arg1(fn vin -> S.transform(vget(vin, "data"), vget(vin, "spec")) end)) + + run_set("validate.basic", S.getprop(validates, "basic"), arg1(fn vin -> S.validate(vget(vin, "data"), vget(vin, "spec")) end), false) + + Enum.each(["child", "one", "exact"], fn gn -> + run_set("validate.#{gn}", S.getprop(validates, gn), arg1(fn vin -> S.validate(vget(vin, "data"), vget(vin, "spec")) end)) + end) + + run_set("validate.invalid", S.getprop(validates, "invalid"), arg1(fn vin -> S.validate(vget(vin, "data"), vget(vin, "spec")) end), false) + run_set("validate.special", S.getprop(validates, "special"), arg1(fn vin -> S.validate(vget(vin, "data"), vget(vin, "spec"), vget(vin, "inj")) end)) + + Enum.each(["basic", "operators", "edge", "alts"], fn gn -> + run_set("select.#{gn}", S.getprop(selects, gn), arg1(fn vin -> S.select(vget(vin, "obj"), vget(vin, "query")) end)) + end) + + run_set("sentinels.getprop_unify", S.getprop(sentinels, "getprop_unify"), arg1(fn vin -> S.getprop(vget(vin, "val"), vget(vin, "key"), vget(vin, "alt")) end), false) + run_set("sentinels.getelem_absent", S.getprop(sentinels, "getelem_absent"), arg1(fn vin -> S.getelem(vget(vin, "val"), vget(vin, "key"), vget(vin, "alt")) end), false) + run_set("sentinels.haskey_unify", S.getprop(sentinels, "haskey_unify"), arg1(fn vin -> S.haskey(vget(vin, "val"), vget(vin, "key")) end), false) + run_set("sentinels.isempty_unify", S.getprop(sentinels, "isempty_unify"), arg1(fn v -> S.isempty(v) end), false) + run_set("sentinels.isnode_unify", S.getprop(sentinels, "isnode_unify"), arg1(fn v -> S.isnode(v) end), false) + run_set("sentinels.stringify_null", S.getprop(sentinels, "stringify_null"), arg1(fn vin -> S.stringify(vin) end), false) + end + + def main(argv) do + Process.put(:npass, 0) + Process.put(:nfail, 0) + Process.put(:failures, []) + + testfile = if argv == [], do: "../build/test/test.json", else: hd(argv) + raw = File.read!(testfile) + alltests = parse(raw) + spec = S.getprop(alltests, "struct") + run_all(spec) + + Enum.each(Process.get(:failures, []), &IO.puts/1) + IO.puts("\nPASS #{Process.get(:npass, 0)} FAIL #{Process.get(:nfail, 0)}") + if Process.get(:nfail, 0) > 0, do: System.halt(1) + end +end + +Runner.main(System.argv()) diff --git a/haskell/AGENTS.md b/haskell/AGENTS.md new file mode 100644 index 00000000..93f23ea0 --- /dev/null +++ b/haskell/AGENTS.md @@ -0,0 +1,79 @@ +# AGENTS.md — Haskell port of `voxgig/struct` + +Read the repo-root [`../AGENTS.md`](../AGENTS.md) first. This file covers only +what is specific to the Haskell port. **TypeScript is canonical; the shared +`build/test/*.jsonic` corpus is the contract.** This port follows the +distinct-`undefined`/`null` model of the OCaml / Scala ports (it has separate +`VNoval` / `VNull` constructors), not the single-`null` model of the +Python / Clojure / Dart / Elixir ports. + +## How to build / test / lint + +``` +cd haskell +make test # ghc … test/Runner.hs && runner — runs build/test/test.json +make lint # ghc -fno-code (a clean type-check = pass) +``` + +Requires only GHC and its boot libraries (`base`, `array`). **Zero third-party +runtime dependencies** — no Cabal/Stack packages, no `aeson`, no `regex-*`. The +test runner ships a hand-written JSON reader; the library vendors a small +RE2-subset regex engine (`src/Vregex.hs`). + +## The value model + +The canonical algorithm mutates nodes in place and relies on reference-stable +nodes. Haskell has no mutable native collection, so a node holds an `IORef`: + +- **maps → `VMap (IORef [(String, Value)])`** — an ordered association list + (insertion order; re-assigning an existing key keeps its position). +- **lists → `VList (IORef [Value])`**. + +`ismap`/`islist`/`isnode` pattern-match the constructor; `isfunc` matches +`VFunc`. **The entire API runs in `IO`** because every read/mutate touches an +`IORef`. Always build nodes with `jm` / `jt` (or the engines) — never fabricate +the `IORef` by hand outside those. + +## `VNoval` vs `VNull` + +Distinct constructors, mirroring canonical TS (and OCaml / Scala): + +- `VNoval` = canonical `undefined` (property absent). +- `VNull` = JSON `null`. + +`getprop` / `getelem` / `haskey` / `isempty` / `isnode` treat *both* as "no +value" (the Group-A rule is automatic: they test `isNullish`). Group-B +processors (`setprop`, `clone`, `merge`, `walk`, `inject`, `transform`, +`validate`, `select`) preserve `VNull` literally; `lookup_` is the internal raw +reader. There is **no** NOARG sentinel — the distinct constructors already +carry the distinction (`typify VNoval` = `t_noval`, `stringify VNoval` = `""`, +`pathifyFull … absent=True` = ``). + +## Naming + +Public names are the canonical lower-smushed / snake_cased names (`getpath`, +`ismap`, `re_find_all`, `check_placement`, `injector_args`, `inject_child`), so +the case/underscore-insensitive parity check matches them. The parity tool reads +top-level `name ::` type signatures (the `_HASKELL_DECL` extractor in +`tools/check_parity.py`), so **every public function needs a standalone type +signature**. Many functions come in arity pairs (`getprop`/`getpropAlt`, +`stringify`/`stringifyMax`, `merge`/`mergeD`, `slice`/`sliceM`, +`pathify`/`pathifyFull`). + +## Gotchas + +- **`skip` / `delete`** are `VSentinel "skip"` / `VSentinel "delete"`, compared + by tag via `is_skip` / `is_delete`. +- **One-line `case … of … -> do …; _ -> …`** does not parse — the `_` arm is + swallowed into the `do`. Use explicit braces `case x of { A -> do { … }; _ -> … }` + or multiple lines. +- **`filter`** shadows `Prelude.filter` (it is a canonical name). The library + does `import Prelude hiding (filter)` and uses `L.filter` (`qualified Data.List + as L`) internally; the runner calls the library one as `VoxgigStruct.filter`. +- **Numbers** are `VNum Double`. `typify` treats a whole `Double` as an integer + (`Number.isInteger` semantics); `numToString` prints integral values without + `.0` and otherwise the shortest round-tripping `%g`. +- `dummyInj` (an `unsafePerformIO` singleton) only backs corpus-unreached + `Inj`-needing paths; do not rely on its mutable state. +- Keep `make test` and `python3 ../tools/check_parity.py` green, and add no + runtime dependencies. Change canonical (TS + corpus) first, then propagate. diff --git a/haskell/DOCS.md b/haskell/DOCS.md new file mode 100644 index 00000000..93aaebf0 --- /dev/null +++ b/haskell/DOCS.md @@ -0,0 +1,114 @@ +# Haskell port — comprehensive guide + +This document covers the Haskell-specific details of `voxgig/struct`. For the +language-neutral concepts, tutorial and full reference, read the top-level +[`../DOCS.md`](../DOCS.md); for the user overview, [`README.md`](./README.md). +TypeScript is canonical and the shared `build/test` corpus is the contract. + +## Installation + +The library is two files (`src/VoxgigStruct.hs` and the in-tree regex engine +`src/Vregex.hs`) with no third-party dependencies — only the GHC boot +libraries. Add `src/` to your include path (`ghc -isrc`) and +`import VoxgigStruct`. + +## Representation of data + +| JSON-shape thing | Haskell representation | +|------------------|------------------------------------------------| +| object / map | `VMap (IORef [(String, Value)])` (insertion order) | +| array / list | `VList (IORef [Value])` | +| string | `VStr String` | +| number | `VNum Double` (integers are whole `Double`s) | +| boolean | `VBool Bool` | +| JSON `null` | `VNull` | +| undefined | `VNoval` | +| function | `VFunc Injector` | +| SKIP / DELETE | `VSentinel "skip"` / `VSentinel "delete"` | + +Nodes are **mutable and reference-stable** on purpose: `merge`, `walk`, +`inject`, `transform`, `validate` mutate nodes in place and depend on shared +references. Haskell has no mutable native collection, so a node holds an +`IORef` to its contents (the analog of OCaml's `ref` or Rust's `Rc`). +A consequence is that **the entire public API runs in `IO`** — every reader and +mutator returns `IO`. Build nodes with `jm` / `jt`, or by running the +`transform` / `inject` engines. + +### `VNoval` vs `VNull`: undefined vs JSON null + +Like the OCaml and Scala ports (and the canonical TypeScript), this port keeps +the canonical `undefined` and JSON `null` as **distinct constructors** +(`VNoval` / `VNull`). So it mirrors the canonical logic directly and does not +need the Group-A/B `null`-collapsing rules of the single-`null` ports +(Python / Clojure / Dart / Elixir). `getprop` / `getelem` / `haskey` collapse +*both* to the alt (their "no value" rule); the Group-B processors preserve +`VNull` literally; `lookup_` is the internal raw reader. + +## The public API + +Names are lower-smushed / snake_cased, identical (case/underscore-insensitively) +to the canonical export list: + +- **Lookups / paths:** `getpath`, `setpath`, `getprop`, `setprop`, `getelem`, + `delprop`, `haskey`, `keysof`, `items`. +- **Predicates / kinds:** `isnode`, `ismap`, `islist`, `iskey`, `isfunc`, + `isempty`, `typify`, `typename`. +- **Values:** `clone`, `merge`, `walk`, `size`, `slice`, `pad`, `flatten`, + `filter`, `getdef`, `strkey`. +- **Strings / formatting:** `stringify`, `jsonify`, `pathify`, `join`, + `escre`, `escurl`. +- **Regex (RE2-subset uniform API):** `re_compile`, `re_find`, `re_find_all`, + `re_replace`, `re_test`, `re_escape`. Backed by the in-tree `Vregex`. +- **By-example engine:** `inject`, `transform`, `validate`, `select`, and the + injector helpers `check_placement`, `injector_args`, `inject_child`. +- **Builders / markers:** `jm`, `jt`, `skip`, `delete`, the `t_*` type + constants and `m_keypre` / `m_keypost` / `m_val`. + +Optional arguments are explicit. `walk` takes `Maybe WalkFn` before/after and a +`Value` maxdepth: `walk before after maxdepth v` (a `WalkFn` is +`Value -> Value -> Value -> Value -> IO Value` = key/val/parent/path). The +many-arity helpers come in pairs, e.g. `getprop` / `getpropAlt`, +`getelem` / `getelemAlt`, `stringify` / `stringifyMax`, `merge` / `mergeD`, +`slice` / `sliceM`, `pathify` / `pathifyFull`. The injection-aware API takes an +`InjArg` (`INone` / `IDef InjDef` / `IInj Inj`). + +## Examples + +```haskell +import VoxgigStruct + +demo :: IO () +demo = do + -- merge (later wins; the first node is modified in place) + a <- jm [VStr "a", VNum 1]; b <- jm [VStr "b", VNum 2]; xs <- jt [a, b] + putStrLn =<< stringify =<< merge xs -- {a:1,b:2} + + -- transform: spec mirrors the desired output, backticks pull from data + dat <- jm [VStr "name", VStr "alice"] + idsp <- jm [VStr "id", VStr "`name`"]; spec <- jm [VStr "user", idsp] + putStrLn =<< stringify =<< transform INone dat spec +``` + +## Testing + +`make test` compiles `test/Runner.hs` and runs the entire shared corpus +(`../build/test/test.json`). The runner ships a tiny hand-written JSON reader +(no `aeson`) that builds the library's `IORef`-backed nodes directly — the same +representation the library operates on — and uses the same runner logic as +every other port. Keep it green, keep `python3 ../tools/check_parity.py` green, +and add no runtime dependencies. + +## Implementation notes + +- The injection state (`Inj`) is a record of `IORef`s (one per mutable field); + a caller-supplied `injdef` is the plain `InjDef` record. +- `skip` / `delete` are `VSentinel` values compared by tag (`is_skip` / + `is_delete`). +- Numbers follow JS formatting in `stringify` / `jsonify` (an integral `Double` + prints without `.0`; otherwise the shortest round-tripping `%g` form, matching + the canonical implementation). +- The only regex engine is the in-tree `Vregex` (a small backtracking matcher + covering the RE2 subset the corpus uses for `$LIKE` and the `re_*` API). +- A single `dummyInj` placeholder (built with `unsafePerformIO`) backs the two + corpus-unreached paths that need an `Inj` without one in hand + (`getelem`'s function-alt, `$FORMAT`'s function-formatter). diff --git a/haskell/Makefile b/haskell/Makefile new file mode 100644 index 00000000..bf62848e --- /dev/null +++ b/haskell/Makefile @@ -0,0 +1,36 @@ +# Makefile for the Haskell port of voxgig/struct. +# Requires GHC (`ghc` / `runghc`) on PATH. No third-party dependencies +# (only the GHC boot libraries: base, array, etc.). + +.PHONY: test lint build inspect clean reset publish format + +BUILDDIR := .hsbuild + +# Run the shared JSON corpus through the Haskell implementation. +test: + @mkdir -p $(BUILDDIR) + ghc -O0 -isrc -itest -outputdir $(BUILDDIR) -o $(BUILDDIR)/runner test/Runner.hs + $(BUILDDIR)/runner ../build/test/test.json + +# "Lint": type-check the library and runner (a clean compile = pass). +lint: + ghc -fno-code -isrc -itest test/Runner.hs + +# Compile the library as a build smoke-test. +build: + ghc -fno-code -isrc src/VoxgigStruct.hs + +format: + @echo "haskell: (ormolu/fourmolu optional)" + +inspect: + @ghc --version + +clean: + rm -rf $(BUILDDIR) src/*.hi src/*.o test/*.hi test/*.o + +reset: clean + +# The library publishes to Hackage; this target creates the git tag. +publish: + @echo "haskell: publish via 'cabal upload' + git tag haskell/vX.Y.Z" diff --git a/haskell/README.md b/haskell/README.md new file mode 100644 index 00000000..e87bbb2c --- /dev/null +++ b/haskell/README.md @@ -0,0 +1,77 @@ +# voxgig_struct — Haskell + +A Haskell port of [`voxgig/struct`](../README.md): one small, fixed API for +manipulating JSON-shaped data — lookups, deep merge, by-example transform, +by-example validate, tree walk, path get/set, selection — that returns the +**same answer** as the canonical TypeScript implementation and every other +port. The behavioural contract is the shared JSON corpus in +[`build/test/`](../build/test); this port passes it in full. + +## Status + +Complete. Every canonical public function is implemented and the entire +shared corpus passes (`make test`). **Zero third-party dependencies** — only +GHC and its boot libraries (`base`, `array`) are required. + +## Requirements + +- GHC 9.x (tested with 9.4). No Cabal/Stack packages needed. + +## Use + +```haskell +import VoxgigStruct + +main :: IO () +main = do + store <- jm ["a", undefined] -- build nodes with jm / jt (see below) + v <- getpath INone store (VStr "a.b") + print =<< stringify v +``` + +`jm` / `jt` are the JSON-object / JSON-array builders (`jm` takes a flat +`[k1, v1, k2, v2, ...]` list of `Value`s; `jt` takes a list of items): + +```haskell +do inner <- jt [VNum 2, VNum 3] + m <- jm [VStr "a", VNum 1, VStr "b", inner] + putStrLn =<< jsonify m VNoval +``` + +### Data model + +The canonical algorithm mutates nodes in place and relies on **reference-stable** +nodes (a node updated through one reference is seen through every other). +Haskell has no mutable native collection, so a node carries an `IORef` to its +contents — `VList (IORef [Value])` for arrays, `VMap (IORef [(String, Value)])` +for objects (insertion-ordered) — the analog of OCaml's `ref` or Rust's +`Rc`. Because the heap is mutable, **the whole API runs in `IO`**. + +Like the OCaml / Scala ports, `undefined` (`VNoval`) and JSON `null` (`VNull`) +are **distinct** constructors, so the port mirrors the canonical TS logic +directly without the Group-A/B `null`-collapsing the single-`null` ports need. + +## API + +The public surface matches the canonical export list, in lower-smushed / +snake_cased names: + +`clone delprop escre escurl filter flatten getdef getelem getpath getprop +haskey inject isempty isfunc iskey islist ismap isnode items join jsonify +keysof merge pad pathify select setpath setprop size slice strkey stringify +transform typify typename validate walk re_compile re_find re_find_all +re_replace re_test re_escape jm jt check_placement injector_args inject_child` + +See [`DOCS.md`](./DOCS.md) for the full guide and +[the language-neutral docs](../DOCS.md) for concepts and examples. + +## Develop + +``` +make test # compile + run the shared corpus +make lint # ghc -fno-code (a clean type-check = pass) +``` + +## License + +MIT. See [`../LICENSE`](../LICENSE). diff --git a/haskell/src/VoxgigStruct.hs b/haskell/src/VoxgigStruct.hs new file mode 100644 index 00000000..4687bdb9 --- /dev/null +++ b/haskell/src/VoxgigStruct.hs @@ -0,0 +1,2111 @@ +-- Copyright (c) 2025-2026 Voxgig Ltd. MIT LICENSE. +-- +-- Voxgig Struct — Haskell port. +-- +-- A faithful port of the canonical TypeScript implementation +-- (typescript/src/StructUtility.ts). Like TypeScript (and the OCaml / Rust +-- ports), this port keeps `undefined` (VNoval) and JSON `null` (VNull) +-- distinct, so it mirrors the canonical TS logic directly. The canonical +-- algorithm mutates nodes in place and relies on reference-stable nodes +-- (shared references seen by walk / merge / inject). Haskell has no mutable +-- native collection, so nodes carry an `IORef` to their contents (lists are +-- `IORef [Value]`, maps an `IORef` of ordered key/value pairs) — the analog of +-- the OCaml `ref` or Rust `Rc` — and the whole API runs in `IO`. +-- Zero third-party runtime dependencies; the regex helper is the in-tree +-- Vregex engine (RE2 subset). + +{-# LANGUAGE LambdaCase #-} + +module VoxgigStruct where + +import Control.Exception (Exception, throwIO) +import Control.Monad (filterM, foldM, forM_, when) +import Data.Bits (shiftL, (.&.), (.|.)) +import Data.Char (toLower, toUpper) +import Data.IORef +import Data.List (findIndex, intercalate, isPrefixOf, sort) +import qualified Data.List as L +import Data.Maybe (fromMaybe, isJust) +import Numeric (showHex) +import System.IO.Unsafe (unsafePerformIO) +import Text.Printf (printf) +import Text.Read (readMaybe) +import qualified Vregex + +import Prelude hiding (filter) + +-- --------------------------------------------------------------------------- +-- Value model +-- --------------------------------------------------------------------------- + +data Value + = VNoval -- TS undefined — property absent + | VNull -- JSON null + | VBool !Bool + | VNum !Double + | VStr !String + | VList !(IORef [Value]) + | VMap !(IORef [(String, Value)]) + | VFunc Injector + | VSentinel !String -- SKIP / DELETE, by tag + +type Injector = Inj -> Value -> String -> Value -> IO Value +type ModifyFn = Value -> Value -> Value -> Inj -> IO () + +data Inj = Inj + { iMode :: IORef Int + , iFull :: IORef Bool + , iKeyi :: IORef Int + , iKeys :: IORef Value + , iKey :: IORef Value + , iIval :: IORef Value + , iParent :: IORef Value + , iPath :: IORef Value + , iNodes :: IORef Value + , iHandler :: IORef Injector + , iErrs :: IORef Value + , iMeta :: IORef Value + , iDparent :: IORef Value + , iDpath :: IORef Value + , iBase :: IORef Value + , iModify :: IORef (Maybe ModifyFn) + , iPrior :: IORef (Maybe Inj) + , iExtra :: IORef Value + } + +-- injdef: the loose Partial the public API accepts. +data InjDef = InjDef + { dMeta :: Value + , dExtra :: Value + , dErrs :: Value + , dModify :: Maybe ModifyFn + , dHandler :: Maybe Injector + , dBase :: Value + , dDparent :: Value + , dDpath :: Value + , dKey :: Value + } + +data InjArg = IInj Inj | IDef InjDef | INone + +newtype StructError = StructError String +instance Show StructError where show (StructError m) = m +instance Exception StructError + +-- --------------------------------------------------------------------------- +-- Constants +-- --------------------------------------------------------------------------- + +m_keypre, m_keypost, m_val :: Int +m_keypre = 1 +m_keypost = 2 +m_val = 4 + +s_dkey, s_banno, s_dtop, s_derrs, s_dspec, s_bexact, s_bval, s_bkey, s_bopen :: String +s_dkey = "$KEY" +s_banno = "`$ANNO`" +s_dtop = "$TOP" +s_derrs = "$ERRS" +s_dspec = "$SPEC" +s_bexact = "`$EXACT`" +s_bval = "`$VAL`" +s_bkey = "`$KEY`" +s_bopen = "`$OPEN`" + +s_mt, s_bt, s_ds, s_dt, s_cn, s_fs, s_key, s_viz :: String +s_mt = "" +s_bt = "`" +s_ds = "$" +s_dt = "." +s_cn = ":" +s_fs = "/" +s_key = "KEY" +s_viz = ": " + +s_string, s_object, s_list, s_map, s_nil, s_null :: String +s_string = "string" +s_object = "object" +s_list = "list" +s_map = "map" +s_nil = "nil" +s_null = "null" + +cross :: String +cross = "\10799" -- U+2A2F vector cross product (select error messages) + +t_any, t_noval, t_boolean, t_decimal, t_integer, t_number, t_string :: Int +t_function, t_null, t_list, t_map, t_instance, t_scalar, t_node :: Int +t_any = 0x7FFFFFFF +t_noval = 0x40000000 +t_boolean = 0x20000000 +t_decimal = 0x10000000 +t_integer = 0x08000000 +t_number = 0x04000000 +t_string = 0x02000000 +t_function = 0x01000000 +t_null = 0x00400000 +t_list = 0x00004000 +t_map = 0x00002000 +t_instance = 0x00001000 +t_scalar = 0x00000080 +t_node = 0x00000040 + +typenameTbl :: [String] +typenameTbl = + [ "any", "nil", "boolean", "decimal", "integer", "number", "string", "function" + , "symbol", "null", "", "", "", "", "", "", "", "list", "map", "instance" + , "", "", "", "", "scalar", "node" ] + +skip, delete :: Value +skip = VSentinel "skip" +delete = VSentinel "delete" + +maxdepth :: Int +maxdepth = 32 + +-- --------------------------------------------------------------------------- +-- Small helpers +-- --------------------------------------------------------------------------- + +mkList :: [Value] -> IO Value +mkList xs = VList <$> newIORef xs + +mkMap :: [(String, Value)] -> IO Value +mkMap es = VMap <$> newIORef es + +emptyList :: IO Value +emptyList = mkList [] + +emptyMap :: IO Value +emptyMap = mkMap [] + +vint :: Int -> Value +vint i = VNum (fromIntegral i) + +listItems :: Value -> IO [Value] +listItems (VList r) = readIORef r +listItems _ = return [] + +mapEntries :: Value -> IO [(String, Value)] +mapEntries (VMap m) = readIORef m +mapEntries _ = return [] + +isNoval :: Value -> Bool +isNoval VNoval = True +isNoval _ = False + +isNullish :: Value -> Bool +isNullish VNoval = True +isNullish VNull = True +isNullish _ = False + +is_skip :: Value -> Bool +is_skip (VSentinel "skip") = True +is_skip _ = False + +is_delete :: Value -> Bool +is_delete (VSentinel "delete") = True +is_delete _ = False + +vStrEq :: Value -> String -> Bool +vStrEq (VStr s) t = s == t +vStrEq _ _ = False + +vIsTrue :: Value -> Bool +vIsTrue (VBool True) = True +vIsTrue _ = False + +isStr :: Value -> Bool +isStr (VStr _) = True +isStr _ = False + +readIntOpt :: String -> Maybe Int +readIntOpt s = readMaybe (dropPlus s) + where dropPlus ('+':r) = r + dropPlus x = x + +setAt :: Int -> a -> [a] -> [a] +setAt i v xs = [if j == i then v else x | (j, x) <- zip [0 ..] xs] + +opPut :: String -> Value -> [(String, Value)] -> [(String, Value)] +opPut k v es = + if any ((== k) . fst) es + then map (\(k', v') -> if k' == k then (k, v) else (k', v')) es + else es ++ [(k, v)] + +opDel :: String -> [(String, Value)] -> [(String, Value)] +opDel k = L.filter ((/= k) . fst) + +anyM :: (a -> IO Bool) -> [a] -> IO Bool +anyM _ [] = return False +anyM f (x:xs) = do b <- f x; if b then return True else anyM f xs + +andM :: [IO Bool] -> IO Bool +andM [] = return True +andM (m:ms) = do b <- m; if b then andM ms else return False + +isIntegerF :: Double -> Bool +isIntegerF n = not (isNaN n) && not (isInfinite n) && n == fromIntegral (truncate n :: Integer) + +numToString :: Double -> String +numToString n + | isNaN n = "NaN" + | isIntegerF n && abs n < 1e16 = show (truncate n :: Integer) + | otherwise = shortest 1 + where + shortest p + | p > 17 = printf "%.17g" n + | otherwise = + let s = printf ("%." ++ show (p :: Int) ++ "g") n :: String + in if (readMaybe s :: Maybe Double) == Just n then s else shortest (p + 1) + +floorNumStr :: Double -> String +floorNumStr n = numToString (fromIntegral (floor n :: Integer)) + +-- JS `'' + v` / String(v) for keys and concatenation. +jsString :: Value -> IO String +jsString v = case v of + VNoval -> return "undefined" + VNull -> return "null" + VBool b -> return (if b then "true" else "false") + VNum n -> return (numToString n) + VStr s -> return s + VFunc _ -> return "function" + VSentinel s -> return s + VMap _ -> return "[object Object]" + VList r -> do + items <- readIORef r + parts <- mapM (\x -> case x of VNoval -> return ""; VNull -> return ""; _ -> jsString x) items + return (intercalate "," parts) + +-- pure String(v) for scalar values (the node cases never reach here) +jsstrPure :: Value -> String +jsstrPure v = case v of + VNoval -> "undefined" + VNull -> "null" + VBool b -> if b then "true" else "false" + VNum n -> numToString n + VStr s -> s + VFunc _ -> "function" + VSentinel s -> s + _ -> "" + +isIntKey :: String -> Bool +isIntKey s = not (null s) && all (\c -> (c >= '0' && c <= '9') || c == '-') s + +clz32 :: Int -> Int +clz32 n0 = + let n = n0 .&. 0xFFFFFFFF + in if n == 0 then 32 else go n 0 + where + go n r = if (n .&. 0x80000000) /= 0 then r else go ((n `shiftL` 1) .&. 0xFFFFFFFF) (r + 1) + +splitOn :: Char -> String -> [String] +splitOn c s = case break (== c) s of + (a, []) -> [a] + (a, _:rest) -> a : splitOn c rest + +isPrefixOf' :: String -> String -> Bool +isPrefixOf' = isPrefixOf + +replaceAll :: String -> String -> String -> String +replaceAll s find_ repl + | null find_ = s + | otherwise = go s + where + flen = length find_ + go [] = [] + go str@(c:rest) = + if find_ `isPrefixOf` str then repl ++ go (drop flen str) else c : go rest + +-- --------------------------------------------------------------------------- +-- Minor utilities +-- --------------------------------------------------------------------------- + +isnode :: Value -> Bool +isnode (VMap _) = True +isnode (VList _) = True +isnode _ = False + +ismap :: Value -> Bool +ismap (VMap _) = True +ismap _ = False + +islist :: Value -> Bool +islist (VList _) = True +islist _ = False + +isfunc :: Value -> Bool +isfunc (VFunc _) = True +isfunc _ = False + +iskey :: Value -> Bool +iskey (VStr s) = s /= "" +iskey (VNum _) = True +iskey _ = False + +isempty :: Value -> IO Bool +isempty v = case v of + VNoval -> return True + VNull -> return True + VStr s -> return (s == "") + VList r -> null <$> readIORef r + VMap m -> null <$> readIORef m + _ -> return False + +getdef :: Value -> Value -> Value +getdef v alt = if isNoval v then alt else v + +typify :: Value -> Int +typify v = case v of + VNoval -> t_noval + VNull -> t_scalar .|. t_null + VBool _ -> t_scalar .|. t_boolean + VNum n -> if isNaN n then t_noval + else if isIntegerF n then t_scalar .|. t_number .|. t_integer + else t_scalar .|. t_number .|. t_decimal + VStr _ -> t_scalar .|. t_string + VFunc _ -> t_scalar .|. t_function + VList _ -> t_node .|. t_list + VMap _ -> t_node .|. t_map + VSentinel _ -> t_node .|. t_map + +typename :: Int -> String +typename t = + let i = clz32 t + in if i >= 0 && i < length typenameTbl then typenameTbl !! i else head typenameTbl + +size :: Value -> IO Int +size v = case v of + VList r -> length <$> readIORef r + VMap m -> length <$> readIORef m + VStr s -> return (length s) + VBool b -> return (if b then 1 else 0) + VNum n -> return (floor n) + _ -> return 0 + +strkey :: Value -> String +strkey key = case key of + VNoval -> s_mt + VStr s -> s + VBool _ -> s_mt + VNum n -> if isIntegerF n then numToString n else floorNumStr n + _ -> s_mt + +keysof :: Value -> IO [String] +keysof v = case v of + VMap m -> sort . map fst <$> readIORef m + VList r -> do items <- readIORef r; return [show i | i <- [0 .. length items - 1]] + _ -> return [] + +listIndex :: IORef [Value] -> Value -> IO Value +listIndex r key = do + let ks = case key of VStr s -> s; VNum n -> numToString n; _ -> "" + items <- readIORef r + case readIntOpt ks of + Just i | i >= 0 && i < length items -> return (items !! i) + _ -> return VNoval + +getpropAlt :: Value -> Value -> Value -> IO Value +getpropAlt alt v key + | isNoval v || isNoval key = return alt + | otherwise = do + out <- case v of + VMap m -> do k <- jsString key; fromMaybe VNoval . lookup k <$> readIORef m + VList r -> listIndex r key + _ -> return VNoval + return (if isNullish out then alt else out) + +getprop :: Value -> Value -> IO Value +getprop = getpropAlt VNoval + +lookup_ :: Value -> Value -> IO Value +lookup_ v key + | isNoval v || isNoval key = return VNoval + | otherwise = case v of + VMap m -> do k <- jsString key; fromMaybe VNoval . lookup k <$> readIORef m + VList r -> listIndex r key + _ -> return VNoval + +haskey :: Value -> Value -> IO Bool +haskey v key = (not . isNullish) <$> getprop v key + +getelemAlt :: Value -> Value -> Value -> IO Value +getelemAlt alt v key + | isNoval v || isNoval key = return alt + | otherwise = do + out <- case v of + VList r -> do + let ks = case key of VStr s -> s; VNum n -> numToString n; _ -> "" + if isIntKey ks + then do + items <- readIORef r + let len = length items + case readIntOpt ks of + Just nk0 -> let nk = if nk0 < 0 then len + nk0 else nk0 + in return (if nk >= 0 && nk < len then items !! nk else VNoval) + Nothing -> return VNoval + else return VNoval + _ -> return VNoval + if isNullish out + then case alt of VFunc f -> f dummyInj VNoval "" VNoval; _ -> return alt + else return out + +getelem :: Value -> Value -> IO Value +getelem = getelemAlt VNoval + +getpropRaw :: Value -> String -> IO Value +getpropRaw v k = case v of + VMap m -> fromMaybe VNoval . lookup k <$> readIORef m + VList r -> do + items <- readIORef r + case readIntOpt k of + Just i | i >= 0 && i < length items -> return (items !! i) + _ -> return VNoval + _ -> return VNoval + +itemsPairs :: Value -> IO [(String, Value)] +itemsPairs v = + if not (isnode v) then return [] + else do ks <- keysof v; mapM (\k -> (,) k <$> getpropRaw v k) ks + +items :: Value -> IO Value +items v = do + ps <- itemsPairs v + xs <- mapM (\(k, x) -> mkList [VStr k, x]) ps + mkList xs + +itemsV :: Value -> ((String, Value) -> Value) -> IO Value +itemsV v f = do ps <- itemsPairs v; mkList (map f ps) + +flatten :: Int -> Value -> IO Value +flatten depth l = + if not (islist l) then return l + else do + its <- listItems l + out <- foldM go [] its + mkList out + where + go acc item = + if islist item && depth > 0 + then do f <- flatten (depth - 1) item; fis <- listItems f; return (acc ++ fis) + else return (acc ++ [item]) + +filter :: Value -> ((String, Value) -> Bool) -> IO Value +filter v check = do + ps <- itemsPairs v + mkList [x | (k, x) <- ps, check (k, x)] + +setprop :: Value -> Value -> Value -> IO Value +setprop parent key v + | not (iskey key) = return parent + | otherwise = do + case parent of + VMap m -> do k <- jsString key; modifyIORef' m (opPut k v) + VList r -> do + let ks = case key of VStr s -> s; VNum n -> floorNumStr n; _ -> "" + case readIntOpt ks of + Nothing -> return () + Just ki -> do + its <- readIORef r + let len = length its + if ki >= 0 + then let ki' = if ki > len then len else ki + in if ki' >= len then writeIORef r (its ++ [v]) else writeIORef r (setAt ki' v its) + else writeIORef r (v : its) + _ -> return () + return parent + +delprop :: Value -> Value -> IO Value +delprop parent key + | not (iskey key) = return parent + | otherwise = do + case parent of + VMap m -> do k <- jsString key; modifyIORef' m (opDel k) + VList r -> do + let ks = case key of VStr s -> s; VNum n -> floorNumStr n; _ -> "" + case readIntOpt ks of + Just ki | ki >= 0 -> do + its <- readIORef r + when (ki < length its) $ writeIORef r [x | (j, x) <- zip [0 ..] its, j /= ki] + _ -> return () + _ -> return () + return parent + +clone :: Value -> IO Value +clone v = case v of + VList r -> do its <- readIORef r; xs <- mapM clone its; mkList xs + VMap m -> do es <- readIORef m; es' <- mapM (\(k, x) -> (,) k <$> clone x) es; mkMap es' + _ -> return v + +sliceM :: Value -> Value -> Value -> Bool -> IO Value +sliceM v start stop mutate = case v of + VNum n -> do + let lo = case start of VNum s -> s; _ -> -(1 / 0) + hi = case stop of VNum e -> e - 1; _ -> 1 / 0 + return (VNum (max lo (min n hi))) + _ | islist v || isStr v -> do + vlen <- size v + let start' = case (start, stop) of (VNoval, x) | not (isNoval x) -> VNum 0; _ -> start + case start' of + VNum sf -> do + let s0 = truncate sf :: Int + (s1, e1) = + if s0 < 0 then (0, let e = vlen + s0 in if e < 0 then 0 else e) + else case stop of + VNum ef -> let e = truncate ef :: Int + in if e < 0 then (s0, let e2 = vlen + e in if e2 < 0 then 0 else e2) + else if vlen < e then (s0, vlen) else (s0, e) + _ -> (s0, vlen) + s2 = if vlen < s1 then vlen else s1 + if s2 > -1 && s2 <= e1 && e1 <= vlen + then case v of + VList r -> do its <- readIORef r + let sub = take (e1 - s2) (drop s2 its) + if mutate then writeIORef r sub >> return v else mkList sub + VStr str -> return (VStr (take (e1 - s2) (drop s2 str))) + _ -> return v + else case v of + VList r -> if mutate then writeIORef r [] >> return v else emptyList + VStr _ -> return (VStr "") + _ -> return v + _ -> return v + _ -> return v + +slice :: Value -> Value -> Value -> IO Value +slice v start stop = sliceM v start stop False + +-- ----- regex helpers (uniform re_* API + in-tree Vregex) ----- + +reStr :: Value -> IO String +reStr p = case p of VStr s -> return s; _ -> jsString p + +re_compile :: Value -> IO Value +re_compile p = case p of VStr _ -> return p; _ -> VStr <$> jsString p + +re_test :: Value -> Value -> IO Value +re_test p input = do ps <- reStr p; is <- reStr input; return (VBool (Vregex.testStr ps is)) + +re_find :: Value -> Value -> IO Value +re_find p input = do + ps <- reStr p + is <- reStr input + case Vregex.findBounds (Vregex.compile ps) is of + Just (s, e) -> mkList [VStr (take (e - s) (drop s is))] + Nothing -> return VNull + +re_find_all :: Value -> Value -> IO Value +re_find_all _ _ = emptyList + +re_replace :: Value -> Value -> Value -> IO Value +re_replace _ input _ = return input + +re_escape :: Value -> IO Value +re_escape = escre + +escre :: Value -> IO Value +escre s = do + str <- case s of VStr x -> return x; VNoval -> return s_mt; _ -> jsString s + return $ VStr $ concatMap (\c -> if c `elem` ".*+?^${}()|[]\\" then ['\\', c] else [c]) str + +escurl :: Value -> IO Value +escurl s = do + str <- case s of VStr x -> return x; VNoval -> return s_mt; _ -> jsString s + return $ VStr $ concatMap enc str + where + enc c = if unreserved c then [c] else '%' : (printf "%02X" (fromEnum c) :: String) + unreserved c = (c >= 'A' && c <= 'Z') || (c >= 'a' && c <= 'z') + || (c >= '0' && c <= '9') || c `elem` "-_.!~*'()" + +-- ----- json_encode / stringify / jsonify / pad / join / pathify ----- + +pad4hex :: Int -> String +pad4hex n = let h = showHex n "" in replicate (4 - length h) '0' ++ h + +jsonEncode :: Bool -> Maybe Int -> Value -> IO String +jsonEncode srt indent = \v -> enc v 0 + where + esc s = '"' : concatMap escc s ++ "\"" + escc c = case c of + '"' -> "\\\"" + '\\' -> "\\\\" + '\n' -> "\\n" + '\r' -> "\\r" + '\t' -> "\\t" + _ | fromEnum c < 32 -> "\\u" ++ pad4hex (fromEnum c) + | otherwise -> [c] + enc val level = case val of + VNoval -> return "null" + VNull -> return "null" + VBool b -> return (if b then "true" else "false") + VNum n -> return (numToString n) + VStr s -> return (esc s) + VFunc _ -> return "null" + VSentinel _ -> return "null" + VList r -> do + its <- readIORef r + if null its then return "[]" else case indent of + Just ind -> do + let pad = replicate (ind * (level + 1)) ' ' + cpad = replicate (ind * level) ' ' + parts <- mapM (\x -> (pad ++) <$> enc x (level + 1)) its + return ("[\n" ++ intercalate ",\n" parts ++ "\n" ++ cpad ++ "]") + Nothing -> do + parts <- mapM (\x -> enc x (level + 1)) its + return ("[" ++ intercalate "," parts ++ "]") + VMap m -> do + es <- readIORef m + let ks0 = map fst es + ks = if srt then sort ks0 else ks0 + if null ks then return "{}" else case indent of + Just ind -> do + let pad = replicate (ind * (level + 1)) ' ' + cpad = replicate (ind * level) ' ' + parts <- mapM (\k -> do x <- maybe (return VNoval) return (lookup k es) + xs <- enc x (level + 1) + return (pad ++ esc k ++ ": " ++ xs)) ks + return ("{\n" ++ intercalate ",\n" parts ++ "\n" ++ cpad ++ "}") + Nothing -> do + parts <- mapM (\k -> do x <- maybe (return VNoval) return (lookup k es) + xs <- enc x (level + 1) + return (esc k ++ ":" ++ xs)) ks + return ("{" ++ intercalate "," parts ++ "}") + +hasCycle :: Value -> IO Bool +hasCycle v0 = do + seen <- newIORef [] + let sameNode (VList a) (VList b) = a == b + sameNode (VMap a) (VMap b) = a == b + sameNode _ _ = False + go v = case v of + VList r -> do + s <- readIORef seen + if any (sameNode v) s then return True + else do modifyIORef' seen (v :); xs <- readIORef r; anyM go xs + VMap m -> do + s <- readIORef seen + if any (sameNode v) s then return True + else do modifyIORef' seen (v :); es <- readIORef m; anyM (go . snd) es + _ -> return False + go v0 + +prettyColor :: String -> String +prettyColor valstr = + let colors = [81, 118, 213, 39, 208, 201, 45, 190, 129, 51, 160, 121, 226, 33, 207, 69] + c = map (\n -> "\ESC[38;5;" ++ show (n :: Int) ++ "m") colors + clen = length c + r = "\ESC[0m" + step (d, o, t) ch + | ch == '{' || ch == '[' = let d2 = d + 1; o2 = c !! (d2 `mod` clen) in (d2, o2, t ++ o2 ++ [ch]) + | ch == '}' || ch == ']' = let t2 = t ++ o ++ [ch]; d2 = d - 1; o2 = c !! (((d2 `mod` clen) + clen) `mod` clen) in (d2, o2, t2) + | otherwise = (d, o, t ++ o ++ [ch]) + (_, _, res) = foldl step (0 :: Int, head c, head c) valstr + in res ++ r + +stringifyFull :: Value -> Value -> Bool -> IO String +stringifyFull v maxlen pretty = case v of + VNoval -> return (if pretty then "<>" else s_mt) + _ -> do + valstr <- case v of + VStr s -> return s + _ -> do + cyc <- hasCycle v + if cyc then return "__STRINGIFY_FAILED__" + else do s <- jsonEncode True Nothing v; return (L.filter (/= '"') s) + let valstr2 = case maxlen of + VNum m | m > -1 -> let mi = truncate m; l = length valstr + in if mi < l then take (max 0 (mi - 3)) valstr ++ "..." else valstr + _ -> valstr + if pretty then return (prettyColor valstr2) else return valstr2 + +stringify :: Value -> IO String +stringify v = stringifyFull v VNoval False + +stringifyMax :: Value -> Value -> IO String +stringifyMax v maxlen = stringifyFull v maxlen False + +jsonify :: Value -> Value -> IO String +jsonify v flags = case v of + VNoval -> return s_null + _ -> do + indentV <- getpropAlt (VNum 2) flags (VStr "indent") + let indent = case indentV of VNum n -> truncate n; _ -> 2 + str <- if indent > 0 then jsonEncode False (Just indent) v else jsonEncode False Nothing v + offV <- getpropAlt (VNum 0) flags (VStr "offset") + let off = case offV of VNum n -> truncate n; _ -> 0 + if off > 0 + then case lines str of + (_:rest) -> return ("{\n" ++ intercalate "\n" (map (\l -> replicate off ' ' ++ l) rest)) + [] -> return str + else return str + +pad :: Value -> Value -> Value -> IO String +pad s padding padchar = do + str <- case s of VStr x -> return x; VNull -> return "null"; _ -> stringify s + let p = case padding of VNum n -> truncate n; _ -> 44 + pc = case padchar of VStr x -> take 1 (x ++ " "); _ -> " " + return $ if p > -1 + then let n = p - length str in if n > 0 then str ++ concat (replicate n pc) else str + else let n = (-p) - length str in if n > 0 then concat (replicate n pc) ++ str else str + +join :: Value -> Value -> Bool -> IO String +join arr sep url = + if not (islist arr) then return s_mt + else do + sepdef <- case sep of VNoval -> return ","; VNull -> return ","; VStr s -> return s; _ -> jsString sep + let single = length sepdef == 1 + sc = if single then head sepdef else ' ' + stripTrailing = reverse . dropWhile (== sc) . reverse + stripLeading = dropWhile (== sc) + collapse str = build 0 str + where + nn = length str + build i s = case s of + [] -> [] + (ch:_) | ch == sc -> + let run = takeWhile (== sc) s + j = i + length run + rest = drop (length run) s + in if i > 0 && j < nn then sc : build j rest else run ++ build j rest + _ -> let (seg, rest) = break (== sc) s in seg ++ build (i + length seg) rest + its <- listItems arr + let sarr = length its + process idx s0v = case s0v of + VStr s | s /= s_mt -> + let s1 = if single + then if url && idx == 0 then stripTrailing s + else let a = if idx > 0 then stripLeading s else s + b = if idx < sarr - 1 || not url then stripTrailing a else a + in collapse b + else s + in if s1 /= s_mt then [s1] else [] + _ -> [] + out = concat [process idx s0v | (idx, s0v) <- zip [0 ..] its] + return (intercalate sepdef out) + +joinurl :: Value -> IO String +joinurl arr = join arr (VStr "/") True + +replace :: Value -> Value -> Value -> IO String +replace s from_ to_ = do + let ts = typify s + rs <- if (t_string .&. ts) == 0 then stringify s + else if ((t_noval .|. t_null) .&. ts) > 0 then return s_mt + else stringify s + to_s <- case to_ of VStr x -> return x; _ -> jsString to_ + case from_ of + VStr f | f /= "" -> return (replaceAll rs f to_s) + _ -> return rs + +pathifyFull :: Value -> Value -> Value -> Bool -> IO String +pathifyFull v startin endin absent = do + mpath <- if islist v then Just <$> listItems v + else return (if iskey v then Just [v] else Nothing) + let start = case startin of VNum n -> if n > -1 then truncate n else 0; _ -> 0 + endn = case endin of VNum n -> if n > -1 then truncate n else 0; _ -> 0 + pstr <- case mpath of + Just p | start >= 0 -> do + let len = length p + e = max 0 (len - endn) + s = min start len + sub = if s <= e then take (e - s) (drop s p) else [] + if null sub then return (Just "") + else do + let fp = L.filter iskey sub + mapped = map (\pp -> case pp of + VNum n -> floorNumStr n + VStr x -> L.filter (/= '.') x + _ -> "") fp + return (Just (intercalate "." mapped)) + _ -> return Nothing + case pstr of + Just s -> return s + Nothing -> do + tl <- if absent then return s_mt else do st <- stringifyMax v (VNum 47); return (s_cn ++ st) + return ("") + +pathify :: Value -> IO String +pathify v = pathifyFull v VNoval VNoval False + +-- --------------------------------------------------------------------------- +-- walk / merge +-- --------------------------------------------------------------------------- + +type WalkFn = Value -> Value -> Value -> Value -> IO Value + +walk :: Maybe WalkFn -> Maybe WalkFn -> Value -> Value -> IO Value +walk before after md v = walkImpl before after md VNoval VNoval Nothing v + +walkImpl :: Maybe WalkFn -> Maybe WalkFn -> Value -> Value -> Value -> Maybe Value -> Value -> IO Value +walkImpl before after md key parent mpath v = do + path <- maybe emptyList return mpath + depth <- size path + out0 <- case before of Nothing -> return v; Just f -> f key v parent path + let mdv = case md of VNum n -> if n >= 0 then truncate n else maxdepth; _ -> maxdepth + if mdv == 0 || (mdv > 0 && mdv <= depth) + then return out0 + else do + when (isnode out0) $ do + prefix <- listItems path + ps <- itemsPairs out0 + forM_ ps $ \(ckey, child) -> do + childpath <- mkList (prefix ++ [VStr ckey]) + result <- walkImpl before after (VNum (fromIntegral mdv)) (VStr ckey) out0 (Just childpath) child + case out0 of + VMap m -> modifyIORef' m (opPut ckey result) + VList r -> modifyIORef' r (\xs -> [if i == read ckey then result else x | (i, x) <- zip [0 ..] xs]) + _ -> return () + case after of Nothing -> return out0; Just f -> f key out0 parent path + +mergeD :: Value -> Value -> IO Value +mergeD objs maxd = do + let md = case maxd of VNum n -> if n < 0 then 0 else truncate n; _ -> 32 + if not (islist objs) then return objs + else do + l <- listItems objs + let lenlist = length l + if lenlist == 0 then return VNoval + else if lenlist == 1 then return (head l) + else do + out0 <- do em <- emptyMap; getpropAlt em objs (VNum 0) + outRef <- newIORef out0 + forM_ [1 .. lenlist - 1] $ \oi -> do + let obj = l !! oi + if not (isnode obj) then writeIORef outRef obj + else do + o <- readIORef outRef + cur <- newIORef [o] + dst <- newIORef [o] + let grow ref nn = do a <- readIORef ref; when (length a <= nn) (writeIORef ref (a ++ replicate (nn + 1 - length a) VNoval)) + before key vv _parent path = do + pii <- size path + if md <= pii then do + grow cur pii + modifyIORef' cur (setAt pii vv) + when (pii > 0) $ do c <- readIORef cur; _ <- setprop (c !! (pii - 1)) key vv; return () + return VNoval + else if not (isnode vv) then do + grow cur pii; modifyIORef' cur (setAt pii vv); return vv + else do + grow dst pii; grow cur pii + dpi <- if pii > 0 then do d <- readIORef dst; getprop (d !! (pii - 1)) key + else do d <- readIORef dst; return (d !! pii) + modifyIORef' dst (setAt pii dpi) + let tval = dpi + if isNullish tval then do + nn <- if islist vv then emptyList else emptyMap + modifyIORef' cur (setAt pii nn); return vv + else if (islist vv && islist tval) || (ismap vv && ismap tval) then do + modifyIORef' cur (setAt pii tval); return vv + else do + modifyIORef' cur (setAt pii vv); return VNoval + after key vv _parent path = do + ci <- size path + if ci < 1 then do c <- readIORef cur; return (if not (null c) then head c else vv) + else do + c <- readIORef cur + let target = if ci - 1 < length c then c !! (ci - 1) else VNoval + value = if ci < length c then c !! ci else VNoval + _ <- setprop target key value + return value + res <- walk (Just before) (Just after) VNoval obj + writeIORef outRef res + when (md == 0) $ do + o <- getprop objs (VNum (fromIntegral (lenlist - 1))) + nn <- if islist o then emptyList else if ismap o then emptyMap else return o + writeIORef outRef nn + readIORef outRef + +merge :: Value -> IO Value +merge objs = mergeD objs VNoval + +-- --------------------------------------------------------------------------- +-- getpath / setpath +-- --------------------------------------------------------------------------- + +iaBase, iaDparent, iaMeta, iaKey, iaDpath :: InjArg -> IO Value +iaBase ia = case ia of IInj i -> readIORef (iBase i); IDef d -> return (dBase d); INone -> return VNoval +iaDparent ia = case ia of IInj i -> readIORef (iDparent i); IDef d -> return (dDparent d); INone -> return VNoval +iaMeta ia = case ia of IInj i -> readIORef (iMeta i); IDef d -> return (dMeta d); INone -> return VNoval +iaKey ia = case ia of IInj i -> readIORef (iKey i); IDef d -> return (dKey d); INone -> return VNoval +iaDpath ia = case ia of IInj i -> readIORef (iDpath i); IDef d -> return (dDpath d); INone -> return VNoval + +iaHandler :: InjArg -> IO (Maybe Injector) +iaHandler ia = case ia of IInj i -> Just <$> readIORef (iHandler i); IDef d -> return (dHandler d); INone -> return Nothing + +iaIsSome :: InjArg -> Bool +iaIsSome INone = False +iaIsSome _ = True + +metaPathMatch :: String -> Maybe (String, String, String) +metaPathMatch s = case break (== '$') s of + (pre, '$':rest) | not (null pre) -> + case rest of + (op:after) | (op == '=' || op == '~') && not (null after) -> Just (pre, [op], after) + _ -> Nothing + _ -> Nothing + +getpath :: InjArg -> Value -> Value -> IO Value +getpath inj store path = do + mpa <- case path of + VList r -> Just <$> readIORef r + VStr s -> return (Just (map VStr (splitOn '.' s))) + VNum n -> return (Just [VStr (strkey (VNum n))]) + _ -> return Nothing + case mpa of + Nothing -> return VNoval + Just pa0 -> do + base <- iaBase inj + dparent <- iaDparent inj + injMeta <- iaMeta inj + injKey <- iaKey inj + dpath <- iaDpath inj + src <- if iskey base then getpropAlt store store base else return store + let numparts = length pa0 + paRef <- newIORef pa0 + vRef <- newIORef store + let arrGet i = do pa <- readIORef paRef; return (if i >= 0 && i < length pa then pa !! i else VNoval) + p0init <- arrGet 0 + if isNoval path || isNoval store || (numparts == 1 && vStrEq p0init s_mt) || numparts == 0 + then writeIORef vRef src + else do + when (numparts == 1) $ do p0 <- arrGet 0; gv <- getprop store p0; writeIORef vRef gv + vcur <- readIORef vRef + if isfunc vcur then return () + else do + writeIORef vRef src + p0 <- arrGet 0 + case p0 of + VStr s0 -> case metaPathMatch s0 of + Just (g1, _, g3) | not (isNoval injMeta) && iaIsSome inj -> do + mv <- getprop injMeta (VStr g1); writeIORef vRef mv + modifyIORef' paRef (setAt 0 (VStr g3)) + _ -> return () + _ -> return () + let countAsc p acc = do nxt <- arrGet (p + 1); if vStrEq nxt s_mt then countAsc (p + 1) (acc + 1) else return (acc, p) + loop pii = do + vc <- readIORef vRef + if isNoval vc || pii >= numparts then return () + else do + raw <- arrGet pii + part0 <- case raw of + VStr s | iaIsSome inj && s == s_dkey -> return (if not (isNoval injKey) then injKey else raw) + VStr s | "$GET:" `isPrefixOf` s -> do sl <- sliceM (VStr s) (VNum 5) (VNum (-1)) False; gp <- getpath INone src sl; VStr <$> stringify gp + VStr s | "$REF:" `isPrefixOf` s -> do sl <- sliceM (VStr s) (VNum 5) (VNum (-1)) False; sp <- getprop store (VStr s_dspec); gp <- getpath INone sp sl; VStr <$> stringify gp + VStr s | iaIsSome inj && "$META:" `isPrefixOf` s -> do sl <- sliceM (VStr s) (VNum 6) (VNum (-1)) False; gp <- getpath INone injMeta sl; VStr <$> stringify gp + _ -> return raw + let part = case part0 of VStr s -> VStr (replaceAll s "$$" "$"); _ -> VStr (strkey part0) + if vStrEq part s_mt then do + (ascends0, pii2) <- countAsc pii 0 + if iaIsSome inj && ascends0 > 0 then do + let ascends = if pii2 == numparts - 1 then ascends0 - 1 else ascends0 + if ascends == 0 then do writeIORef vRef dparent; loop (pii2 + 1) + else do + pa2 <- readIORef paRef + let tailparts = drop (pii2 + 1) pa2 + sl <- sliceM dpath (VNum (fromIntegral (negate ascends))) VNoval False + tl <- mkList tailparts + inner <- mkList [sl, tl] + fullpath <- flatten 1 inner + dsz <- size dpath + if ascends <= dsz then do gp <- getpath INone store fullpath; writeIORef vRef gp + else writeIORef vRef VNoval + else do writeIORef vRef dparent; loop (pii2 + 1) + else do + gp <- getprop vc part; writeIORef vRef gp; loop (pii + 1) + loop 0 + mh <- iaHandler inj + case mh of + Just h | iaIsSome inj -> do + refp <- pathify path + vc <- readIORef vRef + case inj of + IInj i -> do r <- h i vc refp store; writeIORef vRef r + _ -> do r <- h dummyInj vc refp store; writeIORef vRef r + _ -> return () + readIORef vRef + +setpath :: Value -> Value -> Value -> IO Value +setpath store path v = do + let ptype = typify path + parts <- if (t_list .&. ptype) > 0 then (listItems path >>= mkList) + else if (t_string .&. ptype) > 0 then (case path of VStr s -> mkList (map VStr (splitOn '.' s)); _ -> emptyList) + else if (t_number .&. ptype) > 0 then mkList [path] + else return VNoval + if isNoval parts then return VNoval + else do + numparts <- size parts + parentRef <- newIORef store + forM_ [0 .. numparts - 2] $ \pii -> do + parent <- readIORef parentRef + pkey <- getelem parts (VNum (fromIntegral pii)) + np0 <- getprop parent pkey + np <- if not (isnode np0) then do + nextpart <- getelem parts (VNum (fromIntegral (pii + 1))) + nn <- if (t_number .&. typify nextpart) > 0 then emptyList else emptyMap + _ <- setprop parent pkey nn; return nn + else return np0 + writeIORef parentRef np + parent <- readIORef parentRef + lastkey <- getelem parts (VNum (-1)) + if is_delete v then delprop parent lastkey >> return parent + else setprop parent lastkey v >> return parent + +-- --------------------------------------------------------------------------- +-- string-pattern helpers (RE2-subset-free) +-- --------------------------------------------------------------------------- + +injectionFull :: String -> Maybe String +injectionFull s = + let n = length s + in if n >= 2 && head s == '`' && last s == '`' + then let inner = take (n - 2) (drop 1 s) + in if '`' `elem` inner then Nothing + else if isDollarUpper inner then Just (takeDollarName inner) else Just inner + else Nothing + where + upper c = c >= 'A' && c <= 'Z' + digit c = c >= '0' && c <= '9' + lengthLetters str j = if j < length str && upper (str !! j) then lengthLetters str (j + 1) else j + lettersDigits str k = if k < length str && digit (str !! k) then lettersDigits str (k + 1) else k + isDollarUpper inner = + length inner > 1 && head inner == '$' && + let le = lengthLetters inner 1 + in le > 1 && lettersDigits inner le == length inner + takeDollarName inner = take (lengthLetters inner 1) inner + +injectionPartialReplace :: String -> (String -> IO String) -> IO String +injectionPartialReplace s f = go s + where + go [] = return [] + go ('`':rest) = case break (== '`') rest of + (inner, '`':rest2) -> do r <- f inner; rs <- go rest2; return (r ++ rs) + (_, []) -> do rs <- go rest; return ('`' : rs) + go (c:rest) = (c :) <$> go rest + +replaceTransformNames :: String -> String +replaceTransformNames = go + where + upper c = c >= 'A' && c <= 'Z' + go [] = [] + go ('`':'$':rest) = + let (letters, rest2) = span upper rest + in case rest2 of + ('`':rest3) | not (null letters) -> map toLower letters ++ go rest3 + _ -> '`' : go ('$':rest) + go (c:rest) = c : go rest + +-- --------------------------------------------------------------------------- +-- Injection state +-- --------------------------------------------------------------------------- + +newInj :: Value -> Value -> IO Inj +newInj v parent = do + keys <- mkList [VStr s_dtop] + path <- mkList [VStr s_dtop] + nodes <- mkList [parent] + errs <- emptyList + meta <- emptyMap + dpath <- mkList [VStr s_dtop] + Inj <$> newIORef m_val <*> newIORef False <*> newIORef 0 + <*> newIORef keys <*> newIORef (VStr s_dtop) <*> newIORef v + <*> newIORef parent <*> newIORef path <*> newIORef nodes + <*> newIORef injectHandler <*> newIORef errs <*> newIORef meta + <*> newIORef VNoval <*> newIORef dpath <*> newIORef (VStr s_dtop) + <*> newIORef Nothing <*> newIORef Nothing <*> newIORef VNoval + +injDescend :: Inj -> IO Value +injDescend inj = do + meta <- readIORef (iMeta inj) + case meta of + VMap _ -> do + d <- getpropRaw meta "__d" + let dn = case d of VNum n -> n; _ -> 0 + _ <- setprop meta (VStr "__d") (VNum (dn + 1)); return () + _ -> return () + path <- readIORef (iPath inj) + parentkey <- getelem path (VNum (-2)) + dparent <- readIORef (iDparent inj) + if isNoval dparent then do + dpath <- readIORef (iDpath inj) + sz <- size dpath + when (sz > 1) $ do its <- listItems dpath; nl <- mkList (its ++ [parentkey]); writeIORef (iDpath inj) nl + else when (not (isNoval parentkey)) $ do + dp <- getprop dparent parentkey; writeIORef (iDparent inj) dp + dpath <- readIORef (iDpath inj) + lastpart <- getelem dpath (VNum (-1)) + pk <- jsString parentkey + if vStrEq lastpart ("$:" ++ pk) + then do sl <- sliceM dpath (VNum (-1)) VNoval False; writeIORef (iDpath inj) sl + else do its <- listItems dpath; nl <- mkList (its ++ [parentkey]); writeIORef (iDpath inj) nl + readIORef (iDparent inj) + +injChild :: Inj -> Int -> Value -> IO Inj +injChild inj keyi keys = do + kv <- getelem keys (VNum (fromIntegral keyi)) + let key = strkey kv + v <- readIORef (iIval inj) + ival <- getprop v (VStr key) + ipath <- readIORef (iPath inj); pitems <- listItems ipath; npath <- mkList (pitems ++ [VStr key]) + inodes <- readIORef (iNodes inj); nitems <- listItems inodes; nnodes <- mkList (nitems ++ [v]) + idpath <- readIORef (iDpath inj); ditems <- listItems idpath; ndpath <- mkList ditems + mode <- readIORef (iMode inj); full <- readIORef (iFull inj); handler <- readIORef (iHandler inj) + errs <- readIORef (iErrs inj); meta <- readIORef (iMeta inj); base <- readIORef (iBase inj) + modify <- readIORef (iModify inj); dparent <- readIORef (iDparent inj); extra <- readIORef (iExtra inj) + Inj <$> newIORef mode <*> newIORef full <*> newIORef keyi + <*> newIORef keys <*> newIORef (VStr key) <*> newIORef ival + <*> newIORef v <*> newIORef npath <*> newIORef nnodes + <*> newIORef handler <*> newIORef errs <*> newIORef meta + <*> newIORef dparent <*> newIORef ndpath <*> newIORef base + <*> newIORef modify <*> newIORef (Just inj) <*> newIORef extra + +injSetval :: Int -> Inj -> Value -> IO Value +injSetval ancestor inj v = do + (target, key) <- if ancestor < 2 + then do p <- readIORef (iParent inj); k <- readIORef (iKey inj); return (p, k) + else do ns <- readIORef (iNodes inj); ps <- readIORef (iPath inj) + t <- getelem ns (VNum (fromIntegral (negate ancestor))) + k <- getelem ps (VNum (fromIntegral (negate ancestor))) + return (t, k) + if isNoval v then delprop target key else setprop target key v + +injSetval1 :: Inj -> Value -> IO Value +injSetval1 = injSetval 1 + +dummyInj :: Inj +dummyInj = unsafePerformIO $ do + parent <- mkMap [(s_dtop, VNoval)] + newInj VNoval parent +{-# NOINLINE dummyInj #-} + +-- --------------------------------------------------------------------------- +-- inject +-- --------------------------------------------------------------------------- + +inject :: InjArg -> Value -> Value -> IO Value +inject injarg v store = do + state <- case injarg of + IInj i -> return i + _ -> do + parent <- mkMap [(s_dtop, v)] + i <- newInj v parent + writeIORef (iDparent i) store + el <- emptyList + errs <- getpropAlt el store (VStr s_derrs) + writeIORef (iErrs i) errs + meta <- readIORef (iMeta i) + case meta of VMap _ -> setprop meta (VStr "__d") (VNum 0) >> return (); _ -> return () + case injarg of + IDef d -> do + case dModify d of Just _ -> writeIORef (iModify i) (dModify d); Nothing -> return () + when (not (isNoval (dExtra d))) $ writeIORef (iExtra i) (dExtra d) + when (not (isNoval (dMeta d))) $ writeIORef (iMeta i) (dMeta d) + case dHandler d of Just h -> writeIORef (iHandler i) h; Nothing -> return () + _ -> return () + return i + _ <- injDescend state + v' <- if isnode v then do + nodekeys0 <- case v of + VMap m -> do es <- readIORef m + let ks = map fst es + normal = sort (L.filter (notElem '$') ks) + trans = sort (L.filter (elem '$') ks) + return (normal ++ trans) + VList r -> do its <- readIORef r; return [show i | i <- [0 .. length its - 1]] + _ -> return [] + nkRef <- newIORef nodekeys0 + nkiRef <- newIORef 0 + let loop = do + nki <- readIORef nkiRef + nks <- readIORef nkRef + if nki >= length nks then return () + else do + keysv <- mkList (map VStr nks) + childinj <- injChild state nki keysv + nodekeyV <- readIORef (iKey childinj) + writeIORef (iMode childinj) m_keypre + nkstr <- jsString nodekeyV + prekey <- injectstr nkstr store (Just childinj) + ck <- readIORef (iKeys childinj); ckl <- listItems ck; ckls <- mapM jsString ckl + writeIORef nkRef ckls + when (not (isNoval prekey)) $ do + iv <- getprop v prekey + writeIORef (iIval childinj) iv + writeIORef (iMode childinj) m_val + _ <- inject (IInj childinj) iv store + ck2 <- readIORef (iKeys childinj); ckl2 <- listItems ck2; ckls2 <- mapM jsString ckl2 + writeIORef nkRef ckls2 + writeIORef (iMode childinj) m_keypost + _ <- injectstr nkstr store (Just childinj) + ck3 <- readIORef (iKeys childinj); ckl3 <- listItems ck3; ckls3 <- mapM jsString ckl3 + writeIORef nkRef ckls3 + cki <- readIORef (iKeyi childinj) + writeIORef nkiRef (cki + 1) + loop + loop + return v + else case v of + VStr _ -> do + writeIORef (iMode state) m_val + sv <- jsString v + nv <- injectstr sv store (Just state) + when (not (is_skip nv)) $ injSetval1 state nv >> return () + return nv + _ -> return v + modify <- readIORef (iModify state) + case modify of + Just f | not (is_skip v') -> do + mkey <- readIORef (iKey state); mparent <- readIORef (iParent state); mval <- getprop mparent mkey + f mval mkey mparent state + _ -> return () + writeIORef (iIval state) v' + parentS <- readIORef (iParent state) + lookup_ parentS (VStr s_dtop) + +injectHandler :: Injector +injectHandler inj v refstr store = do + let iscmd = isfunc v && (refstr == "" || s_ds `isPrefixOf` refstr) + if iscmd then case v of VFunc f -> f inj v refstr store; _ -> return v + else do + mode <- readIORef (iMode inj); full <- readIORef (iFull inj) + if mode == m_val && full then do _ <- injSetval1 inj v; return v else return v + +injectstr :: String -> Value -> Maybe Inj -> IO Value +injectstr v store injOpt = + if v == s_mt then return (VStr s_mt) + else case injectionFull v of + Just pathref0 -> do + case injOpt of Just i -> writeIORef (iFull i) True; Nothing -> return () + let pathref = if length pathref0 > 3 then replaceAll (replaceAll pathref0 "$BT" s_bt) "$DS" s_ds else pathref0 + ia = case injOpt of Just i -> IInj i; Nothing -> INone + getpath ia store (VStr pathref) + Nothing -> do + out <- injectionPartialReplace v $ \ref0 -> do + let refp = if length ref0 > 3 then replaceAll (replaceAll ref0 "$BT" s_bt) "$DS" s_ds else ref0 + case injOpt of Just i -> writeIORef (iFull i) False; Nothing -> return () + let ia = case injOpt of Just i -> IInj i; Nothing -> INone + found <- getpath ia store (VStr refp) + case found of + VNoval -> return s_mt + VStr s -> return (if s == "__NULL__" then "null" else s) + VFunc _ -> return s_mt + _ -> jsonEncode False Nothing found + case injOpt of + Just i -> do writeIORef (iFull i) True; h <- readIORef (iHandler i); h i (VStr out) v store + Nothing -> return (VStr out) + +-- --------------------------------------------------------------------------- +-- transform commands +-- --------------------------------------------------------------------------- + +transformDelete :: Injector +transformDelete inj _ _ _ = do p <- readIORef (iParent inj); k <- readIORef (iKey inj); _ <- delprop p k; return VNoval + +transformCopy :: Injector +transformCopy inj _ _ _ = do + mode <- readIORef (iMode inj) + if mode == m_keypre || mode == m_keypost then readIORef (iKey inj) + else do dp <- readIORef (iDparent inj); k <- readIORef (iKey inj); out <- lookup_ dp k; _ <- injSetval1 inj out; return out + +transformKey :: Injector +transformKey inj _ _ _ = do + mode <- readIORef (iMode inj) + if mode /= m_val then return VNoval + else do + p <- readIORef (iParent inj) + keyspec <- lookup_ p (VStr s_bkey) + if not (isNoval keyspec) then do _ <- delprop p (VStr s_bkey); dp <- readIORef (iDparent inj); getprop dp keyspec + else do + anno <- lookup_ p (VStr s_banno) + fromanno <- lookup_ anno (VStr s_key) + if not (isNoval fromanno) then return fromanno + else do pa <- readIORef (iPath inj); getelem pa (VNum (-2)) + +transformAnno :: Injector +transformAnno inj _ _ _ = do p <- readIORef (iParent inj); _ <- delprop p (VStr s_banno); return VNoval + +transformMerge :: Injector +transformMerge inj _ _ _ = do + mode <- readIORef (iMode inj) + if mode == m_keypre then readIORef (iKey inj) + else if mode == m_keypost then do + p <- readIORef (iParent inj); k <- readIORef (iKey inj) + args0 <- getprop p k + args <- if islist args0 then return args0 else mkList [args0] + _ <- injSetval1 inj VNoval + pc <- clone p + l1 <- mkList [p] + l3 <- mkList [pc] + inner <- mkList [l1, args, l3] + mergelist <- flatten 1 inner + _ <- merge mergelist + readIORef (iKey inj) + else return VNoval + +transformEach :: Injector +transformEach inj _ _ store = do + keys <- readIORef (iKeys inj) + when (islist keys) $ do _ <- sliceM keys (VNum 0) (VNum 1) True; return () + mode <- readIORef (iMode inj) + if mode /= m_val then return VNoval + else do + parent <- readIORef (iParent inj) + psz <- size parent + srcpath <- if psz > 1 then getelem parent (VNum 1) else return VNoval + child_tm <- if psz > 2 then do e <- getelem parent (VNum 2); clone e else return VNoval + base <- readIORef (iBase inj) + srcstore <- getpropAlt store store base + src <- getpath (IInj inj) srcstore srcpath + path0 <- readIORef (iPath inj) + tkey <- getelem path0 (VNum (-2)) + nodes <- readIORef (iNodes inj) + target <- do t <- getelem nodes (VNum (-2)); if isNullish t then getelem nodes (VNum (-1)) else return t + rvalRef <- newIORef =<< emptyList + when (isnode src) $ do + tvall <- case src of + VList r -> do its <- readIORef r; mapM (\_ -> clone child_tm) its + VMap m -> do es <- readIORef m + mapM (\(k, _) -> do cc <- clone child_tm + when (ismap cc) (do anno <- mkMap [(s_key, VStr k)]; _ <- setprop cc (VStr s_banno) anno; return ()) + return cc) es + _ -> return [] + tvalv <- mkList tvall + tcurrent <- case src of + VMap m -> do es <- readIORef m; mkList (map snd es) + VList r -> do its <- readIORef r; mkList its + _ -> return src + when (length tvall > 0) $ do + path <- readIORef (iPath inj) + ckey <- getelem path (VNum (-2)) + plist <- listItems path + tpath <- mkList (if null plist then [] else take (length plist - 1) plist) + dpathRef <- newIORef [VStr s_dtop] + case srcpath of + VStr sp | sp /= s_mt -> forM_ (splitOn '.' sp) (\pp -> when (pp /= s_mt) (modifyIORef' dpathRef (++ [VStr pp]))) + _ -> return () + cks <- jsString ckey + when (not (isNoval ckey)) $ modifyIORef' dpathRef (++ [VStr ("$:" ++ cks)]) + tcur0 <- mkMap [(cks, tcurrent)] + tcurRef <- newIORef tcur0 + tpsz <- size tpath + when (tpsz > 1) $ do + pkey <- getelemAlt (VStr s_dtop) path (VNum (-3)) + pks <- jsString pkey + modifyIORef' dpathRef (++ [VStr ("$:" ++ pks)]) + tc <- readIORef tcurRef; ntc <- mkMap [(pks, tc)]; writeIORef tcurRef ntc + ckeyList <- if not (isNoval ckey) then mkList [ckey] else emptyList + tinj <- injChild inj 0 ckeyList + writeIORef (iPath tinj) tpath + nlist <- listItems nodes + nn <- mkList (if null nlist then [] else take (length nlist - 1) nlist) + writeIORef (iNodes tinj) nn + tinjNodes <- readIORef (iNodes tinj); tnsz <- size tinjNodes + tparent <- if tnsz > 0 then getelem tinjNodes (VNum (-1)) else return VNoval + writeIORef (iParent tinj) tparent + when (not (isNoval ckey) && not (isNoval tparent)) $ do _ <- setprop tparent ckey tvalv; return () + writeIORef (iIval tinj) tvalv + dpv <- readIORef dpathRef; dpl <- mkList dpv; writeIORef (iDpath tinj) dpl + tcur <- readIORef tcurRef; writeIORef (iDparent tinj) tcur + _ <- inject (IInj tinj) tvalv store + iv <- readIORef (iIval tinj); writeIORef rvalRef iv + rval <- readIORef rvalRef + _ <- setprop target tkey rval + rsz <- size rval + if islist rval && rsz > 0 then getelem rval (VNum 0) else return VNoval + +transformPack :: Injector +transformPack inj _ _ store = do + mode <- readIORef (iMode inj) + k0 <- readIORef (iKey inj) + if mode /= m_keypre || not (isStr k0) then return VNoval + else do + parent <- readIORef (iParent inj) + nodes <- readIORef (iNodes inj) + key <- readIORef (iKey inj) + argsVal <- getprop parent key + asz <- size argsVal + if not (islist argsVal) || asz < 2 then return VNoval + else do + srcpath <- getelem argsVal (VNum 0) + origchildspec <- getelem argsVal (VNum 1) + path <- readIORef (iPath inj) + tkey <- getelem path (VNum (-2)) + pathsize <- size path + target <- do t <- getelem nodes (VNum (fromIntegral (pathsize - 2))); if isNullish t then getelem nodes (VNum (fromIntegral (pathsize - 1))) else return t + base <- readIORef (iBase inj) + srcstore <- getpropAlt store store base + src0 <- getpath (IInj inj) srcstore srcpath + src <- if not (islist src0) + then if ismap src0 then do ps <- itemsPairs src0; xs <- mapM (\(k, node) -> do anno <- mkMap [(s_key, VStr k)]; _ <- setprop node (VStr s_banno) anno; return node) ps; mkList xs + else return VNoval + else return src0 + if isNoval src then return VNoval + else do + keypath <- getprop origchildspec (VStr s_bkey) + childspec <- delprop origchildspec (VStr s_bkey) + child <- getpropAlt childspec childspec (VStr s_bval) + tval <- emptyMap + srcPairs <- itemsPairs src + forM_ srcPairs $ \(srckey, srcnode) -> do + k <- if isNoval keypath then return (VStr srckey) + else case keypath of + VStr kp | s_bt `isPrefixOf` kp -> do em <- emptyMap; dt <- mkMap [(s_dtop, srcnode)]; ls <- mkList [em, store, dt]; mst <- mergeD ls (VNum 1); inject INone (VStr kp) mst + _ -> getpath (IInj inj) srcnode keypath + tchild <- clone child + _ <- setprop tval k tchild + anno <- getprop srcnode (VStr s_banno) + if isNoval anno then delprop tchild (VStr s_banno) >> return () else setprop tchild (VStr s_banno) anno >> return () + rvalRef <- newIORef =<< emptyMap + empty <- isempty tval + when (not empty) $ do + tsrc <- emptyMap + srcItems <- listItems src + forM_ (zip [0 ..] srcItems) $ \(i, node) -> do + kn <- if isNoval keypath then return (vint i) + else case keypath of + VStr kp | s_bt `isPrefixOf` kp -> do em <- emptyMap; dt <- mkMap [(s_dtop, node)]; ls <- mkList [em, store, dt]; mst <- mergeD ls (VNum 1); inject INone (VStr kp) mst + _ -> getpath (IInj inj) node keypath + _ <- setprop tsrc kn node; return () + tpath <- sliceM path (VNum (-1)) VNoval False + ckey <- getelem path (VNum (-2)) + dpathRef <- newIORef [VStr s_dtop] + case srcpath of + VStr sp -> forM_ (splitOn '.' sp) (\pp -> when (pp /= s_mt) (modifyIORef' dpathRef (++ [VStr pp]))) + _ -> return () + cks <- jsString ckey + modifyIORef' dpathRef (++ [VStr ("$:" ++ cks)]) + tcur0 <- mkMap [(cks, tsrc)] + tcurRef <- newIORef tcur0 + tpsz <- size tpath + when (tpsz > 1) $ do + pkey <- getelemAlt (VStr s_dtop) path (VNum (-3)) + pks <- jsString pkey + modifyIORef' dpathRef (++ [VStr ("$:" ++ pks)]) + tc <- readIORef tcurRef; ntc <- mkMap [(pks, tc)]; writeIORef tcurRef ntc + ckl <- mkList [ckey] + tinj <- injChild inj 0 ckl + writeIORef (iPath tinj) tpath + nn <- sliceM nodes (VNum (-1)) VNoval False + writeIORef (iNodes tinj) nn + tnodes <- readIORef (iNodes tinj); tparent <- getelem tnodes (VNum (-1)) + writeIORef (iParent tinj) tparent + writeIORef (iIval tinj) tval + dpv <- readIORef dpathRef; dpl <- mkList dpv; writeIORef (iDpath tinj) dpl + tcur <- readIORef tcurRef; writeIORef (iDparent tinj) tcur + _ <- inject (IInj tinj) tval store + iv <- readIORef (iIval tinj); writeIORef rvalRef iv + rval <- readIORef rvalRef + _ <- setprop target tkey rval + return VNoval + +transformRef :: Injector +transformRef inj v _ store = do + mode <- readIORef (iMode inj) + if mode /= m_val then return VNoval + else do + nodes <- readIORef (iNodes inj) + parent <- readIORef (iParent inj) + refpath <- lookup_ parent (VNum 1) + keys <- readIORef (iKeys inj); ksz <- size keys; writeIORef (iKeyi inj) ksz + specFunc <- getprop store (VStr s_dspec) + case specFunc of + VFunc f -> do + spec <- f inj VNoval "" VNoval + refv <- getpath INone spec refpath + hasSubRef <- newIORef False + when (isnode refv) $ do _ <- walk (Just (\_ v2 _ _ -> do when (vStrEq v2 "`$REF`") (writeIORef hasSubRef True); return v2)) Nothing VNoval refv; return () + tref <- clone refv + ipath <- readIORef (iPath inj); ipsz <- size ipath + cpath <- sliceM ipath (VNum 0) (VNum (fromIntegral (ipsz - 3))) False + tpath <- sliceM ipath (VNum 0) (VNum (fromIntegral (ipsz - 1))) False + tcur <- getpath INone store cpath + tval <- getpath INone store tpath + rvalRef <- newIORef VNoval + hasSub <- readIORef hasSubRef + when (not (isNoval refv) && (not hasSub || not (isNoval tval))) $ do + lastT <- getelem tpath (VNum (-1)); cl <- mkList [lastT] + cs <- injChild inj 0 cl + writeIORef (iPath cs) tpath + inodes <- readIORef (iNodes inj); insz <- size inodes + nn <- sliceM inodes (VNum 0) (VNum (fromIntegral (insz - 1))) False + writeIORef (iNodes cs) nn + parent2 <- getelem nodes (VNum (-2)); writeIORef (iParent cs) parent2 + writeIORef (iIval cs) tref + writeIORef (iDparent cs) tcur + _ <- inject (IInj cs) tref store + iv <- readIORef (iIval cs); writeIORef rvalRef iv + rval <- readIORef rvalRef + _ <- injSetval 2 inj rval + prior <- readIORef (iPrior inj) + case prior of + Just p -> when (islist parent) $ do pk <- readIORef (iKeyi p); writeIORef (iKeyi p) (pk - 1) + Nothing -> return () + return v + _ -> return VNoval + +-- --------------------------------------------------------------------------- +-- formatters / transform_format / transform_apply / transform +-- --------------------------------------------------------------------------- + +jsstr :: Value -> IO String +jsstr v = case v of + VNull -> return "null" + VBool b -> return (if b then "true" else "false") + _ -> jsString v + +readDoubleOr0 :: String -> Double +readDoubleOr0 s = fromMaybe 0 (readMaybe s :: Maybe Double) + +type Formatter = Value -> Value -> IO Value + +formatterTbl :: [(String, Formatter)] +formatterTbl = + [ ("identity", \_ v -> return v) + , ("upper", \_ v -> if isnode v then return v else do s <- jsstr v; return (VStr (map toUpper s))) + , ("lower", \_ v -> if isnode v then return v else do s <- jsstr v; return (VStr (map toLower s))) + , ("string", \_ v -> if isnode v then return v else do s <- jsstr v; return (VStr s)) + , ("number", \_ v -> if isnode v then return v + else do s <- jsstr v; let n = readDoubleOr0 s in return (VNum (if isNaN n then 0 else n))) + , ("integer", \_ v -> if isnode v then return v + else do s <- jsstr v; let n = readDoubleOr0 s in return (VNum (fromIntegral (truncate (if isNaN n then 0 else n) :: Integer)))) + , ("concat", \k v -> if isNoval k && islist v + then do iv <- itemsV v (\(_, x) -> if isnode x then VStr s_mt else VStr (jsstrPure x)); s <- join iv (VStr s_mt) False; return (VStr s) + else return v) + ] + +check_placement :: Int -> String -> Int -> Inj -> IO Bool +check_placement modes ijname parenttypes inj = do + modenum <- readIORef (iMode inj) + if (modes .&. modenum) == 0 then do + let allowed = L.filter (\m -> (modes .&. m) /= 0) [m_keypre, m_keypost, m_val] + placements = intercalate "," (map (\m -> if m == m_val then "value" else "key") allowed) + cur = if modenum == m_val then "value" else "key" + errs <- readIORef (iErrs inj); esz <- size errs + _ <- setprop errs (VNum (fromIntegral esz)) (VStr ("$" ++ ijname ++ ": invalid placement as " ++ cur ++ ", expected: " ++ placements ++ ".")) + return False + else do + ie <- isempty (VNum (fromIntegral parenttypes)) + if not ie then do + p <- readIORef (iParent inj) + let ptype = typify p + if (parenttypes .&. ptype) == 0 then do + errs <- readIORef (iErrs inj); esz <- size errs + _ <- setprop errs (VNum (fromIntegral esz)) (VStr ("$" ++ ijname ++ ": invalid placement in parent " ++ typename ptype ++ ", expected: " ++ typename parenttypes ++ ".")) + return False + else return True + else return True + +injector_args :: [Int] -> Value -> IO [Value] +injector_args argtypes args = do + let numargs = length argtypes + foundRef <- newIORef (replicate (1 + numargs) VNoval) + let go [] = return () + go ((argi, at):rest) = do + arg <- getelem args (VNum (fromIntegral argi)) + let argtype = typify arg + if (at .&. argtype) == 0 then do + s <- stringifyMax arg (VNum 22) + modifyIORef' foundRef (setAt 0 (VStr ("invalid argument: " ++ s ++ " (" ++ typename argtype ++ " at position " ++ show (1 + argi) ++ ") is not of type: " ++ typename at ++ "."))) + else do modifyIORef' foundRef (setAt (1 + argi) arg); go rest + go (zip [0 ..] argtypes) + readIORef foundRef + +inject_child :: Value -> Value -> Inj -> IO Inj +inject_child child store inj = do + prior <- readIORef (iPrior inj) + cinjRef <- newIORef inj + case prior of + Just pr -> do + pprior <- readIORef (iPrior pr) + case pprior of + Just pp -> do + pkeyi <- readIORef (iKeyi pr); pkeys <- readIORef (iKeys pr) + c <- injChild pp pkeyi pkeys + writeIORef (iIval c) child + cp <- readIORef (iParent c); prk <- readIORef (iKey pr); _ <- setprop cp prk child + writeIORef cinjRef c + Nothing -> do + ikeyi <- readIORef (iKeyi inj); ikeys <- readIORef (iKeys inj) + c <- injChild pr ikeyi ikeys + writeIORef (iIval c) child + cp <- readIORef (iParent c); ik <- readIORef (iKey inj); _ <- setprop cp ik child + writeIORef cinjRef c + Nothing -> return () + cinj <- readIORef cinjRef + _ <- inject (IInj cinj) child store + return cinj + +transformFormat :: Injector +transformFormat inj _ _ store = do + keys <- readIORef (iKeys inj); _ <- sliceM keys (VNum 0) (VNum 1) True + mode <- readIORef (iMode inj) + if mode /= m_val then return VNoval + else do + parent <- readIORef (iParent inj) + name <- lookup_ parent (VNum 1) + child <- lookup_ parent (VNum 2) + path <- readIORef (iPath inj) + tkey <- getelem path (VNum (-2)) + nodes <- readIORef (iNodes inj) + target <- do t <- getelem nodes (VNum (-2)); if isNullish t then getelem nodes (VNum (-1)) else return t + cinj <- inject_child child store inj + resolved <- readIORef (iIval cinj) + nameKey <- jsString name + let formatter = if (t_function .&. typify name) > 0 + then Just (\k vv -> case name of { VFunc f -> do { ks <- jsString k; f dummyInj vv ks VNoval }; _ -> return vv }) + else lookup nameKey formatterTbl + case formatter of + Nothing -> do errs <- readIORef (iErrs inj); esz <- size errs; _ <- setprop errs (VNum (fromIntegral esz)) (VStr ("$FORMAT: unknown format: " ++ nameKey ++ ".")); return VNoval + Just f -> do + out <- walk (Just (\k vv _ _ -> f k vv)) Nothing VNoval resolved + _ <- setprop target tkey out + return out + +transformApply :: Injector +transformApply inj _ _ store = do + ok <- check_placement m_val "APPLY" t_list inj + if not ok then return VNoval + else do + parent <- readIORef (iParent inj) + sl <- sliceM parent (VNum 1) VNoval False + res <- injector_args [t_function, t_any] sl + let err = res !! 0 + applyFn = res !! 1 + child = if length res > 2 then res !! 2 else VNoval + if not (isNoval err) then do errs <- readIORef (iErrs inj); esz <- size errs; es <- jsString err; _ <- setprop errs (VNum (fromIntegral esz)) (VStr ("$APPLY: " ++ es)); return VNoval + else do + path <- readIORef (iPath inj); tkey <- getelem path (VNum (-2)) + nodes <- readIORef (iNodes inj); target <- do t <- getelem nodes (VNum (-2)); if isNullish t then getelem nodes (VNum (-1)) else return t + cinj <- inject_child child store inj + resolved <- readIORef (iIval cinj) + out <- case applyFn of VFunc f -> f cinj resolved "" store; _ -> return VNoval + _ <- setprop target tkey out + return out + +defaultInjDef :: Value -> InjDef +defaultInjDef errs = InjDef + { dMeta = VNoval, dExtra = VNoval, dErrs = errs, dModify = Nothing, dHandler = Nothing + , dBase = VNoval, dDparent = VNoval, dDpath = VNoval, dKey = VNoval } + +transform :: InjArg -> Value -> Value -> IO Value +transform injarg dat spec0 = do + let origspec = spec0 + spec <- clone spec0 + let extra = case injarg of IDef d -> dExtra d; _ -> VNoval + collect = case injarg of IDef d -> not (isNoval (dErrs d)); _ -> False + errs <- case injarg of IDef d | collect -> return (dErrs d); _ -> emptyList + extraTransforms <- emptyMap + extraData <- emptyMap + when (not (isNoval extra)) $ do + ps <- itemsPairs extra + forM_ ps $ \(k, vv) -> if s_ds `isPrefixOf` k then setprop extraTransforms (VStr k) vv >> return () else setprop extraData (VStr k) vv >> return () + edEmpty <- isempty extraData + ec <- if edEmpty then return VNoval else clone extraData + dc <- clone dat + ls <- mkList [ec, dc] + dataClone <- merge ls + store <- emptyMap + let put k vv = setprop store (VStr k) vv >> return () + put s_dtop dataClone + put s_dspec (VFunc (\_ _ _ _ -> return origspec)) + put "$BT" (VFunc (\_ _ _ _ -> return (VStr s_bt))) + put "$DS" (VFunc (\_ _ _ _ -> return (VStr s_ds))) + put "$WHEN" (VFunc (\_ _ _ _ -> return (VStr "1970-01-01T00:00:00.000Z"))) + put "$DELETE" (VFunc transformDelete) + put "$COPY" (VFunc transformCopy) + put "$KEY" (VFunc transformKey) + put "$ANNO" (VFunc transformAnno) + put "$MERGE" (VFunc transformMerge) + put "$EACH" (VFunc transformEach) + put "$PACK" (VFunc transformPack) + put "$REF" (VFunc transformRef) + put "$FORMAT" (VFunc transformFormat) + put "$APPLY" (VFunc transformApply) + etPairs <- itemsPairs extraTransforms + forM_ etPairs $ \(k, vv) -> put k vv + put s_derrs errs + let idef0 = defaultInjDef errs + idef = case injarg of + IDef d -> idef0 { dMeta = dMeta d, dModify = dModify d, dHandler = dHandler d, dBase = dBase d } + _ -> idef0 + out <- inject (IDef idef) spec store + esz <- size errs + when (esz > 0 && not collect) $ do j <- join errs (VStr " | ") False; throwIO (StructError j) + return out + +-- --------------------------------------------------------------------------- +-- validate +-- --------------------------------------------------------------------------- + +pushErr :: Inj -> String -> IO () +pushErr inj msg = do errs <- readIORef (iErrs inj); esz <- size errs; _ <- setprop errs (VNum (fromIntegral esz)) (VStr msg); return () + +invalidTypeMsg :: Value -> String -> Int -> Value -> String -> IO String +invalidTypeMsg path needtype vt v _whence = do + vs <- if isNullish v then return "no value" else stringify v + psz <- size path + fieldPart <- if psz > 1 then do p <- pathifyFull path (VNum 1) VNoval False; return ("field " ++ p ++ " to be ") else return "" + let typePart = if not (isNullish v) then typename vt ++ s_viz else "" + return ("Expected " ++ fieldPart ++ needtype ++ ", but found " ++ typePart ++ vs ++ ".") + +validateString :: Injector +validateString inj _ _ _ = do + dp <- readIORef (iDparent inj); k <- readIORef (iKey inj) + out <- lookup_ dp k + let t = typify out + if (t_string .&. t) == 0 then do path <- readIORef (iPath inj); m <- invalidTypeMsg path s_string t out "V1010"; pushErr inj m; return VNoval + else if vStrEq out s_mt then do path <- readIORef (iPath inj); p <- pathifyFull path (VNum 1) VNoval False; pushErr inj ("Empty string at " ++ p); return VNoval + else return out + +validateType :: Injector +validateType inj _ refstr _ = do + let tname = if length refstr > 1 then map toLower (drop 1 refstr) else "any" + idx = fromMaybe (-1) (findIndex (== tname) typenameTbl) + typev0 = if idx >= 0 then shiftL 1 (31 - idx) else 0 + typev = if tname == s_nil then typev0 .|. t_null else typev0 + dp <- readIORef (iDparent inj); k <- readIORef (iKey inj) + out <- lookup_ dp k + let t = typify out + if (t .&. typev) == 0 then do path <- readIORef (iPath inj); m <- invalidTypeMsg path tname t out "V1001"; pushErr inj m; return VNoval + else return out + +validateAny :: Injector +validateAny inj _ _ _ = do dp <- readIORef (iDparent inj); k <- readIORef (iKey inj); lookup_ dp k + +validateChild :: Injector +validateChild inj _ _ _ = do + parent <- readIORef (iParent inj); key <- readIORef (iKey inj); path <- readIORef (iPath inj); keys <- readIORef (iKeys inj) + mode <- readIORef (iMode inj) + if mode == m_keypre then do + childtm <- getprop parent key + pkey <- getelem path (VNum (-2)) + dp <- readIORef (iDparent inj) + tval <- getprop dp pkey + if isNoval tval then do + em <- emptyMap; eks <- keysof em + forM_ eks $ \ckey -> do cc <- clone childtm; _ <- setprop parent (VStr ckey) cc; ksz <- size keys; _ <- setprop keys (VNum (fromIntegral ksz)) (VStr ckey); return () + _ <- delprop parent key; return VNoval + else if not (ismap tval) then do + psz <- size path; sl <- sliceM path (VNum 0) (VNum (fromIntegral (psz - 1))) False + m <- invalidTypeMsg sl s_object (typify tval) tval "V0220"; pushErr inj m; return VNoval + else do + tks <- keysof tval + forM_ tks $ \ckey -> do cc <- clone childtm; _ <- setprop parent (VStr ckey) cc; ksz <- size keys; _ <- setprop keys (VNum (fromIntegral ksz)) (VStr ckey); return () + _ <- delprop parent key; return VNoval + else if mode == m_val then do + childtm <- getprop parent (VNum 1) + if not (islist parent) then do pushErr inj "Invalid $CHILD as value"; return VNoval + else do + dp <- readIORef (iDparent inj) + if isNoval dp then case parent of VList r -> writeIORef r [] >> return VNoval; _ -> return VNoval + else if not (islist dp) then do + psz <- size path; sl <- sliceM path (VNum 0) (VNum (fromIntegral (psz - 1))) False + m <- invalidTypeMsg sl s_list (typify dp) dp "V0230"; pushErr inj m + psz2 <- size parent; writeIORef (iKeyi inj) psz2; return dp + else do + ps <- itemsPairs dp + forM_ ps $ \(k, _) -> do cc <- clone childtm; _ <- setprop parent (VStr k) cc; return () + n <- size dp + case parent of { VList r -> do { a <- readIORef r; writeIORef r (take (min n (length a)) a) }; _ -> return () } + writeIORef (iKeyi inj) 0 + getprop dp (VNum 0) + else return VNoval + +validateOne :: Injector +validateOne inj _ _ store = do + mode <- readIORef (iMode inj) + if mode == m_val then do + parent <- readIORef (iParent inj) + keyi <- readIORef (iKeyi inj) + if not (islist parent) || keyi /= 0 then do + path <- readIORef (iPath inj); p <- pathifyFull path (VNum 1) (VNum 1) False + pushErr inj ("The $ONE validator at field " ++ p ++ " must be the first element of an array."); return VNoval + else do + keys <- readIORef (iKeys inj); ksz <- size keys; writeIORef (iKeyi inj) ksz + dp <- readIORef (iDparent inj); _ <- injSetval 2 inj dp + path <- readIORef (iPath inj); psz <- size path; sl <- sliceM path (VNum 0) (VNum (fromIntegral (psz - 1))) False; writeIORef (iPath inj) sl + np <- readIORef (iPath inj); nk <- getelem np (VNum (-1)); writeIORef (iKey inj) nk + tvals <- sliceM parent (VNum 1) VNoval False + tsz <- size tvals + if tsz == 0 then do path2 <- readIORef (iPath inj); p <- pathifyFull path2 (VNum 1) (VNum 1) False; pushErr inj ("The $ONE validator at field " ++ p ++ " must have at least one argument."); return VNoval + else do + matchedRef <- newIORef False + tvItems <- listItems tvals + forM_ tvItems $ \tval -> do + matched <- readIORef matchedRef + when (not matched) $ do + terrs <- emptyList + em <- emptyMap; ls <- mkList [em, store]; vstore <- mergeD ls (VNum 1) + dp2 <- readIORef (iDparent inj); _ <- setprop vstore (VStr s_dtop) dp2 + meta <- readIORef (iMeta inj) + let idef = (defaultInjDef terrs) { dExtra = vstore, dMeta = meta } + vcurrent <- validate (IDef idef) dp2 tval + _ <- injSetval (-2) inj vcurrent + tesz <- size terrs + when (tesz == 0) $ writeIORef matchedRef True + matched <- readIORef matchedRef + when (not matched) $ do + ps <- itemsPairs tvals + descs <- mapM (\(_, x) -> stringify x) ps + let valdesc = replaceTransformNames (intercalate ", " descs) + path3 <- readIORef (iPath inj); dp3 <- readIORef (iDparent inj) + m <- invalidTypeMsg path3 ((if tsz > 1 then "one of " else "") ++ valdesc) (typify dp3) dp3 "V0210" + pushErr inj m + return VNoval + else return VNoval + +validateExact :: Injector +validateExact inj _ _ _ = do + mode <- readIORef (iMode inj) + if mode == m_val then do + parent <- readIORef (iParent inj); keyi <- readIORef (iKeyi inj) + if not (islist parent) || keyi /= 0 then do path <- readIORef (iPath inj); p <- pathifyFull path (VNum 1) (VNum 1) False; pushErr inj ("The $EXACT validator at field " ++ p ++ " must be the first element of an array."); return VNoval + else do + keys <- readIORef (iKeys inj); ksz <- size keys; writeIORef (iKeyi inj) ksz + dp <- readIORef (iDparent inj); _ <- injSetval 2 inj dp + path <- readIORef (iPath inj); psz <- size path; sl <- sliceM path (VNum 0) (VNum (fromIntegral (psz - 1))) False; writeIORef (iPath inj) sl + np <- readIORef (iPath inj); nk <- getelem np (VNum (-1)); writeIORef (iKey inj) nk + tvals <- sliceM parent (VNum 1) VNoval False + tsz <- size tvals + if tsz == 0 then do path2 <- readIORef (iPath inj); p <- pathifyFull path2 (VNum 1) (VNum 1) False; pushErr inj ("The $EXACT validator at field " ++ p ++ " must have at least one argument."); return VNoval + else do + matchedRef <- newIORef False + tvItems <- listItems tvals + dp2 <- readIORef (iDparent inj) + forM_ tvItems $ \tval -> do matched <- readIORef matchedRef; when (not matched) $ do eqb <- veq tval dp2; when eqb (writeIORef matchedRef True) + matched <- readIORef matchedRef + when (not matched) $ do + ps <- itemsPairs tvals + descs <- mapM (\(_, x) -> stringify x) ps + let valdesc = replaceTransformNames (intercalate ", " descs) + path3 <- readIORef (iPath inj); psz3 <- size path3 + m <- invalidTypeMsg path3 ((if psz3 > 1 then "" else "value ") ++ "exactly equal to " ++ (if tsz == 1 then "" else "one of ") ++ valdesc) (typify dp2) dp2 "V0110" + pushErr inj m + return VNoval + else do p <- readIORef (iParent inj); k <- readIORef (iKey inj); _ <- delprop p k; return VNoval + +veq :: Value -> Value -> IO Bool +veq a b = case (a, b) of + (VNoval, VNoval) -> return True + (VNull, VNull) -> return True + (VBool x, VBool y) -> return (x == y) + (VNum x, VNum y) -> return (x == y) + (VStr x, VStr y) -> return (x == y) + (VSentinel x, VSentinel y) -> return (x == y) + (VList x, VList y) -> do xs <- readIORef x; ys <- readIORef y; if length xs /= length ys then return False else andM (zipWith veq xs ys) + (VMap x, VMap y) -> do xs <- readIORef x; ys <- readIORef y; if length xs /= length ys then return False else andM (map (\(k, vv) -> case lookup k ys of Just w -> veq vv w; Nothing -> return False) xs) + _ -> return False + +validation :: ModifyFn +validation pval key parent inj = do + when (not (is_skip pval)) $ do + meta <- readIORef (iMeta inj) + exact <- getpropAlt (VBool False) meta (VStr s_bexact) + dp <- readIORef (iDparent inj) + cval <- getprop dp key + let exactB = case exact of VBool True -> True; _ -> False + when (not ((not exactB) && isNoval cval)) $ do + let ptype = typify pval + pjs <- jsString pval + when (not ((t_string .&. ptype) > 0 && '$' `elem` pjs)) $ do + let ctype = typify cval + path <- readIORef (iPath inj) + if ptype /= ctype && not (isNoval pval) then do m <- invalidTypeMsg path (typename ptype) ctype cval "V0010"; pushErr inj m + else if ismap cval then + if not (ismap pval) then do m <- invalidTypeMsg path (typename ptype) ctype cval "V0020"; pushErr inj m + else do + ckeys <- keysof cval + pkeys <- keysof pval + bopenV <- getprop pval (VStr s_bopen) + if not (null pkeys) && not (vIsTrue bopenV) then do + badkeys <- filterM (\ck -> do lk <- lookup_ pval (VStr ck); return (isNoval lk)) ckeys + when (not (null badkeys)) $ do p <- pathifyFull path (VNum 1) VNoval False; pushErr inj ("Unexpected keys at field " ++ p ++ s_viz ++ intercalate ", " badkeys) + else do + ls <- mkList [pval, cval]; _ <- merge ls + when (isnode pval) (delprop pval (VStr s_bopen) >> return ()) + else if islist cval then when (not (islist pval)) $ do m <- invalidTypeMsg path (typename ptype) ctype cval "V0030"; pushErr inj m + else if exactB then do + eqb <- veq cval pval + when (not eqb) $ do + psz <- size path + pathmsg <- if psz > 1 then do p <- pathifyFull path (VNum 1) VNoval False; return ("at field " ++ p ++ ": ") else return "" + cjs <- jsString cval; pjs2 <- jsString pval + pushErr inj ("Value " ++ pathmsg ++ cjs ++ " should equal " ++ pjs2 ++ ".") + else do _ <- setprop parent key cval; return () + +validateHandler :: Injector +validateHandler inj v refstr store = case metaPathMatch refstr of + Just (_, g2, _) -> do + if g2 == "=" then do l <- mkList [VStr s_bexact, v]; _ <- injSetval1 inj l; return () else do _ <- injSetval1 inj v; return () + writeIORef (iKeyi inj) (-1) + return skip + Nothing -> injectHandler inj v refstr store + +validate :: InjArg -> Value -> Value -> IO Value +validate injarg dat spec = do + let extra = case injarg of IDef d -> dExtra d; _ -> VNoval + collect = case injarg of IDef d -> not (isNoval (dErrs d)); _ -> False + errs <- case injarg of IDef d | collect -> return (dErrs d); _ -> emptyList + base <- emptyMap + let put k vv = setprop base (VStr k) vv >> return () + forM_ ["$DELETE", "$COPY", "$KEY", "$META", "$MERGE", "$EACH", "$PACK"] (\k -> put k VNull) + put "$STRING" (VFunc validateString) + forM_ ["$NUMBER", "$INTEGER", "$DECIMAL", "$BOOLEAN", "$NULL", "$NIL", "$MAP", "$LIST", "$FUNCTION", "$INSTANCE"] (\k -> put k (VFunc validateType)) + put "$ANY" (VFunc validateAny) + put "$CHILD" (VFunc validateChild) + put "$ONE" (VFunc validateOne) + put "$EXACT" (VFunc validateExact) + extraMap <- if isNoval extra then emptyMap else return extra + errMap <- mkMap [(s_derrs, errs)] + ls <- mkList [base, extraMap, errMap]; store <- mergeD ls (VNum 1) + meta <- case injarg of IDef d | not (isNoval (dMeta d)) -> return (dMeta d); _ -> emptyMap + bex <- getpropAlt (VBool False) meta (VStr s_bexact); _ <- setprop meta (VStr s_bexact) bex + let idef = (defaultInjDef errs) { dMeta = meta, dExtra = store, dModify = Just validation, dHandler = Just validateHandler } + out <- transform (IDef idef) dat spec + esz <- size errs + when (esz > 0 && not collect) $ do j <- join errs (VStr " | ") False; throwIO (StructError j) + return out + +-- --------------------------------------------------------------------------- +-- select +-- --------------------------------------------------------------------------- + +selectAnd :: Injector +selectAnd inj _ _ store = do + mode <- readIORef (iMode inj) + when (mode == m_keypre) $ do + parent <- readIORef (iParent inj); key <- readIORef (iKey inj) + terms <- getprop parent key + path <- readIORef (iPath inj); ppath <- sliceM path (VNum (-1)) VNoval False + point <- getpath INone store ppath + em <- emptyMap; ls <- mkList [em, store]; vstore <- mergeD ls (VNum 1) + _ <- setprop vstore (VStr s_dtop) point + ps <- itemsPairs terms + forM_ ps $ \(_, term) -> do + terrs <- emptyList + meta <- readIORef (iMeta inj) + let idef = (defaultInjDef terrs) { dExtra = vstore, dMeta = meta } + _ <- validate (IDef idef) point term + tesz <- size terrs + when (tesz /= 0) $ do pp <- pathify ppath; sp <- stringify point; st <- stringify terms; pushErr inj ("AND:" ++ pp ++ cross ++ sp ++ " fail:" ++ st) + gkey <- getelem path (VNum (-2)) + nodes <- readIORef (iNodes inj); gp <- getelem nodes (VNum (-2)) + _ <- setprop gp gkey point; return () + return VNoval + +selectOr :: Injector +selectOr inj _ _ store = do + mode <- readIORef (iMode inj) + when (mode == m_keypre) $ do + parent <- readIORef (iParent inj); key <- readIORef (iKey inj) + terms <- getprop parent key + path <- readIORef (iPath inj); ppath <- sliceM path (VNum (-1)) VNoval False + point <- getpath INone store ppath + em <- emptyMap; ls <- mkList [em, store]; vstore <- mergeD ls (VNum 1) + _ <- setprop vstore (VStr s_dtop) point + doneRef <- newIORef False + ps <- itemsPairs terms + forM_ ps $ \(_, term) -> do + done <- readIORef doneRef + when (not done) $ do + terrs <- emptyList + meta <- readIORef (iMeta inj) + let idef = (defaultInjDef terrs) { dExtra = vstore, dMeta = meta } + _ <- validate (IDef idef) point term + tesz <- size terrs + when (tesz == 0) $ do + gkey <- getelem path (VNum (-2)) + nodes <- readIORef (iNodes inj); gp <- getelem nodes (VNum (-2)) + _ <- setprop gp gkey point; writeIORef doneRef True + done <- readIORef doneRef + when (not done) $ do pp <- pathify ppath; sp <- stringify point; st <- stringify terms; pushErr inj ("OR:" ++ pp ++ cross ++ sp ++ " fail:" ++ st) + return VNoval + +selectNot :: Injector +selectNot inj _ _ store = do + mode <- readIORef (iMode inj) + when (mode == m_keypre) $ do + parent <- readIORef (iParent inj); key <- readIORef (iKey inj) + term <- getprop parent key + path <- readIORef (iPath inj); ppath <- sliceM path (VNum (-1)) VNoval False + point <- getpath INone store ppath + em <- emptyMap; ls <- mkList [em, store]; vstore <- mergeD ls (VNum 1) + _ <- setprop vstore (VStr s_dtop) point + terrs <- emptyList + meta <- readIORef (iMeta inj) + let idef = (defaultInjDef terrs) { dExtra = vstore, dMeta = meta } + _ <- validate (IDef idef) point term + tesz <- size terrs + when (tesz == 0) $ do pp <- pathify ppath; sp <- stringify point; st <- stringify term; pushErr inj ("NOT:" ++ pp ++ cross ++ sp ++ " fail:" ++ st) + gkey <- getelem path (VNum (-2)) + nodes <- readIORef (iNodes inj); gp <- getelem nodes (VNum (-2)) + _ <- setprop gp gkey point; return () + return VNoval + +numCmp :: Value -> Value -> (Double -> Double -> Bool) -> Bool +numCmp a b op = case (a, b) of (VNum x, VNum y) -> op x y; _ -> False + +selectCmp :: Injector +selectCmp inj _ refstr store = do + mode <- readIORef (iMode inj) + when (mode == m_keypre) $ do + parent <- readIORef (iParent inj); key <- readIORef (iKey inj) + term <- getprop parent key + path <- readIORef (iPath inj); gkey <- getelem path (VNum (-2)) + ppath <- sliceM path (VNum (-1)) VNoval False + point <- getpath INone store ppath + pass <- case refstr of + "$GT" -> return (numCmp point term (>)) + "$LT" -> return (numCmp point term (<)) + "$GTE" -> return (numCmp point term (>=)) + "$LTE" -> return (numCmp point term (<=)) + "$LIKE" -> case term of { VStr t -> do { sp <- stringify point; return (Vregex.testStr t sp) }; _ -> return False } + _ -> return False + if pass then do nodes <- readIORef (iNodes inj); gp <- getelem nodes (VNum (-2)); _ <- setprop gp gkey point; return () + else do pp <- pathify ppath; sp <- stringify point; st <- stringify term; pushErr inj ("CMP: " ++ pp ++ cross ++ sp ++ " fail:" ++ refstr ++ " " ++ st) + return VNoval + +select :: Value -> Value -> IO Value +select children0 query = + if not (isnode children0) then emptyList + else do + children <- if ismap children0 + then do ps <- itemsPairs children0; xs <- mapM (\(k, n) -> do _ <- setprop n (VStr s_dkey) (VStr k); return n) ps; mkList xs + else do its <- listItems children0; xs <- mapM (\(i, n) -> if ismap n then do _ <- setprop n (VStr s_dkey) (vint i); return n else return n) (zip [0 ..] its); mkList xs + results <- emptyList + extra <- emptyMap + forM_ [("$AND", selectAnd), ("$OR", selectOr), ("$NOT", selectNot), ("$GT", selectCmp), ("$LT", selectCmp), ("$GTE", selectCmp), ("$LTE", selectCmp), ("$LIKE", selectCmp)] $ \(k, f) -> setprop extra (VStr k) (VFunc f) >> return () + q <- clone query + _ <- walk (Just (\_ vv _ _ -> do when (ismap vv) (do bo <- getpropAlt (VBool True) vv (VStr s_bopen); _ <- setprop vv (VStr s_bopen) bo; return ()); return vv)) Nothing VNoval q + citems <- listItems children + forM_ citems $ \child -> do + errs <- emptyList + meta <- emptyMap; _ <- setprop meta (VStr s_bexact) (VBool True) + qc <- clone q + let idef = (defaultInjDef errs) { dMeta = meta, dExtra = extra } + _ <- validate (IDef idef) child qc + esz <- size errs + when (esz == 0) $ do rsz <- size results; _ <- setprop results (VNum (fromIntegral rsz)) child; return () + return results + +-- --------------------------------------------------------------------------- +-- builders +-- --------------------------------------------------------------------------- + +jm :: [Value] -> IO Value +jm kv = do + m <- emptyMap + let go [] = return () + go (k0:rest) = do + k <- case k0 of VNull -> return "null"; VStr s -> return s; _ -> stringify k0 + let (vv, rest') = case rest of (x:xs) -> (x, xs); [] -> (VNull, []) + _ <- setprop m (VStr k) vv + go rest' + go kv + return m + +jt :: [Value] -> IO Value +jt = mkList + +tn :: Int -> String +tn = typename diff --git a/haskell/src/Vregex.hs b/haskell/src/Vregex.hs new file mode 100644 index 00000000..6cddaeac --- /dev/null +++ b/haskell/src/Vregex.hs @@ -0,0 +1,237 @@ +-- Minimal backtracking regex engine for the Haskell port of voxgig/struct. +-- Supports the RE2 subset the corpus exercises: literals, '.', anchors ^ $, +-- \b, character classes [..] / [^..] with ranges and \d \w \s \D \W \S, +-- groups (..) and (?:..), alternation |, quantifiers * + ? and {n}/{n,}/{n,m} +-- with optional lazy '?'. No third-party dependency. The struct library uses +-- `test` for $LIKE; `find` backs the public re_* API (not corpus-tested). + +module Vregex + ( Re + , compile + , test + , testStr + , findBounds + ) where + +import Control.Applicative ((<|>)) +import Data.Array (Array, listArray, (!)) +import Data.Foldable (asum) +import Data.Maybe (isJust) + +data Node + = Char Char + | Any + | Start + | End + | WordB + | Cls Bool [Citem] -- negated?, items + | Grp [[Node]] -- alternation of sequences + | Star Bool Node -- greedy?, atom + | Plus Bool Node + | Opt Bool Node + | Rep Bool Int (Maybe Int) Node + +data Citem + = CChar Char + | CRange Char Char + | CD | CW | CS | CND | CNW | CNS -- \d \w \s \D \W \S + +-- ----- parser (remaining-string style) ----- + +parse :: String -> [[Node]] +parse pat = fst (parseAlt pat) + +parseAlt :: String -> ([[Node]], String) +parseAlt s0 = + let (first, s1) = parseSeq s0 + in go [first] s1 + where + go acc ('|':rest) = let (sq, r) = parseSeq rest in go (sq : acc) r + go acc r = (reverse acc, r) + +parseSeq :: String -> ([Node], String) +parseSeq = goSeq [] + where + goSeq acc s = case s of + [] -> (reverse acc, s) + ('|':_) -> (reverse acc, s) + (')':_) -> (reverse acc, s) + _ -> case parseAtom s of + (Nothing, s') -> (reverse acc, s') + (Just a, s') -> + let (a', s'') = parseQuantSuffix a s' + in goSeq (a' : acc) s'' + +parseAtom :: String -> (Maybe Node, String) +parseAtom s = case s of + [] -> (Nothing, s) + ('(':rest) -> + let rest1 = case rest of ('?':':':r) -> r; _ -> rest + (alts, r2) = parseAlt rest1 + r3 = case r2 of (')':r) -> r; _ -> r2 + in (Just (Grp alts), r3) + ('[':_) -> let (n, r) = parseClass s in (Just n, r) + ('.':rest) -> (Just Any, rest) + ('^':rest) -> (Just Start, rest) + ('$':rest) -> (Just End, rest) + ('\\':rest) -> case rest of + ('d':r) -> (Just (Cls False [CD]), r) + ('w':r) -> (Just (Cls False [CW]), r) + ('s':r) -> (Just (Cls False [CS]), r) + ('D':r) -> (Just (Cls False [CND]), r) + ('W':r) -> (Just (Cls False [CNW]), r) + ('S':r) -> (Just (Cls False [CNS]), r) + ('b':r) -> (Just WordB, r) + ('n':r) -> (Just (Char '\n'), r) + ('t':r) -> (Just (Char '\t'), r) + ('r':r) -> (Just (Char '\r'), r) + (c:r) -> (Just (Char c), r) + [] -> (Just (Char '\\'), []) + (c:rest) -> (Just (Char c), rest) + +parseClass :: String -> (Node, String) +parseClass ('[':s0) = + let (neg, s1) = case s0 of ('^':r) -> (True, r); _ -> (False, s0) + (items, rest) = goCls [] s1 + in (Cls neg (reverse items), rest) + where + goCls acc s = case s of + [] -> (acc, s) + (']':r) -> (acc, r) + ('\\':r) -> case r of + ('d':r') -> goCls (CD : acc) r' + ('w':r') -> goCls (CW : acc) r' + ('s':r') -> goCls (CS : acc) r' + ('D':r') -> goCls (CND : acc) r' + ('W':r') -> goCls (CNW : acc) r' + ('S':r') -> goCls (CNS : acc) r' + ('n':r') -> goCls (CChar '\n' : acc) r' + ('t':r') -> goCls (CChar '\t' : acc) r' + ('r':r') -> goCls (CChar '\r' : acc) r' + (c:r') -> goCls (CChar c : acc) r' + [] -> (acc, []) + (c : '-' : c2 : r) | c2 /= ']' -> goCls (CRange c c2 : acc) r + (c:r) -> goCls (CChar c : acc) r +parseClass s = (Cls False [], s) + +parseQuantSuffix :: Node -> String -> (Node, String) +parseQuantSuffix atom s = case s of + ('*':rest) -> let (lz, r) = lazyq rest in (Star (not lz) atom, r) + ('+':rest) -> let (lz, r) = lazyq rest in (Plus (not lz) atom, r) + ('?':rest) -> let (lz, r) = lazyq rest in (Opt (not lz) atom, r) + ('{':rest) -> + let (mn, r1) = num rest + (mx, r2) = case r1 of + (',':r) -> let (s2, r') = num r in (if null s2 then Nothing else Just (read s2), r') + _ -> (Just (if null mn then 0 else read mn), r1) + in case r2 of + ('}':r3) | not (null mn) -> + let (lz, r4) = lazyq r3 in (Rep (not lz) (read mn) mx atom, r4) + _ -> (atom, s) + _ -> (atom, s) + where + lazyq ('?':r) = (True, r) + lazyq r = (False, r) + num = span (\c -> c >= '0' && c <= '9') + +-- ----- matcher (backtracking, CPS over Maybe) ----- + +isWord :: Char -> Bool +isWord c = (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') + || (c >= '0' && c <= '9') || c == '_' + +spaceChars :: String +spaceChars = [' ', '\t', '\n', '\r', '\f', '\v'] + +citemMatch :: Citem -> Char -> Bool +citemMatch it c = case it of + CChar x -> c == x + CRange a b -> c >= a && c <= b + CD -> c >= '0' && c <= '9' + CND -> not (c >= '0' && c <= '9') + CW -> isWord c + CNW -> not (isWord c) + CS -> c `elem` spaceChars + CNS -> not (c `elem` spaceChars) + +mNode :: (Int -> Char) -> Int -> Node -> Int -> (Int -> Maybe r) -> Maybe r +mNode inp len node pos k = case node of + Char c -> if pos < len && inp pos == c then k (pos + 1) else Nothing + Any -> if pos < len && inp pos /= '\n' then k (pos + 1) else Nothing + Start -> if pos == 0 then k pos else Nothing + End -> if pos == len then k pos else Nothing + WordB -> + let before = pos > 0 && isWord (inp (pos - 1)) + after = pos < len && isWord (inp pos) + in if before /= after then k pos else Nothing + Cls neg items -> + if pos < len + then let c = inp pos + hit = any (`citemMatch` c) items + in if (if neg then not hit else hit) then k (pos + 1) else Nothing + else Nothing + Grp alts -> asum [mSeq inp len sq pos k | sq <- alts] + Opt greedy a -> + if greedy then mNode inp len a pos k <|> k pos + else k pos <|> mNode inp len a pos k + Star greedy a -> mStar inp len greedy a pos k + Plus greedy a -> mNode inp len a pos (\p -> mStar inp len greedy a p k) + Rep greedy mn mx a -> mRep inp len greedy mn mx a pos k + +mStar :: (Int -> Char) -> Int -> Bool -> Node -> Int -> (Int -> Maybe r) -> Maybe r +mStar inp len greedy a pos k = + if greedy + then mNode inp len a pos (\p -> if p > pos then mStar inp len greedy a p k else Nothing) <|> k pos + else k pos <|> mNode inp len a pos (\p -> if p > pos then mStar inp len greedy a p k else Nothing) + +mRep :: (Int -> Char) -> Int -> Bool -> Int -> Maybe Int -> Node -> Int -> (Int -> Maybe r) -> Maybe r +mRep inp len greedy mn mx a pos k = + if mn > 0 + then mNode inp len a pos (\p -> mRep inp len greedy (mn - 1) (fmap (subtract 1) mx) a p k) + else case mx of + Just 0 -> k pos + _ -> + let next p = if p > pos then mRep inp len greedy 0 (fmap (subtract 1) mx) a p k else Nothing + in if greedy then mNode inp len a pos next <|> k pos + else k pos <|> mNode inp len a pos next + +mSeq :: (Int -> Char) -> Int -> [Node] -> Int -> (Int -> Maybe r) -> Maybe r +mSeq inp len sq pos k = case sq of + [] -> k pos + (x:rest) -> mNode inp len x pos (\p -> mSeq inp len rest p k) + +-- Compiled = the alternation AST. +type Re = [[Node]] + +compile :: String -> Re +compile = parse + +mkInp :: String -> (Int -> Char, Int) +mkInp input = + let len = length input + arr = listArray (0, len - 1) input :: Array Int Char + in ((arr !), len) + +-- Does the pattern match anywhere in input? +test :: Re -> String -> Bool +test re input = tryAt 0 + where + (inp, len) = mkInp input + tryAt i + | any (\sq -> isJust (mSeq inp len sq i (\_ -> Just ()))) re = True + | i >= len = False + | otherwise = tryAt (i + 1) + +testStr :: String -> String -> Bool +testStr pat input = test (compile pat) input + +-- Leftmost match: returns (start, stop) or Nothing. Used by the public re_* API. +findBounds :: Re -> String -> Maybe (Int, Int) +findBounds re input = tryAt 0 + where + (inp, len) = mkInp input + tryAt i + | i > len = Nothing + | otherwise = case asum [mSeq inp len sq i Just | sq <- re] of + Just p -> Just (i, p) + Nothing -> tryAt (i + 1) diff --git a/haskell/test/Runner.hs b/haskell/test/Runner.hs new file mode 100644 index 00000000..8d6d70eb --- /dev/null +++ b/haskell/test/Runner.hs @@ -0,0 +1,551 @@ +-- Test runner for the shared JSON corpus (build/test/test.json). +-- Self-contained: an in-tree JSON reader builds the library's `Value` type +-- directly (via the IORef-backed nodes), so the Haskell port is exercised +-- exactly as in production. The runner logic mirrors every other port. + +{-# LANGUAGE LambdaCase #-} + +module Main where + +import Control.Exception (SomeException, throwIO, try) +import Control.Monad (forM_, when) +import Data.Char (chr, toLower) +import Data.IORef +import Data.List (intercalate, isPrefixOf) +import System.Environment (getArgs) +import System.Exit (exitFailure) +import Numeric (readHex) + +import VoxgigStruct +import qualified Vregex + +nullmark, undefmark, existsmark :: String +nullmark = "__NULL__" +undefmark = "__UNDEF__" +existsmark = "__EXISTS__" + +-- ---------------- JSON reader -> Value ---------------- + +jsonRead :: String -> IO Value +jsonRead s0 = do + posRef <- newIORef 0 + let arr = s0 + n = length arr + at i = arr !! i + peek = do p <- readIORef posRef; return (if p < n then Just (at p) else Nothing) + adv = modifyIORef' posRef (+ 1) + skipWs = do + p <- readIORef posRef + if p < n && (at p `elem` " \t\n\r") then adv >> skipWs else return () + pval = do + skipWs + mc <- peek + case mc of + Just '{' -> pobj + Just '[' -> parr + Just '"' -> VStr <$> pstr + Just 't' -> modifyIORef' posRef (+ 4) >> return (VBool True) + Just 'f' -> modifyIORef' posRef (+ 5) >> return (VBool False) + Just 'n' -> modifyIORef' posRef (+ 4) >> return VNull + _ -> pnum + pobj = do + adv; skipWs + mc <- peek + if mc == Just '}' then adv >> emptyMap + else do + m <- emptyMap + let loop = do + skipWs + k <- pstr + skipWs; adv -- ':' + v <- pval + _ <- setprop m (VStr k) v + skipWs + c <- peek >>= \case Just c -> adv >> return c; Nothing -> return '}' + if c == ',' then loop else return m + loop + parr = do + adv; skipWs + mc <- peek + if mc == Just ']' then adv >> emptyList + else do + accRef <- newIORef [] + let loop = do + v <- pval + modifyIORef' accRef (v :) + skipWs + c <- peek >>= \case Just c -> adv >> return c; Nothing -> return ']' + if c == ',' then loop else do acc <- readIORef accRef; mkList (reverse acc) + loop + pstr = do + adv -- opening quote + bRef <- newIORef [] + let loop = do + p <- readIORef posRef + let c = at p + adv + if c == '"' then do b <- readIORef bRef; return (reverse b) + else if c == '\\' then do + p2 <- readIORef posRef + let e = at p2 + adv + case e of + '"' -> push '"' >> loop + '\\' -> push '\\' >> loop + '/' -> push '/' >> loop + 'n' -> push '\n' >> loop + 't' -> push '\t' >> loop + 'r' -> push '\r' >> loop + 'b' -> push '\b' >> loop + 'f' -> push '\f' >> loop + 'u' -> do + pp <- readIORef posRef + let hex = take 4 (drop pp arr) + modifyIORef' posRef (+ 4) + case readHex hex of [(code, _)] -> push (chr code) >> loop; _ -> loop + _ -> push e >> loop + else push c >> loop + push c = modifyIORef' bRef (c :) + loop + pnum = do + start <- readIORef posRef + let go = do + p <- readIORef posRef + if p < n && (at p `elem` "0123456789-+.eE") then adv >> go else return () + go + end <- readIORef posRef + let tok = take (end - start) (drop start arr) + return (VNum (read tok)) + pval + +-- ---------------- fixJSON / equality ---------------- + +fixJson :: Value -> Bool -> IO Value +fixJson v flagNull = case v of + VNoval -> return (if flagNull then VStr nullmark else v) + VNull -> return (if flagNull then VStr nullmark else v) + VMap m -> do + es <- readIORef m + o <- emptyMap + forM_ es $ \(k, x) -> do fx <- fixJson x flagNull; _ <- setprop o (VStr k) fx; return () + return o + VList r -> do its <- readIORef r; xs <- mapM (\x -> fixJson x flagNull) its; mkList xs + _ -> return v + +eqv :: Value -> Value -> IO Bool +eqv a b = case (a, b) of + (VNoval, VNoval) -> return True + (VNoval, VNull) -> return True + (VNull, VNoval) -> return True + (VNull, VNull) -> return True + (VBool x, VBool y) -> return (x == y) + (VNum x, VNum y) -> return (x == y) + (VStr x, VStr y) -> return (x == y) + (VList x, VList y) -> do + xs <- readIORef x; ys <- readIORef y + if length xs /= length ys then return False else allM (zipWith eqv xs ys) + (VMap x, VMap y) -> do + xs <- readIORef x; ys <- readIORef y + if length xs /= length ys then return False + else allM [case lookup k ys of Just w -> eqv v w; Nothing -> return False | (k, v) <- xs] + _ -> return (sameRef a b) + where + allM = andM + sameRef (VList p) (VList q) = p == q + sameRef (VMap p) (VMap q) = p == q + sameRef VNoval VNoval = True + sameRef _ _ = False + +-- ---------------- match support ---------------- + +containsLower :: String -> String -> Bool +containsLower hay needle = + let h = map toLower hay; nd = map toLower needle + in null nd || go h + where + go [] = False + go s@(_:rest) = (map toLower needle `isPrefixOf` map toLower s) || go rest + +matchval :: Value -> Value -> IO Bool +matchval check0 base = do + let check = if vStrEq check0 undefmark || vStrEq check0 nullmark then VNoval else check0 + e <- eqv check base + if e then return True + else case check of + VStr cs -> do + basestr <- stringify base + if length cs >= 2 && head cs == '/' && last cs == '/' + then return (Vregex.testStr (take (length cs - 2) (drop 1 cs)) basestr) + else do cstr <- stringify check; return (containsLower basestr cstr) + VFunc _ -> return True + _ -> return False + +doMatch :: Value -> Value -> IO () +doMatch check base0 = do + base <- clone base0 + _ <- walk (Just (\_ v _ path -> do + when (not (isnode v)) $ do + baseval <- getpath INone base path + e <- eqv baseval v + if e then return () + else if vStrEq v undefmark && isNullish baseval then return () + else if vStrEq v existsmark && not (isNullish baseval) then return () + else do + mv <- matchval v baseval + if not mv then do + pelems <- listItems path + pstrs <- mapM jsString pelems + sv <- stringify v + sb <- stringify baseval + ioError (userError ("MATCH: " ++ intercalate "." pstrs ++ ": [" ++ sv ++ "] <=> [" ++ sb ++ "]")) + else return () + return v)) Nothing VNoval check + return () + +-- ---------------- result tracking ---------------- + +data Counters = Counters { npass :: IORef Int, nfail :: IORef Int, failures :: IORef [String] } + +record :: Counters -> String -> String -> Bool -> String -> IO () +record c group name ok msg = + if ok then modifyIORef' (npass c) (+ 1) + else do modifyIORef' (nfail c) (+ 1); modifyIORef' (failures c) (++ ["FAIL " ++ group ++ " " ++ name ++ " - " ++ msg]) + +errMsg :: SomeException -> String +errMsg e = case lines (show e) of (l:_) -> stripUser l; [] -> show e + where stripUser s = case dropWhile (/= ':') s of _ -> s + +-- ---------------- per-entry runner ---------------- + +omapV :: [(String, Value)] -> IO Value +omapV = mkMap + +entryGet :: Value -> String -> IO Value +entryGet e k = getpropRaw e k + +entryHas :: Value -> String -> IO Bool +entryHas e k = case e of { VMap m -> do { es <- readIORef m; return (any ((== k) . fst) es) }; _ -> return False } + +resolveArgs :: Value -> IO [Value] +resolveArgs entry = do + hc <- entryHas entry "ctx" + if hc then do c <- entryGet entry "ctx"; return [c] + else do + ha <- entryHas entry "args" + if ha then do a <- entryGet entry "args"; if islist a then listItems a else return [] + else do + hi <- entryHas entry "in" + if hi then do v <- entryGet entry "in"; c <- clone v; return [c] + else return [VNoval] + +checkResult :: Value -> [Value] -> Value -> IO () +checkResult entry args res = do + hm <- entryHas entry "match" + matched <- if hm then do + mv <- entryGet entry "match" + ein <- entryGet entry "in"; eres <- entryGet entry "res"; ectx <- entryGet entry "ctx" + al <- mkList args + o <- omapV [("in", ein), ("args", al), ("out", eres), ("ctx", ectx)] + doMatch mv o + return True + else return False + out <- entryGet entry "out" + e <- eqv out res + if e then return () + else if matched && (vStrEq out nullmark || isNullish out) then return () + else do so <- stringify out; sr <- stringify res; ioError (userError ("Expected: " ++ so ++ ", got: " ++ sr)) + +handleError :: Value -> SomeException -> IO () +handleError entry err = do + let msg = exMsg err + he <- entryHas entry "err" + if he then do + entryErr <- entryGet entry "err" + em <- matchval entryErr (VStr msg) + if vIsTrue entryErr || em then do + hm <- entryHas entry "match" + when hm $ do + mv <- entryGet entry "match" + ein <- entryGet entry "in"; eres <- entryGet entry "res"; ectx <- entryGet entry "ctx" + o <- omapV [("in", ein), ("out", eres), ("ctx", ectx), ("err", VStr msg)] + doMatch mv o + else do se <- stringify entryErr; ioError (userError ("ERROR MATCH: [" ++ se ++ "] <=> [" ++ msg ++ "]")) + else throwIO err + +exMsg :: SomeException -> String +exMsg e = + let s = show e + in case stripPrefix "user error (" s of + Just rest -> reverse (drop 1 (reverse rest)) -- drop trailing ')' + Nothing -> s + where stripPrefix p str = if p `isPrefixOf` str then Just (drop (length p) str) else Nothing + +runSet :: Counters -> String -> Value -> ([Value] -> IO Value) -> Bool -> IO () +runSet c group node subject flagNull = do + fixed <- fixJson node flagNull + testset <- getprop fixed (VStr "set") >>= \ts -> if islist ts then listItems ts else return [] + forM_ testset $ \entry -> do + nm <- entryGet entry "name" >>= jsString + result <- try (runOne entry) :: IO (Either SomeException ()) + case result of + Right () -> record c group nm True "" + Left e -> do + r2 <- try (handleError entry e) :: IO (Either SomeException ()) + case r2 of + Right () -> record c group nm True "" + Left e2 -> record c group nm False (exMsg e2) + where + runOne entry = do + ho <- entryHas entry "out" + when (not ho && flagNull) $ do _ <- setprop entry (VStr "out") (VStr nullmark); return () + args <- resolveArgs entry + r <- subject args + res <- fixJson r flagNull + _ <- setprop entry (VStr "res") res + checkResult entry args res + +runSingle :: Counters -> String -> Value -> (Value -> IO Value) -> IO () +runSingle c group node actualFn = do + result <- try go :: IO (Either SomeException ()) + case result of + Right () -> return () + Left e -> record c group "single" False (exMsg e) + where + go = do + expected <- entryGet node "out" + inv <- entryGet node "in" + actual <- actualFn inv + e <- eqv expected actual + if e then record c group "single" True "" + else do se <- stringify expected; sa <- stringify actual; record c group "single" False ("Expected: " ++ se ++ ", got: " ++ sa) + +-- ---------------- arg helpers ---------------- + +arg1 :: (Value -> IO Value) -> [Value] -> IO Value +arg1 f = \args -> f (case args of (x:_) -> x; [] -> VNoval) + +vget :: Value -> String -> IO Value +vget vin k = case vin of { VMap m -> do { es <- readIORef m; return (maybe VNoval id (lookup k es)) }; _ -> return VNoval } + +vhas :: Value -> String -> IO Bool +vhas vin k = case vin of { VMap m -> do { es <- readIORef m; return (any ((== k) . fst) es) }; _ -> return False } + +-- ---------------- main ---------------- + +main :: IO () +main = do + args <- getArgs + let testfile = case args of (f:_) -> f; [] -> "../build/test/test.json" + raw <- readFile testfile + alltests <- jsonRead raw + spec <- entryGet alltests "struct" + c <- Counters <$> newIORef 0 <*> newIORef 0 <*> newIORef [] + runAll c spec + fs <- readIORef (failures c) + forM_ fs putStrLn + p <- readIORef (npass c) + f <- readIORef (nfail c) + putStrLn ("\nPASS " ++ show p ++ " FAIL " ++ show f) + when (f > 0) exitFailure + +-- ---------------- test groups ---------------- + +nullModifier :: Value -> Value -> Value -> Inj -> IO () +nullModifier v key parent _inj = + if vStrEq v nullmark then setprop parent key VNull >> return () + else case v of + VStr s -> do _ <- setprop parent key (VStr (replaceAll s nullmark "null")); return () + _ -> return () + +runAll :: Counters -> Value -> IO () +runAll c spec = do + let g k = getpropRaw spec k + minor <- g "minor"; walks <- g "walk"; merges <- g "merge" + getpaths <- g "getpath"; injects <- g "inject"; transforms <- g "transform" + validates <- g "validate"; selects <- g "select"; sentinels <- g "sentinels" + let mg k = getpropRaw minor k + rs group nd subj fl = do n <- nd; runSet c group n subj fl + rsT group nd subj = rs group nd subj True + rsF group nd subj = rs group nd subj False + + rsT "minor.isnode" (mg "isnode") (arg1 (\v -> return (VBool (isnode v)))) + rsT "minor.ismap" (mg "ismap") (arg1 (\v -> return (VBool (ismap v)))) + rsT "minor.islist" (mg "islist") (arg1 (\v -> return (VBool (islist v)))) + rsF "minor.iskey" (mg "iskey") (arg1 (\v -> return (VBool (iskey v)))) + rsF "minor.strkey" (mg "strkey") (arg1 (\v -> return (VStr (strkey v)))) + rsF "minor.isempty" (mg "isempty") (arg1 (\v -> VBool <$> isempty v)) + rsT "minor.isfunc" (mg "isfunc") (arg1 (\v -> return (VBool (isfunc v)))) + rsF "minor.clone" (mg "clone") (arg1 clone) + rsT "minor.escre" (mg "escre") (arg1 escre) + rsT "minor.escurl" (mg "escurl") (arg1 escurl) + rsF "minor.stringify" (mg "stringify") (arg1 (\vin -> do + h <- vhas vin "val" + if h then do val <- vget vin "val"; mx <- vget vin "max"; VStr <$> stringifyMax val mx + else VStr <$> stringify VNoval)) + rsF "minor.jsonify" (mg "jsonify") (arg1 (\vin -> do val <- vget vin "val"; fl <- vget vin "flags"; VStr <$> jsonify val fl)) + rsF "minor.getelem" (mg "getelem") (arg1 (\vin -> do + alt <- vget vin "alt"; val <- vget vin "val"; key <- vget vin "key" + if isNullish alt then getelem val key else getelemAlt alt val key)) + rsT "minor.delprop" (mg "delprop") (arg1 (\vin -> do p <- vget vin "parent"; k <- vget vin "key"; delprop p k)) + rsF "minor.size" (mg "size") (arg1 (\v -> vint <$> size v)) + rsF "minor.slice" (mg "slice") (arg1 (\vin -> do val <- vget vin "val"; st <- vget vin "start"; en <- vget vin "end"; slice val st en)) + rsF "minor.pad" (mg "pad") (arg1 (\vin -> do val <- vget vin "val"; pd <- vget vin "pad"; ch <- vget vin "char"; VStr <$> pad val pd ch)) + rsF "minor.pathify" (mg "pathify") (arg1 (\vin -> do + h <- vhas vin "path"; frm <- vget vin "from" + if h then do pth <- vget vin "path"; VStr <$> pathifyFull pth frm VNoval False + else VStr <$> pathifyFull VNoval frm VNoval True)) + rsT "minor.items" (mg "items") (arg1 items) + rsF "minor.getprop" (mg "getprop") (arg1 (\vin -> do + alt <- vget vin "alt"; val <- vget vin "val"; key <- vget vin "key" + if isNullish alt then getprop val key else getpropAlt alt val key)) + rsT "minor.setprop" (mg "setprop") (arg1 (\vin -> do p <- vget vin "parent"; k <- vget vin "key"; val <- vget vin "val"; setprop p k val)) + rsF "minor.haskey" (mg "haskey") (arg1 (\vin -> do s <- vget vin "src"; k <- vget vin "key"; VBool <$> haskey s k)) + rsT "minor.keysof" (mg "keysof") (arg1 (\v -> do ks <- keysof v; mkList (map VStr ks))) + rsF "minor.join" (mg "join") (arg1 (\vin -> do val <- vget vin "val"; sep <- vget vin "sep"; url <- vget vin "url"; VStr <$> join val sep (vIsTrue url))) + rsF "minor.typify" (mg "typify") (arg1 (\v -> return (vint (typify v)))) + rsF "minor.setpath" (mg "setpath") (arg1 (\vin -> do st <- vget vin "store"; pth <- vget vin "path"; val <- vget vin "val"; setpath st pth val)) + rsT "minor.filter" (mg "filter") (arg1 (\vin -> do + val <- vget vin "val"; ch <- vget vin "check" + let check = case ch of + VStr "gt3" -> \(_, x) -> case x of VNum n -> n > 3; _ -> False + VStr "lt3" -> \(_, x) -> case x of VNum n -> n < 3; _ -> False + _ -> \_ -> False + VoxgigStruct.filter val check)) + rsT "minor.typename" (mg "typename") (arg1 (\v -> return (VStr (typename (case v of VNum n -> truncate n; _ -> 0))))) + rsT "minor.flatten" (mg "flatten") (arg1 (\vin -> do + val <- vget vin "val"; d <- vget vin "depth" + flatten (case d of VNum n -> truncate n; _ -> 1) val)) + + runWalkLog c "walk.log" =<< getpropRaw walks "log" + do nd <- getpropRaw walks "basic" + rs "walk.basic" (return nd) (arg1 (\vin -> walk Nothing (Just (\_ v _ path -> + case v of { VStr s -> do { pelems <- listItems path; pstrs <- mapM jsString pelems; return (VStr (s ++ "~" ++ intercalate "." pstrs)) }; _ -> return v })) VNoval vin)) True + do nd <- getpropRaw walks "copy"; rs "walk.copy" (return nd) (arg1 (walkCopySubject)) True + do nd <- getpropRaw walks "depth"; rs "walk.depth" (return nd) (arg1 (walkDepthSubject)) False + + do nd <- getpropRaw merges "basic"; runSingle c "merge.basic" nd (\in_ -> clone in_ >>= merge) + rsT "merge.cases" (getpropRaw merges "cases") (arg1 merge) + rsT "merge.array" (getpropRaw merges "array") (arg1 merge) + rsT "merge.integrity" (getpropRaw merges "integrity") (arg1 merge) + rsT "merge.depth" (getpropRaw merges "depth") (arg1 (\vin -> do val <- vget vin "val"; d <- vget vin "depth"; mergeD val d)) + + rsT "getpath.basic" (getpropRaw getpaths "basic") (arg1 (\vin -> do st <- vget vin "store"; pth <- vget vin "path"; getpath INone st pth)) + rsT "getpath.relative" (getpropRaw getpaths "relative") (arg1 (\vin -> do + st <- vget vin "store"; pth <- vget vin "path"; dpv <- vget vin "dpath"; dpar <- vget vin "dparent" + dpath <- case dpv of VStr s -> mkList (map VStr (splitOn '.' s)); _ -> return VNoval + let d = (defaultInjDef VNoval) { dDparent = dpar, dDpath = dpath } + getpath (IDef d) st pth)) + rsT "getpath.special" (getpropRaw getpaths "special") (arg1 (\vin -> do + st <- vget vin "store"; pth <- vget vin "path"; injm <- vget vin "inj" + bs <- getprop injm (VStr "base"); mt <- getprop injm (VStr "meta"); dpar <- getprop injm (VStr "dparent"); dpt <- getprop injm (VStr "dpath"); ky <- getprop injm (VStr "key") + let d = (defaultInjDef VNoval) { dBase = bs, dMeta = mt, dDparent = dpar, dDpath = dpt, dKey = ky } + getpath (if isNullish injm then INone else IDef d) st pth)) + rsT "getpath.handler" (getpropRaw getpaths "handler") (arg1 (\vin -> do + stv <- vget vin "store"; pth <- vget vin "path" + store <- omapV [("$TOP", stv), ("$FOO", VFunc (\_ _ _ _ -> return (VStr "foo")))] + let d = (defaultInjDef VNoval) { dHandler = Just (\_inj v _ref _store -> case v of VFunc f -> f dummyInj VNoval "" VNoval; _ -> return v) } + getpath (IDef d) store pth)) + + do nd <- getpropRaw injects "basic"; runSingle c "inject.basic" nd (\in_ -> do val <- getpropRaw in_ "val" >>= clone; st <- getpropRaw in_ "store" >>= clone; inject INone val st) + rsT "inject.string" (getpropRaw injects "string") (arg1 (\vin -> do val <- vget vin "val"; st <- vget vin "store"; cur <- vget vin "current"; let d = (defaultInjDef VNoval) { dModify = Just nullModifier, dExtra = cur } in inject (IDef d) val st)) + rsT "inject.deep" (getpropRaw injects "deep") (arg1 (\vin -> do val <- vget vin "val"; st <- vget vin "store"; inject INone val st)) + + do nd <- getpropRaw transforms "basic"; runSingle c "transform.basic" nd (\in_ -> do dat <- getpropRaw in_ "data"; sp <- getpropRaw in_ "spec"; transform INone dat sp) + forM_ ["paths", "cmds", "each", "pack", "ref"] $ \gn -> + rsT ("transform." ++ gn) (getpropRaw transforms gn) (arg1 (\vin -> do dat <- vget vin "data"; sp <- vget vin "spec"; transform INone dat sp)) + rsT "transform.modify" (getpropRaw transforms "modify") (arg1 (\vin -> do + dat <- vget vin "data"; sp <- vget vin "spec"; st <- vget vin "store" + let modf = \v key parent _inj -> case v of VStr s | not (isNullish key) && not (isNullish parent) -> setprop parent key (VStr ("@" ++ s)) >> return (); _ -> return () + d = (defaultInjDef VNoval) { dModify = Just modf, dExtra = st } + transform (IDef d) dat sp)) + rsF "transform.format" (getpropRaw transforms "format") (arg1 (\vin -> do dat <- vget vin "data"; sp <- vget vin "spec"; transform INone dat sp)) + rsT "transform.apply" (getpropRaw transforms "apply") (arg1 (\vin -> do dat <- vget vin "data"; sp <- vget vin "spec"; transform INone dat sp)) + + rsF "validate.basic" (getpropRaw validates "basic") (arg1 (\vin -> do dat <- vget vin "data"; sp <- vget vin "spec"; validate INone dat sp)) + forM_ ["child", "one", "exact"] $ \gn -> + rsT ("validate." ++ gn) (getpropRaw validates gn) (arg1 (\vin -> do dat <- vget vin "data"; sp <- vget vin "spec"; validate INone dat sp)) + rsF "validate.invalid" (getpropRaw validates "invalid") (arg1 (\vin -> do dat <- vget vin "data"; sp <- vget vin "spec"; validate INone dat sp)) + rsT "validate.special" (getpropRaw validates "special") (arg1 (\vin -> do + dat <- vget vin "data"; sp <- vget vin "spec"; injm <- vget vin "inj" + mt <- getprop injm (VStr "meta") + let d = (defaultInjDef VNoval) { dMeta = mt } + validate (if isNullish injm then INone else IDef d) dat sp)) + + forM_ ["basic", "operators", "edge", "alts"] $ \gn -> + rsT ("select." ++ gn) (getpropRaw selects gn) (arg1 (\vin -> do obj <- vget vin "obj"; qry <- vget vin "query"; select obj qry)) + + rsF "sentinels.getprop_unify" (getpropRaw sentinels "getprop_unify") (arg1 (\vin -> do alt <- vget vin "alt"; val <- vget vin "val"; key <- vget vin "key"; getpropAlt alt val key)) + rsF "sentinels.getelem_absent" (getpropRaw sentinels "getelem_absent") (arg1 (\vin -> do alt <- vget vin "alt"; val <- vget vin "val"; key <- vget vin "key"; getelemAlt alt val key)) + rsF "sentinels.haskey_unify" (getpropRaw sentinels "haskey_unify") (arg1 (\vin -> do val <- vget vin "val"; key <- vget vin "key"; VBool <$> haskey val key)) + rsF "sentinels.isempty_unify" (getpropRaw sentinels "isempty_unify") (arg1 (\v -> VBool <$> isempty v)) + rsF "sentinels.isnode_unify" (getpropRaw sentinels "isnode_unify") (arg1 (\v -> return (VBool (isnode v)))) + rsF "sentinels.stringify_null" (getpropRaw sentinels "stringify_null") (arg1 (\vin -> VStr <$> stringify vin)) + +runWalkLog :: Counters -> String -> Value -> IO () +runWalkLog c group node = do + result <- try go :: IO (Either SomeException ()) + case result of + Right () -> return () + Left e -> record c group "log" False (exMsg e) + where + go = do + testData <- clone node + logRef <- emptyList + let walklog _ v _ _ = return v + walklogA key v parent path = do + ks <- if isNullish key then stringify VNoval else stringify key + vs <- stringify v + ps <- if isNullish parent then stringify VNoval else stringify parent + ts <- pathify path + sz <- size logRef + _ <- setprop logRef (VNum (fromIntegral sz)) (VStr ("k=" ++ ks ++ ", v=" ++ vs ++ ", p=" ++ ps ++ ", t=" ++ ts)) + return v + din <- getpropRaw testData "in" + _ <- walk Nothing (Just walklogA) VNoval din + dout <- getpropRaw testData "out" + expected <- getprop dout (VStr "after") + e <- eqv expected logRef + if e then record c group "log" True "" + else do se <- stringify expected; sl <- stringify logRef; record c group "log" False ("Expected: " ++ se ++ ", got: " ++ sl) + +walkCopySubject :: Value -> IO Value +walkCopySubject vin = do + curRef <- newIORef =<< mkList [VNoval] + let walkcopy key v _parent path = + if isNullish key then do + inner <- if ismap v then emptyMap else if islist v then emptyList else return v + nl <- mkList [inner] + writeIORef curRef nl + return v + else do + i <- size path + nv <- if isnode v then do + cur <- readIORef curRef + let grow = do its <- listItems cur; when (length its <= i) (do _ <- setprop cur (VNum (fromIntegral (length its))) VNoval; grow) + grow + nn <- if ismap v then emptyMap else emptyList + _ <- setprop cur (VNum (fromIntegral i)) nn + return nn + else return v + cur <- readIORef curRef + tgt <- getelem cur (VNum (fromIntegral (i - 1))) + _ <- setprop tgt key nv + return v + _ <- walk (Just walkcopy) Nothing VNoval vin + cur <- readIORef curRef + getelem cur (VNum 0) + +walkDepthSubject :: Value -> IO Value +walkDepthSubject vin = do + topRef <- newIORef VNoval + currRef <- newIORef VNoval + let copy key v _parent _path = do + if isNullish key || isnode v then do + child <- if islist v then emptyList else emptyMap + if isNullish key then do writeIORef topRef child; writeIORef currRef child + else do cur <- readIORef currRef; _ <- setprop cur key child; writeIORef currRef child + else do cur <- readIORef currRef; _ <- setprop cur key v; return () + return v + src <- vget vin "src"; md <- vget vin "maxdepth" + _ <- walk (Just copy) Nothing md src + readIORef topRef diff --git a/java/AGENTS.md b/java/AGENTS.md index 0a0e6333..6547be09 100644 --- a/java/AGENTS.md +++ b/java/AGENTS.md @@ -12,16 +12,12 @@ only what is specific to the Java port. ## Status (read this) -The top-level [`../README.md`](../README.md) still lists Java as **Partial**, -and [`../REPORT.md`](../design/REPORT.md)'s per-language section echoes an older -"22 of 40 / no test runner" snapshot. Both are **stale**. The current source -defines the **full canonical API** — all 40 functions, the `Injection` state -machine, `SKIP`/`DELETE`, mode constants + `MODENAME`, all 11 transform -commands, the validate checkers, and the 4 select operators — and -`python3 ../tools/check_parity.py` reports it `ok`; the committed baseline -([`test-baseline.json`](./test-baseline.json)) passes the shared corpus -suite across all eight files. Trust the source and the parity tool over the -prose tables. +**Complete.** The source defines the **full canonical API** — all 40 +functions, the `Injection` state machine, `SKIP`/`DELETE`, mode constants + +`MODENAME`, all 11 transform commands, the validate checkers, and the 4 +select operators — `python3 ../tools/check_parity.py` reports it `ok`, and +the shared corpus passes in full (1300/1300; the committed baseline +[`test-baseline.json`](./test-baseline.json) records the per-file counts). ## Layout diff --git a/java/README.md b/java/README.md index 30ce9c3a..3ebc5121 100644 --- a/java/README.md +++ b/java/README.md @@ -19,10 +19,9 @@ parity matrix, see the [top-level README](../README.md) and [REPORT.md](../design/REPORT.md). For the in-depth guide (tutorial, recipes, explanation), see [`DOCS.md`](./DOCS.md). -> **Maturity note.** The top-level README lists Java as a *partial* port. -> That label is about project maturity (and the JVM family lagging the -> canonical by a release), **not** missing API: the full canonical surface -> is present and the parity check reports Java `ok`. +> **Status: complete.** The full canonical surface is present, the parity +> check reports Java `ok`, and the shared `build/test/` corpus passes in +> full (1300/1300, `make test-java`). ## Install diff --git a/java/src/test/Runner.java b/java/src/test/Runner.java index 2b10c2a6..dd44e607 100644 --- a/java/src/test/Runner.java +++ b/java/src/test/Runner.java @@ -123,7 +123,12 @@ public static Result runsetflags( // way before comparison. This preserves the null-vs-absent distinction // across the round-trip exactly as the canonical cross-port runner does. if (nullFlag) { - in = fixJSON(in); + // Only encode a *present* input; an absent `in` stays UNDEF so the + // subject sees "undefined" (matches the canonical runner, which clones + // the absent value rather than a null marker). + if (entry.containsKey("in")) { + in = fixJSON(in); + } expected = fixJSON(expected); } diff --git a/java/src/test/StructCorpusTest.java b/java/src/test/StructCorpusTest.java index 335a0ff7..ddd61002 100644 --- a/java/src/test/StructCorpusTest.java +++ b/java/src/test/StructCorpusTest.java @@ -102,8 +102,9 @@ Iterable corpus() { Object key = getp(in, "key"); return Struct.delprop(parent == Struct.UNDEF ? null : parent, key); }); - add(tests, "minor", "stringify", true, in -> { - // Use UNDEF for absent val so stringify renders "" instead of "null". + add(tests, "minor", "stringify", false, in -> { + // null:false keeps a JSON-null val as a real null (rendered "null"); an + // absent val is UNDEF (rendered ""). Mirrors the canonical harness. Object val = getpDef(in, "val", Struct.UNDEF); Object max = getp(in, "max"); Integer m = max instanceof Number n ? n.intValue() : null; @@ -114,9 +115,9 @@ Iterable corpus() { Object flags = getp(in, "flags"); return Struct.jsonify(val, flags); }); - add(tests, "minor", "pathify", true, in -> { - // Use UNDEF for absent keys so pathify renders "" instead - // of "" (matches JS undefined-vs-null semantics). + add(tests, "minor", "pathify", false, in -> { + // null:false keeps a JSON-null path as a real null ("") + // and an absent path as UNDEF (""); null parts are dropped. Object path = getpDef(in, "path", Struct.UNDEF); Object from = getp(in, "from"); Object to = getp(in, "to"); diff --git a/java/test-baseline.json b/java/test-baseline.json index e0a2ec0e..818c4286 100644 --- a/java/test-baseline.json +++ b/java/test-baseline.json @@ -1,40 +1,40 @@ { "files": { "getpath.jsonic": { - "passed": 87, - "total": 87 + "passed": 94, + "total": 94 }, "inject.jsonic": { "passed": 41, "total": 41 }, "merge.jsonic": { - "passed": 133, - "total": 133 + "passed": 141, + "total": 141 }, "minor.jsonic": { - "passed": 506, - "total": 506 + "passed": 553, + "total": 553 }, "select.jsonic": { - "passed": 47, - "total": 47 + "passed": 88, + "total": 88 }, "transform.jsonic": { - "passed": 187, - "total": 187 + "passed": 192, + "total": 192 }, "validate.jsonic": { - "passed": 131, - "total": 131 + "passed": 142, + "total": 142 }, "walk.jsonic": { - "passed": 46, - "total": 46 + "passed": 49, + "total": 49 } }, "total": { - "passed": 1178, - "total": 1178 + "passed": 1300, + "total": 1300 } } diff --git a/kotlin/AGENTS.md b/kotlin/AGENTS.md index 4879d8a4..f41c63d3 100644 --- a/kotlin/AGENTS.md +++ b/kotlin/AGENTS.md @@ -13,12 +13,10 @@ covers only what is specific to the Kotlin port. ## Status -Classified **Partial** in [`../README.md`](../README.md) and -[`../REPORT.md`](../design/REPORT.md) (same bracket as Java). In practice the -full canonical surface is present (40 functions, 15 type flags, 3 mode -constants, the sentinels, the `Injection` machine) and -`../tools/check_parity.py` reports it `ok`. REPORT.md records it as -**already Group A**, passing 135/135. +**Complete.** The full canonical surface is present (40 functions, 15 type +flags, 3 mode constants, the sentinels, the `Injection` machine), +`../tools/check_parity.py` reports it `ok`, and the shared corpus passes in +full (1315/1315). ## Layout diff --git a/kotlin/README.md b/kotlin/README.md index 52149706..65bab8e5 100644 --- a/kotlin/README.md +++ b/kotlin/README.md @@ -2,8 +2,8 @@ > Kotlin/JVM port of the canonical TypeScript implementation. > -> **Status: partial port** (alongside Java) — but it currently carries -> the **full** TS-canonical public API: all 48 functions, 15 type +> **Status: complete.** Carries the **full** TS-canonical public API and +> passes the shared corpus in full (1315/1315). All 48 functions, 15 type > bit-flags, 3 mode constants (`M_KEYPRE`/`M_KEYPOST`/`M_VAL`), > `SKIP`/`DELETE` sentinels, and the `Injection` state machine. > `inject()`/`transform()`/`validate()`/`select()` all dispatch through @@ -563,14 +563,12 @@ Inside backticks in a `validate` spec (implemented as `validate_STRING`, ## Notes -### Why partial? +### Status -The Kotlin port is classified **Partial** in the parity matrix -([`../REPORT.md`](../design/REPORT.md)) in the same bracket as Java. In -practice it implements the entire canonical public surface and -`check_parity.py` reports it `ok`; the classification reflects port -maturity rather than a missing API. Treat behavioural authority as -resting with the canonical TypeScript and the shared corpus. +The Kotlin port is **Complete**: it implements the entire canonical public +surface, `check_parity.py` reports it `ok`, and it passes the shared corpus +in full (1315/1315). Treat behavioural authority as resting with the +canonical TypeScript and the shared corpus. ### `null` conventions diff --git a/ocaml/AGENTS.md b/ocaml/AGENTS.md new file mode 100644 index 00000000..cdaf8334 --- /dev/null +++ b/ocaml/AGENTS.md @@ -0,0 +1,67 @@ +# AGENTS.md — OCaml port of `voxgig/struct` + +Read the repo-root [`AGENTS.md`](../AGENTS.md) first. This file covers only +what is specific to the OCaml port. **TypeScript is canonical; the shared +`build/test/*.jsonic` corpus is the contract.** This port mirrors the +canonical TypeScript logic directly (not the Python port), because OCaml — like +TypeScript and Rust — keeps `undefined` and JSON `null` as distinct values. + +## How to build / test / lint + +``` +cd ocaml +make test # ocamlc compiles src + test, runs build/test/test.json +make lint # type-checks the library (a clean compile = pass) +``` + +Requires only the OCaml compiler (`ocamlc`). **Zero third-party +dependencies** — no opam packages, no `Str`. The test runner has an in-tree +JSON reader, and regex is the in-tree `src/vregex.ml` engine. + +## The value model + +Everything is one variant type (`value`) so the functions are effectively +dynamic within it: + +``` +Noval | Null | Bool | Num of float | Str | List of value list ref + | Map of omap | Func of injector | Sentinel of string +``` + +- **`Noval` is the TS `undefined`** (property absent); **`Null` is JSON null**. + They are distinct — this is the canonical TS model. `is_nullish` covers both + (JS `null == v`); `is_noval` is `undefined` only. Group A readers (`getprop`, + `getelem`, `haskey`) return the default on either; Group B processors use the + raw `lookup_` to preserve `Null`. **Getting `getprop` (Group A) vs `lookup_` + (raw) right is the single most common source of port bugs** — e.g. validate's + bad-key check and `transform_FORMAT`/`$REF` argument reads must use `lookup_`. +- **Numbers are a single `Num of float`** (like Rust). `typify` splits + integer/decimal via `Number.isInteger` semantics (`2.0` is an integer). +- **Nodes are mutable and reference-stable:** lists are `value list ref`, maps + are the in-tree ordered `omap` (insertion order preserved). The algorithm + mutates them in place; never swap in an immutable structure. +- **`skip` / `delete`** are `Sentinel` values compared structurally by tag. + +## Injection state + +`inj` is a mutable record (the `Injection`). The public API accepts a loose +`injdef` record (the `Partial` of the canonical) wrapped in the +`injarg` variant (`IInj | IDef | INone`), so `getpath` / `inject` / `transform` +/ `validate` work both with a live `inj` (recursion) and a caller-supplied +options record. + +## Naming + +Public names are the canonical names, lower-smushed or snake_cased so they +match case/underscore-insensitively (`getpath`, `ismap`, `re_find_all`, +`check_placement` ≡ `checkPlacement`, `injector_args` ≡ `injectorArgs`, +`inject_child` ≡ `injectChild`). Avoid the OCaml keyword `val` as an +identifier — local value parameters are named `v`. + +## Gotchas + +- **Comments cannot contain `*)`** — regex-bearing comments are reworded. +- **`Group A` vs raw `lookup_`** — see above; re-check before touching any + read path in validate / transform. +- Keep `make test` and `python3 ../tools/check_parity.py` green, and add no + runtime dependencies. Change canonical (TS + corpus) first, then propagate. diff --git a/ocaml/DOCS.md b/ocaml/DOCS.md new file mode 100644 index 00000000..36648d91 --- /dev/null +++ b/ocaml/DOCS.md @@ -0,0 +1,117 @@ +# OCaml port — comprehensive guide + +This document covers the OCaml-specific details of `voxgig/struct`. For the +language-neutral concepts, tutorial and full reference, read the top-level +[`DOCS.md`](../DOCS.md); for the user overview, [`README.md`](./README.md). +TypeScript is canonical and the shared `build/test` corpus is the contract. + +## Installation + +The whole library is two source files under `src/` and needs nothing but the +OCaml compiler. Compile it into your project (`ocamlc -I src src/vregex.ml +src/voxgig_struct.ml ...`) and `open Voxgig_struct`. + +## Representation of data + +| JSON-shape thing | OCaml representation | +|-------------------------|------------------------------------| +| object / map | `Map of omap` (insertion-ordered) | +| array / list | `List of value list ref` | +| string | `Str of string` | +| number (int or decimal) | `Num of float` | +| boolean | `Bool of bool` | +| JSON `null` | `Null` | +| undefined / absent | `Noval` | +| function (commands) | `Func of injector` | + +Nodes are **mutable and reference-stable** on purpose: `merge`, `walk`, +`inject`, `transform`, `validate` mutate nodes in place and depend on shared +references. Build nodes directly (or with `jm` / `jt`); the in-tree `omap` +preserves insertion order. + +### `Noval` vs `Null` + +Unlike the single-`nil` ports (Python, Clojure, Lua), OCaml keeps the two +canonical concepts apart, exactly like TypeScript and Rust: + +- `Noval` — the TS `undefined`: a property is absent. **Not** a scalar. +- `Null` — JSON `null`: a real value. + +The Group A / Group B rules ([`design/UNDEF_SPEC.md`](../design/UNDEF_SPEC.md)) +decide which one a slot collapses to: + +- **Group A** readers — `getprop`, `getelem`, `haskey` — treat a stored `Null` + as "no value" (they return the default). +- **Group B** processors — `setprop`, `clone`, `merge`, `walk`, `inject`, + `transform`, `validate`, `select` — preserve `Null` literally. The internal + `lookup_` is the raw reader they use when null must survive. + +```ocaml +typify Noval (* T_noval *) +typify Null (* T_scalar lor T_null *) +stringify Noval (* "" *) +stringify Null (* "null" *) +``` + +## The public API + +Names are the canonical names, lower-smushed or snake_cased: + +- **Lookups / paths:** `getpath`, `setpath`, `getprop`, `setprop`, `getelem`, + `delprop`, `haskey`, `keysof`, `items`. +- **Predicates / kinds:** `isnode`, `ismap`, `islist`, `iskey`, `isfunc`, + `isempty`, `typify`, `typename`. +- **Values:** `clone`, `merge`, `walk`, `size`, `slice`, `pad`, `flatten`, + `filter`, `getdef`, `strkey`. +- **Strings / formatting:** `stringify`, `jsonify`, `pathify`, `join`, + `escre`, `escurl`. +- **Regex (RE2-subset uniform API):** `re_compile`, `re_find`, `re_find_all`, + `re_replace`, `re_test`, `re_escape`. Backed by the in-tree `Vregex` engine. +- **By-example engine:** `inject`, `transform`, `validate`, `select`, and the + injector helpers `check_placement`, `injector_args`, `inject_child`. +- **Builders / markers:** `jm`, `jt`, `skip`, `delete`, the `t_*` type + constants and `m_keypre` / `m_keypost` / `m_val`. + +Many functions take OCaml optional arguments where the canonical has optional +parameters, e.g. `getprop ?alt v key`, `slice ?start ?stop ?mutate v`, +`stringify ?maxlen ?pretty v`, `merge ?maxdepth objs`. + +## Examples + +```ocaml +open Voxgig_struct + +(* merge: later wins; the first node is modified in place *) +merge (jt [jm [Str "a"; Num 1.0]; jm [Str "b"; Num 2.0]]) (* {a:1,b:2} *) + +(* transform: spec mirrors the output; backticks pull from the data *) +transform (jm [Str "name"; Str "alice"]) + (jm [Str "user"; jm [Str "id"; Str "`name`"]]) (* {user:{id:alice}} *) + +(* validate: plain values are typed defaults; `$STRING` etc. are commands *) +validate (jm [Str "a"; Str "x"]) (jm [Str "a"; Str "`$STRING`"]) (* {a:x} *) + +(* select: MongoDB-style query over children *) +select (jt [jm [Str "a"; Num 1.0]; jm [Str "a"; Num 2.0]]) + (jm [Str "a"; jm [Str "`$GT`"; Num 1.0]]) (* [{$KEY:1,a:2}] *) +``` + +## Testing + +`make test` compiles `src/` + `test/runner.ml` with `ocamlc` and runs the +entire shared corpus (`../build/test/test.json`) through the port, using an +in-tree JSON reader and the same runner logic as every other port. Keep it +green, keep `python3 ../tools/check_parity.py` green, and add no runtime +dependencies. + +## Implementation notes + +- The injection state (`inj`) is a mutable record; callers pass a loose + `injdef` record via the `injarg` variant, so it is never confused with data. +- `skip` / `delete` are `Sentinel` markers. +- Numbers follow JS formatting in `stringify` / `jsonify` (an integral float + prints without a trailing `.0`); `num_to_string` finds the shortest + round-tripping representation. +- `src/vregex.ml` is a small backtracking regex engine covering the RE2 subset + the corpus uses (classes, `\d \w \s \b`, `{n,m}`, groups, alternation, lazy + quantifiers) — enough for `$LIKE` and the `re_*` API, with no dependency. diff --git a/ocaml/Makefile b/ocaml/Makefile new file mode 100644 index 00000000..636571fb --- /dev/null +++ b/ocaml/Makefile @@ -0,0 +1,37 @@ +# Makefile for the OCaml port of voxgig/struct. +# Requires the OCaml compiler (ocamlc / ocamlopt). No third-party libraries. + +OCAMLC = ocamlc +SRC = src/vregex.ml src/voxgig_struct.ml +TESTSRC = $(SRC) test/runner.ml + +.PHONY: test lint build inspect clean reset publish + +# Build and run the shared JSON corpus through the OCaml implementation. +test: run_tests + ./run_tests + +run_tests: $(TESTSRC) + $(OCAMLC) -I src $(TESTSRC) -o run_tests + +# "Lint": type-check the library (a clean compile means it is sound). No +# third-party linter is required; ocamlformat can be wired into this target. +lint: + $(OCAMLC) -I src -c $(SRC) + @echo ok + +build: + $(OCAMLC) -I src -c $(SRC) + +inspect: + @$(OCAMLC) -version + +clean: + rm -f src/*.cmi src/*.cmo test/*.cmi test/*.cmo run_tests + +reset: clean + +# The library publishes to opam; this target creates the git tag. Configure +# opam-publish for a real release. +publish: + @echo "ocaml: publish via opam + git tag ocaml/vX.Y.Z" diff --git a/ocaml/README.md b/ocaml/README.md new file mode 100644 index 00000000..83cae02a --- /dev/null +++ b/ocaml/README.md @@ -0,0 +1,79 @@ +# @voxgig/struct — OCaml + +An OCaml port of [`voxgig/struct`](../README.md): one small, fixed API for +manipulating JSON-shaped data — lookups, deep merge, by-example transform, +by-example validate, tree walk, path get/set, selection — that returns the +**same answer** as the canonical TypeScript implementation and every other +port. The behavioural contract is the shared JSON corpus in +[`build/test/`](../build/test); this port passes it in full. + +## Status + +Complete. Every canonical public function is implemented and the entire +shared corpus passes (`make test`). **Zero third-party dependencies** — only +the OCaml compiler is required. + +## Requirements + +- The OCaml compiler (`ocamlc`), version 4.14 or later. + +## Use + +The library lives in the `Voxgig_struct` module: + +```ocaml +open Voxgig_struct + +let store = + Map { entries = [("a", Map { entries = [("b", Num 2.0)] })] } + +let () = + print_endline (stringify (getpath store (Str "a.b"))); (* 2 *) + print_endline (stringify (transform + (Map { entries = [("a", Num 1.0)] }) + (Map { entries = [("x", Str "`a`")] }))) (* {x:1} *) +``` + +`jm` / `jt` are convenient JSON-object / JSON-array builders: + +```ocaml +jsonify (jm [Str "a"; Num 1.0; Str "b"; jt [Num 2.0; Num 3.0]]) +``` + +### Data model + +A single `value` variant represents JSON-shaped data: + +``` +Noval | Null | Bool of bool | Num of float | Str of string + | List of value list ref | Map of omap | Func of injector + | Sentinel of string +``` + +`Noval` is the canonical `undefined` (absent); `Null` is JSON null — distinct, +exactly as in the canonical TypeScript. Nodes (`List` / `Map`) are mutable and +reference-stable, so the library's in-place algorithms behave identically to +the reference implementation. See [`DOCS.md`](./DOCS.md) and +[the language-neutral docs](../DOCS.md). + +## API + +The public surface matches the canonical export list (lower-smushed / +snake_cased): `clone delprop escre escurl filter flatten getdef getelem +getpath getprop haskey inject isempty isfunc iskey islist ismap isnode items +join jsonify keysof merge pad pathify select setpath setprop size slice strkey +stringify transform typify typename validate walk re_compile re_find +re_find_all re_replace re_test re_escape jm jt check_placement injector_args +inject_child`. + +## Develop + +``` +make test # run the shared corpus +make lint # type-check the library +make inspect # compiler version +``` + +## License + +MIT. See [`../LICENSE`](../LICENSE). diff --git a/ocaml/src/voxgig_struct.ml b/ocaml/src/voxgig_struct.ml new file mode 100644 index 00000000..fc7bdc9f --- /dev/null +++ b/ocaml/src/voxgig_struct.ml @@ -0,0 +1,1858 @@ +(* Copyright (c) 2025-2026 Voxgig Ltd. MIT LICENSE. + * + * Voxgig Struct — OCaml port. + * + * A faithful port of the canonical TypeScript implementation + * (typescript/src/StructUtility.ts). Like TypeScript (and the Rust port), + * OCaml keeps `undefined` (Noval) and JSON `null` (Null) distinct, so this + * port mirrors the canonical TS logic directly. Nodes are mutable and + * reference-stable: lists are `value list ref`, maps are an in-tree ordered + * map (insertion order preserved). Zero third-party runtime dependencies; the + * regex helper is the in-tree Vregex engine (RE2 subset). *) + +(* --------------------------------------------------------------------------- + * Value model + * ------------------------------------------------------------------------- *) + +type value = + | Noval (* TS undefined — property absent *) + | Null (* JSON null *) + | Bool of bool + | Num of float + | Str of string + | List of value list ref + | Map of omap + | Func of injector + | Sentinel of string (* SKIP / DELETE, by tag *) + +and omap = { mutable entries : (string * value) list } + +and injector = inj -> value -> string -> value -> value + +and modifyfn = value -> value -> value -> inj -> unit + +and inj = { + mutable mode : int; + mutable full : bool; + mutable keyi : int; + mutable keys : value; (* List of Str *) + mutable key : value; (* Str *) + mutable ival : value; + mutable parent : value; + mutable path : value; (* List of Str *) + mutable nodes : value; (* List *) + mutable handler : injector; + mutable errs : value; (* List *) + mutable meta : value; (* Map *) + mutable dparent : value; + mutable dpath : value; (* List *) + mutable base : value; (* Str or Noval *) + mutable modify : modifyfn option; + mutable prior : inj option; + mutable extra : value; +} + +(* injdef: the loose Partial the public API accepts. *) +and injdef = { + mutable d_meta : value; + mutable d_extra : value; + mutable d_errs : value; + mutable d_modify : modifyfn option; + mutable d_handler : injector option; + mutable d_base : value; + mutable d_dparent : value; + mutable d_dpath : value; + mutable d_key : value; +} + +type injarg = IInj of inj | IDef of injdef | INone + +exception Struct_error of string + +(* --------------------------------------------------------------------------- + * Constants + * ------------------------------------------------------------------------- *) + +let m_keypre = 1 +let m_keypost = 2 +let m_val = 4 + +let s_dkey = "$KEY" +let s_banno = "`$ANNO`" +let s_dtop = "$TOP" +let s_derrs = "$ERRS" +let s_dspec = "$SPEC" +let s_bexact = "`$EXACT`" +let s_bval = "`$VAL`" +let s_bkey = "`$KEY`" +let s_bopen = "`$OPEN`" + +let s_mt = "" +let s_bt = "`" +let s_ds = "$" +let s_dt = "." +let s_cn = ":" +let s_fs = "/" +let s_key = "KEY" +let s_viz = ": " + +let s_string = "string" +let s_object = "object" +let s_list = "list" +let s_map = "map" +let s_nil = "nil" +let s_null = "null" + +let t_any = (1 lsl 31) - 1 +let t_noval = 1 lsl 30 +let t_boolean = 1 lsl 29 +let t_decimal = 1 lsl 28 +let t_integer = 1 lsl 27 +let t_number = 1 lsl 26 +let t_string = 1 lsl 25 +let t_function = 1 lsl 24 +let t_null = 1 lsl 22 +let t_list = 1 lsl 14 +let t_map = 1 lsl 13 +let t_instance = 1 lsl 12 +let t_scalar = 1 lsl 7 +let t_node = 1 lsl 6 + +let typename_tbl = [| + "any"; "nil"; "boolean"; "decimal"; "integer"; "number"; "string"; "function"; + "symbol"; "null"; ""; ""; ""; ""; ""; ""; ""; "list"; "map"; "instance"; + ""; ""; ""; ""; "scalar"; "node" |] + +let skip = Sentinel "skip" +let delete = Sentinel "delete" + +let maxdepth = 32 + +(* --------------------------------------------------------------------------- + * Small helpers + * ------------------------------------------------------------------------- *) + +let lst l = List (ref l) +let empty_list () = List (ref []) +let empty_map () = Map { entries = [] } +let vstr s = Str s +let vint i = Num (float_of_int i) + +let is_noval = function Noval -> true | _ -> false +let is_nullish = function Noval | Null -> true | _ -> false +let is_skip v = (match v with Sentinel "skip" -> true | _ -> false) +let is_delete v = (match v with Sentinel "delete" -> true | _ -> false) + +let is_integer_f n = Float.is_finite n && Float.rem n 1.0 = 0.0 + +let num_to_string n = + if Float.is_nan n then "NaN" + else if Float.is_integer n && Float.abs n < 1e16 then Printf.sprintf "%.0f" n + else begin + let rec try_prec p = + if p > 17 then Printf.sprintf "%.17g" n + else let s = Printf.sprintf "%.*g" p n in + if float_of_string s = n then s else try_prec (p + 1) + in try_prec 1 + end + +(* JS `'' + v` / String(v) for keys and concatenation. *) +let rec js_string v = + match v with + | Noval -> "undefined" + | Null -> "null" + | Bool b -> if b then "true" else "false" + | Num n -> num_to_string n + | Str s -> s + | List r -> + String.concat "," + (List.map (fun x -> match x with Noval | Null -> "" | _ -> js_string x) !r) + | Map _ -> "[object Object]" + | Func _ -> "function" + | Sentinel s -> s + +let is_int_key s = + let n = String.length s in + n > 0 && + (let ok = ref true in + String.iteri (fun i c -> + if not ((c >= '0' && c <= '9') || (c = '-')) then ok := false; + ignore i) s; + !ok) + +let clz32 n = + let n = n land 0xFFFFFFFF in + if n = 0 then 32 + else begin + let r = ref 0 and x = ref n in + while !x land 0x80000000 = 0 do incr r; x := (!x lsl 1) land 0xFFFFFFFF done; + !r + end + +(* ----- ordered map ops ----- *) +let omap_get m k = try Some (List.assoc k m.entries) with Not_found -> None +let omap_has m k = List.mem_assoc k m.entries +let omap_keys m = List.map fst m.entries +let omap_len m = List.length m.entries +let omap_set m k v = + if List.mem_assoc k m.entries then + m.entries <- List.map (fun (k', v') -> if k' = k then (k, v) else (k', v')) m.entries + else m.entries <- m.entries @ [(k, v)] +let omap_del m k = m.entries <- List.filter (fun (k', _) -> k' <> k) m.entries + +(* --------------------------------------------------------------------------- + * The big mutually-recursive block of library functions + * ------------------------------------------------------------------------- *) + +(* a placeholder inj for the (corpus-unreached) getelem function-alt path *) +let dummy_inj_ref : inj option ref = ref None + +let rec isnode v = match v with Map _ | List _ -> true | _ -> false +and ismap v = match v with Map _ -> true | _ -> false +and islist v = match v with List _ -> true | _ -> false +and isfunc v = match v with Func _ -> true | _ -> false + +and iskey k = match k with Str s -> s <> "" | Num _ -> true | _ -> false + +and isempty v = + is_nullish v || v = Str "" || + (match v with List r -> !r = [] | Map m -> m.entries = [] | _ -> false) + +and getdef v alt = if is_noval v then alt else v + +and typify v = + match v with + | Noval -> t_noval + | Null -> t_scalar lor t_null + | Bool _ -> t_scalar lor t_boolean + | Num n -> + if Float.is_nan n then t_noval + else if is_integer_f n then t_scalar lor t_number lor t_integer + else t_scalar lor t_number lor t_decimal + | Str _ -> t_scalar lor t_string + | Func _ -> t_scalar lor t_function + | List _ -> t_node lor t_list + | Map _ -> t_node lor t_map + | Sentinel _ -> t_node lor t_map + +and typename t = + let i = clz32 t in + if i >= 0 && i < Array.length typename_tbl then typename_tbl.(i) else typename_tbl.(0) + +and size v = + match v with + | List r -> List.length !r + | Map m -> omap_len m + | Str s -> String.length s + | Bool b -> if b then 1 else 0 + | Num n -> int_of_float (Float.floor n) + | _ -> 0 + +and strkey ?(key = Noval) () = + match key with + | Noval -> s_mt + | Str s -> s + | Bool _ -> s_mt + | Num n -> if is_integer_f n then num_to_string n else num_to_string (Float.floor n) + | _ -> s_mt + +and keysof v = + match v with + | Map m -> List.sort compare (omap_keys m) + | List r -> List.mapi (fun i _ -> string_of_int i) !r + | _ -> [] + +(* internal: list element by numeric key, no negative wrap, returns Noval if oob *) +and list_index lr key = + let ks = (match key with Str s -> s | Num n -> num_to_string n | _ -> "") in + match int_of_string_opt ks with + | Some i when i >= 0 && i < List.length !lr -> List.nth !lr i + | _ -> Noval + +and getprop ?(alt = Noval) v key = + if is_noval v || is_noval key then alt + else + let out = + match v with + | Map m -> (match omap_get m (js_string key) with Some x -> x | None -> Noval) + | List r -> list_index r key + | _ -> Noval + in + if is_nullish out then alt else out + +and lookup_ v key = + if is_noval v || is_noval key then Noval + else match v with + | Map m -> (match omap_get m (js_string key) with Some x -> x | None -> Noval) + | List r -> list_index r key + | _ -> Noval + +and haskey v key = not (is_nullish (getprop v key)) + +and getelem ?(alt = Noval) v key = + if is_noval v || is_noval key then alt + else begin + let out = ref Noval in + (match v with + | List r -> + let ks = (match key with Str s -> s | Num n -> num_to_string n | _ -> "") in + if is_int_key ks then begin + let len = List.length !r in + let nk0 = int_of_string ks in + let nk = if nk0 < 0 then len + nk0 else nk0 in + if nk >= 0 && nk < len then out := List.nth !r nk + end + | _ -> ()); + if is_nullish !out then + (match alt with + | Func f -> f (Option.get !dummy_inj_ref) Noval "" Noval + | _ -> alt) + else !out + end + +and items_pairs v : (string * value) list = + if not (isnode v) then [] + else List.map (fun k -> (k, getprop_raw v k)) (keysof v) + +and getprop_raw v k = + (* literal stored value at sorted-key k (string), preserving null *) + match v with + | Map m -> (match omap_get m k with Some x -> x | None -> Noval) + | List r -> (try List.nth !r (int_of_string k) with _ -> Noval) + | _ -> Noval + +and items_v v (f : (string * value) -> value) : value = + lst (List.map f (items_pairs v)) + +and items v : value = + lst (List.map (fun (k, x) -> lst [Str k; x]) (items_pairs v)) + +and flatten ?(depth = 1) l = + if not (islist l) then l + else begin + let out = ref [] in + (match l with List r -> + List.iter (fun item -> + if islist item && depth > 0 then + (match flatten ~depth:(depth - 1) item with + | List r2 -> List.iter (fun x -> out := x :: !out) !r2 + | _ -> ()) + else out := item :: !out) !r + | _ -> ()); + lst (List.rev !out) + end + +and filter v check = + let out = ref [] in + List.iter (fun (k, x) -> if check (k, x) then out := x :: !out) (items_pairs v); + lst (List.rev !out) + +and setprop parent key v = + if not (iskey key) then parent + else begin + (match parent with + | Map m -> omap_set m (js_string key) v + | List r -> + let ks = (match key with Str s -> s | Num n -> num_to_string (Float.floor n) | _ -> "") in + (match int_of_string_opt ks with + | None -> () + | Some ki -> + let len = List.length !r in + if ki >= 0 then begin + let ki = if ki > len then len else ki in + if ki >= len then r := !r @ [v] + else r := List.mapi (fun i x -> if i = ki then v else x) !r + end else r := v :: !r) + | _ -> ()); + parent + end + +and delprop parent key = + if not (iskey key) then parent + else begin + (match parent with + | Map m -> omap_del m (js_string key) + | List r -> + let ks = (match key with Str s -> s | Num n -> num_to_string (Float.floor n) | _ -> "") in + (match int_of_string_opt ks with + | Some ki when ki >= 0 && ki < List.length !r -> + r := List.filteri (fun i _ -> i <> ki) !r + | _ -> ()) + | _ -> ()); + parent + end + +and clone v = + match v with + | List r -> List (ref (List.map clone !r)) + | Map m -> Map { entries = List.map (fun (k, x) -> (k, clone x)) m.entries } + | _ -> v + +and slice ?(start = Noval) ?(stop = Noval) ?(mutate = false) v = + match v with + | Num n -> + let lo = (match start with Num s -> s | _ -> neg_infinity) in + let hi = (match stop with Num e -> e -. 1.0 | _ -> infinity) in + Num (Float.max lo (Float.min n hi)) + | List _ | Str _ -> + let vlen = size v in + let start = (match start, stop with Noval, x when not (is_noval x) -> Num 0.0 | _ -> start) in + (match start with + | Num sf -> + let s = int_of_float sf in + let s, e = + if s < 0 then 0, (let e = vlen + s in if e < 0 then 0 else e) + else match stop with + | Num ef -> + let e = int_of_float ef in + if e < 0 then s, (let e = vlen + e in if e < 0 then 0 else e) + else if vlen < e then s, vlen + else s, e + | _ -> s, vlen + in + let s = if vlen < s then vlen else s in + if s > -1 && s <= e && e <= vlen then + (match v with + | List r -> + if mutate then begin + r := (let arr = Array.of_list !r in Array.to_list (Array.sub arr s (e - s))); v + end else lst (let arr = Array.of_list !r in Array.to_list (Array.sub arr s (e - s))) + | Str str -> Str (String.sub str s (e - s)) + | _ -> v) + else + (match v with + | List r -> if mutate then (r := []; v) else empty_list () + | Str _ -> Str s_mt + | _ -> v) + | _ -> v) + | _ -> v + +(* ----- regex helpers (uniform re_* API + targeted hand-rolled matchers) ----- *) + +and re_compile ?flags:_ p = (match p with Str _ -> p | _ -> Str (js_string p)) +and re_str p = (match p with Str s -> s | _ -> js_string p) +and re_find p input = + (match Vregex.find_bounds (Vregex.compile (re_str p)) (re_str input) with + | Some (s, e) -> lst [Str (String.sub (re_str input) s (e - s))] + | None -> Null) +and re_find_all _p _input = empty_list () +and re_replace _p input _r = input +and re_test p input = Bool (Vregex.test_str (re_str p) (re_str input)) +and re_escape s = escre s + +and escre s = + let s = (match s with Str x -> x | Noval -> s_mt | _ -> js_string s) in + let b = Buffer.create (String.length s) in + String.iter (fun c -> + (match c with + | '.' | '*' | '+' | '?' | '^' | '$' | '{' | '}' | '(' | ')' | '|' + | '[' | ']' | '\\' -> Buffer.add_char b '\\' + | _ -> ()); + Buffer.add_char b c) s; + Str (Buffer.contents b) + +and escurl s = + let s = (match s with Str x -> x | Noval -> s_mt | _ -> js_string s) in + let b = Buffer.create (String.length s) in + String.iter (fun c -> + let unreserved = + (c >= 'A' && c <= 'Z') || (c >= 'a' && c <= 'z') || (c >= '0' && c <= '9') + || c = '-' || c = '_' || c = '.' || c = '!' || c = '~' || c = '*' + || c = '\'' || c = '(' || c = ')' in + if unreserved then Buffer.add_char b c + else Buffer.add_string b (Printf.sprintf "%%%02X" (Char.code c))) s; + Str (Buffer.contents b) + +(* ----- stringify / jsonify / pathify / join ----- *) + +and json_encode ?(sort = false) ?indent v = + let buf = Buffer.create 64 in + let esc 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" + | c when Char.code c < 32 -> Buffer.add_string buf (Printf.sprintf "\\u%04x" (Char.code c)) + | c -> Buffer.add_char buf c) s; + Buffer.add_char buf '"' + in + let rec enc v level = + match v with + | Noval | Null -> Buffer.add_string buf "null" + | Bool b -> Buffer.add_string buf (if b then "true" else "false") + | Num n -> Buffer.add_string buf (num_to_string n) + | Str s -> esc s + | Func _ | Sentinel _ -> Buffer.add_string buf "null" + | List r -> + if !r = [] then Buffer.add_string buf "[]" + else (match indent with + | Some ind -> + let pad = String.make (ind * (level + 1)) ' ' in + let cpad = String.make (ind * level) ' ' in + Buffer.add_string buf "[\n"; + List.iteri (fun i x -> + if i > 0 then Buffer.add_string buf ",\n"; + Buffer.add_string buf pad; enc x (level + 1)) !r; + Buffer.add_string buf "\n"; Buffer.add_string buf cpad; Buffer.add_char buf ']' + | None -> + Buffer.add_char buf '['; + List.iteri (fun i x -> if i > 0 then Buffer.add_char buf ','; enc x (level + 1)) !r; + Buffer.add_char buf ']') + | Map m -> + let ks = List.map fst m.entries in + let ks = if sort then List.sort compare ks else ks in + if ks = [] then Buffer.add_string buf "{}" + else (match indent with + | Some ind -> + let pad = String.make (ind * (level + 1)) ' ' in + let cpad = String.make (ind * level) ' ' in + Buffer.add_string buf "{\n"; + List.iteri (fun i k -> + if i > 0 then Buffer.add_string buf ",\n"; + Buffer.add_string buf pad; esc k; Buffer.add_string buf ": "; + enc (Option.get (omap_get m k)) (level + 1)) ks; + Buffer.add_string buf "\n"; Buffer.add_string buf cpad; Buffer.add_char buf '}' + | None -> + Buffer.add_char buf '{'; + List.iteri (fun i k -> + if i > 0 then Buffer.add_char buf ','; + esc k; Buffer.add_char buf ':'; enc (Option.get (omap_get m k)) (level + 1)) ks; + Buffer.add_char buf '}') + in + enc v 0; Buffer.contents buf + +and has_cycle v = + let seen = ref [] in + let rec go v = + match v with + | List r -> if List.memq v !seen then true else (seen := v :: !seen; List.exists go !r) + | Map m -> if List.memq v !seen then true else (seen := v :: !seen; List.exists (fun (_, x) -> go x) m.entries) + | _ -> false + in go v + +and stringify ?(maxlen = Noval) ?(pretty = false) v = + match v with + | Noval -> if pretty then "<>" else s_mt + | _ -> + let valstr = + match v with + | Str s -> s + | _ -> if has_cycle v then "__STRINGIFY_FAILED__" + else (try let s = json_encode ~sort:true v in + (* TS removes all double quotes *) + String.concat "" (String.split_on_char '"' s) + with _ -> "__STRINGIFY_FAILED__") + in + let valstr = + match maxlen with + | Num m when m > -1.0 -> + let m = int_of_float m in + let l = String.length valstr in + if m < l then String.sub valstr 0 (max 0 (m - 3)) ^ "..." + else valstr + | _ -> valstr + in + if pretty then begin + let colors = [81;118;213;39;208;201;45;190;129;51;160;121;226;33;207;69] in + let c = Array.of_list (List.map (fun n -> Printf.sprintf "\027[38;5;%dm" n) colors) in + let r = "\027[0m" in + let d = ref 0 and o = ref c.(0) and t = Buffer.create 64 in + Buffer.add_string t c.(0); + String.iter (fun ch -> + if ch = '{' || ch = '[' then begin + incr d; o := c.(!d mod Array.length c); + Buffer.add_string t !o; Buffer.add_char t ch + end else if ch = '}' || ch = ']' then begin + Buffer.add_string t !o; Buffer.add_char t ch; + decr d; o := c.((((!d mod Array.length c) + Array.length c) mod Array.length c)) + end else (Buffer.add_string t !o; Buffer.add_char t ch)) valstr; + Buffer.contents t ^ r + end else valstr + +and jsonify ?(flags = Noval) v = + match v with + | Noval -> s_null + | _ -> + let indent = (match getprop ~alt:(Num 2.0) flags (Str "indent") with Num n -> int_of_float n | _ -> 2) in + (try + let str = if indent > 0 then json_encode ~indent v else json_encode v in + let offset = (match getprop ~alt:(Num 0.0) flags (Str "offset") with Num n -> int_of_float n | _ -> 0) in + if offset > 0 then + (match String.split_on_char '\n' str with + | _ :: rest -> "{\n" ^ String.concat "\n" (List.map (fun l -> String.make offset ' ' ^ l) rest) + | [] -> str) + else str + with _ -> s_null) + +and pad ?(padding = Noval) ?(padchar = Noval) s = + let s = (match s with Str x -> x | Null -> "null" | _ -> stringify s) in + let padding = (match padding with Num n -> int_of_float n | _ -> 44) in + let padchar = (match padchar with Str x -> String.sub (x ^ " ") 0 1 | _ -> " ") in + if padding > -1 then + let n = padding - String.length s in + if n > 0 then s ^ String.concat "" (List.init n (fun _ -> padchar)) else s + else + let n = (- padding) - String.length s in + if n > 0 then String.concat "" (List.init n (fun _ -> padchar)) ^ s else s + +and join ?(sep = Noval) ?(url = false) arr = + if not (islist arr) then s_mt + else begin + let sepdef = (match sep with Noval | Null -> "," | Str s -> s | _ -> js_string sep) in + let single = (String.length sepdef = 1) in + let sc = if single then sepdef.[0] else ' ' in + let items_ = (match arr with List r -> !r | _ -> []) in + let sarr = List.length items_ in + let strip_trailing s = let n = String.length s in let i = ref n in + while !i > 0 && s.[!i - 1] = sc do decr i done; String.sub s 0 !i in + let strip_leading s = let n = String.length s in let i = ref 0 in + while !i < n && s.[!i] = sc do incr i done; String.sub s !i (n - !i) in + (* Collapse runs of the sep char to one, but only when the run is bounded + by a non-sep char on both sides (mirrors ([^sep])sep+([^sep])). Boundary + runs (leading / trailing) are left untouched. *) + let collapse s = + let n = String.length s in + let b = Buffer.create n in + let i = ref 0 in + while !i < n do + if s.[!i] <> sc then (Buffer.add_char b s.[!i]; incr i) + else begin + let j = ref !i in + while !j < n && s.[!j] = sc do incr j done; + let before_nonsep = !i > 0 && s.[!i - 1] <> sc in + let after_nonsep = !j < n in + if before_nonsep && after_nonsep then Buffer.add_char b sc + else Buffer.add_string b (String.sub s !i (!j - !i)); + i := !j + end + done; + Buffer.contents b in + let out = ref [] in + List.iteri (fun idx s0 -> + match s0 with + | Str s when s <> s_mt -> + let s = + if single then begin + if url && idx = 0 then strip_trailing s + else begin + let s = if idx > 0 then strip_leading s else s in + let s = if idx < sarr - 1 || not url then strip_trailing s else s in + collapse s + end + end else s + in + if s <> s_mt then out := s :: !out + | _ -> ()) items_; + String.concat sepdef (List.rev !out) + end + +and joinurl arr = join ~sep:(Str "/") ~url:true arr + +and replace s from_ to_ = + let ts = typify s in + let rs = + if (t_string land ts) = 0 then stringify s + else if ((t_noval lor t_null) land ts) > 0 then s_mt + else stringify s in + let to_s = (match to_ with Str x -> x | _ -> js_string to_) in + match from_ with + | Str f -> + (* replace all occurrences *) + if f = "" then rs + else begin + let b = Buffer.create (String.length rs) in + let flen = String.length f in let i = ref 0 in let n = String.length rs in + while !i < n do + if !i + flen <= n && String.sub rs !i flen = f then (Buffer.add_string b to_s; i := !i + flen) + else (Buffer.add_char b rs.[!i]; incr i) + done; Buffer.contents b + end + | _ -> rs + +and pathify ?(startin = Noval) ?(endin = Noval) ?(absent = false) v = + let path = + if islist v then Some (match v with List r -> !r | _ -> []) + else if iskey v then Some [v] + else None in + let start = (match startin with Num n -> if n > -1.0 then int_of_float n else 0 | _ -> 0) in + let endn = (match endin with Num n -> if n > -1.0 then int_of_float n else 0 | _ -> 0) in + let pathstr = + match path with + | Some p when start >= 0 -> + let len = List.length p in + let arr = Array.of_list p in + let e = max 0 (len - endn) in + let s = min start len in + let sub = if s <= e then Array.to_list (Array.sub arr s (e - s)) else [] in + if sub = [] then Some "" + else + let fp = List.filter iskey sub in + let mapped = List.map (fun pp -> + match pp with + | Num n -> num_to_string (Float.floor n) + | _ -> String.concat "" (String.split_on_char '.' (js_string pp))) fp in + Some (String.concat "." mapped) + | _ -> None + in + match pathstr with + | Some s -> s + | None -> "" + +(* ----- walk ----- *) + +and walk ?before ?after ?maxdepth:(md = Noval) ?(key = Noval) ?(parent = Noval) ?path ?pool v = + let pool = (match pool with Some p -> p | None -> [| ref [Noval] |] ) in + ignore pool; + walk_impl before after md key parent path v + +and walk_impl before after md key parent path v = + (* path is a string list ref shared per depth (we keep it simple: an int-indexed value list) *) + let path = (match path with Some p -> p | None -> empty_list ()) in + let depth = size path in + let out = ref (match before with None -> v | Some f -> f key v parent path) in + let mdv = (match md with Num n -> if n >= 0.0 then int_of_float n else maxdepth | Noval | Null -> maxdepth | _ -> maxdepth) in + if mdv = 0 || (mdv > 0 && mdv <= depth) then !out + else begin + (if isnode !out then begin + let prefix = (match path with List r -> !r | _ -> []) in + List.iter (fun (ckey, child) -> + let childpath = lst (prefix @ [Str ckey]) in + let result = walk_impl before after (Num (float_of_int mdv)) (Str ckey) !out (Some childpath) child in + (match !out with + | Map m -> omap_set m ckey result + | List r -> r := List.mapi (fun i x -> if i = int_of_string ckey then result else x) !r + | _ -> ())) (items_pairs !out) + end); + (match after with None -> !out | Some f -> f key !out parent path) + end + +(* ----- merge ----- *) + +and merge ?(maxdepth = Noval) objs = + let md = (match maxdepth with Num n -> if n < 0.0 then 0 else int_of_float n | Noval | Null -> 32 | _ -> 32) in + if not (islist objs) then objs + else begin + let l = (match objs with List r -> !r | _ -> []) in + let lenlist = List.length l in + if lenlist = 0 then Noval + else if lenlist = 1 then List.nth l 0 + else begin + let out = ref (getprop ~alt:(empty_map ()) objs (Num 0.0)) in + for oi = 1 to lenlist - 1 do + let obj = List.nth l oi in + if not (isnode obj) then out := obj + else begin + let cur = ref [| !out |] in + let dst = ref [| !out |] in + let grow a n = if Array.length !a <= n then begin + let na = Array.make (n + 1) Noval in + Array.blit !a 0 na 0 (Array.length !a); a := na end in + let before key v _parent path = + let pi = size path in + if md <= pi then begin + grow cur pi; !cur.(pi) <- v; + if pi > 0 then ignore (setprop !cur.(pi - 1) key v); + Noval + end else if not (isnode v) then begin + grow cur pi; !cur.(pi) <- v; v + end else begin + grow dst pi; grow cur pi; + !dst.(pi) <- (if pi > 0 then getprop !dst.(pi - 1) key else !dst.(pi)); + let tval = !dst.(pi) in + if is_nullish tval then (!cur.(pi) <- (if islist v then empty_list () else empty_map ()); v) + else if (islist v && islist tval) || (ismap v && ismap tval) then + (!cur.(pi) <- tval; v) + else (!cur.(pi) <- v; Noval) + end + in + let after key _v _parent path = + let ci = size path in + if ci < 1 then (if Array.length !cur > 0 then !cur.(0) else _v) + else begin + let target = if ci - 1 < Array.length !cur then !cur.(ci - 1) else Noval in + let value = if ci < Array.length !cur then !cur.(ci) else Noval in + ignore (setprop target key value); value + end + in + out := walk ~before ~after obj + end + done; + if md = 0 then begin + let o = getprop objs (Num (float_of_int (lenlist - 1))) in + out := (if islist o then empty_list () else if ismap o then empty_map () else o) + end; + !out + end + end + +(* ----- getpath / setpath ----- *) + +and ia_base = function IInj i -> i.base | IDef d -> d.d_base | INone -> Noval +and ia_dparent = function IInj i -> i.dparent | IDef d -> d.d_dparent | INone -> Noval +and ia_meta = function IInj i -> i.meta | IDef d -> d.d_meta | INone -> Noval +and ia_key = function IInj i -> i.key | IDef d -> d.d_key | INone -> Noval +and ia_dpath = function IInj i -> i.dpath | IDef d -> d.d_dpath | INone -> Noval +and ia_handler = function IInj i -> Some i.handler | IDef d -> d.d_handler | INone -> None +and ia_is_some = function INone -> false | _ -> true + +and getpath ?(inj = INone) store path = + let pa = + match path with + | List r -> Some (Array.of_list !r) + | Str s -> Some (Array.of_list (List.map (fun x -> Str x) (String.split_on_char '.' s))) + | Num n -> Some [| Str (strkey ~key:(Num n) ()) |] + | _ -> None + in + match pa with + | None -> Noval + | Some pa -> + let base = ia_base inj in + let dparent = ia_dparent inj in + let inj_meta = ia_meta inj in + let inj_key = ia_key inj in + let dpath = ia_dpath inj in + let src = if iskey base then getprop ~alt:store store base else store in + let numparts = Array.length pa in + let v = ref store in + let arr_get i = if i >= 0 && i < Array.length pa then pa.(i) else Noval in + (if is_noval path || is_noval store + || (numparts = 1 && pa.(0) = Str s_mt) || numparts = 0 then + v := src + else begin + if numparts = 1 then v := getprop store pa.(0); + if not (isfunc !v) then begin + v := src; + (match pa.(0) with + | Str s0 -> + (match meta_path_match s0 with + | Some (g1, _, g3) when not (is_noval inj_meta) && ia_is_some inj -> + v := getprop inj_meta (Str g1); pa.(0) <- Str g3 + | _ -> ()) + | _ -> ()); + let pi = ref 0 in + let continue = ref true in + while !continue && not (is_noval !v) && !pi < numparts do + let raw = pa.(!pi) in + let part = + match raw with + | Str s when ia_is_some inj && s = s_dkey -> if not (is_noval inj_key) then inj_key else raw + | Str s when starts_with s "$GET:" -> + Str (stringify (getpath ~inj:INone src (slice ~start:(Num 5.0) ~stop:(Num (-1.0)) (Str s)))) + | Str s when starts_with s "$REF:" -> + Str (stringify (getpath ~inj:INone (getprop store (Str s_dspec)) (slice ~start:(Num 5.0) ~stop:(Num (-1.0)) (Str s)))) + | Str s when ia_is_some inj && starts_with s "$META:" -> + Str (stringify (getpath ~inj:INone inj_meta (slice ~start:(Num 6.0) ~stop:(Num (-1.0)) (Str s)))) + | _ -> raw + in + let part = (match part with + | Str s -> Str (replace_all s "$$" "$") + | _ -> Str (strkey ~key:part ())) in + if part = Str s_mt then begin + let ascends = ref 0 in + while arr_get (!pi + 1) = Str s_mt do incr ascends; incr pi done; + if ia_is_some inj && !ascends > 0 then begin + if !pi = numparts - 1 then decr ascends; + if !ascends = 0 then v := dparent + else begin + let tailparts = Array.to_list (Array.sub pa (!pi + 1) (numparts - (!pi + 1))) in + let fullpath = flatten (lst [slice ~start:(Num (float_of_int (- !ascends))) dpath; lst tailparts]) in + v := (if !ascends <= size dpath then getpath ~inj:INone store fullpath else Noval); + continue := false + end + end else v := dparent + end else v := getprop !v part; + if !continue then incr pi + done + end + end); + (match ia_handler inj with + | Some h when ia_is_some inj -> + let refp = pathify path in + (match inj with + | IInj i -> v := h i !v refp store + | _ -> v := h (Option.get !dummy_inj_ref) !v refp store) + | _ -> ()); + !v + +and setpath ?(inj = INone) store path v = + let ptype = typify path in + let parts = + if (t_list land ptype) > 0 then (match path with List r -> lst !r | _ -> empty_list ()) + else if (t_string land ptype) > 0 then (match path with Str s -> lst (List.map (fun x -> Str x) (String.split_on_char '.' s)) | _ -> empty_list ()) + else if (t_number land ptype) > 0 then lst [path] + else Noval + in + if is_noval parts then Noval + else begin + let base = (match inj with INone -> Noval | _ -> ia_base inj) in + let numparts = size parts in + let parent = ref (if iskey base then getprop ~alt:store store base else store) in + for pi = 0 to numparts - 2 do + let pkey = getelem parts (Num (float_of_int pi)) in + let np = getprop !parent pkey in + let np = if not (isnode np) then begin + let nextpart = getelem parts (Num (float_of_int (pi + 1))) in + let nn = if (t_number land typify nextpart) > 0 then empty_list () else empty_map () in + ignore (setprop !parent pkey nn); nn + end else np in + parent := np + done; + if is_delete v then ignore (delprop !parent (getelem parts (Num (-1.0)))) + else ignore (setprop !parent (getelem parts (Num (-1.0))) v); + !parent + end + +(* ----- string-pattern helpers (hand-rolled, RE2-subset-free) ----- *) + +and starts_with s pre = + String.length s >= String.length pre && String.sub s 0 (String.length pre) = pre + +and replace_all s find_ repl = + if find_ = "" then s + else begin + let b = Buffer.create (String.length s) in + let flen = String.length find_ in let n = String.length s in let i = ref 0 in + while !i < n do + if !i + flen <= n && String.sub s !i flen = find_ then (Buffer.add_string b repl; i := !i + flen) + else (Buffer.add_char b s.[!i]; incr i) + done; Buffer.contents b + end + +(* R_META_PATH = ^([^$]+)\$([=~])(.+)$ *) +and meta_path_match s = + match String.index_opt s '$' with + | Some i when i > 0 && i + 1 < String.length s + && (s.[i + 1] = '=' || s.[i + 1] = '~') + && i + 2 <= String.length s - 1 -> + Some (String.sub s 0 i, String.make 1 s.[i + 1], String.sub s (i + 2) (String.length s - i - 2)) + | _ -> None + +(* R_INJECTION_FULL: whole string is a single backtick injection; returns the + captured reference ($NAME with trailing digits stripped, or the literal). *) +and injection_full s = + let n = String.length s in + if n >= 2 && s.[0] = '`' && s.[n - 1] = '`' then begin + let inner = String.sub s 1 (n - 2) in + if String.contains inner '`' then None + else begin + (* $[A-Z]+[0-9]*$ -> group is $ + uppercase run *) + let is_dollar_upper = + String.length inner > 1 && inner.[0] = '$' && + (let j = ref 1 in + while !j < String.length inner && inner.[!j] >= 'A' && inner.[!j] <= 'Z' do incr j done; + let letters_end = !j in + letters_end > 1 && + (let k = ref letters_end in + while !k < String.length inner && inner.[!k] >= '0' && inner.[!k] <= '9' do incr k done; + !k = String.length inner)) + in + if is_dollar_upper then begin + let j = ref 1 in + while !j < String.length inner && inner.[!j] >= 'A' && inner.[!j] <= 'Z' do incr j done; + Some (String.sub inner 0 !j) + end else Some inner + end + end else None + +(* replace each `...` (R_INJECTION_PARTIAL) using f on the inner text *) +and injection_partial_replace s f = + let n = String.length s in + let b = Buffer.create n in + let i = ref 0 in + while !i < n do + if s.[!i] = '`' then begin + match String.index_from_opt s (!i + 1) '`' with + | Some j -> + let inner = String.sub s (!i + 1) (j - !i - 1) in + Buffer.add_string b (f inner); + i := j + 1 + | None -> Buffer.add_char b s.[!i]; incr i + end else (Buffer.add_char b s.[!i]; incr i) + done; + Buffer.contents b + +(* replace `$NAME` -> name (lowercase), used in validate error descriptions *) +and replace_transform_names s = + let n = String.length s in + let b = Buffer.create n in + let i = ref 0 in + while !i < n do + if s.[!i] = '`' && !i + 1 < n && s.[!i + 1] = '$' then begin + let j = ref (!i + 2) in + while !j < n && s.[!j] >= 'A' && s.[!j] <= 'Z' do incr j done; + if !j < n && s.[!j] = '`' && !j > !i + 2 then begin + Buffer.add_string b (String.lowercase_ascii (String.sub s (!i + 2) (!j - !i - 2))); + i := !j + 1 + end else (Buffer.add_char b s.[!i]; incr i) + end else (Buffer.add_char b s.[!i]; incr i) + done; + Buffer.contents b + +(* ----- Injection ----- *) + +and new_inj v parent = + { mode = m_val; full = false; keyi = 0; + keys = lst [Str s_dtop]; key = Str s_dtop; ival = v; parent; + path = lst [Str s_dtop]; nodes = lst [parent]; handler = inject_handler; + errs = empty_list (); meta = empty_map (); dparent = Noval; dpath = lst [Str s_dtop]; + base = Str s_dtop; modify = None; prior = None; extra = Noval } + +and inj_descend inj = + (match inj.meta with Map m -> + let d = (match omap_get m "__d" with Some (Num n) -> n | _ -> 0.0) in + omap_set m "__d" (Num (d +. 1.0)) | _ -> ()); + let parentkey = getelem inj.path (Num (-2.0)) in + if is_noval inj.dparent then begin + if size inj.dpath > 1 then + inj.dpath <- (match inj.dpath, parentkey with List r, _ -> lst (!r @ [parentkey]) | _ -> inj.dpath) + end else if not (is_noval parentkey) then begin + inj.dparent <- getprop inj.dparent parentkey; + let lastpart = getelem inj.dpath (Num (-1.0)) in + if lastpart = Str ("$:" ^ js_string parentkey) then + inj.dpath <- slice ~start:(Num (-1.0)) inj.dpath + else inj.dpath <- (match inj.dpath with List r -> lst (!r @ [parentkey]) | _ -> inj.dpath) + end; + inj.dparent + +and inj_child inj keyi keys = + let key = strkey ~key:(getelem keys (Num (float_of_int keyi))) () in + let v = inj.ival in + let cinj = { + mode = inj.mode; full = inj.full; keyi; keys; key = Str key; + ival = getprop v (Str key); parent = v; + path = (match inj.path with List r -> lst (!r @ [Str key]) | _ -> lst [Str key]); + nodes = (match inj.nodes with List r -> lst (!r @ [v]) | _ -> lst [v]); + handler = inj.handler; errs = inj.errs; meta = inj.meta; base = inj.base; + modify = inj.modify; prior = Some inj; + dpath = (match inj.dpath with List r -> lst !r | _ -> inj.dpath); + dparent = inj.dparent; extra = inj.extra; + } in + cinj + +and inj_setval ?(ancestor = 1) inj v = + let target, key = + if ancestor < 2 then inj.parent, inj.key + else getelem inj.nodes (Num (float_of_int (- ancestor))), getelem inj.path (Num (float_of_int (- ancestor))) + in + if is_noval v then delprop target key else setprop target key v + +(* ----- inject ----- *) + +and inject ?(inj = INone) v store = + let state = + match inj with + | IInj i -> i + | _ -> + let parent = Map { entries = [(s_dtop, v)] } in + let i = new_inj v parent in + i.dparent <- store; + i.errs <- getprop ~alt:(empty_list ()) store (Str s_derrs); + (match i.meta with Map m -> omap_set m "__d" (Num 0.0) | _ -> ()); + (match inj with + | IDef d -> + (match d.d_modify with Some _ -> i.modify <- d.d_modify | None -> ()); + (if not (is_noval d.d_extra) then i.extra <- d.d_extra); + (if not (is_noval d.d_meta) then i.meta <- d.d_meta); + (match d.d_handler with Some h -> i.handler <- h | None -> ()) + | _ -> ()); + i + in + ignore (inj_descend state); + let v = + if isnode v then begin + let nodekeys = ref ( + match v with + | Map m -> + let ks = List.map fst m.entries in + let normal = List.sort compare (List.filter (fun k -> not (String.contains k '$')) ks) in + let trans = List.sort compare (List.filter (fun k -> String.contains k '$') ks) in + normal @ trans + | List r -> List.mapi (fun i _ -> string_of_int i) !r + | _ -> []) + in + let nki = ref 0 in + let continue = ref true in + while !continue && !nki < List.length !nodekeys do + let childinj = inj_child state !nki (lst (List.map (fun s -> Str s) !nodekeys)) in + let nodekey = childinj.key in + childinj.mode <- m_keypre; + let prekey = injectstr (js_string nodekey) store (Some childinj) in + nodekeys := List.map js_string (match childinj.keys with List r -> !r | _ -> []); + (if not (is_noval prekey) then begin + childinj.ival <- getprop v prekey; + childinj.mode <- m_val; + ignore (inject ~inj:(IInj childinj) childinj.ival store); + nodekeys := List.map js_string (match childinj.keys with List r -> !r | _ -> []); + childinj.mode <- m_keypost; + ignore (injectstr (js_string nodekey) store (Some childinj)); + nodekeys := List.map js_string (match childinj.keys with List r -> !r | _ -> []) + end); + nki := childinj.keyi + 1; + ignore continue + done; + v + end else if (match v with Str _ -> true | _ -> false) then begin + state.mode <- m_val; + let nv = injectstr (js_string v) store (Some state) in + (if not (is_skip nv) then ignore (inj_setval state nv)); + nv + end else v + in + (match state.modify with + | Some f when not (is_skip v) -> + let mkey = state.key in let mparent = state.parent in let mval = getprop mparent mkey in + f mval mkey mparent state + | _ -> ()); + state.ival <- v; + lookup_ state.parent (Str s_dtop) + +and inject_handler inj v refstr store = + let iscmd = isfunc v && (refstr = "" || starts_with refstr s_ds) in + if iscmd then (match v with Func f -> f inj v refstr store | _ -> v) + else if state_mode_is_val inj && inj.full then (ignore (inj_setval inj v); v) + else v + +and state_mode_is_val inj = (inj.mode = m_val) + +and injectstr v store inj_opt = + if v = s_mt then Str s_mt + else begin + match injection_full v with + | Some pathref0 -> + (match inj_opt with Some i -> i.full <- true | None -> ()); + let pathref = if String.length pathref0 > 3 then + replace_all (replace_all pathref0 "$BT" s_bt) "$DS" s_ds else pathref0 in + let ia = (match inj_opt with Some i -> IInj i | None -> INone) in + let out = getpath ~inj:ia store (Str pathref) in + (* out may be any value, returned as the injected value *) + out_to_val out + | None -> + let out = injection_partial_replace v (fun ref0 -> + let refp = if String.length ref0 > 3 then + replace_all (replace_all ref0 "$BT" s_bt) "$DS" s_ds else ref0 in + (match inj_opt with Some i -> i.full <- false | None -> ()); + let ia = (match inj_opt with Some i -> IInj i | None -> INone) in + let found = getpath ~inj:ia store (Str refp) in + match found with + | Noval -> s_mt + | Str s -> if s = "__NULL__" then "null" else s + | Func _ -> s_mt + | _ -> (try json_encode found with _ -> stringify found)) + in + (match inj_opt with + | Some i when isfunc_handler i -> + i.full <- true; out_to_val (i.handler i (Str out) v store) + | _ -> Str out) + end + +and out_to_val v = v +and isfunc_handler _i = true + +(* ----- transform commands ----- *) + +and transform_delete inj _v _ref _store = ignore (delprop inj.parent inj.key); Noval + +and transform_copy inj _v _ref _store = + if inj.mode = m_keypre || inj.mode = m_keypost then inj.key + else begin + let out = lookup_ inj.dparent inj.key in + ignore (inj_setval inj out); out + end + +and transform_key inj _v _ref _store = + if inj.mode <> m_val then Noval + else begin + let keyspec = lookup_ inj.parent (Str s_bkey) in + if not (is_noval keyspec) then (ignore (delprop inj.parent (Str s_bkey)); getprop inj.dparent keyspec) + else + let anno = lookup_ inj.parent (Str s_banno) in + let fromanno = lookup_ anno (Str s_key) in + if not (is_noval fromanno) then fromanno + else getelem inj.path (Num (-2.0)) + end + +and transform_anno inj _v _ref _store = ignore (delprop inj.parent (Str s_banno)); Noval + +and transform_merge inj _v _ref _store = + if inj.mode = m_keypre then inj.key + else if inj.mode = m_keypost then begin + let args0 = getprop inj.parent inj.key in + let args = if islist args0 then args0 else lst [args0] in + ignore (inj_setval inj Noval); + let mergelist = flatten (lst [lst [inj.parent]; args; lst [clone inj.parent]]) in + ignore (merge mergelist); + inj.key + end else Noval + +and transform_each inj _v _ref store = + (if islist inj.keys then ignore (slice ~start:(Num 0.0) ~stop:(Num 1.0) ~mutate:true inj.keys)); + if inj.mode <> m_val then Noval + else begin + let parent = inj.parent in + let srcpath = if size parent > 1 then getelem parent (Num 1.0) else Noval in + let child_tm = if size parent > 2 then clone (getelem parent (Num 2.0)) else Noval in + let srcstore = getprop ~alt:store store inj.base in + let src = getpath ~inj:(IInj inj) srcstore srcpath in + let tkey = getelem inj.path (Num (-2.0)) in + let nodes = inj.nodes in + let target = + let t = getelem nodes (Num (-2.0)) in + if is_nullish t then getelem nodes (Num (-1.0)) else t in + let tval = ref [] in + let rval = ref (empty_list ()) in + (if isnode src then begin + (match src with + | List r -> List.iter (fun _ -> tval := clone child_tm :: !tval) !r + | Map m -> List.iter (fun (k, _) -> + let cc = clone child_tm in + (if ismap cc then ignore (setprop cc (Str s_banno) (Map { entries = [(s_key, Str k)] }))); + tval := cc :: !tval) m.entries + | _ -> ()); + let tvall = List.rev !tval in + let tvalv = lst tvall in + let tcurrent = (match src with + | Map m -> lst (List.map snd m.entries) + | List r -> lst !r | _ -> src) in + if List.length tvall > 0 then begin + let path = inj.path in + let ckey = getelem path (Num (-2.0)) in + let plist = (match path with List r -> !r | _ -> []) in + let tpath = lst (if plist = [] then [] else List.filteri (fun i _ -> i < List.length plist - 1) plist) in + let dpath = ref [Str s_dtop] in + (match srcpath with Str sp when sp <> s_mt -> + List.iter (fun p -> if p <> s_mt then dpath := !dpath @ [Str p]) (String.split_on_char '.' sp) + | _ -> ()); + (if not (is_noval ckey) then dpath := !dpath @ [Str ("$:" ^ js_string ckey)]); + let tcur = ref (Map { entries = [(js_string ckey, tcurrent)] }) in + (if size tpath > 1 then begin + let pkey = getelem ~alt:(Str s_dtop) path (Num (-3.0)) in + dpath := !dpath @ [Str ("$:" ^ js_string pkey)]; + tcur := Map { entries = [(js_string pkey, !tcur)] } + end); + let tinj = inj_child inj 0 (if not (is_noval ckey) then lst [ckey] else empty_list ()) in + tinj.path <- tpath; + let nlist = (match nodes with List r -> !r | _ -> []) in + tinj.nodes <- lst (if nlist = [] then [] else List.filteri (fun i _ -> i < List.length nlist - 1) nlist); + tinj.parent <- (if size tinj.nodes > 0 then getelem tinj.nodes (Num (-1.0)) else Noval); + (if not (is_noval ckey) && not (is_noval tinj.parent) then ignore (setprop tinj.parent ckey tvalv)); + tinj.ival <- tvalv; + tinj.dpath <- lst !dpath; + tinj.dparent <- !tcur; + ignore (inject ~inj:(IInj tinj) tvalv store); + rval := tinj.ival + end + end); + ignore (setprop target tkey !rval); + if islist !rval && size !rval > 0 then getelem !rval (Num 0.0) else Noval + end + +and transform_pack inj _v _ref store = + if inj.mode <> m_keypre || not (match inj.key with Str _ -> true | _ -> false) then Noval + else begin + let parent = inj.parent in let path = inj.path in let nodes = inj.nodes in + let args_val = getprop parent inj.key in + if not (islist args_val) || size args_val < 2 then Noval + else begin + let srcpath = getelem args_val (Num 0.0) in + let origchildspec = getelem args_val (Num 1.0) in + let tkey = getelem path (Num (-2.0)) in + let pathsize = size path in + let target = + let t = getelem nodes (Num (float_of_int (pathsize - 2))) in + if is_nullish t then getelem nodes (Num (float_of_int (pathsize - 1))) else t in + let srcstore = getprop ~alt:store store inj.base in + let src0 = getpath ~inj:(IInj inj) srcstore srcpath in + let src = + if not (islist src0) then + (if ismap src0 then + lst (List.map (fun (k, node) -> + ignore (setprop node (Str s_banno) (Map { entries = [(s_key, Str k)] })); node) + (items_pairs src0)) + else Noval) + else src0 in + if is_noval src then Noval + else begin + let keypath = getprop origchildspec (Str s_bkey) in + let childspec = delprop origchildspec (Str s_bkey) in + let child = getprop ~alt:childspec childspec (Str s_bval) in + let tval = empty_map () in + List.iter (fun (srckey, srcnode) -> + let k = + if is_noval keypath then Str srckey + else (match keypath with + | Str kp when starts_with kp s_bt -> + inject (Str kp) (merge ~maxdepth:(Num 1.0) (lst [empty_map (); store; Map { entries = [(s_dtop, srcnode)] }])) + | _ -> getpath ~inj:(IInj inj) srcnode keypath) in + let tchild = clone child in + ignore (setprop tval k tchild); + let anno = getprop srcnode (Str s_banno) in + if is_noval anno then ignore (delprop tchild (Str s_banno)) + else ignore (setprop tchild (Str s_banno) anno)) (items_pairs src); + let rval = ref (empty_map ()) in + (if not (isempty tval) then begin + let tsrc = empty_map () in + List.iteri (fun i node -> + let kn = + if is_noval keypath then vint i + else (match keypath with + | Str kp when starts_with kp s_bt -> + inject (Str kp) (merge ~maxdepth:(Num 1.0) (lst [empty_map (); store; Map { entries = [(s_dtop, node)] }])) + | _ -> getpath ~inj:(IInj inj) node keypath) in + ignore (setprop tsrc kn node)) + (match src with List r -> !r | _ -> []); + let tpath = slice ~start:(Num (-1.0)) inj.path in + let ckey = getelem inj.path (Num (-2.0)) in + let dpath = ref [Str s_dtop] in + (match srcpath with Str sp -> + List.iter (fun p -> if p <> s_mt then dpath := !dpath @ [Str p]) (String.split_on_char '.' sp) + | _ -> ()); + dpath := !dpath @ [Str ("$:" ^ js_string ckey)]; + let tcur = ref (Map { entries = [(js_string ckey, tsrc)] }) in + (if size tpath > 1 then begin + let pkey = getelem ~alt:(Str s_dtop) inj.path (Num (-3.0)) in + dpath := !dpath @ [Str ("$:" ^ js_string pkey)]; + tcur := Map { entries = [(js_string pkey, !tcur)] } + end); + let tinj = inj_child inj 0 (lst [ckey]) in + tinj.path <- tpath; + tinj.nodes <- slice ~start:(Num (-1.0)) inj.nodes; + tinj.parent <- getelem tinj.nodes (Num (-1.0)); + tinj.ival <- tval; + tinj.dpath <- lst !dpath; + tinj.dparent <- !tcur; + ignore (inject ~inj:(IInj tinj) tval store); + rval := tinj.ival + end); + ignore (setprop target tkey !rval); + Noval + end + end + end + +and transform_ref inj v _ref store = + if inj.mode <> m_val then Noval + else begin + let nodes = inj.nodes in + let refpath = lookup_ inj.parent (Num 1.0) in + inj.keyi <- size inj.keys; + let spec_func = getprop store (Str s_dspec) in + (match spec_func with + | Func f -> + let spec = f inj Noval "" Noval in + let refv = getpath ~inj:INone spec refpath in + let has_sub = ref false in + (if isnode refv then ignore (walk ~before:(fun _k v2 _p _path -> (if v2 = Str "`$REF`" then has_sub := true); v2) refv)); + let tref = clone refv in + let cpath = slice ~start:(Num 0.0) ~stop:(Num (float_of_int (size inj.path - 3))) inj.path in + let tpath = slice ~start:(Num 0.0) ~stop:(Num (float_of_int (size inj.path - 1))) inj.path in + let tcur = getpath ~inj:INone store cpath in + let tval = getpath ~inj:INone store tpath in + let rval = ref Noval in + (if not (is_noval refv) && (not !has_sub || not (is_noval tval)) then begin + let cs = inj_child inj 0 (lst [getelem tpath (Num (-1.0))]) in + cs.path <- tpath; + cs.nodes <- slice ~start:(Num 0.0) ~stop:(Num (float_of_int (size inj.nodes - 1))) inj.nodes; + cs.parent <- getelem nodes (Num (-2.0)); + cs.ival <- tref; + cs.dparent <- tcur; + ignore (inject ~inj:(IInj cs) tref store); + rval := cs.ival + end); + ignore (inj_setval ~ancestor:2 inj !rval); + (match inj.prior with + | Some p when islist inj.parent -> p.keyi <- p.keyi - 1 + | _ -> ()); + v + | _ -> Noval) + end + +and jsstr v = match v with Null -> "null" | Bool b -> if b then "true" else "false" | _ -> js_string v + +and formatter_tbl = [ + ("identity", (fun _k v -> v)); + ("upper", (fun _k v -> if isnode v then v else Str (String.uppercase_ascii (jsstr v)))); + ("lower", (fun _k v -> if isnode v then v else Str (String.lowercase_ascii (jsstr v)))); + ("string", (fun _k v -> if isnode v then v else Str (jsstr v))); + ("number", (fun _k v -> if isnode v then v else + let n = (try float_of_string (jsstr v) with _ -> 0.0) in + let n = if Float.is_nan n then 0.0 else n in Num n)); + ("integer", (fun _k v -> if isnode v then v else + let n = (try float_of_string (jsstr v) with _ -> 0.0) in + let n = if Float.is_nan n then 0.0 else n in Num (Float.of_int (int_of_float n)))); + ("concat", (fun k v -> if is_noval k && islist v then + Str (join ~sep:(Str s_mt) (items_v v (fun (_, x) -> if isnode x then Str s_mt else Str (jsstr x)))) + else v)); +] + +and check_placement modes ijname parenttypes inj = + let modenum = inj.mode in + if (modes land modenum) = 0 then begin + let allowed = List.filter (fun m -> (modes land m) <> 0) [m_keypre; m_keypost; m_val] in + let placements = String.concat "," (List.map (fun m -> if m = m_val then "value" else "key") allowed) in + let cur = if modenum = m_val then "value" else "key" in + ignore (setprop inj.errs (Num (float_of_int (size inj.errs))) (Str (Printf.sprintf "$%s: invalid placement as %s, expected: %s." ijname cur placements))); + false + end else if not (isempty (Num (float_of_int parenttypes))) then begin + let ptype = typify inj.parent in + if (parenttypes land ptype) = 0 then begin + ignore (setprop inj.errs (Num (float_of_int (size inj.errs))) + (Str (Printf.sprintf "$%s: invalid placement in parent %s, expected: %s." ijname (typename ptype) (typename parenttypes)))); + false + end else true + end else true + +and injector_args argtypes args = + let numargs = List.length argtypes in + let found = Array.make (1 + numargs) Noval in + let err = ref None in + (try + List.iteri (fun argi at -> + let arg = getelem args (Num (float_of_int argi)) in + let argtype = typify arg in + if (at land argtype) = 0 then begin + found.(0) <- Str (Printf.sprintf "invalid argument: %s (%s at position %d) is not of type: %s." + (stringify ~maxlen:(Num 22.0) arg) (typename argtype) (1 + argi) (typename at)); + err := Some (); raise Exit + end else found.(1 + argi) <- arg) argtypes + with Exit -> ()); + ignore !err; + Array.to_list found + +and inject_child child store inj = + let cinj = ref inj in + (match inj.prior with + | Some prior -> + (match prior.prior with + | Some pprior -> + let c = inj_child pprior prior.keyi prior.keys in + c.ival <- child; ignore (setprop c.parent prior.key child); cinj := c + | None -> + let c = inj_child prior inj.keyi inj.keys in + c.ival <- child; ignore (setprop c.parent inj.key child); cinj := c) + | None -> ()); + ignore (inject ~inj:(IInj !cinj) child store); + !cinj + +and transform_format inj _v _ref store = + ignore (slice ~start:(Num 0.0) ~stop:(Num 1.0) ~mutate:true inj.keys); + if inj.mode <> m_val then Noval + else begin + let name = lookup_ inj.parent (Num 1.0) in + let child = lookup_ inj.parent (Num 2.0) in + let tkey = getelem inj.path (Num (-2.0)) in + let target = let t = getelem inj.nodes (Num (-2.0)) in if is_nullish t then getelem inj.nodes (Num (-1.0)) else t in + let cinj = inject_child child store inj in + let resolved = cinj.ival in + let formatter = + if (t_function land typify name) > 0 then + Some (fun k v -> match name with Func f -> f (Option.get !dummy_inj_ref) v (js_string k) Noval | _ -> v) + else (match List.assoc_opt (js_string name) formatter_tbl with Some f -> Some f | None -> None) + in + match formatter with + | None -> ignore (setprop inj.errs (Num (float_of_int (size inj.errs))) (Str (Printf.sprintf "$FORMAT: unknown format: %s." (js_string name)))); Noval + | Some f -> + let out = walk ~before:(fun k v _p _path -> f k v) resolved in + ignore (setprop target tkey out); out + end + +and transform_apply inj _v _ref store = + if not (check_placement m_val "APPLY" t_list inj) then Noval + else begin + let res = injector_args [t_function; t_any] (slice ~start:(Num 1.0) inj.parent) in + let err = List.nth res 0 in + let apply_fn = List.nth res 1 in + let child = if List.length res > 2 then List.nth res 2 else Noval in + if not (is_noval err) then (ignore (setprop inj.errs (Num (float_of_int (size inj.errs))) (Str ("$APPLY: " ^ js_string err))); Noval) + else begin + let tkey = getelem inj.path (Num (-2.0)) in + let target = let t = getelem inj.nodes (Num (-2.0)) in if is_nullish t then getelem inj.nodes (Num (-1.0)) else t in + let cinj = inject_child child store inj in + let resolved = cinj.ival in + let out = (match apply_fn with Func f -> f cinj resolved "" store | _ -> Noval) in + ignore (setprop target tkey out); out + end + end + +and transform ?(inj = INone) data spec = + let origspec = spec in + let spec = clone spec in + let extra = (match inj with IDef d -> d.d_extra | _ -> Noval) in + let collect = (match inj with IDef d -> not (is_noval d.d_errs) | _ -> false) in + let errs = (match inj with IDef d when collect -> d.d_errs | _ -> empty_list ()) in + let extra_transforms = empty_map () in + let extra_data = empty_map () in + (if not (is_noval extra) then + List.iter (fun (k, v) -> + if starts_with k s_ds then ignore (setprop extra_transforms (Str k) v) + else ignore (setprop extra_data (Str k) v)) (items_pairs extra)); + let data_clone = merge (lst [(if isempty extra_data then Noval else clone extra_data); clone data]) in + let store = empty_map () in + let put k v = ignore (setprop store (Str k) v) in + put s_dtop data_clone; + put s_dspec (Func (fun _ _ _ _ -> origspec)); + put "$BT" (Func (fun _ _ _ _ -> Str s_bt)); + put "$DS" (Func (fun _ _ _ _ -> Str s_ds)); + put "$WHEN" (Func (fun _ _ _ _ -> Str "1970-01-01T00:00:00.000Z")); + put "$DELETE" (Func transform_delete); + put "$COPY" (Func transform_copy); + put "$KEY" (Func transform_key); + put "$ANNO" (Func transform_anno); + put "$MERGE" (Func transform_merge); + put "$EACH" (Func transform_each); + put "$PACK" (Func transform_pack); + put "$REF" (Func transform_ref); + put "$FORMAT" (Func transform_format); + put "$APPLY" (Func transform_apply); + List.iter (fun (k, v) -> put k v) (items_pairs extra_transforms); + put s_derrs errs; + let idef = { (default_injdef ()) with d_errs = errs } in + (match inj with + | IDef d -> + idef.d_meta <- d.d_meta; idef.d_modify <- d.d_modify; idef.d_handler <- d.d_handler; + idef.d_base <- d.d_base + | _ -> ()); + let out = inject ~inj:(IDef idef) spec store in + if size errs > 0 && not collect then raise (Struct_error (join ~sep:(Str " | ") errs)); + out + +and default_injdef () = + { d_meta = Noval; d_extra = Noval; d_errs = Noval; d_modify = None; d_handler = None; + d_base = Noval; d_dparent = Noval; d_dpath = Noval; d_key = Noval } + +(* ----- validate ----- *) + +and invalid_type_msg path needtype vt v _whence = + let vs = if is_nullish v then "no value" else stringify v in + "Expected " + ^ (if size path > 1 then "field " ^ pathify ~startin:(Num 1.0) path ^ " to be " else "") + ^ needtype ^ ", but found " + ^ (if not (is_nullish v) then typename vt ^ s_viz else "") + ^ vs ^ "." + +and validate_string inj _v _ref _store = + let out = lookup_ inj.dparent inj.key in + let t = typify out in + if (t_string land t) = 0 then (push_err inj (invalid_type_msg inj.path s_string t out "V1010"); Noval) + else if out = Str s_mt then (push_err inj ("Empty string at " ^ pathify ~startin:(Num 1.0) inj.path); Noval) + else out + +and push_err inj msg = ignore (setprop inj.errs (Num (float_of_int (size inj.errs))) (Str msg)) + +and validate_type inj _v refstr _store = + let tname = if String.length refstr > 1 then String.lowercase_ascii (String.sub refstr 1 (String.length refstr - 1)) else "any" in + let idx = (let r = ref (-1) in Array.iteri (fun i x -> if x = tname && !r < 0 then r := i) typename_tbl; !r) in + let typev0 = if idx >= 0 then 1 lsl (31 - idx) else 0 in + let typev = if tname = s_nil then typev0 lor t_null else typev0 in + let out = lookup_ inj.dparent inj.key in + let t = typify out in + if (t land typev) = 0 then (push_err inj (invalid_type_msg inj.path tname t out "V1001"); Noval) + else out + +and validate_any inj _v _ref _store = lookup_ inj.dparent inj.key + +and validate_child inj _v _ref _store = + let parent = inj.parent in let key = inj.key in let path = inj.path in let keys = inj.keys in + if inj.mode = m_keypre then begin + let childtm = getprop parent key in + let pkey = getelem path (Num (-2.0)) in + let tval = getprop inj.dparent pkey in + if is_noval tval then begin + List.iter (fun ckey -> ignore (setprop parent (Str ckey) (clone childtm)); ignore (setprop keys (Num (float_of_int (size keys))) (Str ckey))) (keysof (empty_map ())); + ignore (delprop parent key); Noval + end else if not (ismap tval) then + (push_err inj (invalid_type_msg (slice ~start:(Num 0.0) ~stop:(Num (float_of_int (size path - 1))) path) s_object (typify tval) tval "V0220"); Noval) + else begin + List.iter (fun ckey -> ignore (setprop parent (Str ckey) (clone childtm)); ignore (setprop keys (Num (float_of_int (size keys))) (Str ckey))) (keysof tval); + ignore (delprop parent key); Noval + end + end else if inj.mode = m_val then begin + let childtm = getprop parent (Num 1.0) in + if not (islist parent) then (push_err inj "Invalid $CHILD as value"; Noval) + else if is_noval inj.dparent then (match parent with List r -> r := []; Noval | _ -> Noval) + else if not (islist inj.dparent) then begin + push_err inj (invalid_type_msg (slice ~start:(Num 0.0) ~stop:(Num (float_of_int (size path - 1))) path) s_list (typify inj.dparent) inj.dparent "V0230"); + inj.keyi <- size parent; inj.dparent + end else begin + List.iter (fun (k, _) -> ignore (setprop parent (Str k) (clone childtm))) (items_pairs inj.dparent); + (match parent with List r -> let n = size inj.dparent in r := (let a = Array.of_list !r in Array.to_list (Array.sub a 0 (min n (Array.length a)))) | _ -> ()); + inj.keyi <- 0; + getprop inj.dparent (Num 0.0) + end + end else Noval + +and validate_one inj _v _ref store = + if inj.mode = m_val then begin + let parent = inj.parent in + if not (islist parent) || inj.keyi <> 0 then + (push_err inj ("The $ONE validator at field " ^ pathify ~startin:(Num 1.0) ~endin:(Num 1.0) inj.path ^ " must be the first element of an array."); Noval) + else begin + inj.keyi <- size inj.keys; + ignore (inj_setval ~ancestor:2 inj inj.dparent); + inj.path <- slice ~start:(Num 0.0) ~stop:(Num (float_of_int (size inj.path - 1))) inj.path; + inj.key <- getelem inj.path (Num (-1.0)); + let tvals = slice ~start:(Num 1.0) parent in + if size tvals = 0 then + (push_err inj ("The $ONE validator at field " ^ pathify ~startin:(Num 1.0) ~endin:(Num 1.0) inj.path ^ " must have at least one argument."); Noval) + else begin + let matched = ref false in + List.iter (fun tval -> + if not !matched then begin + let terrs = empty_list () in + let vstore = merge ~maxdepth:(Num 1.0) (lst [empty_map (); store]) in + ignore (setprop vstore (Str s_dtop) inj.dparent); + let idef = { (default_injdef ()) with d_extra = vstore; d_errs = terrs; d_meta = inj.meta } in + let vcurrent = validate ~inj:(IDef idef) inj.dparent tval in + ignore (inj_setval ~ancestor:(-2) inj vcurrent); + if size terrs = 0 then matched := true + end) (match tvals with List r -> !r | _ -> []); + if not !matched then begin + let valdesc = String.concat ", " (List.map (fun (_, x) -> stringify x) (items_pairs tvals)) in + let valdesc = replace_transform_names valdesc in + push_err inj (invalid_type_msg inj.path ((if size tvals > 1 then "one of " else "") ^ valdesc) (typify inj.dparent) inj.dparent "V0210") + end; + Noval + end + end + end else Noval + +and validate_exact inj _v _ref _store = + if inj.mode = m_val then begin + let parent = inj.parent in + if not (islist parent) || inj.keyi <> 0 then + (push_err inj ("The $EXACT validator at field " ^ pathify ~startin:(Num 1.0) ~endin:(Num 1.0) inj.path ^ " must be the first element of an array."); Noval) + else begin + inj.keyi <- size inj.keys; + ignore (inj_setval ~ancestor:2 inj inj.dparent); + inj.path <- slice ~start:(Num 0.0) ~stop:(Num (float_of_int (size inj.path - 1))) inj.path; + inj.key <- getelem inj.path (Num (-1.0)); + let tvals = slice ~start:(Num 1.0) parent in + if size tvals = 0 then + (push_err inj ("The $EXACT validator at field " ^ pathify ~startin:(Num 1.0) ~endin:(Num 1.0) inj.path ^ " must have at least one argument."); Noval) + else begin + let matched = ref false in + List.iter (fun tval -> if not !matched && veq tval inj.dparent then matched := true) + (match tvals with List r -> !r | _ -> []); + if not !matched then begin + let valdesc = String.concat ", " (List.map (fun (_, x) -> stringify x) (items_pairs tvals)) in + let valdesc = replace_transform_names valdesc in + push_err inj (invalid_type_msg inj.path + ((if size inj.path > 1 then "" else "value ") ^ "exactly equal to " ^ (if size tvals = 1 then "" else "one of ") ^ valdesc) + (typify inj.dparent) inj.dparent "V0110") + end; + Noval + end + end + end else (ignore (delprop inj.parent inj.key); Noval) + +and veq a b = + match a, b with + | Noval, Noval -> true + | Null, Null -> true + | Bool x, Bool y -> x = y + | Num x, Num y -> x = y + | Str x, Str y -> x = y + | Sentinel x, Sentinel y -> x = y + | List x, List y -> List.length !x = List.length !y && List.for_all2 veq !x !y + | Map x, Map y -> + omap_len x = omap_len y && + List.for_all (fun (k, v) -> match omap_get y k with Some w -> veq v w | None -> false) x.entries + | _ -> false + +and validation pval key parent inj = + if not (is_skip pval) then begin + let exact = getprop ~alt:(Bool false) inj.meta (Str s_bexact) in + let cval = getprop inj.dparent key in + let exact_b = (match exact with Bool true -> true | _ -> false) in + if not ((not exact_b) && is_noval cval) then begin + let ptype = typify pval in + if not ((t_string land ptype) > 0 && String.contains (js_string pval) '$') then begin + let ctype = typify cval in + if ptype <> ctype && not (is_noval pval) then + push_err inj (invalid_type_msg inj.path (typename ptype) ctype cval "V0010") + else if ismap cval then begin + if not (ismap pval) then push_err inj (invalid_type_msg inj.path (typename ptype) ctype cval "V0020") + else begin + let ckeys = keysof cval in + let pkeys = keysof pval in + if List.length pkeys > 0 && not (getprop pval (Str s_bopen) = Bool true) then begin + let badkeys = List.filter (fun ck -> is_noval (lookup_ pval (Str ck))) ckeys in + if List.length badkeys > 0 then + push_err inj ("Unexpected keys at field " ^ pathify ~startin:(Num 1.0) inj.path ^ s_viz ^ String.concat ", " badkeys) + end else begin + ignore (merge (lst [pval; cval])); + if isnode pval then ignore (delprop pval (Str s_bopen)) + end + end + end else if islist cval then + (if not (islist pval) then push_err inj (invalid_type_msg inj.path (typename ptype) ctype cval "V0030")) + else if exact_b then + (if not (veq cval pval) then + let pathmsg = if size inj.path > 1 then "at field " ^ pathify ~startin:(Num 1.0) inj.path ^ ": " else "" in + push_err inj ("Value " ^ pathmsg ^ js_string cval ^ " should equal " ^ js_string pval ^ ".")) + else ignore (setprop parent key cval) + end + end + end + +and validate_handler inj v refstr store = + match meta_path_match refstr with + | Some (_, g2, _) -> + (if g2 = "=" then ignore (inj_setval inj (lst [Str s_bexact; v])) else ignore (inj_setval inj v)); + inj.keyi <- -1; skip + | None -> inject_handler inj v refstr store + +and validate ?(inj = INone) data spec = + let extra = (match inj with IDef d -> d.d_extra | _ -> Noval) in + let collect = (match inj with IDef d -> not (is_noval d.d_errs) | _ -> false) in + let errs = (match inj with IDef d when collect -> d.d_errs | _ -> empty_list ()) in + let base = empty_map () in + let put k v = ignore (setprop base (Str k) v) in + List.iter (fun k -> put k Null) ["$DELETE"; "$COPY"; "$KEY"; "$META"; "$MERGE"; "$EACH"; "$PACK"]; + put "$STRING" (Func validate_string); + List.iter (fun k -> put k (Func validate_type)) + ["$NUMBER"; "$INTEGER"; "$DECIMAL"; "$BOOLEAN"; "$NULL"; "$NIL"; "$MAP"; "$LIST"; "$FUNCTION"; "$INSTANCE"]; + put "$ANY" (Func validate_any); + put "$CHILD" (Func validate_child); + put "$ONE" (Func validate_one); + put "$EXACT" (Func validate_exact); + let store = merge ~maxdepth:(Num 1.0) (lst [base; (if is_noval extra then empty_map () else extra); Map { entries = [(s_derrs, errs)] }]) in + let meta = (match inj with IDef d when not (is_noval d.d_meta) -> d.d_meta | _ -> empty_map ()) in + ignore (setprop meta (Str s_bexact) (getprop ~alt:(Bool false) meta (Str s_bexact))); + let idef = { (default_injdef ()) with d_meta = meta; d_extra = store; d_modify = Some validation; d_handler = Some validate_handler; d_errs = errs } in + let out = transform ~inj:(IDef idef) data spec in + if size errs > 0 && not collect then raise (Struct_error (join ~sep:(Str " | ") errs)); + out + +(* ----- select ----- *) + +and select_and inj _v _ref store = + (if inj.mode = m_keypre then begin + let terms = getprop inj.parent inj.key in + let ppath = slice ~start:(Num (-1.0)) inj.path in + let point = getpath ~inj:INone store ppath in + let vstore = merge ~maxdepth:(Num 1.0) (lst [empty_map (); store]) in + ignore (setprop vstore (Str s_dtop) point); + List.iter (fun (_, term) -> + let terrs = empty_list () in + let idef = { (default_injdef ()) with d_extra = vstore; d_errs = terrs; d_meta = inj.meta } in + ignore (validate ~inj:(IDef idef) point term); + if size terrs <> 0 then push_err inj ("AND:" ^ pathify ppath ^ "\xe2\xa8\xaf" ^ stringify point ^ " fail:" ^ stringify terms)) (items_pairs terms); + let gkey = getelem inj.path (Num (-2.0)) in + let gp = getelem inj.nodes (Num (-2.0)) in + ignore (setprop gp gkey point) + end); Noval + +and select_or inj _v _ref store = + (if inj.mode = m_keypre then begin + let terms = getprop inj.parent inj.key in + let ppath = slice ~start:(Num (-1.0)) inj.path in + let point = getpath ~inj:INone store ppath in + let vstore = merge ~maxdepth:(Num 1.0) (lst [empty_map (); store]) in + ignore (setprop vstore (Str s_dtop) point); + let done_ = ref false in + List.iter (fun (_, term) -> + if not !done_ then begin + let terrs = empty_list () in + let idef = { (default_injdef ()) with d_extra = vstore; d_errs = terrs; d_meta = inj.meta } in + ignore (validate ~inj:(IDef idef) point term); + if size terrs = 0 then begin + let gkey = getelem inj.path (Num (-2.0)) in + let gp = getelem inj.nodes (Num (-2.0)) in + ignore (setprop gp gkey point); done_ := true + end + end) (items_pairs terms); + if not !done_ then push_err inj ("OR:" ^ pathify ppath ^ "\xe2\xa8\xaf" ^ stringify point ^ " fail:" ^ stringify terms) + end); Noval + +and select_not inj _v _ref store = + (if inj.mode = m_keypre then begin + let term = getprop inj.parent inj.key in + let ppath = slice ~start:(Num (-1.0)) inj.path in + let point = getpath ~inj:INone store ppath in + let vstore = merge ~maxdepth:(Num 1.0) (lst [empty_map (); store]) in + ignore (setprop vstore (Str s_dtop) point); + let terrs = empty_list () in + let idef = { (default_injdef ()) with d_extra = vstore; d_errs = terrs; d_meta = inj.meta } in + ignore (validate ~inj:(IDef idef) point term); + if size terrs = 0 then push_err inj ("NOT:" ^ pathify ppath ^ "\xe2\xa8\xaf" ^ stringify point ^ " fail:" ^ stringify term); + let gkey = getelem inj.path (Num (-2.0)) in + let gp = getelem inj.nodes (Num (-2.0)) in + ignore (setprop gp gkey point) + end); Noval + +and num_cmp a b op = + match a, b with + | Num x, Num y -> (match op with `Gt -> x > y | `Lt -> x < y | `Gte -> x >= y | `Lte -> x <= y) + | _ -> false + +and select_cmp inj _v refstr store = + (if inj.mode = m_keypre then begin + let term = getprop inj.parent inj.key in + let gkey = getelem inj.path (Num (-2.0)) in + let ppath = slice ~start:(Num (-1.0)) inj.path in + let point = getpath ~inj:INone store ppath in + let pass = + if refstr = "$GT" then num_cmp point term `Gt + else if refstr = "$LT" then num_cmp point term `Lt + else if refstr = "$GTE" then num_cmp point term `Gte + else if refstr = "$LTE" then num_cmp point term `Lte + else if refstr = "$LIKE" then (match term with Str t -> Vregex.test_str t (stringify point) | _ -> false) + else false in + if pass then (let gp = getelem inj.nodes (Num (-2.0)) in ignore (setprop gp gkey point)) + else push_err inj ("CMP: " ^ pathify ppath ^ "\xe2\xa8\xaf" ^ stringify point ^ " fail:" ^ refstr ^ " " ^ stringify term) + end); Noval + +and select children query = + if not (isnode children) then empty_list () + else begin + let children = + if ismap children then + lst (List.map (fun (k, n) -> ignore (setprop n (Str s_dkey) (Str k)); n) (items_pairs children)) + else + lst (List.mapi (fun i n -> if ismap n then (ignore (setprop n (Str s_dkey) (vint i)); n) else n) + (match children with List r -> !r | _ -> [])) in + let results = empty_list () in + let extra = empty_map () in + List.iter (fun (k, f) -> ignore (setprop extra (Str k) (Func f))) + [("$AND", select_and); ("$OR", select_or); ("$NOT", select_not); + ("$GT", select_cmp); ("$LT", select_cmp); ("$GTE", select_cmp); ("$LTE", select_cmp); ("$LIKE", select_cmp)]; + let q = clone query in + ignore (walk ~before:(fun _k v _p _path -> (if ismap v then ignore (setprop v (Str s_bopen) (getprop ~alt:(Bool true) v (Str s_bopen)))); v) q); + List.iter (fun child -> + let errs = empty_list () in + let idef = { (default_injdef ()) with d_errs = errs; d_meta = (let m = empty_map () in ignore (setprop m (Str s_bexact) (Bool true)); m); d_extra = extra } in + ignore (validate ~inj:(IDef idef) child (clone q)); + if size errs = 0 then ignore (setprop results (Num (float_of_int (size results))) child)) + (match children with List r -> !r | _ -> []); + results + end + +(* ----- builders ----- *) + +and jm kv = + let m = empty_map () in + let arr = Array.of_list kv in + let n = Array.length arr in + let i = ref 0 in + while !i < n do + let k0 = arr.(!i) in + let k = (match k0 with Null -> "null" | Str s -> s | _ -> stringify k0) in + omap_set (match m with Map mm -> mm | _ -> assert false) k (if !i + 1 < n then arr.(!i + 1) else Null); + i := !i + 2 + done; m + +and jt v = lst v + +(* --------------------------------------------------------------------------- + * Finish: set the dummy inj for getelem's function-alt path + * ------------------------------------------------------------------------- *) + +let () = + let parent = Map { entries = [(s_dtop, Noval)] } in + dummy_inj_ref := Some (new_inj Noval parent) + +let tn = typename diff --git a/ocaml/src/vregex.ml b/ocaml/src/vregex.ml new file mode 100644 index 00000000..73b9dddf --- /dev/null +++ b/ocaml/src/vregex.ml @@ -0,0 +1,254 @@ +(* Minimal backtracking regex engine for the OCaml port of voxgig/struct. + * Supports the RE2 subset the corpus exercises: literals, '.', anchors ^ $, + * \b, character classes [..] / [^..] with ranges and \d \w \s \D \W \S, + * groups (..) and (?:..), alternation |, quantifiers * + ? and {n}/{n,}/{n,m} + * with optional lazy '?'. No third-party dependency. The struct library uses + * `test` for $LIKE; `find` backs the public re_* API (not corpus-tested). *) + +type node = + | Char of char + | Any + | Start + | End + | WordB + | Cls of bool * citem list (* negated?, items *) + | Grp of node list list (* alternation of sequences *) + | Star of bool * node (* greedy?, atom *) + | Plus of bool * node + | Opt of bool * node + | Rep of bool * int * int option * node + +and citem = + | CChar of char + | CRange of char * char + | CD | CW | CS | CND | CNW | CNS (* \d \w \s \D \W \S *) + +(* ----- parser ----- *) + +let parse (pat : string) : node list list = + let n = String.length pat in + let pos = ref 0 in + let peek () = if !pos < n then Some pat.[!pos] else None in + let adv () = incr pos in + let parse_class () = + (* assumes current char is '[' *) + adv (); + let neg = (peek () = Some '^') in + if neg then adv (); + let items = ref [] in + let finished = ref false in + while not !finished do + match peek () with + | None -> finished := true + | Some ']' -> adv (); finished := true + | Some '\\' -> + adv (); + (match peek () with + | Some 'd' -> items := CD :: !items; adv () + | Some 'w' -> items := CW :: !items; adv () + | Some 's' -> items := CS :: !items; adv () + | Some 'D' -> items := CND :: !items; adv () + | Some 'W' -> items := CNW :: !items; adv () + | Some 'S' -> items := CNS :: !items; adv () + | Some 'n' -> items := CChar '\n' :: !items; adv () + | Some 't' -> items := CChar '\t' :: !items; adv () + | Some 'r' -> items := CChar '\r' :: !items; adv () + | Some c -> items := CChar c :: !items; adv () + | None -> ()) + | Some c -> + adv (); + (* range? *) + (match peek () with + | Some '-' when (!pos + 1 < n && pat.[!pos + 1] <> ']') -> + adv (); + (match peek () with + | Some c2 -> adv (); items := CRange (c, c2) :: !items + | None -> items := CChar c :: !items) + | _ -> items := CChar c :: !items) + done; + Cls (neg, List.rev !items) + in + let parse_quant_suffix atom = + match peek () with + | Some '*' -> adv (); + let lazy_ = (peek () = Some '?') in if lazy_ then adv (); + Some (Star (not lazy_, atom)) + | Some '+' -> adv (); + let lazy_ = (peek () = Some '?') in if lazy_ then adv (); + Some (Plus (not lazy_, atom)) + | Some '?' -> adv (); + let lazy_ = (peek () = Some '?') in if lazy_ then adv (); + Some (Opt (not lazy_, atom)) + | Some '{' -> + (* {n} {n,} {n,m} *) + let save = !pos in + adv (); + let num () = + let b = Buffer.create 4 in + let rec go () = match peek () with + | Some c when c >= '0' && c <= '9' -> Buffer.add_char b c; adv (); go () + | _ -> () in + go (); Buffer.contents b in + let mn = num () in + let mx = + match peek () with + | Some ',' -> adv (); let s = num () in if s = "" then None else Some (int_of_string s) + | _ -> Some (if mn = "" then 0 else int_of_string mn) + in + (match peek () with + | Some '}' when mn <> "" -> + adv (); + let lazy_ = (peek () = Some '?') in if lazy_ then adv (); + Some (Rep (not lazy_, int_of_string mn, mx, atom)) + | _ -> pos := save; None) (* not a valid quantifier; treat '{' literally *) + | _ -> None + in + let rec parse_alt () : node list list = + let first = parse_seq () in + let alts = ref [first] in + while peek () = Some '|' do + adv (); + alts := parse_seq () :: !alts + done; + List.rev !alts + and parse_seq () : node list = + let out = ref [] in + let stop = ref false in + while not !stop do + match peek () with + | None | Some '|' | Some ')' -> stop := true + | _ -> + let atom = parse_atom () in + (match atom with + | None -> stop := true + | Some a -> + let a = (match parse_quant_suffix a with Some q -> q | None -> a) in + out := a :: !out) + done; + List.rev !out + and parse_atom () : node option = + match peek () with + | None -> None + | Some '(' -> + adv (); + (* non-capturing? *) + (if peek () = Some '?' && !pos + 1 < n && pat.[!pos + 1] = ':' then (adv (); adv ())); + let alts = parse_alt () in + (if peek () = Some ')' then adv ()); + Some (Grp alts) + | Some '[' -> Some (parse_class ()) + | Some '.' -> adv (); Some Any + | Some '^' -> adv (); Some Start + | Some '$' -> adv (); Some End + | Some '\\' -> + adv (); + (match peek () with + | Some 'd' -> adv (); Some (Cls (false, [CD])) + | Some 'w' -> adv (); Some (Cls (false, [CW])) + | Some 's' -> adv (); Some (Cls (false, [CS])) + | Some 'D' -> adv (); Some (Cls (false, [CND])) + | Some 'W' -> adv (); Some (Cls (false, [CNW])) + | Some 'S' -> adv (); Some (Cls (false, [CNS])) + | Some 'b' -> adv (); Some WordB + | Some 'n' -> adv (); Some (Char '\n') + | Some 't' -> adv (); Some (Char '\t') + | Some 'r' -> adv (); Some (Char '\r') + | Some c -> adv (); Some (Char c) + | None -> Some (Char '\\')) + | Some c -> adv (); Some (Char c) + in + parse_alt () + +(* ----- matcher (backtracking, CPS) ----- *) + +let is_word c = + (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') || (c >= '0' && c <= '9') || c = '_' + +let citem_match it c = + match it with + | CChar x -> c = x + | CRange (a, b) -> c >= a && c <= b + | CD -> c >= '0' && c <= '9' + | CND -> not (c >= '0' && c <= '9') + | CW -> is_word c + | CNW -> not (is_word c) + | CS -> c = ' ' || c = '\t' || c = '\n' || c = '\r' || c = '\012' || c = '\011' + | CNS -> not (c = ' ' || c = '\t' || c = '\n' || c = '\r' || c = '\012' || c = '\011') + +let rec m_node input len node pos (k : int -> bool) : bool = + match node with + | Char c -> pos < len && input.[pos] = c && k (pos + 1) + | Any -> pos < len && input.[pos] <> '\n' && k (pos + 1) + | Start -> pos = 0 && k pos + | End -> pos = len && k pos + | WordB -> + let before = pos > 0 && is_word input.[pos - 1] in + let after = pos < len && is_word input.[pos] in + (before <> after) && k pos + | Cls (neg, items) -> + pos < len && + (let c = input.[pos] in + let hit = List.exists (fun it -> citem_match it c) items in + (if neg then not hit else hit) && k (pos + 1)) + | Grp alts -> List.exists (fun seq -> m_seq input len seq pos k) alts + | Opt (greedy, a) -> + if greedy then m_node input len a pos k || k pos + else k pos || m_node input len a pos k + | Star (greedy, a) -> m_star input len greedy a pos k + | Plus (greedy, a) -> + m_node input len a pos (fun p -> m_star input len greedy a p k) + | Rep (greedy, mn, mx, a) -> m_rep input len greedy mn mx a pos k + +and m_star input len greedy a pos k = + if greedy then + m_node input len a pos (fun p -> p > pos && m_star input len greedy a p k) || k pos + else + k pos || m_node input len a pos (fun p -> p > pos && m_star input len greedy a p k) + +and m_rep input len greedy mn mx a pos k = + if mn > 0 then + m_node input len a pos (fun p -> + m_rep input len greedy (mn - 1) + (match mx with Some m -> Some (m - 1) | None -> None) a p k) + else + match mx with + | Some 0 -> k pos + | _ -> + let next p = p > pos && m_rep input len greedy 0 + (match mx with Some m -> Some (m - 1) | None -> None) a p k in + if greedy then m_node input len a pos next || k pos + else k pos || m_node input len a pos next + +and m_seq input len seq pos k = + match seq with + | [] -> k pos + | x :: rest -> m_node input len x pos (fun p -> m_seq input len rest p k) + +(* Compiled = the alternation AST. *) +type t = node list list + +let compile (pat : string) : t = parse pat + +(* Does the pattern match anywhere in input? *) +let test (re : t) (input : string) : bool = + let len = String.length input in + let rec try_at i = + if List.exists (fun seq -> m_seq input len seq i (fun _ -> true)) re then true + else if i >= len then false + else try_at (i + 1) + in + try_at 0 + +let test_str (pat : string) (input : string) : bool = test (compile pat) input + +(* Leftmost match: returns (start, stop) or None. Used by the public re_* API. *) +let find_bounds (re : t) (input : string) : (int * int) option = + let len = String.length input in + let rec try_at i = + if i > len then None + else + let best = ref (-1) in + let ok = List.exists (fun seq -> m_seq input len seq i (fun p -> best := p; true)) re in + if ok then Some (i, !best) else try_at (i + 1) + in + try_at 0 diff --git a/ocaml/test/runner.ml b/ocaml/test/runner.ml new file mode 100644 index 00000000..88983447 --- /dev/null +++ b/ocaml/test/runner.ml @@ -0,0 +1,487 @@ +(* Test runner for the shared JSON corpus (build/test/test.json). + * Self-contained: an in-tree JSON reader builds the library's `value` type + * directly, so the OCaml port is exercised exactly as in production. *) + +open Voxgig_struct + +let nullmark = "__NULL__" +let undefmark = "__UNDEF__" +let existsmark = "__EXISTS__" + +(* ---------------- JSON reader -> value ---------------- *) + +let json_read (s : string) : value = + let n = String.length s in + let pos = ref 0 in + let peek () = if !pos < n then Some s.[!pos] else None in + let adv () = incr pos in + let skip_ws () = + while !pos < n && (match s.[!pos] with ' ' | '\t' | '\n' | '\r' -> true | _ -> false) do incr pos done + in + let rec pval () = + skip_ws (); + match peek () with + | Some '{' -> pobj () + | Some '[' -> parr () + | Some '"' -> Str (pstr ()) + | Some 't' -> pos := !pos + 4; Bool true + | Some 'f' -> pos := !pos + 5; Bool false + | Some 'n' -> pos := !pos + 4; Null + | _ -> pnum () + and pobj () = + adv (); skip_ws (); + if peek () = Some '}' then (adv (); empty_map ()) + else begin + let m = empty_map () in + let rec loop () = + skip_ws (); + let k = pstr () in + skip_ws (); adv (); (* : *) + let v = pval () in + ignore (setprop m (Str k) v); + skip_ws (); + let c = (match peek () with Some c -> adv (); c | None -> '}') in + if c = ',' then loop () else m + in loop () + end + and parr () = + adv (); skip_ws (); + if peek () = Some ']' then (adv (); empty_list ()) + else begin + let acc = ref [] in + let rec loop () = + let v = pval () in + acc := v :: !acc; + skip_ws (); + let c = (match peek () with Some c -> adv (); c | None -> ']') in + if c = ',' then loop () else lst (List.rev !acc) + in loop () + end + and pstr () = + adv (); + let b = Buffer.create 16 in + let rec loop () = + let c = s.[!pos] in adv (); + if c = '"' then Buffer.contents b + else if c = '\\' then begin + let e = s.[!pos] in adv (); + (match e with + | '"' -> Buffer.add_char b '"' | '\\' -> Buffer.add_char b '\\' + | '/' -> Buffer.add_char b '/' | 'n' -> Buffer.add_char b '\n' + | 't' -> Buffer.add_char b '\t' | 'r' -> Buffer.add_char b '\r' + | 'b' -> Buffer.add_char b '\b' | 'f' -> Buffer.add_char b '\012' + | 'u' -> + let hex = String.sub s !pos 4 in pos := !pos + 4; + let code = int_of_string ("0x" ^ hex) in + if code < 128 then Buffer.add_char b (Char.chr code) + else if code < 2048 then begin + Buffer.add_char b (Char.chr (0xC0 lor (code lsr 6))); + Buffer.add_char b (Char.chr (0x80 lor (code land 0x3F))) + end else begin + Buffer.add_char b (Char.chr (0xE0 lor (code lsr 12))); + Buffer.add_char b (Char.chr (0x80 lor ((code lsr 6) land 0x3F))); + Buffer.add_char b (Char.chr (0x80 lor (code land 0x3F))) + end + | c -> Buffer.add_char b c); + loop () + end else (Buffer.add_char b c; loop ()) + in loop () + and pnum () = + let start = !pos in + while !pos < n && (match s.[!pos] with + | '0'..'9' | '-' | '+' | '.' | 'e' | 'E' -> true | _ -> false) do incr pos done; + let tok = String.sub s start (!pos - start) in + Num (float_of_string tok) + in + pval () + +(* ---------------- fixJSON / equality ---------------- *) + +let rec fix_json v flag_null = + match v with + | Noval | Null -> if flag_null then Str nullmark else v + | Map m -> let o = empty_map () in + List.iter (fun (k, x) -> ignore (setprop o (Str k) (fix_json x flag_null))) m.entries; o + | List r -> lst (List.map (fun x -> fix_json x flag_null) !r) + | _ -> v + +(* Order-independent deep equality for maps; sequence equality for lists. *) +let rec eqv a b = + match a, b with + | (Noval | Null), (Noval | Null) -> true + | Bool x, Bool y -> x = y + | Num x, Num y -> x = y + | Str x, Str y -> x = y + | List x, List y -> List.length !x = List.length !y && List.for_all2 eqv !x !y + | Map x, Map y -> + omap_len x = omap_len y && + List.for_all (fun (k, v) -> match omap_get y k with Some w -> eqv v w | None -> false) x.entries + | _ -> a == b + +(* ---------------- match support ---------------- *) + +let matchval check base = + let check = if check = Str undefmark || check = Str nullmark then Noval else check in + if eqv check base then true + else match check with + | Str cs -> + let basestr = stringify base in + if String.length cs >= 2 && cs.[0] = '/' && cs.[String.length cs - 1] = '/' then + Vregex.test_str (String.sub cs 1 (String.length cs - 2)) basestr + else + let low s = String.lowercase_ascii s in + let contains hay needle = + let hl = String.length hay and nl = String.length needle in + let rec go i = if i + nl > hl then false + else if String.sub hay i nl = needle then true else go (i + 1) in + nl = 0 || go 0 in + contains (low basestr) (low (stringify check)) + | Func _ -> true + | _ -> false + +let do_match check base = + let base = clone base in + ignore (walk ~before:(fun _k v _p path -> + (if not (isnode v) then begin + let baseval = getpath base path in + if eqv baseval v then () + else if v = Str undefmark && is_nullish baseval then () + else if v = Str existsmark && not (is_nullish baseval) then () + else if not (matchval v baseval) then + raise (Struct_error (Printf.sprintf "MATCH: %s: [%s] <=> [%s]" + (String.concat "." (List.map js_string (match path with List r -> !r | _ -> []))) + (stringify v) (stringify baseval))) + end); + v) check) + +(* ---------------- result tracking ---------------- *) + +let npass = ref 0 +let nfail = ref 0 +let failures = ref [] + +let record group name ok msg = + if ok then incr npass + else (incr nfail; failures := Printf.sprintf "FAIL %s %s - %s" group name msg :: !failures) + +(* ---------------- per-entry runner ---------------- *) + +let omap_v kvs = + let m = empty_map () in + List.iter (fun (k, v) -> ignore (setprop m (Str k) v)) kvs; m + +let getprop_raw_pub e k = (match e with Map m -> (match omap_get m k with Some x -> x | None -> Noval) | _ -> Noval) +let entry_get e k = getprop_raw_pub e k +let entry_has e k = match e with Map m -> omap_has m k | _ -> false +let default_injdef_pub () = + { d_meta = Noval; d_extra = Noval; d_errs = Noval; d_modify = None; d_handler = None; + d_base = Noval; d_dparent = Noval; d_dpath = Noval; d_key = Noval } + +let resolve_args entry = + if entry_has entry "ctx" then [entry_get entry "ctx"] + else if entry_has entry "args" then (match entry_get entry "args" with List r -> !r | _ -> []) + else if entry_has entry "in" then [clone (entry_get entry "in")] + else [Noval] + +let check_result entry args res = + let matched = ref false in + (if entry_has entry "match" then begin + do_match (entry_get entry "match") + (omap_v ["in", entry_get entry "in"; "args", lst args; + "out", entry_get entry "res"; "ctx", entry_get entry "ctx"]); + matched := true + end); + let out = entry_get entry "out" in + if eqv out res then () + else if !matched && (out = Str nullmark || is_nullish out) then () + else raise (Struct_error (Printf.sprintf "Expected: %s, got: %s" (stringify out) (stringify res))) + +let handle_error entry err = + let msg = (match err with Struct_error m -> m | e -> Printexc.to_string e) in + if entry_has entry "err" then begin + let entry_err = entry_get entry "err" in + if entry_err = Bool true || matchval entry_err (Str msg) then begin + if entry_has entry "match" then + do_match (entry_get entry "match") + (omap_v ["in", entry_get entry "in"; "out", entry_get entry "res"; + "ctx", entry_get entry "ctx"; "err", Str msg]) + end else + raise (Struct_error (Printf.sprintf "ERROR MATCH: [%s] <=> [%s]" (stringify entry_err) msg)) + end else raise err + +let run_set ?(flags = []) group node subject = + let flag_null = (match List.assoc_opt "null" flags with Some b -> b | None -> true) in + let fixed = fix_json node flag_null in + let testset = (match getprop fixed (Str "set") with List r -> !r | _ -> []) in + List.iter (fun entry -> + let name = js_string (entry_get entry "name") in + try + (if not (entry_has entry "out") && flag_null then ignore (setprop entry (Str "out") (Str nullmark))); + let args = resolve_args entry in + let res = fix_json (subject args) flag_null in + ignore (setprop entry (Str "res") res); + check_result entry args res; + record group name true "" + with + | e -> + (try handle_error entry e; record group name true "" + with e2 -> record group name false + (match e2 with Struct_error m -> m | _ -> Printexc.to_string e2))) + testset + +let run_single group node actual_fn = + try + let expected = getprop_raw_pub node "out" in + let actual = actual_fn (getprop_raw_pub node "in") in + if eqv expected actual then record group "single" true "" + else record group "single" false (Printf.sprintf "Expected: %s, got: %s" (stringify expected) (stringify actual)) + with e -> record group "single" false (match e with Struct_error m -> m | _ -> Printexc.to_string e) + +(* ---------------- arg helpers ---------------- *) + +let arg1 f = fun args -> f (match args with x :: _ -> x | [] -> Noval) +let vget vin k = match vin with Map m -> (match omap_get m k with Some x -> x | None -> Noval) | _ -> Noval +let vhas vin k = match vin with Map m -> omap_has m k | _ -> false + +(* ---------------- test groups ---------------- *) + +let null_modifier v key parent _inj = + if v = Str nullmark then ignore (setprop parent key Null) + else (match v with Str s -> ignore (setprop parent key (Str ( + (* replace __NULL__ with null *) + let b = Buffer.create (String.length s) in + let nl = String.length nullmark in let n = String.length s in let i = ref 0 in + while !i < n do + if !i + nl <= n && String.sub s !i nl = nullmark then (Buffer.add_string b "null"; i := !i + nl) + else (Buffer.add_char b s.[!i]; incr i) + done; Buffer.contents b))) + | _ -> ()) + +let rec run_all spec = + let g k = getprop_raw_pub spec k in + ignore g; + let minor = g "minor" and walks = g "walk" and merges = g "merge" + and getpaths = g "getpath" and injects = g "inject" and transforms = g "transform" + and validates = g "validate" and selects = g "select" and sentinels = g "sentinels" in + let mg n = getprop_raw_pub minor n in + + (* minor *) + run_set "minor.isnode" (mg "isnode") (arg1 (fun v -> Bool (isnode v))); + run_set "minor.ismap" (mg "ismap") (arg1 (fun v -> Bool (ismap v))); + run_set "minor.islist" (mg "islist") (arg1 (fun v -> Bool (islist v))); + run_set "minor.iskey" ~flags:["null", false] (mg "iskey") (arg1 (fun v -> Bool (iskey v))); + run_set "minor.strkey" ~flags:["null", false] (mg "strkey") (arg1 (fun v -> Str (strkey ~key:v ()))); + run_set "minor.isempty" ~flags:["null", false] (mg "isempty") (arg1 (fun v -> Bool (isempty v))); + run_set "minor.isfunc" (mg "isfunc") (arg1 (fun v -> Bool (isfunc v))); + run_set "minor.clone" ~flags:["null", false] (mg "clone") (arg1 clone); + run_set "minor.escre" (mg "escre") (arg1 escre); + run_set "minor.escurl" (mg "escurl") (arg1 escurl); + run_set "minor.stringify" ~flags:["null", false] (mg "stringify") + (arg1 (fun vin -> if vhas vin "val" then Str (stringify ~maxlen:(vget vin "max") (vget vin "val")) else Str (stringify Noval))); + run_set "minor.jsonify" ~flags:["null", false] (mg "jsonify") + (arg1 (fun vin -> Str (jsonify ~flags:(vget vin "flags") (vget vin "val")))); + run_set "minor.getelem" ~flags:["null", false] (mg "getelem") + (arg1 (fun vin -> let alt = vget vin "alt" in + if is_nullish alt then getelem (vget vin "val") (vget vin "key") + else getelem ~alt (vget vin "val") (vget vin "key"))); + run_set "minor.delprop" (mg "delprop") + (arg1 (fun vin -> delprop (vget vin "parent") (vget vin "key"))); + run_set "minor.size" ~flags:["null", false] (mg "size") (arg1 (fun v -> vint (size v))); + run_set "minor.slice" ~flags:["null", false] (mg "slice") + (arg1 (fun vin -> slice ~start:(vget vin "start") ~stop:(vget vin "end") (vget vin "val"))); + run_set "minor.pad" ~flags:["null", false] (mg "pad") + (arg1 (fun vin -> Str (pad ~padding:(vget vin "pad") ~padchar:(vget vin "char") (vget vin "val")))); + run_set "minor.pathify" ~flags:["null", false] (mg "pathify") + (arg1 (fun vin -> if vhas vin "path" then Str (pathify ~startin:(vget vin "from") (vget vin "path")) + else Str (pathify ~startin:(vget vin "from") ~absent:true Noval))); + run_set "minor.items" (mg "items") (arg1 items); + run_set "minor.getprop" ~flags:["null", false] (mg "getprop") + (arg1 (fun vin -> let alt = vget vin "alt" in + if is_nullish alt then getprop (vget vin "val") (vget vin "key") + else getprop ~alt (vget vin "val") (vget vin "key"))); + run_set "minor.setprop" (mg "setprop") + (arg1 (fun vin -> setprop (vget vin "parent") (vget vin "key") (vget vin "val"))); + run_set "minor.haskey" ~flags:["null", false] (mg "haskey") + (arg1 (fun vin -> Bool (haskey (vget vin "src") (vget vin "key")))); + run_set "minor.keysof" (mg "keysof") (arg1 (fun v -> lst (List.map (fun s -> Str s) (keysof v)))); + run_set "minor.join" ~flags:["null", false] (mg "join") + (arg1 (fun vin -> Str (join ~sep:(vget vin "sep") ~url:(match vget vin "url" with Bool true -> true | _ -> false) (vget vin "val")))); + run_set "minor.typify" ~flags:["null", false] (mg "typify") (arg1 (fun v -> vint (typify v))); + run_set "minor.setpath" ~flags:["null", false] (mg "setpath") + (arg1 (fun vin -> setpath (vget vin "store") (vget vin "path") (vget vin "val"))); + run_set "minor.filter" (mg "filter") + (arg1 (fun vin -> let check = (match vget vin "check" with + | Str "gt3" -> (fun (_, x) -> match x with Num n -> n > 3.0 | _ -> false) + | Str "lt3" -> (fun (_, x) -> match x with Num n -> n < 3.0 | _ -> false) + | _ -> (fun _ -> false)) in + filter (vget vin "val") check)); + run_set "minor.typename" (mg "typename") (arg1 (fun v -> Str (typename (match v with Num n -> int_of_float n | _ -> 0)))); + run_set "minor.flatten" (mg "flatten") + (arg1 (fun vin -> flatten ?depth:(match vget vin "depth" with Num n -> Some (int_of_float n) | _ -> None) (vget vin "val"))); + + (* walk *) + run_walk_log "walk.log" (getprop_raw_pub walks "log"); + run_set "walk.basic" (getprop_raw_pub walks "basic") + (arg1 (fun vin -> walk ~after:(fun _k v _p path -> + match v with Str s -> Str (s ^ "~" ^ String.concat "." (List.map js_string (match path with List r -> !r | _ -> []))) | _ -> v) vin)); + run_set "walk.copy" (getprop_raw_pub walks "copy") (arg1 walk_copy_subject); + run_set "walk.depth" ~flags:["null", false] (getprop_raw_pub walks "depth") (arg1 walk_depth_subject); + + (* merge *) + run_single "merge.basic" (getprop_raw_pub merges "basic") (fun in_ -> merge (clone in_)); + run_set "merge.cases" (getprop_raw_pub merges "cases") (arg1 merge); + run_set "merge.array" (getprop_raw_pub merges "array") (arg1 merge); + run_set "merge.integrity" (getprop_raw_pub merges "integrity") (arg1 merge); + run_set "merge.depth" (getprop_raw_pub merges "depth") + (arg1 (fun vin -> merge ~maxdepth:(vget vin "depth") (vget vin "val"))); + + (* getpath *) + run_set "getpath.basic" (getprop_raw_pub getpaths "basic") + (arg1 (fun vin -> getpath (vget vin "store") (vget vin "path"))); + run_set "getpath.relative" (getprop_raw_pub getpaths "relative") + (arg1 (fun vin -> + let dpath = (match vget vin "dpath" with Str s -> lst (List.map (fun x -> Str x) (String.split_on_char '.' s)) | _ -> Noval) in + let d = { (default_injdef_pub ()) with d_dparent = vget vin "dparent"; d_dpath = dpath } in + getpath ~inj:(IDef d) (vget vin "store") (vget vin "path"))); + run_set "getpath.special" (getprop_raw_pub getpaths "special") + (arg1 (fun vin -> + let injm = vget vin "inj" in + let d = { (default_injdef_pub ()) with + d_base = getprop injm (Str "base"); d_meta = getprop injm (Str "meta"); + d_dparent = getprop injm (Str "dparent"); d_dpath = getprop injm (Str "dpath"); + d_key = getprop injm (Str "key") } in + getpath ~inj:(if is_nullish injm then INone else IDef d) (vget vin "store") (vget vin "path"))); + run_set "getpath.handler" (getprop_raw_pub getpaths "handler") + (arg1 (fun vin -> + let store = omap_v ["$TOP", vget vin "store"; "$FOO", Func (fun _ _ _ _ -> Str "foo")] in + let d = { (default_injdef_pub ()) with d_handler = Some (fun _inj v _ref _store -> match v with Func f -> f (Obj.magic 0) Noval "" Noval | _ -> v) } in + getpath ~inj:(IDef d) store (vget vin "path"))); + + (* inject *) + run_single "inject.basic" (getprop_raw_pub injects "basic") + (fun in_ -> inject (clone (getprop_raw_pub in_ "val")) (clone (getprop_raw_pub in_ "store"))); + run_set "inject.string" (getprop_raw_pub injects "string") + (arg1 (fun vin -> + let d = { (default_injdef_pub ()) with d_modify = Some null_modifier; d_extra = vget vin "current" } in + inject ~inj:(IDef d) (vget vin "val") (vget vin "store"))); + run_set "inject.deep" (getprop_raw_pub injects "deep") + (arg1 (fun vin -> inject (vget vin "val") (vget vin "store"))); + + (* transform *) + run_single "transform.basic" (getprop_raw_pub transforms "basic") + (fun in_ -> transform (getprop_raw_pub in_ "data") (getprop_raw_pub in_ "spec")); + List.iter (fun gn -> + run_set ("transform." ^ gn) (getprop_raw_pub transforms gn) + (arg1 (fun vin -> transform (vget vin "data") (vget vin "spec")))) + ["paths"; "cmds"; "each"; "pack"; "ref"]; + run_set "transform.modify" (getprop_raw_pub transforms "modify") + (arg1 (fun vin -> + let d = { (default_injdef_pub ()) with + d_modify = Some (fun v key parent _inj -> + (match v with Str s when not (is_nullish key) && not (is_nullish parent) -> ignore (setprop parent key (Str ("@" ^ s))) | _ -> ())); + d_extra = vget vin "store" } in + transform ~inj:(IDef d) (vget vin "data") (vget vin "spec"))); + run_set "transform.format" ~flags:["null", false] (getprop_raw_pub transforms "format") + (arg1 (fun vin -> transform (vget vin "data") (vget vin "spec"))); + run_set "transform.apply" (getprop_raw_pub transforms "apply") + (arg1 (fun vin -> transform (vget vin "data") (vget vin "spec"))); + + (* validate *) + run_set "validate.basic" ~flags:["null", false] (getprop_raw_pub validates "basic") + (arg1 (fun vin -> validate (vget vin "data") (vget vin "spec"))); + List.iter (fun gn -> + run_set ("validate." ^ gn) (getprop_raw_pub validates gn) + (arg1 (fun vin -> validate (vget vin "data") (vget vin "spec")))) + ["child"; "one"; "exact"]; + run_set "validate.invalid" ~flags:["null", false] (getprop_raw_pub validates "invalid") + (arg1 (fun vin -> validate (vget vin "data") (vget vin "spec"))); + run_set "validate.special" (getprop_raw_pub validates "special") + (arg1 (fun vin -> + let injm = vget vin "inj" in + let d = { (default_injdef_pub ()) with d_meta = getprop injm (Str "meta") } in + validate ~inj:(if is_nullish injm then INone else IDef d) (vget vin "data") (vget vin "spec"))); + + (* select *) + List.iter (fun gn -> + run_set ("select." ^ gn) (getprop_raw_pub selects gn) + (arg1 (fun vin -> select (vget vin "obj") (vget vin "query")))) + ["basic"; "operators"; "edge"; "alts"]; + + (* sentinels *) + run_set "sentinels.getprop_unify" ~flags:["null", false] (getprop_raw_pub sentinels "getprop_unify") + (arg1 (fun vin -> getprop ~alt:(vget vin "alt") (vget vin "val") (vget vin "key"))); + run_set "sentinels.getelem_absent" ~flags:["null", false] (getprop_raw_pub sentinels "getelem_absent") + (arg1 (fun vin -> getelem ~alt:(vget vin "alt") (vget vin "val") (vget vin "key"))); + run_set "sentinels.haskey_unify" ~flags:["null", false] (getprop_raw_pub sentinels "haskey_unify") + (arg1 (fun vin -> Bool (haskey (vget vin "val") (vget vin "key")))); + run_set "sentinels.isempty_unify" ~flags:["null", false] (getprop_raw_pub sentinels "isempty_unify") + (arg1 (fun v -> Bool (isempty v))); + run_set "sentinels.isnode_unify" ~flags:["null", false] (getprop_raw_pub sentinels "isnode_unify") + (arg1 (fun v -> Bool (isnode v))); + run_set "sentinels.stringify_null" ~flags:["null", false] (getprop_raw_pub sentinels "stringify_null") + (arg1 (fun vin -> Str (stringify vin))) + +and run_walk_log group node = + try + let test_data = clone node in + let log = empty_list () in + let walklog key v parent path = + ignore (setprop log (Num (float_of_int (size log))) + (Str (Printf.sprintf "k=%s, v=%s, p=%s, t=%s" + (if is_nullish key then stringify Noval else stringify key) + (stringify v) + (if is_nullish parent then stringify Noval else stringify parent) + (pathify path)))); + v in + ignore (walk ~after:walklog (getprop_raw_pub test_data "in")); + let expected = getprop (getprop_raw_pub test_data "out") (Str "after") in + if eqv expected log then record group "log" true "" + else record group "log" false (Printf.sprintf "Expected: %s, got: %s" (stringify expected) (stringify log)) + with e -> record group "log" false (match e with Struct_error m -> m | _ -> Printexc.to_string e) + +and walk_copy_subject vin = + let cur = ref (lst [Noval]) in + let walkcopy key v _parent path = + if is_nullish key then begin + cur := lst [(if ismap v then empty_map () else if islist v then empty_list () else v)]; + v + end else begin + let i = size path in + let nv = if isnode v then begin + (match !cur with List r -> while List.length !r <= i do r := !r @ [Noval] done | _ -> ()); + let n = if ismap v then empty_map () else empty_list () in + (match !cur with List r -> r := List.mapi (fun j x -> if j = i then n else x) !r | _ -> ()); + n + end else v in + ignore (setprop (getelem !cur (Num (float_of_int (i - 1)))) key nv); + v + end in + ignore (walk ~before:walkcopy vin); + getelem !cur (Num 0.0) + +and walk_depth_subject vin = + let top = ref Noval and curr = ref Noval in + let copy key v _parent _path = + (if is_nullish key || isnode v then begin + let child = if islist v then empty_list () else empty_map () in + if is_nullish key then (top := child; curr := child) + else (ignore (setprop !curr key child); curr := child) + end else ignore (setprop !curr key v)); + v in + ignore (walk ~before:copy ~maxdepth:(vget vin "maxdepth") (vget vin "src")); + !top + +(* ---------------- main ---------------- *) + +let () = + let testfile = if Array.length Sys.argv > 1 then Sys.argv.(1) else "../build/test/test.json" in + let ic = open_in_bin testfile in + let len = in_channel_length ic in + let raw = really_input_string ic len in + close_in ic; + let alltests = json_read raw in + let spec = getprop_raw_pub alltests "struct" in + run_all spec; + List.iter print_endline (List.rev !failures); + Printf.printf "\nPASS %d FAIL %d\n" !npass !nfail; + if !nfail > 0 then exit 1 diff --git a/scala/AGENTS.md b/scala/AGENTS.md new file mode 100644 index 00000000..ce3f2692 --- /dev/null +++ b/scala/AGENTS.md @@ -0,0 +1,69 @@ +# AGENTS.md — Scala port of `voxgig/struct` + +Read the repo-root [`AGENTS.md`](../AGENTS.md) first. This file covers only +what is specific to the Scala port. **TypeScript is canonical; the shared +`build/test/*.jsonic` corpus is the contract.** This port mirrors the +canonical TypeScript logic directly (it was ported from the OCaml port), because +Scala — like TypeScript, Rust and OCaml — keeps `undefined` and JSON `null` +distinct. + +## How to build / test / lint + +``` +cd scala +make test # scalac compiles src + test, scala runs build/test/test.json +make lint # type-checks the library (a clean compile = pass) +``` + +Requires the Scala 3 compiler (`scalac` / `scala`) and a JDK on `PATH`. **Zero +third-party dependencies** — the test runner has an in-tree JSON reader, and +the only regex used is the JVM standard `java.util.regex`. + +## The value model + +Everything is one sealed ADT (`Value`) so the functions are effectively +dynamic within it: + +``` +Noval | VNull | VBool | VNum(Double) | VStr | VList(ArrayBuffer[Value]) + | VMap(LinkedHashMap[String, Value]) | VFunc(Injector) | VSentinel(String) +``` + +- **`Noval` is the TS `undefined`** (property absent); **`VNull` is JSON null**. + Distinct — the canonical TS model. `isNullish` covers both (JS `null == v`); + `isNoval` is `undefined` only. Group A readers (`getprop`, `getelem`, + `haskey`) return the default on either; Group B processors use the raw + `lookup_` to preserve `VNull`. **Getting `getprop` (Group A) vs `lookup_` + (raw) right is the single most common source of port bugs** — e.g. validate's + bad-key check and `transform`'s `$FORMAT`/`$REF` argument reads use `lookup_`. +- **Numbers are a single `VNum(Double)`** (like Rust/OCaml). `typify` splits + integer/decimal via `Number.isInteger` semantics (`2.0` is an integer). +- **Nodes are mutable and reference-stable:** lists are `ArrayBuffer[Value]`, + maps are `scala.collection.mutable.LinkedHashMap[String, Value]` (insertion + order preserved; re-assigning an existing key keeps its position). The + algorithm mutates them in place; never swap in an immutable collection. +- **`SKIP` / `DELETE`** are `VSentinel` values compared by tag. + +## Injection state + +`Inj` is a mutable class (the `Injection`). The public API accepts a loose +`InjDef` (the `Partial` of the canonical) wrapped in the `InjArg` +ADT (`IInj | IDef | INone`), so `getpath` / `inject` / `transform` / `validate` +work both with a live `Inj` (recursion) and a caller-supplied options object. + +## Naming + +Public names are the canonical names, lower-smushed or camelCased so they +match case/underscore-insensitively (`getpath`, `ismap`, `re_find_all`, +`checkPlacement`, `injectorArgs`, `injectChild`). Everything lives in +`object voxgig.struct`. + +## Gotchas + +- **`clone` collides with `java.lang.Object#clone`** in code that doesn't live + inside the `struct` object (e.g. the runner imports it as `sclone`). Inside + the object the library's own `clone` shadows the inherited one. +- **`Group A` vs raw `lookup_`** — see above; re-check before touching any read + path in validate / transform. +- Keep `make test` and `python3 ../tools/check_parity.py` green, and add no + runtime dependencies. Change canonical (TS + corpus) first, then propagate. diff --git a/scala/DOCS.md b/scala/DOCS.md new file mode 100644 index 00000000..b878f0bb --- /dev/null +++ b/scala/DOCS.md @@ -0,0 +1,117 @@ +# Scala port — comprehensive guide + +This document covers the Scala-specific details of `voxgig/struct`. For the +language-neutral concepts, tutorial and full reference, read the top-level +[`DOCS.md`](../DOCS.md); for the user overview, [`README.md`](./README.md). +TypeScript is canonical and the shared `build/test` corpus is the contract. + +## Installation + +The library is a single source file (`src/voxgig_struct.scala`) and needs +nothing but the Scala 3 toolchain. Compile it into your project and +`import voxgig.struct.*`. + +## Representation of data + +| JSON-shape thing | Scala representation | +|-------------------------|-------------------------------------------------------| +| object / map | `VMap(LinkedHashMap[String, Value])` (insertion order)| +| array / list | `VList(ArrayBuffer[Value])` | +| string | `VStr(String)` | +| number (int or decimal) | `VNum(Double)` | +| boolean | `VBool(Boolean)` | +| JSON `null` | `VNull` | +| undefined / absent | `Noval` | +| function (commands) | `VFunc(Injector)` | + +Nodes are **mutable and reference-stable** on purpose: `merge`, `walk`, +`inject`, `transform`, `validate` mutate nodes in place and depend on shared +references. Build nodes with `mkMap` / `mkList` (or `jm` / `jt`); the mutable +`LinkedHashMap` preserves insertion order and keeps a key's position when it is +re-assigned. + +### `Noval` vs `VNull` + +Unlike the single-`nil` ports (Python, Clojure, Lua), Scala keeps the two +canonical concepts apart, exactly like TypeScript, Rust and OCaml: + +- `Noval` — the TS `undefined`: a property is absent. **Not** a scalar. +- `VNull` — JSON `null`: a real value. + +The Group A / Group B rules ([`design/UNDEF_SPEC.md`](../design/UNDEF_SPEC.md)) +decide which one a slot collapses to: + +- **Group A** readers — `getprop`, `getelem`, `haskey` — treat a stored `VNull` + as "no value" (they return the default). +- **Group B** processors — `setprop`, `clone`, `merge`, `walk`, `inject`, + `transform`, `validate`, `select` — preserve `VNull` literally. The internal + `lookup_` is the raw reader they use when null must survive. + +```scala +typify(Noval) // T_noval +typify(VNull) // T_scalar | T_null +stringify(Noval) // "" +stringify(VNull) // "null" +``` + +## The public API + +Names are the canonical names, lower-smushed or camelCased: + +- **Lookups / paths:** `getpath`, `setpath`, `getprop`, `setprop`, `getelem`, + `delprop`, `haskey`, `keysof`, `items`. +- **Predicates / kinds:** `isnode`, `ismap`, `islist`, `iskey`, `isfunc`, + `isempty`, `typify`, `typename`. +- **Values:** `clone`, `merge`, `walk`, `size`, `slice`, `pad`, `flatten`, + `filter`, `getdef`, `strkey`. +- **Strings / formatting:** `stringify`, `jsonify`, `pathify`, `join`, + `escre`, `escurl`. +- **Regex (RE2-subset uniform API):** `re_compile`, `re_find`, `re_find_all`, + `re_replace`, `re_test`, `re_escape`. Backed by `java.util.regex`. +- **By-example engine:** `inject`, `transform`, `validate`, `select`, and the + injector helpers `checkPlacement`, `injectorArgs`, `injectChild`. +- **Builders / markers:** `jm`, `jt`, `SKIP`, `DELETE`, the `T_*` type + constants and `M_KEYPRE` / `M_KEYPOST` / `M_VAL`. + +Many functions take Scala default arguments where the canonical has optional +parameters, e.g. `getprop(v, key, alt = Noval)`, `slice(v, start, stop, +mutate)`, `stringify(v, maxlen, pretty)`, `merge(objs, maxdepth)`. + +## Examples + +```scala +import voxgig.struct.* + +// merge: later wins; the first node is modified in place +merge(jt(jm(VStr("a"), VNum(1.0)), jm(VStr("b"), VNum(2.0)))) // {a:1,b:2} + +// transform: spec mirrors the output; backticks pull from the data +transform(jm(VStr("name"), VStr("alice")), + jm(VStr("user"), jm(VStr("id"), VStr("`name`")))) // {user:{id:alice}} + +// validate: plain values are typed defaults; `$STRING` etc. are commands +validate(jm(VStr("a"), VStr("x")), jm(VStr("a"), VStr("`$STRING`"))) // {a:x} + +// select: MongoDB-style query over children +select(jt(jm(VStr("a"), VNum(1.0)), jm(VStr("a"), VNum(2.0))), + jm(VStr("a"), jm(VStr("`$GT`"), VNum(1.0)))) // [{$KEY:1,a:2}] +``` + +## Testing + +`make test` compiles `src/` + `test/runner.scala` with `scalac` and runs the +entire shared corpus (`../build/test/test.json`) through the port via `scala`, +using an in-tree JSON reader and the same runner logic as every other port. +Keep it green, keep `python3 ../tools/check_parity.py` green, and add no runtime +dependencies. + +## Implementation notes + +- The injection state (`Inj`) is a mutable class; callers pass a loose `InjDef` + via the `InjArg` ADT, so it is never confused with data. +- `SKIP` / `DELETE` are `VSentinel` markers. +- Numbers follow JS formatting in `stringify` / `jsonify` (an integral + `VNum` prints without a trailing `.0`); `numToString` relies on Java's + shortest round-tripping `Double.toString` for non-integers. +- The only regex is the JVM standard `java.util.regex`, which covers the RE2 + subset the corpus uses for `$LIKE` and the `re_*` API. diff --git a/scala/Makefile b/scala/Makefile new file mode 100644 index 00000000..97b7d775 --- /dev/null +++ b/scala/Makefile @@ -0,0 +1,32 @@ +# Makefile for the Scala port of voxgig/struct. +# Requires the Scala 3 compiler (`scalac` / `scala`) and a JDK on PATH. +# No third-party libraries. + +SRC = src/voxgig_struct.scala +TESTSRC = $(SRC) test/runner.scala + +.PHONY: test lint build inspect clean reset publish + +# Build and run the shared JSON corpus through the Scala implementation. +test: build + scala -cp out Runner + +build: + rm -rf out && mkdir out && scalac $(TESTSRC) -d out + +# "Lint": compile the library (a clean compile means the code type-checks). +# scalafmt/scalafix can be wired into this target if available. +lint: + rm -rf out-lint && mkdir out-lint && scalac $(SRC) -d out-lint && echo ok + +inspect: + @scalac -version 2>&1 | head -1 + +clean: + rm -rf out out-lint + +reset: clean + +# The library publishes to Maven Central; this target creates the git tag. +publish: + @echo "scala: publish via sbt/Maven Central + git tag scala/vX.Y.Z" diff --git a/scala/README.md b/scala/README.md new file mode 100644 index 00000000..518d9028 --- /dev/null +++ b/scala/README.md @@ -0,0 +1,78 @@ +# @voxgig/struct — Scala + +A Scala port of [`voxgig/struct`](../README.md): one small, fixed API for +manipulating JSON-shaped data — lookups, deep merge, by-example transform, +by-example validate, tree walk, path get/set, selection — that returns the +**same answer** as the canonical TypeScript implementation and every other +port. The behavioural contract is the shared JSON corpus in +[`build/test/`](../build/test); this port passes it in full. + +## Status + +Complete. Every canonical public function is implemented and the entire +shared corpus passes (`make test`). **Zero third-party dependencies** — only +the Scala 3 toolchain and a JDK are required. + +## Requirements + +- A JDK (Java 11+). +- The Scala 3 compiler (`scalac` / `scala`). + +## Use + +The library lives in the `voxgig.struct` object: + +```scala +import voxgig.struct.* + +val store = mkMap(Seq("a" -> mkMap(Seq("b" -> VNum(2.0))))) + +println(stringify(getpath(store, VStr("a.b")))) // 2 +println(stringify(transform( + mkMap(Seq("a" -> VNum(1.0))), + mkMap(Seq("x" -> VStr("`a`")))))) // {x:1} +``` + +`jm` / `jt` are convenient JSON-object / JSON-array builders: + +```scala +jsonify(jm(VStr("a"), VNum(1.0), VStr("b"), jt(VNum(2.0), VNum(3.0)))) +``` + +### Data model + +A single `Value` ADT represents JSON-shaped data: + +``` +Noval | VNull | VBool(Boolean) | VNum(Double) | VStr(String) + | VList(ArrayBuffer[Value]) | VMap(LinkedHashMap[String, Value]) + | VFunc(Injector) | VSentinel(String) +``` + +`Noval` is the canonical `undefined` (absent); `VNull` is JSON null — distinct, +exactly as in the canonical TypeScript. Nodes (`VList` / `VMap`) are mutable and +reference-stable, so the library's in-place algorithms behave identically to +the reference implementation. See [`DOCS.md`](./DOCS.md) and +[the language-neutral docs](../DOCS.md). + +## API + +The public surface matches the canonical export list (lower-smushed / +camelCased): `clone delprop escre escurl filter flatten getdef getelem getpath +getprop haskey inject isempty isfunc iskey islist ismap isnode items join +jsonify keysof merge pad pathify select setpath setprop size slice strkey +stringify transform typify typename validate walk re_compile re_find +re_find_all re_replace re_test re_escape jm jt checkPlacement injectorArgs +injectChild`. + +## Develop + +``` +make test # run the shared corpus +make lint # type-check the library +make inspect # toolchain version +``` + +## License + +MIT. See [`../LICENSE`](../LICENSE). diff --git a/scala/src/voxgig_struct.scala b/scala/src/voxgig_struct.scala new file mode 100644 index 00000000..b555ae28 --- /dev/null +++ b/scala/src/voxgig_struct.scala @@ -0,0 +1,1833 @@ +// Copyright (c) 2025-2026 Voxgig Ltd. MIT LICENSE. +// +// Voxgig Struct — Scala port. +// +// A faithful port of the canonical TypeScript implementation +// (typescript/src/StructUtility.ts). Like TypeScript (and the Rust / OCaml +// ports), Scala keeps `undefined` (Noval) and JSON `null` (VNull) distinct, so +// this port mirrors the canonical TS logic directly. Nodes are mutable and +// reference-stable: lists are `ArrayBuffer[Value]`, maps are an insertion- +// ordered `LinkedHashMap[String, Value]`. The only regex used is the JVM +// standard `java.util.regex`; there are no third-party runtime dependencies. + +package voxgig + +import scala.collection.mutable.{ArrayBuffer, LinkedHashMap} + +object struct { + + // --------------------------------------------------------------------------- + // Value model + // --------------------------------------------------------------------------- + + sealed trait Value + case object Noval extends Value // TS undefined — absent + case object VNull extends Value // JSON null + final case class VBool(b: Boolean) extends Value + final case class VNum(n: Double) extends Value + final case class VStr(s: String) extends Value + final case class VList(buf: ArrayBuffer[Value]) extends Value + final case class VMap(map: LinkedHashMap[String, Value]) extends Value + final case class VFunc(f: Injector) extends Value + final case class VSentinel(tag: String) extends Value + + type Injector = (Inj, Value, String, Value) => Value + type Modify = (Value, Value, Value, Inj) => Unit + type WalkFn = (Value, Value, Value, Value) => Value + + final class Inj { + var mode: Int = M_VAL + var full: Boolean = false + var keyi: Int = 0 + var keys: Value = mkList(Seq(VStr(S_DTOP))) + var key: Value = VStr(S_DTOP) + var ival: Value = Noval + var parent: Value = Noval + var path: Value = mkList(Seq(VStr(S_DTOP))) + var nodes: Value = mkList(Seq()) + var handler: Injector = injectHandler + var errs: Value = mkList(Seq()) + var meta: Value = emptyMap() + var dparent: Value = Noval + var dpath: Value = mkList(Seq(VStr(S_DTOP))) + var base: Value = VStr(S_DTOP) + var modify: Option[Modify] = None + var prior: Option[Inj] = None + var extra: Value = Noval + } + + final class InjDef { + var dMeta: Value = Noval + var dExtra: Value = Noval + var dErrs: Value = Noval + var dModify: Option[Modify] = None + var dHandler: Option[Injector] = None + var dBase: Value = Noval + var dParent: Value = Noval + var dPath: Value = Noval + var dKey: Value = Noval + } + + sealed trait InjArg + case object INone extends InjArg + final case class IInj(inj: Inj) extends InjArg + final case class IDef(d: InjDef) extends InjArg + + final case class StructError(msg: String) extends RuntimeException(msg) + + // --------------------------------------------------------------------------- + // Constants + // --------------------------------------------------------------------------- + + val M_KEYPRE = 1 + val M_KEYPOST = 2 + val M_VAL = 4 + + val S_DKEY = "$KEY" + val S_BANNO = "`$ANNO`" + val S_DTOP = "$TOP" + val S_DERRS = "$ERRS" + val S_DSPEC = "$SPEC" + val S_BEXACT = "`$EXACT`" + val S_BVAL = "`$VAL`" + val S_BKEY = "`$KEY`" + val S_BOPEN = "`$OPEN`" + + val S_MT = "" + val S_BT = "`" + val S_DS = "$" + val S_DT = "." + val S_CN = ":" + val S_KEY = "KEY" + val S_VIZ = ": " + + val S_string = "string" + val S_object = "object" + val S_list = "list" + val S_map = "map" + val S_nil = "nil" + val S_null = "null" + + val T_any = (1 << 31) - 1 + val T_noval = 1 << 30 + val T_boolean = 1 << 29 + val T_decimal = 1 << 28 + val T_integer = 1 << 27 + val T_number = 1 << 26 + val T_string = 1 << 25 + val T_function = 1 << 24 + val T_null = 1 << 22 + val T_list = 1 << 14 + val T_map = 1 << 13 + val T_instance = 1 << 12 + val T_scalar = 1 << 7 + val T_node = 1 << 6 + + val TYPENAME = Array( + "any", "nil", "boolean", "decimal", "integer", "number", "string", "function", + "symbol", "null", "", "", "", "", "", "", "", "list", "map", "instance", + "", "", "", "", "scalar", "node") + + val SKIP: Value = VSentinel("skip") + val DELETE: Value = VSentinel("delete") + + val MAXDEPTH = 32 + + // --------------------------------------------------------------------------- + // Constructors / tiny helpers + // --------------------------------------------------------------------------- + + def mkList(xs: Seq[Value]): Value = VList(ArrayBuffer.from(xs)) + def emptyList(): Value = VList(ArrayBuffer.empty[Value]) + def emptyMap(): Value = VMap(LinkedHashMap.empty[String, Value]) + def mkMap(pairs: Seq[(String, Value)]): Value = { + val m = LinkedHashMap.empty[String, Value] + pairs.foreach { case (k, v) => m.put(k, v) } + VMap(m) + } + def vint(i: Int): Value = VNum(i.toDouble) + + def isNoval(v: Value): Boolean = v == Noval + def isNullish(v: Value): Boolean = v == Noval || v == VNull + def isSkip(v: Value): Boolean = v == VSentinel("skip") + def isDelete(v: Value): Boolean = v == VSentinel("delete") + + def isIntegerF(n: Double): Boolean = !n.isNaN && !n.isInfinite && n == Math.floor(n) + + def numToString(n: Double): String = { + if (n.isNaN) "NaN" + else if (isIntegerF(n) && Math.abs(n) < 1e16) n.toLong.toString + else n.toString + } + + def jsString(v: Value): String = v match { + case Noval => "undefined" + case VNull => "null" + case VBool(b) => if (b) "true" else "false" + case VNum(n) => numToString(n) + case VStr(s) => s + case VList(b) => b.map(x => x match { case Noval | VNull => ""; case _ => jsString(x) }).mkString(",") + case VMap(_) => "[object Object]" + case VFunc(_) => "function" + case VSentinel(t) => t + } + + def clz32(x0: Int): Int = if (x0 == 0) 32 else Integer.numberOfLeadingZeros(x0) + + // ordered map ops on the underlying LinkedHashMap + def omapGet(m: LinkedHashMap[String, Value], k: String): Option[Value] = m.get(k) + def omapHas(m: LinkedHashMap[String, Value], k: String): Boolean = m.contains(k) + def omapKeys(m: LinkedHashMap[String, Value]): Seq[String] = m.keysIterator.toSeq + def omapLen(m: LinkedHashMap[String, Value]): Int = m.size + def omapSet(m: LinkedHashMap[String, Value], k: String, v: Value): Unit = m.put(k, v) + def omapDel(m: LinkedHashMap[String, Value], k: String): Unit = m.remove(k) + + // --------------------------------------------------------------------------- + // Minor utilities + // --------------------------------------------------------------------------- + + def isnode(v: Value): Boolean = v match { case VMap(_) | VList(_) => true; case _ => false } + def ismap(v: Value): Boolean = v match { case VMap(_) => true; case _ => false } + def islist(v: Value): Boolean = v match { case VList(_) => true; case _ => false } + def isfunc(v: Value): Boolean = v match { case VFunc(_) => true; case _ => false } + + def iskey(k: Value): Boolean = k match { + case VStr(s) => s.nonEmpty + case VNum(_) => true + case _ => false + } + + def isempty(v: Value): Boolean = + isNullish(v) || v == VStr("") || (v match { + case VList(b) => b.isEmpty + case VMap(m) => m.isEmpty + case _ => false + }) + + def getdef(v: Value, alt: Value): Value = if (isNoval(v)) alt else v + + def typify(v: Value): Int = v match { + case Noval => T_noval + case VNull => T_scalar | T_null + case VBool(_) => T_scalar | T_boolean + case VNum(n) => + if (n.isNaN) T_noval + else if (isIntegerF(n)) T_scalar | T_number | T_integer + else T_scalar | T_number | T_decimal + case VStr(_) => T_scalar | T_string + case VFunc(_) => T_scalar | T_function + case VList(_) => T_node | T_list + case VMap(_) => T_node | T_map + case VSentinel(_) => T_node | T_map + } + + def typename(t: Int): String = { + val i = clz32(t) + if (i >= 0 && i < TYPENAME.length) TYPENAME(i) else TYPENAME(0) + } + + def size(v: Value): Int = v match { + case VList(b) => b.length + case VMap(m) => m.size + case VStr(s) => s.length + case VBool(b) => if (b) 1 else 0 + case VNum(n) => Math.floor(n).toInt + case _ => 0 + } + + def strkey(key: Value = Noval): String = key match { + case Noval => S_MT + case VStr(s) => s + case VBool(_) => S_MT + case VNum(n) => if (isIntegerF(n)) numToString(n) else numToString(Math.floor(n)) + case _ => S_MT + } + + def keysof(v: Value): Seq[String] = v match { + case VMap(m) => omapKeys(m).sorted + case VList(b) => b.indices.map(_.toString) + case _ => Seq.empty + } + + private def isIntKey(s: String): Boolean = + s.nonEmpty && s.forall(c => (c >= '0' && c <= '9') || c == '-') + + private def listIndex(b: ArrayBuffer[Value], key: Value): Value = { + val ks = key match { case VStr(s) => s; case VNum(n) => numToString(n); case _ => "" } + try { + val i = ks.toInt + if (i >= 0 && i < b.length) b(i) else Noval + } catch { case _: NumberFormatException => Noval } + } + + def getprop(v: Value, key: Value, alt: Value = Noval): Value = { + if (isNoval(v) || isNoval(key)) alt + else { + val out = v match { + case VMap(m) => omapGet(m, jsString(key)).getOrElse(Noval) + case VList(b) => listIndex(b, key) + case _ => Noval + } + if (isNullish(out)) alt else out + } + } + + // Raw lookup that preserves stored VNull (Group B), like TS _lookup. + def lookup_(v: Value, key: Value): Value = { + if (isNoval(v) || isNoval(key)) Noval + else v match { + case VMap(m) => omapGet(m, jsString(key)).getOrElse(Noval) + case VList(b) => listIndex(b, key) + case _ => Noval + } + } + + def haskey(v: Value, key: Value): Boolean = !isNullish(getprop(v, key)) + + // dummy inj for the (corpus-unreached) getelem function-alt path + private lazy val dummyInj: Inj = { val i = new Inj; i.parent = mkMap(Seq((S_DTOP, Noval))); i } + + def getelem(v: Value, key: Value, alt: Value = Noval): Value = { + if (isNoval(v) || isNoval(key)) alt + else { + var out: Value = Noval + v match { + case VList(b) => + val ks = key match { case VStr(s) => s; case VNum(n) => numToString(n); case _ => "" } + if (isIntKey(ks)) { + val len = b.length + val nk0 = ks.toInt + val nk = if (nk0 < 0) len + nk0 else nk0 + if (nk >= 0 && nk < len) out = b(nk) + } + case _ => + } + if (isNullish(out)) (alt match { + case VFunc(f) => f(dummyInj, Noval, "", Noval) + case _ => alt + }) + else out + } + } + + private def getpropRaw(v: Value, k: String): Value = v match { + case VMap(m) => omapGet(m, k).getOrElse(Noval) + case VList(b) => try b(k.toInt) catch { case _: Throwable => Noval } + case _ => Noval + } + + def itemsPairs(v: Value): Seq[(String, Value)] = + if (!isnode(v)) Seq.empty else keysof(v).map(k => (k, getpropRaw(v, k))) + + def itemsV(v: Value, f: ((String, Value)) => Value): Value = + mkList(itemsPairs(v).map(f)) + + def items(v: Value): Value = + mkList(itemsPairs(v).map { case (k, x) => mkList(Seq(VStr(k), x)) }) + + def flatten(l: Value, depth: Int = 1): Value = + if (!islist(l)) l + else { + val out = ArrayBuffer.empty[Value] + l match { + case VList(b) => b.foreach { item => + if (islist(item) && depth > 0) flatten(item, depth - 1) match { + case VList(b2) => b2.foreach(out.append) + case _ => + } + else out.append(item) + } + case _ => + } + VList(out) + } + + def filter(v: Value, check: ((String, Value)) => Boolean): Value = { + val out = ArrayBuffer.empty[Value] + itemsPairs(v).foreach { case (k, x) => if (check((k, x))) out.append(x) } + VList(out) + } + + def setprop(parent: Value, key: Value, v: Value): Value = { + if (iskey(key)) parent match { + case VMap(m) => omapSet(m, jsString(key), v) + case VList(b) => + val ks = key match { case VStr(s) => s; case VNum(n) => numToString(Math.floor(n)); case _ => "" } + try { + val ki = ks.toInt + val len = b.length + if (ki >= 0) { + val k2 = if (ki > len) len else ki + if (k2 >= len) b.append(v) else b(k2) = v + } else b.insert(0, v) + } catch { case _: NumberFormatException => } + case _ => + } + parent + } + + def delprop(parent: Value, key: Value): Value = { + if (iskey(key)) parent match { + case VMap(m) => omapDel(m, jsString(key)) + case VList(b) => + val ks = key match { case VStr(s) => s; case VNum(n) => numToString(Math.floor(n)); case _ => "" } + try { + val ki = ks.toInt + if (ki >= 0 && ki < b.length) b.remove(ki) + } catch { case _: NumberFormatException => } + case _ => + } + parent + } + + def clone(v: Value): Value = v match { + case VList(b) => VList(b.map(clone)) + case VMap(m) => + val nm = LinkedHashMap.empty[String, Value] + m.foreach { case (k, x) => nm.put(k, clone(x)) } + VMap(nm) + case _ => v + } + + def slice(v: Value, start: Value = Noval, stop: Value = Noval, mutate: Boolean = false): Value = v match { + case VNum(n) => + val lo = start match { case VNum(s) => s; case _ => Double.NegativeInfinity } + val hi = stop match { case VNum(e) => e - 1.0; case _ => Double.PositiveInfinity } + VNum(Math.max(lo, Math.min(n, hi))) + case VList(_) | VStr(_) => + val vlen = size(v) + val start2 = (start, stop) match { case (Noval, x) if !isNoval(x) => VNum(0.0); case _ => start } + start2 match { + case VNum(sf) => + val s0 = sf.toInt + var s = s0 + var e = 0 + if (s0 < 0) { s = 0; e = { val ee = vlen + s0; if (ee < 0) 0 else ee } } + else stop match { + case VNum(ef) => + val e0 = ef.toInt + if (e0 < 0) { e = { val ee = vlen + e0; if (ee < 0) 0 else ee } } + else if (vlen < e0) e = vlen + else e = e0 + case _ => e = vlen + } + if (vlen < s) s = vlen + if (s > -1 && s <= e && e <= vlen) v match { + case VList(b) => + if (mutate) { val sub = b.slice(s, e); b.clear(); b ++= sub; v } + else VList(b.slice(s, e)) + case VStr(str) => VStr(str.substring(s, e)) + case _ => v + } else v match { + case VList(b) => if (mutate) { b.clear(); v } else emptyList() + case VStr(_) => VStr(S_MT) + case _ => v + } + case _ => v + } + case _ => v + } + + // --------------------------------------------------------------------------- + // Regex (uniform re_* API over java.util.regex) + // --------------------------------------------------------------------------- + + private def reStr(p: Value): String = p match { case VStr(s) => s; case _ => jsString(p) } + + def re_compile(p: Value, flags: Value = Noval): Value = p match { case VStr(_) => p; case _ => VStr(jsString(p)) } + def re_test(p: Value, input: Value): Value = + VBool(java.util.regex.Pattern.compile(reStr(p)).matcher(reStr(input)).find()) + def re_find(p: Value, input: Value): Value = { + val m = java.util.regex.Pattern.compile(reStr(p)).matcher(reStr(input)) + if (m.find()) { + val buf = ArrayBuffer[Value](VStr(m.group(0))) + for (i <- 1 to m.groupCount()) buf.append(VStr(Option(m.group(i)).getOrElse(""))) + VList(buf) + } else VNull + } + def re_find_all(p: Value, input: Value): Value = { + val m = java.util.regex.Pattern.compile(reStr(p)).matcher(reStr(input)) + val out = ArrayBuffer.empty[Value] + while (m.find()) { + val buf = ArrayBuffer[Value](VStr(m.group(0))) + for (i <- 1 to m.groupCount()) buf.append(VStr(Option(m.group(i)).getOrElse(""))) + out.append(VList(buf)) + } + VList(out) + } + def re_replace(p: Value, input: Value, repl: Value): Value = input + def re_escape(s: Value): Value = escre(s) + + def escre(s: Value): Value = { + val str = s match { case VStr(x) => x; case Noval => S_MT; case _ => jsString(s) } + val b = new StringBuilder + str.foreach { c => + c match { + case '.' | '*' | '+' | '?' | '^' | '$' | '{' | '}' | '(' | ')' | '|' | '[' | ']' | '\\' => b.append('\\') + case _ => + } + b.append(c) + } + VStr(b.toString) + } + + def escurl(s: Value): Value = { + val str = s match { case VStr(x) => x; case Noval => S_MT; case _ => jsString(s) } + val b = new StringBuilder + str.getBytes("UTF-8").foreach { bt => + val c = (bt & 0xff).toChar + val unreserved = (c >= 'A' && c <= 'Z') || (c >= 'a' && c <= 'z') || (c >= '0' && c <= '9') || + c == '-' || c == '_' || c == '.' || c == '!' || c == '~' || c == '*' || c == '\'' || c == '(' || c == ')' + if (unreserved) b.append(c) else b.append("%%%02X".format(bt & 0xff)) + } + VStr(b.toString) + } + + // --------------------------------------------------------------------------- + // JSON-ish serialization / stringify / jsonify + // --------------------------------------------------------------------------- + + private def escJson(s: String, b: StringBuilder): Unit = { + b.append('"') + s.foreach { + case '"' => b.append("\\\"") + case '\\' => b.append("\\\\") + case '\n' => b.append("\\n") + case '\r' => b.append("\\r") + case '\t' => b.append("\\t") + case c if c < 32 => b.append("\\u%04x".format(c.toInt)) + case c => b.append(c) + } + b.append('"') + } + + def jsonEncode(v: Value, sort: Boolean = false, indent: Int = -1): String = { + val b = new StringBuilder + def enc(v: Value, level: Int): Unit = v match { + case Noval | VNull => b.append("null") + case VBool(x) => b.append(if (x) "true" else "false") + case VNum(n) => b.append(numToString(n)) + case VStr(s) => escJson(s, b) + case VFunc(_) | VSentinel(_) => b.append("null") + case VList(buf) => + if (buf.isEmpty) b.append("[]") + else if (indent >= 0) { + val pad = " " * (indent * (level + 1)); val cpad = " " * (indent * level) + b.append("[\n") + buf.zipWithIndex.foreach { case (x, i) => if (i > 0) b.append(",\n"); b.append(pad); enc(x, level + 1) } + b.append("\n"); b.append(cpad); b.append(']') + } else { + b.append('[') + buf.zipWithIndex.foreach { case (x, i) => if (i > 0) b.append(','); enc(x, level + 1) } + b.append(']') + } + case VMap(m) => + val ks0 = m.keysIterator.toSeq + val ks = if (sort) ks0.sorted else ks0 + if (ks.isEmpty) b.append("{}") + else if (indent >= 0) { + val pad = " " * (indent * (level + 1)); val cpad = " " * (indent * level) + b.append("{\n") + ks.zipWithIndex.foreach { case (k, i) => + if (i > 0) b.append(",\n"); b.append(pad); escJson(k, b); b.append(": "); enc(m(k), level + 1) + } + b.append("\n"); b.append(cpad); b.append('}') + } else { + b.append('{') + ks.zipWithIndex.foreach { case (k, i) => + if (i > 0) b.append(','); escJson(k, b); b.append(':'); enc(m(k), level + 1) + } + b.append('}') + } + } + enc(v, 0); b.toString + } + + private def hasCycle(v: Value): Boolean = { + val seen = ArrayBuffer.empty[AnyRef] + def go(v: Value): Boolean = v match { + case VList(b) => if (seen.exists(_ eq b)) true else { seen.append(b); b.exists(go) } + case VMap(m) => if (seen.exists(_ eq m)) true else { seen.append(m); m.valuesIterator.exists(go) } + case _ => false + } + go(v) + } + + def stringify(v: Value, maxlen: Value = Noval, pretty: Boolean = false): String = v match { + case Noval => if (pretty) "<>" else S_MT + case _ => + var valstr = v match { + case VStr(s) => s + case _ => + if (hasCycle(v)) "__STRINGIFY_FAILED__" + else try jsonEncode(v, sort = true).replace("\"", "") catch { case _: Throwable => "__STRINGIFY_FAILED__" } + } + maxlen match { + case VNum(m) if m > -1.0 => + val mm = m.toInt; val l = valstr.length + if (mm < l) valstr = valstr.substring(0, Math.max(0, mm - 3)) + "..." + case _ => + } + if (pretty) { + val colors = Array(81, 118, 213, 39, 208, 201, 45, 190, 129, 51, 160, 121, 226, 33, 207, 69) + val c = colors.map(n => s"[38;5;${n}m") + val r = "" + var d = 0; var o = c(0); val t = new StringBuilder; t.append(c(0)) + valstr.foreach { ch => + if (ch == '{' || ch == '[') { d += 1; o = c(d % c.length); t.append(o); t.append(ch) } + else if (ch == '}' || ch == ']') { t.append(o); t.append(ch); d -= 1; o = c(((d % c.length) + c.length) % c.length) } + else { t.append(o); t.append(ch) } + } + t.append(r); t.toString + } else valstr + } + + def jsonify(v: Value, flags: Value = Noval): String = v match { + case Noval => S_null + case _ => + val indent = getprop(flags, VStr("indent"), VNum(2.0)) match { case VNum(n) => n.toInt; case _ => 2 } + try { + val str = if (indent > 0) jsonEncode(v, indent = indent) else jsonEncode(v) + val offset = getprop(flags, VStr("offset"), VNum(0.0)) match { case VNum(n) => n.toInt; case _ => 0 } + if (offset > 0) { + val lines = str.split("\n", -1).toSeq + if (lines.nonEmpty) "{\n" + lines.tail.map(l => (" " * offset) + l).mkString("\n") else str + } else str + } catch { case _: Throwable => S_null } + } + + def pad(s: Value, padding: Value = Noval, padchar: Value = Noval): String = { + val str = s match { case VStr(x) => x; case VNull => "null"; case _ => stringify(s) } + val p = padding match { case VNum(n) => n.toInt; case _ => 44 } + val pc = padchar match { case VStr(x) => (x + " ").substring(0, 1); case _ => " " } + if (p > -1) { val n = p - str.length; if (n > 0) str + (pc * n) else str } + else { val n = (-p) - str.length; if (n > 0) (pc * n) + str else str } + } + + // --------------------------------------------------------------------------- + // join / pathify / replace + // --------------------------------------------------------------------------- + + def join(arr: Value, sep: Value = Noval, url: Boolean = false): String = { + if (!islist(arr)) S_MT + else { + val sepdef = sep match { case Noval | VNull => ","; case VStr(s) => s; case _ => jsString(sep) } + val single = sepdef.length == 1 + val sc = if (single) sepdef.charAt(0) else ' ' + val itemsL = arr match { case VList(b) => b.toSeq; case _ => Seq.empty } + val sarr = itemsL.length + def stripTrailing(s: String) = { var i = s.length; while (i > 0 && s.charAt(i - 1) == sc) i -= 1; s.substring(0, i) } + def stripLeading(s: String) = { var i = 0; while (i < s.length && s.charAt(i) == sc) i += 1; s.substring(i) } + def collapse(s: String) = { + val b = new StringBuilder; var i = 0; val n = s.length + while (i < n) { + if (s.charAt(i) != sc) { b.append(s.charAt(i)); i += 1 } + else { + var j = i; while (j < n && s.charAt(j) == sc) j += 1 + val beforeNon = i > 0 && s.charAt(i - 1) != sc + val afterNon = j < n + if (beforeNon && afterNon) b.append(sc) else b.append(s.substring(i, j)) + i = j + } + } + b.toString + } + val out = ArrayBuffer.empty[String] + itemsL.zipWithIndex.foreach { + case (VStr(s0), idx) if s0 != S_MT => + val s = if (single) { + if (url && idx == 0) stripTrailing(s0) + else { + var x = if (idx > 0) stripLeading(s0) else s0 + x = if (idx < sarr - 1 || !url) stripTrailing(x) else x + collapse(x) + } + } else s0 + if (s != S_MT) out.append(s) + case _ => + } + out.mkString(sepdef) + } + } + + def joinurl(arr: Value): String = join(arr, VStr("/"), url = true) + + def replace(s: Value, from: Value, to: Value): String = { + val ts = typify(s) + val rs = if ((T_string & ts) == 0) stringify(s) + else if (((T_noval | T_null) & ts) > 0) S_MT + else stringify(s) + val toS = to match { case VStr(x) => x; case _ => jsString(to) } + from match { + case VStr(f) if f.nonEmpty => rs.replace(f, toS) + case _ => rs + } + } + + def pathify(v: Value, startin: Value = Noval, endin: Value = Noval, absent: Boolean = false): String = { + val path: Option[Seq[Value]] = + if (islist(v)) Some(v match { case VList(b) => b.toSeq; case _ => Seq.empty }) + else if (iskey(v)) Some(Seq(v)) + else None + val start = startin match { case VNum(n) => if (n > -1.0) n.toInt else 0; case _ => 0 } + val endn = endin match { case VNum(n) => if (n > -1.0) n.toInt else 0; case _ => 0 } + val pathstr: Option[String] = path match { + case Some(p) if start >= 0 => + val len = p.length + val e = Math.max(0, len - endn) + val s = Math.min(start, len) + val sub = if (s <= e) p.slice(s, e) else Seq.empty + if (sub.isEmpty) Some("") + else { + val fp = sub.filter(iskey) + val mapped = fp.map { + case VNum(n) => numToString(Math.floor(n)) + case pp => jsString(pp).replace(".", S_MT) + } + Some(mapped.mkString(".")) + } + case _ => None + } + pathstr match { + case Some(s) => s + case None => "" + } + } + + // --------------------------------------------------------------------------- + // walk / merge + // --------------------------------------------------------------------------- + + def walk(v: Value, before: Option[WalkFn] = None, after: Option[WalkFn] = None, + maxdepth: Value = Noval, key: Value = Noval, parent: Value = Noval, path: Value = null): Value = { + val p = if (path == null) emptyList() else path + val depth = size(p) + var out = before match { case Some(f) => f(key, v, parent, p); case None => v } + val mdv = maxdepth match { case VNum(n) if n >= 0 => n.toInt; case _ => MAXDEPTH } + if (mdv == 0 || (mdv > 0 && mdv <= depth)) out + else { + if (isnode(out)) { + val prefix = p match { case VList(b) => b.toSeq; case _ => Seq.empty } + itemsPairs(out).foreach { case (ckey, child) => + val childpath = mkList(prefix :+ VStr(ckey)) + val result = walk(child, before, after, VNum(mdv.toDouble), VStr(ckey), out, childpath) + out match { + case VMap(m) => m.put(ckey, result) + case VList(b) => b(ckey.toInt) = result + case _ => + } + } + } + after match { case Some(f) => f(key, out, parent, p); case None => out } + } + } + + def merge(objs: Value, maxdepth: Value = Noval): Value = { + val md = maxdepth match { case VNum(n) => if (n < 0) 0 else n.toInt; case _ => MAXDEPTH } + if (!islist(objs)) objs + else { + val l = objs match { case VList(b) => b; case _ => ArrayBuffer.empty[Value] } + val lenlist = l.length + if (lenlist == 0) Noval + else if (lenlist == 1) l(0) + else { + var out = getprop(objs, VNum(0.0), emptyMap()) + for (oi <- 1 until lenlist) { + val obj = l(oi) + if (!isnode(obj)) out = obj + else { + val cur = ArrayBuffer[Value](out) + val dst = ArrayBuffer[Value](out) + def grow(a: ArrayBuffer[Value], n: Int): Unit = while (a.length <= n) a.append(Noval) + val before: WalkFn = (key, v, _parent, path) => { + val pi = size(path) + if (md <= pi) { + grow(cur, pi); cur(pi) = v + if (pi > 0) setprop(cur(pi - 1), key, v) + Noval + } else if (!isnode(v)) { + grow(cur, pi); cur(pi) = v; v + } else { + grow(dst, pi); grow(cur, pi) + dst(pi) = if (pi > 0) getprop(dst(pi - 1), key) else dst(pi) + val tval = dst(pi) + if (isNullish(tval)) { cur(pi) = if (islist(v)) emptyList() else emptyMap(); v } + else if ((islist(v) && islist(tval)) || (ismap(v) && ismap(tval))) { cur(pi) = tval; v } + else { cur(pi) = v; Noval } + } + } + val after: WalkFn = (key, _v, _parent, path) => { + val ci = size(path) + if (ci < 1) (if (cur.nonEmpty) cur(0) else _v) + else { + val target = if (ci - 1 < cur.length) cur(ci - 1) else Noval + val value = if (ci < cur.length) cur(ci) else Noval + setprop(target, key, value); value + } + } + out = walk(obj, Some(before), Some(after)) + } + } + if (md == 0) { + val o = getprop(objs, VNum((lenlist - 1).toDouble)) + out = if (islist(o)) emptyList() else if (ismap(o)) emptyMap() else o + } + out + } + } + } + + // --------------------------------------------------------------------------- + // getpath / setpath + // --------------------------------------------------------------------------- + + private def iaBase(ia: InjArg): Value = ia match { case IInj(i) => i.base; case IDef(d) => d.dBase; case INone => Noval } + private def iaDparent(ia: InjArg): Value = ia match { case IInj(i) => i.dparent; case IDef(d) => d.dParent; case INone => Noval } + private def iaMeta(ia: InjArg): Value = ia match { case IInj(i) => i.meta; case IDef(d) => d.dMeta; case INone => Noval } + private def iaKey(ia: InjArg): Value = ia match { case IInj(i) => i.key; case IDef(d) => d.dKey; case INone => Noval } + private def iaDpath(ia: InjArg): Value = ia match { case IInj(i) => i.dpath; case IDef(d) => d.dPath; case INone => Noval } + private def iaHandler(ia: InjArg): Option[Injector] = ia match { case IInj(i) => Some(i.handler); case IDef(d) => d.dHandler; case INone => None } + private def iaIsSome(ia: InjArg): Boolean = ia != INone + + private def startsWith(s: String, pre: String): Boolean = s.startsWith(pre) + private def replaceAll(s: String, find: String, repl: String): String = if (find.isEmpty) s else s.replace(find, repl) + + // R_META_PATH = ^([^$]+)\$([=~])(.+)$ + private def metaPathMatch(s: String): Option[(String, String, String)] = { + val i = s.indexOf('$') + if (i > 0 && i + 1 < s.length && (s.charAt(i + 1) == '=' || s.charAt(i + 1) == '~') && i + 2 <= s.length - 1) + Some((s.substring(0, i), s.charAt(i + 1).toString, s.substring(i + 2))) + else None + } + + def getpath(store: Value, path: Value, inj: InjArg = INone): Value = { + val pa: Option[Array[Value]] = path match { + case VList(b) => Some(b.toArray) + case VStr(s) => Some(s.split("\\.", -1).map(x => VStr(x)).toArray) + case VNum(n) => Some(Array(VStr(strkey(VNum(n))))) + case _ => None + } + pa match { + case None => Noval + case Some(parts) => + val base = iaBase(inj) + val dparent = iaDparent(inj) + val injMeta = iaMeta(inj) + val injKey = iaKey(inj) + val dpath = iaDpath(inj) + val src = if (iskey(base)) getprop(store, base, store) else store + val numparts = parts.length + var v: Value = store + def arrGet(i: Int): Value = if (i >= 0 && i < parts.length) parts(i) else Noval + if (isNoval(path) || isNoval(store) || (numparts == 1 && parts(0) == VStr(S_MT)) || numparts == 0) { + v = src + } else { + if (numparts == 1) v = getprop(store, parts(0)) + if (!isfunc(v)) { + v = src + parts(0) match { + case VStr(s0) => + metaPathMatch(s0) match { + case Some((g1, _, g3)) if !isNoval(injMeta) && iaIsSome(inj) => + v = getprop(injMeta, VStr(g1)); parts(0) = VStr(g3) + case _ => + } + case _ => + } + var pi = 0 + var continue = true + while (continue && !isNoval(v) && pi < numparts) { + val raw = parts(pi) + val part0: Value = raw match { + case VStr(s) if iaIsSome(inj) && s == S_DKEY => if (!isNoval(injKey)) injKey else raw + case VStr(s) if startsWith(s, "$GET:") => + VStr(stringify(getpath(src, slice(VStr(s), VNum(5.0), VNum(-1.0)), INone))) + case VStr(s) if startsWith(s, "$REF:") => + VStr(stringify(getpath(getprop(store, VStr(S_DSPEC)), slice(VStr(s), VNum(5.0), VNum(-1.0)), INone))) + case VStr(s) if iaIsSome(inj) && startsWith(s, "$META:") => + VStr(stringify(getpath(injMeta, slice(VStr(s), VNum(6.0), VNum(-1.0)), INone))) + case _ => raw + } + val part: Value = part0 match { + case VStr(s) => VStr(replaceAll(s, "$$", "$")) + case _ => VStr(strkey(part0)) + } + if (part == VStr(S_MT)) { + var ascends = 0 + while (arrGet(pi + 1) == VStr(S_MT)) { ascends += 1; pi += 1 } + if (iaIsSome(inj) && ascends > 0) { + if (pi == numparts - 1) ascends -= 1 + if (ascends == 0) { v = dparent } + else { + val tail = parts.slice(pi + 1, numparts).toSeq + val fullpath = flatten(mkList(Seq(slice(dpath, VNum((-ascends).toDouble)), mkList(tail)))) + v = if (ascends <= size(dpath)) getpath(store, fullpath, INone) else Noval + continue = false + } + } else { v = dparent } + } else v = getprop(v, part) + if (continue) pi += 1 + } + } + } + iaHandler(inj) match { + case Some(h) if iaIsSome(inj) => + val refp = pathify(path) + inj match { + case IInj(i) => v = h(i, v, refp, store) + case _ => v = h(dummyInj, v, refp, store) + } + case _ => + } + v + } + } + + def setpath(store: Value, path: Value, v: Value, inj: InjArg = INone): Value = { + val ptype = typify(path) + val parts: Value = + if ((T_list & ptype) > 0) (path match { case VList(b) => mkList(b.toSeq); case _ => emptyList() }) + else if ((T_string & ptype) > 0) (path match { case VStr(s) => mkList(s.split("\\.", -1).map(x => VStr(x)).toSeq); case _ => emptyList() }) + else if ((T_number & ptype) > 0) mkList(Seq(path)) + else Noval + if (isNoval(parts)) Noval + else { + val base = inj match { case INone => Noval; case _ => iaBase(inj) } + val numparts = size(parts) + var parent = if (iskey(base)) getprop(store, base, store) else store + for (pi <- 0 until numparts - 1) { + val pkey = getelem(parts, VNum(pi.toDouble)) + var np = getprop(parent, pkey) + if (!isnode(np)) { + val nextpart = getelem(parts, VNum((pi + 1).toDouble)) + np = if ((T_number & typify(nextpart)) > 0) emptyList() else emptyMap() + setprop(parent, pkey, np) + } + parent = np + } + if (isDelete(v)) delprop(parent, getelem(parts, VNum(-1.0))) + else setprop(parent, getelem(parts, VNum(-1.0)), v) + parent + } + } + + // --------------------------------------------------------------------------- + // backtick-string helpers + // --------------------------------------------------------------------------- + + // R_INJECTION_FULL: whole string is one backtick injection -> captured ref. + private def injectionFull(s: String): Option[String] = { + val n = s.length + if (n >= 2 && s.charAt(0) == '`' && s.charAt(n - 1) == '`') { + val inner = s.substring(1, n - 1) + if (inner.indexOf('`') >= 0) None + else { + val isDollarUpper = inner.length > 1 && inner.charAt(0) == '$' && { + var j = 1; while (j < inner.length && inner.charAt(j) >= 'A' && inner.charAt(j) <= 'Z') j += 1 + val lettersEnd = j + lettersEnd > 1 && { + var k = lettersEnd; while (k < inner.length && inner.charAt(k) >= '0' && inner.charAt(k) <= '9') k += 1 + k == inner.length + } + } + if (isDollarUpper) { + var j = 1; while (j < inner.length && inner.charAt(j) >= 'A' && inner.charAt(j) <= 'Z') j += 1 + Some(inner.substring(0, j)) + } else Some(inner) + } + } else None + } + + private def injectionPartialReplace(s: String, f: String => String): String = { + val n = s.length; val b = new StringBuilder; var i = 0 + while (i < n) { + if (s.charAt(i) == '`') { + val j = s.indexOf('`', i + 1) + if (j >= 0) { b.append(f(s.substring(i + 1, j))); i = j + 1 } + else { b.append(s.charAt(i)); i += 1 } + } else { b.append(s.charAt(i)); i += 1 } + } + b.toString + } + + private def replaceTransformNames(s: String): String = { + val n = s.length; val b = new StringBuilder; var i = 0 + while (i < n) { + if (s.charAt(i) == '`' && i + 1 < n && s.charAt(i + 1) == '$') { + var j = i + 2; while (j < n && s.charAt(j) >= 'A' && s.charAt(j) <= 'Z') j += 1 + if (j < n && s.charAt(j) == '`' && j > i + 2) { + b.append(s.substring(i + 2, j).toLowerCase); i = j + 1 + } else { b.append(s.charAt(i)); i += 1 } + } else { b.append(s.charAt(i)); i += 1 } + } + b.toString + } + + // --------------------------------------------------------------------------- + // Injection methods + // --------------------------------------------------------------------------- + + private def newInj(v: Value, parent: Value): Inj = { + val i = new Inj + i.mode = M_VAL; i.full = false; i.keyi = 0 + i.keys = mkList(Seq(VStr(S_DTOP))); i.key = VStr(S_DTOP); i.ival = v; i.parent = parent + i.path = mkList(Seq(VStr(S_DTOP))); i.nodes = mkList(Seq(parent)); i.handler = injectHandler + i.errs = emptyList(); i.meta = emptyMap(); i.dparent = Noval; i.dpath = mkList(Seq(VStr(S_DTOP))) + i.base = VStr(S_DTOP); i.modify = None; i.prior = None; i.extra = Noval + i + } + + private def injDescend(inj: Inj): Value = { + inj.meta match { + case VMap(m) => + val d = m.get("__d") match { case Some(VNum(n)) => n; case _ => 0.0 } + m.put("__d", VNum(d + 1.0)) + case _ => + } + val parentkey = getelem(inj.path, VNum(-2.0)) + if (isNoval(inj.dparent)) { + if (size(inj.dpath) > 1) inj.dpath = inj.dpath match { case VList(b) => mkList(b.toSeq :+ parentkey); case _ => inj.dpath } + } else if (!isNoval(parentkey)) { + inj.dparent = getprop(inj.dparent, parentkey) + val lastpart = getelem(inj.dpath, VNum(-1.0)) + if (lastpart == VStr("$:" + jsString(parentkey))) inj.dpath = slice(inj.dpath, VNum(-1.0)) + else inj.dpath = inj.dpath match { case VList(b) => mkList(b.toSeq :+ parentkey); case _ => inj.dpath } + } + inj.dparent + } + + private def injChild(inj: Inj, keyi: Int, keys: Value): Inj = { + val key = strkey(getelem(keys, VNum(keyi.toDouble))) + val v = inj.ival + val c = new Inj + c.mode = inj.mode; c.full = inj.full; c.keyi = keyi; c.keys = keys; c.key = VStr(key) + c.ival = getprop(v, VStr(key)); c.parent = v + c.path = inj.path match { case VList(b) => mkList(b.toSeq :+ VStr(key)); case _ => mkList(Seq(VStr(key))) } + c.nodes = inj.nodes match { case VList(b) => mkList(b.toSeq :+ v); case _ => mkList(Seq(v)) } + c.handler = inj.handler; c.errs = inj.errs; c.meta = inj.meta; c.base = inj.base + c.modify = inj.modify; c.prior = Some(inj) + c.dpath = inj.dpath match { case VList(b) => mkList(b.toSeq); case _ => inj.dpath } + c.dparent = inj.dparent; c.extra = inj.extra + c + } + + private def injSetval(inj: Inj, v: Value, ancestor: Int = 1): Value = { + val (target, key) = + if (ancestor < 2) (inj.parent, inj.key) + else (getelem(inj.nodes, VNum((-ancestor).toDouble)), getelem(inj.path, VNum((-ancestor).toDouble))) + if (isNoval(v)) delprop(target, key) else setprop(target, key, v) + } + + // --------------------------------------------------------------------------- + // inject + // --------------------------------------------------------------------------- + + def inject(v: Value, store: Value, inj: InjArg = INone): Value = { + val state: Inj = inj match { + case IInj(i) => i + case _ => + val parent = mkMap(Seq((S_DTOP, v))) + val i = newInj(v, parent) + i.dparent = store + i.errs = getprop(store, VStr(S_DERRS), emptyList()) + i.meta match { case VMap(m) => m.put("__d", VNum(0.0)); case _ => } + inj match { + case IDef(d) => + d.dModify match { case Some(_) => i.modify = d.dModify; case None => } + if (!isNoval(d.dExtra)) i.extra = d.dExtra + if (!isNoval(d.dMeta)) i.meta = d.dMeta + d.dHandler match { case Some(h) => i.handler = h; case None => } + case _ => + } + i + } + injDescend(state) + + val rv: Value = + if (isnode(v)) { + var nodekeys: Seq[String] = v match { + case VMap(m) => + val ks = m.keysIterator.toSeq + val normal = ks.filter(k => k.indexOf('$') < 0).sorted + val trans = ks.filter(k => k.indexOf('$') >= 0).sorted + normal ++ trans + case VList(b) => b.indices.map(_.toString) + case _ => Seq.empty + } + var nki = 0 + while (nki < nodekeys.length) { + val childinj = injChild(state, nki, mkList(nodekeys.map(s => VStr(s)))) + val nodekey = childinj.key + childinj.mode = M_KEYPRE + val prekey = injectstr(jsString(nodekey), store, Some(childinj)) + nodekeys = (childinj.keys match { case VList(b) => b.toSeq; case _ => Seq.empty }).map(jsString) + if (!isNoval(prekey)) { + childinj.ival = getprop(v, prekey) + childinj.mode = M_VAL + inject(childinj.ival, store, IInj(childinj)) + nodekeys = (childinj.keys match { case VList(b) => b.toSeq; case _ => Seq.empty }).map(jsString) + childinj.mode = M_KEYPOST + injectstr(jsString(nodekey), store, Some(childinj)) + nodekeys = (childinj.keys match { case VList(b) => b.toSeq; case _ => Seq.empty }).map(jsString) + } + nki = childinj.keyi + 1 + } + v + } else v match { + case VStr(_) => + state.mode = M_VAL + val nv = injectstr(jsString(v), store, Some(state)) + if (!isSkip(nv)) injSetval(state, nv) + nv + case _ => v + } + + state.modify match { + case Some(f) if !isSkip(rv) => + val mkey = state.key; val mparent = state.parent; val mval = getprop(mparent, mkey) + f(mval, mkey, mparent, state) + case _ => + } + state.ival = rv + lookup_(state.parent, VStr(S_DTOP)) + } + + private def injectHandler(inj: Inj, v: Value, refstr: String, store: Value): Value = { + val iscmd = isfunc(v) && (refstr == "" || startsWith(refstr, S_DS)) + if (iscmd) v match { case VFunc(f) => f(inj, v, refstr, store); case _ => v } + else if (inj.mode == M_VAL && inj.full) { injSetval(inj, v); v } + else v + } + + private def injectstr(v: String, store: Value, injOpt: Option[Inj]): Value = { + if (v == S_MT) VStr(S_MT) + else injectionFull(v) match { + case Some(pathref0) => + injOpt.foreach(_.full = true) + val pathref = if (pathref0.length > 3) replaceAll(replaceAll(pathref0, "$BT", S_BT), "$DS", S_DS) else pathref0 + val ia = injOpt match { case Some(i) => IInj(i); case None => INone } + getpath(store, VStr(pathref), ia) + case None => + val out = injectionPartialReplace(v, ref0 => { + val refp = if (ref0.length > 3) replaceAll(replaceAll(ref0, "$BT", S_BT), "$DS", S_DS) else ref0 + injOpt.foreach(_.full = false) + val ia = injOpt match { case Some(i) => IInj(i); case None => INone } + getpath(store, VStr(refp), ia) match { + case Noval => S_MT + case VStr(s) => if (s == "__NULL__") "null" else s + case VFunc(_) => S_MT + case found => try jsonEncode(found) catch { case _: Throwable => stringify(found) } + } + }) + injOpt match { + case Some(i) => i.full = true; i.handler(i, VStr(out), v, store) + case None => VStr(out) + } + } + } + + // --------------------------------------------------------------------------- + // transform commands + // --------------------------------------------------------------------------- + + private val transformDelete: Injector = (inj, _v, _r, _s) => { delprop(inj.parent, inj.key); Noval } + + private val transformCopy: Injector = (inj, _v, _r, _s) => { + if (inj.mode == M_KEYPRE || inj.mode == M_KEYPOST) inj.key + else { val out = lookup_(inj.dparent, inj.key); injSetval(inj, out); out } + } + + private val transformKey: Injector = (inj, _v, _r, _s) => { + if (inj.mode != M_VAL) Noval + else { + val keyspec = lookup_(inj.parent, VStr(S_BKEY)) + if (!isNoval(keyspec)) { delprop(inj.parent, VStr(S_BKEY)); getprop(inj.dparent, keyspec) } + else { + val anno = lookup_(inj.parent, VStr(S_BANNO)) + val fromanno = lookup_(anno, VStr(S_KEY)) + if (!isNoval(fromanno)) fromanno else getelem(inj.path, VNum(-2.0)) + } + } + } + + private val transformAnno: Injector = (inj, _v, _r, _s) => { delprop(inj.parent, VStr(S_BANNO)); Noval } + + private val transformMerge: Injector = (inj, _v, _r, _s) => { + if (inj.mode == M_KEYPRE) inj.key + else if (inj.mode == M_KEYPOST) { + val args0 = getprop(inj.parent, inj.key) + val args = if (islist(args0)) args0 else mkList(Seq(args0)) + injSetval(inj, Noval) + val mergelist = flatten(mkList(Seq(mkList(Seq(inj.parent)), args, mkList(Seq(clone(inj.parent)))))) + merge(mergelist) + inj.key + } else Noval + } + + private val transformEach: Injector = (inj, _v, _r, store) => { + if (islist(inj.keys)) slice(inj.keys, VNum(0.0), VNum(1.0), mutate = true) + if (inj.mode != M_VAL) Noval + else { + val parent = inj.parent + val srcpath = if (size(parent) > 1) getelem(parent, VNum(1.0)) else Noval + val childTm = if (size(parent) > 2) clone(getelem(parent, VNum(2.0))) else Noval + val srcstore = getprop(store, inj.base, store) + val src = getpath(srcstore, srcpath, IInj(inj)) + val tkey = getelem(inj.path, VNum(-2.0)) + val nodes = inj.nodes + val target = { val t = getelem(nodes, VNum(-2.0)); if (isNullish(t)) getelem(nodes, VNum(-1.0)) else t } + val tval = ArrayBuffer.empty[Value] + var rval: Value = emptyList() + if (isnode(src)) { + src match { + case VList(b) => b.foreach(_ => tval.append(clone(childTm))) + case VMap(m) => m.foreach { case (k, _) => + val cc = clone(childTm) + if (ismap(cc)) setprop(cc, VStr(S_BANNO), mkMap(Seq((S_KEY, VStr(k))))) + tval.append(cc) + } + case _ => + } + val tvalv = VList(tval) + val tcurrent = src match { case VMap(m) => mkList(m.valuesIterator.toSeq); case VList(b) => mkList(b.toSeq); case _ => src } + if (tval.nonEmpty) { + val path = inj.path + val ckey = getelem(path, VNum(-2.0)) + val plist = path match { case VList(b) => b.toSeq; case _ => Seq.empty } + val tpath = mkList(if (plist.isEmpty) Seq.empty else plist.take(plist.length - 1)) + val dpath = ArrayBuffer[Value](VStr(S_DTOP)) + srcpath match { case VStr(sp) if sp != S_MT => sp.split("\\.", -1).foreach(p => if (p != S_MT) dpath.append(VStr(p))); case _ => } + if (!isNoval(ckey)) dpath.append(VStr("$:" + jsString(ckey))) + var tcur: Value = mkMap(Seq((jsString(ckey), tcurrent))) + if (size(tpath) > 1) { + val pkey = getelem(path, VNum(-3.0), VStr(S_DTOP)) + dpath.append(VStr("$:" + jsString(pkey))) + tcur = mkMap(Seq((jsString(pkey), tcur))) + } + val tinj = injChild(inj, 0, if (!isNoval(ckey)) mkList(Seq(ckey)) else emptyList()) + tinj.path = tpath + val nlist = nodes match { case VList(b) => b.toSeq; case _ => Seq.empty } + tinj.nodes = mkList(if (nlist.isEmpty) Seq.empty else nlist.take(nlist.length - 1)) + tinj.parent = if (size(tinj.nodes) > 0) getelem(tinj.nodes, VNum(-1.0)) else Noval + if (!isNoval(ckey) && !isNoval(tinj.parent)) setprop(tinj.parent, ckey, tvalv) + tinj.ival = tvalv + tinj.dpath = VList(dpath) + tinj.dparent = tcur + inject(tvalv, store, IInj(tinj)) + rval = tinj.ival + } + } + setprop(target, tkey, rval) + if (islist(rval) && size(rval) > 0) getelem(rval, VNum(0.0)) else Noval + } + } + + private val transformPack: Injector = (inj, _v, _r, store) => { + if (inj.mode != M_KEYPRE || !(inj.key match { case VStr(_) => true; case _ => false })) Noval + else { + val parent = inj.parent; val path = inj.path; val nodes = inj.nodes + val argsVal = getprop(parent, inj.key) + if (!islist(argsVal) || size(argsVal) < 2) Noval + else { + val srcpath = getelem(argsVal, VNum(0.0)) + val origchildspec = getelem(argsVal, VNum(1.0)) + val tkey = getelem(path, VNum(-2.0)) + val pathsize = size(path) + val target = { val t = getelem(nodes, VNum((pathsize - 2).toDouble)); if (isNullish(t)) getelem(nodes, VNum((pathsize - 1).toDouble)) else t } + val srcstore = getprop(store, inj.base, store) + val src0 = getpath(srcstore, srcpath, IInj(inj)) + val src = + if (!islist(src0)) { + if (ismap(src0)) mkList(itemsPairs(src0).map { case (k, node) => + setprop(node, VStr(S_BANNO), mkMap(Seq((S_KEY, VStr(k))))); node + }) + else Noval + } else src0 + if (isNoval(src)) Noval + else { + val keypath = getprop(origchildspec, VStr(S_BKEY)) + val childspec = delprop(origchildspec, VStr(S_BKEY)) + val child = getprop(childspec, VStr(S_BVAL), childspec) + val tval = emptyMap() + itemsPairs(src).foreach { case (srckey, srcnode) => + val k = + if (isNoval(keypath)) VStr(srckey) + else keypath match { + case VStr(kp) if startsWith(kp, S_BT) => + inject(VStr(kp), merge(mkList(Seq(emptyMap(), store, mkMap(Seq((S_DTOP, srcnode))))), VNum(1.0))) + case _ => getpath(srcnode, keypath, IInj(inj)) + } + val tchild = clone(child) + setprop(tval, k, tchild) + val anno = getprop(srcnode, VStr(S_BANNO)) + if (isNoval(anno)) delprop(tchild, VStr(S_BANNO)) else setprop(tchild, VStr(S_BANNO), anno) + } + var rval: Value = emptyMap() + if (!isempty(tval)) { + val tsrc = emptyMap() + val srcSeq = src match { case VList(b) => b.toSeq; case _ => Seq.empty } + srcSeq.zipWithIndex.foreach { case (node, i) => + val kn = + if (isNoval(keypath)) vint(i) + else keypath match { + case VStr(kp) if startsWith(kp, S_BT) => + inject(VStr(kp), merge(mkList(Seq(emptyMap(), store, mkMap(Seq((S_DTOP, node))))), VNum(1.0))) + case _ => getpath(node, keypath, IInj(inj)) + } + setprop(tsrc, kn, node) + } + val tpath = slice(inj.path, VNum(-1.0)) + val ckey = getelem(inj.path, VNum(-2.0)) + val dpath = ArrayBuffer[Value](VStr(S_DTOP)) + srcpath match { case VStr(sp) => sp.split("\\.", -1).foreach(p => if (p != S_MT) dpath.append(VStr(p))); case _ => } + dpath.append(VStr("$:" + jsString(ckey))) + var tcur: Value = mkMap(Seq((jsString(ckey), tsrc))) + if (size(tpath) > 1) { + val pkey = getelem(inj.path, VNum(-3.0), VStr(S_DTOP)) + dpath.append(VStr("$:" + jsString(pkey))) + tcur = mkMap(Seq((jsString(pkey), tcur))) + } + val tinj = injChild(inj, 0, mkList(Seq(ckey))) + tinj.path = tpath + tinj.nodes = slice(inj.nodes, VNum(-1.0)) + tinj.parent = getelem(tinj.nodes, VNum(-1.0)) + tinj.ival = tval + tinj.dpath = VList(dpath) + tinj.dparent = tcur + inject(tval, store, IInj(tinj)) + rval = tinj.ival + } + setprop(target, tkey, rval) + Noval + } + } + } + } + + private val transformRef: Injector = (inj, v, _r, store) => { + if (inj.mode != M_VAL) Noval + else { + val nodes = inj.nodes + val refpath = lookup_(inj.parent, VNum(1.0)) + inj.keyi = size(inj.keys) + getprop(store, VStr(S_DSPEC)) match { + case VFunc(f) => + val spec = f(inj, Noval, "", Noval) + val refv = getpath(spec, refpath, INone) + var hasSub = false + if (isnode(refv)) walk(refv, before = Some((_k, v2, _p, _path) => { if (v2 == VStr("`$REF`")) hasSub = true; v2 })) + val tref = clone(refv) + val cpath = slice(inj.path, VNum(0.0), VNum((size(inj.path) - 3).toDouble)) + val tpath = slice(inj.path, VNum(0.0), VNum((size(inj.path) - 1).toDouble)) + val tcur = getpath(store, cpath, INone) + val tval = getpath(store, tpath, INone) + var rval: Value = Noval + if (!isNoval(refv) && (!hasSub || !isNoval(tval))) { + val cs = injChild(inj, 0, mkList(Seq(getelem(tpath, VNum(-1.0))))) + cs.path = tpath + cs.nodes = slice(inj.nodes, VNum(0.0), VNum((size(inj.nodes) - 1).toDouble)) + cs.parent = getelem(nodes, VNum(-2.0)) + cs.ival = tref + cs.dparent = tcur + inject(tref, store, IInj(cs)) + rval = cs.ival + } + injSetval(inj, rval, 2) + inj.prior match { + case Some(p) if islist(inj.parent) => p.keyi = p.keyi - 1 + case _ => + } + v + case _ => Noval + } + } + } + + private def jsstr(v: Value): String = v match { + case VNull => "null"; case VBool(b) => if (b) "true" else "false"; case _ => jsString(v) + } + + private val formatterTbl: Seq[(String, (Value, Value) => Value)] = Seq( + "identity" -> ((_k, v) => v), + "upper" -> ((_k, v) => if (isnode(v)) v else VStr(jsstr(v).toUpperCase)), + "lower" -> ((_k, v) => if (isnode(v)) v else VStr(jsstr(v).toLowerCase)), + "string" -> ((_k, v) => if (isnode(v)) v else VStr(jsstr(v))), + "number" -> ((_k, v) => if (isnode(v)) v else { val n = try jsstr(v).toDouble catch { case _: Throwable => 0.0 }; VNum(if (n.isNaN) 0.0 else n) }), + "integer" -> ((_k, v) => if (isnode(v)) v else { val n = try jsstr(v).toDouble catch { case _: Throwable => 0.0 }; VNum((if (n.isNaN) 0.0 else n).toInt.toDouble) }), + "concat" -> ((k, v) => if (isNoval(k) && islist(v)) VStr(join(itemsV(v, { case (_, x) => if (isnode(x)) VStr(S_MT) else VStr(jsstr(x)) }), VStr(S_MT))) else v) + ) + + def checkPlacement(modes: Int, ijname: String, parentTypes: Int, inj: Inj): Boolean = { + val modenum = inj.mode + if ((modes & modenum) == 0) { + val allowed = Seq(M_KEYPRE, M_KEYPOST, M_VAL).filter(m => (modes & m) != 0) + val placements = allowed.map(m => if (m == M_VAL) "value" else "key").mkString(",") + val cur = if (modenum == M_VAL) "value" else "key" + setprop(inj.errs, VNum(size(inj.errs).toDouble), VStr(s"$$$ijname: invalid placement as $cur, expected: $placements.")) + false + } else if (!isempty(VNum(parentTypes.toDouble))) { + val ptype = typify(inj.parent) + if ((parentTypes & ptype) == 0) { + setprop(inj.errs, VNum(size(inj.errs).toDouble), VStr(s"$$$ijname: invalid placement in parent ${typename(ptype)}, expected: ${typename(parentTypes)}.")) + false + } else true + } else true + } + + def injectorArgs(argTypes: Seq[Int], args: Value): Value = { + val numargs = argTypes.length + val found = ArrayBuffer.fill[Value](1 + numargs)(Noval) + var stop = false + var argi = 0 + while (argi < numargs && !stop) { + val arg = getelem(args, VNum(argi.toDouble)) + val argType = typify(arg) + if ((argTypes(argi) & argType) == 0) { + found(0) = VStr(s"invalid argument: ${stringify(arg, VNum(22.0))} (${typename(argType)} at position ${1 + argi}) is not of type: ${typename(argTypes(argi))}.") + stop = true + } else { found(1 + argi) = arg; argi += 1 } + } + VList(found) + } + + def injectChild(child: Value, store: Value, inj: Inj): Inj = { + var cinj = inj + inj.prior match { + case Some(prior) => + prior.prior match { + case Some(pprior) => + val c = injChild(pprior, prior.keyi, prior.keys); c.ival = child + setprop(c.parent, prior.key, child); cinj = c + case None => + val c = injChild(prior, inj.keyi, inj.keys); c.ival = child + setprop(c.parent, inj.key, child); cinj = c + } + case None => + } + inject(child, store, IInj(cinj)) + cinj + } + + private val transformFormat: Injector = (inj, _v, _r, store) => { + slice(inj.keys, VNum(0.0), VNum(1.0), mutate = true) + if (inj.mode != M_VAL) Noval + else { + val name = lookup_(inj.parent, VNum(1.0)) + val child = lookup_(inj.parent, VNum(2.0)) + val tkey = getelem(inj.path, VNum(-2.0)) + val target = { val t = getelem(inj.nodes, VNum(-2.0)); if (isNullish(t)) getelem(inj.nodes, VNum(-1.0)) else t } + val cinj = injectChild(child, store, inj) + val resolved = cinj.ival + val formatter: Option[(Value, Value) => Value] = + if ((T_function & typify(name)) > 0) Some((k, v) => name match { case VFunc(f) => f(dummyInj, v, jsString(k), Noval); case _ => v }) + else formatterTbl.find(_._1 == jsString(name)).map(_._2) + formatter match { + case None => setprop(inj.errs, VNum(size(inj.errs).toDouble), VStr(s"$$FORMAT: unknown format: ${jsString(name)}.")); Noval + case Some(f) => + val out = walk(resolved, before = Some((k, v, _p, _path) => f(k, v))) + setprop(target, tkey, out); out + } + } + } + + private val transformApply: Injector = (inj, _v, _r, store) => { + if (!checkPlacement(M_VAL, "APPLY", T_list, inj)) Noval + else { + val res = injectorArgs(Seq(T_function, T_any), slice(inj.parent, VNum(1.0))) + val err = getelem(res, VNum(0.0)) + val applyFn = getelem(res, VNum(1.0)) + val child = if (size(res) > 2) getelem(res, VNum(2.0)) else Noval + if (!isNoval(err)) { setprop(inj.errs, VNum(size(inj.errs).toDouble), VStr("$APPLY: " + jsString(err))); Noval } + else { + val tkey = getelem(inj.path, VNum(-2.0)) + val target = { val t = getelem(inj.nodes, VNum(-2.0)); if (isNullish(t)) getelem(inj.nodes, VNum(-1.0)) else t } + val cinj = injectChild(child, store, inj) + val resolved = cinj.ival + val out = applyFn match { case VFunc(f) => f(cinj, resolved, "", store); case _ => Noval } + setprop(target, tkey, out); out + } + } + } + + def transform(data: Value, spec0: Value, inj: InjArg = INone): Value = { + val origspec = spec0 + val spec = clone(spec0) + val extra = inj match { case IDef(d) => d.dExtra; case _ => Noval } + val collect = inj match { case IDef(d) => !isNoval(d.dErrs); case _ => false } + val errs = inj match { case IDef(d) if collect => d.dErrs; case _ => emptyList() } + val extraTransforms = emptyMap() + val extraData = emptyMap() + if (!isNoval(extra)) itemsPairs(extra).foreach { case (k, v) => + if (startsWith(k, S_DS)) setprop(extraTransforms, VStr(k), v) else setprop(extraData, VStr(k), v) + } + val dataClone = merge(mkList(Seq(if (isempty(extraData)) Noval else clone(extraData), clone(data)))) + val store = emptyMap() + def put(k: String, v: Value): Unit = setprop(store, VStr(k), v) + put(S_DTOP, dataClone) + put(S_DSPEC, VFunc((_, _, _, _) => origspec)) + put("$BT", VFunc((_, _, _, _) => VStr(S_BT))) + put("$DS", VFunc((_, _, _, _) => VStr(S_DS))) + put("$WHEN", VFunc((_, _, _, _) => VStr("1970-01-01T00:00:00.000Z"))) + put("$DELETE", VFunc(transformDelete)) + put("$COPY", VFunc(transformCopy)) + put("$KEY", VFunc(transformKey)) + put("$ANNO", VFunc(transformAnno)) + put("$MERGE", VFunc(transformMerge)) + put("$EACH", VFunc(transformEach)) + put("$PACK", VFunc(transformPack)) + put("$REF", VFunc(transformRef)) + put("$FORMAT", VFunc(transformFormat)) + put("$APPLY", VFunc(transformApply)) + itemsPairs(extraTransforms).foreach { case (k, v) => put(k, v) } + put(S_DERRS, errs) + val idef = new InjDef + idef.dErrs = errs + inj match { + case IDef(d) => idef.dMeta = d.dMeta; idef.dModify = d.dModify; idef.dHandler = d.dHandler; idef.dBase = d.dBase + case _ => + } + val out = inject(spec, store, IDef(idef)) + if (size(errs) > 0 && !collect) throw StructError(join(errs, VStr(" | "))) + out + } + + // --------------------------------------------------------------------------- + // validate + // --------------------------------------------------------------------------- + + private def invalidTypeMsg(path: Value, needtype: String, vt: Int, v: Value, whence: String): String = { + val vs = if (isNullish(v)) "no value" else stringify(v) + "Expected " + + (if (size(path) > 1) "field " + pathify(path, VNum(1.0)) + " to be " else "") + + needtype + ", but found " + + (if (!isNullish(v)) typename(vt) + S_VIZ else "") + vs + "." + } + + private def pushErr(inj: Inj, msg: String): Unit = setprop(inj.errs, VNum(size(inj.errs).toDouble), VStr(msg)) + + private val validateString: Injector = (inj, _v, _r, _s) => { + val out = lookup_(inj.dparent, inj.key) + val t = typify(out) + if ((T_string & t) == 0) { pushErr(inj, invalidTypeMsg(inj.path, S_string, t, out, "V1010")); Noval } + else if (out == VStr(S_MT)) { pushErr(inj, "Empty string at " + pathify(inj.path, VNum(1.0))); Noval } + else out + } + + private val validateType: Injector = (inj, _v, refstr, _s) => { + val tname = if (refstr.length > 1) refstr.substring(1).toLowerCase else "any" + val idx = TYPENAME.indexOf(tname) + val typev0 = if (idx >= 0) 1 << (31 - idx) else 0 + val typev = if (tname == S_nil) typev0 | T_null else typev0 + val out = lookup_(inj.dparent, inj.key) + val t = typify(out) + if ((t & typev) == 0) { pushErr(inj, invalidTypeMsg(inj.path, tname, t, out, "V1001")); Noval } + else out + } + + private val validateAny: Injector = (inj, _v, _r, _s) => lookup_(inj.dparent, inj.key) + + private val validateChild: Injector = (inj, _v, _r, _s) => { + val parent = inj.parent; val key = inj.key; val path = inj.path; val keys = inj.keys + if (inj.mode == M_KEYPRE) { + val childtm = getprop(parent, key) + val pkey = getelem(path, VNum(-2.0)) + val tval = getprop(inj.dparent, pkey) + if (isNoval(tval)) { + keysof(emptyMap()).foreach { ckey => setprop(parent, VStr(ckey), clone(childtm)); setprop(keys, VNum(size(keys).toDouble), VStr(ckey)) } + delprop(parent, key); Noval + } else if (!ismap(tval)) { + pushErr(inj, invalidTypeMsg(slice(path, VNum(0.0), VNum((size(path) - 1).toDouble)), S_object, typify(tval), tval, "V0220")); Noval + } else { + keysof(tval).foreach { ckey => setprop(parent, VStr(ckey), clone(childtm)); setprop(keys, VNum(size(keys).toDouble), VStr(ckey)) } + delprop(parent, key); Noval + } + } else if (inj.mode == M_VAL) { + val childtm = getprop(parent, VNum(1.0)) + if (!islist(parent)) { pushErr(inj, "Invalid $CHILD as value"); Noval } + else if (isNoval(inj.dparent)) { parent match { case VList(b) => b.clear(); case _ => }; Noval } + else if (!islist(inj.dparent)) { + pushErr(inj, invalidTypeMsg(slice(path, VNum(0.0), VNum((size(path) - 1).toDouble)), S_list, typify(inj.dparent), inj.dparent, "V0230")) + inj.keyi = size(parent); inj.dparent + } else { + itemsPairs(inj.dparent).foreach { case (k, _) => setprop(parent, VStr(k), clone(childtm)) } + parent match { case VList(b) => val n = size(inj.dparent); if (b.length > n) b.remove(n, b.length - n); case _ => } + inj.keyi = 0 + getprop(inj.dparent, VNum(0.0)) + } + } else Noval + } + + private val validateOne: Injector = (inj, _v, _r, store) => { + if (inj.mode == M_VAL) { + val parent = inj.parent + if (!islist(parent) || inj.keyi != 0) { pushErr(inj, "The $ONE validator at field " + pathify(inj.path, VNum(1.0), VNum(1.0)) + " must be the first element of an array."); Noval } + else { + inj.keyi = size(inj.keys) + injSetval(inj, inj.dparent, 2) + inj.path = slice(inj.path, VNum(0.0), VNum((size(inj.path) - 1).toDouble)) + inj.key = getelem(inj.path, VNum(-1.0)) + val tvals = slice(parent, VNum(1.0)) + if (size(tvals) == 0) { pushErr(inj, "The $ONE validator at field " + pathify(inj.path, VNum(1.0), VNum(1.0)) + " must have at least one argument."); Noval } + else { + var matched = false + (tvals match { case VList(b) => b.toSeq; case _ => Seq.empty }).foreach { tval => + if (!matched) { + val terrs = emptyList() + val vstore = merge(mkList(Seq(emptyMap(), store)), VNum(1.0)) + setprop(vstore, VStr(S_DTOP), inj.dparent) + val d = new InjDef; d.dExtra = vstore; d.dErrs = terrs; d.dMeta = inj.meta + val vcurrent = validate(inj.dparent, tval, IDef(d)) + injSetval(inj, vcurrent, -2) + if (size(terrs) == 0) matched = true + } + } + if (!matched) { + val valdesc = replaceTransformNames(itemsPairs(tvals).map { case (_, x) => stringify(x) }.mkString(", ")) + pushErr(inj, invalidTypeMsg(inj.path, (if (size(tvals) > 1) "one of " else "") + valdesc, typify(inj.dparent), inj.dparent, "V0210")) + } + Noval + } + } + } else Noval + } + + private val validateExact: Injector = (inj, _v, _r, _s) => { + if (inj.mode == M_VAL) { + val parent = inj.parent + if (!islist(parent) || inj.keyi != 0) { pushErr(inj, "The $EXACT validator at field " + pathify(inj.path, VNum(1.0), VNum(1.0)) + " must be the first element of an array."); Noval } + else { + inj.keyi = size(inj.keys) + injSetval(inj, inj.dparent, 2) + inj.path = slice(inj.path, VNum(0.0), VNum((size(inj.path) - 1).toDouble)) + inj.key = getelem(inj.path, VNum(-1.0)) + val tvals = slice(parent, VNum(1.0)) + if (size(tvals) == 0) { pushErr(inj, "The $EXACT validator at field " + pathify(inj.path, VNum(1.0), VNum(1.0)) + " must have at least one argument."); Noval } + else { + var matched = false + (tvals match { case VList(b) => b.toSeq; case _ => Seq.empty }).foreach { tval => if (!matched && veq(tval, inj.dparent)) matched = true } + if (!matched) { + val valdesc = replaceTransformNames(itemsPairs(tvals).map { case (_, x) => stringify(x) }.mkString(", ")) + pushErr(inj, invalidTypeMsg(inj.path, (if (size(inj.path) > 1) "" else "value ") + "exactly equal to " + (if (size(tvals) == 1) "" else "one of ") + valdesc, typify(inj.dparent), inj.dparent, "V0110")) + } + Noval + } + } + } else { delprop(inj.parent, inj.key); Noval } + } + + def veq(a: Value, b: Value): Boolean = (a, b) match { + case (Noval, Noval) => true + case (VNull, VNull) => true + case (VBool(x), VBool(y)) => x == y + case (VNum(x), VNum(y)) => x == y + case (VStr(x), VStr(y)) => x == y + case (VSentinel(x), VSentinel(y)) => x == y + case (VList(x), VList(y)) => x.length == y.length && x.indices.forall(i => veq(x(i), y(i))) + case (VMap(x), VMap(y)) => + x.size == y.size && x.forall { case (k, v) => y.get(k) match { case Some(w) => veq(v, w); case None => false } } + case _ => false + } + + private val validation: Modify = (pval, key, parent, inj) => { + if (!isSkip(pval)) { + val exact = getprop(inj.meta, VStr(S_BEXACT), VBool(false)) + val cval = getprop(inj.dparent, key) + val exactB = exact match { case VBool(true) => true; case _ => false } + if (!(!exactB && isNoval(cval))) { + val ptype = typify(pval) + if (!((T_string & ptype) > 0 && jsString(pval).indexOf('$') >= 0)) { + val ctype = typify(cval) + if (ptype != ctype && !isNoval(pval)) pushErr(inj, invalidTypeMsg(inj.path, typename(ptype), ctype, cval, "V0010")) + else if (ismap(cval)) { + if (!ismap(pval)) pushErr(inj, invalidTypeMsg(inj.path, typename(ptype), ctype, cval, "V0020")) + else { + val ckeys = keysof(cval) + val pkeys = keysof(pval) + if (pkeys.nonEmpty && !(getprop(pval, VStr(S_BOPEN)) == VBool(true))) { + val badkeys = ckeys.filter(ck => isNoval(lookup_(pval, VStr(ck)))) + if (badkeys.nonEmpty) pushErr(inj, "Unexpected keys at field " + pathify(inj.path, VNum(1.0)) + S_VIZ + badkeys.mkString(", ")) + } else { + merge(mkList(Seq(pval, cval))) + if (isnode(pval)) delprop(pval, VStr(S_BOPEN)) + } + } + } else if (islist(cval)) { + if (!islist(pval)) pushErr(inj, invalidTypeMsg(inj.path, typename(ptype), ctype, cval, "V0030")) + } else if (exactB) { + if (!veq(cval, pval)) { + val pathmsg = if (size(inj.path) > 1) "at field " + pathify(inj.path, VNum(1.0)) + ": " else "" + pushErr(inj, "Value " + pathmsg + jsString(cval) + " should equal " + jsString(pval) + ".") + } + } else setprop(parent, key, cval) + } + } + } + } + + private def validateHandler(inj: Inj, v: Value, refstr: String, store: Value): Value = { + metaPathMatch(refstr) match { + case Some((_, g2, _)) => + if (g2 == "=") injSetval(inj, mkList(Seq(VStr(S_BEXACT), v))) else injSetval(inj, v) + inj.keyi = -1; SKIP + case None => injectHandler(inj, v, refstr, store) + } + } + + def validate(data: Value, spec: Value, inj: InjArg = INone): Value = { + val extra = inj match { case IDef(d) => d.dExtra; case _ => Noval } + val collect = inj match { case IDef(d) => !isNoval(d.dErrs); case _ => false } + val errs = inj match { case IDef(d) if collect => d.dErrs; case _ => emptyList() } + val base = emptyMap() + def put(k: String, v: Value): Unit = setprop(base, VStr(k), v) + Seq("$DELETE", "$COPY", "$KEY", "$META", "$MERGE", "$EACH", "$PACK").foreach(k => put(k, VNull)) + put("$STRING", VFunc(validateString)) + Seq("$NUMBER", "$INTEGER", "$DECIMAL", "$BOOLEAN", "$NULL", "$NIL", "$MAP", "$LIST", "$FUNCTION", "$INSTANCE").foreach(k => put(k, VFunc(validateType))) + put("$ANY", VFunc(validateAny)) + put("$CHILD", VFunc(validateChild)) + put("$ONE", VFunc(validateOne)) + put("$EXACT", VFunc(validateExact)) + val store = merge(mkList(Seq(base, if (isNoval(extra)) emptyMap() else extra, mkMap(Seq((S_DERRS, errs))))), VNum(1.0)) + val meta = inj match { case IDef(d) if !isNoval(d.dMeta) => d.dMeta; case _ => emptyMap() } + setprop(meta, VStr(S_BEXACT), getprop(meta, VStr(S_BEXACT), VBool(false))) + val idef = new InjDef + idef.dMeta = meta; idef.dExtra = store; idef.dModify = Some(validation); idef.dHandler = Some(validateHandler); idef.dErrs = errs + val out = transform(data, spec, IDef(idef)) + if (size(errs) > 0 && !collect) throw StructError(join(errs, VStr(" | "))) + out + } + + // --------------------------------------------------------------------------- + // select + // --------------------------------------------------------------------------- + + private val selectAnd: Injector = (inj, _v, _r, store) => { + if (inj.mode == M_KEYPRE) { + val terms = getprop(inj.parent, inj.key) + val ppath = slice(inj.path, VNum(-1.0)) + val point = getpath(store, ppath, INone) + val vstore = merge(mkList(Seq(emptyMap(), store)), VNum(1.0)) + setprop(vstore, VStr(S_DTOP), point) + itemsPairs(terms).foreach { case (_, term) => + val terrs = emptyList() + val d = new InjDef; d.dExtra = vstore; d.dErrs = terrs; d.dMeta = inj.meta + validate(point, term, IDef(d)) + if (size(terrs) != 0) pushErr(inj, "AND:" + pathify(ppath) + "⨯" + stringify(point) + " fail:" + stringify(terms)) + } + val gkey = getelem(inj.path, VNum(-2.0)); val gp = getelem(inj.nodes, VNum(-2.0)) + setprop(gp, gkey, point) + } + Noval + } + + private val selectOr: Injector = (inj, _v, _r, store) => { + if (inj.mode == M_KEYPRE) { + val terms = getprop(inj.parent, inj.key) + val ppath = slice(inj.path, VNum(-1.0)) + val point = getpath(store, ppath, INone) + val vstore = merge(mkList(Seq(emptyMap(), store)), VNum(1.0)) + setprop(vstore, VStr(S_DTOP), point) + var done = false + itemsPairs(terms).foreach { case (_, term) => + if (!done) { + val terrs = emptyList() + val d = new InjDef; d.dExtra = vstore; d.dErrs = terrs; d.dMeta = inj.meta + validate(point, term, IDef(d)) + if (size(terrs) == 0) { + val gkey = getelem(inj.path, VNum(-2.0)); val gp = getelem(inj.nodes, VNum(-2.0)) + setprop(gp, gkey, point); done = true + } + } + } + if (!done) pushErr(inj, "OR:" + pathify(ppath) + "⨯" + stringify(point) + " fail:" + stringify(terms)) + } + Noval + } + + private val selectNot: Injector = (inj, _v, _r, store) => { + if (inj.mode == M_KEYPRE) { + val term = getprop(inj.parent, inj.key) + val ppath = slice(inj.path, VNum(-1.0)) + val point = getpath(store, ppath, INone) + val vstore = merge(mkList(Seq(emptyMap(), store)), VNum(1.0)) + setprop(vstore, VStr(S_DTOP), point) + val terrs = emptyList() + val d = new InjDef; d.dExtra = vstore; d.dErrs = terrs; d.dMeta = inj.meta + validate(point, term, IDef(d)) + if (size(terrs) == 0) pushErr(inj, "NOT:" + pathify(ppath) + "⨯" + stringify(point) + " fail:" + stringify(term)) + val gkey = getelem(inj.path, VNum(-2.0)); val gp = getelem(inj.nodes, VNum(-2.0)) + setprop(gp, gkey, point) + } + Noval + } + + private def numCmp(a: Value, b: Value, op: String): Boolean = (a, b) match { + case (VNum(x), VNum(y)) => op match { case "gt" => x > y; case "lt" => x < y; case "gte" => x >= y; case "lte" => x <= y; case _ => false } + case _ => false + } + + private val selectCmp: Injector = (inj, _v, refstr, store) => { + if (inj.mode == M_KEYPRE) { + val term = getprop(inj.parent, inj.key) + val gkey = getelem(inj.path, VNum(-2.0)) + val ppath = slice(inj.path, VNum(-1.0)) + val point = getpath(store, ppath, INone) + val pass = + if (refstr == "$GT") numCmp(point, term, "gt") + else if (refstr == "$LT") numCmp(point, term, "lt") + else if (refstr == "$GTE") numCmp(point, term, "gte") + else if (refstr == "$LTE") numCmp(point, term, "lte") + else if (refstr == "$LIKE") (term match { case VStr(t) => java.util.regex.Pattern.compile(t).matcher(stringify(point)).find(); case _ => false }) + else false + if (pass) { val gp = getelem(inj.nodes, VNum(-2.0)); setprop(gp, gkey, point) } + else pushErr(inj, "CMP: " + pathify(ppath) + "⨯" + stringify(point) + " fail:" + refstr + " " + stringify(term)) + } + Noval + } + + def select(children0: Value, query: Value): Value = { + if (!isnode(children0)) emptyList() + else { + val children = + if (ismap(children0)) mkList(itemsPairs(children0).map { case (k, n) => setprop(n, VStr(S_DKEY), VStr(k)); n }) + else mkList((children0 match { case VList(b) => b.toSeq; case _ => Seq.empty }).zipWithIndex.map { case (n, i) => if (ismap(n)) { setprop(n, VStr(S_DKEY), vint(i)); n } else n }) + val results = emptyList() + val extra = emptyMap() + Seq(("$AND", selectAnd), ("$OR", selectOr), ("$NOT", selectNot), ("$GT", selectCmp), ("$LT", selectCmp), ("$GTE", selectCmp), ("$LTE", selectCmp), ("$LIKE", selectCmp)) + .foreach { case (k, f) => setprop(extra, VStr(k), VFunc(f)) } + val q = clone(query) + walk(q, before = Some((_k, v, _p, _path) => { if (ismap(v)) setprop(v, VStr(S_BOPEN), getprop(v, VStr(S_BOPEN), VBool(true))); v })) + (children match { case VList(b) => b.toSeq; case _ => Seq.empty }).foreach { child => + val errs = emptyList() + val d = new InjDef + d.dErrs = errs + d.dMeta = { val m = emptyMap(); setprop(m, VStr(S_BEXACT), VBool(true)); m } + d.dExtra = extra + validate(child, clone(q), IDef(d)) + if (size(errs) == 0) setprop(results, VNum(size(results).toDouble), child) + } + results + } + } + + // --------------------------------------------------------------------------- + // builders + // --------------------------------------------------------------------------- + + def jm(kv: Value*): Value = { + val m = LinkedHashMap.empty[String, Value] + val arr = kv.toArray + val n = arr.length + var i = 0 + while (i < n) { + val k0 = arr(i) + val k = k0 match { case VNull => "null"; case VStr(s) => s; case _ => stringify(k0) } + m.put(k, if (i + 1 < n) arr(i + 1) else VNull) + i += 2 + } + VMap(m) + } + + def jt(v: Value*): Value = mkList(v) + + def tn(t: Int): String = typename(t) +} diff --git a/scala/test/runner.scala b/scala/test/runner.scala new file mode 100644 index 00000000..68230686 Binary files /dev/null and b/scala/test/runner.scala differ diff --git a/tools/check_parity.py b/tools/check_parity.py index 60d6c622..b2c08c3f 100755 --- a/tools/check_parity.py +++ b/tools/check_parity.py @@ -31,9 +31,10 @@ # so it is trivially in parity and is not checked.) COMPLETE_PORTS = [ "javascript", "python", "go", "php", "ruby", "lua", - "rust", "c", "zig", "csharp", "perl", "cpp", "swift", + "rust", "c", "zig", "csharp", "perl", "cpp", "swift", "clojure", "ocaml", "scala", + "java", "kotlin", "dart", "elixir", "haskell", ] -PARTIAL_PORTS = ["java", "kotlin"] +PARTIAL_PORTS: list[str] = [] # Accepted, documented divergences (normalised name keys). Anything NOT listed # here is treated as a parity gap and fails the check; this list should only @@ -76,6 +77,12 @@ "zig": ["zig/src/struct.zig"], "kotlin": ["kotlin/src/main/kotlin/voxgig/struct/Struct.kt"], "perl": ["perl/lib/Voxgig/Struct.pm"], + "clojure": ["clojure/src/voxgig/struct.clj"], + "ocaml": ["ocaml/src/voxgig_struct.ml"], + "scala": ["scala/src/voxgig_struct.scala"], + "dart": ["dart/lib/voxgig_struct.dart"], + "elixir": ["elixir/lib/voxgig_struct.ex"], + "haskell": ["haskell/src/VoxgigStruct.hs"], "swift": [ "swift/Sources/VoxgigStruct/Value.swift", "swift/Sources/VoxgigStruct/Constants.swift", @@ -127,6 +134,23 @@ def canonical_names() -> list[str]: # doesn't put `(` after the function name in the definition, so neither of # the patterns above catches them. _PERL_SUB_DECL = re.compile(r"^\s*sub\s+([A-Za-z_][A-Za-z0-9_]*)", re.M) +# Clojure `(defn name` / `(defn- name` / `(def name` definitions. The library +# uses lower-smushed canonical names (getpath, ismap, re_find, checkPlacement), +# so the same case/underscore-insensitive norm() applies. Clojure idents allow +# extra symbol chars, none of which appear in canonical names. +_CLJ_DEFN_DECL = re.compile(r"\(defn?-?\s+([A-Za-z_][A-Za-z0-9_*+!?<>=-]*)", re.M) +# OCaml `let [rec] NAME` / `and NAME` bindings. The library uses lower-smushed +# canonical names (getpath, ismap, re_find, check_placement), matched +# case/underscore-insensitively by norm(). +_OCAML_DECL = re.compile(r"^\s*(?:let\s+(?:rec\s+)?|and\s+)([A-Za-z_][A-Za-z0-9_']*)", re.M) +# Scala `def NAME` method definitions. Canonical names are lower-smushed / +# camelCased (getpath, ismap, re_find, checkPlacement), matched by norm(). +_SCALA_DECL = re.compile(r"\bdef\s+([A-Za-z_][A-Za-z0-9_]*)", re.M) + +# Haskell top-level type signatures: `name :: ...` at column 0. Every public +# function has one, so this is a superset of the port's public names. Canonical +# names are lower-smushed / snake_cased (getpath, ismap, re_find, getprop). +_HASKELL_DECL = re.compile(r"^([a-z][A-Za-z0-9_']*)\s*::", re.M) def defined_keys(port: str) -> set[str]: @@ -150,6 +174,18 @@ def defined_keys(port: str) -> set[str]: if port == "perl": for ident in _PERL_SUB_DECL.findall(text): keys.add(norm(ident)) + if port == "clojure": + for ident in _CLJ_DEFN_DECL.findall(text): + keys.add(norm(ident)) + if port == "ocaml": + for ident in _OCAML_DECL.findall(text): + keys.add(norm(ident)) + if port == "scala": + for ident in _SCALA_DECL.findall(text): + keys.add(norm(ident)) + if port == "haskell": + for ident in _HASKELL_DECL.findall(text): + keys.add(norm(ident)) # The C port uses a `voxgig_` prefix on every public function. Strip it so # `voxgig_getpath` matches canonical `getpath`. Trailing `_v` / `_va` # (voxgig_jm_va for variadic-style builders, voxgig_walk_v for the value