A => .gitattributes +17 -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
A => .gitignore +19 -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/
A => jfon.asd +33 -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)))
A => jfon/main.lisp +80 -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))))
A => tests/main.lisp +291 -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
+}"
+)))))