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

Add type checking to survey related functions

Browse source
This commit is contained in:
Marcus Kammer 2025-02-21 19:39:32 +01:00
parent 85f56d35c6
commit b9cdb5cad6
Signed by: marcuskammer
GPG key ID: C374817BE285268F
2 changed files with 11 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
dev.metalisp.survey.asd
View file

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

10
src/models/survey.lisp
View file

@ -88,10 +88,20 @@ Accepts all valid initargs for survey class."
(defun build-questionnaire-link (survey-uid resource) (defun build-questionnaire-link (survey-uid resource)
(format nil "/questionnaire/~a~a" survey-uid resource)) (format nil "/questionnaire/~a~a" survey-uid resource))
(deftype survey-plist ()
'(and list (satisfies survey-plist-p)))
(defun survey-plist-p (plist)
(and (integerp (getf plist :uid))
(pathnamep (getf plist :data-dir))
(listp (getf plist :properties))))
(defun plist-to-survey (survey-plist) (defun plist-to-survey (survey-plist)
(check-type survey-plist survey-plist)
(apply #'make-instance 'survey survey-plist)) (apply #'make-instance 'survey survey-plist))
(defun filter-surveys-by-uid (survey-uid) (defun filter-surveys-by-uid (survey-uid)
(check-type survey-uid integer)
(remove-if-not (lambda (s) (remove-if-not (lambda (s)
(eql (getf s :uid) survey-uid)) (eql (getf s :uid) survey-uid))
(ml-survey/fileops:surveys-db))) (ml-survey/fileops:surveys-db)))