loop..do cleanup

12 files changed, 62 insertions, 65 deletions

diff --git a/lisp/bogenherr.asd b/lisp/bogenherr.asd
index 4af87fa..495ae85 100644
--- a/lisp/bogenherr.asd
+++ b/lisp/bogenherr.asd
@@ -21,8 +21,8 @@
 (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*))
 
-(loop for pkg in *quicklisp-packages* do
-  (ql:quickload (symbol-name pkg)))
+(loop for pkg in *quicklisp-packages*
+      do (ql:quickload (symbol-name pkg)))
 
 (do-defsystem :name "bogenherr"
   :version "1"
diff --git a/lisp/service/base-service.lisp b/lisp/service/base-service.lisp
index 77df817..ecd9469 100644
--- a/lisp/service/base-service.lisp
+++ b/lisp/service/base-service.lisp
@@ -8,9 +8,9 @@
   (:documentation ""))
 
 (defmacro loop-intersect-slots ((slot record other-object) &body body)
-  `(loop for ,slot in (intersect-slots ,record (org-ckons-core::map-slot-names ,other-object)) do
-        (when (slot-is-field-p ,slot)
-          ,@body)))
+  `(loop for ,slot in (intersect-slots ,record (org-ckons-core::map-slot-names ,other-object))
+         do (when (slot-is-field-p ,slot)
+              ,@body)))
 
 (defmethod copy-from-record ((base-service base-service) (record record))
   (loop-intersect-slots (slot record base-service)
diff --git a/lisp/service/messages-service.lisp b/lisp/service/messages-service.lisp
index 18999ab..e03c04c 100644
--- a/lisp/service/messages-service.lisp
+++ b/lisp/service/messages-service.lisp
@@ -38,8 +38,8 @@
                                                        (id (get-user))
                                                        (string= (session-value :messages-read) "read")))))
     (sanitize-rest-json instance)
-    (loop for result in (results instance) do
-         (sanitize-json result))))
+    (loop for result in (results instance)
+          do (sanitize-json result))))
 
 (defclass messages/mark-service (messages-service)
   ((location-p :initform nil))
diff --git a/lisp/service/password-service.lisp b/lisp/service/password-service.lisp
index fee720e..32507d2 100644
--- a/lisp/service/password-service.lisp
+++ b/lisp/service/password-service.lisp
@@ -42,8 +42,8 @@
             (let ((auth-pkg (make-instance 'auth-pkg)))
               (loop for param in (remove-if (lambda (x)
                                               (intersection `(,x) '(id pwd2)))
-                                            (sb-introspect:function-lambda-list #'password-submit-json)) do
-                   (setf (slot-value user param) (symbol-value param)))
+                                            (sb-introspect:function-lambda-list #'password-submit-json))
+                    do (setf (slot-value user param) (symbol-value param)))
               (update-password auth-pkg user)
               (set-user user)
               (setf (session-value :message) "Password saved successfully."))
diff --git a/lisp/service/profile-service.lisp b/lisp/service/profile-service.lisp
index c5783ad..256d599 100644
--- a/lisp/service/profile-service.lisp
+++ b/lisp/service/profile-service.lisp
@@ -48,12 +48,12 @@
   (with-auth (instance profile/modify-service "profile-modify")
     (with-bogenherr-database
       (let ((user (get-user)))
-        (if (= id (id user))
+        (if (= (id user) id)
             (let ((auth-pkg (make-instance 'auth-pkg)))
               (loop for param in (remove-if (lambda (x)
                                               (intersection `(,x) '(id)))
-                                            (sb-introspect:function-lambda-list #'profile-modify-submit-json)) do
-                   (setf (slot-value user param) (symbol-value param)))
+                                            (sb-introspect:function-lambda-list #'profile-modify-submit-json))
+                    do (setf (slot-value user param) (symbol-value param)))
               (copy-from-record instance user)
               (update-user auth-pkg user)
               (set-user user)
diff --git a/lisp/service/rest-service.lisp b/lisp/service/rest-service.lisp
index eda0948..b01f7fa 100644
--- a/lisp/service/rest-service.lisp
+++ b/lisp/service/rest-service.lisp
@@ -37,5 +37,5 @@
 
 (defmethod sanitize-rest-json ((rest-service rest-service))
   (loop for slot in (intersection '(org-ckons-session::*session-key *table *where-expression pwd)
-                                  (org-ckons-core::map-slot-names rest-service)) do
-       (setf (slot-value rest-service slot) nil)))
+                                  (org-ckons-core::map-slot-names rest-service))
+        do (setf (slot-value rest-service slot) nil)))
diff --git a/lisp/service/users-service.lisp b/lisp/service/users-service.lisp
index fa56c53..5b16d46 100644
--- a/lisp/service/users-service.lisp
+++ b/lisp/service/users-service.lisp
@@ -26,8 +26,8 @@
       (let ((auth-pkg (make-instance 'auth-pkg)))
         (setf (users instance) (get-all-users auth-pkg))))
     (sanitize-rest-json instance)
-    (loop for user in (users instance) do
-         (sanitize-json user))))
+    (loop for user in (users instance)
+          do (sanitize-json user))))
 
 (defclass users/add-service (users/view-service)
   ((form :initarg :form
@@ -69,8 +69,8 @@
   (with-auth (instance users/add-service "users-modify")
     (with-bogenherr-database
       (let ((registration (make-instance 'registration)))
-        (loop for param in (sb-introspect:function-lambda-list #'users-add-submit-json) do
-             (setf (slot-value registration param) (symbol-value param)))
+        (loop for param in (sb-introspect:function-lambda-list #'users-add-submit-json)
+              do (setf (slot-value registration param) (symbol-value param)))
         (let* ((auth-pkg (make-instance 'auth-pkg))
                (id (insert-registration auth-pkg registration)))
           (setf registration (get-registration-by-id auth-pkg id)))
@@ -185,10 +185,10 @@
                           (progn
                             (loop for role-group in (union '("profile-admin")
                                                            (cl-ppcre:split "\\|" (role_groups registration))
-                                                           :test 'string=) do
-                                 (insert-user-role-group auth-pkg (make-instance 'user-role
-                                                                                 :user_id (id user)
-                                                                                 :role_group_name role-group)))
+                                                           :test 'string=)
+                                  do (insert-user-role-group auth-pkg (make-instance 'user-role
+                                                                                     :user_id (id user)
+                                                                                     :role_group_name role-group)))
                             (delete-registration auth-pkg hash)
                             (setf (session-value :message) "Registration completed successfully."))
                           (setf (session-value :errormsg) "Error while completing registration.")))
@@ -238,10 +238,10 @@
               (delete-role-groups auth-pkg user)
               (loop for role-group in (union '("profile-admin")
                                              (cl-ppcre:split "\\|" role_groups)
-                                             :test 'string=) do
-                   (insert-user-role-group auth-pkg (make-instance 'user-role
-                                                                   :user_id (id user)
-                                                                   :role_group_name role-group)))
+                                             :test 'string=)
+                    do (insert-user-role-group auth-pkg (make-instance 'user-role
+                                                                       :user_id (id user)
+                                                                       :role_group_name role-group)))
               (setf (session-value :message) "User saved successfully."))
             (setf (session-value :errormsg) "An error occured."))))))
 
diff --git a/lisp/sql/auth-pkg.lisp b/lisp/sql/auth-pkg.lisp
index 21a996e..58d89cc 100644
--- a/lisp/sql/auth-pkg.lisp
+++ b/lisp/sql/auth-pkg.lisp
@@ -166,9 +166,9 @@
          (let* ((auth-pkg (make-instance 'auth-pkg))
                 (has-all-roles-p (let ((has-all-roles-p t))
                                    (with-bogenherr-database
-                                     (loop for role in (if (listp ,roles) ,roles (list ,roles)) do
-                                          (when (not (has-role auth-pkg ,session-name role))
-                                            (setf has-all-roles-p nil)))
+                                     (loop for role in (if (listp ,roles) ,roles (list ,roles))
+                                           do (when (not (has-role auth-pkg ,session-name role))
+                                                (setf has-all-roles-p nil)))
                                      has-all-roles-p))))
            (if has-all-roles-p
                ,@body
diff --git a/lisp/sql/user-session-pkg.lisp b/lisp/sql/user-session-pkg.lisp
index 0adba55..954f84f 100644
--- a/lisp/sql/user-session-pkg.lisp
+++ b/lisp/sql/user-session-pkg.lisp
@@ -106,11 +106,11 @@ variable."
     (setf org-ckons-session::*gc-last-cycle-timestamp* (get-universal-time))
     (with-bogenherr-database
       (let ((user-session-pkg (make-instance 'user-session-pkg)))
-        (loop for user-session in (get-user-sessions user-session-pkg) do
-          (let ((inactive-time (- org-ckons-session::*gc-last-cycle-timestamp* (datetime user-session))))
-            (when (and (> inactive-time org-ckons-session::*session-timeout*)
-                       (sessionid user-session))
-              (org-ckons-core::logger (format nil "Deleting expired session: id = [~a] ; sessionid = [~a]" (id user-session) (sessionid user-session)))
-              (loop for user-session-object in (get-user-session-objects user-session-pkg user-session) do
-                (delete-record user-session-pkg user-session-object))
-              (delete-record user-session-pkg user-session))))))))
+        (loop for user-session in (get-user-sessions user-session-pkg)
+              do (let ((inactive-time (- org-ckons-session::*gc-last-cycle-timestamp* (datetime user-session))))
+                   (when (and (> inactive-time org-ckons-session::*session-timeout*)
+                              (sessionid user-session))
+                     (org-ckons-core::logger (format nil "Deleting expired session: id = [~a] ; sessionid = [~a]" (id user-session) (sessionid user-session)))
+                     (loop for user-session-object in (get-user-session-objects user-session-pkg user-session)
+                           do (delete-record user-session-pkg user-session-object))
+                     (delete-record user-session-pkg user-session))))))))
diff --git a/lisp/webapps/bogenherr/clojurescript/bogenherr/src/core.cljs b/lisp/webapps/bogenherr/clojurescript/bogenherr/src/core.cljs
index 80862b3..6e5276d 100644
--- a/lisp/webapps/bogenherr/clojurescript/bogenherr/src/core.cljs
+++ b/lisp/webapps/bogenherr/clojurescript/bogenherr/src/core.cljs
@@ -164,7 +164,7 @@
 (declare goto-location)
 (declare reset-app)
 (declare goto-register)
-(declare site)
+(declare comp-app)
 (declare start-render)
 (declare start-nav-state)
 (declare reset-nav-state)
@@ -204,7 +204,7 @@
 
 ;; body
 
-(defn site []
+(defn comp-app []
   [:div {:class "container-fluid"}
    [:div {:class "banner"}
     [:table {:width "100%" :height "100%"}
@@ -226,7 +226,7 @@
 
 (defn start-render []
   (let [app-root (rdc/create-root (js/document.getElementById "app"))]
-    (rdc/render app-root [site])))
+    (rdc/render app-root [comp-app])))
 
 (defn start-nav-state []
   (cond (str/starts-with? (@nav-state :location) "/register/")
diff --git a/lisp/webapps/bogenherr/site.lisp b/lisp/webapps/bogenherr/site.lisp
index 37f33cd..9bb1b2d 100644
--- a/lisp/webapps/bogenherr/site.lisp
+++ b/lisp/webapps/bogenherr/site.lisp
@@ -196,8 +196,8 @@
 (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 ("/gallery/delete/:id" :method :delete) (&path (id 'integer)) .gallery-delete)
+(define-endpoint ("/gallery/file/view/:id" :method :get) (&path (id 'integer)) .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)
@@ -212,7 +212,7 @@
 (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 ("/register/:hash" :method :get) (&path (hash 'string)) .base (format nil "/register/~a" 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)
diff --git a/lisp/webapps/webapp-loader.lisp b/lisp/webapps/webapp-loader.lisp
index 7f1461e..e18f661 100644
--- a/lisp/webapps/webapp-loader.lisp
+++ b/lisp/webapps/webapp-loader.lisp
@@ -118,25 +118,25 @@ with the new one."
   (gethash key *webapps*))
 
 (defun populate-webapps ()
-  (loop for options-file in (get-options-files) do
-       (with-open-file (input options-file :direction :input)
-         (let* ((form (read input)))
-           (set-webapp (make-instance 'webapp
-                                      :name (getf form :name)
-                                      :scheme (getf form :scheme)
-                                      :url (getf form :url)
-                                      :document-root (make-webapp-path (getf form :document-root))
-                                      :title (getf form :title)
-                                      :meta-description (getf form :meta-description)
-                                      :databases (getf form :databases)
-                                      :mail-mx (getf form :mail-mx)
-                                      :mail-from (getf form :mail-from)
-                                      :mail-postmaster (getf form :mail-postmaster)
-                                      :mail-webmaster (getf form :mail-webmaster)
-                                      :mail-info (getf form :mail-info)
-                                      :mail-login-notify (getf form :mail-login-notify)
-                                      :mail-authentication (getf form :mail-authentication)
-                                      :mail-ssl (getf form :mail-ssl)))))))
+  (loop for options-file in (get-options-files)
+        do (with-open-file (input options-file :direction :input)
+             (let* ((form (read input)))
+               (set-webapp (make-instance 'webapp
+                                          :name (getf form :name)
+                                          :scheme (getf form :scheme)
+                                          :url (getf form :url)
+                                          :document-root (make-webapp-path (getf form :document-root))
+                                          :title (getf form :title)
+                                          :meta-description (getf form :meta-description)
+                                          :databases (getf form :databases)
+                                          :mail-mx (getf form :mail-mx)
+                                          :mail-from (getf form :mail-from)
+                                          :mail-postmaster (getf form :mail-postmaster)
+                                          :mail-webmaster (getf form :mail-webmaster)
+                                          :mail-info (getf form :mail-info)
+                                          :mail-login-notify (getf form :mail-login-notify)
+                                          :mail-authentication (getf form :mail-authentication)
+                                          :mail-ssl (getf form :mail-ssl)))))))
 
 (defun bogenherr ()
   "Call this to start the server."
@@ -175,6 +175,3 @@ you wish to publish."
        (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)))))