bcup-closures.el

;;; bcup-closures.el ---  -*- lexical-binding: t -*-

;; Closure-manipulating function/macros
(defmacro enclose (arg)
  `(lambda () ,arg))
(defmacro enclose-args (&rest args)
  (let ((enclose-exprs
         (mapcar (lambda (arg) `(enclose ,arg)) args)))
    `(list ,@enclose-exprs)))
(defun unenclose (arg) (funcall arg))
(defalias 'enclosed-expr 'cadddr)

;; Version of `expect` that wraps matcher arguments in closures
(defmacro my-expect (arg matcher &rest args)
  `(apply (get ,matcher 'bcup-matcher)
          (enclose ,arg) (enclose-args ,@args)))

;; Define a matcher that expects to receive its arguments as
;; unevaluated closures
(defmacro bcup-define-uneval-matcher (matcher args &rest body)
  (declare (indent defun))
  `(put ,matcher 'bcup-matcher
        (lambda ,args
          ,@body)))

;; Define a matcher that expects to receive evaluted arguments (like
;; `buttercup-define-matcher'). BODY will automatically be wrapped in
;; the necessary closure-unpacking code, and therefore BODY will not
;; have access to the unevaluated expressions.
(defmacro bcup-define-matcher (matcher args &rest body)
  (declare (indent defun))
  (let* ((argnames (cl-set-difference args '(&optional &rest)))
         (arg-unpack-bindings
          (mapcar (lambda (argname) `(,argname (unenclose ,argname)))
                  argnames)))
    `(bcup-define-uneval-matcher ,matcher ,args
       (let (,@arg-unpack-bindings)
              ,@body))))

;; Same usage as `buttercup-define-matcher', for backward
;; compatibility
(bcup-define-matcher :to-be (a b)
  (if (eq a b)
      (cons t (format "Expected %S not to be `eq' to %S" a b))
    (cons nil (format "Expected %S to be `eq' to %S" a b))))

;; Let's test it
(message "Expect test 1 (no closures):\n%s"
         (pp-to-string
          (let ((x t)
                (y t)
                (z nil))
            (list
             (my-expect x :to-be y)
             (my-expect x :to-be z)))))

;; Now let's define a version that uses the unevaluated expressions to
;; generate better failure messages.
(bcup-define-uneval-matcher :to-be (a b)
  (if (eq (unenclose a) (unenclose b))
      (cons t (format "Expected %S not to be `eq' to %S, but it was" (enclosed-expr a) (unenclose b)))
    (cons nil (format "Expected %S to be `eq' to %S, but instead it was %S" (enclosed-expr a) (unenclose b) (unenclose a)))))

;; Same test, different matcher
(message "Expect test 2 (with closures):\n%s"
         (pp-to-string
          (let ((x t)
                (y t)
                (z nil))
            (list
             (my-expect x :to-be y)
             (my-expect x :to-be z)))))