src/view/components/tabs.lisp

(in-package :murja.view.components.tabs)

(defclass tab ()
  ((url :initarg :url :initform nil :accessor tab-url)
   (component :initarg :component :initform (error "Component needed") :accessor tab-component)
   (title :initarg :title :initform (error "Title needed") :accessor title)
   (require-login :initarg :require-login :initform nil :accessor require-login)
   (needed-abilities :initarg :abilities :initform nil :accessor abilities)
   (subtab :initarg :subtab :initform nil :accessor subtab)))

;; A hack for deducing runtime if a value is instanceof 'tab.
;; I got tired of trying to find a java-style instanceof operator that would polymorphically work for every value :D
(defmethod is-tab? ((tabb tab))
  t)

(defmethod is-tab? ((tabb t))
  nil)

(defmethod print-object ((tabb tab) output)
  (format output "#<TAB: ~a ~a>" (tab-url tabb) (title tabb)))


(eval-when (:compile-toplevel :load-toplevel :execute)
  (defvar *tabs* (make-hash-table :test 'equal)
    "A list of tabs, keyed by symbol and valued by instances of tab class"))

(defmacro deftab (sym (&key
			 url
			 (title "")
			 subtab
			 params
			 require-login
			 needed-abilities
			 captured-url-params
			 inject-to-head)
		  &body rst)
  `(progn
     (setf (gethash (quote ,sym) *tabs*)
	   (make-instance 'tab :url ,url 
			       :abilities (list ,@needed-abilities)
			       :require-login ,require-login
			       :subtab (quote ,subtab)
			       :title ,title
			       :component (lambda (&rest all)
					    (destructuring-bind ,captured-url-params all 
					      (murja.middleware.db:with-db
						  (with-html 
						    ,@rst))))))
     (defroute ,sym (,url 
		     :method :get
		     :decorators (@transaction
				  (@ssr-authenticated :require-authentication ,require-login )
				  ;;@check-if-initial
				  (@dispatcher ,inject-to-head)
				  ))
	 ,params
       (values (quote ,sym) (list ,@captured-url-params)))))

(defun tab-container (selected-tab tablist* tab-parameters)
  (assert (is-tab? selected-tab))
  (assert (every #'is-tab? tablist*))

  (let ((tablist (sort (copy-list tablist*)
		       (lambda (a b)
			 (string-lessp (title a) (title b))))))
    (assert (equalp (length tablist*) (length tablist)))
    
    (with-html
      (:div.tabs :id "topbar"
		 (:ul.tab-headers
		  (dolist (tab tablist)
		    (unless (subtab tab)
		      (:li :class (format nil "tab-header ~a" (if (equalp tab selected-tab)
								  "tab-selected"
								  ""))
			   ;; wonder if this is actually necessary or just an artifact of the old newui branch?
			   :data-href (tab-url tab)
			   (:a :href (tab-url tab)
			       (title tab))))))
		 (apply (tab-component selected-tab) tab-parameters)))))
  

(defun @dispatcher (next inject-to-head)
  (multiple-value-bind (sym url-params) (funcall next)
    (let* ((tab (gethash sym *tabs*))
	   ;; inject-to-head gets passed through to macros here as an unevaluated list
	   ;; and I don't understand why that happens, but this fixes the symptom and
	   ;; shouldn't expose too much vulnerabilities as :inject-to-head is trusted data 
	   (inject-to-head (map 'list
				#'eval
				inject-to-head))
	   (usr-abilities (when *user*
			    (coerce (murja.model.user:abilities *user*) 'list))))
      (assert tab)
      (if (or (not (abilities tab))
	      (intersection usr-abilities (abilities tab))
	      (or (not (require-login tab))
		  *user*))
	  (let ((*inject-to-head* inject-to-head))
	    (root-component
	     (tab-container tab 
			    (remove-if-not (lambda (tab)
					     (or (not (require-login tab))
						 (subtab tab)
						 *user*))
					   (alexandria:hash-table-values 
					    *tabs*))
			    url-params)))
	  (progn
	    (setf (hunchentoot:return-code*) 404)
	    "Nothing found")))))