From a798184ad7fa0ad7613503e1b9a72c01d30c5bf9 Mon Sep 17 00:00:00 2001
From: Marcus Kammer <marcus.kammer@mailbox.org>
Date: Sat, 5 Oct 2024 13:50:32 +0200
Subject: [PATCH] Create as 2 object from hash table

---
 src/as2.lisp | 37 ++++++++++++++++++++++++++++++++++++-
 1 file changed, 36 insertions(+), 1 deletion(-)

diff --git a/src/as2.lisp b/src/as2.lisp
index 71edfdd..1ec8887 100644
--- a/src/as2.lisp
+++ b/src/as2.lisp
@@ -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)))