diff options
Diffstat (limited to 'lisp')
| -rw-r--r-- | lisp/bogenherr.asd | 2 | ||||
| -rw-r--r-- | lisp/webapps/bogenherr/clojurescript/bogenherr/project.clj | 6 | ||||
| -rw-r--r-- | lisp/webapps/bogenherr/clojurescript/bogenherr/src/core.cljs | 102 | ||||
| -rw-r--r-- | lisp/webapps/bogenherr/site.lisp | 130 | ||||
| -rw-r--r-- | lisp/webapps/webapp-loader.lisp | 19 |
5 files changed, 154 insertions, 105 deletions
diff --git a/lisp/bogenherr.asd b/lisp/bogenherr.asd index 44e8d08..4af87fa 100644 --- a/lisp/bogenherr.asd +++ b/lisp/bogenherr.asd @@ -17,7 +17,7 @@ :depends-on ,(eval depends-on) :components ,components)) -(defparameter *quicklisp-packages* '(cl-ppcre cl-smtp hunchentoot cl-log ironclad cl-markdown tmpdir net-telent-date uffi drakma cl-json postmodern fiveam local-time trivial-octet-streams)) +(defparameter *quicklisp-packages* '(cl-ppcre cl-smtp hunchentoot easy-routes cl-log ironclad cl-markdown tmpdir net-telent-date uffi drakma cl-json postmodern fiveam local-time trivial-octet-streams)) (defparameter *asdf-packages* '(org-ckons-core org-ckons-http org-ckons-json org-ckons-file org-ckons-serializable org-ckons-session org-ckons-condition org-ckons-sql)) (defparameter *all-packages* (append *quicklisp-packages* *asdf-packages*)) diff --git a/lisp/webapps/bogenherr/clojurescript/bogenherr/project.clj b/lisp/webapps/bogenherr/clojurescript/bogenherr/project.clj index 54d857d..d8a5856 100644 --- a/lisp/webapps/bogenherr/clojurescript/bogenherr/project.clj +++ b/lisp/webapps/bogenherr/clojurescript/bogenherr/project.clj @@ -9,7 +9,11 @@ [prismatic/dommy "LATEST"] [hiccups "LATEST"] [cljsjs/showdown "LATEST"] - [com.andrewmcveigh/cljs-time "LATEST"]] + [com.andrewmcveigh/cljs-time "LATEST"] + [cljsjs/react "LATEST"] + [cljsjs/react-dom "LATEST"] + [cljsjs/react-dom-server "LATEST"] + [reagent "LATEST"]] :source-paths ["src"] :aliases {"fig:build" ["trampoline" "run" "-m" "figwheel.main" "-b" "dev" "-r"] "fig:min" ["run" "-m" "figwheel.main" "-O" "advanced" "-bo" "dev"]} diff --git a/lisp/webapps/bogenherr/clojurescript/bogenherr/src/core.cljs b/lisp/webapps/bogenherr/clojurescript/bogenherr/src/core.cljs index 5cc5f97..80862b3 100644 --- a/lisp/webapps/bogenherr/clojurescript/bogenherr/src/core.cljs +++ b/lisp/webapps/bogenherr/clojurescript/bogenherr/src/core.cljs @@ -1,21 +1,19 @@ (ns bogenherr.core (:require-macros [hiccups.core :as hiccups :refer [html]]) - (:require [ajax.core :refer [GET POST raw-response-format]] + (:require [ajax.core :refer [GET POST PUT DELETE raw-response-format]] [dommy.core :as dommy] [hiccups.runtime :as hiccupsrt] [cljsjs.showdown :as showdown] [clojure.string :as str] [cljs-time.format :as time-format] + [reagent.core :as r] + [reagent.dom :as rd] + [reagent.dom.client :as rdc] [org-ckons-cljs.notifications.core :as ck-notifications] [org-ckons-cljs.form.core :as ck-form])) ;; declarations -(enable-console-print!) -(def jquery (js* "$")) -(def sql-formatter (time-format/formatter "yyyy-MM-dd HH:mm:ss")) -(def pretty-formatter (time-format/formatters :rfc822)) - (declare date-sql-to-pretty) (declare markdown-to-html) (declare reduce-checkboxes) @@ -26,7 +24,7 @@ (declare handler-menu) (declare handler-menu-user) (declare render-menu) -(declare template-home) +(declare comp-home) (declare handler-home) (declare render-home) (declare template-login) @@ -166,6 +164,19 @@ (declare goto-location) (declare reset-app) (declare goto-register) +(declare site) +(declare start-render) +(declare start-nav-state) +(declare reset-nav-state) +(declare start) + +(enable-console-print!) +(def jquery (js* "$")) +(def sql-formatter (time-format/formatter "yyyy-MM-dd HH:mm:ss")) +(def pretty-formatter (time-format/formatters :rfc822)) +(def nav-state (r/atom {:location "/home"})) + +;; helper functions (defn date-sql-to-pretty [sql-date] (first (str/split (time-format/unparse pretty-formatter (time-format/parse sql-formatter (first (str/split sql-date ".")))) " Z"))) @@ -191,6 +202,49 @@ (second (str/split (-> this (.prop "id")) "_"))))) (.toArray (jquery selector))))) +;; body + +(defn site [] + [:div {:class "container-fluid"} + [:div {:class "banner"} + [:table {:width "100%" :height "100%"} + [:tbody + [:tr + [:td {:class "banner-menu"} + [:div {:id "menu-user"}]] + [:td {:class "banner-title"} "Bogen-" [:i "Herr"]] + [:td {:class "banner-menu"} " "]]]]] + [:div {:id "menu" :class "well"}] + [:div {:id "errormsg"}] + [:div {:id "message"}] + [:div {:id "body"}] + [:div {:id "footer"} + [:hr] + "Carlos Konstanski (970) 294-9708"]]) + +;; start the react app + +(defn start-render [] + (let [app-root (rdc/create-root (js/document.getElementById "app"))] + (rdc/render app-root [site]))) + +(defn start-nav-state [] + (cond (str/starts-with? (@nav-state :location) "/register/") + (goto-register (str/replace-first (@nav-state :location) "/register/" "")) + :else (goto-location (@nav-state :location)))) + +(defn reset-nav-state [url] + (reset! nav-state (assoc @nav-state :location url))) + +(defn ^:dev/after-load start + ([] + (start-render) + (start-nav-state)) + ([url] + (reset-nav-state url) + (start-render) + (start-nav-state))) + ;; notifications (defn notifications [jsonobj] @@ -212,7 +266,7 @@ (for [menuitem menuitems] [:li {:class "nav-item"} [:a {:class (cond (= (str/upper-case (get menuitem "handler")) - (str/upper-case (dommy/html (dommy/sel1 :#location)))) + (str/upper-case (@nav-state :location))) "nav-link active" :else "nav-link") @@ -250,13 +304,14 @@ ;; home (hiccups/defhtml template-home [jsonobj] - [:h2 {:style "text-align: center"} "Welcome To Carlos Konstanski's Music Studio"] - [:h3 {:style "text-align: center"} - [:i "a.k.a. der Bogenherr<br/>a.k.a. Dr. Divertimento"]] - [:h2 {:style "text-align: center"} "Study the Violin, Viola and Viola d'Amore With Me!"] - [:div {:style "text-align: center"} - [:img {:style "width: 100%" - :src "/static/images/instrument-cabinet.jpg"}]]) + [:div + [:h2 {:style "text-align: center"} "Welcome To Carlos Konstanski's Music Studio"] + [:h3 {:style "text-align: center"} + [:i "a.k.a. der Bogenherr" [:br] "a.k.a. Dr. Divertimento"]] + [:h2 {:style "text-align: center"} "Study the Violin, Viola and Viola d'Amore With Me!"] + [:div {:style "text-align: center"} + [:img {:style "width: 100%" + :src "/static/images/instrument-cabinet.jpg"}]]]) (defn handler-home [response] (let [jsonobj (js->clj (js/JSON.parse response))] @@ -303,7 +358,7 @@ (goto-location "/login") (get jsonobj "message") (do - (dommy/set-html! (dommy/sel1 :#location) "/home") + (reset-nav-state "/home") (render-home) (render-menu))))) @@ -319,7 +374,7 @@ (defn handler-logout [response] (let [jsonobj (js->clj (js/JSON.parse response))] (render-home "You are now logged out" "") - (dommy/set-html! (dommy/sel1 :#location) "/home") + (reset-nav-state "/home") (render-menu))) (defn render-logout [] @@ -644,7 +699,7 @@ :referrerpolicy "strict-origin-when-cross-origin" :allowfullscreen "allowfullscreen"}] :else - (let [img-src (str "/gallery/file/view?id=" (get rec "id"))] + (let [img-src (str "/gallery/file/view/" (get rec "id"))] [:img {:style "height:405px; cursor:pointer; cursor:hand" :src img-src :onclick (str (namespace ::x) ".on_gallery_image_clicked('" img-src "')")}]))] @@ -771,10 +826,9 @@ (on-menu-clicked "/gallery"))) (defn render-gallery-delete [id] - (POST "/gallery/delete" - {:format :raw - :params {:id id} - :handler handler-gallery-delete})) + (DELETE (str "/gallery/delete/" id) + {:format :raw + :handler handler-gallery-delete})) ;; testimonials @@ -1282,7 +1336,7 @@ ;; location (defn on-menu-clicked [handler] - (dommy/set-html! (dommy/sel1 :#location) handler) + (reset-nav-state handler) (render-menu) (cond (= handler "/home") (render-home) (= handler "/login") (render-login) @@ -1311,6 +1365,6 @@ (set! (.-location js/document) "/")) (defn goto-register [hash] - (dommy/set-html! (dommy/sel1 :#location) "/users/register") + (reset-nav-state "/users/register") (render-menu) (render-users-register hash)) diff --git a/lisp/webapps/bogenherr/site.lisp b/lisp/webapps/bogenherr/site.lisp index b79f493..37f33cd 100644 --- a/lisp/webapps/bogenherr/site.lisp +++ b/lisp/webapps/bogenherr/site.lisp @@ -3,7 +3,7 @@ (in-package :bogenherr) -(defmacro .base (&optional (onload-fn "goto_location('/home')")) +(defmacro .base (&optional (start-url "/home")) `(org-ckons-http::html5 `(html (head @@ -18,27 +18,13 @@ `((script :type "text/javascript" :src ,(getf js :src) :integrity ,(getf js :integrity) :crossorigin ,(getf js :crossorigin)))) '((:src "https://code.jquery.com/jquery-3.7.1.slim.min.js" :integrity "ha256-kmHvs0B+OpCW5GVHUNjv9rOmY0IvSIRcf7zGUDTDQM8=" :crossorigin "anonymous"))) ((script :type "text/javascript" :src "/cljs-out/dev-main.js"))) - ((body :onload ,(format nil "bogenherr.core.~a" ,onload-fn)) - ((div :class "container-fluid") - ((div :class "banner") - ((table :width "100%" :height "100%") - (tr - ((td :class "banner-menu") - ((div :id "menu-user"))) - ((td :class "banner-title") "Bogen-<i>Herr</i>") - ((td :class "banner-menu") - " ")))) - ((div :id "menu" :class "well")) - ((div :id "location" :style "display: none")) - ((div :id "errormsg")) - ((div :id "message")) - ((div :id "body")) - ((div :id "footer") - (hr) - "Carlos Konstanski (970) 294-9708") - ,@(mapcar (lambda (js) - `((script :type "text/javascript" :src ,(getf js :src) :integrity ,(getf js :integrity) :crossorigin ,(getf js :crossorigin)))) - '((:src "https://cdn.jsdelivr.net/npm/bootstrap@4.6.2/dist/js/bootstrap.bundle.min.js" :integrity "sha384-Fy6S3B9q64WdZWQUiU+q4/2Lc9npb8tCaSX9FK7E8HnRr0Jz8D6OP9dO5Vg3Q9ct" :crossorigin "anonymous")))))))) + ((body :onload ,(format nil "bogenherr.core.start(~a)" ,(if start-url + (format nil "'~a'" start-url) + "null"))) + ((div :id "app")) + ,@(mapcar (lambda (js) + `((script :type "text/javascript" :src ,(getf js :src) :integrity ,(getf js :integrity) :crossorigin ,(getf js :crossorigin)))) + '((:src "https://cdn.jsdelivr.net/npm/bootstrap@4.6.2/dist/js/bootstrap.bundle.min.js" :integrity "sha384-Fy6S3B9q64WdZWQUiU+q4/2Lc9npb8tCaSX9FK7E8HnRr0Jz8D6OP9dO5Vg3Q9ct" :crossorigin "anonymous"))))))) (defmacro .location () `(location-json location)) @@ -184,53 +170,53 @@ (defmacro .users-delete () `(users-delete-json id)) -(define-endpoint :get "/" () .base) -(define-endpoint :post "/location" ((location :parameter-type 'string)) .location) -(define-endpoint :get "/home" () .home-get) -(define-endpoint :post "/home" ((message :parameter-type 'string) (errormsg :parameter-type 'string)) .home-post) -(define-endpoint :get "/menu" () .menu) -(define-endpoint :get "/menu/user" () .menu-user) -(define-endpoint :get "/login" () .login) -(define-endpoint :post "/login/authenticate" ((username :parameter-type 'string) (pwd :parameter-type 'string)) .login-authenticate) -(define-endpoint :get "/login/forgot" () .login-forgot) -(define-endpoint :get "/logout" () .logout) -(define-endpoint :get "/profile" () .profile) -(define-endpoint :get "/profile/view" () .profile-view) -(define-endpoint :post "/profile/modify" () .profile-modify) -(define-endpoint :post "/profile/modify/submit" ((id :parameter-type 'integer) (username :parameter-type 'string) (first_name :parameter-type 'string) (last_name :parameter-type 'string) (email :parameter-type 'string) (phone :parameter-type 'string)) .profile-modify-submit) -(define-endpoint :get "/password" () .password) -(define-endpoint :post "/password/submit" ((id :parameter-type 'integer) (pwd :parameter-type 'string) (pwd2 :parameter-type 'string)) .password-submit) -(define-endpoint :get "/about-us" () .about-us) -(define-endpoint :get "/about-us/view" () .about-us-view) -(define-endpoint :post "/about-us/modify" () .about-us-modify) -(define-endpoint :post "/about-us/modify/submit" ((content :parameter-type 'string)) .about-us-modify-submit) -(define-endpoint :get "/gallery" () .gallery) -(define-endpoint :get "/gallery/view" () .gallery-view) -(define-endpoint :post "/gallery/add" () .gallery-add) -(define-endpoint :post "/gallery/add/submit" ((description :parameter-type 'string) (video_embed_url :parameter-type 'string) (upload :parameter-type 'string)) .gallery-add-submit) -(define-endpoint :post "/gallery/modify" ((id :parameter-type 'integer)) .gallery-modify) -(define-endpoint :post "/gallery/modify/submit" ((id :parameter-type 'integer) (description :parameter-type 'string) (video_embed_url :parameter-type 'string) (upload :parameter-type 'string)) .gallery-modify-submit) -(define-endpoint :post "/gallery/delete" ((id :parameter-type 'integer)) .gallery-delete) -(define-endpoint :get "/gallery/file/view" ((id :parameter-type 'integer)) .gallery-file-view) -(define-endpoint :get "/testimonials" () .testimonials) -(define-endpoint :get "/testimonials/view" () .testimonials-view) -(define-endpoint :post "/testimonials/modify" () .testimonials-modify) -(define-endpoint :post "/testimonials/modify/submit" ((content :parameter-type 'string)) .testimonials-modify-submit) -(define-endpoint :get "/contact-us" () .contact-us) -(define-endpoint :get "/contact-us/view" () .contact-us-view) -(define-endpoint :post "/contact-us/email" ((first_name :parameter-type 'string) (last_name :parameter-type 'string) (email :parameter-type 'string) (phone :parameter-type 'string) (comments :parameter-type 'string)) .contact-us-email) -(define-endpoint :get "/messages" () .messages) -(define-endpoint :post "/messages/results" ((read :parameter-type 'string)) .messages-results) -(define-endpoint :post "/messages/mark" ((read :parameter-type 'string) (id :parameter-type 'integer)) .messages-mark) -(define-endpoint :get "/users" () .users) -(define-endpoint :get "/users/view" () .users-view) -(define-endpoint :post "/users/add" () .users-add) -(define-endpoint :post "/users/add/submit" ((role_groups :parameter-type 'string) (first_name :parameter-type 'string) (last_name :parameter-type 'string) (email :parameter-type 'string)) .users-add-submit) -(define-endpoint :get "/register" ((hash :parameter-type 'string)) .base (format nil "goto_register('~a') " hash)) -(define-endpoint :post "/users/register" ((hash :parameter-type 'string)) .users-register) -(define-endpoint :post "/users/register/form" ((hash :parameter-type 'string)) .users-register-form) -(define-endpoint :post "/users/register/submit" ((hash :parameter-type 'string) (username :parameter-type 'string) (pwd :parameter-type 'string) (pwd2 :parameter-type 'string) (phone :parameter-type 'string)) .users-register-submit) -(define-endpoint :post "/users/modify" ((id :parameter-type 'integer)) .users-modify) -(define-endpoint :post "/users/modify/submit" ((id :parameter-type 'integer) (role_groups :parameter-type 'string) (username :parameter-type 'string) (first_name :parameter-type 'string) (last_name :parameter-type 'string) (email :parameter-type 'string) (phone :parameter-type 'string)) .users-modify-submit) -(define-endpoint :post "/users/toggle-active" ((id :parameter-type 'integer)) .users-toggle-active) -(define-endpoint :post "/users/delete" ((id :parameter-type 'integer)) .users-delete) +(define-endpoint ("/" :method :get) () .base) +(define-endpoint ("/location" :method :post) (&post (location :parameter-type 'string)) .location) +(define-endpoint ("/home" :method :get) () .home-get) +(define-endpoint ("/home" :method :post) (&post (message :parameter-type 'string) (errormsg :parameter-type 'string)) .home-post) +(define-endpoint ("/menu" :method :get) () .menu) +(define-endpoint ("/menu/user" :method :get) () .menu-user) +(define-endpoint ("/login" :method :get) () .login) +(define-endpoint ("/login/authenticate" :method :post) (&post (username :parameter-type 'string) (pwd :parameter-type 'string)) .login-authenticate) +(define-endpoint ("/login/forgot" :method :get) () .login-forgot) +(define-endpoint ("/logout" :method :get) () .logout) +(define-endpoint ("/profile" :method :get) () .profile) +(define-endpoint ("/profile/view" :method :get) () .profile-view) +(define-endpoint ("/profile/modify" :method :post) () .profile-modify) +(define-endpoint ("/profile/modify/submit" :method :post) (&post (id :parameter-type 'integer) (username :parameter-type 'string) (first_name :parameter-type 'string) (last_name :parameter-type 'string) (email :parameter-type 'string) (phone :parameter-type 'string)) .profile-modify-submit) +(define-endpoint ("/password" :method :get) () .password) +(define-endpoint ("/password/submit" :method :post) (&post (id :parameter-type 'integer) (pwd :parameter-type 'string) (pwd2 :parameter-type 'string)) .password-submit) +(define-endpoint ("/about-us" :method :get) () .about-us) +(define-endpoint ("/about-us/view" :method :get) () .about-us-view) +(define-endpoint ("/about-us/modify" :method :post) () .about-us-modify) +(define-endpoint ("/about-us/modify/submit" :method :post) (&post (content :parameter-type 'string)) .about-us-modify-submit) +(define-endpoint ("/gallery" :method :get) () .gallery) +(define-endpoint ("/gallery/view" :method :get) () .gallery-view) +(define-endpoint ("/gallery/add" :method :post) () .gallery-add) +(define-endpoint ("/gallery/add/submit" :method :post) (&post (description :parameter-type 'string) (video_embed_url :parameter-type 'string) (upload :parameter-type 'string)) .gallery-add-submit) +(define-endpoint ("/gallery/modify" :method :post) (&post (id :parameter-type 'integer)) .gallery-modify) +(define-endpoint ("/gallery/modify/submit" :method :post) (&post (id :parameter-type 'integer) (description :parameter-type 'string) (video_embed_url :parameter-type 'string) (upload :parameter-type 'string)) .gallery-modify-submit) +(define-endpoint ("/gallery/delete/:id" :method :delete) () .gallery-delete) +(define-endpoint ("/gallery/file/view/:id" :method :get) () .gallery-file-view) +(define-endpoint ("/testimonials" :method :get) () .testimonials) +(define-endpoint ("/testimonials/view" :method :get) () .testimonials-view) +(define-endpoint ("/testimonials/modify" :method :post) () .testimonials-modify) +(define-endpoint ("/testimonials/modify/submit" :method :post) (&post (content :parameter-type 'string)) .testimonials-modify-submit) +(define-endpoint ("/contact-us" :method :get) () .contact-us) +(define-endpoint ("/contact-us/view" :method :get) () .contact-us-view) +(define-endpoint ("/contact-us/email" :method :post) (&post (first_name :parameter-type 'string) (last_name :parameter-type 'string) (email :parameter-type 'string) (phone :parameter-type 'string) (comments :parameter-type 'string)) .contact-us-email) +(define-endpoint ("/messages" :method :get) () .messages) +(define-endpoint ("/messages/results" :method :post) (&post (read :parameter-type 'string)) .messages-results) +(define-endpoint ("/messages/mark" :method :post) (&post (read :parameter-type 'string) (id :parameter-type 'integer)) .messages-mark) +(define-endpoint ("/users" :method :get) () .users) +(define-endpoint ("/users/view" :method :get) () .users-view) +(define-endpoint ("/users/add" :method :post) () .users-add) +(define-endpoint ("/users/add/submit" :method :post) (&post (role_groups :parameter-type 'string) (first_name :parameter-type 'string) (last_name :parameter-type 'string) (email :parameter-type 'string)) .users-add-submit) +(define-endpoint ("/register/:hash" :method :get) () .base hash) +(define-endpoint ("/users/register" :method :post) (&post (hash :parameter-type 'string)) .users-register) +(define-endpoint ("/users/register/form" :method :post) (&post (hash :parameter-type 'string)) .users-register-form) +(define-endpoint ("/users/register/submit" :method :post) (&post (hash :parameter-type 'string) (username :parameter-type 'string) (pwd :parameter-type 'string) (pwd2 :parameter-type 'string) (phone :parameter-type 'string)) .users-register-submit) +(define-endpoint ("/users/modify" :method :post) (&post (id :parameter-type 'integer)) .users-modify) +(define-endpoint ("/users/modify/submit" :method :post) (&post (id :parameter-type 'integer) (role_groups :parameter-type 'string) (username :parameter-type 'string) (first_name :parameter-type 'string) (last_name :parameter-type 'string) (email :parameter-type 'string) (phone :parameter-type 'string)) .users-modify-submit) +(define-endpoint ("/users/toggle-active" :method :post) (&post (id :parameter-type 'integer)) .users-toggle-active) +(define-endpoint ("/users/delete" :method :post) (&post (id :parameter-type 'integer)) .users-delete) diff --git a/lisp/webapps/webapp-loader.lisp b/lisp/webapps/webapp-loader.lisp index 6b1775b..7f1461e 100644 --- a/lisp/webapps/webapp-loader.lisp +++ b/lisp/webapps/webapp-loader.lisp @@ -147,7 +147,7 @@ with the new one." (start-messenger 'text-file-messenger :filename (format nil "/var/log/lisp/~a.log" package)) (setf *session-secret* (org-ckons-session::generate-sessionid)) (populate-webapps) - (setf *acceptor* (start (make-instance 'easy-acceptor + (setf *acceptor* (start (make-instance 'easy-routes:easy-routes-acceptor :port *port* :document-root (make-server-path (format nil "webapps/~a/" package)) :name (format nil "~a-acceptor" package))))))) @@ -164,12 +164,17 @@ with the new one." (org-ckons-session::ship-headers *header-register*)) output))) -(defmacro define-endpoint (request-type uri var-list page-function &rest args) - "Does the grunt work of creating an `easy-handler' for each page you -wish to publish." - (let ((name (gensym))) +(defmacro define-endpoint (template-and-options var-list page-function &rest args) + "Does the grunt work of creating an `easy-routes' route for each page +you wish to publish." + (let ((name (gensym)) + (uri (first template-and-options)) + (method (getf (rest template-and-options) :method))) `(progn - (org-ckons-core::logger (format nil "Publishing page. URL = [~a]" ,uri)) - (define-easy-handler (,name :uri ,uri :default-request-type ,request-type) + (org-ckons-core::logger (format nil "Publishing page. URL = [~a], method = [~a]" ,uri ,method)) + (easy-routes:defroute ,name ,template-and-options ,var-list (with-request-wrapper ,uri ,page-function ,@args))))) + ;; (define-easy-handler (,name :uri ,uri :default-request-type ,request-type) + ;; ,var-list + ;; (with-request-wrapper ,uri ,page-function ,@args))))) |