Classes for ActivityVocab’s extended Activities

This commit is contained in:
Jaidyn Ann 2024-06-12 21:42:47 -05:00
parent 984b3d5b2a
commit a604d74b5b

View File

@ -17,6 +17,9 @@
(defpackage #:activitypub-servist/activity-vocabulary (defpackage #:activitypub-servist/activity-vocabulary
(:use #:cl) (:use #:cl)
;; One should never USE this package, since some class-names shadow
;; core Common Lisp symbols! Beware! :P
(:shadow #:delete #:ignore #:listen #:read #:remove)
(:nicknames "AP-S/AV" "AV")) (:nicknames "AP-S/AV" "AV"))
(in-package #:activitypub-servist/activity-vocabulary) (in-package #:activitypub-servist/activity-vocabulary)
@ -25,21 +28,47 @@
;;; Macros ;;; Macros
;;; ———————————————————————————————————————— ;;; ————————————————————————————————————————
(defmacro defclass-w-accessors (name direct-superclasses slots &rest options) (defmacro defclass-w-accessors (name direct-superclasses slots &rest options)
"Identical to DEFCLASS, but with one convenience: A slot definition, if being
simply a symbol, will default to a slot with an accessor and init-arg named after the
symbol. The init-arg will be :symbol, and the accessor will be classname-symbol.
For instance,
(defclass-w-accessors PERSON () (AGE
HEIGHT
(NAME :INIT-FORM Unknown)))
```
is equivalent to
```
(defclass PERSON () ((AGE :INIT-ARG :AGE :ACCESSOR PERSON-AGE)
(HEIGHT :INIT-ARG :HEIGHT :ACCESSOR PERSON-HEIGHT)
(NAME :INIT-FORM Unknown)))
```"
`(defclass ,name ,direct-superclasses `(defclass ,name ,direct-superclasses
,(mapcar ,(mapcar
(lambda (slot) (lambda (slot)
(typecase slot (typecase slot
(list slot) (list slot)
(t (list slot :accessor slot :initarg (intern (symbol-name slot) "KEYWORD"))))) (t (list slot :accessor (intern (format nil "~A-~A" name slot))
:initarg (intern (symbol-name slot) "KEYWORD")))))
slots) slots)
,@options)) ,@options))
(defmacro defclass-empty-children (name direct-children)
"For each name in the list DIRECT-CHILDREN, a subclass of NAME will be created.
These new subclasses have no slots of its own they will be empty derivatives
of NAME."
(append
'(progn)
(mapcar (lambda (a)
`(defclass ,a (,name) ()))
direct-children)))
;;; Core types ;;; Core types
;;; ———————————————————————————————————————— ;;; ————————————————————————————————————————
;; https://www.w3.org/ns/activitystreams#Object ;; https://www.w3.org/ns/activitystreams#Object
(defclass-w-accessors av-object () (defclass-w-accessors object ()
( (
attachment attributed-to audience bcc bto cc content context attachment attributed-to audience bcc bto cc content context
duration end-time generator icon image in-reply-to location duration end-time generator icon image in-reply-to location
@ -47,35 +76,43 @@
tag to updated url)) tag to updated url))
;; https://www.w3.org/ns/activitystreams#Link ;; https://www.w3.org/ns/activitystreams#Link
(defclass-w-accessors av-link () (defclass-w-accessors link ()
(height href hreflang media-type name preview rel width)) (height href hreflang media-type name preview rel width))
;; https://www.w3.org/ns/activitystreams#Activity ;; https://www.w3.org/ns/activitystreams#Activity
(defclass-w-accessors av-activity (av-object) (defclass-w-accessors activity (object)
(actor instrument object origin result target)) (actor instrument object origin result target))
;; Should be ordinary Activity, sans `object`. ;; Should be ordinary Activity, sans `object`.
;; https://www.w3.org/ns/activitystreams#IntransitiveActivity ;; https://www.w3.org/ns/activitystreams#IntransitiveActivity
(defclass av-intransitive-activity (av-activity) ()) (defclass intransitive-activity (activity) ())
;; https://www.w3.org/ns/activitystreams#Collection ;; https://www.w3.org/ns/activitystreams#Collection
(defclass-w-accessors av-collection (av-object) (defclass-w-accessors collection (object)
(current first items last total-items)) (current first items last total-items))
;; https://www.w3.org/ns/activitystreams#OrderedCollection ;; https://www.w3.org/ns/activitystreams#OrderedCollection
(defclass av-ordered-collection (av-collection) ()) (defclass ordered-collection (collection) ())
;; https://www.w3.org/ns/activitystreams#CollectionPage ;; https://www.w3.org/ns/activitystreams#CollectionPage
(defclass-w-accessors av-collection-page (av-collection) (defclass-w-accessors collection-page (collection)
(next part-of prev)) (next part-of prev))
;; https://www.w3.org/ns/activitystreams#OrderedCollectionPage ;; https://www.w3.org/ns/activitystreams#OrderedCollectionPage
(defclass-w-accessors av-ordered-collection-page (av-collection-page) (defclass-w-accessors ordered-collection-page (collection-page)
(startIndex)) (start-index))
;;; Extended Activity types ;;; Extended Activity types
;;; ———————————————————————————————————————— ;;; ————————————————————————————————————————
(defclass-w-accessors av- (defclass-empty-children activity
(accept add announce create delete dislike flag follow ignore join leave
like listen move offer read reject remove travel undo update view))
(defclass arrive (intransitive-activity) ())
(defclass ignore (block) ())
(defclass invite (offer) ())
(defclass question (intransitive-activity) ())
(defclass tentative-accept (accept) ())
(defclass tentative-reject (reject) ())