
(defclass range ()
  ((low :initarg :low :accessor range-low)
   (high :initarg :high :accessor range-high)))

(defmethod print-object ((obj range) stream)
  (print-unreadable-object (obj stream :type t :identity t)
    (with-accessors ((low range-low) (high range-high)) obj
      (format stream ":LOW ~S :HIGH ~S" low high))))

(define-condition endpoints-swapped-error (error)
  ((low :initarg :low)
   (high :initarg :high)))

(defmethod print-object ((obj endpoints-swapped-error) stream)
  (print-unreadable-object (obj stream :type t)
    (with-slots (low high) obj
      (format stream ":LOW ~S :HIGH ~S" low high))))

(defun prompt-for-endpoint (which)
  (format *query-io* "Enter new value for ~A endpoint" which)
  (force-output *query-io*)
  (list (read *query-io*)))

(defun validate-range (range)
  (with-accessors ((low range-low) (high range-high)) range
    (restart-case
	(progn
	  (assert (realp low)  (low))
	  (assert (realp high) (high))
	  (unless (<= low high)
	    (error 'endpoints-swapped-error :low low :high high)))
      (set-low-endpoint (value)
	:report "Supply a new value for the low endpoint"
	  :interactive (lambda () (prompt-for-endpoint "low"))
	  (setf low value)
	  (validate-range range))
	(set-high-endpoint (value)
	  :report "Supply a new value for the high endpoint"
	  :interactive (lambda () (prompt-for-endpoint "high"))
	  (setf high value)
	  (validate-range range))
	(set-both-endpoints (new-low new-high)
	  :report "Supply new values for both endpoints"
	  :interactive (lambda () (append (prompt-for-endpoint "low")
					  (prompt-for-endpoint "high")))
	  (setf low new-low
		high new-high)
	  (validate-range range))
	(swap-endpoints ()
	  :report "Switch the values for the low and high endpoints"
	  (rotatef low high))))))

(defmethod initialize-instance :after ((obj range) &key)
  (validate-range obj))

(handler-bind ((endpoints-swapped-error #'(lambda (exception)
					    (declare (ignore exception))
					    (invoke-restart 'swap-endpoints)))
	       (simple-error #'(lambda (exception)
				 (invoke-restart 'set-both-endpoints 0 1))))
  (make-instance 'range :low "five" :high 10))

