Skip to content

Instantly share code, notes, and snippets.

@jmercouris
Last active February 26, 2019 18:33
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save jmercouris/1e66bbbf70e125ac024e32e2e349015b to your computer and use it in GitHub Desktop.
Save jmercouris/1e66bbbf70e125ac024e32e2e349015b to your computer and use it in GitHub Desktop.
(create-or-update
'reviews ;; class
(find-dao 'reviews :user user) ;; predicate
((slot-name . value) ;; values
(slot-name . value)))
(let ((object (find-dao 'reviews :user user)))
(if object
(progn
(setf (slot-accessor object) value)
(setf (slot-accessor object) value)
(update-dao object))
(make-instance 'reviews
:slot-initform value
:slot-initform value)))
(defmacro create-or-update (class predicate slot-values)
(let ((object (gensym)))
`(let ((,object ,predicate))
(if ,object
(progn
,@(loop for slot in slot-values
collect `(setf (,(car slot) ,object) ,(cdr slot))))
(save-dao
(make-instance
,class
,@(loop for (car . cdr) in slot-values
collect (list (intern (symbol-name car) "KEYWORD") cdr))))))))
CL-USER> (macroexpand-1 '(create-or-update
;; class
'fish
;; predicate accessor
(find-dao 'reviews :user user)
;; list of slots with new values
((review-text . review-value)
(review-title . review-title-value))))
(LET ((#:G558 (FIND-DAO 'REVIEWS :USER USER)))
(IF #:G558
(PROGN
(SETF (REVIEW-TEXT #:G558) REVIEW-VALUE)
(SETF (REVIEW-TITLE #:G558) REVIEW-TITLE-VALUE))
(SAVE-DAO
(MAKE-INSTANCE 'FISH (:REVIEW-TEXT REVIEW-VALUE)
(:REVIEW-TITLE REVIEW-TITLE-VALUE)))))
T
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment