Create surveys and get an overview of all surveys
This commit is contained in:
parent
5de2da8f8a
commit
89ae137c40
GPG key ID:
C374817BE285268F
3 changed files with 111 additions and 40 deletions
|
|
@ -40,4 +40,4 @@
|
|||
(:use #:cl)
|
||||
(:import-from #:dev.metalisp.sbt
|
||||
#:with-page)
|
||||
(:export #:index #:imprint #:new-survey))
|
||||
(:export #:index #:imprint #:new-survey #:surveys #:create-survey #:survey))
|
||||
|
|
|
|||
|
|
@ -57,9 +57,6 @@
|
|||
((string= lang "de") (dev.metalisp.survey/forms:sus-form-de))
|
||||
(t (error "Unsupported language: ~A" lang))))
|
||||
|
||||
(define-easy-handler (index :uri "/") ()
|
||||
(dev.metalisp.survey/pages:index))
|
||||
|
||||
(define-easy-handler (imprint :uri "/imprint") ()
|
||||
(dev.metalisp.survey/pages:imprint))
|
||||
|
||||
|
|
@ -75,33 +72,47 @@
|
|||
(store-response (make-db-path (today) "_submit-db.lisp") response)
|
||||
(format nil "~A" response)))
|
||||
|
||||
(defun starts-with-subseq (subseq seq)
|
||||
"Check if the sequence SEQ starts with the subsequence SUBSEQ."
|
||||
(let ((subseq-length (length subseq)))
|
||||
(and (<= subseq-length (length seq))
|
||||
(string= subseq (subseq seq 0 subseq-length)))))
|
||||
;; (defun starts-with-subseq (subseq seq)
|
||||
;; "Check if the sequence SEQ starts with the subsequence SUBSEQ."
|
||||
;; (let ((subseq-length (length subseq)))
|
||||
;; (and (<= subseq-length (length seq))
|
||||
;; (string= subseq (subseq seq 0 subseq-length)))))
|
||||
|
||||
(defun survey-uri-p (request)
|
||||
"Predicate function to check if the request URI matches the survey pattern.
|
||||
The URI should start with \"/survey/\" followed by a numeric ID."
|
||||
;; (defun survey-uri-p (request)
|
||||
;; "Predicate function to check if the request URI matches the survey pattern.
|
||||
;; The URI should start with \"/survey/\" followed by a numeric ID."
|
||||
;; (let* ((uri (hunchentoot:request-uri request))
|
||||
;; (id (subseq uri (length "/survey/"))))
|
||||
;; (and (starts-with-subseq "/survey/" uri)
|
||||
;; (every #'digit-char-p id))))
|
||||
|
||||
(defun survey-uri-p (uri)
|
||||
"Check if the request URI matches the pattern '/survey/<numeric>'"
|
||||
(let ((parts (uiop:split-string uri :separator "/")))
|
||||
(and (= (length parts) 3)
|
||||
(string= (second parts) "survey")
|
||||
(every #'digit-char-p (third parts)))))
|
||||
|
||||
(defun survey-uri (request)
|
||||
(let ((uri (hunchentoot:request-uri request)))
|
||||
(and (starts-with-subseq "/survey/" uri)
|
||||
(let ((id (subseq uri (length "/survey/"))))
|
||||
(every #'digit-char-p id)))))
|
||||
(survey-uri-p uri)))
|
||||
|
||||
(define-easy-handler (survey-handler :uri #'survey-uri-p) ()
|
||||
(let ((id (subseq (hunchentoot:request-uri*) (length "/survey/"))))
|
||||
(setf (content-type*) "text/plain")
|
||||
(format nil "Survey ID: ~a" id)))
|
||||
(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)))))
|
||||
(dev.metalisp.survey/pages:survey survey)
|
||||
(hunchentoot:request-uri*)))
|
||||
|
||||
(define-easy-handler (new-survey :uri "/new-survey") nil
|
||||
(dev.metalisp.survey/pages:new-survey))
|
||||
|
||||
(define-easy-handler (create-survey :uri "/create-survey"
|
||||
:default-request-type :post) nil
|
||||
(define-easy-handler (create-survey :uri "/create-survey") nil
|
||||
(let ((post-params (post-parameters* *request*))
|
||||
(uid (* (get-universal-time) (random 999)))
|
||||
(stored-surveys (load-response (make-surveys-db-path))))
|
||||
(store-response (make-surveys-db-path) (push (list uid post-params) stored-surveys))
|
||||
(setf (content-type*) "text/plain")
|
||||
(format nil "~A" post-params)))
|
||||
(dev.metalisp.survey/pages:create-survey uid)))
|
||||
|
||||
(define-easy-handler (surveys :uri "/") nil
|
||||
(let ((stored-surveys (load-response (make-surveys-db-path))))
|
||||
(dev.metalisp.survey/pages:surveys stored-surveys)))
|
||||
|
|
|
|||
|
|
@ -8,11 +8,6 @@
|
|||
(dev.metalisp.survey/partials:navbar-en)
|
||||
(:section :class "container"
|
||||
(:h2 :class "mb-3" "Surveys")
|
||||
(:div :class "btn-toolbar my-3"
|
||||
(:div :class "btn-group me-2"
|
||||
(:a :class "btn btn-primary"
|
||||
:href "/new-survey"
|
||||
"New Survey")))
|
||||
(loop for (lang anchors) on collection by #'cddr do
|
||||
(:section :class "container-fluid mb-3"
|
||||
(:h3 :class "mb-3" lang)
|
||||
|
|
@ -58,18 +53,20 @@
|
|||
|
||||
(:h3 "Questionnaires")
|
||||
(:div :class "mb-3"
|
||||
(let ((questionnaires '(("sus-de" "System Usability Scale (Deutsch)")
|
||||
("sus-en" "System Usability Scale (English)"))))
|
||||
(loop for el in questionnaires do
|
||||
(let ((questionnaires '(("sus?lang=de" "System Usability Scale (Deutsch)")
|
||||
("sus?lang=en" "System Usability Scale (English)"))))
|
||||
(loop for el in questionnaires
|
||||
for key = (first el)
|
||||
for value = (second el) do
|
||||
(:div :class "form-check"
|
||||
(:input :class "form-check-input"
|
||||
:type "checkbox"
|
||||
:value "t"
|
||||
:id (first el)
|
||||
:name (first el)
|
||||
:value key
|
||||
:id key
|
||||
:name "questionnaire"
|
||||
(:label :class "form-check-label"
|
||||
:for (first el)
|
||||
(second el)))))))
|
||||
:for key
|
||||
value))))))
|
||||
|
||||
(:button :type"Submit"
|
||||
:class "btn btn-primary"
|
||||
|
|
@ -77,3 +74,66 @@
|
|||
|
||||
(defun imprint ()
|
||||
nil)
|
||||
|
||||
(defun extract-title (list)
|
||||
(cdr (assoc "title" (second list) :test #'string-equal)))
|
||||
|
||||
(defun extract-description (list)
|
||||
(cdr (assoc "description" (second list) :test #'string-equal)))
|
||||
|
||||
(defun extract-id (list)
|
||||
(first list))
|
||||
|
||||
(defun surveys (surveys)
|
||||
"Generates the view to show all surveys available."
|
||||
(with-page (:title "Surveys")
|
||||
(dev.metalisp.survey/partials:navbar-en)
|
||||
(:section :class "container"
|
||||
(:h2 :class "mb-3" "Your Surveys")
|
||||
(:div :class "btn-toolbar my-3"
|
||||
(:div :class "btn-group me-2"
|
||||
(:a :class "btn btn-primary"
|
||||
:href "/new-survey"
|
||||
"New Survey")))
|
||||
(:ol :class "list-group list-group-numbered"
|
||||
(loop for survey in surveys
|
||||
for title = (extract-title survey)
|
||||
for description = (extract-description survey)
|
||||
for id = (extract-id survey) do
|
||||
(:li :class "list-group-item d-flex justify-content-between align-items-start"
|
||||
(:div :class "ms-2 me-auto"
|
||||
(:a :class "fw-bold clearfix"
|
||||
:href (format nil "/survey/~A" id)
|
||||
title)
|
||||
(if description
|
||||
(:span description)
|
||||
nil))))))))
|
||||
|
||||
(defun create-survey (survey-id)
|
||||
"Generates the view to show the survey created."
|
||||
(with-page (:title "Surveys")
|
||||
(dev.metalisp.survey/partials:navbar-en)
|
||||
(:section :class "container"
|
||||
(:h2 "Your Surveys")
|
||||
(if survey-id
|
||||
(:div :class "alert alert-info" :role "alert"
|
||||
(format nil "Your new survey: ~A is created." survey-id))
|
||||
nil))))
|
||||
|
||||
(defun survey (survey)
|
||||
"Generates the view to show the survey created."
|
||||
(let ((id (format nil "~a" (first survey)))
|
||||
(properties (first (rest survey))))
|
||||
(with-page (:title "Surveys")
|
||||
(dev.metalisp.survey/partials:navbar-en)
|
||||
(:section :class "container"
|
||||
(:h2 id)
|
||||
(:ul :class "list-group"
|
||||
(loop for property in properties
|
||||
for key = (car property)
|
||||
for value = (cdr property) do
|
||||
(:li :class "list-group-item"
|
||||
(if (string= key "questionnaire")
|
||||
(:a :href (concatenate 'string "/survey/" id "/" value)
|
||||
value)
|
||||
(format nil "~a: ~a" key value)))))))))
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue