src/views/middleware/newui-dispatcher.lisp

(defpackage murja.newui.dispatcher
  (:use :cl :murja.views.components.root :murja.views.components.tab :cl-hash-util)
  (:import-from :murja.newui :c)
  (:import-from :murja.middleware.auth :@ssr-authenticated :*user*)
  (:export :@dispatcher :deftab))

(in-package :murja.newui.dispatcher)

;; (defun @view-dispatcher (next)
;;   "Returns newui data structures based on whatever parameters next returns.

(defclass tab ()
  ((route :initarg :route :initform (error "Route needed") :accessor tab-route)
   (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)))

(defmethod print-object ((current-tab tab) output)
  (with-slots (route title needed-abilities) current-tab
    (format output "#<TAB: ~{~{~a: ~s~}~^,~%~t ~}>" (list
						     (list :route route)
						     (list :title title)
						     (list :needed-abilities needed-abilities)))))

(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
			 route
			 title
			 require-login
			 needed-abilities)
		  &body rst)
  `(setf (gethash (quote ,sym) *tabs*)
	 (make-instance 'tab :route ,route
			     :abilities ,needed-abilities
			     :require-login ,require-login
			     :title ,title
			     :component (lambda ()
					  (c :div ()
					     ,@rst)))))
(defun @dispatcher (next)
  (let* ((sym (funcall next))
	 (tab (gethash sym *tabs*))
	 (usr-abilities (when *user*
			  (coerce (murja.models.user:abilities *user*) 'list))))
    (assert tab)

    (when (or (not (abilities tab))
	      (intersection usr-abilities (abilities tab))
	      (or (not (require-login tab))
		  *user*))
	      
      (let ((tab-spec (hash)))
	(maphash (lambda (k v)
		   (declare (ignore k))
		   (format t "req login? ~a~%" (require-login v))
		   (when (or (not (require-login v))
			     *user*)
		     (setf (gethash (title v) tab-spec)
			   (funcall (tab-component v)))))
		 *tabs*)
      (root-component
       (tabs (title tab)
	     tab-spec))))))