Rename JSON-LD-OBJECT & LITEPUB-OBJECT
JSON-LD:JSON-LD-OBJECT → JSON-LD:OBJECT and LITEPUB:LITEPUB-OBJECT → LITEPUB:OBJECT More succinct, no?
This commit is contained in:
parent
4905c0be95
commit
f98b5d81a9
|
|
@ -46,7 +46,7 @@
|
|||
|
||||
(defmacro define-json-empty-types (superclasses context &rest direct-children)
|
||||
"For each list of DIRECT-CHILDREN, a “hollow” JSON subtype and CLOS subclass
|
||||
ofE SUPERCLASSES will be created, with the given JSON-LD context CONTEXT.
|
||||
ofE SUPERCLASSES will be created, with the given JSON-LD context @CONTEXT.
|
||||
These new subclasses have no slots of its own — they will be empty derivatives
|
||||
of SUPERCLASSES.
|
||||
|
||||
|
|
|
|||
|
|
@ -25,8 +25,8 @@
|
|||
#:no-@context
|
||||
;; Globals
|
||||
#:*default-json-type*
|
||||
;; Objects
|
||||
#:json-ld-object
|
||||
;; Classes
|
||||
#:object
|
||||
;; Slots/Accessors
|
||||
:@context :@id :@type :@etc))
|
||||
|
||||
|
|
@ -40,7 +40,7 @@
|
|||
of this type. Should be a string, the IRI corresponding to a registered type.
|
||||
For example: “https://www.w3.org/ns/activitystreams#Object”
|
||||
|
||||
The default value “*” refers to the base JSON-LD-OBJECT type.")
|
||||
The default value “*” refers to the base JSON-LD:OBJECT type.")
|
||||
|
||||
(defvar *json-types* (make-hash-table :test #'equal)
|
||||
"Stores descriptions of each JSON-type, mapping type-IRI to class-name and property-name to slot-name.
|
||||
|
|
@ -60,7 +60,7 @@ Maps URLs to text-content, so we don’t have to download the same context again
|
|||
|
||||
;;; Base class
|
||||
;;; ————————————————————————————————————————
|
||||
(defclass json-ld-object ()
|
||||
(defclass object ()
|
||||
((@context
|
||||
:initform nil
|
||||
:documentation
|
||||
|
|
@ -85,7 +85,7 @@ slot. This is often filled up in the case of undefined node-types or non-adheren
|
|||
object definitions.")))
|
||||
|
||||
(setf (gethash "*" *json-types*)
|
||||
'((json-ld-object)
|
||||
'((object)
|
||||
("@context" @context . "@context")
|
||||
("@id" @id . "@id")
|
||||
("@type" @type . "@type")))
|
||||
|
|
@ -94,18 +94,18 @@ object definitions.")))
|
|||
(:documentation
|
||||
"Returns a JSON-LD CLOS object’s @context, for use in JSON-encoding of the
|
||||
object.
|
||||
The implementation for the JSON-LD-OBJECT class simply returns the activitystreams
|
||||
The implementation for the JSON-LD:OBJECT class simply returns the activitystreams
|
||||
URL.
|
||||
If you would like to change @context on a class-level, override this method.
|
||||
If you would like to change it on an object-level, set the @CONTEXT slot."))
|
||||
|
||||
(defmethod @context ((obj json-ld-object))
|
||||
(defmethod @context ((obj object))
|
||||
(let ((slot-@context (slot-value obj '@context)))
|
||||
(unless (eq slot-@context 'no-@context)
|
||||
(or slot-@context
|
||||
"https://www.w3.org/ns/activitystreams"))))
|
||||
|
||||
(defmethod yason:encode-slots progn ((obj json-ld-object))
|
||||
(defmethod yason:encode-slots progn ((obj object))
|
||||
(flatten-contained-contexts obj)
|
||||
;; We only want to encode @context, @id, and @type if the child class doesn’t
|
||||
;; have its own alias for them.
|
||||
|
|
@ -131,7 +131,7 @@ If you would like to change it on an object-level, set the @CONTEXT slot."))
|
|||
(cdr alist-cell)))
|
||||
(@etc obj)))
|
||||
|
||||
(defmethod yason:encode ((obj json-ld-object) &optional (stream *standard-output))
|
||||
(defmethod yason:encode ((obj object) &optional (stream *standard-output))
|
||||
(yason:with-output (stream)
|
||||
(yason:encode-object obj)))
|
||||
|
||||
|
|
@ -150,9 +150,9 @@ encoding as @type’s value. If only the CLOS class-name is provided, @type will
|
|||
not be encoded for this object.
|
||||
|
||||
DIRECT-SUPERCLASSES is a list of JSON-LD CLOS classes, whose slots and context
|
||||
this should inherit. JSON-LD-OBJECT should be somewhere in the hierarchy, in order
|
||||
this should inherit. JSON-LD:OBJECT should be somewhere in the hierarchy, in order
|
||||
to provide “@context”, “@id”, and “@type”; if no superclasses are provided,
|
||||
JSON-LD-OBJECT is default.
|
||||
JSON-LD:OBJECT is default.
|
||||
|
||||
CONTEXT is a context hash-table, parsed from a JSON-LD context by JSON-LD:PARSE
|
||||
or JSON-LD:PARSE-CONTEXT. Any terms defined in this context will be used to
|
||||
|
|
@ -202,11 +202,11 @@ Here is a brief example partially defining the “Place” type from ActivityStr
|
|||
;; Now, actually define the class, encoder, etc…
|
||||
`(let ((json-class
|
||||
(define-json-clos-class ,names
|
||||
,(or direct-superclasses `(json-ld-object))
|
||||
,(or direct-superclasses `(json-ld:object))
|
||||
,direct-slots
|
||||
,options)))
|
||||
(define-json-type-encoder ,(car names) ,direct-slots)
|
||||
(register-json-type ',names (or ',direct-superclasses '(json-ld-object)) ',direct-slots ,context)
|
||||
(register-json-type ',names (or ',direct-superclasses '(json-ld:object)) ',direct-slots ,context)
|
||||
json-class)))
|
||||
|
||||
(defmacro define-json-clos-class (names direct-superclasses direct-slots options)
|
||||
|
|
@ -511,7 +511,7 @@ during JSON-encoding with YASON:ENCODE."
|
|||
(setf (slot-value subobj '@context) 'no-@context))))
|
||||
|
||||
(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.
|
||||
Unregistered slots that don’t get encoded/decoded are ignored."
|
||||
(let* ((type-def (class-json-type-definition (class-name (class-of obj))))
|
||||
(slot-defs (cdr type-def)))
|
||||
|
|
@ -529,28 +529,28 @@ Unregistered slots that don’t get encoded/decoded are ignored."
|
|||
(slot-value obj '@etc))))))
|
||||
|
||||
(defun contained-json-objects (item)
|
||||
"Given ITEM of arbitrary type, return all JSON-LD-OBJECTs contained within,
|
||||
recursively. Lists, hash-tables, and the slots of JSON-LD-OBJECTs are explored."
|
||||
"Given ITEM of arbitrary type, return all JSON-LD:OBJECTs contained within,
|
||||
recursively. Lists, hash-tables, and the slots of JSON-LD:OBJECTs are explored."
|
||||
(typecase item
|
||||
(cons (reduce
|
||||
(lambda (a b)
|
||||
(append a b))
|
||||
(mapcar (lambda (a) (contained-json-objects a))
|
||||
item)))
|
||||
(hash-table (let ((ret '()))
|
||||
(maphash
|
||||
(lambda (k v)
|
||||
(setq ret
|
||||
(append ret (contained-json-objects v))))
|
||||
item)
|
||||
ret))
|
||||
(json-ld-object (append
|
||||
(list item)
|
||||
(reduce
|
||||
(lambda (b c)
|
||||
(append b c))
|
||||
(mapcar (lambda (a) (contained-json-objects a))
|
||||
(json-slot-values item)))))))
|
||||
(cons (reduce
|
||||
(lambda (a b)
|
||||
(append a b))
|
||||
(mapcar (lambda (a) (contained-json-objects a))
|
||||
item)))
|
||||
(hash-table (let ((ret '()))
|
||||
(maphash
|
||||
(lambda (k v)
|
||||
(setq ret
|
||||
(append ret (contained-json-objects v))))
|
||||
item)
|
||||
ret))
|
||||
(object (append
|
||||
(list item)
|
||||
(reduce
|
||||
(lambda (b c)
|
||||
(append b c))
|
||||
(mapcar (lambda (a) (contained-json-objects a))
|
||||
(json-slot-values item)))))))
|
||||
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -35,7 +35,7 @@
|
|||
;;; ————————————————————————————————————————
|
||||
(defvar *litepub-uri* "https://jam.xwx.moe/schemas/litepub-0.1.jsonld"
|
||||
"The “Litepub” flavour we use is nicked directly from Pleroma; there is not a
|
||||
canonical URL for it. This URI will be used in encoded LITEPUB-OBJECTs in the
|
||||
canonical URL for it. This URI will be used in encoded LITEPUB:OBJECTs in the
|
||||
@CONTEXT.
|
||||
Defaults to a copy at jam.xwx.moe — because why not? ¯\_(ツ)_/¯")
|
||||
|
||||
|
|
@ -43,11 +43,11 @@ Defaults to a copy at jam.xwx.moe — because why not? ¯\_(ツ)_/¯")
|
|||
|
||||
;;; Core types
|
||||
;;; ————————————————————————————————————————
|
||||
(defclass litepub-object ()
|
||||
(defclass object ()
|
||||
()
|
||||
(:documentation "The base class used for Litepub objects."))
|
||||
|
||||
(json-ld:define-json-type (as/v/a:object "Object") (as/jld::json-ld-object litepub-object) *litepub-uri*
|
||||
(json-ld:define-json-type (as/v/a:object "Object") (as/jld:object litepub:object) *litepub-uri*
|
||||
((atom-uri
|
||||
"atomUri"
|
||||
:documentation "A string containing a URI to an Atom-feed alternative representation of an object.
|
||||
|
|
@ -109,7 +109,7 @@ Potentially deprecated/very uncommon.")
|
|||
|
||||
;; https://schema.org/PropertyValue
|
||||
(json-ld:define-json-type (property-value "PropertyValue")
|
||||
(litepub-object json-ld:json-ld-object) *litepub-uri*
|
||||
(litepub:object json-ld:object) *litepub-uri*
|
||||
(;; https://schema.org/value
|
||||
(value
|
||||
"value"
|
||||
|
|
@ -196,6 +196,6 @@ In case of doubt, QUOTE-URL is preferred."))
|
|||
;;; Extended Link types
|
||||
;;; ————————————————————————————————————————
|
||||
;; https://docs.joinmastodon.org/spec/activitypub/#Hashtag
|
||||
(json-ld:define-json-type (hashtag "Hashtag") (as/v/a:link litepub-object) *litepub-uri*
|
||||
(json-ld:define-json-type (hashtag "Hashtag") (as/v/a:link litepub:object) *litepub-uri*
|
||||
()
|
||||
(:documentation "Similar to Mentions, a Hashtag is used to link a post to given topics. Should be stored in a TAG slot, and contain NAME (#hashtag) and HREF (link to a server’s hashtag listing)."))
|
||||
|
|
|
|||
Ŝarĝante…
Reference in New Issue