Clean up and use another design
This commit is contained in:
parent
7909196650
commit
d3a42aabaf
GPG key ID:
C374817BE285268F
3 changed files with 117 additions and 148 deletions
117
src/as2.lisp
Normal file
117
src/as2.lisp
Normal file
|
|
@ -0,0 +1,117 @@
|
||||||
|
;;;; -*- mode: common-lisp; coding: utf-8; -*-
|
||||||
|
|
||||||
|
(defpackage :ml-as2
|
||||||
|
(:use :cl)
|
||||||
|
(:export #:define-property-method
|
||||||
|
#:define-property-methods
|
||||||
|
#:object
|
||||||
|
#:link
|
||||||
|
#:attachment
|
||||||
|
#:attributed-to
|
||||||
|
#:audience
|
||||||
|
#:content
|
||||||
|
#:context
|
||||||
|
#:name
|
||||||
|
#:end-time
|
||||||
|
#:generator
|
||||||
|
#:icon
|
||||||
|
#:image
|
||||||
|
#:in-reply-to
|
||||||
|
#:location
|
||||||
|
#:preview
|
||||||
|
#:published
|
||||||
|
#:replies
|
||||||
|
#:start-time
|
||||||
|
#:summary
|
||||||
|
#:tag
|
||||||
|
#:updated
|
||||||
|
#:url
|
||||||
|
#:to
|
||||||
|
#:bto
|
||||||
|
#:cc
|
||||||
|
#:bcc
|
||||||
|
#:media-type
|
||||||
|
#:duration
|
||||||
|
#:href
|
||||||
|
#:rel
|
||||||
|
#:media-type
|
||||||
|
#:name
|
||||||
|
#:hreflang
|
||||||
|
#:height
|
||||||
|
#:width
|
||||||
|
#:preview))
|
||||||
|
|
||||||
|
(in-package #:ml-as2)
|
||||||
|
|
||||||
|
(defun kebab-camel (kebab-string)
|
||||||
|
"Transform KEBAB-STRING as kebab-case to camelCase."
|
||||||
|
(with-output-to-string (out)
|
||||||
|
(loop :with capitalize = nil
|
||||||
|
:for char :across kebab-string
|
||||||
|
:do (cond ((char= char #\-)
|
||||||
|
(setf capitalize t))
|
||||||
|
(capitalize
|
||||||
|
(write-char (char-upcase char) out)
|
||||||
|
(setf capitalize nil))
|
||||||
|
(t (write-char (char-downcase char) out))))))
|
||||||
|
|
||||||
|
(defclass property-container ()
|
||||||
|
((properties :initform (make-hash-table :test #'equal)
|
||||||
|
:accessor properties)))
|
||||||
|
|
||||||
|
(defmethod initialize-instance :after ((obj property-container) &key)
|
||||||
|
(setf (gethash "type" (properties obj))
|
||||||
|
(string-capitalize (class-name (class-of obj)))))
|
||||||
|
|
||||||
|
(defmacro define-property-method (class-name name)
|
||||||
|
`(defmethod ,name ((obj ,class-name) &optional value)
|
||||||
|
(let ((key ,(kebab-camel (string-downcase (symbol-name name)))))
|
||||||
|
(if value
|
||||||
|
(prog1 obj
|
||||||
|
(setf (gethash key (properties obj)) value))
|
||||||
|
(gethash key (properties obj))))))
|
||||||
|
|
||||||
|
(defmacro define-property-methods (class-name &rest property-names)
|
||||||
|
`(progn
|
||||||
|
,@(loop for name in property-names
|
||||||
|
collect `(define-property-method ,class-name ,name))))
|
||||||
|
|
||||||
|
(defclass object (property-container) ())
|
||||||
|
(define-property-methods object
|
||||||
|
attachment
|
||||||
|
attributed-to
|
||||||
|
audience
|
||||||
|
content
|
||||||
|
context
|
||||||
|
name
|
||||||
|
end-time
|
||||||
|
generator
|
||||||
|
icon
|
||||||
|
image
|
||||||
|
in-reply-to
|
||||||
|
location
|
||||||
|
preview
|
||||||
|
published
|
||||||
|
replies
|
||||||
|
start-time
|
||||||
|
summary
|
||||||
|
tag
|
||||||
|
updated
|
||||||
|
url
|
||||||
|
to
|
||||||
|
bto
|
||||||
|
cc
|
||||||
|
bcc
|
||||||
|
media-type
|
||||||
|
duration)
|
||||||
|
|
||||||
|
(defclass link (property-container) ())
|
||||||
|
(define-property-methods link
|
||||||
|
href
|
||||||
|
rel
|
||||||
|
media-type
|
||||||
|
name
|
||||||
|
hreflang
|
||||||
|
height
|
||||||
|
width
|
||||||
|
preview)
|
||||||
|
|
@ -1,33 +0,0 @@
|
||||||
;;;; -*- mode: common-lisp; coding: utf-8; -*-
|
|
||||||
|
|
||||||
(in-package :ml-as2)
|
|
||||||
|
|
||||||
(defclass application ()
|
|
||||||
((type :initarg :type
|
|
||||||
:initform "Application"
|
|
||||||
:accessor actor-type
|
|
||||||
:documentation "Any kind of software.")))
|
|
||||||
|
|
||||||
(defclass group ()
|
|
||||||
((type :initarg :type
|
|
||||||
:initform "Group"
|
|
||||||
:accessor actor-type
|
|
||||||
:documentation "Any kind of software.")))
|
|
||||||
|
|
||||||
(defclass organization ()
|
|
||||||
((type :initarg :type
|
|
||||||
:initform "Organization"
|
|
||||||
:accessor actor-type
|
|
||||||
:documentation "Any kind of software.")))
|
|
||||||
|
|
||||||
(defclass person ()
|
|
||||||
((type :initarg :type
|
|
||||||
:initform "Person"
|
|
||||||
:accessor actor-type
|
|
||||||
:documentation "Any kind of software.")))
|
|
||||||
|
|
||||||
(defclass service ()
|
|
||||||
((type :initarg :type
|
|
||||||
:initform "Service"
|
|
||||||
:accessor actor-type
|
|
||||||
:documentation "Any kind of software.")))
|
|
||||||
|
|
@ -1,115 +0,0 @@
|
||||||
;;;; -*- mode: common-lisp; coding: utf-8; -*-
|
|
||||||
|
|
||||||
(defpackage :ml-as2
|
|
||||||
(:use :cl)
|
|
||||||
(:export #:object))
|
|
||||||
|
|
||||||
(in-package :ml-as2)
|
|
||||||
|
|
||||||
(defclass object ()
|
|
||||||
((id :initarg :id
|
|
||||||
:accessor object-id
|
|
||||||
:documentation "The Object is the primary base type for the Activity Streams vocabulary.")
|
|
||||||
(type :initarg :type
|
|
||||||
:accessor object-type
|
|
||||||
:documentation "Identifies the Object or Link type.")
|
|
||||||
(attachment :initarg :attachment
|
|
||||||
:accessor object-attachment
|
|
||||||
:documentation "Identifies a resource attached or related to an object that potentially requires special handling.")
|
|
||||||
(attributed-to :initarg :attributed-to
|
|
||||||
:accessor object-attributed-to
|
|
||||||
:documentation "Identifies one or more entities to which this object is attributed.")
|
|
||||||
(audience :initarg :audience
|
|
||||||
:accessor object-audience
|
|
||||||
:documentation "Identifies one or more entities that represent the total population of entities for which the object can considered to be relevant.")
|
|
||||||
(content :initarg :content
|
|
||||||
:accessor object-content
|
|
||||||
:documentation "The content or textual representation of the Object encoded as a JSON string.")
|
|
||||||
(context :initarg :context
|
|
||||||
:accessor object-context
|
|
||||||
:documentation "Identifies the context within which the object exists or an activity was performed.")
|
|
||||||
(content-map :initarg :content-map
|
|
||||||
:accessor object-content-map
|
|
||||||
:documentation "The content or textual representation of the Object encoded as a language map.")
|
|
||||||
(name :initarg :name
|
|
||||||
:accessor object-name
|
|
||||||
:documentation "A simple, human-readable, plain-text name for the object.")
|
|
||||||
(name-map :initarg :name-map
|
|
||||||
:accessor object-name-map
|
|
||||||
:documentation "A language map of human-readable, plain-text names for the object.")
|
|
||||||
(end-time :initarg :end-time
|
|
||||||
:accessor object-end-time
|
|
||||||
:documentation "The date and time describing the actual or expected ending time of the object.")
|
|
||||||
(generator :initarg :generator
|
|
||||||
:accessor object-generator
|
|
||||||
:documentation "Identifies the entity that generated the object.")
|
|
||||||
(icon :initarg :icon
|
|
||||||
:accessor object-icon
|
|
||||||
:documentation "Indicates an entity that describes an icon for this object.")
|
|
||||||
(image :initarg :image
|
|
||||||
:accessor object-image
|
|
||||||
:documentation "Indicates an entity that describes an image for this object.")
|
|
||||||
(in-reply-to :initarg :in-reply-to
|
|
||||||
:accessor object-in-reply-to
|
|
||||||
:documentation "Indicates one or more entities for which this object is considered a response.")
|
|
||||||
(location :initarg :location
|
|
||||||
:accessor object-location
|
|
||||||
:documentation "Indicates one or more physical or logical locations associated with the object.")
|
|
||||||
(preview :initarg :preview
|
|
||||||
:accessor object-preview
|
|
||||||
:documentation "Identifies an entity that provides a preview of this object.")
|
|
||||||
(published :initarg :published
|
|
||||||
:accessor object-published
|
|
||||||
:documentation "The date and time at which the object was published.")
|
|
||||||
(replies :initarg :replies
|
|
||||||
:accessor object-replies
|
|
||||||
:documentation "Identifies a Collection containing objects considered to be responses to this object.")
|
|
||||||
(start-time :initarg :start-time
|
|
||||||
:accessor object-start-time
|
|
||||||
:documentation "The date and time describing the actual or expected starting time of the object.")
|
|
||||||
(summary :initarg :summary
|
|
||||||
:accessor object-summary
|
|
||||||
:documentation "A natural language summarization of the object encoded as HTML.")
|
|
||||||
(summary-map :initarg :summary-map
|
|
||||||
:accessor object-summary-map
|
|
||||||
:documentation "A language map of natural language summarizations of the object encoded as HTML.")
|
|
||||||
(tag :initarg :tag
|
|
||||||
:accessor object-tag
|
|
||||||
:documentation "One or more \"tags\" that have been associated with an objects. A tag can be any kind of Object.")
|
|
||||||
(updated :initarg :updated
|
|
||||||
:accessor object-updated
|
|
||||||
:documentation "The date and time at which the object was updated.")
|
|
||||||
(url :initarg :url
|
|
||||||
:accessor object-url
|
|
||||||
:documentation "Identifies one or more links to representations of the object.")
|
|
||||||
(to :initarg :to
|
|
||||||
:accessor object-to
|
|
||||||
:documentation "Identifies an entity considered to be part of the public primary audience of an Object.")
|
|
||||||
(bto :initarg :bto
|
|
||||||
:accessor object-bto
|
|
||||||
:documentation "Identifies an Object that is part of the private primary audience of this Object.")
|
|
||||||
(cc :initarg :cc
|
|
||||||
:accessor object-cc
|
|
||||||
:documentation "Identifies an Object that is part of the public secondary audience of this Object.")
|
|
||||||
(bcc :initarg :bcc
|
|
||||||
:accessor object-bcc
|
|
||||||
:documentation "Identifies one or more Objects that are part of the private secondary audience of this Object.")
|
|
||||||
(media-type :initarg :media-type
|
|
||||||
:accessor object-media-type
|
|
||||||
:documentation "When used on a Link, identifies the MIME media type of the referenced resource.")
|
|
||||||
(duration :initarg :duration
|
|
||||||
:accessor object-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.")))
|
|
||||||
|
|
||||||
(defgeneric to-plist (object)
|
|
||||||
(:documentation "Serialize an object to a plist. This function is independent from any JSON library, allowing serialization to a plist which can then be used to create a JSON string with any desired library."))
|
|
||||||
|
|
||||||
(defmethod to-plist ((obj object))
|
|
||||||
(loop :for slot :in (sb-mop:class-slots (class-of obj))
|
|
||||||
:for slot-name = (sb-mop:slot-definition-name slot)
|
|
||||||
:when (slot-boundp obj slot-name)
|
|
||||||
append (list (intern (symbol-name slot-name) "KEYWORD")
|
|
||||||
(let ((value (slot-value obj slot-name)))
|
|
||||||
(if (typep value 'object)
|
|
||||||
(to-plist value)
|
|
||||||
value)))))
|
|
||||||
Loading…
Add table
Reference in a new issue