marcuskammer/dev.metalisp.activitystreams
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Create as 2 object from hash table

Browse source
This commit is contained in:
Marcus Kammer 2024-10-05 13:50:32 +02:00
parent 2736eb4ff1
commit a798184ad7
Signed by: marcuskammer
GPG key ID: C374817BE285268F
1 changed files with 36 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

37
src/as2.lisp
View file

@ -92,8 +92,22 @@
(in-package #:ml-as2)
(defvar conflicting-type-names
'("block" "delete" "ignore" "read" "remove" "type" "first" "last")
"List of ActivityStream 2 names which are in conflict with reserved Common Lisp names.")
(defun camel-kebab (camel-string)
"Convert CAMEL-STRING as CamelCase to kebab-case."
(string-downcase
(with-output-to-string (out)
(write-char (char camel-string 0) out)
(loop for c across (subseq camel-string 1)
do (when (upper-case-p c)
(write-char #\- out))
(write-char c out)))))
(defun kebab-camel (kebab-string)
"Transform KEBAB-STRING as kebab-case to camelCase."
"Convert KEBAB-STRING as kebab-case to camelCase."
(with-output-to-string (out)
(loop :with capitalize = nil
:for char :across kebab-string
@ -104,6 +118,14 @@
(setf capitalize nil))
(t (write-char (char-downcase char) out))))))
(defun add-postfix (postfix string)
(concatenate 'string string postfix))
(defun add-as2-postfix (string)
(if (member string conflicting-type-names :test #'string=)
(add-postfix "-as2" string)
string))
(defun remove-postfix (postfix string)
"Remove the given postfix from the string if it exists."
(let* ((postfix-length (length postfix))
@ -121,6 +143,19 @@
(defun prepare-property-key (name)
(kebab-camel (remove-as2-postfix (string (symbol-name name)))))
(defun string-symbol (string)
(intern (string-upcase (add-as2-postfix (camel-kebab string))) :ml-as2))
(defun object-from-hash (hash-table)
"Create an AS2 object instance based on the 'type' field in the hash-table."
(let* ((type-string (gethash "type" hash-table "Object"))
(object-type-symbol (string-symbol type-string)))
(if (find-class object-type-symbol nil)
(let ((object (make-instance object-type-symbol)))
(setf (slot-value object 'properties) hash-table)
object)
(error "Unknown AS2 object type: ~A" type-string))))
(defclass property-container ()
((properties :initform (make-hash-table :test #'equal)
:accessor properties)))