From 8becb3d8aa0ea62a6512f80d626570a9db293d51 Mon Sep 17 00:00:00 2001 From: Marcus Kammer Date: Fri, 7 Jun 2024 18:55:42 +0200 Subject: [PATCH] Show the results of questionnaires in the survey view --- src/handlers/main.lisp | 4 +- src/handlers/questionnaire-submit.lisp | 9 +-- src/handlers/questionnaire.lisp | 10 +-- src/handlers/survey.lisp | 105 ++++++++++++++++++++----- src/views/survey.lisp | 28 +++---- 5 files changed, 107 insertions(+), 49 deletions(-) diff --git a/src/handlers/main.lisp b/src/handlers/main.lisp index 30a4d87..33400d5 100644 --- a/src/handlers/main.lisp +++ b/src/handlers/main.lisp @@ -1,7 +1,9 @@ (in-package :ml-survey/handlers) (defun surveys-data-dir () - (ensure-directories-exist (uiop:merge-pathnames* "data/surveys"))) + (let ((data-dir (uiop:merge-pathnames* "data/surveys/"))) + (ensure-directories-exist data-dir) + data-dir)) (defun split-uri (uri) (check-type uri string) diff --git a/src/handlers/questionnaire-submit.lisp b/src/handlers/questionnaire-submit.lisp index adf3a4c..52cc756 100644 --- a/src/handlers/questionnaire-submit.lisp +++ b/src/handlers/questionnaire-submit.lisp @@ -2,11 +2,10 @@ (defun questionnaire-submit-uri-p (uri) "Check if the request URI matches the pattern '/survey//submit'" - (let ((parts (split-uri uri)) - (survey (make-survey uri))) + (let ((parts (split-uri uri))) (and (= (length parts) 3) (string= (first parts) "survey") - (funcall survey 'id) + (every #'digit-char-p (second parts)) (search "submit" (third parts))))) (defun questionnaire-submit-uri (request) @@ -21,7 +20,7 @@ (define-easy-handler (questionnaire-submit :uri #'questionnaire-submit-uri) nil (let ((post-params (post-parameters* *request*)) (questionnaire-id (generate-uuid)) - (survey (make-survey (request-uri*)))) - (store-response (ensure-data-file-exist (funcall survey 'id) questionnaire-id) + (s (make-instance 'survey :id (second (split-uri (request-uri*)))))) + (store-response (ensure-data-file-exist (survey-id s) questionnaire-id) post-params) (ml-survey/views:questionnaire-submit))) diff --git a/src/handlers/questionnaire.lisp b/src/handlers/questionnaire.lisp index 40c11b1..a33ee97 100644 --- a/src/handlers/questionnaire.lisp +++ b/src/handlers/questionnaire.lisp @@ -2,12 +2,10 @@ (defun questionnaire-uri-p (uri) "Check if the request URI matches the pattern '/survey/'" - (let ((parts (split-uri uri)) - (survey (make-survey uri))) + (let ((parts (split-uri uri))) (and (= (length parts) 3) (string= (first parts) "survey") - (every #'digit-char-p (second parts)) - (funcall survey 'id-p)))) + (every #'digit-char-p (second parts))))) (defun questionnaire-uri (request) (questionnaire-uri-p (request-uri request))) @@ -20,6 +18,6 @@ (t (error "Unsupported language: ~A" lang)))) (define-easy-handler (questionnaire :uri #'questionnaire-uri) (lang) - (let ((survey (make-survey (request-uri*)))) + (let ((s (make-instance 'survey :id (second (split-uri (request-uri*)))))) (setf *html-lang* lang) - (funcall (choose-sus-form lang) (funcall survey 'id)))) + (funcall (choose-sus-form lang) (survey-id s)))) diff --git a/src/handlers/survey.lisp b/src/handlers/survey.lisp index bcf582f..0d4e772 100644 --- a/src/handlers/survey.lisp +++ b/src/handlers/survey.lisp @@ -1,27 +1,96 @@ (in-package :ml-survey/handlers) -(defun make-survey (uri) - (labels ((survey-fn (action) - (case action - (id (second (split-uri uri))) +(defun extract-numbers (results) + "Extract numbers from a questionnaire RESULTS list. +Returns a list of integers." + (check-type results list) + (mapcar (lambda (x) + (parse-integer (remove-if (complement #'digit-char-p) + (cdr x)))) results)) - (id-p (let ((ids (mapcar #'car (load-response (make-surveys-db-file))))) - (if (member (parse-integer (survey-fn 'id)) ids) t nil))) +(defun sus-calc-score (results) + (check-type results list) + (let ((counter 0)) + (mapcar (lambda (x) + (setq counter (1+ counter)) + (if (evenp counter) + (- 5 x) + (1- x))) + results))) - (uri-p (let ((parts (split-uri uri))) - (and (= (length parts) 2) - (string= (first parts) "survey") - (every #'digit-char-p (second parts)) - (survey-fn 'id-p)))) +(defun sus-calc-score-per-row (results) + (check-type results list) + (* (apply #'+ (sus-calc-score results)) 2.5)) - (properties (first (rest (assoc (parse-integer (survey-fn 'id)) - (load-response (make-surveys-db-file))))))))) - #'survey-fn)) +(defun sus-calc (files) + (check-type files list) + (loop for f in files + for resp = (load-response f) + collect + (sus-calc-score-per-row (extract-numbers resp)))) + +(defclass survey () + ((id :initarg :id :reader survey-id) + (data-dir :initarg :data-dir :reader survey-data-dir) + (properties :initarg :properties :reader survey-properties))) + +(defmethod initialize-instance :after ((survey survey) &key) + (with-slots (id data-dir properties) survey + (setf data-dir (uiop:merge-pathnames* + (format nil "~a/" id) + (surveys-data-dir))) + (setf properties (first (rest (assoc (parse-integer id) + (load-response (make-surveys-db-file)))))))) + +(defgeneric survey-id-p (survey) + (:documentation "Check if the survey ID is present in the surveys database.")) + +(defgeneric survey-data-dir-files (survey) + (:documentation "Get the list of files in the survey's data directory.")) + +(defgeneric survey-data-dir-p (survey) + (:documentation "Check if the survey's data directory exists.")) + +(defmethod survey-id-p ((survey survey)) + (let ((ids (mapcar #'car (load-response (make-surveys-db-file))))) + (if (member (parse-integer (survey-id survey)) ids) t nil))) + +(defmethod survey-data-dir-files ((survey survey)) + (uiop:directory-files (survey-data-dir survey))) + +(defmethod survey-data-dir-p ((survey survey)) + (uiop:directory-exists-p (survey-data-dir survey))) + +(defmethod survey-html ((survey survey)) + (spinneret:with-html + (:table :class "table" + (:thead :class "thead-dark" + (:tr (:th :scope "col" + "Key") + (:th :scope "col" + "Value"))) + (:tbody (loop for property in (survey-properties survey) + for key = (car property) + for value = (cdr property) do + (:tr (:td key) + (:td (if (string= key "questionnaire") + (:a :href (concatenate 'string "/survey/" (survey-id survey) value) + value) + value)))))))) + +(defun survey-uri-p (uri) + (let* ((parts (split-uri uri)) + (s (make-instance 'survey :id (second parts)))) + (and (= (length parts) 2) + (string= (first parts) "survey") + (every #'digit-char-p (survey-id s)) + (survey-id-p s)))) (defun survey-uri (request) - (let ((survey (make-survey (request-uri request)))) - (funcall survey 'uri-p))) + (survey-uri-p (request-uri request))) (define-easy-handler (survey :uri #'survey-uri) () - (let ((survey (make-survey (request-uri*)))) - (ml-survey/views:survey (funcall survey 'id) (funcall survey 'properties)))) + (let ((s (make-instance 'survey :id (second (split-uri (request-uri*)))))) + (ml-survey/views:survey s + (when (survey-data-dir-p s) + (sus-calc (survey-data-dir-files s)))))) diff --git a/src/views/survey.lisp b/src/views/survey.lisp index e77e90c..b31245c 100644 --- a/src/views/survey.lisp +++ b/src/views/survey.lisp @@ -1,24 +1,14 @@ (in-package :ml-survey/views) -(defun survey (id properties) +(defun survey (survey &optional results) "Generates the view to show the survey created." - (check-type id string) - (check-type properties list) - (with-page (:title "Surveys") + (with-page (:title "Survey Details") (navbar-en) (:section :class "container" - (:h2 id) - (:table :class "table" - (:thead :class "thead-dark" - (:tr (:th :scope "col" - "Key") - (:th :scope "col" - "Value"))) - (:tbody (loop for property in properties - for key = (car property) - for value = (cdr property) do - (:tr (:td key) - (:td (if (string= key "questionnaire") - (:a :href (concatenate 'string "/survey/" id value) - value) - value))))))))) + (:h2 (format nil "Survey ID: ~a" (ml-survey/handlers::survey-id survey))) + (:h3 "Properties") + (ml-survey/handlers::survey-html survey) + (:h3 "Questionnaire Results") + (:ul + (loop for result in results do + (:li result))))))