From 53eb03aa794aa9305f70d47b2fde08626738bc50 Mon Sep 17 00:00:00 2001
From: Marcus Kammer <marcus.kammer@mailbox.org>
Date: Tue, 11 Jun 2024 18:27:17 +0200
Subject: [PATCH] Make survey class global available

---
 src/survey.lisp | 50 +++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 50 insertions(+)
 create mode 100644 src/survey.lisp

diff --git a/src/survey.lisp b/src/survey.lisp
new file mode 100644
index 0000000..b4368b8
--- /dev/null
+++ b/src/survey.lisp
@@ -0,0 +1,50 @@
+(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)
+                    (ensure-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)))
+
+(defun build-questionnaire-link (survey-id resource)
+  (format nil "/survey/~a/questionnaire~a" survey-id resource))
+
+(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)
+                           (cond ((string= key "questionnaire")
+                                  (:td (:a :href (build-questionnaire-link (survey-id survey) value) value)))
+                                 (t (:td value)))))))))