marcuskammer/dev.metalisp.survey
1
0
Fork 0
Code Issues 9 Pull requests Projects Releases Packages Wiki Activity Actions

Define a make-survey function

Browse source
This commit is contained in:
Marcus Kammer 2024-06-02 17:04:48 +02:00
parent bfd430a317
commit 615c547b19
Signed by: marcuskammer
GPG key ID: C374817BE285268F
1 changed files with 17 additions and 2 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

19
src/handlers/survey.lisp
View file

@ -29,6 +29,21 @@
(check-type id integer) (check-type id integer)
(first (rest (assoc id (load-response (make-surveys-db-path)))))) (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) () (define-easy-handler (survey :uri #'survey-uri) ()
(let ((id (survey-id (request-uri*)))) (let ((survey (make-survey (request-uri*))))
(ml-survey/views:survey id (survey-properties (parse-integer id))))) (ml-survey/views:survey (funcall survey 'id) (funcall survey 'properties))))