diff --git a/src/as2.lisp b/src/as2.lisp new file mode 100644 index 0000000..34a0a2f --- /dev/null +++ b/src/as2.lisp @@ -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) diff --git a/src/as2/actor.lisp b/src/as2/actor.lisp deleted file mode 100644 index 3771b02..0000000 --- a/src/as2/actor.lisp +++ /dev/null @@ -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."))) diff --git a/src/as2/base.lisp b/src/as2/base.lisp deleted file mode 100644 index 5415f97..0000000 --- a/src/as2/base.lisp +++ /dev/null @@ -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)))))