summaryrefslogtreecommitdiff
path: root/load.lisp
diff options
context:
space:
mode:
authorJuan Manuel Tomás <jtomas1815@gmail.com>2022-12-26 03:10:17 -0300
committerJuan Manuel Tomás <jtomas1815@gmail.com>2022-12-26 03:10:17 -0300
commit2990f8c72975eb1de8be62ac043375fea47857eb (patch)
treedb7c8045b29bbb18255b7c05077e8f599fe070bd /load.lisp
parentd7d3e70886554cb8350ea444adf384ca078673fb (diff)
downloadjson-2990f8c72975eb1de8be62ac043375fea47857eb.tar.gz
json-2990f8c72975eb1de8be62ac043375fea47857eb.zip
Introduce a way to serialize the parsed json data
Diffstat (limited to 'load.lisp')
-rw-r--r--load.lisp120
1 files changed, 120 insertions, 0 deletions
diff --git a/load.lisp b/load.lisp
new file mode 100644
index 0000000..80fef99
--- /dev/null
+++ b/load.lisp
@@ -0,0 +1,120 @@
+(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)))