;; Copyright (c) 2003-2005 Edward Marco Baringer
;; All rights reserved. 
;; 
;; Redistribution and use in source and binary forms, with or without
;; modification, are permitted provided that the following conditions are
;; met:
;; 
;;  - Redistributions of source code must retain the above copyright
;;    notice, this list of conditions and the following disclaimer.
;; 
;;  - Redistributions in binary form must reproduce the above copyright
;;    notice, this list of conditions and the following disclaimer in the
;;    documentation and/or other materials provided with the distribution.
;; 
;;  - Neither the name of Edward Marco Baringer, nor BESE, nor the names
;;    of its contributors may be used to endorse or promote products
;;    derived from this software without specific prior written permission.
;; 
;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
;; A PARTICULAR PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE COPYRIGHT
;; OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
;; LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

(in-package :org.unknownlamer.ucw-im)

(defclass range-cursor ()
  ((data :accessor range-cursor.data
                 :initarg :data
                 :documentation
                 "Data to range.")
   (chunk-size :accessor range-cursor.chunk-size
               :initarg :chunk-size
               :type integer
               :initform 20
               :documentation
               "Maximum number of elements in one chunk.")
   (offset :accessor range-cursor.offset
           :type integer
           :initarg :offset
           :initform 0
           :documentation
           "Current offset in chunks.")
   (recent-fetch-size :reader range-cursor.recent-fetch-size
                     :initform nil
                     :documentation
                     "Number of recently retrieved data elements."))
  (:documentation "Read chunks of elements from data at arbitrary offset."))

(defgeneric range-cursor.data-size (range-cursor data)
  (:method ((rc range-cursor) (rd sequence))
    (length rd))
  (:documentation "Return total number of elements in the DATA."))

(defgeneric range-cursor.fetch-data-chunk (range-cursor data offset length)
  (:method ((rc range-cursor) (data sequence) (offset integer) (length integer))
    (subseq data offset (+ offset length)))
  (:documentation "Read LENGTH elements from DATA starting from
OFFSET(excluding OFFSET element).
Return a list of elements."))

(defgeneric range-cursor.delete-data-item (range-cursor data item index)
  (:method ((rc range-cursor) (data sequence) item (index integer))
    (declare (ignore item))
    (when (<= index (length data))
      (setf (range-cursor.data rc)
            (delete-if (constantly t) data :start (1- index) :count 1))
      t))
  (:documentation "Delete ITEM with INDEX from cursor related DATA."))

(defgeneric range-cursor.add-data-item (range-cursor data item)
  (:method ((rc range-cursor) (data sequence) item)
    (push item (range-cursor.data rc))
    t)
  (:documentation "Add ITEM with INDEX to cursor related DATA."))

(defgeneric range-cursor.range-size (range-cursor)
  (:documentation "Return the size of the set in chunks."))

(defmethod range-cursor.range-size ((rc range-cursor))
  (with-slots (data chunk-size) rc
    (multiple-value-bind (q rem)
        (floor (range-cursor.data-size rc data) chunk-size)
      (if (zerop rem) q (1+ q)))))

(defmethod range-cursor.have-previous-p ((rc range-cursor))
  (> (range-cursor.offset rc) 0))

(defmethod range-cursor.have-next-p ((rc range-cursor))
  (aif (range-cursor.recent-fetch-size rc)
       (> it (range-cursor.chunk-size rc))
       t ; no reads yet
       ))

(defgeneric range-cursor.fetch-chunk (range-cursor op)
  (:documentation "Retrieve chunk from the data.
Returns a list of elements."))

(defmethod range-cursor.fetch-chunk :before ((rc range-cursor) op)
  (with-slots (offset recent-fetch-size) rc
    (setf offset
          (ecase op
            (:first 0)
            (:last (max (1- (range-cursor.range-size rc)) 0))
            (:next (if (and recent-fetch-size (range-cursor.have-next-p rc))
                       (1+ offset)
                       offset))
            (:previous (if (range-cursor.have-previous-p rc)
                           (1- offset)
                           offset))
            (:current (max 0 offset))))))

(defmethod range-cursor.fetch-chunk ((rc range-cursor) op)
  (declare (ignore op))
  (with-slots (chunk-size recent-fetch-size offset data) rc
    (let ((items (range-cursor.fetch-data-chunk rc data (* offset chunk-size) (1+ chunk-size))))
      (setf recent-fetch-size (length items))
      (if (> recent-fetch-size chunk-size)
          (butlast items)
          items))))

(defmethod range-cursor.delete-item ((rc range-cursor) item (index integer))
  "Delete ITEM with INDEX from cursor related DATA."
  (range-cursor.delete-data-item rc (range-cursor.data rc) item index))

(defmethod range-cursor.add-item ((rc range-cursor) item)
  "Add ITEM to cursor related DATA."
  (range-cursor.add-data-item rc (range-cursor.data rc) item))