marcuskammer/dev.metalisp.survey
1
0
Fork 0
Code Issues 9 Pull requests Projects Releases Packages Wiki Activity Actions

Re-structure source files

Browse source
This commit is contained in:
Marcus Kammer 2024-06-02 10:44:24 +02:00
parent 38cba683f9
commit 008d5691d4
Signed by: marcuskammer
GPG key ID: C374817BE285268F
18 changed files with 160 additions and 154 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

22
dev.metalisp.survey.asd
View file

@ -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")))))

48
package.lisp
View file

@ -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*))

27
src/app.lisp Normal file
View file

@ -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/"))

82
src/handlers.lisp
View file

@ -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)))

8
src/handlers/create-survey.lisp Normal file
View file

@ -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)))

33
src/main.lisp → src/handlers/main.lisp
View file

@ -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/"))

4
src/handlers/new-survey.lisp Normal file
View file

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

25
src/handlers/questionnaire-submit.lisp Normal file
View file

@ -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)))

23
src/handlers/questionnaire.lisp Normal file
View file

@ -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)))

18
src/handlers/survey.lisp Normal file
View file

@ -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)))

6
src/handlers/surveys.lisp Normal file
View file

@ -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)))

2
src/views/create-survey.lisp
View file

@ -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

6
src/views/forms/sus.lisp
View file

@ -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'.")

2
src/views/new-survey.lisp
View file

@ -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"

2
src/views/partials/_navbar.lisp
View file

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

2
src/views/questionnaire-submit.lisp
View file

@ -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"

2
src/views/survey.lisp
View file

@ -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"

2
src/views/surveys.lisp
View file

@ -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")