diff of fba573be376026c63666ece8cd50f10da2fa95f0
fba573be376026c63666ece8cd50f10da2fa95f0
diff --git a/aggressive-murja.asd b/aggressive-murja.asd
index 23a1326..0c4ea18 100644
--- a/aggressive-murja.asd
+++ b/aggressive-murja.asd
@@ -40,25 +40,26 @@
(:file "halisql")
(:file "migrations")
(:file "json")))
- (:module "murja-newui"
- :components ((:file "newui")
- (:file "simpledate")))
(:file "migration-list")
(:file "settings")
-
(:module "users"
:components ((:file "user-db")))
+
(:file "session-db")
-
(:module "models"
:components
((:file "user")
- (:file "post")))
-
+ (:file "post")
+ (:file "tab")))
+
(:module "middleware"
:components ((:file "json")
(:file "db")
(:file "auth")))
+
+ (:module "murja-newui"
+ :components ((:file "newui")
+ (:file "simpledate")))
(:file "session")
(:module "posts"
:components
diff --git a/resources/js/newui.js b/resources/js/newui.js
index 46093bf..13ec8d6 100644
--- a/resources/js/newui.js
+++ b/resources/js/newui.js
@@ -25,6 +25,7 @@ window.addEventListener('DOMContentLoaded', _ => {
// Listen for messages
socket.addEventListener("message", (event) => {
+ console.log(`got newui message ${event.data}`);
let split = event.data.split(':');
let key = split[0];
switch(key) {
@@ -43,8 +44,10 @@ window.addEventListener('DOMContentLoaded', _ => {
});
function send(event) {
+ console.log(`Calling ${event}`);
if(!session_id) { alert('Session id is damaged'); return; }
if(!checkOpen()) { handleClosed(); return; }
socket.send(`sessionid:${session_id};CALL:${event}`);
+ console.log(`Called ${event}`);
}
diff --git a/src/middleware/db.lisp b/src/middleware/db.lisp
index 8a08c3b..408e56c 100644
--- a/src/middleware/db.lisp
+++ b/src/middleware/db.lisp
@@ -3,6 +3,7 @@
(:export :connect-murjadb-toplevel
:@transaction
:with-db
+ :*settings*
:*automatic-tests-on?*))
(in-package :murja.middleware.db)
diff --git a/src/models/tab.lisp b/src/models/tab.lisp
new file mode 100644
index 0000000..03335fd
--- /dev/null
+++ b/src/models/tab.lisp
@@ -0,0 +1,12 @@
+(defpackage murja.models.tab
+ (:use :cl)
+ (:export :tab :tab-route :tab-component :title :require-login :abilities))
+
+(in-package :murja.models.tab)
+
+(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)))
diff --git a/src/murja-newui/newui.lisp b/src/murja-newui/newui.lisp
index 43e1a0a..9e150ce 100644
--- a/src/murja-newui/newui.lisp
+++ b/src/murja-newui/newui.lisp
@@ -6,6 +6,8 @@
(in-package :murja.newui)
+(defvar *stop-escape* nil)
+
;; pitäiskö nää olla uniikkeja per käyttäjä 🤔
(defclass ui-session (hunchensocket:websocket-resource)
((path :initarg :path :reader ui-path :initform "/newui"))
@@ -84,6 +86,7 @@
(defclass event ()
((generated-js-id :accessor generated-js-id :initform (format nil "fn~a" (random 98765)))
+ (post-js :accessor post-js :initform "" :initarg :post-js)
(closure :initarg :closure :initform (error "Gimme closure") :accessor closure)))
(defmethod set-state ((s state) key value)
@@ -98,11 +101,17 @@
(defsetf get-state set-state)
(defmethod render ((s string))
- s)
+ (if *stop-escape*
+ s
+ (hunchentoot:escape-for-html
+ s)))
(defmethod render ((s t))
- (if s
- (prin1-to-string s)
+ (if s
+ (if *stop-escape*
+ (prin1-to-string s)
+ (hunchentoot:escape-for-html
+ (prin1-to-string s)))
""))
(defparameter *single-element-tags* (list :link :meta :input :img)
@@ -110,18 +119,26 @@
(defmethod render ((c component))
(with-slots (tag attrs children) c
- (if (member tag *single-element-tags*)
- (format nil "<~a~{ ~a=\"~a\"~^~} />" tag attrs)
- (format nil "~a~&
+ (let* ((*stop-escape* (member :stop-escape attrs))
+ (attrs (alexandria:plist-hash-table attrs)))
+ (remhash :stop-escape attrs)
+ (let ((attrs (alexandria:hash-table-plist attrs)))
+ (if (member tag *single-element-tags*)
+ (format nil "<~a~{ ~a=\"~a\"~^~} />" tag attrs)
+ (format nil "~a~&
<~a~{ ~a=\"~a\"~^~}>~% ~{~a~}~%</~a>~%"
- (if (equalp tag :html) "<!DOCTYPE html>" "")
- tag attrs (mapcar (lambda (kid) (render kid)) children) tag))))
+ (if (equalp tag :html) "<!DOCTYPE html>" "")
+ tag attrs (mapcar (lambda (kid) (render kid)) children) tag))))))
(defmethod rerender ((c component))
(with-slots (attrs) c
- (let ((id (getf attrs :id)))
- (hunchensocket:send-text-message *current-ws* (json:stringify (hash ("id" id)
- ("new-html" (render c))))))))
+ (let* ((id (getf attrs :id))
+ (renderation (render c))
+ (json (json:stringify (hash ("id" id)
+ ("new-html" renderation)))))
+ (format t "html: ~a~%" renderation)
+ (format t "Rerendered and sending down the line: ~s~%" json)
+ (hunchensocket:send-text-message *current-ws* json))))
(defmethod render ((e event))
"pääseeköhän tähän väliin?")
@@ -136,6 +153,13 @@
:attributes (list ,@attrs)
:children ,children))
+(defmethod initialize-instance :after ((c component) &key)
+ (with-slots (tag children) c
+ (assert (or (member tag *single-element-tags*)
+ (equalp tag :script)
+ children))
+ c))
+
(defmacro c (tag attrs &rest children)
`(make-instance 'component
:tag ,tag
@@ -144,8 +168,8 @@
(defvar *js-identifiers-in-scope* (hash))
-(defun e (fn)
- (let ((ev (make-instance 'event :closure fn)))
+(defun e (fn &key (post-js ""))
+ (let ((ev (make-instance 'event :closure fn :post-js post-js)))
(setf (gethash (generated-js-id ev) *js-identifiers-in-scope*) ev)
ev))
@@ -157,7 +181,7 @@
(format out *component-format-string* tag attrs children)))
(defmethod print-object ((e event) out)
- (format out "send('~a');" (generated-js-id e)))
+ (format out "send('~a'); ~a /*post-js*/; return false;" (generated-js-id e) (post-js e)))
;; (with-slots (generated-js-id closure) e
;; (format out "#<generated-js-id: ~a, closure: ~a>" generated-js-id (function-lambda-expression closure))))
@@ -230,9 +254,10 @@
(defun call-event (sessionid call-dst)
(declare (ignore sessionid))
(let* ((fn (gethash call-dst *js-identifiers-in-scope*)))
- (with-slots (closure) fn
- (format t "Calling ~a~%" fn)
- (funcall closure))))
+ (with-slots (closure) fn
+ (murja.middleware.db:with-db
+ (format t "Calling ~a~%" fn)
+ (funcall closure)))))
(defun @newui (next)
(render (funcall next)))
diff --git a/src/views/blog-main.lisp b/src/views/blog-main.lisp
index 7ba1845..e646a7a 100644
--- a/src/views/blog-main.lisp
+++ b/src/views/blog-main.lisp
@@ -1,12 +1,12 @@
(defpackage murja.views.blog-main
- (:use :cl :murja.views.components.root :murja.views.components.tab)
+ (:use :cl :murja.views.components.root)
(:import-from :murja.models.user :user-nickname)
(:import-from :cl-hash-util :hash)
(:import-from :murja.routes.root-routes :@check-if-initial)
(:import-from :murja.middleware.auth :@ssr-authenticated :*user*)
(:import-from :murja.routes.settings-routes :get-settings)
(:import-from :murja.middleware.db :@transaction)
- (:import-from :murja.newui :@newui :c :with-state)
+ (:import-from :murja.newui :@newui :e :c :with-state)
(:import-from :easy-routes :defroute)
@@ -19,24 +19,24 @@
(deftab /only-logged-in (:route "/only-logged-in"
:require-login t
:title "This shouldn't be visible")
- (c :div ()
- "Näkyyköhän tää?"))
+ (with-state ((a 1)) ()
+ (c :div (:class "se-testi-div")
+ (c :div ()
+ (format nil "Näkyyköhän tää? ~d" a))
+ (c :button (:onclick (e (lambda () (incf a))))
+ "Clickme"))))
(deftab / (:route "/blog/"
:title "Home")
(let* ((settings (get-settings))
(page-size (gethash "recent-post-count" settings))
- (page 1)
- (page-posts (murja.models.post:get-page page page-size)))
-
- ;; (when *user*
- ;; (setf (gethash "Secret logged in user tab" tabs-spec)
- ;; (c :div () (format nil "Welcome ~a" (user-nickname *user*)))))
-
- (murja.views.components.page:page page-posts)))
-
-
-
-
+ (page 1))
+ (with-state (
+ (page-posts (murja.models.post:get-page page page-size))) ()
+ ;; (when *user*
+ ;; (setf (gethash "Secret logged in user tab" tabs-spec)
+ ;; (c :div () (format nil "Welcome ~a" (user-nickname *user*)))))
+ (c :div ()
+ (murja.views.components.page:page page-posts)))))
diff --git a/src/views/components/page.lisp b/src/views/components/page.lisp
index 7b87de5..32c6dab 100644
--- a/src/views/components/page.lisp
+++ b/src/views/components/page.lisp
@@ -5,7 +5,9 @@
(in-package :murja.views.components.page)
(defun page (list-of-posts)
- (component :div (:class "page")
- (map 'list (lambda (post)
- (murja.views.components.post:post post))
- list-of-posts)))
+ (let ((posts (map 'list (lambda (post)
+ (murja.views.components.post:post post))
+ list-of-posts)))
+ (component :div (:class "page")
+ (or posts
+ (c :div () "No posts found?")))))
diff --git a/src/views/components/post.lisp b/src/views/components/post.lisp
index c2c1825..1ae697f 100644
--- a/src/views/components/post.lisp
+++ b/src/views/components/post.lisp
@@ -7,7 +7,6 @@
(in-package :murja.views.components.post)
(defun post (post &key show-footer?)
- (assert *settings*)
(let ((creator (creator post)))
(c :article (:class "post")
(c :h2 ()
@@ -20,7 +19,7 @@
(c :time (:datetime (created-at post))
(created-at post))))
- (c :section (:class "content") (article post))
+ (c :section (:class "content" :stop-escape t) (article post))
(when (previouslies post)
@@ -28,11 +27,9 @@
(map 'list
(lambda (p)
(cl-hash-util:with-keys ("title" "id") p
- (c :a (:href (format nil "/blog/post/~d" id))
- (format nil "~a, " (gethash "previously_label" *settings*)))))
+ (c :a (:href (format nil "/blog/post/~d" id))
+ (format nil "~a, " (gethash "previously_label" *settings*)))))
(previouslies post))))
-
-
(when (tags post)
(component :ul (:class "tags")
diff --git a/src/views/components/tab.lisp b/src/views/components/tab.lisp
index ea9b564..6683522 100644
--- a/src/views/components/tab.lisp
+++ b/src/views/components/tab.lisp
@@ -1,33 +1,37 @@
(defpackage murja.views.components.tab
(:import-from :lisp-fixup :partial)
(:export :tabs)
- (:use :cl :murja.newui))
+ (:use :cl :murja.newui)
+ (:local-nicknames (:tabmodel :murja.models.tab)))
(in-package :murja.views.components.tab)
-(defun tabs (firstly-selected-title tab-hash ;; &key onleave ;; how did I plan to call js callbacks here again?
- )
- "Takes in a Title -> (Component | State mapping, returns a component that's supposed to look like the tab component used by the old Elm app"
- (let ((titles))
- (maphash (lambda (k v)
- (declare (ignore v))
- (push k titles))
- tab-hash)
+(defvar *selected-tab* nil)
- (sort titles #'string-lessp)
+(defun tabs (firstly-selected-title tablist ;; &key onleave ;; how did I plan to call js callbacks here again?
+ )
+ "Takes in a Title -> (Component | State mapping, returns a component that's supposed to look like the tab component used by the old Elm app"
- (with-state ((selected-title firstly-selected-title)) ()
+ ;; (sort tablist (lisp-fixup:compose #'string-lessp #'tabmodel:title))
+ (with-state ((selected-title firstly-selected-title)) ()
+ (let ((selected-tab (first (remove-if-not (lambda (tab)
+ (equalp (tabmodel:title tab)
+ selected-title))
+ tablist))))
(c :div (:id "topbar" :class "tabs")
(component :ul (:class "tab-headers")
(map 'list
- (lambda (title)
- (c :li (:class (format nil "tab-header ~a" (when (string= title selected-title) "tab-selected"))
- :onclick (e (lambda ()
- (setf selected-title title))))
- title))
- titles))
- (gethash selected-title tab-hash)))))
-
-
-
-
+ (lambda (tab)
+ ;; what if we made (:li () (:a () ...) ...) that'd be changed into a (:li () ...) later if javascript exists?
+ (c :li (:class (format nil "tab-header delinkify ~a" (when (string= (tabmodel:title tab) selected-title) "tab-selected"))
+ :data-href (tabmodel:tab-route tab))
+ (c :a (:href (tabmodel:tab-route tab)
+ :onclick (e (lambda ()
+ (setf selected-title (tabmodel:title tab)))
+ :post-js (format nil "history.pushState({}, '', ~s)" (tabmodel:tab-route tab))))
+ (tabmodel:title tab))))
+ tablist))
+ (progn
+ (format t "selected-tab: ~a~%" selected-tab)
+ (setf *selected-tab* selected-tab)
+ (funcall (tabmodel:tab-component selected-tab)))))))
diff --git a/src/views/middleware/newui-dispatcher.lisp b/src/views/middleware/newui-dispatcher.lisp
index 5307245..bcb4b8d 100644
--- a/src/views/middleware/newui-dispatcher.lisp
+++ b/src/views/middleware/newui-dispatcher.lisp
@@ -1,5 +1,5 @@
(defpackage murja.newui.dispatcher
- (:use :cl :murja.views.components.root :murja.views.components.tab :cl-hash-util)
+ (: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)
@@ -9,23 +9,6 @@
(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"))
@@ -38,13 +21,15 @@
&body rst)
`(progn
(setf (gethash (quote ,sym) *tabs*)
- (make-instance 'tab :route ,route
- :abilities ,needed-abilities
- :require-login ,require-login
- :title ,title
- :component (lambda ()
- (c :div ()
- ,@rst))))
+ (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
@@ -66,16 +51,11 @@
(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))))))
+ (remove-if-not (lambda (tab)
+ (or (not (require-login tab))
+ *user*))
+ (alexandria:hash-table-values
+ *tabs*)))))))