Split questionnaire into different files but keep package
This commit is contained in:
parent
c7cde8a1d0
commit
26d6d43eec
GPG key ID:
C374817BE285268F
5 changed files with 145 additions and 142 deletions
|
|
@ -1,142 +0,0 @@
|
|||
;;;; -*- mode: common-lisp; coding: utf-8; -*-
|
||||
|
||||
(defpackage ml-survey/questionnaire
|
||||
(:use :cl)
|
||||
(:import-from #:hunchentoot
|
||||
#:define-easy-handler)
|
||||
(:import-from #:ml-sbt
|
||||
#:t9n
|
||||
#:with-page
|
||||
#:with-body-header
|
||||
#:with-body-main)
|
||||
(:import-from #:ml-sbt/btn
|
||||
#:btn
|
||||
#:btn-primary)
|
||||
(:import-from #:ml-sbt/form
|
||||
#:multi-form)
|
||||
(:import-from #:ml-sbt/utility
|
||||
#:spacing))
|
||||
|
||||
(in-package :ml-survey/questionnaire)
|
||||
|
||||
(defstruct questionnaire
|
||||
(lang "" :type string)
|
||||
(name "" :type string))
|
||||
|
||||
(defun form-path (q)
|
||||
(uiop:merge-pathnames* (format nil "~a/~a.lisp"
|
||||
(questionnaire-lang q)
|
||||
(questionnaire-name q))
|
||||
(ml-survey/fileops:ensure-questionnaires-dir)))
|
||||
|
||||
(defun load-form (q)
|
||||
(declare (type questionnaire q))
|
||||
"Load a Lisp file containing form definitions."
|
||||
(let ((form-path (form-path q)))
|
||||
(handler-case
|
||||
(progn (load form-path) nil)
|
||||
(file-error (e)
|
||||
(warn "File error occurred: ~A" e))
|
||||
(reader-error (e)
|
||||
(warn "Syntax error occurred: ~A" e)))))
|
||||
|
||||
(defmacro with-form (&body body)
|
||||
"Create a standardized HTML form wrapped in a <main> tag with a pre-defined
|
||||
class and structure, using the Spinneret library. The form is designed to be
|
||||
used within a web application served by Hunchentoot, utilizing common layout
|
||||
and localization practices. The macro automatically sets the form’s action to
|
||||
the current request URI and expects certain functions and variables to be
|
||||
available in its environment for full functionality."
|
||||
`(spinneret:with-html
|
||||
(:main :id "main-content"
|
||||
:class "container-fluid my-5"
|
||||
(:p "Please fill out the following forms and press the submit button.")
|
||||
;; action is defined as hunchentoot:request-uri* function
|
||||
(:form :id "questionnaire-form"
|
||||
:action (hunchentoot:request-uri*)
|
||||
:method "post"
|
||||
:class (spacing :property "m" :side "y" :size 5)
|
||||
,@body
|
||||
(btn-primary (:type "submit")
|
||||
(t9n "submit" (questionnaire-lang q)))))))
|
||||
|
||||
(defun view (q)
|
||||
(declare (type questionnaire q))
|
||||
(with-page (:title "Questionnaire Form" :lang (questionnaire-lang q))
|
||||
(with-body-header "fluid" "Questionnaire Form" (questionnaire-lang q))
|
||||
(with-form (load-form q))))
|
||||
|
||||
(defun view-submit (q)
|
||||
(declare (type questionnaire q))
|
||||
(with-page (:title "Confirmation")
|
||||
(with-body-header "fluid" "Confirmation" (questionnaire-lang q))
|
||||
(:main :id "main-content"
|
||||
:class "container"
|
||||
(:div :class "alert alert-info"
|
||||
:role "alert"
|
||||
"Thank you for filling out the questionnaire."))))
|
||||
|
||||
(defun questionnaire-uri-p (uri)
|
||||
"Check if the request URI matches the pattern '/survey/<numeric>/lang/type'"
|
||||
(let ((parts (ml-survey/app:split-uri uri)))
|
||||
(and (= (length parts) 4)
|
||||
(string= (first parts) "survey")
|
||||
(every #'digit-char-p (second parts))
|
||||
(= 2 (length (third parts))))))
|
||||
|
||||
(defun questionnaire-uri (request)
|
||||
(questionnaire-uri-p (hunchentoot:request-uri request)))
|
||||
|
||||
(defvar *likert-scale*
|
||||
'(:sus :nps :ueq :mecue :seq :umux :pwu :smeq :intui :visawi))
|
||||
|
||||
(defun likert-p (q)
|
||||
(let ((q-keyword (if (stringp q) (intern (string-upcase q) :keyword) q)))
|
||||
(if (member q-keyword *likert-scale*)
|
||||
t
|
||||
nil)))
|
||||
|
||||
(defun process-questionnaire-get (q)
|
||||
(declare (type questionnaire q))
|
||||
(view q))
|
||||
|
||||
(defun questionnaire-data-structure (post-params q)
|
||||
(list :type (if (likert-p (questionnaire-name q))
|
||||
"likert"
|
||||
"mixed")
|
||||
:name (questionnaire-name q)
|
||||
:timestamp (ml-survey/app:today+now)
|
||||
:post-data post-params))
|
||||
|
||||
(defun questionnaire-write-to-file (data-file post-params q)
|
||||
(ml-survey/fileops:write-to-file data-file (questionnaire-data-structure post-params q)))
|
||||
|
||||
(defun process-questionnaire-post (post-params survey q)
|
||||
(declare (type questionnaire q))
|
||||
(let* ((survey-id (ml-survey/survey:survey-id survey))
|
||||
(questionnaire-id (ml-survey/app:generate-uuid))
|
||||
(questionnaire-data-file (ml-survey/fileops:ensure-data-file-exist survey-id questionnaire-id)))
|
||||
(questionnaire-write-to-file questionnaire-data-file post-params q)
|
||||
(view-submit q)))
|
||||
|
||||
(defun extract-uri-param (param)
|
||||
(ml-survey/app:extract-from (hunchentoot:request-uri*) param))
|
||||
|
||||
(defun create-survey (survey-id)
|
||||
(make-instance 'ml-survey/survey:survey :id survey-id))
|
||||
|
||||
(defun create-questionnaire (lang name)
|
||||
(make-questionnaire :lang lang :name name))
|
||||
|
||||
(defun process-request (survey questionnaire)
|
||||
(ecase (hunchentoot:request-method*)
|
||||
(:get (process-questionnaire-get questionnaire))
|
||||
(:post (process-questionnaire-post (hunchentoot:post-parameters*) survey questionnaire))))
|
||||
|
||||
(define-easy-handler (questionnaire-handler :uri #'questionnaire-uri) ()
|
||||
(let* ((survey-id (extract-uri-param :survey-id))
|
||||
(lang (extract-uri-param :lang))
|
||||
(questionnaire-name (extract-uri-param :questionnaire))
|
||||
(survey (create-survey survey-id))
|
||||
(questionnaire (create-questionnaire lang questionnaire-name)))
|
||||
(process-request survey questionnaire)))
|
||||
67
src/questionnaire/handler.lisp
Normal file
67
src/questionnaire/handler.lisp
Normal file
|
|
@ -0,0 +1,67 @@
|
|||
;;; -*- mode: lisp; coding: utf-8; -*-
|
||||
(in-package :ml-survey/questionnaire)
|
||||
|
||||
(defun questionnaire-uri-p (uri)
|
||||
"Check if the request URI matches the pattern '/survey/<numeric>/lang/type'"
|
||||
(let ((parts (ml-survey/app:split-uri uri)))
|
||||
(and (= (length parts) 4)
|
||||
(string= (first parts) "survey")
|
||||
(every #'digit-char-p (second parts))
|
||||
(= 2 (length (third parts))))))
|
||||
|
||||
(defun questionnaire-uri (request)
|
||||
(questionnaire-uri-p (hunchentoot:request-uri request)))
|
||||
|
||||
(defvar *likert-scale*
|
||||
'(:sus :nps :ueq :mecue :seq :umux :pwu :smeq :intui :visawi))
|
||||
|
||||
(defun likert-p (q)
|
||||
(let ((q-keyword (if (stringp q) (intern (string-upcase q) :keyword) q)))
|
||||
(if (member q-keyword *likert-scale*)
|
||||
t
|
||||
nil)))
|
||||
|
||||
(defun process-questionnaire-get (q)
|
||||
(declare (type questionnaire q))
|
||||
(view q))
|
||||
|
||||
(defun questionnaire-data-structure (post-params q)
|
||||
(list :type (if (likert-p (questionnaire-name q))
|
||||
"likert"
|
||||
"mixed")
|
||||
:name (questionnaire-name q)
|
||||
:timestamp (ml-survey/app:today+now)
|
||||
:post-data post-params))
|
||||
|
||||
(defun questionnaire-write-to-file (data-file post-params q)
|
||||
(ml-survey/fileops:write-to-file data-file (questionnaire-data-structure post-params q)))
|
||||
|
||||
(defun process-questionnaire-post (post-params survey q)
|
||||
(declare (type questionnaire q))
|
||||
(let* ((survey-id (ml-survey/survey:survey-id survey))
|
||||
(questionnaire-id (ml-survey/app:generate-uuid))
|
||||
(questionnaire-data-file (ml-survey/fileops:ensure-data-file-exist survey-id questionnaire-id)))
|
||||
(questionnaire-write-to-file questionnaire-data-file post-params q)
|
||||
(view-submit q)))
|
||||
|
||||
(defun extract-uri-param (param)
|
||||
(ml-survey/app:extract-from (hunchentoot:request-uri*) param))
|
||||
|
||||
(defun create-survey (survey-id)
|
||||
(make-instance 'ml-survey/survey:survey :id survey-id))
|
||||
|
||||
(defun create-questionnaire (lang name)
|
||||
(make-questionnaire :lang lang :name name))
|
||||
|
||||
(defun process-request (survey questionnaire)
|
||||
(ecase (hunchentoot:request-method*)
|
||||
(:get (process-questionnaire-get questionnaire))
|
||||
(:post (process-questionnaire-post (hunchentoot:post-parameters*) survey questionnaire))))
|
||||
|
||||
(define-easy-handler (questionnaire-handler :uri #'questionnaire-uri) ()
|
||||
(let* ((survey-id (extract-uri-param :survey-id))
|
||||
(lang (extract-uri-param :lang))
|
||||
(questionnaire-name (extract-uri-param :questionnaire))
|
||||
(survey (create-survey survey-id))
|
||||
(questionnaire (create-questionnaire lang questionnaire-name)))
|
||||
(process-request survey questionnaire)))
|
||||
6
src/questionnaire/model.lisp
Normal file
6
src/questionnaire/model.lisp
Normal file
|
|
@ -0,0 +1,6 @@
|
|||
;;; -*- mode: lisp; coding: utf-8; -*-
|
||||
(in-package :ml-survey/questionnaire)
|
||||
|
||||
(defstruct questionnaire
|
||||
(lang "" :type string)
|
||||
(name "" :type string))
|
||||
17
src/questionnaire/package.lisp
Normal file
17
src/questionnaire/package.lisp
Normal file
|
|
@ -0,0 +1,17 @@
|
|||
;;; -*- mode: lisp; coding: utf-8; -*-
|
||||
(defpackage :ml-survey/questionnaire
|
||||
(:use :cl)
|
||||
(:import-from #:hunchentoot
|
||||
#:define-easy-handler)
|
||||
(:import-from #:ml-sbt
|
||||
#:t9n
|
||||
#:with-page
|
||||
#:with-body-header
|
||||
#:with-body-main)
|
||||
(:import-from #:ml-sbt/btn
|
||||
#:btn
|
||||
#:btn-primary)
|
||||
(:import-from #:ml-sbt/form
|
||||
#:multi-form)
|
||||
(:import-from #:ml-sbt/utility
|
||||
#:spacing))
|
||||
55
src/questionnaire/view.lisp
Normal file
55
src/questionnaire/view.lisp
Normal file
|
|
@ -0,0 +1,55 @@
|
|||
;;; -*- mode: lisp; coding: utf-8; -*-
|
||||
(in-package :ml-survey/questionnaire)
|
||||
|
||||
(defun form-path (q)
|
||||
(uiop:merge-pathnames* (format nil "~a/~a.lisp"
|
||||
(questionnaire-lang q)
|
||||
(questionnaire-name q))
|
||||
(ml-survey/fileops:ensure-questionnaires-dir)))
|
||||
|
||||
(defun load-form (q)
|
||||
(declare (type questionnaire q))
|
||||
"Load a Lisp file containing form definitions."
|
||||
(let ((form-path (form-path q)))
|
||||
(handler-case
|
||||
(progn (load form-path) nil)
|
||||
(file-error (e)
|
||||
(warn "File error occurred: ~A" e))
|
||||
(reader-error (e)
|
||||
(warn "Syntax error occurred: ~A" e)))))
|
||||
|
||||
(defmacro with-form (&body body)
|
||||
"Create a standardized HTML form wrapped in a <main> tag with a pre-defined
|
||||
class and structure, using the Spinneret library. The form is designed to be
|
||||
used within a web application served by Hunchentoot, utilizing common layout
|
||||
and localization practices. The macro automatically sets the form’s action to
|
||||
the current request URI and expects certain functions and variables to be
|
||||
available in its environment for full functionality."
|
||||
`(spinneret:with-html
|
||||
(:main :id "main-content"
|
||||
:class "container-fluid my-5"
|
||||
(:p "Please fill out the following forms and press the submit button.")
|
||||
;; action is defined as hunchentoot:request-uri* function
|
||||
(:form :id "questionnaire-form"
|
||||
:action (hunchentoot:request-uri*)
|
||||
:method "post"
|
||||
:class (spacing :property "m" :side "y" :size 5)
|
||||
,@body
|
||||
(btn-primary (:type "submit")
|
||||
(t9n "submit" (questionnaire-lang q)))))))
|
||||
|
||||
(defun view (q)
|
||||
(declare (type questionnaire q))
|
||||
(with-page (:title "Questionnaire Form" :lang (questionnaire-lang q))
|
||||
(with-body-header "fluid" "Questionnaire Form" (questionnaire-lang q))
|
||||
(with-form (load-form q))))
|
||||
|
||||
(defun view-submit (q)
|
||||
(declare (type questionnaire q))
|
||||
(with-page (:title "Confirmation")
|
||||
(with-body-header "fluid" "Confirmation" (questionnaire-lang q))
|
||||
(:main :id "main-content"
|
||||
:class "container"
|
||||
(:div :class "alert alert-info"
|
||||
:role "alert"
|
||||
"Thank you for filling out the questionnaire."))))
|
||||
Loading…
Add table
Reference in a new issue