diff --git a/activity-servist.asd b/activity-servist.asd index febe331..2e1b576 100644 --- a/activity-servist.asd +++ b/activity-servist.asd @@ -15,26 +15,25 @@ :components ((:file "src/activity-servist"))) -(asdf:defsystem "activity-servist/activity-vocabulary" +(asdf:defsystem "activity-servist/activity-streams" :version "0.0" :license "AGPLv3" - :description "AP-S subpackage for handling ActivityVocabulary parsing/encoding." + :description "A-S subpackage for handling ActivityStreams parsing/encoding." :author "Jaidyn Ann " :homepage "https://hak.xwx.moe/jadedctrl/activity-servist" - :in-order-to ((test-op (test-op "activitypub/tests/activity-vocabulary"))) :depends-on ("alexandria" "closer-mop" "str" "yason") - :components ((:file "src/activity-vocabulary"))) + :components ((:file "src/activity-streams") + (:file "src/activity-vocabulary"))) (asdf:defsystem "activity-servist/signatures" :version "0.0" :license "AGPLv3" - :description "AP-S subpackage for handling HTTP signatures." + :description "A-S subpackage for handling HTTP signatures." :author "Jaidyn Ann " :homepage "https://hak.xwx.moe/jadedctrl/activity-servist" - :in-order-to ((test-op (test-op "activitypub/tests/signatures"))) :depends-on ("cl-base64" "flexi-streams" "inferior-shell" "ironclad" "str") :components ((:file "src/signatures"))) @@ -42,14 +41,14 @@ ;;; Tests ;;; ————————————————————————————————————— -(asdf:defsystem "activity-servist/tests/activity-vocabulary" +(asdf:defsystem "activity-servist/tests/activity-streams" :version "0.0" :license "AGPLv3" :author "Jaidyn Ann " - :description "Tests for the the activity-servist/signatures package." + :description "Tests for the the activity-servist/activity-streams package." - :depends-on (:activity-servist/activity-vocabulary :alexandria :lisp-unit2) - :components ((:file "t/activity-vocabulary"))) + :depends-on (:activity-servist/activity-streams :alexandria :lisp-unit2) + :components ((:file "t/activity-streams"))) (asdf:defsystem "activity-servist/tests/signatures" @@ -68,7 +67,7 @@ :author "Jaidyn Ann " :description "Tests for all activity-servist subpacakges." - :depends-on (:activity-servist/tests/activity-vocabulary + :depends-on (:activity-servist/tests/activity-streams :activity-servist/tests/signatures :alexandria :lisp-unit2) :components ((:file "t/t"))) @@ -79,6 +78,6 @@ `(defmethod asdf:perform ((o asdf:test-op) (c (eql (asdf:find-system ',package)))) (eval (read-from-string (format nil "(~A:run-with-summary)" ',package))))) -(define-asdf-testing activity-servist/tests/activity-vocabulary) +(define-asdf-testing activity-servist/tests/activity-streams) (define-asdf-testing activity-servist/tests/signatures) (define-asdf-testing activity-servist/tests) diff --git a/src/activity-streams.lisp b/src/activity-streams.lisp new file mode 100644 index 0000000..e6da30a --- /dev/null +++ b/src/activity-streams.lisp @@ -0,0 +1,270 @@ +;;;; activity-streams: Serialize/deserialize ActivityStreams objects. + +;; Copyright © 2024 Jaidyn Ann +;; +;; This program is free software: you can redistribute it and/or +;; modify it under the terms of the GNU General Public License as +;; published by the Free Software Foundation, either version 3 of +;; the License, or (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +(defpackage #:activity-servist/activity-streams + (:use #:cl) + (:nicknames "AS/AS" "ACTIVITY-STREAMS") + (:export + ;; Functions + :parse :encode + :define-class-encoders + ;; Globals + :*ap-packages* + ;; Classes + :object + ;; Slots + :@context :type)) + +(in-package #:activity-servist/activity-streams) + + + +;;; Globals +;;; ———————————————————————————————————————— +(defparameter *ap-packages* (list :activity-servist/activity-vocabulary *package*) + "A list of packages in which we should search for AP classes and slot-symbols +during JSON parsing. The class-name searched for is simply the value of the JSON +object’s “type” key. The package first in the list to export such a symbol +is the winner.") + +;; Private, internal variable. +(defparameter *@context* nil + "Used in YASON:ENCODE to ensure that a single top-level @context can be +created where AP objects contain other AP objects in their slots. +This variable is overridden locally during encoding (LET), and should never be +modified globally (as we expect it to be nil in top-level objects.") + + + +;;; Macros +;;; ———————————————————————————————————————— +;; This macro and the following function are related to JSON serialization; see +;; the below “JSON serialization” section for other related functions. +(defmacro define-yason-encode-slots (class) + "Define a YASON:ENCODE-SLOTS method for a CLASS, which simply encodes all of +CLASS’es slots with JSON keys based on the camel-cased slot name." + (append + `(defmethod yason:encode-slots progn ((obj ,class))) + (mapcar (yason-encode-slot-function) + (class-slots-activity-alist class)))) + +(defun yason-encode-slot-function () + "Helper-function for the DEFINE-YASON-ENCODE-SLOTS macro. +This returns a function to create a quoted function that should be called for each slot, +again and again, by YASON:ENCODE-SLOTS." + (lambda (slot-key-pair) + `(let ((key ',(car slot-key-pair)) + (value (ignore-errors (slot-value obj ',(car slot-key-pair))))) + (cond ((eq key '@context) ; Encoded in YASON:ENCODE-OBJECT using *@context* + (setq *@context* (merge-@contexts *@context* value))) + ((eq key 'type) ; Encode type based on class-name or TYPE slot + (yason:encode-object-element + "type" (or value + (class-pretty-name (class-of obj))))) + (value + (yason:encode-object-element ,(cdr slot-key-pair) value)))))) + + + +;;; Core class +;;; ———————————————————————————————————————— +(defclass object () + ((@context :initform "https://www.w3.org/ns/activitystreams") + (type))) + + + +;;; JSON parsing +;;; ———————————————————————————————————————— +(defun parse (string) + "Parse a string containing JSON into an ActivityPub object." + (parse-table (yason:parse string))) + +(defun parse-table (table) + "Parse a hash-table corresponding to YASON-parsed JSON into an ActivityPub object." + (let* ((class (car (find-registered-classes (param-case (gethash "type" table))))) + (obj (make-instance class))) + (loop for key being each hash-key of table + for val being each hash-value of table + do (let ((slot-sym (car (find-registered-symbols (param-case key)))) + (val (parse-value val))) + (when slot-sym + (setf (slot-value obj slot-sym) val)))) + obj)) + +(defun parse-value (val) + "Parse the value of a key found in YASON-parsed JSON. +All ActivityPub objects (hash-tables containing “type”) will be parsed into +ActivityPub objects; all others will parsed into associative lists." + (typecase val + (hash-table (maybe-parse-table val)) + (list (mapcar (lambda (a) + (if (hash-table-p a) + (maybe-parse-table a) + a)) + val)) + (t val))) + +(defun maybe-parse-table (table) + "If a hash-table seems to be a valid ActivityPub object, attempt parsing it +into one. Otherwise, parse it into an associative list." + (if (gethash "type" table) + (parse-table table) + (alexandria:hash-table-alist table))) + + + +;;; JSON serialization +;;; ———————————————————————————————————————— +(defun define-class-encoders (classes) + "For each class in CLASSES, define an YASON:ENCODE-SLOTS method for that class, +which only encodes slots unique to that class (as ENCODE-SLOTS is called for each +inherited class). Each slot’s name is converted to camel-case, as per convention." + (mapcar (lambda (class) + (closer-mop:finalize-inheritance class) + (eval `(define-yason-encode-slots ,class))) + classes)) + +(defun encode (obj &optional (stream *standard-output*)) + "Encode OBJ into JSON. A mere wrapper around YASON:ENCODE." + (yason:encode obj stream)) + +(defmethod yason:encode ((obj object) &optional (stream *standard-output*)) + (yason:with-output (stream) + (yason:encode-object obj))) + +(defmethod yason:encode-object ((obj object)) + (typecase *@context* + (null ; If this is the top-level (non-nested) object, establish a @context. + (let ((*@context* 'top-level)) + (yason:encode-object obj))) + (symbol ; In the top-level, encode slots and then @context. + (setq *@context* (slot-value obj '@context)) + (yason:with-object () + (yason:encode-slots obj) + (yason:encode-object-element "@context" *@context*))) + (T ; In nested objects, only encode slots — not *@context*. + (yason:with-object () + (yason:encode-slots obj))))) + +(defun class-slots-activity-alist (class) + "Return an associative list containing CLASSes slots’ symbols consed with +their sanitized string keys appropriate for ActivityVocabular custom. +A class with slots MAP-AWAY and COLLECTION-AGAIN would return + ((MAP-AWAY . “mapAway”)(COLLECTION-AGAIN . “collectionAgain”))" + (alist-mapcdr #'camel-case + (class-slots-alist class))) + +(defun merge-@contexts (a b) + "Given two @context lists, A and B, merge them into one JSON-LD @context list +containing both of their elements." + (cond ((equal a b) a) + ((not b) a) + ((not a) b) + ((and (listp a) + (find b a :test #'equal)) + a) + (T + (merge-lists + (if (listp a) a (list a)) + (if (listp b) b (list b)))))) + + + +;;; Util +;;; ———————————————————————————————————————— +(defun camel-case (string) + "Convert a STRING to camel-casing. That is, casingLikeThis. +Wrapper around STR:CAMEL-CASE, working around a bug that a non-alphanumeric +character at the start of the string gets erroneously (or at least undesireably, +to us) removed." + (keep-nonalphanumeric-prefix string + (str:camel-case string))) + +(defun param-case (string) + "Convert a STRING to param-casing. That is, casing-like-this. +Wrapper around STR:PARAM-CASE, working around a bug that a non-alphanumeric +character at the start of the string gets erroneously (or at least undesireably, +to us) removed." + (keep-nonalphanumeric-prefix string + (str:param-case string))) +(defun camel-case (str) + "Convert a STRING to camel-casing. +Wrapper around STR:CAMEL-CASE, working around a bug that a non-alphanumeric +character at the start of the string gets erroneously (or at least undesireably, +to us) removed." + (keep-nonalphanumeric-prefix str (str:camel-case str))) + +(defun keep-nonalphanumeric-prefix (str child-str) + "This ensures that a CHILD-STR derived from STR has the same nonalphanumeric +prefix as STR, as some functions like to remove such prefixes." + (if (not (alphanumericp (aref str 0))) + (concatenate 'string + (string (aref str 0)) + child-str) + child-str)) + +(defun class-pretty-name (class) + "Return a CLASS’es name in a “pretty” (sentence-capitalized) string." + (string-capitalize (symbol-name (class-name class)))) + +(defun merge-lists (a b) + "Given lists A and B, merge them into one list non-redundantly — all unique +items in each will be contained in the resultant list." + (append a (remove-if (lambda (item) (find item a :test #'equal)) b))) + +(defun find-registered-symbols (str) + "Find all symbols identified by string STR within packages in the +*ap-packages* list." + (remove-if + #'not + (mapcar (lambda (package) (find-symbol (string-upcase str) package)) + *ap-packages*))) + +(defun find-registered-classes (str) + "Find all classes identified by string STR within pacakges in the +*ap-packages* list." + (remove-if + #'not + (mapcar (lambda (sym) (find-class sym)) + (find-registered-symbols str)))) + +(defun alist-mapcdr (function alist) + "Apply a FUNCTION to all values (cdrs) of an ALIST’s pairs. Returns a new ALIST +of the same keys, whose values are the results of FUNCTION." + (mapcar + (lambda (cell) + (cons (car cell) + (funcall function (cdr cell)))) + alist)) + +(defun class-slots-alist (class) + "Return an associative list of a CLASS’es direct slots (by symbol) matched with +their names as strings. For instance, a class with slots MAP-AWAY and +COLLECTION-AGAIN would return: + ((MAP-AWAY . “MAP-AWAY”)(COLLECTION-AGAIN . “COLLECTION-AGAIN”)" + (mapcar + (lambda (slot) + (let ((name (closer-mop:slot-definition-name slot))) + (cons name (symbol-name name)))) + (closer-mop:class-direct-slots class))) + + + +;;; Defining YASON:ENCODE-SLOTS +;;; ———————————————————————————————————————— +(as/as:define-class-encoders (list (find-class 'object))) diff --git a/src/activity-vocabulary.lisp b/src/activity-vocabulary.lisp index e0fc031..5a4a4e5 100644 --- a/src/activity-vocabulary.lisp +++ b/src/activity-vocabulary.lisp @@ -1,4 +1,4 @@ -;;;; activity-vocabulary: Classes for ActivityVocabulary types. +;;;; activity-vocabulary: Base classes for ActivityStreams. ;; Copyright © 2024 Jaidyn Ann ;; @@ -22,21 +22,15 @@ ;; One should never USE this package, since some class-names shadow ;; core Common Lisp symbols! Beware! :P (:export - ;; Functions - :parse - ;; Globals - :*ap-packages* ;; Classes :accept :activity :add :announce :application :arrive :article :audio :collection :collection-page :create :delete :dislike :document :event :flag :follow :group :ignore :ignore :image :intransitive-activity :invite :join - :leave :like :link :link :listen :move :note :object :offer - :ordered-collection :ordered-collection-page :organization :page :person - :place :profile :question :read :reject :relationship :remove :service - :tentative-accept :tentative-reject :tombstone :travel :undo :update :video - :view + :leave :like :link :listen :move :note :object :offer :ordered-collection + :ordered-collection-page :organization :page :person :place :profile + :question :read :reject :relationship :remove :service :tentative-accept + :tentative-reject :tombstone :travel :undo :update :video :view ;; Slots - :@context :type :activity-actor :activity-instrument :activity-object :activity-origin :activity-result :activity-target :collection-current :collection-first :collection-items :collection-last @@ -61,23 +55,6 @@ (in-package #:activity-servist/activity-vocabulary) - -;;; Globals -;;; ———————————————————————————————————————— -(defparameter *ap-packages* (list *package*) - "A list of packages in which we should search for AP classes and slot-symbols -during JSON parsing. The class-name searched for is simply the value of the JSON -object’s “type” key. The package first in the list to export such a symbol -is the winner.") - -;; Private, internal variable. -(defparameter *@context* nil - "Used in YASON:ENCODE to ensure that a single top-level @context can be -created where AP objects contain other AP objects in their slots. -This variable is overridden locally during encoding (LET), and should never be -modified globally (as we expect it to be nil in top-level objects.") - - ;;; Macros ;;; ———————————————————————————————————————— @@ -113,42 +90,12 @@ of NAME." `(defclass ,a (,name) ())) direct-children))) -;; This macro and the following function are related to JSON serialization; see -;; the below “JSON serialization” section for other related functions. -(defmacro define-yason-encode-slots (class) - "Define a YASON:ENCODE-SLOTS method for a CLASS, which simply encodes all of -CLASS’es slots with JSON keys based on the camel-cased slot name." - (append - `(defmethod yason:encode-slots progn ((obj ,class))) - (mapcar (yason-encode-slot-function) - (class-slots-activity-alist class)))) - -(defun yason-encode-slot-function () - "Helper-function for the DEFINE-YASON-ENCODE-SLOTS macro. -This returns a function to create a quoted function that should be called for each slot, -again and again, by YASON:ENCODE-SLOTS." - (lambda (slot-key-pair) - `(let ((key ',(car slot-key-pair)) - (value (ignore-errors (slot-value obj ',(car slot-key-pair))))) - (cond ((eq key '@context) ; Encoded in YASON:ENCODE-OBJECT using *@context* - (setq *@context* (merge-@contexts *@context* value))) - ((eq key 'type) ; Encode type based on class-name or TYPE slot - (yason:encode-object-element - "type" (or value - (class-pretty-name (class-of obj))))) - (value - (yason:encode-object-element ,(cdr slot-key-pair) value)))))) - ;;; Core types ;;; ———————————————————————————————————————— -(defclass as-object () - ((@context :initform "https://www.w3.org/ns/activitystreams") - (type :accessor object-type))) - ;; https://www.w3.org/ns/activitystreams#Object -(defclass-w-accessors object (as-object) +(defclass-w-accessors object (activity-servist/activity-streams:object) ( attachment attributed-to audience bcc bto cc content context duration end-time generator icon id image in-reply-to location @@ -156,7 +103,7 @@ again and again, by YASON:ENCODE-SLOTS." tag to updated url)) ;; https://www.w3.org/ns/activitystreams#Link -(defclass-w-accessors link (as-object) +(defclass-w-accessors link (activity-servist/activity-streams:object) (height href hreflang media-type name preview rel width)) ;; https://www.w3.org/ns/activitystreams#Activity @@ -241,175 +188,11 @@ again and again, by YASON:ENCODE-SLOTS." (mention)) - -;;; JSON parsing -;;; ———————————————————————————————————————— -(defun parse (string) - "Parse a string containing JSON into an ActivityPub object." - (parse-table (yason:parse string))) - -(defun parse-table (table) - "Parse a hash-table corresponding to YASON-parsed JSON into an ActivityPub object." - (let* ((class (car (find-registered-classes (param-case (gethash "type" table))))) - (obj (make-instance class))) - (loop for key being each hash-key of table - for val being each hash-value of table - do (let ((slot-sym (car (find-registered-symbols (param-case key)))) - (val (parse-value val))) - (when slot-sym - (setf (slot-value obj slot-sym) val)))) - obj)) - -(defun parse-value (val) - "Parse the value of a key found in YASON-parsed JSON. -All ActivityPub objects (hash-tables containing “type”) will be parsed into -ActivityPub objects; all others will parsed into associative lists." - (typecase val - (hash-table (maybe-parse-table val)) - (list (mapcar (lambda (a) - (if (hash-table-p a) - (maybe-parse-table a) - a)) - val)) - (t val))) - -(defun maybe-parse-table (table) - "If a hash-table seems to be a valid ActivityPub object, attempt parsing it -into one. Otherwise, parse it into an associative list." - (if (gethash "type" table) - (parse-table table) - (alexandria:hash-table-alist table))) - - - -;;; JSON serialization -;;; ———————————————————————————————————————— -;; Note-worthy: See the above-defined DEFINE-YASON-ENCODE-SLOTS. -(defmethod yason:encode ((obj as-object) &optional (stream *standard-output*)) - (yason:with-output (stream) - (yason:encode-object obj))) - -(defmethod yason:encode-object ((obj as-object)) - (typecase *@context* - (null ; If this is the top-level (non-nested) object, establish a @context. - (let ((*@context* 'top-level)) - (yason:encode-object obj))) - (symbol ; In the top-level, encode slots and then @context. - (setq *@context* (slot-value obj '@context)) - (yason:with-object () - (yason:encode-slots obj) - (yason:encode-object-element "@context" *@context*))) - (T ; In nested objects, only encode slots — not *@context*. - (yason:with-object () - (yason:encode-slots obj))))) - -(defun class-slots-activity-alist (class) - "Return an associative list containing CLASSes slots’ symbols consed with -their sanitized string keys appropriate for ActivityVocabular custom. -A class with slots MAP-AWAY and COLLECTION-AGAIN would return - ((MAP-AWAY . “mapAway”)(COLLECTION-AGAIN . “collectionAgain”))" - (alist-mapcdr #'camel-case - (class-slots-alist class))) - -(defun merge-@contexts (a b) - "Given two @context lists, A and B, merge them into one JSON-LD @context list -containing both of their elements." - (cond ((equal a b) a) - ((not b) a) - ((not a) b) - ((and (listp a) - (find b a :test #'equal)) - a) - (T - (merge-lists - (if (listp a) a (list a)) - (if (listp b) b (list b)))))) - - - -;;; Util -;;; ———————————————————————————————————————— -(defun camel-case (string) - "Convert a STRING to camel-casing. That is, casingLikeThis. -Wrapper around STR:CAMEL-CASE, working around a bug that a non-alphanumeric -character at the start of the string gets erroneously (or at least undesireably, -to us) removed." - (keep-nonalphanumeric-prefix string - (str:camel-case string))) - -(defun param-case (string) - "Convert a STRING to param-casing. That is, casing-like-this. -Wrapper around STR:PARAM-CASE, working around a bug that a non-alphanumeric -character at the start of the string gets erroneously (or at least undesireably, -to us) removed." - (keep-nonalphanumeric-prefix string - (str:param-case string))) -(defun camel-case (str) - "Convert a STRING to camel-casing. -Wrapper around STR:CAMEL-CASE, working around a bug that a non-alphanumeric -character at the start of the string gets erroneously (or at least undesireably, -to us) removed." - (keep-nonalphanumeric-prefix str (str:camel-case str))) - -(defun keep-nonalphanumeric-prefix (str child-str) - "This ensures that a CHILD-STR derived from STR has the same nonalphanumeric -prefix as STR, as some functions like to remove such prefixes." - (if (not (alphanumericp (aref str 0))) - (concatenate 'string - (string (aref str 0)) - child-str) - child-str)) - -(defun class-pretty-name (class) - "Return a CLASS’es name in a “pretty” (sentence-capitalized) string." - (string-capitalize (symbol-name (class-name class)))) - -(defun merge-lists (a b) - "Given lists A and B, merge them into one list non-redundantly — all unique -items in each will be contained in the resultant list." - (append a (remove-if (lambda (item) (find item a :test #'equal)) b))) - -(defun find-registered-symbols (str) - "Find all symbols identified by string STR within packages in the -*ap-packages* list." - (mapcar (lambda (package) (find-symbol (string-upcase str) package)) - *ap-packages*)) - -(defun find-registered-classes (str) - "Find all classes identified by string STR within pacakges in the -*ap-packages* list." - (mapcar (lambda (sym) (find-class sym)) - (find-registered-symbols str))) - -(defun alist-mapcdr (function alist) - "Apply a FUNCTION to all values (cdrs) of an ALIST’s pairs. Returns a new ALIST -of the same keys, whose values are the results of FUNCTION." - (mapcar - (lambda (cell) - (cons (car cell) - (funcall function (cdr cell)))) - alist)) - -(defun class-slots-alist (class) - "Return an associative list of a CLASS’es direct slots (by symbol) matched with -their names as strings. For instance, a class with slots MAP-AWAY and -COLLECTION-AGAIN would return: - ((MAP-AWAY . “MAP-AWAY”)(COLLECTION-AGAIN . “COLLECTION-AGAIN”)" - (mapcar - (lambda (slot) - (let ((name (closer-mop:slot-definition-name slot))) - (cons name (symbol-name name)))) - (closer-mop:class-direct-slots class))) - - ;;; Defining YASON:ENCODE-SLOTS ;;; ———————————————————————————————————————— ;; On-the-fly define YASON:ENCODE-SLOTS for each of our distinct AP classes. -(mapcar (lambda (class) - (closer-mop:finalize-inheritance class) - (eval `(define-yason-encode-slots ,class))) - (mapcar #'find-class - '(as-object object link activity collection collection-page - ordered-collection ordered-collection-page place profile - relationship tombstone))) +(as/as:define-class-encoders + (mapcar #'find-class + '(object link activity collection collection-page ordered-collection + ordered-collection-page place profile relationship tombstone))) diff --git a/t/activity-vocabulary.lisp b/t/activity-streams.lisp similarity index 86% rename from t/activity-vocabulary.lisp rename to t/activity-streams.lisp index 6542e70..d8c0f23 100644 --- a/t/activity-vocabulary.lisp +++ b/t/activity-streams.lisp @@ -1,4 +1,4 @@ -;;;; activity-servist/tests/activity-vocabulary: Testing activity-vocabulary. +;;;; activity-servist/tests/activity-streams: Testing activity-streams. ;; Copyright © 2024 Jaidyn Levesque ;; @@ -15,19 +15,19 @@ ;; You should have received a copy of the GNU Affero General Public License ;; along with this program. If not, see . -(defpackage :activity-servist/tests/activity-vocabulary +(defpackage :activity-servist/tests/activity-streams (:use :cl :lisp-unit2) - (:nicknames "AS/T/AV") + (:nicknames "AS/T/AS") (:export :run :run-with-summary)) -(in-package :activity-servist/tests/activity-vocabulary) +(in-package :activity-servist/tests/activity-streams) (defun run () - "Run all ACTIVITY-VOCABULARY tests." - (lisp-unit2:run-tests :package :activity-servist/tests/activity-vocabulary)) + "Run all ACTIVITY-STREAMS tests." + (lisp-unit2:run-tests :package :activity-servist/tests/activity-streams)) (defun run-with-summary () - "Run tests with summary for ACTIVITY-VOCABULARY." + "Run tests with summary for ACTIVITY-STREAMS." (lisp-unit2:with-summary() (run))) @@ -37,7 +37,7 @@ ;;; ———————————————————————————————————————— (defmacro relative-pathname (path) "Return an absolute path adding the relative PATH to the system’s path." - `(asdf:system-relative-pathname :activity-servist/tests/activity-vocabulary ,path)) + `(asdf:system-relative-pathname :activity-servist/tests/activity-streams ,path)) (defmacro define-json-test (path tags) "Define a lisp-unit2 test for parsing of the given JSON file. @@ -52,7 +52,7 @@ ensuring they are semantically equivalent. White-space and key order are ignored (yason:parse (yason:with-output-to-string* () (yason:encode-object - (as/av:parse ,content))))))))) + (as/as:parse ,content))))))))) (defun sort-alist (alist predicate) "Sort an associative list by its keys." @@ -88,6 +88,6 @@ Any nested hash-tables found as values are also sorted, recursively." ;; Examples are taken from the spec: ;; https://www.w3.org/TR/activitystreams-vocabulary/ (mapcar (lambda (file) - (eval `(define-json-test ,file '(:core)))) + (eval `(define-json-test ,file '(:activity-vocabulary)))) (uiop:directory-files - (relative-pathname "t/activity-vocabulary/core/"))) + (relative-pathname "t/activity-streams/activity-vocabulary/"))) diff --git a/t/activity-vocabulary/core/activity.json b/t/activity-streams/activity-vocabulary/activity.json similarity index 100% rename from t/activity-vocabulary/core/activity.json rename to t/activity-streams/activity-vocabulary/activity.json diff --git a/t/activity-vocabulary/core/collection-page.json b/t/activity-streams/activity-vocabulary/collection-page.json similarity index 100% rename from t/activity-vocabulary/core/collection-page.json rename to t/activity-streams/activity-vocabulary/collection-page.json diff --git a/t/activity-vocabulary/core/collection.json b/t/activity-streams/activity-vocabulary/collection.json similarity index 100% rename from t/activity-vocabulary/core/collection.json rename to t/activity-streams/activity-vocabulary/collection.json diff --git a/t/activity-vocabulary/core/intransitive-activity.json b/t/activity-streams/activity-vocabulary/intransitive-activity.json similarity index 100% rename from t/activity-vocabulary/core/intransitive-activity.json rename to t/activity-streams/activity-vocabulary/intransitive-activity.json diff --git a/t/activity-vocabulary/core/link.json b/t/activity-streams/activity-vocabulary/link.json similarity index 100% rename from t/activity-vocabulary/core/link.json rename to t/activity-streams/activity-vocabulary/link.json diff --git a/t/activity-vocabulary/core/object.json b/t/activity-streams/activity-vocabulary/object.json similarity index 100% rename from t/activity-vocabulary/core/object.json rename to t/activity-streams/activity-vocabulary/object.json diff --git a/t/activity-vocabulary/core/ordered-collection-page.json b/t/activity-streams/activity-vocabulary/ordered-collection-page.json similarity index 100% rename from t/activity-vocabulary/core/ordered-collection-page.json rename to t/activity-streams/activity-vocabulary/ordered-collection-page.json diff --git a/t/activity-vocabulary/core/ordered-collection.json b/t/activity-streams/activity-vocabulary/ordered-collection.json similarity index 100% rename from t/activity-vocabulary/core/ordered-collection.json rename to t/activity-streams/activity-vocabulary/ordered-collection.json diff --git a/t/t.lisp b/t/t.lisp index bd22108..405eb0e 100644 --- a/t/t.lisp +++ b/t/t.lisp @@ -25,7 +25,7 @@ (defun run () "Run tests from all activity-servist subpackages." (activity-servist/tests/signatures:run) - (activity-servist/tests/activity-vocabulary:run)) + (activity-servist/tests/activity-streams:run)) (defun run-with-summary () "Run tests with summary for all activity-servist subpackages."