From 89ae137c402aeeb6c258fbd3b91c645b62cbe5eb Mon Sep 17 00:00:00 2001 From: Marcus Kammer Date: Thu, 30 May 2024 22:06:13 +0200 Subject: [PATCH] Create surveys and get an overview of all surveys --- package.lisp | 2 +- src/main.lisp | 55 +++++++++++++++++------------ src/pages.lisp | 94 +++++++++++++++++++++++++++++++++++++++++--------- 3 files changed, 111 insertions(+), 40 deletions(-) diff --git a/package.lisp b/package.lisp index cad8c28..b9454f1 100644 --- a/package.lisp +++ b/package.lisp @@ -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)) diff --git a/src/main.lisp b/src/main.lisp index 82a2b32..55fb889 100644 --- a/src/main.lisp +++ b/src/main.lisp @@ -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/'" + (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))) diff --git a/src/pages.lisp b/src/pages.lisp index 41ae417..e0c4f96 100644 --- a/src/pages.lisp +++ b/src/pages.lisp @@ -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 - (:div :class "form-check" - (:input :class "form-check-input" - :type "checkbox" - :value "t" - :id (first el) - :name (first el) - (:label :class "form-check-label" - :for (first el) - (second el))))))) + (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 key + :id key + :name "questionnaire" + (:label :class "form-check-label" + :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)))))))))