;; query-view.lisp --- 

;; Copyright (C) 2008 Clinton Ebadi <clinton@unknownlamer.org>

;; Author: Clinton Ebadi <clinton@unknownlamer.org>

;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU Lesser General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU Lesser General Public License
;; along with this program.  If not, see <http://www.gnu.org/licenses/>.

(in-package :org.unknownlamer.golgonooza.web)

;; query driven view-view
;; Fetches current items using a query protocol
;; ISSUES
;;  Uncached query-paged-view is unusably consy / database intensive
;;  Names are perhaps bad; maybe FOO-query-view instead of query-FOO-view?
;;  Unpaged query-view does not support caching

(defcomponent query-view ()
  ((reverse :accessor reversep :initform nil :initarg :reverse)
   (%cache :initform nil :documentation "cons of current request and
cached instances. For internal use only.")
   (%count :initform nil :documentation "ephemeral cache of item
count. For internal use only.")))

;; Internal protocol
(defgeneric current-items (query-view))
(defgeneric total-items   (query-view))
(defgeneric limit (query-view))
(defgeneric skip (query-view))
(defgeneric minimum-item (query-view))
(defgeneric maximum-item (query-view))
(defgeneric query-view-total-instances (query-view)
  (:documentation "Ask the database for the total number of
  instances. By default this value is cached by
  view-view.total-items"))

(defmethod minimum-item ((view query-view))
  (declare (ignore view))
  nil)

(defmethod maximum-item ((view query-view))
  (declare (ignore view))
  nil)

(defmethod limit ((view query-view))
  (declare (ignore view))
  nil)

(defmethod skip ((view query-view))
  (declare (ignore view))
  nil)

(defmethod query-view-total-instances ((view query-view))
  (query-view-count-instances view (minimum-item view) (maximum-item view)))

(labels ((cache-valid-p (view %cache-slot)
	   (let ((%cache (slot-value view %cache-slot)))
	     (and %cache (eq (car %cache) (context.request *context*)))))
	 (update-cache (view %cache-slot new-value)
	   (setf (slot-value view %cache-slot)
		 (cons (context.request *context*) new-value))))
  ;; These use an ephemeral cache that survives only for the
  ;; request. It seems reasonable to ensure that the request has a
  ;; consistent view of the database, and this makes uncached views
  ;; usable.
  (defmethod current-items ((view query-view))
    (if (cache-valid-p view '%cache)
	(cdr (slot-value view '%cache))
	(cdr (update-cache view '%cache
			   (query-view-get-instances
			    view (minimum-item view) (maximum-item view)
			    :limit (limit view) :skip (skip view)
			    :from-end (reversep view))))))

  (defmethod total-items :around ((view query-view))
    (if (cache-valid-p view '%count)
	(cdr (slot-value view '%count))
	(cdr (update-cache view '%count (call-next-method))))))

;; End user protocol
(defgeneric query-view-get-instances (query-view lower upper 
 				      &key limit skip from-end exclusive))

(defgeneric query-view-count-instances (query-view min max)
  (:documentation "Count items in database between min and max"))

(defmethod query-view-count-instances ((query-view query-view) min max)
  "Default (inefficient) method for counting instances"
  (length (query-view-get-instances query-view min max)))

;; Extension mixins
(defcomponent query-ranged-view-mixin ()
  ((minimum :initarg :min   :initform nil :accessor minimum-item)
   (maximum :initarg :max   :initform nil :accessor maximum-item)
   (limit   :initarg :limit :initform nil :accessor limit)))

(defcomponent query-keyed-view-mixin ()
  ((query-key :initarg :query-key :accessor minimum-item :accessor maximum-item)))

(defcomponent query-paged-view-mixin ()
  ((offset :initarg :offset
		    :accessor page-offset
		    :initform 0
		    :backtrack t)
   (page-size :accessor page-size :initform 20
	      :initarg :page-size)))

;; Internal protocol
(defgeneric page-count (paged-query-view))

(defmethod initialize-instance :after ((r query-paged-view-mixin)
				       &key &allow-other-keys)
  (setf (page-offset r) (page-offset r)))

(defmethod page-count ((view query-paged-view-mixin))
  (ceiling (1- (/ (total-items view)
		  (page-size view)))))

(defmethod limit :around ((view query-paged-view-mixin))
  (let ((limit (call-next-method)))
    (if (and limit (> (* (page-offset view)
			 (page-size view))
		      limit))
	nil
	(page-size view))))

(defmethod skip :around ((view query-paged-view-mixin))
  (+ (or (call-next-method) 0)
     (* (page-size view) (page-offset view))))

(defmethod total-items ((view query-paged-view-mixin))
  (query-view-total-instances view))

(defmethod (setf page-offset) :around (new (view query-paged-view-mixin))
  (let ((count (page-count view)))
    (call-next-method (cond ((< new 0) 0)
			    ((> new count) count)
			    (t new))
		      view)))

;; Frontend/Navigation Protocol
(defgeneric/cc scroll-start (paged-query-view))
(defgeneric/cc scroll-end (paged-query-view))
(defgeneric/cc scroll-forward (paged-query-view &optional pages))
(defgeneric/cc scroll-backward (paged-query-view &optional pages))
(defgeneric/cc scroll-to-page (paged-query-view n))

(defmethod have-previous-page-p ((view query-paged-view-mixin))
  (not (zerop (page-offset view))))

(defmethod have-next-page-p ((view query-paged-view-mixin))
  (let ((base-item (car (last (current-items view)))))
    (if (reversep view)
	(query-view-get-instances view (minimum-item view) base-item
				  :limit 1 :from-end t :exclusive :upper)
	(query-view-get-instances view base-item (maximum-item view)
				  :limit 1 :exclusive :lower))))


(defmethod/cc scroll-start ((view query-paged-view-mixin))
  (setf (page-offset view) 0))

(defmethod/cc scroll-end ((view query-paged-view-mixin))
  (setf (page-offset view) (page-count view)))

(defmethod/cc scroll-forward ((view query-paged-view-mixin) &optional (n 1))
  (let ((offset (+ n (page-offset view))))
    (if (> offset (page-count view))
	(scroll-end view)
	(setf (page-offset view) offset))))

(defmethod/cc scroll-backward ((view query-paged-view-mixin) &optional (n 1))
  (let ((offset (- (page-offset view) n)))
    (if (<= offset 0)
	(scroll-start view)
	(setf (page-offset view) offset))))

(defmethod/cc scroll-to-page ((view query-paged-view-mixin) n)
  (cond ((< n 0) (scroll-start view))
	((> n (page-count view)) (scroll-end view))
	(t (setf (page-offset view) n))))

;; default rendering protocol
(defgeneric render-query-view-result (result query-view))

(defmethod render ((query-view query-view))
  (mapc (arnesi:rcurry #'render-query-view-result query-view)
	(current-items query-view)))

;; cached database view view

(defcomponent cached-query-paged-view-mixin (query-paged-view-mixin)
  ((total-items :accessor total-items)
   (current-items :initform nil :accessor current-items)))

(defmethod total-items ((view cached-query-paged-view-mixin))
  (if (slot-boundp view 'total-items)
      (slot-value view 'total-items)
      (setf (slot-value view 'total-items) (query-view-total-instances view))))

(defun query-view-get-forward (range old-offset new-offset)
  (let ((base-item (if (= old-offset new-offset)
		       (car (current-items range))
		       (car (last (current-items range)))))
	(skip (if (= new-offset old-offset)
		  0
		  (* (page-size range)
		     (1- (- new-offset old-offset)))))
	(exclusive (when (not (= old-offset new-offset))
		     (if (reversep range) :upper :lower)))
	(minimum (minimum-item range))
	(maximum (maximum-item range)))
    (if (reversep range)
	(query-view-get-instances range minimum (or base-item maximum)
				  :from-end t :limit (limit range) :skip skip
				  :exclusive exclusive)
	(query-view-get-instances range (or base-item minimum) maximum
				  :from-end nil :limit (limit range) :skip skip
				  :exclusive exclusive))))

(defun query-view-get-backward (range old-offset new-offset)
  (let ((base-item (car (current-items range)))
	(limit (page-size range))
	(skip (* (page-size range)
		 (1- (- old-offset new-offset))))
	(minimum (minimum-item range))
	(maximum (maximum-item range)))
    (if (reversep range)
	(query-view-get-instances range (or base-item minimum) maximum
				  :from-end nil :limit limit :skip skip
				  :exclusive :lower)
	(query-view-get-instances range minimum (or base-item maximum)
				  :from-end t :limit limit :skip skip
				  :exclusive :upper))))

(defun query-view-reload-instances (range old-offset new-offset)
  (setf
   (current-items range)
   (cond 
     ((>= new-offset old-offset)
      (query-view-get-forward range old-offset new-offset))
     ((< new-offset old-offset)
      (nreverse
       (query-view-get-backward range old-offset new-offset))))))

(defmethod (setf page-offset) :around (new-offset
				       (view cached-query-paged-view-mixin))
  (assert (>= new-offset 0) (new-offset))
  (let ((old-offset (page-offset view)))
    (call-next-method)
    (slot-makunbound view 'total-items)
    (query-view-reload-instances view old-offset new-offset)
    new-offset))

(defcomponent standard-query-view (query-ranged-view-mixin
				   cached-query-paged-view-mixin
				   query-view)
  ())