(in-package :odb)

(defclass btree (persistent-object)
  ((new-kv-pairs :accessor new-kv-pairs)
   (removed-keys :accessor removed-keys)))

(defmethod initialize-instance :after ((btree btree) &key (new-kv-pairs '()) (removed-keys '()))
  (setf (new-kv-pairs btree) new-kv-pairs
	(removed-keys btree) removed-keys))

(defmethod commit-object :before ((btree btree))
  (let ((btrees (btrees *db*)))
    (loop for key in (removed-keys btree)
	  do (%delete btrees (cons btree key)))
    (loop for object in (new-kv-pairs btree)
          when object do (%put btrees (cons btree (key object)) (value object))))
  (setf (new-kv-pairs btree) '()
	(removed-keys btree) '()))

(defmethod get-value ((btree btree) key)
  (let ((object (find-key key (new-kv-pairs btree))))
    (cond (object (values (value object) t))
	  ((id btree) (get-value (btrees *db*) (cons btree key))))))

(defmethod (setf get-value) (value (btree btree) key)
  (prog1 value
    (touch btree)
    (let ((new-kv-pairs (new-kv-pairs btree)))
      (multiple-value-bind (object tail) (find-key key new-kv-pairs)
	(cond ((consp object) (setf (cdr object) value))
	      (tail (setf (first tail) (cons key value)))
	      (t (push (cons key value) (new-kv-pairs btree))))))
    (whereas ((key (find key (removed-keys btree) :test #'lookup=)))
      (deletef key (removed-keys btree)))))

(defmethod map-without-kv ((btree btree) key)
  (prog1 (touch btree)
    (whereas ((object (find-key key (new-kv-pairs btree))))
      (deletef object (new-kv-pairs btree)))
    (unless (sometree (lambda (x) (and (typep x 'id-mixin) (not (id x)))) key)
      (pushnew key (removed-keys btree) :test #'lookup=))))