diff --git a/src/activity-vocabulary.lisp b/src/activity-vocabulary.lisp index 9194e38..605c221 100644 --- a/src/activity-vocabulary.lisp +++ b/src/activity-vocabulary.lisp @@ -17,6 +17,9 @@ (defpackage #:activitypub-servist/activity-vocabulary (: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")) (in-package #:activitypub-servist/activity-vocabulary) @@ -25,21 +28,47 @@ ;;; Macros ;;; ———————————————————————————————————————— (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 ,(mapcar (lambda (slot) (typecase 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) ,@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 ;;; ———————————————————————————————————————— ;; 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 duration end-time generator icon image in-reply-to location @@ -47,35 +76,43 @@ tag to updated url)) ;; 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)) ;; 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)) ;; Should be ordinary Activity, sans `object`. ;; https://www.w3.org/ns/activitystreams#IntransitiveActivity -(defclass av-intransitive-activity (av-activity) ()) +(defclass intransitive-activity (activity) ()) ;; 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)) ;; https://www.w3.org/ns/activitystreams#OrderedCollection -(defclass av-ordered-collection (av-collection) ()) +(defclass ordered-collection (collection) ()) ;; 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)) ;; https://www.w3.org/ns/activitystreams#OrderedCollectionPage -(defclass-w-accessors av-ordered-collection-page (av-collection-page) - (startIndex)) - +(defclass-w-accessors ordered-collection-page (collection-page) + (start-index)) ;;; 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) ())