diff of fdb2bd17baa3e6a904a1c9240764af035a8728ea
fdb2bd17baa3e6a904a1c9240764af035a8728ea
diff --git a/aggressive-murja.asd b/aggressive-murja.asd
index e238d0d..e8245db 100644
--- a/aggressive-murja.asd
+++ b/aggressive-murja.asd
@@ -43,6 +43,8 @@
(:module "murja-newui"
:components ((:file "newui")))
(:file "migration-list")
+ (:file "settings")
+
(:module "users"
:components ((:file "user-db")))
(:file "session-db")
@@ -73,6 +75,14 @@
(:file "rss-reader-routes")
(:file "user-editor")
(:file "root-routes")))
+
+ (:module "views"
+ :components
+ ((:module "components"
+ :components ((:file "tab")
+ (:file "root")))
+ (:file "blog-main")))
+
(:file "main"))))
:in-order-to ((test-op (test-op "aggressive-murja/tests"))))
@@ -92,6 +102,7 @@
(eval (read-from-string "(fiveam:run! 'murja.tests:main-suite)"))))
;; (ql:quickload :aggressive-murja)
+;; (ql:quickload :aggressive-murja/tests)
;; (asdf:make "aggressive-murja")
;; (asdf:make "aggressive-murja/tests")
diff --git a/src/middleware/db.lisp b/src/middleware/db.lisp
index be8da67..b24570e 100644
--- a/src/middleware/db.lisp
+++ b/src/middleware/db.lisp
@@ -40,6 +40,8 @@
(with-connection (list db username password host :port port)
,@body)))
+(defvar *settings* nil "A hashmap view of `select * from blog.settings`. If this variable is nil, wrap your route with @transaction middleware. If you setf keys here, remember to update db too with murja.settings:update-setting")
+
(defun @transaction (next)
(with-db
(handler-bind ((cl-postgres:database-socket-error
@@ -53,4 +55,5 @@
(setf (hunchentoot:return-code*) 500)
(return-from @transaction "Internal Server Error"))))
(with-transaction ()
- (funcall next)))))
+ (let ((*settings* (murja.settings:get-settings)))
+ (funcall next))))))
diff --git a/src/murja-newui/newui.lisp b/src/murja-newui/newui.lisp
index 9e9be25..a39f117 100644
--- a/src/murja-newui/newui.lisp
+++ b/src/murja-newui/newui.lisp
@@ -1,6 +1,6 @@
(defpackage murja.newui
(:use :cl)
- (:export :*server* :@newui :c :with-state)
+ (:export :*server* :component :render :@newui :c :with-state :e)
(:local-nicknames (:json :com.inuoe.jzon))
(:import-from :cl-hash-util :hash))
@@ -100,7 +100,7 @@
(defmethod render ((s string))
s)
-(defparameter *single-element-tags* (list :link)
+(defparameter *single-element-tags* (list :link :meta :input)
"Contains tags that don't expand to <:tag attrs>children</:tag> but instead into <:tag attrs />")
(defmethod render ((c component))
@@ -124,6 +124,13 @@
(defmethod render ((s state))
(render (root-component s)))
+(defmacro component (tag attrs children)
+ "Precisely the same constructor as `c`, but takes its children as a list instead of &rest arguments"
+ `(make-instance 'component
+ :tag ,tag
+ :attributes (list ,@attrs)
+ :children ,children))
+
(defmacro c (tag attrs &rest children)
`(make-instance 'component
:tag ,tag
@@ -189,7 +196,7 @@
current-state))))
(easy-routes:defroute demo ("/demo" :method :get) ()
- (let ((state (with-state ((linnunrata-vakio 42))
+ (let ((state (with-state ((linnunrata-vakio 42)) ()
(c :body ()
(c :header () "Willkommen!")
(c :div (:class "sidebar-flex")
@@ -221,3 +228,6 @@
(with-slots (closure) fn
(format t "Calling ~a~%" fn)
(funcall closure))))
+
+(defun @newui (next)
+ (render (funcall next)))
diff --git a/src/posts/post-db.lisp b/src/posts/post-db.lisp
index 51e28cb..5a86780 100644
--- a/src/posts/post-db.lisp
+++ b/src/posts/post-db.lisp
@@ -10,14 +10,14 @@
(defqueries "post-fns")
(defun get-titles-by-year (&key allow-hidden?)
- (mapcar (lambda (title)
+ (map 'list
+ (lambda (title)
- (when (gethash "Tags" title)
- (setf (gethash "Tags" title)
- (parse (gethash "Tags" title))))
- title)
- (coerce
- (get-titles-by-year* allow-hidden?) 'list)))
+ (when (gethash "Tags" title)
+ (setf (gethash "Tags" title)
+ (parse (gethash "Tags" title))))
+ title)
+ (get-titles-by-year* allow-hidden?)))
(defun fix-post (post)
(dolist (key (list "creator" "tags" "versions" "previously"))
diff --git a/src/routes/settings-routes.lisp b/src/routes/settings-routes.lisp
index 266e6c9..e56d86c 100644
--- a/src/routes/settings-routes.lisp
+++ b/src/routes/settings-routes.lisp
@@ -1,3 +1,6 @@
+;; this shit is completely deprecated :D
+;; look at murja.settings for symbols that will survive current deprecation round
+
(defpackage murja.routes.settings-routes
(:use :cl)
(:import-from :halisql :defqueries)
diff --git a/src/settings.lisp b/src/settings.lisp
new file mode 100644
index 0000000..e491f30
--- /dev/null
+++ b/src/settings.lisp
@@ -0,0 +1,18 @@
+(defpackage murja.settings
+ (:import-from :com.inuoe.jzon :stringify :parse)
+ (:export :get-settings :update-setting)
+ (:use :cl))
+
+(in-package :murja.settings)
+
+(defun get-settings ()
+ (reduce (lambda (acc pair)
+ (destructuring-bind (k v) pair
+ (setf (gethash k acc) (com.inuoe.jzon:parse v))
+ acc))
+ (postmodern:query "SELECT key, value FROM blog.Settings")
+
+ :initial-value (make-hash-table :test 'equal)))
+
+(defun update-setting (k v)
+ (postmodern:execute "INSERT INTO blog.Settings (key, value) VALUES ($1, $2) ON CONFLICT (key) DO UPDATE SET value = excluded.value" k (stringify v)))
diff --git a/src/views/blog-main.lisp b/src/views/blog-main.lisp
new file mode 100644
index 0000000..6232c14
--- /dev/null
+++ b/src/views/blog-main.lisp
@@ -0,0 +1,33 @@
+(defpackage murja.views.blog-main
+ (:use :cl :murja.views.components.root :murja.views.components.tab)
+ (:import-from :cl-hash-util :hash)
+ (:import-from :murja.routes.root-routes :@check-if-initial)
+ (:import-from :murja.routes.settings-routes :get-settings)
+ (:import-from :murja.middleware.db :@transaction)
+ (:import-from :murja.posts.post-db :get-titles-by-year :get-page )
+ (:import-from :murja.newui :@newui :c :with-state)
+ (:import-from :easy-routes :defroute))
+
+(in-package :murja.views.blog-main)
+
+(defroute blog-root-view ("/blog/" :method :get
+ :decorators (@newui @transaction @check-if-initial)) ()
+
+ (let* ((settings (get-settings))
+ (page-size (gethash "recent-post-count" settings))
+ (page 1)
+ (page-posts (get-page page page-size))
+ (sidebar-titles (get-titles-by-year)))
+ (root-component
+ (tabs "Home"
+ (hash
+ ("Home"
+ (c :p () "Welcome to murja I guess.... :D"))
+ ("Ilpo testaa"
+ (c :p () "Kakkos tabi"))
+
+ ("Kolmas tabi"
+ (c :form ()
+ (c :label ()
+ "Testi inputti"
+ (c :input (:type "text" :value "Koodista tuleva oletushomma"))))))))))
diff --git a/src/views/components/root.lisp b/src/views/components/root.lisp
new file mode 100644
index 0000000..251476d
--- /dev/null
+++ b/src/views/components/root.lisp
@@ -0,0 +1,19 @@
+(defpackage murja.views.components.root
+ (:use :cl :murja.newui)
+ (:import-from :murja.middleware.db :*settings*)
+ (:export :root-component))
+
+(in-package :murja.views.components.root)
+
+(defun root-component (inner-component)
+ "Returns the root html element of murja with `inner-component` embedded inside it"
+ (c :html ()
+ (c :head ()
+ (c :link (:href "/resources/murja.css" :rel "stylesheet" :type "text/css"))
+ (c :script (:src "https://unpkg.com/ace-custom-element@latest/dist/index.min.js" :type "module"))
+ (c :script (:src "/resources/newui.js"))
+ (c :meta (:charset "UTF-8")))
+ (c :body ()
+ (c :header ()
+ (c :a (:href "/") (gethash "blog-title" *settings* )))
+ inner-component)))
diff --git a/src/views/components/tab.lisp b/src/views/components/tab.lisp
new file mode 100644
index 0000000..ea9b564
--- /dev/null
+++ b/src/views/components/tab.lisp
@@ -0,0 +1,33 @@
+(defpackage murja.views.components.tab
+ (:import-from :lisp-fixup :partial)
+ (:export :tabs)
+ (:use :cl :murja.newui))
+
+(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)
+
+ (sort titles #'string-lessp)
+
+ (with-state ((selected-title firstly-selected-title)) ()
+ (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)))))
+
+
+
+