jadedctrl/activity-servist
jadedctrl/ activity-servist
1
0
Disbranĉigi 0
Fontkodo Issues Tirpetoj Activity

Minor refactoring; LOOP → DOLIST, etc.

This commit is contained in:
Jaidyn Ann 2024-10-21 04:01:19 -05:00
parent 2d377f5b9b
commit 99fffe1bd2
1 changed files with 21 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

39
src/json-ld.lisp
View File

@ -113,7 +113,9 @@ If you would like to change it on an object-level, set the @CONTEXT slot."))
(cddr (assoc property-name type-def :test #'equal)))))) (cddr (assoc property-name type-def :test #'equal))))))
(let* ((class-name (class-name (class-of obj))) (let* ((class-name (class-name (class-of obj)))
(type-def (cdr (class-json-type-definition class-name))) (type-def (cdr (class-json-type-definition class-name)))
(no-context-p (aliased-prop-p "@context" type-def)) ;; (@context is a special case; we should usually encode it.)
(no-context-p (and (aliased-prop-p "@context" type-def)
(slot-value obj '@context)))
(no-id-p (aliased-prop-p "@id" type-def)) (no-id-p (aliased-prop-p "@id" type-def))
(no-type-p (aliased-prop-p "@type" type-def)) (no-type-p (aliased-prop-p "@type" type-def))
(context (@context obj)) (context (@context obj))
@ -476,19 +478,18 @@ objects, recursively. That is, redundant @CONTEXT-definitions are removed — we
try to concentrate everything in the top-level object’s @CONTEXT slot. try to concentrate everything in the top-level object’s @CONTEXT slot.
This is useful for ensuring the same @CONTEXT doesn’t get output a million times This is useful for ensuring the same @CONTEXT doesn’t get output a million times
during JSON-encoding with YASON:ENCODE." during JSON-encoding with YASON:ENCODE."
(loop for subobj in (cdr (contained-json-objects obj)) (dolist (subobj (cdr (contained-json-objects obj)))
do (progn
(progn (let ((old-context (@context obj))
(let ((old-context (@context obj)) (old-subcontext (@context subobj)))
(old-subcontext (@context subobj))) (when (and old-subcontext
(when (and old-subcontext (not (equal old-context old-subcontext)))
(not (equal old-context old-subcontext))) (setf (slot-value obj '@context)
(setf (slot-value obj '@context) (append (if (listp old-context)
(append (if (listp old-context) old-context
old-context (list old-context))
(list old-context)) old-subcontext))))
old-subcontext)))) (setf (slot-value subobj '@context) 'no-@context))))
(setf (slot-value subobj '@context) 'no-@context))))
(defun json-slot-values (obj) (defun json-slot-values (obj)
"Return the values of all registered slots/properties of a JSON-LD:OBJECT. "Return the values of all registered slots/properties of a JSON-LD:OBJECT.
@ -527,7 +528,9 @@ recursively. Lists, hash-tables, and the slots of JSON-LD:OBJECTs are explored."
(object (append (object (append
(list item) (list item)
(reduce (reduce
(lambda (b c) (lambda (&optional b c)
(or b
(append b c))
(append b c)) (append b c))
(mapcar (lambda (a) (contained-json-objects a)) (mapcar (lambda (a) (contained-json-objects a))
(json-slot-values item))))))) (json-slot-values item)))))))
@ -665,7 +668,7 @@ Returns the first found matching file."
in B. If CLOBBERP is set, pre-existing properties of B will be overwritten." in B. If CLOBBERP is set, pre-existing properties of B will be overwritten."
(let ((a-keys (plist-keys a)) (let ((a-keys (plist-keys a))
(b-keys (plist-keys b))) (b-keys (plist-keys b)))
(loop for key in a-keys (dolist (key a-keys)
do (when (or clobberp (not (find key b-keys))) (when (or clobberp (not (find key b-keys)))
(setf (getf b key) (getf a key)))) (setf (getf b key) (getf a key))))
b)) b))