src/murja-newui/newui.lisp

(defpackage murja.newui
  (:use :cl)
  (:import-from :cl-hash-util :hash))

(in-package :murja.newui)

(defclass ui-session (hunchensocket:websocket-resource)
  ((path :initarg :path :reader ui-path :initform "/newui"))
  (:default-initargs :client-class 'ui-user))

(defclass ui-user (hunchensocket:websocket-client)
  ((uid :initarg :uid :initform (uuid:make-v4-uuid) :reader uid)))

(defvar handlers (list (make-instance 'ui-session)))

(defun find-handler (request)
  (find (hunchentoot:script-name request) handlers :test #'string= :key #'ui-path))

(pushnew 'find-handler hunchensocket:*websocket-dispatch-table*)

(defmethod hunchensocket:client-connected ((session ui-session) (user ui-user))
  (format t "~a Connected!~%" (uid user)))

(defmethod hunchensocket:client-disconnected ((session ui-session) user)
  (format t "DisConnected!~%"))

(defmethod hunchensocket:text-message-received ((session ui-session) user message)
  (format t "~a said ~a~%" (uid user) message)
  (loop for peer in (hunchensocket:clients session)
	when (equalp (uid user) (uid peer))
          do (hunchensocket:send-text-message peer "hehe :D")))


;; html generator thing 

(defclass component ()
  ((tag :initarg :tag :initform (error "Gimme tag") :accessor tag)
   (attrs :initarg :attributes :initform (error "Gimme attributes") :accessor attrs)
   (children :accessor children :initarg :children :initform (error "Gimme kids"))))

(defgeneric render (c)
  (:documentation "Returns html of this (c ...) tree"))
(defgeneric rerender (c)
  (:documentation "Compiles c into html and pushes it into a websocket"))

(defclass state ()
  (;;(observers :initarg :observers :initform nil :accessor observers)
   (root-component :initarg :root :initform nil :accessor root-component)
   (root-component-generator :accessor root-component-generator)
   (state-map :initarg :state :initform (hash) :accessor state-map)))

(defclass event ()
  ((generated-js-id :accessor generated-js-id :initform (format nil "fn~a" (random 98765)))
   (closure :initarg :closure :initform (error "Gimme closure"))))

(defmethod set-state ((s state) key value)
  (with-slots (state-map root-component root-component-generator) s
    (setf (gethash key state-map) value)
    (setf root-component (funcall root-component-generator))
    (rerender root-component)))

(defmethod get-state ((s state) key)
  (gethash key (state-map s)))

(defsetf get-state set-state)

(defmethod render ((s string))
  s)

(defmethod render ((c component))
  (with-slots (tag attrs children) c
    (format nil "<~a ~{~a=\"~a\"~^ ~}>~%  ~{~a~}~%</~a>~%"
	    tag attrs (mapcar (lambda (kid) (render kid)) children) tag)))

(defmethod rerender ((c component))
  (format t "Rerending a component ~a~%" (render c)))

(defmethod render ((e event))
  "pääseeköhän tähän väliin?")

(defmethod render ((s state))
  (render (root-component s)))

(defmacro c (tag attrs &rest children)
  `(make-instance 'component
		  :tag ,tag
		  :attributes (list ,@attrs)
		  :children (list ,@children)))

(defun e (fn)
  (let ((ev (make-instance 'event :closure fn)))
    (setf (gethash (generated-js-id ev) *js-identifiers-in-scope*) ev)
    ev))

(defparameter *component-format-string* 
  "(c ~s (~{~s~^ ~}) ~{~s~^ ~})")

(defmethod print-object ((c component) out)
  (with-slots (tag attrs children) c
    (format out *component-format-string* tag attrs children)))

(defmethod print-object ((e event) out)
  (format out "~a();" (generated-js-id e)))
;; (with-slots (generated-js-id closure) e
;;   (format out "#<generated-js-id: ~a, closure: ~a>" generated-js-id (function-lambda-expression closure))))

(defmethod print-object ((s state) out)
  (format out
	  "(with-state (~{(~a ~a)~})
  ~a)" (alexandria:hash-table-plist (state-map s)) (root-component s)))
    
(defvar *current-state* nil)
(defvar *js-identifiers-in-scope* (hash))

(defmacro with-state (bindings &rest body)
  (let ((rewritten-symbols (map 'list #'first bindings)))
    (labels ((rewrite (element)
	       (cond ((listp element) (map 'list #'rewrite element))
		     ((member element rewritten-symbols) `(get-state current-state (quote ,element)))
		     (t element))))
      `(let ((current-state (make-instance 'state :state ,(reduce (lambda (m pair)
								    (destructuring-bind (k v &rest _) pair
								      (declare (ignore _))
								      (setf (gethash k m) v)
								      m))
								  bindings
								  :initial-value (hash)))))
	 (setf (root-component current-state)
	       ,@(rewrite body))
	 (setf (root-component-generator current-state) (lambda () ,@(rewrite body)))
	 current-state))))


;; (defun jännägetter (o)
;;   (second o))

;; (defun set-jännä (o value)
;;   (setf (second o) value)
;;   o)

;; (defsetf jännägetter set-jännä)

;; (setf 
;;  (jännägetter (list 1 2 3 4 5)) 555)
;; (1 555 3 4 5)
  

;; (with-state ((a 123)
;; 	     (b "lol")
;; 	     (c :Aaaa))
;;   (format t "Mitähän ~a on?~%" a)
;;   (setf a 7654222)
;;   (format t "Entä nyt? ~a~%" a))


;; jonkun osan tästä pitäisi palauttaa (values (joko komponentti puu tai html) (state-puu))
;; sitten websocket-listener kuulostelee jotain "CALL $id" eventtejä frontilta, ja osaa etsiä state-puusta oikean 0-arity closuren jota kutsua

;; (render
;;  (c :html (:lang "en")
;;    (c :head ()
;;       (c :style () "* { background-color: #880088; }")
;;       (c :link (:rel :stylesheet :src "/resources/murja.css")))

;;     (with-state ((linnunrata-vakio 42))
;; 		   (c :body ()
;; 		      (c :header () "Willkommen!")
;; 		      (c :div (:class "sidebar-flex")
;; 			 (c :div () (format nil "~d bugia korjaamatta" linnunrata-vakio))
;; 			 (c :button (:onclick (e (lambda ()
;; 						   (format t "lollero ~a~%" linnunrata-vakio)
;; 						   (decf linnunrata-vakio))))))))))
    
    
    
    

  
;; (setf *js-identifiers-in-scope* (hash))

;; (caar
;;  (alexandria:hash-table-alist
;;   *js-identifiers-in-scope*))


;; (with-slots (closure) (gethash "fn58386" *js-identifiers-in-scope*)
;;   (funcall closure))