(format nil "FLOAT(~A)" (car args))
"FLOAT"))
+(deftype generalized-boolean ()
+ "A type which outputs a SQL boolean value, though any lisp type can be stored in the slot."
+ t)
+
(defmethod database-get-type-specifier ((type (eql 'boolean)) args database db-type)
(declare (ignore args database db-type))
"BOOL")
+(defmethod database-get-type-specifier ((type (eql 'generalized-boolean)) args database db-type)
+ (declare (ignore args database db-type))
+ "BOOL")
+
(defmethod database-get-type-specifier ((type (eql 'number)) args database db-type)
(declare (ignore database db-type))
(cond
(declare (ignore database db-type))
(if val "t" "f"))
+(defmethod database-output-sql-as-type ((type (eql 'generalized-boolean)) val database db-type)
+ (declare (ignore database db-type))
+ (if val "t" "f"))
+
(defmethod database-output-sql-as-type ((type (eql 'string)) val database db-type)
(declare (ignore database db-type))
val)
(declare (ignore database db-type))
(equal "t" val))
+(defmethod read-sql-value (val (type (eql 'generalized-boolean)) database db-type)
+ (declare (ignore database db-type))
+ (equal "t" val))
+
(defmethod read-sql-value (val (type (eql 'number)) database db-type)
(declare (ignore database db-type))
(etypecase val
results)
+
+;;; Serialization functions
+
+(defun write-instance-to-stream (obj stream)
+ "Writes an instance to a stream where it can be later be read.
+NOTE: an error will occur if a slot holds a value which can not be written readably."
+ (let* ((class (class-of obj))
+ (alist '()))
+ (dolist (slot (ordered-class-slots (class-of obj)))
+ (let ((name (slot-definition-name slot)))
+ (when (and (not (eq 'view-database name))
+ (slot-boundp obj name))
+ (push (cons name (slot-value obj name)) alist))))
+ (setq alist (reverse alist))
+ (write (cons (class-name class) alist) :stream stream :readably t))
+ obj)
+
+(defun read-instance-from-stream (stream)
+ (let ((raw (read stream nil nil)))
+ (when raw
+ (let ((obj (make-instance (car raw))))
+ (dolist (pair (cdr raw))
+ (setf (slot-value obj (car pair)) (cdr pair)))
+ obj))))