dev.metalisp.survey/src/new-survey.lisp

;;;; -*- mode: common-lisp; coding: utf-8; -*-

(defpackage ml-survey/new-survey
  (:use :cl)
  (:import-from #:hunchentoot
                #:define-easy-handler)
  (:import-from #:ml-sbt/navbar
                #:with-navbar)
  (:import-from #:ml-sbt/btn
                #:btn)
  (:import-from #:ml-sbt
                #:with-page
                #:body-header
                #:body-main))

(in-package :ml-survey/new-survey)

(defun list-questionnaires ()
  (mapcar #'ml-survey/fileops:extract-lang-and-filename
          (ml-survey/fileops:questionnaires-list-files)))

(defun view (&optional survey-id)
  "Generates the view to create a new survey."
  (let ((questionnaires (list-questionnaires))
        (container "container-fluid"))
    (with-page (:title "New Survey")
      (body-header "fluid" "New Survey"
        (with-navbar "fluid" "New Survey"
                     "Home" "/" "New Survey" "/new-survey"))
      (body-main "fluid"
        ;; If `questionnaires' is an empty list, show the user an warning
        ;; message.
        (unless questionnaires
          (:div :class "alert alert-warning"
                :role "alert"
                (format nil "There are no questionnaires available.~%
                                  The folder: ~a is empty." (ml-survey/fileops:questionnaires-dir))))

        ;; When a new survey was created, show the user an info message.
        (when survey-id
          (:div :class "alert alert-info"
                :role "alert"
                (format nil "Your new survey: ~A is created." survey-id)))

        (:form :action "/new-survey"
               :method "post"

               (:fieldset
                (:legend "Metadata")
                (:div :class "mb-3"
                      (:label :class "form-label"
                              :for "title" "Title")
                      (:input :class "form-control"
                              :type "text"
                              :id "title"
                              :required ""
                              :name "title"))
                (:div :class "mb-3"
                      (:label :class "form-label"
                              :for "description" "Description")
                      (:textarea :class "form-control"
                                 :rows "3"
                                 :id "description"
                                 :name "description")))

               (when questionnaires
                 (:fieldset
                  (:legend "Questionnaires")
                  (:div :class "mb-3"
                        (loop for q in questionnaires
                              do (:div :class "form-check"
                                       (:input :class "form-check-input"
                                               :type "checkbox"
                                               :value q
                                               :id q
                                               :name "questionnaire"
                                               (:label :class "form-check-label"
                                                       :for q
                                                       q)))))))

               (:button :type"Submit"
                        :class "btn btn-primary"
                        "Create Survey"))))))

(defun process-new-survey-get ()
  (view))

(defun process-new-survey-post (request)
  (let ((post-params (hunchentoot:post-parameters* request))
        (uid (ml-survey/app:generate-uuid))
        (stored-surveys (ml-survey/fileops:read-from-file (ml-survey/fileops:make-surveys-db-file))))
    (ml-survey/fileops:write-to-file (ml-survey/fileops:make-surveys-db-file)
                                     (push (list uid post-params) stored-surveys))
    (view uid)))

(define-easy-handler (new-survey-handler :uri "/new-survey") nil
  (cond ((eq (hunchentoot:request-method*) :get)
         (process-new-survey-get))
        ((eq (hunchentoot:request-method*) :post)
         (process-new-survey-post hunchentoot:*request*))))