diff options
| -rw-r--r-- | org-ckons-json.asd | 35 | ||||
| -rw-r--r-- | src/json.lisp | 75 |
2 files changed, 110 insertions, 0 deletions
diff --git a/org-ckons-json.asd b/org-ckons-json.asd new file mode 100644 index 0000000..0b19007 --- /dev/null +++ b/org-ckons-json.asd @@ -0,0 +1,35 @@ +;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- +(declaim (optimize (speed 0) (safety 3) (debug 3))) + +(in-package #:cl) + +(defpackage #:org-ckons-json-system (:use #:cl #:asdf)) +(in-package #:org-ckons-json-system) + +(defmacro do-defsystem (&key name version maintainer author description long-description depends-on components) + `(defsystem ,name + :name ,name + :version ,version + :maintainer ,maintainer + :author ,author + :description ,description + :long-description ,long-description + :depends-on ,(eval depends-on) + :components ,components)) + +(defparameter *quicklisp-packages* '(cl-json)) +(defparameter *asdf-packages* '(org-ckons-core)) +(defparameter *all-packages* (append *quicklisp-packages* *asdf-packages*)) + +(loop for pkg in *quicklisp-packages* do + (ql:quickload (symbol-name pkg))) + +(do-defsystem :name "org-ckons-json" + :version "1" + :maintainer "Carlos Konstanski <me@ckons.org>" + :author "Carlos Konstanski <me@ckons.org>" + :description "org-ckons-json" + :long-description "org-ckons-json is a library which provides JSON serialization and deserialization." + :depends-on *all-packages* + :components ((:module src + :components ((:file "json"))))) diff --git a/src/json.lisp b/src/json.lisp new file mode 100644 index 0000000..d7e550b --- /dev/null +++ b/src/json.lisp @@ -0,0 +1,75 @@ +;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- +(declaim (optimize (speed 0) (safety 3) (debug 3))) + +(defpackage :org-ckons-json + (:use :cl)) + +(in-package #:org-ckons-json) + +(defun json-to-object (object-type json-obj) + (remove-if-not (lambda (x) + (let ((found-value nil)) + (loop for slot in (org-ckons-core::map-slot-names x) do + (when (slot-value x slot) + (setf found-value t))) + found-value)) + (mapcar (lambda (obj) + (let ((object (make-instance object-type))) + (loop for slot in (org-ckons-core::map-slot-names object) do + (let ((symb (intern (symbol-name slot) :keyword))) + (setf (slot-value object slot) + (cdr (find-if (lambda (param) (eq (car param) symb)) obj))))) + object)) + json-obj))) + +(defun objects-to-json (list-of-objects &optional (explicit-encoder-p nil)) + (labels ((objectp (object) + (not (eq () (remove-if 'null (mapcar (lambda (superclass) + (eq (class-name superclass) 'base-service)) + (sb-mop:class-direct-superclasses (class-of object))))))) + (list-of-lists-p (object) + (and (listp object) + (find-if (lambda (y) (not (null y))) + (mapcar (lambda (x) + (listp x)) + object)))) + (list-of-objects-p (object) + (and (listp object) + (find-if (lambda (y) (not (null y))) + (mapcar (lambda (x) + (objectp x)) + object)))) + (map-slots (object) + (remove-if 'null (mapcar (lambda (slot) + (let ((symb (intern (symbol-name slot) :keyword)) + (value (slot-value object slot))) + (when value + (cons symb (cond ((or (equal value (json:json-bool t)) + (equal value (json:json-bool nil))) + value) + ((list-of-lists-p value) + (listify value)) + ((list-of-objects-p value) + (if explicit-encoder-p + (error "Can't do list-of-objects with the explicit encoder.") + (listify value))) + ((listp value) + (map 'vector #'identity value)) + ((objectp value) + (if explicit-encoder-p + (cons :object (map-slots value)) + (map-slots value))) + (t + value)))))) + (org-ckons-core::map-slot-names object)))) + (listify (list-of-objects) + (mapcar (lambda (object) + (map-slots object)) + list-of-objects))) + (let ((listobj (listify list-of-objects))) + (org-ckons-core::reduce-to-comma-separated-string (mapcar (lambda (alist) + (if explicit-encoder-p + (json:with-explicit-encoder + (json:encode-json-to-string (cons :object alist))) + (json:encode-json-alist-to-string alist))) + listobj))))) |