Remove :UPDATE parameter from DEFINE-JSON-TYPE
It was… a bit messy on accessors. That’s more headache than it’s worth, and it can be argued that messing with the hierarchy like that was less than preferable. The LitePub classes have been redefined accordingly as subclasses.
This commit is contained in:
parent
06de0e0191
commit
e0341343db
|
|
@ -48,10 +48,6 @@ Used during encoding an object to JSON, for finding type/property-names from cla
|
|||
Keys are the type-IRI (e.g., (“https://www.w3.org/ns/activitystreams#Accept”), and values are an irregular association list, of the form:
|
||||
((CLASS-NAME-SYMBOL . TYPE-NAME) (PROPERTY-IRI SLOT-NAME-SYMBOL . PROPERTY-NAME) ⋯)")
|
||||
|
||||
(defvar *class-defs* (make-hash-table)
|
||||
"Stores the slot definitions of classes, stored directly from DEFINE-JSON-TYPE.
|
||||
Used for the :UPDATE feature of DEFINE-JSON-TYPE, so you can add a slot to a pre-existing class without having to redefine the old slots.")
|
||||
|
||||
(defvar *http-cache* (make-hash-table :test #'equal)
|
||||
"Caches context-texts fetched over HTTP.
|
||||
Maps URLs to text-content, so we don’t have to download the same context again and again.")
|
||||
|
|
@ -176,14 +172,7 @@ By default, a slot will have an accessor simply named after the slot.
|
|||
Set :ACCESSOR to NIL to define no accessor at all.
|
||||
|
||||
OPTIONS contains ordinary class options, in the format of DEFCLASS (for example,
|
||||
:DOCUMENTATION), with one exception: The :UPDATE option.
|
||||
|
||||
If the :UPDATE class option is non-nil, then DIRECT-SLOTS will be considered an
|
||||
“update” to the class, and will be appended to any direct-slots defined during
|
||||
previous definitions of that class done with DEFINE-JSON-TYPE.
|
||||
This is for convenience, so that one doesn’t have to copy an entire class
|
||||
defintion over in order to add one or two slots (which is a common occurance
|
||||
in the ActivityPub landscape).
|
||||
:DOCUMENTATION).
|
||||
|
||||
Here is a brief example partially defining the “Place” type from ActivityStreams:
|
||||
|
||||
|
|
@ -194,15 +183,6 @@ Here is a brief example partially defining the “Place” type from ActivityStr
|
|||
:documentation “The latitude of a place.”)
|
||||
(longitude “longitude”
|
||||
:documentation “The longitude of a place.”)))"
|
||||
;; If the definition is an :UPDATE, remove that from OPTIONS and merge the old
|
||||
;; slots with the new.
|
||||
(let ((direct-slots
|
||||
(if (assoc :update options)
|
||||
(progn (setf options (remove-from-alist :update options))
|
||||
(merge-alists direct-slots
|
||||
(gethash (car names) *class-defs*) 't))
|
||||
direct-slots)))
|
||||
;; Now, actually define the class, encoder, etc…
|
||||
`(let ((json-class
|
||||
(define-json-clos-class ,names
|
||||
,(or direct-superclasses `(json-ld:object))
|
||||
|
|
@ -210,7 +190,7 @@ Here is a brief example partially defining the “Place” type from ActivityStr
|
|||
,options)))
|
||||
(define-json-type-encoder ,(car names) ,direct-slots)
|
||||
(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)
|
||||
"Helper-macro for DEFINE-JSON-TYPE.
|
||||
|
|
@ -275,10 +255,7 @@ corresponding CLOS class) of a node."
|
|||
(let* ((ctx (parse-context context))
|
||||
(type-iri (getf (gethash (cadr names) ctx) :id))
|
||||
(type-name (or type-iri (cadr names))))
|
||||
;; Save the type’s direct-slots, in case of future :UPDATEs.
|
||||
(setf (gethash (car names) *class-defs*)
|
||||
direct-slots)
|
||||
;; Now actually save the JSON-type.
|
||||
;; Save the JSON-type.
|
||||
(setf (gethash type-name *json-types*)
|
||||
(json-type-registry-list names direct-superclasses ctx direct-slots))))
|
||||
|
||||
|
|
@ -676,23 +653,6 @@ Returns the first found matching file."
|
|||
""
|
||||
uri))
|
||||
|
||||
(defun remove-from-alist (item alist)
|
||||
"Removes the cell corresponding to ITEM from an association list."
|
||||
(remove item alist
|
||||
:test (lambda (key cell)
|
||||
(eq (car cell) key))))
|
||||
|
||||
(defun merge-alists (a b &optional clobberp)
|
||||
"Merge two association lists, adding all items of A to B not pre-existing in B.
|
||||
If CLOBBERP is set, pre-existing items of B will be overwritten regardless."
|
||||
(loop for cell in a
|
||||
do (let ((b-has-item-p (assoc (car cell) b)))
|
||||
(cond ((and b-has-item-p clobberp)
|
||||
(setf (cdr (assoc (car cell) b)) (cdr cell)))
|
||||
((not b-has-item-p)
|
||||
(alexandria:appendf b (list cell))))))
|
||||
b)
|
||||
|
||||
(defun plist-keys (plist)
|
||||
"Return a list of keys in a property list."
|
||||
(remove-if #'not
|
||||
|
|
|
|||
|
|
@ -20,7 +20,7 @@
|
|||
(:nicknames "AS/V/LP" "LITEPUB")
|
||||
(:export
|
||||
;; Classes
|
||||
:object
|
||||
:activity :note :object :update
|
||||
:chat-message :emoji :emoji-react :hashtag :property-value
|
||||
;; Slots/Accessors
|
||||
:also-known-as :atom-uri :capabilities :conversation :direct-message-p
|
||||
|
|
@ -43,11 +43,7 @@ Defaults to a copy at jam.xwx.moe — because why not? ¯\_(ツ)_/¯")
|
|||
|
||||
;;; Core types
|
||||
;;; ————————————————————————————————————————
|
||||
(defclass object ()
|
||||
()
|
||||
(:documentation "The base class used for Litepub objects."))
|
||||
|
||||
(json-ld:define-json-type (as/v/a:object "Object") (as/jld:object litepub:object) *litepub-uri*
|
||||
(json-ld:define-json-type (object "Object") (as/v/a:object) *litepub-uri*
|
||||
((atom-uri
|
||||
"atomUri"
|
||||
:documentation "A string containing a URI to an Atom-feed alternative representation of an object.
|
||||
|
|
@ -75,27 +71,33 @@ Generally contains the properties “id”, “owner”, “publicKeyPem”.")
|
|||
;; https://docs.joinmastodon.org/spec/activitypub/#discoverable
|
||||
(discoverablep
|
||||
"discoverable"
|
||||
:accessor actor-discoverable-p
|
||||
:documentation "A boolean value reflecting whether or not an Actor’s profile should be publically discoverable.")
|
||||
;; https://docs.joinmastodon.org/spec/activitypub/#as
|
||||
(manually-approves-followers-p
|
||||
"manuallyApprovesFollowers"
|
||||
:accessor actor-manually-approves-followers-p
|
||||
:documentation "A boolean value, communicating whether or not an Actor screens follow-requests.")
|
||||
;; https://docs.joinmastodon.org/spec/activitypub/#Move
|
||||
(also-known-as
|
||||
"alsoKnownAs"
|
||||
:accessor actor-also-known-as
|
||||
:documentation "When moving between two accounts, the old account sets this property to the URI of the new account.")
|
||||
(capabilities
|
||||
"capabilities"
|
||||
:accessor actor-capabilities
|
||||
:documentation "Contains a hash-table of capability-names mapped to a boolean, marking this Actor’s (server’s) support of capability.
|
||||
One known capabilitity-name is Pleroma’s “acceptsChatMessages”."))
|
||||
(:update 't))
|
||||
One known capabilitity-name is Pleroma’s “acceptsChatMessages”.")))
|
||||
|
||||
|
||||
(json-ld:define-json-type (as/v/a:activity "Activity") (as/v/a:object) *litepub-uri*
|
||||
(defmethod json-ld:@context ((obj litepub:object))
|
||||
(let ((class (class-name (class-of obj))))
|
||||
(case class
|
||||
;; Only use LitePub context for newly-defined classes.
|
||||
(('property-value 'emoji-react 'chat-message 'hashtag 'emoji)
|
||||
*litepub-uri*)
|
||||
;; TODO: Also use LitePub context for old classes when new slots are used.
|
||||
(otherwise
|
||||
(call-next-method)))))
|
||||
|
||||
|
||||
(json-ld:define-json-type (activity "Activity") (as/v/a:activity object) *litepub-uri*
|
||||
(;; https://blog.dereferenced.org/leveraging-json-ld-compound-typing-for-behavioural-hinting-in-activitypub
|
||||
(invisiblep
|
||||
"invisible"
|
||||
|
|
@ -103,8 +105,7 @@ One known capabilitity-name is Pleroma’s “acceptsChatMessages”."))
|
|||
Potentially deprecated/very uncommon.")
|
||||
(list-message
|
||||
"list-message"))
|
||||
(:documentation "An Activity is a subtype of Object that describes some form of action that may happen, is currently happening, or has already happened. The Activity type itself serves as an abstract base type for all types of activities. It is important to note that the Activity type itself does not carry any specific semantics about the kind of action being taken.")
|
||||
(:update 't))
|
||||
(:documentation "An Activity is a subtype of Object that describes some form of action that may happen, is currently happening, or has already happened. The Activity type itself serves as an abstract base type for all types of activities. It is important to note that the Activity type itself does not carry any specific semantics about the kind of action being taken."))
|
||||
|
||||
|
||||
;; https://schema.org/PropertyValue
|
||||
|
|
@ -121,19 +122,18 @@ Potentially deprecated/very uncommon.")
|
|||
|
||||
;;; Extended Activity types
|
||||
;;; ————————————————————————————————————————
|
||||
(json-ld:define-json-type (as/v/a:update "Update") (as/v/a:activity) *litepub-uri*
|
||||
(json-ld:define-json-type (update "Update") (as/v/a:update activity) *litepub-uri*
|
||||
(;; https://ostatus.github.io/spec/OStatus%201.0%20Draft%202.html#rfc.section.6
|
||||
(conversation
|
||||
"conversation"
|
||||
:documentation "When an update is part of a distributed conversation, this is the URI of that conversation.
|
||||
Likely deprecated/highly uncommon."))
|
||||
(:documentation "Indicates that the actor has updated the object. Note, however, that this vocabulary does not define a mechanism for describing the actual set of modifications made to object.
|
||||
The target and origin typically have no defined meaning.")
|
||||
(:update 't))
|
||||
The target and origin typically have no defined meaning."))
|
||||
|
||||
|
||||
;; https://codeberg.org/fediverse/fep/src/branch/main/fep/c0e0/fep-c0e0.md
|
||||
(json-ld:define-json-type (emoji-react "EmojiReact") (as/v/a:like) *litepub-uri*
|
||||
(json-ld:define-json-type (emoji-react "EmojiReact") (as/v/a:like activity) *litepub-uri*
|
||||
()
|
||||
(:documentation "This activity is similar to Like activity. In addition to standard properties of Like activity, EmojiReact activity MUST have a content property. Reaction content MUST be either a single unicode grapheme, or a shortcode of a custom emoji. If custom emoji is used, EmojiReact activity MUST have a tag property containing a single Emoji object."))
|
||||
|
||||
|
|
@ -142,12 +142,12 @@ The target and origin typically have no defined meaning.")
|
|||
;;; Extended Object types
|
||||
;;; ————————————————————————————————————————
|
||||
;; https://docs.joinmastodon.org/spec/activitypub/#Emoji
|
||||
(json-ld:define-json-type (emoji "Emoji") (as/v/a:object) *litepub-uri*
|
||||
(json-ld:define-json-type (emoji "Emoji") (object) *litepub-uri*
|
||||
()
|
||||
(:documentation "Represents a custom-emoji, with a shortcode (NAME), ID, and ICON (containing MEDIA-TYPE and URL)."))
|
||||
|
||||
|
||||
(json-ld:define-json-type (as/v/a:note "Note") (as/v/a:object) *litepub-uri*
|
||||
(json-ld:define-json-type (note "Note") (as/v/a:note object) *litepub-uri*
|
||||
(;; https://misskey-hub.net/ns#_misskey_quote
|
||||
(quote-url
|
||||
"quoteUrl"
|
||||
|
|
@ -164,12 +164,11 @@ It is, however, unclear which one will win out in the end. The implementer prefe
|
|||
Effectively equivalent to QUOTE-URL.
|
||||
One of QUOTE-URL (as:quoteUrl) or QUOTE-URI (fedibird:quoteUri) is to be deprecated, and the other ought be preferred.
|
||||
It is, however, unclear which one will win out in the end. The implementer prefers QUOTE-URL."))
|
||||
(:documentation "Represents a short written work typically less than a single paragraph in length.")
|
||||
(:update 't))
|
||||
(:documentation "Represents a short written work typically less than a single paragraph in length."))
|
||||
|
||||
|
||||
;; https://docs-develop.pleroma.social/backend/development/ap_extensions/#chatmessages
|
||||
(json-ld:define-json-type (chat-message "ChatMessage") (as/v/a:note) *litepub-uri*
|
||||
(json-ld:define-json-type (chat-message "ChatMessage") (note) *litepub-uri*
|
||||
()
|
||||
(:documentation "Represents a private and one-on-one chat-message.
|
||||
Similar to Notes in creation and use, but TO may contain only one recipient.
|
||||
|
|
@ -181,12 +180,12 @@ Potentially very uncommon — it is used by at least Pleroma."))
|
|||
Will set/get the value of either QUOTE-URL or QUOTE-URI, depending on which is currently in use.
|
||||
In case of doubt, QUOTE-URL is preferred."))
|
||||
|
||||
(defmethod note-quote-url ((obj as/v/a:note))
|
||||
(defmethod note-quote-url ((obj note))
|
||||
(or (and (slot-boundp note 'quote-url) (slot-value note 'quote-url))
|
||||
(and (slot-boundp note 'quote-uri) (slot-value note 'quote-uri))))
|
||||
|
||||
(defgeneric (setf note-quote-url) (obj value))
|
||||
(defmethod (setf note-quote-url) ((obj as/v/a:note) value)
|
||||
(defmethod (setf note-quote-url) ((obj note) value)
|
||||
(if (slot-boundp note 'quote-uri)
|
||||
(setf (slot-value note 'quote-uri) value)
|
||||
(setf (slot-value note 'quote-url) value)))
|
||||
|
|
@ -196,6 +195,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 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