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
			 subtab 
			 require-login
			 needed-abilities
			 captured-route-params)
		  &body rst)
  `(progn
     (setf (gethash (quote ,sym) *tabs*)
	   (make-instance 'tab :route ,route
			       :abilities ,needed-abilities
			       :require-login ,require-login
			       :subtab ,subtab
			       :title ,title
			       :component (lambda ,captured-route-params
					    (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)) ()
       (values (quote ,sym) (list ,@captured-route-params)))))
     
(defun @dispatcher (next)
  (multiple-value-bind (sym route-params) (funcall next)
    (let* ((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))
				    (subtab tab)
				    *user*))
			      (alexandria:hash-table-values 
			       *tabs*))
	       route-params))))))