diff --git a/dev.metalisp.survey.asd b/dev.metalisp.survey.asd index 62438a0..7013ce8 100644 --- a/dev.metalisp.survey.asd +++ b/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"))) - (:module "src/views/forms" - :components - ((:file "sus"))) + ((:file "app"))) (: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" - :depends-on ("package" "src/views") - :serial t + (:module "src/handlers" :components ((:file "main") - (:file "handlers"))))) + (:file "create-survey") + (:file "new-survey") + (:file "survey") + (:file "surveys") + (:file "questionnaire") + (:file "questionnaire-submit"))))) diff --git a/package.lisp b/package.lisp index e6689c7..1ac05f0 100644 --- a/package.lisp +++ b/package.lisp @@ -1,29 +1,14 @@ (defpackage ml-survey (:use #:cl) (:import-from #:hunchentoot - #:define-easy-handler - #: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) + #:easy-acceptor) (:export #:*app* #:start-server #:stop-server - #:restart-server - #:today - #:now - #:generate-uuid - #:*survey-data-dir*)) + #:restart-server)) -(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*)) diff --git a/src/app.lisp b/src/app.lisp new file mode 100644 index 0000000..e381399 --- /dev/null +++ b/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/")) diff --git a/src/handlers.lisp b/src/handlers.lisp deleted file mode 100644 index 7cc5e29..0000000 --- a/src/handlers.lisp +++ /dev/null @@ -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/'" - (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/'" - (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/'" - (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))) diff --git a/src/handlers/create-survey.lisp b/src/handlers/create-survey.lisp new file mode 100644 index 0000000..58a2b89 --- /dev/null +++ b/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))) diff --git a/src/main.lisp b/src/handlers/main.lisp similarity index 62% rename from src/main.lisp rename to src/handlers/main.lisp index 7f1c0ed..92ba8b1 100644 --- a/src/main.lisp +++ b/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) - (let ((acceptor (make-instance 'hunchentoot:easy-acceptor - :address address - :name name - :document-root document-root - :port port))) - acceptor)) +(defun split-uri (uri) + (remove-if #'string-empty-p + (uiop:split-string uri :separator "/"))) -(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)) +(defun valid-survey-id-p (id) + (member (if (stringp id) + (parse-integer id) + id) + (mapcar #'car (load-response (make-surveys-db-path))))) (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/")) diff --git a/src/handlers/new-survey.lisp b/src/handlers/new-survey.lisp new file mode 100644 index 0000000..bb38cdb --- /dev/null +++ b/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)) diff --git a/src/handlers/questionnaire-submit.lisp b/src/handlers/questionnaire-submit.lisp new file mode 100644 index 0000000..02d85e9 --- /dev/null +++ b/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/'" + (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))) diff --git a/src/handlers/questionnaire.lisp b/src/handlers/questionnaire.lisp new file mode 100644 index 0000000..28ed884 --- /dev/null +++ b/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/'" + (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))) diff --git a/src/handlers/survey.lisp b/src/handlers/survey.lisp new file mode 100644 index 0000000..1097d66 --- /dev/null +++ b/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/'" + (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))) diff --git a/src/handlers/surveys.lisp b/src/handlers/surveys.lisp new file mode 100644 index 0000000..fee3a27 --- /dev/null +++ b/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))) diff --git a/src/views/create-survey.lisp b/src/views/create-survey.lisp index b7b7a88..aa2680f 100644 --- a/src/views/create-survey.lisp +++ b/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 diff --git a/src/views/forms/sus.lisp b/src/views/forms/sus.lisp index a3e6919..b2c2c84 100644 --- a/src/views/forms/sus.lisp +++ b/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'.") diff --git a/src/views/new-survey.lisp b/src/views/new-survey.lisp index b348f79..0766323 100644 --- a/src/views/new-survey.lisp +++ b/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" diff --git a/src/views/partials/_navbar.lisp b/src/views/partials/_navbar.lisp index 32ee29b..d459551 100644 --- a/src/views/partials/_navbar.lisp +++ b/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 diff --git a/src/views/questionnaire-submit.lisp b/src/views/questionnaire-submit.lisp index b85c4a2..ba42648 100644 --- a/src/views/questionnaire-submit.lisp +++ b/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" diff --git a/src/views/survey.lisp b/src/views/survey.lisp index 011e872..cc71a7e 100644 --- a/src/views/survey.lisp +++ b/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" diff --git a/src/views/surveys.lisp b/src/views/surveys.lisp index d8c1599..c0ebe4a 100644 --- a/src/views/surveys.lisp +++ b/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")