diff of 694627ff3849b0de39228e4faecbe3696b359117
694627ff3849b0de39228e4faecbe3696b359117
diff --git a/aggressive-murja.asd b/aggressive-murja.asd
index 2a86a33..7de9c6b 100644
--- a/aggressive-murja.asd
+++ b/aggressive-murja.asd
@@ -28,7 +28,10 @@
"cl-date-time-parser"
"alexandria"
"uuid"
- "cl-hash-util")
+ "cl-hash-util"
+
+ ;; newui deps
+ "hunchensocket")
:description "A rewrite of the <a href=\"https://github.com/feuery/murja-blog/\">murja blogging engine</a> in lisp"
:components ((:module "src"
:components
@@ -37,6 +40,8 @@
(:file "halisql")
(:file "migrations")
(:file "json")))
+ (:module "murja-newui"
+ :components ((:file "newui")))
(:file "migration-list")
(:module "users"
:components ((:file "user-db")))
diff --git a/src/murja-newui/newui.lisp b/src/murja-newui/newui.lisp
new file mode 100644
index 0000000..1da028f
--- /dev/null
+++ b/src/murja-newui/newui.lisp
@@ -0,0 +1,187 @@
+(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))
diff --git a/src/murja-newui/test_ws.html b/src/murja-newui/test_ws.html
new file mode 100644
index 0000000..2322f14
--- /dev/null
+++ b/src/murja-newui/test_ws.html
@@ -0,0 +1,30 @@
+<html>
+ <body>
+ <textarea id="msgs"></textarea>
+ <br />
+ <button id="send">Send stuff </button>
+
+ <script>
+ window.addEventListener('DOMContentLoaded', _ => {
+ const socket = new WebSocket("http://localhost:12345/newui");
+ const msgs = document.querySelector('#msgs');
+ const sendbtn = document.querySelector('#send');
+
+ // Connection opened
+ socket.addEventListener("open", (event) => {
+ msgs.value += event;
+ msgs.value += "\n";
+ });
+
+ // Listen for messages
+ socket.addEventListener("message", (event) => {
+ msgs.value += event.data + "\n";
+ });
+
+ sendbtn.addEventListener('click', _ => {
+ socket.send('Aslan on hassu kissa');
+ });
+ });
+ </script>
+ </body>
+</html>