Enable loading system using quickload

This commit is contained in:
Marcus Kammer 2024-10-05 19:58:43 +02:00
parent 01f03165ad
commit bad20cc769
Signed by: marcuskammer
GPG key ID: C374817BE285268F

View file

@ -131,34 +131,35 @@
;;; From Object to JSON
(defun kebab-camel (kebab-string)
"Convert 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))))))
(eval-when (:compile-toplevel :load-toplevel :execute)
(defun kebab-camel (kebab-string)
"Convert 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))))))
(defun remove-postfix (postfix string)
"Remove the given postfix from the string if it exists."
(let* ((postfix-length (length postfix))
(string-length (length string))
(index (- string-length postfix-length)))
(if (and (>= string-length postfix-length)
(string= postfix (subseq string index)))
(subseq string 0 index)
string)))
(defun remove-postfix (postfix string)
"Remove the given postfix from the string if it exists."
(let* ((postfix-length (length postfix))
(string-length (length string))
(index (- string-length postfix-length)))
(if (and (>= string-length postfix-length)
(string= postfix (subseq string index)))
(subseq string 0 index)
string)))
(defun remove-as2-postfix (string)
"Remove the '-as2' prefix from the given string."
(remove-postfix "-as2" (string-downcase string)))
(defun remove-as2-postfix (string)
"Remove the '-as2' prefix from the given string."
(remove-postfix "-as2" (string-downcase string)))
(defun prepare-property-key (name)
(kebab-camel (remove-as2-postfix (string (symbol-name name)))))
(defun prepare-property-key (name)
(kebab-camel (remove-as2-postfix (string (symbol-name name))))))
;;; CLOS related stuff
@ -314,3 +315,30 @@
(define-extend-class ignore-as2
block-as2)
;;; Actor Types
(define-extend-classes object
application
group
organization
person
service)
;;; Object and Link Types
(define-extend-classes object
relationship
article
document
event
place
profile
tombstone)
(define-extend-classes document
audio
image
video
note
page)