sketch for a `defpolicy` macro in common lisp

policy.lisp

(defclass user ()
  ((name :reader user-name :initarg :name)
   (roles :reader user-roles :initarg :roles)))

(defclass role ()
  ((name :reader role-name :initarg :name)))

(defclass post ()
  ((author-name :reader author :initarg :author)
   (title :accessor post-title :initarg :title :initform nil)
   (body :accessor post-body :initarg :body :initform nil)))

(defun author? (user post) (string= (user-name user) (author post)))

(defclass policy ()
  ((check :reader policy-check :initarg :check)
   (action :reader policy-action :initarg :action)))

(defun make-policy (&key (check #'identity) action)
  (make-instance 'policy :check check :action action))

(defclass policy-set ()
    ((policies :accessor policies :initarg :policies)))

(defgeneric evaluate (policy-or-set user resource))

(defmethod evaluate ((policy-or-set policy) user resource)
  (with-slots (check action) policy-or-set
    (if (funcall check user)
        (or (funcall action user resource) 'policy-fail)
        'policy-fail)))

(defmethod evaluate ((policy-or-set policy-set) user (resource post))
  (loop for policy in (policies policy-or-set)
        for result = (evaluate policy user resource)
        when (not (equal result 'policy-fail))
        return result))

(defun all? (check lst)
  (flet ((check-and (acc val) (and acc (funcall check val))))
    (reduce #'check-and lst :initial-value T)))

(defun any? (check lst)
  (flet ((check-or (acc val) (or acc (funcall check val))))
    (reduce #'check-or lst :initial-value nil)))

(defun fulfills? (user role)
  (member (role-name role) (user-roles user) :test #'string=))

(defun fulfills-all? (user roles)
  (flet ((fulfilled? (role) (fulfills? user role)))
    (all? #'fulfilled? roles)))

;;; some roles...
(defparameter *admin-role* (make-role "admin"))
(defparameter *basic-role* (make-role "basic"))

;;; would like a macro that generates the following policy sets,
;; generic function and accompanying methods as needed
;; and looks something like:
;;
;; (defpolicy edit? (user post)
;;   (author? user post))
;;
;; (defpolicy edit? ((user "admin") post)
;;   T)
(defparameter *user-posts-edit?-policy-set*
  (make-instance
   'policy-set
   :policies (list
              (make-policy :check #'(lambda (user) user)
                           :action #'(lambda (user post) (author? user post)))
              (make-policy :check #'(lambda (user) (fulfills? user *admin-role*))
                           :action #'(lambda (user post) T)))))

(defgeneric edit? (user resource))

(defmethod edit? (user resource) nil)

(defmethod edit? (user (resource post))
  (evaluate *user-posts-edit?-policy-set* user resource))

;;; simple tests
(let ((post (make-instance 'post :author "test")))
  (let ((user (make-instance 'user :name "bob" :roles (list "admin"))))
    (print (edit? user post))) ;; => T

  (let ((user (make-instance 'user :name "bob" :roles (list "basic"))))
    (print (edit? user post))) ;; => nil

  (let ((user (make-instance 'user :name "test" :roles (list "basic"))))
    (print (edit? user post)))) ;; => T