From ab838fa9afa779fb96ebbf97639caea05f22dba8 Mon Sep 17 00:00:00 2001 From: Daniel Jay Haskin Date: Fri, 20 Oct 2023 21:48:46 -0600 Subject: [PATCH] Initial rough draft. --- .gitattributes | 17 +++ .gitignore | 19 ++++ jfon.asd | 33 ++++++ jfon/main.lisp | 80 +++++++++++++ tests/main.lisp | 291 ++++++++++++++++++++++++++++++++++++++++++++++++ 5 files changed, 440 insertions(+) create mode 100644 .gitattributes create mode 100644 .gitignore create mode 100644 jfon.asd create mode 100644 jfon/main.lisp create mode 100644 tests/main.lisp diff --git a/.gitattributes b/.gitattributes new file mode 100644 index 0000000..0f2bd6e --- /dev/null +++ b/.gitattributes @@ -0,0 +1,17 @@ +# Linux +*.sh text eol=lf + +# Windows +*.ps1 text eol=crlf + +# Both OS's +*.lisp text +*.asd text +*.md text +qlfile text +.gitignore text +*.lock text + +# Images +*.png binary +*.jpg binary diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..381872c --- /dev/null +++ b/.gitignore @@ -0,0 +1,19 @@ +*.abcl +*.fasl +*.dx32fsl +*.dx64fsl +*.lx32fsl +*.lx64fsl +*.x86f +*~ +.#* +.*.sw[a-z] +.slime_paste +/.vagrant/ +\' + +/lighttpd-environment/test-data +/.repl/ros_history + +/.qlot/ +/.bundle-libs/ diff --git a/jfon.asd b/jfon.asd new file mode 100644 index 0000000..70f08d5 --- /dev/null +++ b/jfon.asd @@ -0,0 +1,33 @@ +(defsystem #:skin.djha.jfon + :version "0.1.0" + :author "Daniel Jay Haskin" + :license "MIT" + :depends-on ( + #:com.inuoe.jzon + #:fset + #:trivial-features + #:trivial-package-local-nicknames + ) + :components ((:module "jfon" + :components + ( + (:file "main") + ))) + :description "Port of com.inuoe.jzon to use FSet collections." + :in-order-to ((test-op (test-op "skin.djha.jfon/tests")))) + +(defsystem #:skin.djha.jfon/tests + :version "0.1.0" + :author "Daniel Jay Haskin" + :license "MIT" + :depends-on ( + #:skin.djha.jfon + #:cl-ppcre + #:rove + ) + + :components ((:module "tests" + :components + ((:file "main")))) + :description "Test system for jfon" + :perform (test-op (op c) (symbol-call :rove :run c))) diff --git a/jfon/main.lisp b/jfon/main.lisp new file mode 100644 index 0000000..6091874 --- /dev/null +++ b/jfon/main.lisp @@ -0,0 +1,80 @@ +(in-package #:cl-user) +(defpackage + #:skin.djha.jfon (:use #:cl) + (:documentation + " + JZON for FSets + ") + + (:export + parse + stringify) + (:import-from + #:fset) + (:package-local-nicknames (#:jzon #:com.inuoe.jzon))) +(in-package #:skin.djha.jfon) + +; Write a parser like jzon's `parse` except it outputs FSet maps and seqs. +(defun parse-value (parser event value) + (declare (type jzon:parser parser)) + (ecase event + (:value value) + (:begin-array (parse-array parser)) + (:begin-object (parse-object parser)) + (otherwise (error "Unexpected event: ~A" event)))) + +(defun parse-array (parser) + (declare (type jzon:parser parser)) + (loop with result = (fset:empty-seq) + for event and value + do (setf (values event value) = (jzon:parse-next parser) + while (not (eq event :end-array)) + do + (fset:adjoinf result (parse-value parser event value)) + finally + (return result)))) + +(defun parse-object (parser) + (declare (type jzon:parser parser)) + (loop with result = (fset:empty-seq) + for event and value + do (setf (values event value) (jzon:parse-next parser)) + while (not (eq event :end-array)) + do + ; The event should *always* be `:object-key` at the start of the loop. + (unless (eq event :object-key) + (error "Unexpected event: ~A" event)) + (let ((domain value)) + (multiple-value-bind (ev val) (jzon:parse-next parser) + (fset:adjoinf result domain (parse-value parser ev val)))) + finally + (return result))) + +(defun parse (strm) + " + Parse an input stream into FSet collections. + " + (jzon:with-parser (parser strm) + (multiple-value-bind + (ev val) + (jzon:parse-next parser) + (parse-value parser ev val)))) + +; Write a stringifier like jzon's `stringify` except it takes FSet maps and +; seqs. Basically taken right out of jzon's documentation. +(defun stringify (&key (strm t) (pretty nil)) + (labels ((helper (thing) + (etypecase thing + (jzon:json-atom + (jzon:write-value* thing)) + (fset:seq + (jzon:with-array* + (map nil #'recurse thing))) + (fset:map + (jzon:with-object* + (maphash (lambda (k v) + (jzon:write-key* k) + (helper v)) + thing)))))) + (jzon:with-writer* (:stream strm) (:pretty pretty) + (helper thing)))) diff --git a/tests/main.lisp b/tests/main.lisp new file mode 100644 index 0000000..ae910c1 --- /dev/null +++ b/tests/main.lisp @@ -0,0 +1,291 @@ +#+(or) +(declaim (optimize (speed 0) (space 0) (debug 3))) +(in-package #:cl-user) + +(defpackage #:nrdl/tests + (:use #:cl + #:rove) + (:import-from + #:nrdl)) +(in-package :nrdl/tests) + +(deftest + nested-to-alist + (testing "empty" + (ok (equal nil (nrdl:nested-to-alist nil))) + (ok (equal "" (nrdl:nested-to-alist "")))) + (testing "atomic values" + (ok (equal "hi" (nrdl:nested-to-alist "hi"))) + (ok (equal 15 (nrdl:nested-to-alist 15))) + (ok (equal t (nrdl:nested-to-alist t))) + (ok (equal 'a (nrdl:nested-to-alist 'a))) + (ok (equal :b (nrdl:nested-to-alist :b)))) + (testing "typical invocations" + (ok + (equal + (let + ((a (make-hash-table))) + (setf (gethash 'a a) 1) + (setf (gethash 'b a) 2) + (setf (gethash 'c a) 3) + (nrdl:nested-to-alist + `(1 2 3 (4 5) 6 (7 (8 ,a))))) + '(1 2 3 (4 5) 6 (7 (8 ((A . 1) (B . 2) (C . 3))))))) + (ok (equal + (let ((a (make-hash-table)) + (b (make-hash-table))) + (setf (gethash :origin b) "thither") + (setf (gethash :destination b) "yon") + (setf (gethash 'a a) nil) + (setf (gethash 'b a) b) + (setf (gethash 'c a) '(1 2 3 4 5)) + (nrdl:nested-to-alist a)) + '((A) + (B + (:DESTINATION . "yon") + (:ORIGIN . "thither")) (C 1 2 3 4 5)))))) + +(deftest + parse-tests + (testing "empty" + (ok (signals (with-input-from-string (strm "") + (nrdl:parse-from strm))))) + (testing "simple case" + (ok (equal + '(:a) + (with-input-from-string (strm "[a]") + (nrdl:parse-from strm)) + ))) + (testing "more general case" + (ok (equal + (nrdl:nested-to-alist + (with-input-from-string + (strm + " + # What now brown cow + { + the-wind \"bullseye\" + the-trees false + the-sparrows his-eye + poem + # I don't know if you can hear me + |His eyee + # or if + # you're even there + |is on + # I don't know if you can listen + |The sparrow + ^ + + # to a gypsy's prayer + + this-should-still-work 15.0 + other + |And I know + |He's watching + |Over me + ^ + + force_push + >I sing + >because + >I'm happy + ^ + + \"i am mordac\" true + \"I am web mistress ming\" false + \"you are so wrong\" null + wendover [ + { + so 1 + much -10 + gambling 100 + but 1000 + also -1000 + apparently 10000 + paramedics -10000 + and 1.01 + } + { + die in + a fire + } + 15 + |this + |that + ^ + \"Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor incididunt ut labore et dolore magna aliqua. Ut enim ad minim veniam, quis nostrud exercitation ullamco laboris nisi ut aliquip ex ea commodo consequat. Duis aute irure dolor in reprehenderit in voluptate velit esse cillum dolore eu fugiat nulla pariatur. Excepteur sint occaecat cupidatat non proident, sunt in culpa qui officia deserunt mollit anim id est laborum.\" + ] + } + ") + (nrdl:parse-from strm))) +'((:FORCE_PUSH . "I sing because I'm happy") + ("I am web mistress ming" . nil) + (:OTHER . "And I know +He's watching +Over me") + (:POEM . "His eyee +is on +The sparrow") + (:THE-SPARROWS . :HIS-EYE) (:THE-TREES . nil) (:THE-WIND . "bullseye") + (:THIS-SHOULD-STILL-WORK . 15.0) + (:WENDOVER + ((:ALSO . -1000) (:AND . 1.01) (:APPARENTLY . 10000) (:BUT . 1000) + (:GAMBLING . 100) (:MUCH . -10) (:PARAMEDICS . -10000) (:SO . 1)) + ((:A . :FIRE) (:DIE . :IN)) 15 "this +that" +"Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor incididunt ut labore et dolore magna aliqua. Ut enim ad minim veniam, quis nostrud exercitation ullamco laboris nisi ut aliquip ex ea commodo consequat. Duis aute irure dolor in reprehenderit in voluptate velit esse cillum dolore eu fugiat nulla pariatur. Excepteur sint occaecat cupidatat non proident, sunt in culpa qui officia deserunt mollit anim id est laborum." + ) + ("i am mordac" . T) ("you are so wrong" . cl:null)) +)))) + +(deftest + json-generate-test + (testing "simple example of json" + (ok (equal + (with-output-to-string (strm) + (nrdl:generate-to strm + (alexandria:alist-hash-table + `((:a . 1) + (:b . (:x :y :z)) + (:c . ("food" "for" "thought")) + (:d . cl:null) + (:e . ,nil) + (:f . t) + (:g . 0.87))) + :pretty-indent 4 + :json-mode t)) +"{ + \"a\": 1, + \"b\": [ + \"x\", + \"y\", + \"z\" + ], + \"c\": [ + \"food\", + \"for\", + \"thought\" + ], + \"d\": null, + \"e\": false, + \"f\": true, + \"g\": 0.87 +}")))) + + +(deftest + generate-test + (testing "thorough example" + (let ((sparrow (with-input-from-string + (strm + " + # What now brown cow + { + the-wind \"bullseye\" + the-trees false + the-sparrows his-eye + poem + # I don't know if you can hear me + |His eyee + # or if + # you're even there + |is on + # I don't know if you can listen + |The sparrow + ^ + + # to a gypsy's prayer + + this-should-still-work 15.0 + other + |And I know + |He's watching + |Over me + ^ + + force_push + >I sing + >because + >I'm happy + ^ + + \"i am mordac\" true + \"I am web mistress ming\" false + \"you are so wrong\" null + wendover [ + { + so 1 + much -10 + gambling 100 + but 1000 + also -1000 + apparently 10000 + paramedics -10000 + and 1.01 + } + { + die in + a fire + } + 15 + |this + |that + ^ + \"Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor incididunt ut labore et dolore magna aliqua. Ut enim ad minim veniam, quis nostrud exercitation ullamco laboris nisi ut aliquip ex ea commodo consequat. Duis aute irure dolor in reprehenderit in voluptate velit esse cillum dolore eu fugiat nulla pariatur. Excepteur sint occaecat cupidatat non proident, sunt in culpa qui officia deserunt mollit anim id est laborum.\" + ] + }") + (nrdl:parse-from strm)))) + (ok (equal + (with-output-to-string (strm) + (nrdl:generate-to strm sparrow :pretty-indent 4)) +"{ + force_push \"I sing because I'm happy\" + \"I am web mistress ming\" false + other + |And I know + |He's watching + |Over me + ^ + poem + |His eyee + |is on + |The sparrow + ^ + the-sparrows his-eye + the-trees false + the-wind \"bullseye\" + this-should-still-work 15.0 + wendover [ + { + also -1000 + and 1.01 + apparently 10000 + but 1000 + gambling 100 + much -10 + paramedics -10000 + so 1 + } + { + a fire + die in + } + 15 + |this + |that + ^ + >Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do + >eiusmod tempor incididunt ut labore et dolore magna aliqua. Ut enim ad + >minim veniam, quis nostrud exercitation ullamco laboris nisi ut + >aliquip ex ea commodo consequat. Duis aute irure dolor in + >reprehenderit in voluptate velit esse cillum dolore eu fugiat nulla + >pariatur. Excepteur sint occaecat cupidatat non proident, sunt in + >culpa qui officia deserunt mollit anim id est + >laborum. + ^ + ] + \"i am mordac\" true + \"you are so wrong\" null +}" +))))) -- 2.45.2