Re-structure source files

dev.metalisp.survey.asd

@@ -6,22 +6,24 @@
   :licence "MIT"
   :depends-on ("local-time" "hunchentoot" "dev.metalisp.sbt")
   :components ((:file "package")
-               (:module "src/views/partials"
+               (:module "src"
                 :components
-                ((:file "_navbar")))
+                ((:file "app")))
-               (:module "src/views/forms"
-                :components
-                ((:file "sus")))
                (:module "src/views"
                 :components
-                ((:file "create-survey")
+                ((:file "partials/_navbar")
+                 (:file "forms/sus")
+                 (:file "create-survey")
                  (:file "new-survey")
                  (:file "survey")
                  (:file "surveys")
                  (:file "questionnaire-submit")))
-               (:module "src"
+               (:module "src/handlers"
-                :depends-on ("package" "src/views")
-                :serial t
                 :components
                 ((:file "main")
-                 (:file "handlers")))))
+                 (:file "create-survey")
+                 (:file "new-survey")
+                 (:file "survey")
+                 (:file "surveys")
+                 (:file "questionnaire")
+                 (:file "questionnaire-submit")))))

package.lisp

@@ -1,29 +1,14 @@
 (defpackage ml-survey
   (:use #:cl)
   (:import-from #:hunchentoot
-                #:define-easy-handler
+                #:easy-acceptor)
-                #:easy-acceptor
-                #:post-parameters*
-                #:content-type*
-                #:*request*)
-  (:import-from #:spinneret
-                #:*html*
-                #:*html-lang*)
-  (:import-from #:dev.metalisp.sbt
-                #:with-page)
-  (:import-from #:dev.metalisp.sbt/utility
-                #:spacing)
   (:export
    #:*app*
    #:start-server
    #:stop-server
-   #:restart-server
+   #:restart-server))
-   #:today
-   #:now
-   #:generate-uuid
-   #:*survey-data-dir*))
 
-(defpackage ml-survey/forms
+(defpackage ml-survey/views
   (:use #:cl)
   (:import-from #:spinneret
                 #:*html*
@@ -39,20 +24,25 @@
                 #:with-page)
   (:import-from #:dev.metalisp.sbt/form
                 #:multi-form)
-  (:export #:sus-form-en #:sus-form-de))
-
-(defpackage ml-survey/partials
-  (:use #:cl)
-  (:export #:navbar-en #:navbar-de))
-
-(defpackage ml-survey/views
-  (:use #:cl)
-  (:import-from #:dev.metalisp.sbt
-                #:with-page)
   (:export #:index
            #:imprint
            #:new-survey
            #:surveys
            #:create-survey
            #:survey
-           #:questionnaire-submit))
+           #:questionnaire-submit
+           #:sus-form-de
+           #:sus-form-en))
+
+(defpackage ml-survey/handlers
+  (:use #:cl)
+  (:import-from #:spinneret
+                #:*html*
+                #:*html-lang*)
+  (:import-from #:hunchentoot
+                #:define-easy-handler
+                #:post-parameters*
+                #:content-type*
+                #:request-uri
+                #:request-uri*
+                #:*request*))

src/app.lisp

@@ -0,0 +1,27 @@
+(in-package :ml-survey)
+
+
+(defun create-server (name port &key address document-root)
+  (let ((acceptor (make-instance 'hunchentoot:easy-acceptor
+                                 :address address
+                                 :name name
+                                 :document-root document-root
+                                 :port port)))
+    acceptor))
+
+(defun start-server (acceptor &key document-root)
+  (if document-root
+      (setf (hunchentoot:acceptor-document-root acceptor) document-root))
+  (hunchentoot:start acceptor))
+
+(defun stop-server (acceptor)
+  (hunchentoot:stop acceptor))
+
+(defun restart-server (acceptor)
+  (hunchentoot:stop acceptor)
+  (hunchentoot:start acceptor))
+
+(defvar *app* (create-server 'app
+                             8080
+                             :document-root
+                             "~/quicklisp/local-projects/dev.metalisp.survey/"))

src/handlers.lisp

@@ -1,82 +0,0 @@
-(in-package :ml-survey)
-
-(defun split-uri (uri)
-  (remove-if #'string-empty-p (uiop:split-string uri :separator "/")))
-
-(defun questionnaire-uri-p (uri)
-  "Check if the request URI matches the pattern '/survey/<numeric>'"
-  (let ((parts (split-uri uri)))
-    (and (= (length parts) 3)
-         (string= (first parts) "survey")
-         (every #'digit-char-p (second parts)))))
-
-(defun questionnaire-uri (request)
-  (questionnaire-uri-p (hunchentoot:request-uri request)))
-
-(defun return-sus-form (lang)
-  "Based on LANG decide which sus form to show."
-  (check-type lang string)
-  (cond ((string= lang "en") #'ml-survey/forms:sus-form-en)
-        ((string= lang "de") #'ml-survey/forms:sus-form-de)
-        (t (error "Unsupported language: ~A" lang))))
-
-(define-easy-handler (questionnaire :uri #'questionnaire-uri) (lang)
-  (let ((survey-id (second (split-uri (hunchentoot:request-uri*)))))
-    (setf *html-lang* lang)
-    (funcall (return-sus-form lang) survey-id)))
-
-(defun questionnaire-submit-uri-p (uri)
-  "Check if the request URI matches the pattern '/survey/<numeric>'"
-  (let ((parts (split-uri uri)))
-    (and (= (length parts) 3)
-         (string= (first parts) "survey")
-         (every #'digit-char-p (second parts))
-         (search "submit" (third parts)))))
-
-(defun questionnaire-submit-uri (request)
-  (questionnaire-submit-uri-p (hunchentoot:request-uri request)))
-
-(defun ensure-data-file-exist (id &optional lang)
-  (ensure-directories-exist (format nil "~a~a/~a-~a.lisp"
-                                    *survey-data-dir*
-                                    id
-                                    (generate-uuid)
-                                    lang)))
-
-(define-easy-handler (questionnaire-submit :uri #'questionnaire-submit-uri) (lang)
-  (let ((post-params (post-parameters* *request*))
-        (id (second (split-uri (hunchentoot:request-uri*)))))
-    (store-response (ensure-data-file-exist id) post-params)
-    (ml-survey/views:questionnaire-submit)))
-
-(defun survey-uri-p (uri)
-  "Check if the request URI matches the pattern '/survey/<numeric>'"
-  (let ((parts (split-uri uri)))
-    (and (= (length parts) 2)
-         (string= (first parts) "survey")
-         (every #'digit-char-p (second parts)))))
-
-(defun survey-uri (request)
-  (let ((uri (hunchentoot:request-uri request)))
-    (survey-uri-p uri)))
-
-(define-easy-handler (survey :uri #'survey-uri) ()
-  (let* ((id (subseq (hunchentoot:request-uri*) (length "/survey/")))
-         (survey (assoc (parse-integer id)
-                        (load-response (make-surveys-db-path)))))
-    (ml-survey/views:survey survey)))
-
-(define-easy-handler (new-survey :uri "/new-survey") nil
-  (ml-survey/views:new-survey))
-
-(define-easy-handler (create-survey :uri "/create-survey") nil
-  (let ((post-params (post-parameters* *request*))
-        (uid (ml-survey:generate-uuid))
-        (stored-surveys (load-response (make-surveys-db-path))))
-    (store-response (make-surveys-db-path) (push (list uid post-params) stored-surveys))
-    (ml-survey/views:create-survey uid)))
-
-(define-easy-handler (surveys :uri "/") nil
-  (let ((stored-surveys (load-response (make-surveys-db-path))))
-    (hunchentoot:start-session)
-    (ml-survey/views:surveys stored-surveys)))

src/handlers/create-survey.lisp

@@ -0,0 +1,8 @@
+(in-package :ml-survey/handlers)
+
+(define-easy-handler (create-survey :uri "/create-survey") nil
+  (let ((post-params (post-parameters* *request*))
+        (uid (generate-uuid))
+        (stored-surveys (load-response (make-surveys-db-path))))
+    (store-response (make-surveys-db-path) (push (list uid post-params) stored-surveys))
+    (ml-survey/views:create-survey uid)))

src/handlers/main.lisp

@@ -1,29 +1,19 @@
-(in-package :ml-survey)
+(in-package :ml-survey/handlers)
 
 (defvar *survey-data-dir*
   (ensure-directories-exist (format nil
                                     "~adata/survey/"
                                     (uiop:getcwd))))
 
-(defun create-server (name port &key address document-root)
+(defun split-uri (uri)
-  (let ((acceptor (make-instance 'hunchentoot:easy-acceptor
+  (remove-if #'string-empty-p
-                                 :address address
+             (uiop:split-string uri :separator "/")))
-                                 :name name
-                                 :document-root document-root
-                                 :port port)))
-    acceptor))
 
-(defun start-server (acceptor &key document-root)
+(defun valid-survey-id-p (id)
-  (if document-root
+  (member (if (stringp id)
-      (setf (hunchentoot:acceptor-document-root acceptor) document-root))
+              (parse-integer id)
-  (hunchentoot:start acceptor))
+              id)
-
+          (mapcar #'car (load-response (make-surveys-db-path)))))
-(defun stop-server (acceptor)
-  (hunchentoot:stop acceptor))
-
-(defun restart-server (acceptor)
-  (hunchentoot:stop acceptor)
-  (hunchentoot:start acceptor))
 
 (defun today ()
   "Return today's date formatted as ISO-8601."
@@ -64,8 +54,3 @@
                          (random 1000000))))
 
 (defun string-empty-p (string) (= (length string) 0))
-
-(defvar *app* (create-server 'app
-                             8080
-                             :document-root
-                             "~/quicklisp/local-projects/dev.metalisp.survey/"))

src/handlers/new-survey.lisp

@@ -0,0 +1,4 @@
+(in-package :ml-survey/handlers)
+
+(define-easy-handler (new-survey :uri "/new-survey") nil
+  (ml-survey/views:new-survey))

src/handlers/questionnaire-submit.lisp

@@ -0,0 +1,25 @@
+(in-package :ml-survey/handlers)
+
+(defun questionnaire-submit-uri-p (uri)
+  "Check if the request URI matches the pattern '/survey/<numeric>'"
+  (let ((parts (split-uri uri)))
+    (and (= (length parts) 3)
+         (string= (first parts) "survey")
+         (every #'digit-char-p (second parts))
+         (search "submit" (third parts)))))
+
+(defun questionnaire-submit-uri (request)
+  (questionnaire-submit-uri-p (request-uri request)))
+
+(defun ensure-data-file-exist (id &optional lang)
+  (ensure-directories-exist (format nil "~a~a/~a-~a.lisp"
+                                    *survey-data-dir*
+                                    id
+                                    (generate-uuid)
+                                    lang)))
+
+(define-easy-handler (questionnaire-submit :uri #'questionnaire-submit-uri) nil
+  (let ((post-params (post-parameters* *request*))
+        (id (second (split-uri (request-uri*)))))
+    (store-response (ensure-data-file-exist id) post-params)
+    (ml-survey/views:questionnaire-submit)))

src/handlers/questionnaire.lisp

@@ -0,0 +1,23 @@
+(in-package :ml-survey/handlers)
+
+(defun questionnaire-uri-p (uri)
+  "Check if the request URI matches the pattern '/survey/<numeric>'"
+  (let ((parts (split-uri uri)))
+    (and (= (length parts) 3)
+         (string= (first parts) "survey")
+         (every #'digit-char-p (second parts)))))
+
+(defun questionnaire-uri (request)
+  (questionnaire-uri-p (request-uri request)))
+
+(defun return-sus-form (lang)
+  "Based on LANG decide which sus form to show."
+  (check-type lang string)
+  (cond ((string= lang "en") #'ml-survey/views:sus-form-en)
+        ((string= lang "de") #'ml-survey/views:sus-form-de)
+        (t (error "Unsupported language: ~A" lang))))
+
+(define-easy-handler (questionnaire :uri #'questionnaire-uri) (lang)
+  (let ((survey-id (second (split-uri (request-uri*)))))
+    (setf *html-lang* lang)
+    (funcall (return-sus-form lang) survey-id)))

src/handlers/survey.lisp

@@ -0,0 +1,18 @@
+(in-package :ml-survey/handlers)
+
+(defun survey-uri-p (uri)
+  "Check if the request URI matches the pattern '/survey/<numeric>'"
+  (let ((parts (split-uri uri)))
+    (and (= (length parts) 2)
+         (string= (first parts) "survey")
+         (every #'digit-char-p (second parts)))))
+
+(defun survey-uri (request)
+  (let ((uri (request-uri request)))
+    (survey-uri-p uri)))
+
+(define-easy-handler (survey :uri #'survey-uri) ()
+  (let* ((id (subseq (request-uri*) (length "/survey/")))
+         (survey (assoc (parse-integer id)
+                        (load-response (make-surveys-db-path)))))
+    (ml-survey/views:survey survey)))

src/handlers/surveys.lisp

@@ -0,0 +1,6 @@
+(in-package :ml-survey/handlers)
+
+(define-easy-handler (surveys :uri "/") nil
+  (let ((stored-surveys (load-response (make-surveys-db-path))))
+    (hunchentoot:start-session)
+    (ml-survey/views:surveys stored-surveys)))

src/views/create-survey.lisp

@@ -3,7 +3,7 @@
 (defun create-survey (survey-id)
   "Generates the view to show the survey created."
   (with-page (:title "Surveys")
-    (ml-survey/partials:navbar-en)
+    (navbar-en)
     (:section :class "container"
               (:h2 "Your Surveys")
               (if survey-id

src/views/forms/sus.lisp

@@ -1,8 +1,8 @@
-(in-package :ml-survey/forms)
+(in-package :ml-survey/views)
 
 (defun sus-form-en (survey-id)
   (with-page (:title "SUS Form")
-    (ml-survey/partials:navbar-en)
+    (navbar-en)
     (:section :class "container"
               (:h2 "Usability Feedback Form")
               (:p "Please fill out the following forms and press the submit button.")
@@ -106,7 +106,7 @@
 
 (defun sus-form-de (survey-id)
   (with-page (:title "SUS Formular")
-    (ml-survey/partials:navbar-de)
+    (navbar-de)
     (:section :class "container"
               (:h2 "Usability Feedback Formular")
               (:p "Bitte füllen Sie die folgende Formular aus und klicken Sie auf die Schaltfläche 'Senden'.")

src/views/new-survey.lisp

@@ -14,7 +14,7 @@
 (defun new-survey ()
   "Generates the view to create a new survey."
   (with-page (:title "New Survey")
-    (ml-survey/partials:navbar-en)
+    (navbar-en)
     (:section :class "container"
               (:h2 :class "mb-3" "New Survey")
               (:form :action "/create-survey" :method "post"

src/views/partials/_navbar.lisp

@@ -1,4 +1,4 @@
-(in-package :ml-survey/partials)
+(in-package :ml-survey/views)
 
 (defmacro navbar-brand (src width)
   `(spinneret:with-html

src/views/questionnaire-submit.lisp

@@ -2,7 +2,7 @@
 
 (defun questionnaire-submit ()
   (with-page (:title "Confirmation")
-    (ml-survey/partials:navbar-en)
+    (navbar-en)
     (:section :class "container"
               (:h2 "Confirmation")
               (:div :class "alert alert-info" :role "alert"

src/views/survey.lisp

@@ -5,7 +5,7 @@
   (let ((id (format nil "~a" (first survey)))
         (properties (first (rest survey))))
     (with-page (:title "Surveys")
-      (ml-survey/partials:navbar-en)
+      (navbar-en)
       (:section :class "container"
                 (:h2 id)
                 (:table :class "table"

src/views/surveys.lisp

@@ -12,7 +12,7 @@
 (defun surveys (surveys)
   "Generates the view to show all surveys available."
   (with-page (:title "Surveys")
-    (ml-survey/partials:navbar-en)
+    (navbar-en)
     (:section :class "container"
               (:h2 :class "mb-3"
                    "Your Surveys")