Compare commits
No commits in common. "f98b5d81a9a0966137ad9dd2c522d71438718f8c" and "86b8d0a5144a95b24292d640122a9877605fd6f3" have entirely different histories.
f98b5d81a9
...
86b8d0a514
|
@ -17,48 +17,59 @@
|
|||
|
||||
(defpackage #:activity-servist/vocab/activity
|
||||
(:use #:cl)
|
||||
(:nicknames "AS/V/A" "ACTIVITY-VOCABULARY" "ACTIVITY")
|
||||
(:shadow #:block #:delete #:first #:ignore #:last #:listen #:read #:remove)
|
||||
(:nicknames "AS/V/A" "ACTIVITY-VOCABULARY")
|
||||
(:shadow #:block #:delete #:ignore #:listen #:read #:remove)
|
||||
;; One should never USE this package, since some class-names shadow
|
||||
;; core Common Lisp symbols! Beware! :P
|
||||
(:export
|
||||
;; Classes
|
||||
:accept :activity :actor :add :announce :application :arrive :article :audio
|
||||
:block :collection :collection-page :create :delete :dislike :document
|
||||
:event :flag :follow :group :ignore :image :intransitive-activity :invite
|
||||
:join :leave :like :link :listen :mention :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/Accessors
|
||||
:accuracy :actor :altitude :any-of :arrive :attachment :attributed-to
|
||||
:audience :bcc :bto :cc :closed :content :context :current :deleted
|
||||
:describes :duration :endpoints :end-time :first :followers :following
|
||||
:former-type :generator :height :href :hreflang :icon :image :inbox
|
||||
:in-reply-to :instrument :items :last :latitude :liked :location :longitude
|
||||
:media-type :name :next :object :one-of :ordered-items :origin :outbox
|
||||
:part-of :preferred-username :prev :preview :published :radius :rel
|
||||
:relationship :replies :result :start-index :start-time :streams :subject
|
||||
:summary :tag :target :to :total-items :units :updated :url :width))
|
||||
:accept :activity :add :announce :application :arrive :article :audio :block
|
||||
:collection :collection-page :create :delete :dislike :document :event :flag
|
||||
:follow :group :ignore :ignore :image :intransitive-activity :invite :join
|
||||
: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
|
||||
;; Accessors
|
||||
:activity-actor :activity-instrument :activity-object :activity-origin
|
||||
:activity-result :activity-target
|
||||
:collection-current :collection-first :collection-items :collection-last
|
||||
:collection-total-items
|
||||
:collection-page-next :collection-page-part-of :collection-page-prev
|
||||
:link-height :link-href :link-hreflang :link-media-type :link-name
|
||||
:link-preview :link-rel :link-summary :link-width
|
||||
:object-actor :object-attachment :object-attributed-to :object-audience
|
||||
:object-content :object-context :object-name :object-end-time
|
||||
:object-generator :object-icon :object-image :object-in-reply-to
|
||||
:object-location :object-preview :object-published :object-replies
|
||||
:object-start-time :object-summary :object-tag :object-updated
|
||||
:object-url :object-to :object-bto :object-cc :object-bcc
|
||||
:object-media-type :object-duration
|
||||
:ordered-collection-page-start-index ordered-collection-ordered-items
|
||||
:place-accuracy :place-altitude :place-latitude :place-longitude
|
||||
:place-radius :place-units
|
||||
:question-all-of :question-closed :question-one-of
|
||||
:profile-describes
|
||||
:relationship-object :relationship-relationship :relationship-subject
|
||||
:tombstone-former-type :tombstone-deleted))
|
||||
|
||||
(in-package #:activity-servist/vocab/activity)
|
||||
|
||||
(defmacro define-json-empty-types (superclasses context &rest direct-children)
|
||||
(defmacro define-json-empty-types (superclass context &rest direct-children)
|
||||
"For each list of DIRECT-CHILDREN, a “hollow” JSON subtype and CLOS subclass
|
||||
ofE SUPERCLASSES will be created, with the given JSON-LD context @CONTEXT.
|
||||
of SUPERCLASS will be created, with the given JSON-LD context CONTEXT.
|
||||
These new subclasses have no slots of its own — they will be empty derivatives
|
||||
of SUPERCLASSES.
|
||||
of SUPERCLASS.
|
||||
|
||||
Items of DIRECT-CHILDREN should be of the form,
|
||||
(CLASS-NAME “typeName” “Documenation-string describing the subclass.”)"
|
||||
(append
|
||||
'(progn)
|
||||
(mapcar (lambda (subclass-list)
|
||||
(let ((class-name (cl:first subclass-list))
|
||||
(type-name (second subclass-list))
|
||||
(documentation (third subclass-list)))
|
||||
`(json-ld:define-json-type (,class-name ,type-name) ,superclasses ,context
|
||||
(let ((class-name (first subclass-list))
|
||||
(type-name (second subclass-list))
|
||||
(documentation (third subclass-list)))
|
||||
`(json-ld:define-json-type (,class-name ,type-name) (,superclass) ,context
|
||||
()
|
||||
(:documentation ,documentation))))
|
||||
direct-children)))
|
||||
|
@ -155,51 +166,11 @@ The notion of “context” used is intentionally vague. The intended function i
|
|||
:documentation "Identifies the MIME media type of the value of the content property. If not specified, the content property is assumed to contain text/html content.")
|
||||
(duration
|
||||
"duration"
|
||||
:documentation "When the object describes a time-bound resource, such as an audio or video, a meeting, etc, the duration property indicates the object's approximate duration. The value MUST be expressed as an xsd:duration as defined by [ xmlschema11-2], section 3.3.6 (e.g. a period of 5 seconds is represented as “PT5S”).")
|
||||
|
||||
;; Required actor slots
|
||||
(inbox
|
||||
"inbox"
|
||||
:documentation "A reference to an OrderedCollection comprised of all the messages received by the actor.")
|
||||
(outbox
|
||||
"outbox"
|
||||
:documentation "An OrderedCollection comprised of all the messages produced by the actor.")
|
||||
(following
|
||||
"following"
|
||||
:documentation "A link to a collection of the actors that this actor is following.")
|
||||
(followers
|
||||
"followers"
|
||||
:documentation "A link to a collection of the actors that follow this actor.")
|
||||
|
||||
;; Optional Actor slots
|
||||
(liked
|
||||
"liked"
|
||||
:documentation "A link to a collection of objects this actor has liked.")
|
||||
(streams
|
||||
"streams"
|
||||
:documentation "A list of supplementary Collections which may be of interest.")
|
||||
(preferred-username
|
||||
"preferredUsername"
|
||||
:documentation "A short username which may be used to refer to the actor, with no uniqueness guarantees.")
|
||||
(endpoints
|
||||
"endpoints"
|
||||
:documentation "A JSON object which maps additional (typically server/domain-wide) endpoints which may be useful either for this actor or someone referencing this actor. This mapping may be nested inside the actor document as the value or may be a link to a JSON-LD document with these properties.
|
||||
May include the properties “proxyUrl”, “oauthAuthorizationEndpoint”, “oauthTokenEndpoint”, “provideClientKey”, “signClientKey”, and “sharedInbox”.
|
||||
See the spec for details on these properties: https://www.w3.org/TR/activitypub/#proxyUrl"))
|
||||
|
||||
;; Class docstring
|
||||
:documentation "When the object describes a time-bound resource, such as an audio or video, a meeting, etc, the duration property indicates the object's approximate duration. The value MUST be expressed as an xsd:duration as defined by [ xmlschema11-2], section 3.3.6 (e.g. a period of 5 seconds is represented as “PT5S”)."))
|
||||
(:documentation
|
||||
"Describes an object of any kind. The Object type serves as the base type for most of the other kinds of objects defined in the Activity Vocabulary, including other Core types such as Activity, IntransitiveActivity, Collection and OrderedCollection."))
|
||||
|
||||
|
||||
;; https://www.w3.org/TR/activitypub/#x4-actors
|
||||
;; A dummy ACTOR class, for convenience sake.
|
||||
(defclass actor ()
|
||||
()
|
||||
(:documentation "A dummy-class that represents an Actor ActivityPub object.
|
||||
There is, in reality, no “Actor” supertype in ActivityPub; but it might be useful in practice to treat all Actor-subtypes similarly in some cases, like method definition. Hence the existence of this class."))
|
||||
|
||||
|
||||
;; https://www.w3.org/ns/activitystreams#Link
|
||||
;; “summary” here isn’t real! It’s not a property Link should have (just
|
||||
;; looking at Link’s properties), but it’s implied by the Mention example.
|
||||
|
@ -332,7 +303,7 @@ In the [HTML5], any string not containing the “space” U+0020, “tab” (U+0
|
|||
|
||||
;;; Extended Activity types
|
||||
;;; ————————————————————————————————————————
|
||||
(define-json-empty-types (activity) "https://www.w3.org/ns/activitystreams"
|
||||
(define-json-empty-types activity "https://www.w3.org/ns/activitystreams"
|
||||
(accept "Accept" "Indicates that the actor accepts the object. The target property can be used in certain circumstances to indicate the context into which the object has been accepted.")
|
||||
(add "Add" "Indicates that the actor has added the object to the target. If the target property is not explicitly specified, the target would need to be determined implicitly by context. The origin can be used to identify the context from which the object originated.")
|
||||
(create "Create" "Indicates that the actor has created the object.")
|
||||
|
@ -410,7 +381,7 @@ Either of the ANY-OF and ONE-OF properties MAY be used to express possible answe
|
|||
|
||||
;;; Extended Actor types
|
||||
;;; ————————————————————————————————————————
|
||||
(define-json-empty-types (object actor) "https://www.w3.org/ns/activitystreams"
|
||||
(define-json-empty-types object "https://www.w3.org/ns/activitystreams"
|
||||
(application "Application" "Describes a software application.")
|
||||
(group "Group" "Represents a formal or informal collective of Actors.")
|
||||
(organization "Organization" "Represents an organization.")
|
||||
|
@ -421,14 +392,14 @@ Either of the ANY-OF and ONE-OF properties MAY be used to express possible answe
|
|||
|
||||
;;; Extended Object types
|
||||
;;; ————————————————————————————————————————
|
||||
(define-json-empty-types (object) "https://www.w3.org/ns/activitystreams"
|
||||
(define-json-empty-types object "https://www.w3.org/ns/activitystreams"
|
||||
(article "Article" "Represents any kind of multi-paragraph written work.")
|
||||
(document "Document" "Represents a document of any kind.")
|
||||
(note "Note" "Represents a short written work typically less than a single paragraph in length.")
|
||||
(event "Event" "Represents any kind of event."))
|
||||
|
||||
|
||||
(define-json-empty-types (document) "https://www.w3.org/ns/activitystreams"
|
||||
(define-json-empty-types document "https://www.w3.org/ns/activitystreams"
|
||||
(audio "Audio" "Represents an audio document of any kind.")
|
||||
(image "Image" "An image document of any kind.")
|
||||
(video "Video" "Represents a video document of any kind.")
|
||||
|
|
119
src/json-ld.lisp
119
src/json-ld.lisp
|
@ -25,10 +25,12 @@
|
|||
#:no-@context
|
||||
;; Globals
|
||||
#:*default-json-type*
|
||||
;; Classes
|
||||
#:object
|
||||
;; Slots/Accessors
|
||||
:@context :@id :@type :@etc))
|
||||
;; Objects
|
||||
#:json-ld-object
|
||||
;; Accessors
|
||||
#:json-ld-context #:json-ld-etc #:json-ld-id #:json-ld-type
|
||||
;; Slots
|
||||
:@context :@id :@type :.etc))
|
||||
|
||||
(in-package #:activity-servist/json-ld)
|
||||
|
||||
|
@ -40,7 +42,7 @@
|
|||
of this type. Should be a string, the IRI corresponding to a registered type.
|
||||
For example: “https://www.w3.org/ns/activitystreams#Object”
|
||||
|
||||
The default value “*” refers to the base JSON-LD:OBJECT type.")
|
||||
The default value “*” refers to the base JSON-LD-OBJECT type.")
|
||||
|
||||
(defvar *json-types* (make-hash-table :test #'equal)
|
||||
"Stores descriptions of each JSON-type, mapping type-IRI to class-name and property-name to slot-name.
|
||||
|
@ -60,52 +62,52 @@ Maps URLs to text-content, so we don’t have to download the same context again
|
|||
|
||||
;;; Base class
|
||||
;;; ————————————————————————————————————————
|
||||
(defclass object ()
|
||||
(defclass json-ld-object ()
|
||||
((@context
|
||||
:initform nil
|
||||
:documentation
|
||||
"Used as an override for a class’es @context during encoding.
|
||||
The method @CONTEXT is how the contents of encoded @context is
|
||||
The method JSON-LD-CONTEXT is how the contents of encoded @context is
|
||||
determined; to change a class’es default/calculated @context, override that
|
||||
method. This slot is for changing a specific object’s @context.")
|
||||
(@id
|
||||
:accessor @id
|
||||
:accessor json-ld-id
|
||||
:documentation
|
||||
"Provides the globally unique identifier for an object.")
|
||||
(@type
|
||||
:accessor @type
|
||||
:accessor json-ld-type
|
||||
:documentation
|
||||
"Identifies the type of an object. Used to determine the corresponding CLOS-object.")
|
||||
(@etc
|
||||
(.etc
|
||||
:initform nil
|
||||
:accessor @etc
|
||||
:accessor json-ld-etc
|
||||
:documentation
|
||||
"Components of the JSON object which, during parsing, did not match any specific
|
||||
slot. This is often filled up in the case of undefined node-types or non-adherent
|
||||
object definitions.")))
|
||||
|
||||
(setf (gethash "*" *json-types*)
|
||||
'((object)
|
||||
'((json-ld-object)
|
||||
("@context" @context . "@context")
|
||||
("@id" @id . "@id")
|
||||
("@type" @type . "@type")))
|
||||
|
||||
(defgeneric @context (obj)
|
||||
(defgeneric json-ld-context (obj)
|
||||
(:documentation
|
||||
"Returns a JSON-LD CLOS object’s @context, for use in JSON-encoding of the
|
||||
object.
|
||||
The implementation for the JSON-LD:OBJECT class simply returns the activitystreams
|
||||
The implementation for the JSON-LD-OBJECT class simply returns the activitystreams
|
||||
URL.
|
||||
If you would like to change @context on a class-level, override this method.
|
||||
If you would like to change it on an object-level, set the @CONTEXT slot."))
|
||||
|
||||
(defmethod @context ((obj object))
|
||||
(defmethod json-ld-context ((obj json-ld-object))
|
||||
(let ((slot-@context (slot-value obj '@context)))
|
||||
(unless (eq slot-@context 'no-@context)
|
||||
(or slot-@context
|
||||
"https://www.w3.org/ns/activitystreams"))))
|
||||
|
||||
(defmethod yason:encode-slots progn ((obj object))
|
||||
(defmethod yason:encode-slots progn ((obj json-ld-object))
|
||||
(flatten-contained-contexts obj)
|
||||
;; We only want to encode @context, @id, and @type if the child class doesn’t
|
||||
;; have its own alias for them.
|
||||
|
@ -117,9 +119,9 @@ If you would like to change it on an object-level, set the @CONTEXT slot."))
|
|||
(no-context-p (aliased-prop-p "@context" type-def))
|
||||
(no-id-p (aliased-prop-p "@id" type-def))
|
||||
(no-type-p (aliased-prop-p "@type" type-def))
|
||||
(context (@context obj))
|
||||
(id (and (slot-boundp obj '@id) (@id obj)))
|
||||
(type (and (slot-boundp obj '@type) (@type obj))))
|
||||
(context (json-ld-context obj))
|
||||
(id (and (slot-boundp obj '@id) (json-ld-id obj)))
|
||||
(type (and (slot-boundp obj '@type) (json-ld-type obj))))
|
||||
(when (and context (not no-context-p))
|
||||
(yason:encode-object-element "@context" context))
|
||||
(when (and id (not no-id-p))
|
||||
|
@ -129,9 +131,9 @@ If you would like to change it on an object-level, set the @CONTEXT slot."))
|
|||
(mapcar (lambda (alist-cell)
|
||||
(yason:encode-object-element (car alist-cell)
|
||||
(cdr alist-cell)))
|
||||
(@etc obj)))
|
||||
(json-ld-etc obj)))
|
||||
|
||||
(defmethod yason:encode ((obj object) &optional (stream *standard-output))
|
||||
(defmethod yason:encode ((obj json-ld-object) &optional (stream *standard-output))
|
||||
(yason:with-output (stream)
|
||||
(yason:encode-object obj)))
|
||||
|
||||
|
@ -150,9 +152,9 @@ encoding as @type’s value. If only the CLOS class-name is provided, @type will
|
|||
not be encoded for this object.
|
||||
|
||||
DIRECT-SUPERCLASSES is a list of JSON-LD CLOS classes, whose slots and context
|
||||
this should inherit. JSON-LD:OBJECT should be somewhere in the hierarchy, in order
|
||||
this should inherit. JSON-LD-OBJECT should be somewhere in the hierarchy, in order
|
||||
to provide “@context”, “@id”, and “@type”; if no superclasses are provided,
|
||||
JSON-LD:OBJECT is default.
|
||||
JSON-LD-OBJECT is default.
|
||||
|
||||
CONTEXT is a context hash-table, parsed from a JSON-LD context by JSON-LD:PARSE
|
||||
or JSON-LD:PARSE-CONTEXT. Any terms defined in this context will be used to
|
||||
|
@ -169,7 +171,8 @@ SLOT-OPTIONS are key/value pairs in the format of DEFCLASS’es slot-options.
|
|||
Keywords such as :INITFORM, :DOCUMENTATION, etc. can be used.
|
||||
There is one keyword with behavior unlike DEFCLASS, however — :ACCESSOR.
|
||||
|
||||
By default, a slot will have an accessor simply named after the slot.
|
||||
By default, a slot will have an accessor named after the class and slot, like
|
||||
PLACE-RADIUS for the class PLACE and the slot RADIUS.
|
||||
Set :ACCESSOR to NIL to define no accessor at all.
|
||||
|
||||
OPTIONS contains ordinary class options, in the format of DEFCLASS (for example,
|
||||
|
@ -202,11 +205,11 @@ Here is a brief example partially defining the “Place” type from ActivityStr
|
|||
;; Now, actually define the class, encoder, etc…
|
||||
`(let ((json-class
|
||||
(define-json-clos-class ,names
|
||||
,(or direct-superclasses `(json-ld:object))
|
||||
,(or direct-superclasses `(json-ld-object))
|
||||
,direct-slots
|
||||
,options)))
|
||||
(define-json-type-encoder ,(car names) ,direct-slots)
|
||||
(register-json-type ',names (or ',direct-superclasses '(json-ld:object)) ',direct-slots ,context)
|
||||
(register-json-type ',names (or ',direct-superclasses '(json-ld-object)) ',direct-slots ,context)
|
||||
json-class)))
|
||||
|
||||
(defmacro define-json-clos-class (names direct-superclasses direct-slots options)
|
||||
|
@ -229,12 +232,12 @@ See DEFINE-JSON-TYPE’s docstring for a description of parameters."
|
|||
"Return DEFCLASS-format slot options from DEFINE-JSON-TYPE-format SLOT-OPTS,
|
||||
applying default slot-options, etc."
|
||||
(json-type-normalize-slot-options
|
||||
(merge-plists (json-type-implicit-slot-options slot-name)
|
||||
(merge-plists (json-type-implicit-slot-options class-name slot-name)
|
||||
slot-opts)))
|
||||
|
||||
(defun json-type-implicit-slot-options (slot-name)
|
||||
(defun json-type-implicit-slot-options (class-name slot-name)
|
||||
"Return default property-list slot options for a json-type CLOS class."
|
||||
(list :accessor (intern (format nil "~A" slot-name))))
|
||||
(list :accessor (intern (format nil "~A-~A" class-name slot-name))))
|
||||
|
||||
(defun json-type-normalize-slot-options (slot-opts)
|
||||
"Take property-list slot options from a DEFINE-JSON-TYPE format and massage it
|
||||
|
@ -336,8 +339,8 @@ parsed into hash-tables) will be parsed into CLOS objects."
|
|||
(type (identify-json-type parsed-table ctx))
|
||||
(type-def (or (gethash type *json-types*)
|
||||
(gethash *default-json-type* *json-types*)))
|
||||
(valid-object-p type))
|
||||
(if (or valid-object-p (gethash ".always-object" ctx))
|
||||
(valid-object (or type (gethash "@id" table))))
|
||||
(if (or valid-object (gethash ".always-object" ctx))
|
||||
(parse-table-into-object parsed-table type-def ctx)
|
||||
parsed-table))))
|
||||
|
||||
|
@ -373,10 +376,10 @@ CTX is the according parsed-context."
|
|||
(lambda (property value)
|
||||
(let* ((property-def (assoc property type-def :test #'equal))
|
||||
(slot-name (second property-def))
|
||||
(etc-value (slot-value obj '@etc)))
|
||||
(etc-value (slot-value obj '.etc)))
|
||||
(if property-def
|
||||
(setf (slot-value obj slot-name) value)
|
||||
(setf (slot-value obj '@etc)
|
||||
(setf (slot-value obj '.etc)
|
||||
(append etc-value
|
||||
(list (cons property value)))))))
|
||||
table)
|
||||
|
@ -499,8 +502,8 @@ during JSON-encoding with YASON:ENCODE."
|
|||
(loop for subobj in (cdr (contained-json-objects obj))
|
||||
do
|
||||
(progn
|
||||
(let ((old-context (@context obj))
|
||||
(old-subcontext (@context subobj)))
|
||||
(let ((old-context (json-ld-context obj))
|
||||
(old-subcontext (json-ld-context subobj)))
|
||||
(when (and old-subcontext
|
||||
(not (equal old-context old-subcontext)))
|
||||
(setf (slot-value obj '@context)
|
||||
|
@ -511,7 +514,7 @@ during JSON-encoding with YASON:ENCODE."
|
|||
(setf (slot-value subobj '@context) 'no-@context))))
|
||||
|
||||
(defun json-slot-values (obj)
|
||||
"Return the values of all registered slots/properties of a JSON-LD:OBJECT.
|
||||
"Return the values of all registered slots/properties of a JSON-LD-OBJECT.
|
||||
Unregistered slots that don’t get encoded/decoded are ignored."
|
||||
(let* ((type-def (class-json-type-definition (class-name (class-of obj))))
|
||||
(slot-defs (cdr type-def)))
|
||||
|
@ -526,31 +529,31 @@ Unregistered slots that don’t get encoded/decoded are ignored."
|
|||
slot-defs)
|
||||
(mapcar (lambda (etc-cons)
|
||||
(cdr etc-cons))
|
||||
(slot-value obj '@etc))))))
|
||||
(slot-value obj '.etc))))))
|
||||
|
||||
(defun contained-json-objects (item)
|
||||
"Given ITEM of arbitrary type, return all JSON-LD:OBJECTs contained within,
|
||||
recursively. Lists, hash-tables, and the slots of JSON-LD:OBJECTs are explored."
|
||||
"Given ITEM of arbitrary type, return all JSON-LD-OBJECTs contained within,
|
||||
recursively. Lists, hash-tables, and the slots of JSON-LD-OBJECTs are explored."
|
||||
(typecase item
|
||||
(cons (reduce
|
||||
(lambda (a b)
|
||||
(append a b))
|
||||
(mapcar (lambda (a) (contained-json-objects a))
|
||||
item)))
|
||||
(hash-table (let ((ret '()))
|
||||
(maphash
|
||||
(lambda (k v)
|
||||
(setq ret
|
||||
(append ret (contained-json-objects v))))
|
||||
item)
|
||||
ret))
|
||||
(object (append
|
||||
(list item)
|
||||
(reduce
|
||||
(lambda (b c)
|
||||
(append b c))
|
||||
(mapcar (lambda (a) (contained-json-objects a))
|
||||
(json-slot-values item)))))))
|
||||
(cons (reduce
|
||||
(lambda (a b)
|
||||
(append a b))
|
||||
(mapcar (lambda (a) (contained-json-objects a))
|
||||
item)))
|
||||
(hash-table (let ((ret '()))
|
||||
(maphash
|
||||
(lambda (k v)
|
||||
(setq ret
|
||||
(append ret (contained-json-objects v))))
|
||||
item)
|
||||
ret))
|
||||
(json-ld-object (append
|
||||
(list item)
|
||||
(reduce
|
||||
(lambda (b c)
|
||||
(append b c))
|
||||
(mapcar (lambda (a) (contained-json-objects a))
|
||||
(json-slot-values item)))))))
|
||||
|
||||
|
||||
|
||||
|
|
|
@ -17,16 +17,7 @@
|
|||
|
||||
(defpackage #:activity-servist/vocab/litepub
|
||||
(:use #:cl)
|
||||
(:nicknames "AS/V/LP" "LITEPUB")
|
||||
(:export
|
||||
;; Classes
|
||||
:object
|
||||
:chat-message :emoji :emoji-react :hashtag :property-value
|
||||
;; Slots/Accessors
|
||||
:also-known-as :atom-uri :capabilities :conversation :direct-message-p
|
||||
:discoverablep :former-representations :invisiblep :list-message
|
||||
:manually-approves-followers-p :non-anonymous :public-key :quote-uri
|
||||
:quote-url :sensitivep :value))
|
||||
(:nicknames "AS/V/LP" "LITEPUB"))
|
||||
|
||||
(in-package #:activity-servist/vocab/litepub)
|
||||
|
||||
|
@ -35,7 +26,7 @@
|
|||
;;; ————————————————————————————————————————
|
||||
(defvar *litepub-uri* "https://jam.xwx.moe/schemas/litepub-0.1.jsonld"
|
||||
"The “Litepub” flavour we use is nicked directly from Pleroma; there is not a
|
||||
canonical URL for it. This URI will be used in encoded LITEPUB:OBJECTs in the
|
||||
canonical URL for it. This URI will be used in encoded LITEPUB-OBJECTs in the
|
||||
@CONTEXT.
|
||||
Defaults to a copy at jam.xwx.moe — because why not? ¯\_(ツ)_/¯")
|
||||
|
||||
|
@ -43,61 +34,35 @@ Defaults to a copy at jam.xwx.moe — because why not? ¯\_(ツ)_/¯")
|
|||
|
||||
;;; Core types
|
||||
;;; ————————————————————————————————————————
|
||||
(defclass object ()
|
||||
(defclass litepub-object ()
|
||||
()
|
||||
(:documentation "The base class used for Litepub objects."))
|
||||
|
||||
(json-ld:define-json-type (as/v/a:object "Object") (as/jld:object litepub:object) *litepub-uri*
|
||||
(json-ld:define-json-type (as/v/a:object "Object") (as/jld::json-ld-object litepub-object) *litepub-uri*
|
||||
((atom-uri
|
||||
"atomUri"
|
||||
:documentation "A string containing a URI to an Atom-feed alternative representation of an object.
|
||||
Potentially deprecated/very uncommon.")
|
||||
;; https://docs.joinmastodon.org/spec/activitypub/#sensitive
|
||||
(sensitivep
|
||||
(sensitive
|
||||
"sensitive"
|
||||
:documentation "A boolean value, representing whether or not an Object’s content is not necessarily generally appropriate. This will often hide the content, to some clients. SUMMARY will often be displayed in place of the content.")
|
||||
(non-anonymous
|
||||
"nonAnonymous"
|
||||
:documentation "I had no luck finding what this might mean, to be honest. ¯\_(ツ)_/¯
|
||||
Likely deprecated/highly uncommon.")
|
||||
(direct-message-p
|
||||
(direct-message
|
||||
"directMessage"
|
||||
:documentation "A boolean value commonly used to mark a Note as non-public, a direct message to be visible only to those in TO.
|
||||
Seemingly may be set in the Activity modifying the Note, or the Note itself.")
|
||||
(former-representations
|
||||
"formerRepresentations")
|
||||
|
||||
;; Actor properties
|
||||
(public-key
|
||||
"publicKey"
|
||||
:documentation "Contains an object representing a definition of the Actor’s public key, used for HTTP signatures.
|
||||
Generally contains the properties “id”, “owner”, “publicKeyPem”.")
|
||||
;; https://docs.joinmastodon.org/spec/activitypub/#discoverable
|
||||
(discoverablep
|
||||
"discoverable"
|
||||
:accessor actor-discoverable-p
|
||||
:documentation "A boolean value reflecting whether or not an Actor’s profile should be publically discoverable.")
|
||||
;; https://docs.joinmastodon.org/spec/activitypub/#as
|
||||
(manually-approves-followers-p
|
||||
"manuallyApprovesFollowers"
|
||||
:accessor actor-manually-approves-followers-p
|
||||
:documentation "A boolean value, communicating whether or not an Actor screens follow-requests.")
|
||||
;; https://docs.joinmastodon.org/spec/activitypub/#Move
|
||||
(also-known-as
|
||||
"alsoKnownAs"
|
||||
:accessor actor-also-known-as
|
||||
:documentation "When moving between two accounts, the old account sets this property to the URI of the new account.")
|
||||
(capabilities
|
||||
"capabilities"
|
||||
:accessor actor-capabilities
|
||||
:documentation "Contains a hash-table of capability-names mapped to a boolean, marking this Actor’s (server’s) support of capability.
|
||||
One known capabilitity-name is Pleroma’s “acceptsChatMessages”."))
|
||||
"formerRepresentations"))
|
||||
(:update 't))
|
||||
|
||||
|
||||
(json-ld:define-json-type (as/v/a:activity "Activity") (as/v/a:object) *litepub-uri*
|
||||
(;; https://blog.dereferenced.org/leveraging-json-ld-compound-typing-for-behavioural-hinting-in-activitypub
|
||||
(invisiblep
|
||||
(invisible
|
||||
"invisible"
|
||||
:documentation "A boolean value hinting as to whether or not the result of an Activity should be invisible to the end-user.
|
||||
Potentially deprecated/very uncommon.")
|
||||
|
@ -109,7 +74,7 @@ Potentially deprecated/very uncommon.")
|
|||
|
||||
;; https://schema.org/PropertyValue
|
||||
(json-ld:define-json-type (property-value "PropertyValue")
|
||||
(litepub:object json-ld:object) *litepub-uri*
|
||||
(litepub-object json-ld:json-ld-object) *litepub-uri*
|
||||
(;; https://schema.org/value
|
||||
(value
|
||||
"value"
|
||||
|
@ -138,6 +103,34 @@ The target and origin typically have no defined meaning.")
|
|||
(:documentation "This activity is similar to Like activity. In addition to standard properties of Like activity, EmojiReact activity MUST have a content property. Reaction content MUST be either a single unicode grapheme, or a shortcode of a custom emoji. If custom emoji is used, EmojiReact activity MUST have a tag property containing a single Emoji object."))
|
||||
|
||||
|
||||
|
||||
;;; Extended Actor types
|
||||
;;; ————————————————————————————————————————
|
||||
(json-ld:define-json-type (as/v/a:person "Person") (as/v/a:object) *litepub-uri*
|
||||
(;; https://docs.joinmastodon.org/spec/activitypub/#discoverable
|
||||
(public-key
|
||||
"publicKey"
|
||||
:documentation "Contains an object representing a definition of the user’s public key, used for HTTP signatures.
|
||||
Generally contains the properties “id”, “owner”, “publicKeyPem”.")
|
||||
(discoverable
|
||||
"discoverable"
|
||||
:documentation "A boolean value reflecting whether or not a profile should be publically discoverable.")
|
||||
;; https://docs.joinmastodon.org/spec/activitypub/#as
|
||||
(manually-approves-followers
|
||||
"manuallyApprovesFollowers"
|
||||
:documentation "A boolean value, communicating whether or not a profile screens follow-requests.")
|
||||
;; https://docs.joinmastodon.org/spec/activitypub/#Move
|
||||
(also-known-as
|
||||
"alsoKnownAs"
|
||||
:documentation "When moving between two accounts, the old account sets this property to the URI of the new account.")
|
||||
(capabilities
|
||||
"capabilities"
|
||||
:documentation "Contains a hash-table of capability-names mapped to a boolean, marking this Person’s (server’s) support of capability.
|
||||
One known capabilitity-name is Pleroma’s “acceptsChatMessages”."))
|
||||
(:documentation "Represents an individual person.")
|
||||
(:update 't))
|
||||
|
||||
|
||||
|
||||
;;; Extended Object types
|
||||
;;; ————————————————————————————————————————
|
||||
|
@ -196,6 +189,6 @@ In case of doubt, QUOTE-URL is preferred."))
|
|||
;;; Extended Link types
|
||||
;;; ————————————————————————————————————————
|
||||
;; https://docs.joinmastodon.org/spec/activitypub/#Hashtag
|
||||
(json-ld:define-json-type (hashtag "Hashtag") (as/v/a:link litepub:object) *litepub-uri*
|
||||
(json-ld:define-json-type (hashtag "Hashtag") (as/v/a:link litepub-object) *litepub-uri*
|
||||
()
|
||||
(:documentation "Similar to Mentions, a Hashtag is used to link a post to given topics. Should be stored in a TAG slot, and contain NAME (#hashtag) and HREF (link to a server’s hashtag listing)."))
|
||||
|
|
|
@ -17,7 +17,7 @@
|
|||
|
||||
(defpackage :activity-servist/tests/vocab/activity
|
||||
(:use :cl :lisp-unit2)
|
||||
(:nicknames "AS/T/V/A")
|
||||
(:nicknames "AS/T/V/AV")
|
||||
(:export :run :run-with-summary))
|
||||
|
||||
(in-package :activity-servist/tests/vocab/activity)
|
||||
|
|
Ŝarĝante…
Reference in New Issue