(in-package :odb)

(defclass cursor ()
  ((initialized-p :accessor cursor-initialized-p :initform nil)
   (primed-p :accessor cursor-primed-p :initform nil)))

(defclass database-cursor (cursor)
  ((handle :accessor handle :initarg :handle :initform 0)))

(defclass caching-database-cursor (database-cursor)
  ())

(defmethod make-cursor ((db database))
  (make-instance 'database-cursor :handle (db-cursor (handle db))))

(defmethod cursor-move ((cursor database-cursor) flags &optional (key +unspecific+))
  (when (%cursor-move cursor flags key)
    (values (datum->object *db-key*)
	    (datum->object *db-value*)
	    t)))

(defmethod make-cursor ((db caching-database))
  (make-instance 'caching-database-cursor :handle (db-cursor (handle db))))

(defmethod cursor-move ((cursor caching-database-cursor) flags &optional (key +unspecific+))
  (when (%cursor-move cursor flags key)
    (let* ((cached-objects (cached-objects *transaction*))
	   (id (parse-integer *db-key*))
	   (object (gethash id cached-objects)))
      (cond
	(object
	 (values id (reify object) t))
	((setf object (datum->object))
	 (values id (setf (gethash id cached-objects) object) t))))))

(defmethod cursor-current ((cursor cursor))
  (cursor-move cursor +db-current+))

(defmethod cursor-prev ((cursor database-cursor))
  (let ((primed-p (cursor-primed-p cursor)))
    (setf (cursor-primed-p cursor) nil)
    (if primed-p
	(cursor-move cursor +db-current+)
	(cursor-move cursor +db-prev+))))

(defmethod cursor-next ((cursor database-cursor))
  (let ((primed-p (cursor-primed-p cursor)))
    (setf (cursor-primed-p cursor) nil)
    (if primed-p
	(cursor-move cursor +db-current+)
	(cursor-move cursor +db-next+))))

(defmethod cursor-first ((cursor database-cursor) &key prime)
  (setf (cursor-primed-p cursor) nil)
  (multiple-value-bind (key value present-p) (cursor-move cursor +db-first+)
    (when present-p
      (setf (cursor-primed-p cursor) prime)
      (values key value t))))

(defmethod cursor-last ((cursor database-cursor) &key prime)
  (setf (cursor-primed-p cursor) nil)
  (multiple-value-bind (key value present-p) (cursor-move cursor +db-last+)
    (when present-p
      (setf (cursor-primed-p cursor) prime)
      (values key value t))))

(defmethod cursor-set ((cursor database-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)
    (if present-p
	(if (and from-end (not (lookup= key search-key)))
	    (multiple-value-bind (key value present-p) (cursor-prev cursor)
	      (when present-p
		(setf (cursor-primed-p cursor) prime)
		(values key value t)))
	    (multiple-value-prog1 (values key value t)
	      (setf (cursor-primed-p cursor) prime)))
	(when from-end
	  (cursor-last cursor :prime prime)))))

(defmacro with-cursor ((cursor btree &rest args) &body body)
  `(let ((,cursor (make-cursor ,btree)))
     (unwind-protect
         (progn
	   ,@(when args `((cursor-set ,cursor ,@args)))
	   ,@body)
       (when (typep ,cursor 'database-cursor)
	 (db-cursor-close (handle ,cursor))))))

(defun %cursor-move (cursor flags &optional (key +unspecific+))
  (db-cursor-move (handle cursor)
		  flags
		  (unless (eq key +unspecific+)
		    (let ((*print-id* :bare))
		      (prin1-to-string key)))))