Use survey api to show survey properties

This commit is contained in:
Marcus Kammer 2024-06-23 13:23:14 +02:00
parent b70b23bfcc
commit 275d372b45
Signed by: marcuskammer
GPG key ID: C374817BE285268F
4 changed files with 27 additions and 13 deletions

View file

@ -1,5 +1,9 @@
(in-package :ml-survey/handlers) (in-package :ml-survey/handlers)
(define-easy-handler (surveys :uri "/") nil (define-easy-handler (surveys :uri "/") nil
(let ((stored-surveys (load-response (make-surveys-db-file)))) (ml-survey/views:surveys (mapcar (lambda (x)
(ml-survey/views:surveys stored-surveys))) (make-instance 'ml-survey:survey
:id (format nil
"~a"
(first x))))
(load-response (make-surveys-db-file)))))

View file

@ -9,6 +9,9 @@
#:survey-data-dir-p #:survey-data-dir-p
#:survey-data-dir-files #:survey-data-dir-files
#:survey-html #:survey-html
#:survey-properties
#:survey-properties-title
#:survey-properties-description
#:ensure-data-dir #:ensure-data-dir
#:ensure-data-file-exist #:ensure-data-file-exist
#:store-response #:store-response

View file

@ -35,6 +35,12 @@
(defmethod survey-data-dir-p ((survey survey)) (defmethod survey-data-dir-p ((survey survey))
(uiop:directory-exists-p (survey-data-dir survey))) (uiop:directory-exists-p (survey-data-dir survey)))
(defmethod survey-properties-title ((survey survey))
(cdr (assoc "title" (survey-properties survey) :test #'string-equal)))
(defmethod survey-properties-description ((survey survey))
(cdr (assoc "description" (survey-properties survey) :test #'string-equal)))
(defun build-questionnaire-link (survey-id resource) (defun build-questionnaire-link (survey-id resource)
(format nil "/survey/~a/questionnaire~a" survey-id resource)) (format nil "/survey/~a/questionnaire~a" survey-id resource))

View file

@ -1,16 +1,17 @@
(in-package :ml-survey/views) (in-package :ml-survey/views)
(defun extract-title (list) (defun surveys-p (list)
(cdr (assoc "title" (second list) :test #'string-equal))) "Check if all elements in `lst` are instances of the class `survey`."
(every (lambda (item) (typep item 'ml-survey:survey)) list))
(defun extract-description (list) (deftype surveys-list ()
(cdr (assoc "description" (second list) :test #'string-equal))) '(and list (satisfies surveys-p)))
(defun extract-id (list)
(first list))
(defun surveys (surveys) (defun surveys (surveys)
"Generates the view to show all surveys available." "Generates the view to show all surveys available.
SURVEYS: List of survey objects."
(check-type surveys surveys-list)
(with-page (:title "Surveys") (with-page (:title "Surveys")
(body-header "Surveys" (navbar-en)) (body-header "Surveys" (navbar-en))
(:main :id "main-content" (:main :id "main-content"
@ -23,9 +24,9 @@
(:h2 :class "mb-3" "Overview") (:h2 :class "mb-3" "Overview")
(:ol :class "list-group list-group-numbered" (:ol :class "list-group list-group-numbered"
(loop for survey in surveys (loop for survey in surveys
for title = (extract-title survey) for title = (ml-survey:survey-properties-title survey)
for description = (extract-description survey) for description = (ml-survey:survey-properties-description survey)
for id = (extract-id survey) do for id = (ml-survey:survey-id survey) do
(:li :class "list-group-item d-flex justify-content-between align-items-start" (:li :class "list-group-item d-flex justify-content-between align-items-start"
(:div :class "ms-2 me-auto" (:div :class "ms-2 me-auto"
(:a :class "fw-bold clearfix" (:a :class "fw-bold clearfix"