Fix encoding of aliased @ID, @CONTEXT, and @TYPE
Previously, aliasing them (like ActivityVocab’s ID→@ID) would cause them to get encoded twice.
This commit is contained in:
parent
22ad087a97
commit
8faeb1afd2
|
@ -61,12 +61,10 @@ The method JSON-LD-CONTEXT is how the contents of encoded @context is
|
||||||
determined; to change a class’es default/calculated @context, override that
|
determined; to change a class’es default/calculated @context, override that
|
||||||
method. This slot is for changing a specific object’s @context.")
|
method. This slot is for changing a specific object’s @context.")
|
||||||
(@id
|
(@id
|
||||||
:initform nil
|
|
||||||
:accessor json-ld-id
|
:accessor json-ld-id
|
||||||
:documentation
|
:documentation
|
||||||
"Provides the globally unique identifier for an object.")
|
"Provides the globally unique identifier for an object.")
|
||||||
(@type
|
(@type
|
||||||
:initform nil
|
|
||||||
:accessor json-ld-type
|
:accessor json-ld-type
|
||||||
:documentation
|
:documentation
|
||||||
"Identifies the type of an object. Used to determine the corresponding CLOS-object.")
|
"Identifies the type of an object. Used to determine the corresponding CLOS-object.")
|
||||||
|
@ -101,15 +99,25 @@ If you would like to change it on an object-level, set the @CONTEXT slot."))
|
||||||
|
|
||||||
(defmethod yason:encode-slots progn ((obj json-ld-object))
|
(defmethod yason:encode-slots progn ((obj json-ld-object))
|
||||||
(flatten-contained-contexts obj)
|
(flatten-contained-contexts obj)
|
||||||
(let ((context (json-ld-context obj))
|
;; We only want to encode @context, @id, and @type if the child class doesn’t
|
||||||
(id (json-ld-id obj))
|
;; have its own alias for them.
|
||||||
(type (json-ld-type obj)))
|
(flet ((aliased-prop-p (property-name type-def)
|
||||||
(when context
|
(not (equal property-name
|
||||||
(yason:encode-object-element "@context" (json-ld-context obj)))
|
(cddr (assoc property-name type-def :test #'equal))))))
|
||||||
(when id
|
(let* ((class-name (class-name (class-of obj)))
|
||||||
(yason:encode-object-element "@id" (json-ld-id obj)))
|
(type-def (cdr (class-json-type-definition class-name)))
|
||||||
(when type
|
(no-context-p (aliased-prop-p "@context" type-def))
|
||||||
(yason:encode-object-element "@type" (json-ld-type obj))))
|
(no-id-p (aliased-prop-p "@id" type-def))
|
||||||
|
(no-type-p (aliased-prop-p "@type" type-def))
|
||||||
|
(context (json-ld-context obj))
|
||||||
|
(id (and (slot-boundp obj '@id) (json-ld-id obj)))
|
||||||
|
(type (and (slot-boundp obj '@type) (json-ld-type obj))))
|
||||||
|
(when (and context (not no-context-p))
|
||||||
|
(yason:encode-object-element "@context" context))
|
||||||
|
(when (and id (not no-id-p))
|
||||||
|
(yason:encode-object-element "@id" id))
|
||||||
|
(when (and type (not no-type-p))
|
||||||
|
(yason:encode-object-element "@type" type))))
|
||||||
(mapcar (lambda (alist-cell)
|
(mapcar (lambda (alist-cell)
|
||||||
(yason:encode-object-element (car alist-cell)
|
(yason:encode-object-element (car alist-cell)
|
||||||
(cdr alist-cell)))
|
(cdr alist-cell)))
|
||||||
|
@ -269,6 +277,7 @@ corresponding CLOS class) of a node."
|
||||||
(TYPE-IRI (PROPERTY-NAME SLOT-NAME) ⋯ (PROPERTY-NAME SLOT-NAME))
|
(TYPE-IRI (PROPERTY-NAME SLOT-NAME) ⋯ (PROPERTY-NAME SLOT-NAME))
|
||||||
… where TYPE-IRI is the (hopefully) fully-resolved IRI form of the node-type’s
|
… where TYPE-IRI is the (hopefully) fully-resolved IRI form of the node-type’s
|
||||||
name, though it might be unresolved if context was unprovided or lacking."
|
name, though it might be unresolved if context was unprovided or lacking."
|
||||||
|
(remove-duplicates
|
||||||
(append
|
(append
|
||||||
;; The class-name and type-name.
|
;; The class-name and type-name.
|
||||||
(list (cons (car names) (cadr names)))
|
(list (cons (car names) (cadr names)))
|
||||||
|
@ -290,10 +299,14 @@ name, though it might be unresolved if context was unprovided or lacking."
|
||||||
(let* ((type-def (class-json-type-definition class-name)))
|
(let* ((type-def (class-json-type-definition class-name)))
|
||||||
(when type-def
|
(when type-def
|
||||||
(cdr type-def))))
|
(cdr type-def))))
|
||||||
direct-superclasses))))
|
direct-superclasses)))
|
||||||
|
:test (lambda (a b) (equal (car a) (car b)))
|
||||||
|
:from-end 't))
|
||||||
|
|
||||||
(defun parse (str)
|
(defun parse (str &optional always-object)
|
||||||
"Parse the JSON-LD document contained in STR."
|
"Parse the JSON-LD document contained in STR.
|
||||||
|
If ALWAYS-OBJECT is non-nil, even invalid JSON-LD objects (which would normally be
|
||||||
|
parsed into hash-tables) will be parsed into CLOS objects."
|
||||||
(let ((ctx (make-hash-table :test #'equal)) ; Parsed context
|
(let ((ctx (make-hash-table :test #'equal)) ; Parsed context
|
||||||
(parsed (yason:parse str)))
|
(parsed (yason:parse str)))
|
||||||
(values (parse-item parsed ctx)
|
(values (parse-item parsed ctx)
|
||||||
|
|
Ŝarĝante…
Reference in New Issue