(in-package :odb)

(defclass btree-cursor (database-cursor)
  ((id :accessor id :initarg :id :initform nil)))

(defmethod make-cursor ((btree btree))
  (make-instance 'btree-cursor :handle (db-cursor (handle (btrees *db*))) :id (id btree)))

(defmethod cursor-move ((cursor btree-cursor) flags &optional (key +unspecific+))
  (call-next-method cursor flags (if (eq key +unspecific+) +unspecific+ (cons (id cursor) key))))

(defmethod cursor-prev ((cursor btree-cursor))
  (let ((primed-p (cursor-primed-p cursor)))
    (setf (cursor-primed-p cursor) nil)
    (if (cursor-initialized-p cursor)
	(if primed-p
	    (cursor-current cursor)
	    (multiple-value-bind (key value present-p) (cursor-move cursor +db-prev+)
	      (if (and present-p (= (car key) (id cursor)))
		  (values (cdr key) value t)
		  (setf (cursor-initialized-p cursor) nil))))
	(cursor-last cursor))))

(defmethod cursor-next ((cursor btree-cursor))
  (let ((primed-p (cursor-primed-p cursor)))
    (setf (cursor-primed-p cursor) nil)
    (if (cursor-initialized-p cursor)
	(if primed-p
	    (cursor-current cursor)
	    (multiple-value-bind (key value present-p) (cursor-move cursor +db-next+)
	      (if (and present-p (= (car key) (id cursor)))
		  (values (cdr key) value t)
		  (setf (cursor-initialized-p cursor) nil))))
	(cursor-first cursor))))

(defmethod cursor-first ((cursor btree-cursor) &key prime)
  (setf (cursor-primed-p cursor) nil)
  (multiple-value-bind (key value present-p) (cursor-move cursor +db-set-range+ nil)
    (if (and present-p (= (car key) (id cursor)))
        (multiple-value-prog1 (values (cdr key) value t)
          (setf (cursor-initialized-p cursor) t
		(cursor-primed-p cursor) prime))
        (setf (cursor-initialized-p cursor) nil))))

(defmethod cursor-last ((cursor btree-cursor) &key prime)
  (setf (cursor-primed-p cursor) nil)
  (if (%cursor-move cursor +db-set-range+ (cons (1+ (id cursor)) nil))
      (multiple-value-bind (key value present-p)
	  (progn
	    (setf (cursor-initialized-p cursor) t)
	    (cursor-prev cursor))
	(when present-p
	  (setf (cursor-primed-p cursor) prime)
	  (values key value t)))
      (multiple-value-bind (key value present-p) (cursor-move cursor +db-last+)
        (if (and present-p (= (car key) (id cursor)))
            (multiple-value-prog1 (values (cdr key) value t)
              (setf (cursor-initialized-p cursor) t
		    (cursor-primed-p cursor) prime))
            (setf (cursor-initialized-p cursor) nil)))))

(defmethod cursor-set ((cursor btree-cursor) search-key &key from-end prime)
  (setf (cursor-primed-p cursor) nil)
  (multiple-value-bind (key value present-p) (cursor-move cursor +db-set-range+ search-key)
    (cond
      ((and present-p (= (car key) (id cursor)))
       (if (and from-end (lookup/= (cdr key) search-key))
	   (multiple-value-bind (key value present-p)
	       (progn
		 (setf (cursor-initialized-p cursor) t)
		 (cursor-prev cursor))
	     (when present-p
	       (setf (cursor-primed-p cursor) prime)
	       (values key value t)))
	   (multiple-value-prog1 (values (cdr key) value t)
	     (setf (cursor-initialized-p cursor) t
		   (cursor-primed-p cursor) prime))))
      (from-end
       (cursor-last cursor :prime prime))
      (t
       (setf (cursor-initialized-p cursor) nil)))))