diff options
| author | ckonstanski <ckonstanski@pippiandcarlos.com> | 2020-12-23 18:40:07 -0700 |
|---|---|---|
| committer | ckonstanski <ckonstanski@pippiandcarlos.com> | 2020-12-23 18:40:07 -0700 |
| commit | 09f21b7abfdbe78a515833760f7567bd23614757 (patch) | |
| tree | d85fd4a5ca71d4ab7fed0b330ad0b9ad71f26fc8 /json/json-utils.lisp | |
| parent | 74da7d1d424e08c8504effe562318ca029eb3a6e (diff) | |
moved json functions to separate library
Diffstat (limited to 'json/json-utils.lisp')
| -rw-r--r-- | json/json-utils.lisp | 72 |
1 files changed, 0 insertions, 72 deletions
diff --git a/json/json-utils.lisp b/json/json-utils.lisp deleted file mode 100644 index 0e0fa12..0000000 --- a/json/json-utils.lisp +++ /dev/null @@ -1,72 +0,0 @@ -;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- -(declaim (optimize (speed 0) (safety 3) (debug 3))) - -(in-package #:ldapadmin) - -(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))))) |
