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

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:
Jaidyn Ann 2024-09-05 12:09:56 -05:00
parent 4905c0be95
commit f98b5d81a9
3 changed files with 41 additions and 41 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
src/activity-vocabulary.lisp
View File

@ -46,7 +46,7 @@
(defmacro define-json-empty-types (superclasses context &rest direct-children) (defmacro define-json-empty-types (superclasses context &rest direct-children)
"For each list of DIRECT-CHILDREN, a “hollow” JSON subtype and CLOS subclass "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 These new subclasses have no slots of its own — they will be empty derivatives
of SUPERCLASSES. of SUPERCLASSES.

70
src/json-ld.lisp
View File

@ -25,8 +25,8 @@
#:no-@context #:no-@context
;; Globals ;; Globals
#:*default-json-type* #:*default-json-type*
;; Objects ;; Classes
#:json-ld-object #:object
;; Slots/Accessors ;; Slots/Accessors
:@context :@id :@type :@etc)) :@context :@id :@type :@etc))
@ -40,7 +40,7 @@
of this type. Should be a string, the IRI corresponding to a registered type. of this type. Should be a string, the IRI corresponding to a registered type.
For example: “https://www.w3.org/ns/activitystreams#Object” 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) (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. "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 ;;; Base class
;;; ———————————————————————————————————————— ;;; ————————————————————————————————————————
(defclass json-ld-object () (defclass object ()
((@context ((@context
:initform nil :initform nil
:documentation :documentation
@ -85,7 +85,7 @@ slot. This is often filled up in the case of undefined node-types or non-adheren
object definitions."))) object definitions.")))
(setf (gethash "*" *json-types*) (setf (gethash "*" *json-types*)
'((json-ld-object) '((object)
("@context" @context . "@context") ("@context" @context . "@context")
("@id" @id . "@id") ("@id" @id . "@id")
("@type" @type . "@type"))) ("@type" @type . "@type")))
@ -94,18 +94,18 @@ object definitions.")))
(:documentation (:documentation
"Returns a JSON-LD CLOS object’s @context, for use in JSON-encoding of the "Returns a JSON-LD CLOS object’s @context, for use in JSON-encoding of the
object. 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. URL.
If you would like to change @context on a class-level, override this method. 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.")) 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))) (let ((slot-@context (slot-value obj '@context)))
(unless (eq slot-@context 'no-@context) (unless (eq slot-@context 'no-@context)
(or slot-@context (or slot-@context
"https://www.w3.org/ns/activitystreams")))) "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) (flatten-contained-contexts obj)
;; We only want to encode @context, @id, and @type if the child class doesn’t ;; We only want to encode @context, @id, and @type if the child class doesn’t
;; have its own alias for them. ;; 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))) (cdr alist-cell)))
(@etc obj))) (@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:with-output (stream)
(yason:encode-object obj))) (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. not be encoded for this object.
DIRECT-SUPERCLASSES is a list of JSON-LD CLOS classes, whose slots and context 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, 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 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 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… ;; Now, actually define the class, encoder, etc…
`(let ((json-class `(let ((json-class
(define-json-clos-class ,names (define-json-clos-class ,names
,(or direct-superclasses `(json-ld-object)) ,(or direct-superclasses `(json-ld:object))
,direct-slots ,direct-slots
,options))) ,options)))
(define-json-type-encoder ,(car names) ,direct-slots) (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))) json-class)))
(defmacro define-json-clos-class (names direct-superclasses direct-slots options) (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)))) (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.
Unregistered slots that don’t get encoded/decoded are ignored." Unregistered slots that don’t get encoded/decoded are ignored."
(let* ((type-def (class-json-type-definition (class-name (class-of obj)))) (let* ((type-def (class-json-type-definition (class-name (class-of obj))))
(slot-defs (cdr type-def))) (slot-defs (cdr type-def)))
@ -529,28 +529,28 @@ Unregistered slots that don’t get encoded/decoded are ignored."
(slot-value obj '@etc)))))) (slot-value obj '@etc))))))
(defun contained-json-objects (item) (defun contained-json-objects (item)
"Given ITEM of arbitrary type, return all JSON-LD-OBJECTs contained within, "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." recursively. Lists, hash-tables, and the slots of JSON-LD:OBJECTs are explored."
(typecase item (typecase item
(cons (reduce (cons (reduce
(lambda (a b) (lambda (a b)
(append a b)) (append a b))
(mapcar (lambda (a) (contained-json-objects a)) (mapcar (lambda (a) (contained-json-objects a))
item))) item)))
(hash-table (let ((ret '())) (hash-table (let ((ret '()))
(maphash (maphash
(lambda (k v) (lambda (k v)
(setq ret (setq ret
(append ret (contained-json-objects v)))) (append ret (contained-json-objects v))))
item) item)
ret)) ret))
(json-ld-object (append (object (append
(list item) (list item)
(reduce (reduce
(lambda (b c) (lambda (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)))))))

10
src/litepub.lisp
View File

@ -35,7 +35,7 @@
;;; ———————————————————————————————————————— ;;; ————————————————————————————————————————
(defvar *litepub-uri* "https://jam.xwx.moe/schemas/litepub-0.1.jsonld" (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 "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. @CONTEXT.
Defaults to a copy at jam.xwx.moe — because why not? ¯\_(ツ)_/¯") 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 ;;; Core types
;;; ———————————————————————————————————————— ;;; ————————————————————————————————————————
(defclass litepub-object () (defclass object ()
() ()
(:documentation "The base class used for Litepub objects.")) (: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 ((atom-uri
"atomUri" "atomUri"
:documentation "A string containing a URI to an Atom-feed alternative representation of an object. :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 ;; https://schema.org/PropertyValue
(json-ld:define-json-type (property-value "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 (;; https://schema.org/value
(value (value
"value" "value"
@ -196,6 +196,6 @@ In case of doubt, QUOTE-URL is preferred."))
;;; Extended Link types ;;; Extended Link types
;;; ———————————————————————————————————————— ;;; ————————————————————————————————————————
;; https://docs.joinmastodon.org/spec/activitypub/#Hashtag ;; 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).")) (: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)."))