Simplify survey handler by using questionnaires data structure

dev.metalisp.survey.asd

@@ -2,7 +2,7 @@
 
 (defsystem "dev.metalisp.survey"
   :description "Create questionnaires and analyze the results."
-  :version "0.5.27"
+  :version "0.5.28"
   :author "Marcus Kammer <marcus.kammer@mailbox.org>"
   :source-control (:git "https://code.metalisp.dev/marcuskammer/dev.metalisp.survey.git")
   :licence "MIT"

src/models/package.lisp

@@ -11,6 +11,7 @@
            #:survey-properties-title
            #:survey-properties-description
            #:survey-html
+           #:survey-questionnaires
            #:questionnaire
            #:questionnaire-uid
            #:questionnaire-name

src/models/survey.lisp

@@ -46,6 +46,15 @@
 (defmethod survey-properties-description ((survey survey))
   (cdr (assoc "description" (survey-properties survey) :test #'string-equal)))
 
+(defmethod survey-questionnaires ((survey survey) &optional make-fn)
+  (let ((files (survey-data-dir-files survey)))
+    (mapcar (lambda (file)
+              (with-open-file (in file)
+                (if make-fn
+                    (apply make-fn (read in))
+                    (read in))))
+            files)))
+
 (defun build-questionnaire-link (survey-id resource)
   (format nil "/questionnaire/~a~a" survey-id resource))
 

src/survey/handler.lisp

@@ -1,44 +1,7 @@
 ;;; -*- mode: lisp; coding: utf-8; -*-
+
 (in-package :ml-survey/survey)
 
-(defstruct questionnaire-response
-  type
-  name
-  timestamp
-  post-data)
-
-(defun questionnaire-responses-p (list)
-  "Check if all elements in LIST are of type 'questionnaire-result'."
-  (if (every 'questionnaire-response-p list) t nil))
-
-(deftype questionnaire-responses ()
-  "Define a type representing a list containing only questionnaire-result instances."
-  '(and list (satisfies questionnaire-responses-p)))
-
-(defun questionnaire-response-from-file (filename)
-  "Create a 'questionnaire-result' instance from data read from the file specified by FILENAME."
-  (check-type filename (or string pathname))
-  (let ((data (ml-survey/fileops:read-from-file filename)))
-    (make-questionnaire-response :type (getf data :type)
-                                 :name (getf data :name)
-                                 :timestamp (getf data :timestamp)
-                                 :post-data (getf data :post-data))))
-
-(defun string->keyword (string)
-  (intern (string-upcase string) :keyword))
-
-(defun categorized-responses (responses)
-  "Collecting questionnaire results listed in RESULT-OBJs."
-  (declare (type questionnaire-responses responses))
-  (let ((categorized-responses (list)))
-    (dolist (response responses categorized-responses)
-      (let ((name (string->keyword (questionnaire-response-name response)))
-            (data (questionnaire-response-post-data response))
-            (timestamp (questionnaire-response-timestamp response)))
-        (setf (getf categorized-responses name)
-              (push (cons timestamp data)
-                    (getf categorized-responses name)))))))
-
 (defun survey-uri-p (uri)
   (let ((parts (ml-survey/app:split-uri uri)))
         (and (= (length parts) 2)
@@ -49,10 +12,9 @@
   (survey-uri-p (hunchentoot:request-uri request)))
 
 (define-easy-handler (survey-handler :uri #'survey-uri) ()
-  (let* ((survey-id (ml-survey/app:extract-from (hunchentoot:request-uri*) :survey-id))
+  (let* ((survey-uid (ml-survey/app:extract-from (hunchentoot:request-uri*)
-         (s (make-instance 'survey :id survey-id))
+                                                 :survey-id))
-         (responses (mapcar 'questionnaire-response-from-file
+         (s (make-instance 'survey :id survey-uid))
-                            (survey-data-dir-files s)))
+         (questionnaires (survey-questionnaires s))
-         (categorized-responses (categorized-responses responses))
+         (assessments (parse-assessments questionnaires)))
-         (assessments (parse-assessments categorized-responses)))
     (view s assessments)))