Split activity-vocab package into two

Now, ACTIVITY-VOCABULARY solely contains class
definitions; all parsing/encoding is handled by
the ACTIVITY-STREAMS package.
This commit is contained in:
Jaidyn Ann 2024-06-23 14:56:19 -05:00
parent 5f1903b741
commit 56d4706557
13 changed files with 304 additions and 252 deletions

View File

@ -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 <jadedctrl@posteo.at>"
: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 <jadedctrl@posteo.at>"
: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 <jadedctrl@posteo.at>"
: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 <jadedctrl@posteo.at>"
: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)

270
src/activity-streams.lisp Normal file
View File

@ -0,0 +1,270 @@
;;;; activity-streams: Serialize/deserialize ActivityStreams objects.
;; Copyright © 2024 Jaidyn Ann <jadedctrl@posteo.at>
;;
;; 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 <https://www.gnu.org/licenses/>.
(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
objects 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
CLASSes 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 slots 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 CLASSes 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 ALISTs 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 CLASSes 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)))

View File

@ -1,4 +1,4 @@
;;;; activity-vocabulary: Classes for ActivityVocabulary types.
;;;; activity-vocabulary: Base classes for ActivityStreams.
;; Copyright © 2024 Jaidyn Ann <jadedctrl@posteo.at>
;;
@ -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
objects 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
CLASSes 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 CLASSes 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 ALISTs 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 CLASSes 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)))

View File

@ -1,4 +1,4 @@
;;;; activity-servist/tests/activity-vocabulary: Testing activity-vocabulary.
;;;; activity-servist/tests/activity-streams: Testing activity-streams.
;; Copyright © 2024 Jaidyn Levesque <jadedctrl@posteo.at>
;;
@ -15,19 +15,19 @@
;; You should have received a copy of the GNU Affero General Public License
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
(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 systems 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/")))

View File

@ -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."