From 2990f8c72975eb1de8be62ac043375fea47857eb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Juan=20Manuel=20Tom=C3=A1s?= Date: Mon, 26 Dec 2022 03:10:17 -0300 Subject: Introduce a way to serialize the parsed json data --- dump.lisp | 31 +++++++++++++++ json.asd | 3 +- json.lisp | 120 ----------------------------------------------------------- load.lisp | 120 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ package.lisp | 4 +- 5 files changed, 156 insertions(+), 122 deletions(-) create mode 100644 dump.lisp delete mode 100644 json.lisp create mode 100644 load.lisp diff --git a/dump.lisp b/dump.lisp new file mode 100644 index 0000000..d4f3fff --- /dev/null +++ b/dump.lisp @@ -0,0 +1,31 @@ +(in-package #:json) + +(defun to-string (value) + (defun indent (str level) + (concatenate 'string (make-string (* 4 level) :initial-element #\Space) str)) + (defun to-string-rec (value level) + (cond ((stringp value) + (format nil "\"~a\"" value)) + ((symbolp value) + (string-downcase (symbol-name value))) + ((arrayp value) + (format nil + "[~&~{~a~^,~&~}]" + (map 'list (lambda (x) (indent (to-string-rec x (1+ level)) level)) + value))) + ((hash-table-p value) + (let (items) + (maphash (lambda (k v) + (push (indent (format nil "\"~a\": ~a" k (to-string-rec v (1+ level))) level) + items)) + value) + (format nil "{~&~{~a~^,~&~}}" items))) + (t value))) + (to-string-rec value 0)) + +(defun to-file (value filename) + (with-open-file (s filename + :direction :output + :if-exists :supersede + :if-does-not-exist :create) + (princ (to-string value) s) t)) diff --git a/json.asd b/json.asd index 0af37a2..d6d5f66 100644 --- a/json.asd +++ b/json.asd @@ -4,4 +4,5 @@ #:monparser) :components ((:file "package") - (:file "json"))) + (:file "dump") + (:file "load"))) 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))) 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))) diff --git a/package.lisp b/package.lisp index d2b1e6f..2c7c3a7 100644 --- a/package.lisp +++ b/package.lisp @@ -1,4 +1,6 @@ (defpackage #:json (:use #:cl #:parser) (:export #:parse-string - #:parse-file)) + #:parse-file + #:to-string + #:to-file)) -- cgit v1.2.3