From 486d23f9f56b2f68a75dd0938db41e3168290e3a Mon Sep 17 00:00:00 2001 From: Daniel Jay Haskin Date: Sat, 21 Oct 2023 15:01:37 -0600 Subject: [PATCH] Whatever, it works. --- skin.djha.jfon.asd | 2 +- src/main.lisp | 29 ++-- tests/main.lisp | 414 ++++++++++++++++----------------------------- 3 files changed, 166 insertions(+), 279 deletions(-) diff --git a/skin.djha.jfon.asd b/skin.djha.jfon.asd index 5954786..d053148 100644 --- a/skin.djha.jfon.asd +++ b/skin.djha.jfon.asd @@ -16,7 +16,7 @@ :description "Port of com.inuoe.jzon to use FSet collections." :in-order-to ((test-op (test-op #:skin.djha.jfon/tests)))) -(defsystem #:jfon/tests +(defsystem #:skin.djha.jfon/tests :version "0.1.0" :author "Daniel Jay Haskin" :license "MIT" diff --git a/src/main.lisp b/src/main.lisp index 06233e4..be6de0e 100644 --- a/src/main.lisp +++ b/src/main.lisp @@ -28,17 +28,17 @@ do (setf (values event value) (jzon:parse-next parser)) while (not (eq event :end-array)) do - (fset:adjoinf result (parse-value parser event value)) + (fset:push-last result (parse-value parser event value)) finally (return result))) (defun parse-object (parser) ;(declare (type jzon:parser parser)) - (loop with result = (fset:empty-seq) + (loop with result = (fset:empty-map) and event and value do (setf (values event value) (jzon:parse-next parser)) - while (not (eq event :end-array)) + while (not (eq event :end-object)) do ; The event should *always* be `:object-key` at the start of the loop. (unless (eq event :object-key) @@ -51,17 +51,22 @@ (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)))) + Parse an input stream into FSet collections. + " + (jzon:with-parser (parser strm) + (let ((value (multiple-value-bind + (ev val) + (jzon:parse-next parser) + (parse-value parser ev val)))) + (let ((ev (jzon:parse-next parser))) + (unless (null ev) + (error "Unexpected event: ~A" ev))) + value))) + ; 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)) +(defun stringify (thing &key (strm t) (pretty nil)) (labels ((helper (thing) (etypecase thing (jzon:json-atom @@ -75,5 +80,5 @@ (fset:do-map (k v thing) (jzon:write-key* k) (helper v))))))) - (jzon:with-writer* (:stream strm) (:pretty pretty) + (jzon:with-writer* (:stream strm :pretty pretty) (helper thing)))) diff --git a/tests/main.lisp b/tests/main.lisp index ae910c1..d325f37 100644 --- a/tests/main.lisp +++ b/tests/main.lisp @@ -1,291 +1,173 @@ -#+(or) (declaim (optimize (speed 0) (space 0) (debug 3))) (in-package #:cl-user) - -(defpackage #:nrdl/tests +(defpackage #:skin.djha.jfon/tests (:use #:cl #:rove) - (:import-from - #:nrdl)) -(in-package :nrdl/tests) + (:local-nicknames + (#:jfon #:skin.djha.jfon) + (#:jzon #:com.inuoe.jzon))) +(in-package #:skin.djha.jfon/tests) +(fset:fset-setup-readtable *readtable*) -(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)))))) +(defun nested-to-alist + (value) + " + Recursively changes value, converting all hash tables within the tree to an + alist. Makes testing easier. + " + (cond + ((stringp value) value) + ((or (vectorp value) (listp value)) + (map 'list #'nested-to-alist value)) + ((hash-table-p value) + (let ((coll + (loop for k being the hash-key of value + using (hash-value v) + collect (cons k (nested-to-alist v))))) + (stable-sort coll #'string< :key (lambda (thing) + (format nil "~A" (car thing)))))) + (t + value))) (deftest parse-tests (testing "empty" (ok (signals (with-input-from-string (strm "") - (nrdl:parse-from strm))))) + (jfon:parse strm))))) (testing "simple case" - (ok (equal - '(:a) - (with-input-from-string (strm "[a]") - (nrdl:parse-from strm)) + (ok (fset:equal? + #[ "a" ] + (with-input-from-string (strm "[\"a\"]") + (jfon:parse strm)) ))) + (testing "more general case" - (ok (equal - (nrdl:nested-to-alist + (ok (fset:equal? (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.\" - ] + \"the-wind\": \"bullseye\", + \"the-trees\": false, + \"the-sparrows\": \"his-eye\", + \"poem\": \"His eye is on the sparrow\", + \"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, + \"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\" + ] } ") - (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)) -)))) + (jfon:parse strm)) -(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 -}")))) + #{| + ("poem" "His eye is on the sparrow") + ("other" "And I know He's watching over me") + ("the-wind" "bullseye") + ("wendover" + #[ + #{| + ("so" 1) + ("and" 1.01d0) + ("but" 1000) + ("also" -1000) + ("much" -10) + ("gambling" 100) + ("apparently" 10000) + ("paramedics" -10000) |} + #{| ("a" "fire") ("die" "in") |} + 15 + "this that" ]) + ("the-trees" NIL) + ("force_push" "I sing because I'm happy") + ("i am mordac" T) + ("the-sparrows" "his-eye") + ("you are so wrong" 'CL:NULL) + ("this-should-still-work" 15.0d0) |})))) (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 - ^ + stringify-tests + (testing "empty" + (ok (equal + "false" + (with-output-to-string (strm) + (jfon:stringify nil :strm strm))))) + (testing "general case" + (ok (equal + "{ + \"poem\": \"His eye is on the sparrow\", + \"other\": \"And I know He's watching over me\", + \"the-wind\": \"bullseye\", + \"wendover\": [ + { + \"so\": 1, + \"and\": 1.01, + \"but\": 1000, + \"also\": -1000, + \"much\": -10, + \"gambling\": 100, + \"apparently\": 10000, + \"paramedics\": -10000 + }, + { + \"a\": \"fire\", + \"die\": \"in\" + }, + 15, + \"this that\" + ], + \"the-trees\": false, + \"force_push\": \"I sing because I'm happy\", + \"i am mordac\": true, + \"the-sparrows\": \"his-eye\", + \"you are so wrong\": null, + \"this-should-still-work\": 15.0 +}" + (with-output-to-string (strm) + (jfon:stringify + #{| + ("poem" "His eye is on the sparrow") + ("other" "And I know He's watching over me") + ("the-wind" "bullseye") + ("wendover" + #[ + #{| + ("so" 1) + ("and" 1.01d0) + ("but" 1000) + ("also" -1000) + ("much" -10) + ("gambling" 100) + ("apparently" 10000) + ("paramedics" -10000) |} + #{| ("a" "fire") ("die" "in") |} + 15 + "this that" ]) + ("the-trees" NIL) + ("force_push" "I sing because I'm happy") + ("i am mordac" T) + ("the-sparrows" "his-eye") + ("you are so wrong" 'CL:NULL) + ("this-should-still-work" 15.0d0) |} + :strm strm :pretty t)))))) - 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