Rename accessors from “CLASS-SLOT” to simply “SLOT”

JSON-LD would automatically name accessors
“CLASS-SLOT” which… gets a little bit clunky, no?
Simply “SLOT” is nicer, IMO.
This commit is contained in:
Jaidyn Ann 2024-09-05 11:45:27 -05:00
parent 5cc249ffa9
commit a0f4d6ba36
2 changed files with 26 additions and 46 deletions

View File

@ -18,40 +18,29 @@
(defpackage #:activity-servist/vocab/activity (defpackage #:activity-servist/vocab/activity
(:use #:cl) (:use #:cl)
(:nicknames "AS/V/A" "ACTIVITY-VOCABULARY" "ACTIVITY") (:nicknames "AS/V/A" "ACTIVITY-VOCABULARY" "ACTIVITY")
(:shadow #:block #:delete #:ignore #:listen #:read #:remove) (:shadow #:block #:delete #:first #:ignore #:last #:listen #:read #:remove)
;; One should never USE this package, since some class-names shadow ;; One should never USE this package, since some class-names shadow
;; core Common Lisp symbols! Beware! :P ;; core Common Lisp symbols! Beware! :P
(:export (:export
;; Classes ;; Classes
:accept :activity :add :announce :application :arrive :article :audio :block :accept :activity :actor :add :announce :application :arrive :article :audio
:collection :collection-page :create :delete :dislike :document :event :flag :block :collection :collection-page :create :delete :dislike :document
:follow :group :ignore :ignore :image :intransitive-activity :invite :join :event :flag :follow :group :ignore :image :intransitive-activity :invite
:leave :like :link :listen :move :note :object :offer :ordered-collection :join :leave :like :link :listen :mention :move :note :object :offer
:ordered-collection-page :organization :page :person :place :profile :ordered-collection :ordered-collection-page :organization :page :person
:question :read :reject :relationship :remove :service :tentative-accept :place :profile :question :read :reject :relationship :remove :service
:tentative-reject :tombstone :travel :undo :update :video :view :tentative-accept :tentative-reject :tombstone :travel :undo :update :video
;; Accessors :view
:activity-actor :activity-instrument :activity-object :activity-origin ;; Slots/Accessors
:activity-result :activity-target :accuracy :actor :altitude :any-of :arrive :attachment :attributed-to
:collection-current :collection-first :collection-items :collection-last :audience :bcc :bto :cc :closed :content :context :current :deleted
:collection-total-items :describes :duration :endpoints :end-time :first :followers :following
:collection-page-next :collection-page-part-of :collection-page-prev :former-type :generator :height :href :hreflang :icon :image :inbox
:link-height :link-href :link-hreflang :link-media-type :link-name :in-reply-to :instrument :items :last :latitude :liked :location :longitude
:link-preview :link-rel :link-summary :link-width :media-type :name :next :object :one-of :ordered-items :origin :outbox
:object-actor :object-attachment :object-attributed-to :object-audience :part-of :preferred-username :prev :preview :published :radius :rel
:object-content :object-context :object-name :object-end-time :relationship :replies :result :start-index :start-time :streams :subject
:object-generator :object-icon :object-image :object-in-reply-to :summary :tag :target :to :total-items :units :updated :url :width))
:object-location :object-preview :object-published :object-replies
:object-start-time :object-summary :object-tag :object-updated
:object-url :object-to :object-bto :object-cc :object-bcc
:object-media-type :object-duration
:ordered-collection-page-start-index ordered-collection-ordered-items
:place-accuracy :place-altitude :place-latitude :place-longitude
:place-radius :place-units
:question-all-of :question-closed :question-one-of
:profile-describes
:relationship-object :relationship-relationship :relationship-subject
:tombstone-former-type :tombstone-deleted))
(in-package #:activity-servist/vocab/activity) (in-package #:activity-servist/vocab/activity)
@ -66,7 +55,7 @@ Items of DIRECT-CHILDREN should be of the form,
(append (append
'(progn) '(progn)
(mapcar (lambda (subclass-list) (mapcar (lambda (subclass-list)
(let ((class-name (first subclass-list)) (let ((class-name (cl:first subclass-list))
(type-name (second subclass-list)) (type-name (second subclass-list))
(documentation (third subclass-list))) (documentation (third subclass-list)))
`(json-ld:define-json-type (,class-name ,type-name) ,superclasses ,context `(json-ld:define-json-type (,class-name ,type-name) ,superclasses ,context
@ -171,37 +160,29 @@ The notion of “context” used is intentionally vague. The intended function i
;; Required actor slots ;; Required actor slots
(inbox (inbox
"inbox" "inbox"
:accessor actor-inbox
:documentation "A reference to an OrderedCollection comprised of all the messages received by the actor.") :documentation "A reference to an OrderedCollection comprised of all the messages received by the actor.")
(outbox (outbox
"outbox" "outbox"
:accessor actor-outbox
:documentation "An OrderedCollection comprised of all the messages produced by the actor.") :documentation "An OrderedCollection comprised of all the messages produced by the actor.")
(following (following
"following" "following"
:accessor actor-following
:documentation "A link to a collection of the actors that this actor is following.") :documentation "A link to a collection of the actors that this actor is following.")
(followers (followers
"followers" "followers"
:accessor actor-followers
:documentation "A link to a collection of the actors that follow this actor.") :documentation "A link to a collection of the actors that follow this actor.")
;; Optional Actor slots ;; Optional Actor slots
(liked (liked
"liked" "liked"
:accessor actor-liked
:documentation "A link to a collection of objects this actor has liked.") :documentation "A link to a collection of objects this actor has liked.")
(streams (streams
"streams" "streams"
:accessor actor-streams
:documentation "A list of supplementary Collections which may be of interest.") :documentation "A list of supplementary Collections which may be of interest.")
(preferred-username (preferred-username
"preferredUsername" "preferredUsername"
:accessor actor-preferred-username
:documentation "A short username which may be used to refer to the actor, with no uniqueness guarantees.") :documentation "A short username which may be used to refer to the actor, with no uniqueness guarantees.")
(endpoints (endpoints
"endpoints" "endpoints"
:accessor actor-endpoints
:documentation "A JSON object which maps additional (typically server/domain-wide) endpoints which may be useful either for this actor or someone referencing this actor. This mapping may be nested inside the actor document as the value or may be a link to a JSON-LD document with these properties. :documentation "A JSON object which maps additional (typically server/domain-wide) endpoints which may be useful either for this actor or someone referencing this actor. This mapping may be nested inside the actor document as the value or may be a link to a JSON-LD document with these properties.
May include the properties proxyUrl, oauthAuthorizationEndpoint, oauthTokenEndpoint, provideClientKey, signClientKey, and sharedInbox. May include the properties proxyUrl, oauthAuthorizationEndpoint, oauthTokenEndpoint, provideClientKey, signClientKey, and sharedInbox.
See the spec for details on these properties: https://www.w3.org/TR/activitypub/#proxyUrl")) See the spec for details on these properties: https://www.w3.org/TR/activitypub/#proxyUrl"))

View File

@ -171,8 +171,7 @@ SLOT-OPTIONS are key/value pairs in the format of DEFCLASSes slot-options.
Keywords such as :INITFORM, :DOCUMENTATION, etc. can be used. Keywords such as :INITFORM, :DOCUMENTATION, etc. can be used.
There is one keyword with behavior unlike DEFCLASS, however :ACCESSOR. There is one keyword with behavior unlike DEFCLASS, however :ACCESSOR.
By default, a slot will have an accessor named after the class and slot, like By default, a slot will have an accessor simply named after the slot.
PLACE-RADIUS for the class PLACE and the slot RADIUS.
Set :ACCESSOR to NIL to define no accessor at all. Set :ACCESSOR to NIL to define no accessor at all.
OPTIONS contains ordinary class options, in the format of DEFCLASS (for example, OPTIONS contains ordinary class options, in the format of DEFCLASS (for example,
@ -232,12 +231,12 @@ See DEFINE-JSON-TYPEs docstring for a description of parameters."
"Return DEFCLASS-format slot options from DEFINE-JSON-TYPE-format SLOT-OPTS, "Return DEFCLASS-format slot options from DEFINE-JSON-TYPE-format SLOT-OPTS,
applying default slot-options, etc." applying default slot-options, etc."
(json-type-normalize-slot-options (json-type-normalize-slot-options
(merge-plists (json-type-implicit-slot-options class-name slot-name) (merge-plists (json-type-implicit-slot-options slot-name)
slot-opts))) slot-opts)))
(defun json-type-implicit-slot-options (class-name slot-name) (defun json-type-implicit-slot-options (slot-name)
"Return default property-list slot options for a json-type CLOS class." "Return default property-list slot options for a json-type CLOS class."
(list :accessor (intern (format nil "~A-~A" class-name slot-name)))) (list :accessor (intern (format nil "~A" slot-name))))
(defun json-type-normalize-slot-options (slot-opts) (defun json-type-normalize-slot-options (slot-opts)
"Take property-list slot options from a DEFINE-JSON-TYPE format and massage it "Take property-list slot options from a DEFINE-JSON-TYPE format and massage it