fork download
copy 
  1. (eval-when (:compile-toplevel :load-toplevel :execute)
  2.   (defun keywordize (symbol) (intern (string symbol) "KEYWORD")))
  3.  
  4. (defun this-year ()  (nth-value 5 (decode-universal-time (get-universal-time))))
  5.  
  6. (defgeneric slots-for-database (object)
  7.   (:method-combination append))
  8.  
  9. (defgeneric serialize (object))
  10.  
  11. (defclass entity ()
  12.   ())
  13.  
  14. (defmethod slots-for-database append ((entity entity))
  15.   '())
  16.  
  17. (defmethod serialize ((object entity))
  18.   (cons (class-name (class-of object))
  19.         (mapcar (lambda (slot) (slot-value object slot))
  20.                 (slots-for-database object))))
  21.  
  22. (defmethod print-object ((object entity) stream)
  23.   (print-unreadable-object (object stream :type t :identity t)
  24.     (format stream "~S" (mapcar (function list)
  25.                                 (slots-for-database object)
  26.                                 (rest (serialize object)))))
  27.   object)
  28.  
  29. (defun deserialize (class-and-fields)
  30.   (let ((object (make-instance (first class-and-fields))))
  31.     (loop
  32.       :for slot :in (slots-for-database object)
  33.       :for value :in (rest class-and-fields)
  34.       :do (setf (slot-value object slot) value))
  35.     object))
  36.  
  37. (defmacro define-entity (name (&rest slots-for-database) (&rest other-slots))
  38.   `(progn
  39.      (defclass ,name (entity)
  40.        ,(mapcar (lambda (field)
  41.                   `(,field :initarg ,(keywordize field) :accessor ,field :initform ""))
  42.          (append slots-for-database
  43.                  other-slots)))
  44.      (defmethod slots-for-database append ((object ,name))
  45.        ',slots-for-database)))
  46.  
  47. (define-entity person
  48.     (email gender lname fname dob address zip city)
  49.     (age))
  50.  
  51. (defmethod (setf dob) :after (new-dob (person person))
  52.   (setf (age person) (- (this-year) (parse-integer new-dob :junk-allowed t))))
  53.  
  54.  
  55. (setf *print-circle* t)
  56. (print (multiple-value-list
  57. (let ((foo  (make-instance 'person
  58.                                        :email "foo@example.com"
  59.                                        :gender "male"
  60.                                        :lname "foo" :fname "bar"
  61.                                        :dob "1970"
  62.                                        :address "Main Street, 42"
  63.                                        :zip "92134"
  64.                                        :city "Los Angeles")))
  65.   (values foo
  66.           (deserialize (serialize foo))))
  67. ))
Success #stdin #stdout 0.03s 33476KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
(#<PERSON ((EMAIL #1="foo@example.com") (GENDER #2="male") (LNAME #3="foo")
           (FNAME #4="bar") (DOB #5="1970") (ADDRESS #6="Main Street, 42")
           (ZIP #7="92134") (CITY #8="Los Angeles")) {1001CB28F3}>
 #<PERSON ((EMAIL #1#) (GENDER #2#) (LNAME #3#) (FNAME #4#) (DOB #5#)
           (ADDRESS #6#) (ZIP #7#) (CITY #8#)) {1001E073F3}>)
https://ideone.com/bPhR0S
serialize entity
language:
Common Lisp (sbcl 1.4.16)
created:
3 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!