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