From 615c547b19a32698f0f1b89f573939cf070e079f Mon Sep 17 00:00:00 2001 From: Marcus Kammer Date: Sun, 2 Jun 2024 17:04:48 +0200 Subject: [PATCH] Define a make-survey function --- src/handlers/survey.lisp | 19 +++++++++++++++++-- 1 file changed, 17 insertions(+), 2 deletions(-) diff --git a/src/handlers/survey.lisp b/src/handlers/survey.lisp index adfd2c6..5981478 100644 --- a/src/handlers/survey.lisp +++ b/src/handlers/survey.lisp @@ -29,6 +29,21 @@ (check-type id integer) (first (rest (assoc id (load-response (make-surveys-db-path)))))) +(defun make-survey (uri) + (labels ((survey-fn (action) + (case action + (id (second (split-uri uri))) + (id-p (let ((ids (mapcar #'car (load-response (make-surveys-db-path))))) + (if (member (survey-fn 'id) ids) t nil))) + (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)))) + (properties (let ((survey-id (parse-integer (survey-fn 'id)))) + (first (rest (assoc survey-id (load-response (make-surveys-db-path)))))))))) + #'survey-fn)) + (define-easy-handler (survey :uri #'survey-uri) () - (let ((id (survey-id (request-uri*)))) - (ml-survey/views:survey id (survey-properties (parse-integer id))))) + (let ((survey (make-survey (request-uri*)))) + (ml-survey/views:survey (funcall survey 'id) (funcall survey 'properties))))