summaryrefslogtreecommitdiff
path: root/json.lisp
diff options
context:
space:
mode:
Diffstat (limited to 'json.lisp')
-rw-r--r--json.lisp120
1 files changed, 0 insertions, 120 deletions
diff --git a/json.lisp b/json.lisp
deleted file mode 100644
index 80fef99..0000000
--- a/json.lisp
+++ /dev/null
@@ -1,120 +0,0 @@
-(in-package #:json)
-
-(defparameter number-literal
- (let ((signed-digits
- (comp ((sign (optional (one-of (unit #\-)
- (unit #\+))))
- (natural (if sign
- (one-of (many (unit-if #'digit-char-p))
- (fail "Malformed number."))
- (many (unit-if #'digit-char-p)))))
- (cons sign natural))))
- (comp ((base signed-digits)
- (dot (optional (unit #\.)))
- (fraction (if dot
- (one-of (many (unit-if #'digit-char-p))
- (fail "Malformed fractional part."))
- nothing))
- (e (optional (one-of (unit #\e) (unit #\E))))
- (exponent (if e
- (one-of signed-digits
- (fail "Malformed exponent part."))
- nothing)))
- (read-from-string
- (str:from-list
- (remove nil (append base (cons dot fraction) (cons e exponent))))))))
-
-(defparameter string-literal
- (comp ((_ (unit #\"))
- (chars (optional (many (one-of (comp ((slash (unit #\\))
- (escaped (unit-if))
- (codepoints (if (char= escaped #\u)
- (comp ((cp0 (unit-if #'digit-char-p))
- (cp1 (unit-if #'digit-char-p))
- (cp2 (unit-if #'digit-char-p))
- (cp3 (unit-if #'digit-char-p)))
- (let ((str (make-string 7)))
- (setf (char str 0) #\#)
- (setf (char str 1) #\\)
- (setf (char str 2) #\u)
- (setf (char str 3) cp0)
- (setf (char str 4) cp1)
- (setf (char str 5) cp2)
- (setf (char str 6) cp3)
- str))
- nothing)))
- (case escaped
- (#\n
- #\Newline)
- (#\t
- #\Tab)
- (#\u
- (read-from-string codepoints))
- (t escaped)))
- (unit-if (lambda (x) (and (char/= x #\")
- (char/= x #\\))))))))
- (_ (one-of (unit #\")
- (fail "String is not properly closed."))))
- (str:from-list chars)))
-
-(defparameter true-symbol
- (comp ((_ (unit #\t))
- (_ (one-of (literal "rue")
- (fail "Expected 'true'."))))
- 'true))
-
-(defparameter false-symbol
- (comp ((_ (unit #\f))
- (_ (one-of (literal "alse")
- (fail "Expected 'false'."))))
- 'false))
-
-(defparameter null-symbol
- (comp ((_ (unit #\n))
- (_ (one-of (literal "ull")
- (fail "Expected 'null'."))))
- 'null))
-
-(defvar json-value nil)
-
-(defparameter json-array
- (comp ((_ (unit #\[))
- (vn (optional (separated-list json-value (unit #\,))))
- (_ (unit #\])))
- (apply #'vector vn)))
-
-(defparameter json-object
- (let ((json-pair
- (comp ((_ whitespace)
- (k (one-of string-literal
- (fail "Expected a string.")))
- (_ whitespace)
- (_ (one-of (unit #\:)
- (fail "Expected a \":\"")))
- (v json-value))
- (cons k v))))
- (comp ((_ (unit #\{))
- (vn (optional (separated-list json-pair (unit #\,))))
- (_ (unit #\})))
- (let* ((obj (make-hash-table :test #'equal :size (length vn))))
- (dolist (v vn)
- (setf (gethash (car v) obj) (cdr v)))
- obj))))
-
-(setf json-value
- (comp ((_ whitespace)
- (v (one-of number-literal
- string-literal
- json-object
- json-array
- true-symbol
- false-symbol
- null-symbol))
- (_ whitespace))
- v))
-
-(defun parse-string (str)
- (run json-value (input:from-string str)))
-
-(defun parse-file (file)
- (run json-value (input:from-file file)))