;;;; The JSON tokenizer, and a document read into a dynamic value in an arena.
;;;;
;;;; This is programs/edn.flan and programs/arena-edn.flan in one file, because
;;;; for JSON they are one claim. edn needed two programs: the tokenizer there
;;;; allocates nothing and hands back views, so the struct reader and the arena
;;;; reader are separate lanes over the same cursor. vendor/json copies its
;;;; strings into the allocator, so the cursor and the allocator cannot be
;;;; demonstrated apart — the interesting thing about a token is what
;;;; (json/string-of t) makes of it.
;;;;
;;;; The typed half — (read-json Enemy bytes), the compiler emitting a parser
;;;; from a compile-time walk over a struct's fields — does not exist and is
;;;; not attempted here. What is here is what a reader handed *no* target type
;;;; has to answer with: a Value naming itself through a (Vec Value) and a
;;;; (Map string Value).
;;;;
;;;; ── The one thing this proves that arena-edn.flan cannot ─────────────
;;;;
;;;; arena-edn's header has a section admitting that its strings are views into
;;;; the source buffer and outlive the region rather than dying with it. This
;;;; document does not have that hole, and the proof is at the bottom of main:
;;;; the source buffer is overwritten with `?` bytes while the Value is still
;;;; live, and the strings read back afterwards are still the strings. An
;;;; implementation that aliased the buffer — which is free, and which edn does
;;;; on purpose — prints question marks there.
;;;;
;;;; Everything else is the shape arena-edn already argued for: no teardown
;;;; anywhere, one (free-all frame) at the bottom, and read-value taking no
;;;; allocator because with-allocator around the call is what binds one.
;;;;
;;;; Every case below is one a plausible wrong version fails. Named where that
;;;; is not obvious.

(import json "vendor:json")

(defvar frame Allocator)

;; ── A dump of the token stream ──────────────────────────────────────
;;
;; One letter per kind, then the text in brackets, so both halves of every
;; token are asserted. A tokenizer that got the kinds right and the slices
;; wrong — off by the opening quote — would pass on the letters alone. The
;; text of a string token is the RAW interior, so an escape shows up here with
;; its backslash still on it; that is the divergence between the tokenizer and
;; string-of, and this is where it is visible.

(defn kind-letter [k i32] string
  (cond
    (= k json/tok-eof)          "."
    (= k json/tok-error)        "!"
    (= k json/tok-null)         "n"
    (= k json/tok-bool)         "b"
    (= k json/tok-int)          "i"
    (= k json/tok-float)        "f"
    (= k json/tok-string)       "s"
    (= k json/tok-array-open)   "["
    (= k json/tok-array-close)  "]"
    (= k json/tok-object-open)  "{"
    (= k json/tok-object-close) "}"
    (= k json/tok-colon)        ":"
    (= k json/tok-comma)        ","
    :else                       "?"))

(defn dump [src string] ()
  (let [b (bytes src)
        c (json/cursor b)
        t (json/next (addr c))]
    (while (and (json/ok? (addr c)) (!= (.kind t) json/tok-eof))
      (print (kind-letter (.kind t)))
      (print "<")
      (print (.text t))
      (print ">")
      (set t (json/next (addr c))))
    (when (not (json/ok? (addr c)))
      (print "ERR@")
      (print (json/error-pos (addr c))))
    (println "")))

;; The refusals. Asserted on the *reason* and not on the fact of failing: a
;; tokenizer answering one generic error for all of these would pass a test
;; that only checked that it stopped.
(defn refusal [src string] ()
  (let [b (bytes src)
        c (json/cursor b)]
    (while (and (json/ok? (addr c))
                (!= (.kind (json/next (addr c))) json/tok-eof)))
    (print (json/error-pos (addr c)))
    (print " ")
    (print (json/error-message (json/error (addr c))))
    (println "")))

;; ── The dynamic value ───────────────────────────────────────────────

(defdata Value
  [(Null   [])
   (Bool   [b bool])
   (Int    [n i64])
   (Float  [x f64])
   (Text   [s string])
   (Array  [items (Vec Value)])
   (Object [entries (Map string Value)])])

;; One token in hand, and the cursor for whatever the token opens. An array and
;; an object recurse; everything else is a leaf.
;;
;; The two collection arms are longer than arena-edn's because JSON's commas
;; are grammar and EDN's are whitespace: after every element there has to be a
;; separator or a closer, and nothing else. A reader that skipped that check
;; would accept [1 2] and a trailing comma, which are the two things a file
;; written for JSON5 actually contains — so they are refused here, by name,
;; through json/fail on the cursor. Errors accumulate there rather than being
;; returned, which is why these can be straight loops with one test at the end.
;;
;; Written with a `more` flag rather than early returns because every arm has
;; to answer the partially built collection: a document that fails halfway is
;; still a Value, the cursor is what says it is not trustworthy, and a `return`
;; out of a cond arm would have to repeat the constructor at each of them.
(defn read-value [c (Ptr json/Cursor)  t json/Token] Value
  (cond
    (= (.kind t) json/tok-bool)
      (Value.Bool {.b (match (json/bool-of t) (Some v) v None false)})
    (= (.kind t) json/tok-int)
      (Value.Int {.n (match (json/int-of t) (Some v) v None (i64 0))})
    (= (.kind t) json/tok-float)
      (Value.Float {.x (match (json/float-of t) (Some v) v None 0.0)})
    (= (.kind t) json/tok-string)
      (Value.Text {.s (match (json/string-of t) (Some s) s None "")})

    (= (.kind t) json/tok-array-open)
      (let [items (vec-new Value)
            u (json/next c)
            more (and (json/ok? c) (!= (.kind u) json/tok-array-close))]
        (while more
          (push items (read-value c u))
          (let [sep (json/next c)]
            (cond
              (not (json/ok? c))                        (set more false)
              (= (.kind sep) json/tok-array-close)      (set more false)
              (!= (.kind sep) json/tok-comma)
                (do (json/fail c json/err-unexpected-token (.pos sep))
                    (set more false))
              :else
                (do (set u (json/next c))
                    ;; A comma and then the closer. Named, because a trailing
                    ;; comma is legal JSON5 and a reader that quietly allowed
                    ;; it would be reading a different format than it claims.
                    ;;
                    ;; The fail is what ends the loop, through the ok? test
                    ;; below it and not on its own — so these two are in this
                    ;; order on purpose, and swapping them spins.
                    (when (= (.kind u) json/tok-array-close)
                      (json/fail c json/err-trailing-comma (.pos u)))
                    (when (not (json/ok? c))
                      (set more false))))))
        (Value.Array {.items items}))

    ;; An object key is a quoted string and nothing else — an unquoted one was
    ;; already refused by the tokenizer as a bare word, so what reaches here is
    ;; a number or a bracket where a key was wanted. The key is copied by the
    ;; same string-of the values use, so the map owns its keys and the source
    ;; buffer is not in the picture.
    (= (.kind t) json/tok-object-open)
      (let [entries (map-new string Value)
            k (json/next c)
            more (and (json/ok? c) (!= (.kind k) json/tok-object-close))]
        (while more
          (if (!= (.kind k) json/tok-string)
            (do (json/fail c json/err-unexpected-token (.pos k))
                (set more false))
            (let [key (match (json/string-of k) (Some s) s None "")]
              (json/expect c json/tok-colon)
              (if (not (json/ok? c))
                (set more false)
                (let [v (json/next c)]
                  (if (not (json/ok? c))
                    (set more false)
                    (do
                      (put entries key (read-value c v))
                      (let [sep (json/next c)]
                        (cond
                          (not (json/ok? c))                    (set more false)
                          (= (.kind sep) json/tok-object-close) (set more false)
                          (!= (.kind sep) json/tok-comma)
                            (do (json/fail c json/err-unexpected-token (.pos sep))
                                (set more false))
                          :else
                            ;; Same two steps, same order, same reason as the
                            ;; array arm: the fail ends the loop through the
                            ;; ok? test under it, and it has to, because the
                            ;; next pass would otherwise ask string-of for the
                            ;; text of a closing brace.
                            (do (set k (json/next c))
                                (when (= (.kind k) json/tok-object-close)
                                  (json/fail c json/err-trailing-comma (.pos k)))
                                (when (not (json/ok? c))
                                  (set more false))))))))))))
        (Value.Object {.entries entries}))

    :else Value.Null))

;; Walking it back. (at v i) addresses an element in place and (get m k)
;; answers a copy of the value's bytes; in a region the two are the same thing,
;; an alias into storage nobody individually owns.
(defn count-leaves [v Value] i32
  (match v
    (Array items)
      (let [n 0]
        (dotimes [i (len items)]
          (set n (+ n (count-leaves (at items i)))))
        n)
    ;; map-next fills an out-parameter with a copy of the value's bytes, which
    ;; for a Value holding a container is a second header over the same block.
    ;; In a region that is an alias and not a second owner, so walking a map is
    ;; the ordinary iteration and needs no accessor of its own.
    (Object entries)
      (let [n 0
            cur (i64 0)
            k ""
            e Value.Null]
        (while (map-next entries (addr cur) (addr k) (addr e))
          (set n (+ n (count-leaves e))))
        n)
    _ 1))

(defn sum-ints [v Value] i64
  (match v
    (Int n) n
    (Array items)
      (let [t (i64 0)]
        (dotimes [i (len items)]
          (set t (+ t (sum-ints (at items i)))))
        t)
    (Object entries)
      (match (get entries "xs") (Some x) (sum-ints x) None (i64 0))
    _ (i64 0)))

(defn describe [v Value] string
  (match v
    Null "null" (Bool _b) "bool" (Int _n) "int" (Float _x) "float"
    (Text _s) "string" (Array _i) "array" (Object _e) "object"))

;; The text at a top-level key, or a marker. Used after the source buffer has
;; been scribbled over, which is the whole reason it exists.
(defn text-at [v Value  key string] string
  (match v
    (Object entries)
      (match (get entries key)
        (Some x) (match x (Text s) s _ "<not a string>")
        None "<missing>")
    _ "<not an object>"))

(defn read-doc [src [u8]] Value
  (let [c (json/cursor src)
        t (json/next (addr c))]
    (read-value (addr c) t)))

;; A reader's own refusals, driven end to end: read the whole document and then
;; report what the cursor says. The position matters as much as the message —
;; a trailing comma reported at the opening brace would be useless.
(defn reject [src string] ()
  (let [b (bytes src)
        c (json/cursor b)
        t (json/next (addr c))]
    (read-value (addr c) t)
    (if (json/ok? (addr c))
      (print "accepted")
      (do (print "ERR@")
          (print (json/error-pos (addr c)))
          (print " ")
          (print (json/error-message (json/error (addr c))))))
    (println "")))

;; Four levels deep, and every level allocates. \" is the escape a tokenizer
;; that handed back raw bytes would get visibly wrong; é is the two-byte
;; case and the 😀 pair is the four-byte one, which is the only place
;; the surrogate arithmetic runs.
;;
;; "esc" holds all eight of JSON's one-character escapes and is asserted by its
;; LENGTH rather than by its text, because six of the eight are control bytes
;; and a test file with a raw tab and a raw form feed sitting in an expected
;; string is a test nobody can edit. Eight escapes have to come out as eight
;; bytes; a version that passed one of them through unresolved would be nine.
(defconst doc
  "{\"name\": \"level \\\"1\\\"\",
    \"xs\": [1, 2, 3],
    \"spawns\": [{\"kind\": \"grunt\", \"at\": [10, 20]},
                 {\"kind\": \"boss\",  \"at\": [30, 40]}],
    \"gravity\": 9.8,
    \"looping\": true,
    \"nothing\": null,
    \"esc\": \"\\\"\\\\\\/\\b\\f\\n\\r\\t\",
    \"note\": \"\\u00e9 \\uD83D\\uDE00 \\/\"}")

(defn main [] i32
  ;; ── Scalars, and the boundaries between them ──────────────────────
  (dump "1")                       ; i<1>
  (dump "-1 0 0.0")                ; a leading minus is part of the number
  (dump "1.5 -2.5e3 1e+3 1E-3")    ; f — an exponent makes a float of a whole
  (dump "true false null")         ; b b n, and not three bare words
  (println "")

  ;; A number followed immediately by a delimiter, with no space. A scanner
  ;; that only stopped on whitespace reads "1]" or "1," as one atom and then
  ;; fails to parse it.
  (dump "[1]")
  (dump "[1,2]")
  (dump "{\"a\":1}")
  (dump "[1][2]")
  (println "")

  ;; Empty collections, and nesting. An empty object is the case a reader that
  ;; assumes at least one member gets wrong.
  (dump "{}")
  (dump "[]")
  (dump "[[1],[2,[3]]]")
  (dump "{\"a\":{\"b\":[]}}")
  (println "")

  ;; Strings, raw. The interior is what comes back, so the escapes are still
  ;; escapes here and the second case shows a bracket and a colon inside a
  ;; literal not opening anything.
  (dump "\"hi\"")
  (dump "\"a[b:c,d\" 1")
  (dump "\"\" 1")                  ; the empty string is a token with empty text
  (dump "\"a\\nb\" \"\\u00e9\"")
  (println "")

  ;; ── The refusals, each asserted on its own reason ─────────────────
  ;;
  ;; The JSON5-isms first, in the order the header lists them. Every one of
  ;; these parses somewhere, which is why each gets a sentence naming the
  ;; dialect rather than a shared "unexpected byte".
  (refusal "[1] // trailing")      ; a line comment
  (refusal "/* lead */ [1]")       ; a block comment
  (refusal "1 / 2")                ; a slash that begins neither — not a comment
  (refusal "'single'")
  (refusal "+1")
  (refusal ".5")                   ; edn.flan reads this as a float on purpose
  (refusal "1.")
  (refusal "1.e3")                 ; the same rule, one byte later
  (refusal "0x1f")
  (refusal "01")
  (refusal "NaN")
  (refusal "Infinity")
  (refusal "{name: 1}")            ; an unquoted key
  (println "")

  ;; Strings: the escape grammar, and the two surrogate halves. A lone
  ;; surrogate is refused because rune-size answers None for the whole
  ;; D800-DFFF block, so encode-rune would write nothing and the character
  ;; would vanish — the refusal is forced by the prelude rather than chosen.
  (refusal "\"a\\vb\"")            ; \v is JSON5's
  (refusal "\"a\\x41b\"")          ; so is \x
  (refusal "\"a\\u12\"")           ; four hex digits, not two
  (refusal "\"\\uD800x\"")         ; a high surrogate with no pair after it
  (refusal "\"\\uDC00\"")          ; a low one on its own
  (refusal "\"\\uD800\\uD800\"")   ; a high one followed by another high one
  (refusal "\"a\tb\"")             ; a raw tab, which JSON says to escape
  (refusal "\"unterminated")
  (refusal "\"trailing escape\\")  ; the backslash is the last byte in the file
  (println "")

  ;; Structure, and the number grammar's own failures.
  (refusal "[1 2}")                ; the wrong closer
  (refusal "]")                    ; a closer with nothing open
  (refusal "[1")                   ; end of input with something still open
  (refusal "12x")                  ; starts like a number, is not one
  (refusal "-")                    ; a sign with no digits
  (refusal "1e")                   ; an exponent with no digits
  (refusal "@")                    ; not the start of any JSON value
  ;; 33 opening brackets against a 32-deep stack. The message is the least of
  ;; what this checks: a `>` where the guard needs `>=` writes one past the end
  ;; of a fixed array, and the answer is a bounds trap rather than a wrong
  ;; message. The offset is the 33rd bracket.
  (refusal "[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[")
  (println "")

  ;; ── The reader's own refusals ─────────────────────────────────────
  ;;
  ;; Inside the region, because read-value builds a (Vec Value) and a Value
  ;; holds containers: spec-memory.md's rule traps that construction against
  ;; any allocator that can free one block, and a malformed document builds
  ;; exactly as much of one as a well-formed document does. The refusals being
  ;; checked here are the reader's, not the allocator's.
  (set frame (arena-new 65536))
  (with-allocator frame
    (do
      (reject "[1, 2]")              ; accepted — the control
      (reject "{\"a\": 1}")          ; accepted
      (reject "[1 2]")               ; a missing comma, which EDN would allow
      (reject "[1, 2,]")             ; a trailing comma
      (reject "{\"a\": 1,}")         ; and in an object
      (reject "{\"a\" 1}")           ; a missing colon
      (reject "{1: 2}")              ; a key that is not a string
      (println "")))
  ;; Released before the document below is read into the same region, so that
  ;; the read starts from a reset arena rather than from whatever the refusals
  ;; left behind. free-all is retain-capacity, so this keeps the pages.
  (free-all frame)

  ;; ── The document, in an arena, outliving its source ───────────────
  ;;
  ;; The source buffer is built BEFORE with-allocator, so it belongs to the
  ;; heap and not to the region. That is the point of the whole section: the
  ;; two lifetimes have to be separable for the scribble below to mean
  ;; anything.
  (let [buf (vec-new u8)]
    (append (addr buf) (bytes doc))
    (with-allocator frame
      (let [v (read-doc (as-slice buf))]
        (println (describe v))          ; object
        (println (count-leaves v))      ; every leaf in the graph
        (println (sum-ints v))          ; [1 2 3]
        (println (describe (match v (Object e) (match (get e "gravity")
                                                 (Some g) g None Value.Null)
                             _ Value.Null)))
        ;; The escapes, resolved. The quotes in `name` never existed as bytes
        ;; in the source; é is two bytes out of six and the emoji is four out
        ;; of twelve; and the eight one-character escapes are eight bytes.
        (println (text-at v "name"))
        (println (text-at v "note"))
        (println (len (text-at v "note")))
        (println (len (text-at v "esc")))
        ;; And now the source buffer is destroyed under the live document. An
        ;; implementation that aliased it prints question marks from here on.
        (dotimes [i (len buf)]
          (set (at buf i) \?))
        (println (text-at v "name"))
        (println (text-at v "nothing"))
        (println (text-at v "absent"))))
    ;; The whole document, in one operation and with no per-element teardown.
    (free-all frame)
    (arena-destroy frame)
    (free buf))
  0)