Classes for ActivityVocab’s extended Activities

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)
+(defclass-w-accessors ordered-collection-page (collection-page)
-  (startIndex))
+  (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) ())