src/views/middleware/newui-dispatcher.lisp

(defpackage murja.newui.dispatcher
  (:use :cl :murja.views.components.root :murja.views.components.tab :cl-hash-util :murja.models.tab)
  (:import-from :murja.middleware.db :@transaction)
  (:import-from :easy-routes :defroute)
  (:import-from :murja.newui :c :@newui)
  (:import-from :murja.routes.root-routes :@check-if-initial)
  (:import-from :murja.middleware.auth :@ssr-authenticated :*user*)
  (:export :@dispatcher :deftab))

(in-package :murja.newui.dispatcher)

(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)
  `(progn
     (setf (gethash (quote ,sym) *tabs*)
	   (make-instance 'tab :route ,route
			       :abilities ,needed-abilities
			       :require-login ,require-login
			       :title ,title
			       :component (lambda ()
					    (murja.middleware.db:with-db
						(let ((murja.middleware.db:*settings* (murja.settings:get-settings)))
						(c :div ()
						   ,@rst))))))
     
     (defroute ,(intern (format nil "~a-sym" sym)) (,route 
				   :method :get
				   :decorators (@transaction
						@newui
						(@ssr-authenticated :require-authentication ,require-login )
						@check-if-initial
						@dispatcher)) ()
       (quote ,sym))))
     
(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*))
      
      (root-component
       (tabs (title tab)
	     (remove-if-not (lambda (tab)
			      (or (not (require-login tab))
				  *user*))
			    (alexandria:hash-table-values 
			     *tabs*)))))))