(in-package :odb)

(defclass sequence-cursor (cursor)
  ((sequence :accessor cursor-sequence :initarg :sequence :initform nil)
   length
   (index :accessor cursor-index :initarg :index :initform 0)))

(defmethod make-cursor ((sequence sequence))
  (make-instance 'sequence-cursor :sequence sequence))

(defun cursor-length (cursor)
  (with-caching-slot (cursor 'length)
    (length (cursor-sequence cursor))))

(defmethod cursor-current ((cursor sequence-cursor))
  (when (cursor-initialized-p cursor)
    (let ((index (cursor-index cursor))
	  (length (cursor-length cursor)))
      (if (and (plusp length) (< index length))
	  (let ((object (elt (cursor-sequence cursor) index)))
	    (setf (cursor-initialized-p cursor) t)
	    (values (key object) (value object) t))
	  (setf (cursor-initialized-p cursor) nil)))))

(defmethod cursor-prev ((cursor sequence-cursor))
  (if (cursor-initialized-p cursor)
      (cond
	((cursor-primed-p cursor)
	 (setf (cursor-primed-p cursor) nil)
	 (cursor-current cursor))
	((> (cursor-index cursor) 0)
	 (decf (cursor-index cursor))
	 (cursor-current cursor))
	(t
	 (setf (cursor-initialized-p cursor) nil)))
      (cursor-last cursor)))

(defmethod cursor-next ((cursor sequence-cursor))
  (if (cursor-initialized-p cursor)
      (cond
	((cursor-primed-p cursor)
	 (setf (cursor-primed-p cursor) nil)
	 (cursor-current cursor))
	((< (cursor-index cursor) (1- (cursor-length cursor)))
	 (incf (cursor-index cursor))
	 (cursor-current cursor))
	(t
	 (setf (cursor-initialized-p cursor) nil)))
      (cursor-first cursor)))

(defmethod cursor-first ((cursor sequence-cursor) &key prime)
  (when (plusp (cursor-length cursor))
    (setf (cursor-index cursor) 0
	  (cursor-initialized-p cursor) t
	  (cursor-primed-p cursor) prime)
    (cursor-current cursor)))

(defmethod cursor-last ((cursor sequence-cursor) &key prime)
  (let ((length (cursor-length cursor)))
    (when (plusp length)
      (setf (cursor-index cursor) (1- length)
	    (cursor-initialized-p cursor) t
	    (cursor-primed-p cursor) prime)
      (cursor-current cursor))))

(defmethod cursor-set ((cursor sequence-cursor) search-key &key from-end prime)
  (let ((sequence (cursor-sequence cursor))
	(length (cursor-length cursor)))
    (when (plusp length)
      (flet ((result (index key value)
	       (setf (cursor-index cursor) index
		     (cursor-initialized-p cursor) t
		     (cursor-primed-p cursor) prime)
	       (values key value t)))
	(if from-end
	    (loop for index from (1- length) downto 0
		  for object = (elt sequence index)
		  for key = (key object)
		  for value = (value object)
		  when (<= (compare key search-key) 0)
		  return (result index key value)
		  finally (setf (cursor-initialized-p cursor) nil))
	    (loop for index below length
		  for object = (elt sequence index)
		  for key = (key object)
		  for value = (value object)
		  when (>= (compare key search-key) 0)
		  return (result index key value)
		  finally (setf (cursor-initialized-p cursor) nil)))))))