dane/d-
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Allow non-string json object keys

Browse Source
This commit is contained in:
Dane Johnson 2025-01-29 15:20:32 -06:00
parent 0f04feedcd
commit bd7af0146c
2 changed files with 9 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
d-/json.scm
View File

@ -27,8 +27,8 @@
(define-peg-pattern eobj all (and open-cu close-cu)) (define-peg-pattern eobj all (and open-cu close-cu))
(define-peg-pattern object all (or eobj (define-peg-pattern object all (or eobj
(and open-cu (and open-cu
(* (and string (ignore ":") ++ value comma)) (* (and value (ignore ":") ++ value comma))
(and string (ignore ":") ++ value) (and value (ignore ":") ++ value)
close-cu))) close-cu)))
(define-peg-pattern value body (or number boolean string array object)) (define-peg-pattern value body (or number boolean string array object))
@ -49,9 +49,10 @@
(define (parse-object ss) (define (parse-object ss)
(if (or (null? ss) (null? (cdr ss))) (if (or (null? ss) (null? (cdr ss)))
'() '()
(acons (string->symbol (parse-value (car ss))) (let ([key (parse-value (car ss))])
(acons (if (string? key) (string->symbol key) key)
(parse-value (cadr ss)) (parse-value (cadr ss))
(parse-object (cddr ss))))) (parse-object (cddr ss))))))
(define flatwords '(boolean number string array object)) (define flatwords '(boolean number string array object))

5
test.scm
View File

@ -121,8 +121,9 @@
(assert-equal '() (json "{}")) (assert-equal '() (json "{}"))
(assert-equal '((cat . 1) (assert-equal '((cat . 1)
(bat . #t) (bat . #t)
(rat . "yessir")) (rat . "yessir")
(json "{\"cat\": 1, \"bat\": true, \"rat\": \"yessir\"}")) (4 . "what"))
(json "{\"cat\": 1, \"bat\": true, \"rat\": \"yessir\", 4: \"what\"}"))
(assert-equal '((butter . 1) (assert-equal '((butter . 1)
(brownie)) (brownie))
(json "{\"butter\": 1, \"brownie\": {}}")))) (json "{\"butter\": 1, \"brownie\": {}}"))))