Big refactoring

dev.metalisp.survey.asd

@@ -2,38 +2,19 @@
 
 (defsystem "dev.metalisp.survey"
   :description "A simple survey"
-  :version "0.1.13"
+  :version "0.2.0"
   :author "Marcus Kammer <marcus.kammer@metalisp.dev"
   :source-control "git@git.sr.ht:~marcuskammer/dev.metalisp.survey"
   :licence "MIT"
   :depends-on
   ("local-time" "hunchentoot" "dev.metalisp.sbt")
   :components
-
   ((:module "src"
     :components
-    ((:file "package")
+    ((:file "fileops")
-     (:file "fileops")
+     (:file "navbar")
      (:file "app")
      (:file "survey")
-     (:file "questionnaire")))
-
-   (:module "src/views"
-    :components
-    ((:file "package")
-     (:file "_navbar")
-     (:file "main")
      (:file "questionnaire")
-     (:file "new-survey")
-     (:file "survey")
      (:file "surveys")
-     (:file "questionnaire-submit")))
+     (:file "new-survey")))))
-
-   (:module "src/handlers"
-    :components
-    ((:file "package")
-     (:file "main")
-     (:file "new-survey")
-     (:file "survey")
-     (:file "surveys")
-     (:file "questionnaire")))))

src/app.lisp

@@ -1,9 +1,66 @@
 ;;;; -*- mode: common-lisp; coding: utf-8; -*-
 
-(in-package :ml-survey)
+(defpackage ml-survey/app
+  (:use #:cl)
+  (:export #:extract-from
+           #:*html-lang*
+           #:generate-uuid
+           #:split-uri
+           #:today+now
+           #:*app*
+           #:start))
+
+(in-package #:ml-survey/app)
 
 (defparameter *html-lang* "en")
 
+(defparameter *use-cdn* nil)
+
+(defparameter *url-key-map*
+  '((:survey-id . 1)
+    (:language . 2)
+    (:questionnaire . 3)))
+
+(defun split-uri (uri)
+  (check-type uri string)
+  (remove-if #'string-empty-p
+             (uiop:split-string uri :separator "/")))
+
+(defun extract-from (url key)
+  (let* ((parts (split-uri url))
+         (index (cdr (assoc key *url-key-map*))))
+    (when (and parts index)
+      (nth index parts))))
+
+(defun today ()
+  "Return today's date formatted as ISO-8601."
+  (local-time:format-timestring nil
+                                (local-time:now)
+                                :format '(:year "-" (:month 2) "-" (:day 2))))
+
+(defun now ()
+  "Return current time formatted as ISO-8601."
+  (local-time:format-timestring nil
+                                (local-time:now)
+                                :format '((:hour 2) ":" (:min 2) ":" (:sec 2))))
+
+(defun today+now ()
+   (format nil "~a ~a" (today) (now)))
+
+(defun generate-uuid ()
+  (parse-integer (format nil "~A~A~A"
+                         (sb-posix:getpid)
+                         (get-universal-time)
+                         (random 1000000))))
+
+(defun generate-random-id (length)
+  (let ((charset "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"))
+    (coerce (loop repeat length
+                  collect (char charset (random (length charset))))
+            'string)))
+
+(defun string-empty-p (string) (= (length string) 0))
+
 (defun set-default-directory (directory)
   (setf *default-pathname-defaults* (truename (merge-pathnames directory))))
 
@@ -31,9 +88,9 @@
 (defvar *app* (create-server 'app
                              8080
                              :document-root
-                             (public-dir)
+                             (ml-survey/fileops:public-dir)
                              :access-log-destination
-                             (access-log-file)))
+                             (ml-survey/fileops:access-log-file)))
 
 (defun start ()
   (start-server *app*))

src/fileops.lisp

@@ -1,6 +1,21 @@
 ;;;; -*- mode: common-lisp; coding: utf-8; -*-
 
-(in-package :ml-survey)
+(defpackage ml-survey/fileops
+  (:use #:cl)
+  (:export #:public-dir
+           #:access-log-file
+           #:read-from-file
+           #:write-to-file
+           #:ensure-questionnaires-dir
+           #:ensure-data-file-exist
+           #:ensure-surveys-dir
+           #:make-db-file
+           #:extract-lang-and-filename
+           #:questionnaires-list-files
+           #:questionnaires-dir
+           #:make-surveys-db-file))
+
+(in-package #:ml-survey/fileops)
 
 (defun data-dir ()
   "Construct and return the directory path for storing data within the
@@ -35,6 +50,19 @@ path."
 (defun questionnaires-list-files ()
   (uiop:directory* (format nil "~a*/*.lisp" (questionnaires-dir))))
 
+(defun find-next-directory (dir-list target)
+  (let ((index (position target dir-list :test #'string=)))
+    (when index
+      (nth (1+ index) dir-list))))
+
+(defun extract-lang-and-filename (path &optional (target-dir "questionnaires"))
+  (let* ((directory (pathname-directory path))
+         (name (pathname-name path))
+         (lang (find-next-directory directory target-dir)))
+    (if lang
+        (format nil "/~A/~A" lang name)
+        (format nil "/~A" name))))
+
 (defun ensure-file-exist (pathname)
   "Ensure that a file specified by PATHNAME exists, create it if it doesn't."
   (unless (uiop:file-exists-p pathname)
@@ -86,3 +114,6 @@ within the data directory."
 (ensure-directories-exist (public-dir))
 
 (format t "~%App Data Directory: ~a~%" (data-dir))
+
+(defun make-surveys-db-file ()
+  (make-db-file "surveys-db.lisp"))

src/handlers/main.lisp

@@ -1,48 +0,0 @@
-;;;; -*- mode: common-lisp; coding: utf-8; -*-
-
-(in-package :ml-survey/handlers)
-
-(defparameter *url-key-map*
-  '((:survey-id . 1)
-    (:language . 2)
-    (:questionnaire . 3)))
-
-(defun split-uri (uri)
-  (check-type uri string)
-  (remove-if #'string-empty-p
-             (uiop:split-string uri :separator "/")))
-
-(defun extract-from (url key)
-  (let* ((parts (split-uri url))
-         (index (cdr (assoc key *url-key-map*))))
-    (when (and parts index)
-      (nth index parts))))
-
-(defun today ()
-  "Return today's date formatted as ISO-8601."
-  (local-time:format-timestring nil
-                                (local-time:now)
-                                :format '(:year "-" (:month 2) "-" (:day 2))))
-
-(defun now ()
-  "Return current time formatted as ISO-8601."
-  (local-time:format-timestring nil
-                                (local-time:now)
-                                :format '((:hour 2) ":" (:min 2) ":" (:sec 2))))
-
-(defun today+now ()
-   (format nil "~a ~a" (today) (now)))
-
-(defun generate-uuid ()
-  (parse-integer (format nil "~A~A~A"
-                         (sb-posix:getpid)
-                         (get-universal-time)
-                         (random 1000000))))
-
-(defun generate-random-id (length)
-  (let ((charset "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"))
-    (coerce (loop repeat length
-                  collect (char charset (random (length charset))))
-            'string)))
-
-(defun string-empty-p (string) (= (length string) 0))

src/handlers/new-survey.lisp

@@ -1,19 +0,0 @@
-;;;; -*- mode: common-lisp; coding: utf-8; -*-
-
-(in-package :ml-survey/handlers)
-
-(defun process-new-survey-get ()
-  (ml-survey/views:new-survey))
-
-(defun process-new-survey-post (request)
-  (let ((post-params (post-parameters* request))
-        (uid (generate-uuid))
-        (stored-surveys (read-from-file (make-surveys-db-file))))
-    (write-to-file (make-surveys-db-file) (push (list uid post-params) stored-surveys))
-    (ml-survey/views:new-survey uid)))
-
-(define-easy-handler (new-survey :uri "/new-survey") nil
-  (cond ((eq (hunchentoot:request-method*) :get)
-         (process-new-survey-get))
-        ((eq (hunchentoot:request-method*) :post)
-         (process-new-survey-post *request*))))

src/handlers/package.lisp

@@ -1,19 +0,0 @@
-;;;; -*- mode: common-lisp; coding: utf-8; -*-
-
-(defpackage ml-survey/handlers
-  (:use #:cl)
-  (:import-from #:spinneret
-                #:*html*)
-  (:import-from #:hunchentoot
-                #:define-easy-handler
-                #:post-parameters*
-                #:content-type*
-                #:request-uri
-                #:request-uri*
-                #:*request*)
-  (:import-from #:ml-survey
-                #:ensure-data-dir
-                #:ensure-data-file-exist
-                #:write-to-file
-                #:read-from-file
-                #:make-surveys-db-file))

src/handlers/questionnaire.lisp

@@ -1,43 +0,0 @@
-;;;; -*- mode: common-lisp; coding: utf-8; -*-
-
-(in-package :ml-survey/handlers)
-
-(defun questionnaire-uri-p (uri)
-  "Check if the request URI matches the pattern '/survey/<numeric>/lang/type'"
-  (let ((parts (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 (request-uri request)))
-
-(defun process-questionnaire-get (lang questionnaire)
-  (check-type lang string)
-  (setf ml-survey:*html-lang* lang)
-  (ml-survey/views:questionnaire questionnaire))
-
-(defun process-questionnaire-post (request survey questionnaire)
-  (let* ((post-params (post-parameters* request))
-         (survey-id (ml-survey:survey-id survey))
-         (questionnaire-id (generate-uuid))
-         (questionnaire-data-file (ensure-data-file-exist survey-id
-                                                          questionnaire-id)))
-
-    (write-to-file questionnaire-data-file
-                    (list :type questionnaire
-                          :timestamp (today+now)
-                          :post-data post-params))
-
-    (ml-survey/views:questionnaire-submit)))
-
-(define-easy-handler (questionnaire :uri #'questionnaire-uri) nil
-  (let ((s (make-instance 'ml-survey:survey
-                          :id (extract-from (request-uri*) :survey-id)))
-        (language (extract-from (request-uri*) :language))
-        (questionnaire (extract-from (request-uri*) :questionnaire)))
-    (cond ((eq (hunchentoot:request-method*) :get)
-           (process-questionnaire-get language questionnaire))
-          ((eq (hunchentoot:request-method*) :post)
-           (process-questionnaire-post *request* s questionnaire)))))

src/handlers/survey.lisp

@@ -1,37 +0,0 @@
-;;;; -*- mode: common-lisp; coding: utf-8; -*-
-
-(in-package :ml-survey/handlers)
-
-(defun list-of-categorized-results (result-objs)
-  "Categorize results into different lists based on their type.
-  Apply special calculation for results of type 'sus'."
-  (let ((categorized-results (list :sus nil)))
-    (dolist (result result-objs categorized-results)
-      (let ((type (intern (string-upcase (ml-survey::questionnaire-result-type result)) :keyword))
-            (data (ml-survey::questionnaire-result-post-data result))
-            (timestamp (ml-survey::questionnaire-result-timestamp result)))
-        (cond
-          ((eq type :sus)
-           (setf (getf categorized-results :sus)
-                 (cons (ml-survey:sus-calc (cons timestamp data))
-                       (getf categorized-results :sus))))
-          (t
-           (setf (getf categorized-results type)
-                 (cons (cons timestamp (mapcar #'cdr data))
-                       (getf categorized-results type)))))))))
-
-(defun survey-uri-p (uri)
-  (let ((parts (split-uri uri)))
-        (and (= (length parts) 2)
-             (string= (first parts) "survey")
-             (every #'digit-char-p (second parts)))))
-
-(defun survey-uri (request)
-  (survey-uri-p (request-uri request)))
-
-(define-easy-handler (survey :uri #'survey-uri) ()
-  (let* ((s (make-instance 'ml-survey:survey
-                           :id (extract-from (request-uri*) :survey-id)))
-         (result-objs (mapcar #'ml-survey:questionnaire-result-from-file
-                              (ml-survey:survey-data-dir-files s))))
-    (ml-survey/views:survey s (list-of-categorized-results result-objs))))

src/handlers/surveys.lisp

@@ -1,11 +0,0 @@
-;;;; -*- mode: common-lisp; coding: utf-8; -*-
-
-(in-package :ml-survey/handlers)
-
-(define-easy-handler (surveys :uri "/") nil
-  (let* ((survey-db (read-from-file (make-surveys-db-file)))
-         (list-of-surveys (mapcar (lambda (x)
-                                    (make-instance 'ml-survey:survey
-                                                   :id (format nil "~a" (first x))))
-                                  survey-db)))
-    (ml-survey/views:surveys list-of-surveys)))

src/navbar.lisp

@@ -1,6 +1,10 @@
 ;;;; -*- mode: common-lisp; coding: utf-8; -*-
 
-(in-package :ml-survey/views)
+(defpackage ml-survey/navbar
+  (:use :cl)
+  (:export #:navbar-en))
+
+(in-package :ml-survey/navbar)
 
 (defmacro navbar-brand (src width)
   `(spinneret:with-html

src/new-survey.lisp

@@ -1,12 +1,24 @@
 ;;;; -*- mode: common-lisp; coding: utf-8; -*-
 
-(in-package :ml-survey/views)
+(defpackage ml-survey/new-survey
+  (:use :cl)
+  (:import-from #:hunchentoot
+                #:define-easy-handler)
+  (:import-from #:dev.metalisp.sbt
+                #:with-page
+                #:body-header))
 
-(defun new-survey (&optional survey-id)
+(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 (ml-survey:list-questionnaires)))
+  (let ((questionnaires (list-questionnaires)))
     (with-page (:title "New Survey")
-      (body-header "New Survey" (navbar-en))
+      (body-header "New Survey" (ml-survey/navbar:navbar-en))
       (:main :class "container"
              :id "main-content"
 
@@ -16,7 +28,7 @@
                (:div :class "alert alert-warning"
                      :role "alert"
                      (format nil "There are no questionnaires available.~%
-                                  The folder: ~a is empty." (ml-survey:questionnaires-dir))))
+                                  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
@@ -63,3 +75,20 @@
                     (: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*))))

src/package.lisp

@@ -1,36 +0,0 @@
-;;;; -*- mode: common-lisp; coding: utf-8; -*-
-
-(defpackage ml-survey
-  (:use #:cl)
-  (:import-from #:hunchentoot
-                #:easy-acceptor)
-  (:export
-   #:main
-   #:*html-lang*
-   #:survey
-   #:survey-id
-   #:survey-data-dir-p
-   #:survey-data-dir-files
-   #:survey-html
-   #:survey-properties
-   #:survey-properties-title
-   #:survey-properties-description
-   #:ensure-data-dir
-   #:ensure-data-file-exist
-   #:ensure-questionnaires-dir
-   #:questionnaires-dir
-   #:questionnaires-list-files
-   #:extract-lang-and-filename
-   #:list-questionnaires
-   #:questionnaire-result
-   #:questionnaire-result-from-file
-   #:sus-calc
-   #:write-to-file
-   #:read-from-file
-   #:make-surveys-db-file
-   #:start
-   #:*app*
-   #:set-default-directory
-   #:start-server
-   #:stop-server
-   #:restart-server))

src/questionnaire.lisp

@@ -1,57 +1,106 @@
 ;;;; -*- mode: common-lisp; coding: utf-8; -*-
 
-(in-package :ml-survey)
+(defpackage ml-survey/questionnaire
+  (:use :cl)
+  (:import-from #:hunchentoot
+                #:define-easy-handler)
+  (:import-from #:dev.metalisp.sbt
+                #:find-l10n
+                #:*l10n*
+                #:*use-cdn*
+                #:with-page
+		        #:body-header
+		        #:body-main)
+  (:import-from #:dev.metalisp.sbt/btn
+                #:btn
+                #:btn-primary)
+  (:import-from #:dev.metalisp.sbt/form
+                #:multi-form)
+  (:import-from #:dev.metalisp.sbt/utility
+                #:spacing))
 
-(defun find-next-directory (dir-list target)
+(in-package :ml-survey/questionnaire)
-  (let ((index (position target dir-list :test #'string=)))
-    (when index
-      (nth (1+ index) dir-list))))
 
-(defun extract-lang-and-filename (path &optional (target-dir "questionnaires"))
+(defun load-form (lang questionnaire)
-  (let* ((directory (pathname-directory path))
+  "Load a Lisp file containing form definitions."
-         (name (pathname-name path))
+  (check-type lang string)
-         (lang (find-next-directory directory target-dir)))
+  (check-type questionnaire string)
-    (if lang
+  (let* ((form-path (uiop:merge-pathnames* (format nil "~a/~a.lisp" lang questionnaire)
-        (format nil "/~A/~A" lang name)
+                                           (ml-survey/fileops:ensure-questionnaires-dir))))
-        (format nil "/~A" name))))
+    (unless (probe-file form-path)
+      (error "Form file ~A does not exist." form-path))
+    (load form-path))
+  nil)
 
-(defun list-questionnaires ()
+(defmacro with-form (&body body)
-  (mapcar #'extract-lang-and-filename (questionnaires-list-files)))
+  "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 my-5"
+           (:p "Please fill out the following forms and press the submit button.")
+           ;; action is defined as hunchentoot:request-uri* function
+           (:form :action (hunchentoot:request-uri*)
+                  :method "post"
+                  :class (spacing :property "m" :side "y" :size 5)
+                  ,@body
+                  (btn-primary (:type "submit")
+                    (find-l10n "submit" ml-survey/app:*html-lang* *l10n*))))))
 
-(defun extract-numbers (results)
+(defun view (questionnaire)
-  "Extract numbers from a questionnaire RESULTS list.
+  (with-page (:title "SUS Form" :add-js-urls ("/app.js"))
-Returns a list of integers."
+    (body-header "System Usability Form")
-  (check-type results list)
+    (with-form (load-form ml-survey/app:*html-lang* questionnaire))))
-  (mapcar (lambda (x)
-            (parse-integer (remove-if (complement #'digit-char-p)
-                                      (cdr x)))) results))
 
-(defun sus-calc-score (results)
+(defun view-submit ()
-  (check-type results list)
+  (with-page (:title "Confirmation")
-  (let ((counter 0))
+    (body-header "Confirmation")
-    (mapcar (lambda (x)
+    (:main :id "main-content"
-              (setq counter (1+ counter))
+           :class "container"
-              (if (evenp counter)
+           (:div :class "alert alert-info"
-                  (- 5 x)
+                 :role "alert"
-                  (1- x)))
+                  "Thank you for filling out the questionnaire."))))
-            results)))
 
-(defun sus-calc-score-per-row (results)
+(defun questionnaire-uri-p (uri)
-  (check-type results list)
+  "Check if the request URI matches the pattern '/survey/<numeric>/lang/type'"
-  (reverse (cons (* (apply #'+ (sus-calc-score results)) 2.5) (reverse results))))
+  (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 sus-calc (files)
+(defun questionnaire-uri (request)
-  (check-type files list)
+  (questionnaire-uri-p (hunchentoot:request-uri request)))
-	(cons (car files) (sus-calc-score-per-row (extract-numbers (cdr files)))))
 
-(defstruct questionnaire-result
+(defun process-questionnaire-get (lang questionnaire)
-  type
+  (check-type lang string)
-  timestamp
+  (setf ml-survey/app:*html-lang* lang)
-  post-data)
+  (view questionnaire))
 
-(defun questionnaire-result-from-file (filename)
+(defun process-questionnaire-post (request survey questionnaire)
-  (check-type filename (or string pathname))
+  (let* ((post-params (hunchentoot:post-parameters* request))
-  (let ((data (read-from-file filename)))
+         (survey-id (ml-survey/survey:survey-id survey))
-    (make-questionnaire-result :type (getf data :type)
+         (questionnaire-id (ml-survey/app:generate-uuid))
-                               :timestamp (getf data :timestamp)
+         (questionnaire-data-file (ml-survey/fileops:ensure-data-file-exist survey-id
-                               :post-data (getf data :post-data))))
+                                                                            questionnaire-id)))
+
+    (ml-survey/fileops:write-to-file questionnaire-data-file
+                                     (list :type questionnaire
+                                           :timestamp (ml-survey/app:today+now)
+                                           :post-data post-params))
+
+    (view-submit)))
+
+(define-easy-handler (questionnaire-handler :uri #'questionnaire-uri) nil
+  (let ((s (make-instance 'ml-survey/survey:survey
+                          :id (ml-survey/app:extract-from (hunchentoot:request-uri*) :survey-id)))
+        (language (ml-survey/app:extract-from (hunchentoot:request-uri*) :language))
+        (questionnaire (ml-survey/app:extract-from (hunchentoot:request-uri*) :questionnaire)))
+    (cond ((eq (hunchentoot:request-method*) :get)
+           (process-questionnaire-get language questionnaire))
+          ((eq (hunchentoot:request-method*) :post)
+           (process-questionnaire-post hunchentoot:*request* s questionnaire)))))

src/questionnaires/de/sus.lisp

@@ -1,6 +1,4 @@
-;;;; -*- mode: common-lisp; coding: utf-8; -*-
+(in-package :ml-survey/questionnaire)
-
-(in-package :ml-survey/views)
 
 (multi-form
   (:ask "Ich denke, dass ich dieses System häufig nutzen möchte."

src/questionnaires/en/demo.lisp

@@ -1,6 +1,4 @@
-;;;; -*- mode: common-lisp; coding: utf-8; -*-
+(in-package :ml-survey/questionnaire)
-
-(in-package :ml-survey/views)
 
 (multi-form
   (:ask "What is your age range?"

src/questionnaires/en/sus.lisp

@@ -1,6 +1,4 @@
-;;;; -*- mode: common-lisp; coding: utf-8; -*-
+(in-package :ml-survey/questionnaire)
-
-(in-package :ml-survey/views)
 
 (multi-form
   (:ask "I would like to use this system frequently."

src/survey.lisp

@@ -1,9 +1,18 @@
 ;;;; -*- mode: common-lisp; coding: utf-8; -*-
 
-(in-package :ml-survey)
+(defpackage ml-survey/survey
+  (:use #:cl)
+  (:import-from #:hunchentoot
+                #:define-easy-handler)
+  (:import-from #:dev.metalisp.sbt
+                #:with-page
+		        #:body-header)
+  (:export #:survey-id
+           #:survey
+           #:survey-properties-title
+           #:survey-properties-description))
 
-(defun make-surveys-db-file ()
+(in-package #:ml-survey/survey)
-  (make-db-file "surveys-db.lisp"))
 
 (defclass survey ()
   ((id :initarg :id :reader survey-id)
@@ -14,9 +23,9 @@
   (with-slots (id data-dir properties) survey
     (setf data-dir (uiop:merge-pathnames*
                     (format nil "~a/" id)
-                    (ensure-surveys-dir)))
+                    (ml-survey/fileops:ensure-surveys-dir)))
     (setf properties (first (rest (assoc (parse-integer id)
-                                         (read-from-file (make-surveys-db-file))))))))
+                                         (ml-survey/fileops:read-from-file (ml-survey/fileops:make-surveys-db-file))))))))
 
 (defgeneric survey-id-p (survey)
   (:documentation "Check if the survey ID is present in the surveys database."))
@@ -34,7 +43,7 @@
   (:documentation "Get description property."))
 
 (defmethod survey-id-p ((survey survey))
-  (let ((ids (mapcar #'car (read-from-file (make-surveys-db-file)))))
+  (let ((ids (mapcar #'car (read-from-file (ml-survey/fileops:make-surveys-db-file)))))
     (if (member (parse-integer (survey-id survey)) ids) t nil)))
 
 (defmethod survey-data-dir-files ((survey survey))
@@ -62,3 +71,121 @@
                         (:dd (:a :href (build-questionnaire-link (survey-id survey) value)
 				 (format nil "Open Questionnaire ~a" value))))
                        (t (:dd value)))))))
+
+(defun results-not-null (results)
+  (some (lambda (x) (and (listp x) (not (null x)))) results))
+
+(defun view (survey &optional results)
+  "Generates the view to show the survey created."
+  (check-type survey survey)
+  (let ((results-not-null (results-not-null results))
+        (sus-results (getf results :sus)))
+
+    (with-page (:title "Survey Details" :add-js-urls ("/app.js"))
+      (body-header "Survey Details" (ml-survey/navbar:navbar-en))
+      (:main :id "main-content"
+	         :class "container"
+	         (:p (format nil "ID: ~a" (survey-id survey)))
+	         (:h2 :class "py-3" "Properties")
+	         (survey-html survey)
+
+	         (when results-not-null
+               (:h2 :class "py-3" "Questionnaire Results")
+
+               (if sus-results
+                   (let ((count-answers (length (cdr (car sus-results)))))
+                     (:h3 :class "py-1" "SUS")
+                     (:table :class "table table-hover"
+                       (:caption "Questionnaire results table")
+		               (:thead
+		                (:tr
+	                     (:th :scope "col" "Time")
+	                     (loop for header from 1 below count-answers
+                               do (:th :scope "col" (format nil "Q ~a" header)))
+                         (:th :scope "col" "SUS Score")))
+		               (:tbody
+		                (loop for row in sus-results
+                              do (:tr (mapcar (lambda (data) (:td data)) row)))))))
+
+               (loop for (type data) on results by #'cddr unless (eq type :sus)
+                     do (progn (:h3 :class "py-1" (format nil "~a" type))
+                               (loop for row in data
+                                     do (:ul :class "list-group py-3"
+                                             (loop for data in row
+                                                   for i from 0
+                                                   do (:li :class (if (zerop i)
+                                                                      "list-group-item active"
+                                                                      "list-group-item")
+                                                           data)))))))))))
+(defun extract-numbers (results)
+  "Extract numbers from a questionnaire RESULTS list.
+Returns a list of integers."
+  (check-type results list)
+  (mapcar (lambda (x)
+            (parse-integer (remove-if (complement #'digit-char-p)
+                                      (cdr x)))) results))
+
+(defun sus-calc-score (results)
+  (check-type results list)
+  (let ((counter 0))
+    (mapcar (lambda (x)
+              (setq counter (1+ counter))
+              (if (evenp counter)
+                  (- 5 x)
+                  (1- x)))
+            results)))
+
+(defun sus-calc-score-per-row (results)
+  (check-type results list)
+  (reverse (cons (* (apply #'+ (sus-calc-score results)) 2.5) (reverse results))))
+
+(defun sus-calc (files)
+  (check-type files list)
+	(cons (car files) (sus-calc-score-per-row (extract-numbers (cdr files)))))
+
+(defstruct questionnaire-result
+  type
+  timestamp
+  post-data)
+
+(defun questionnaire-result-from-file (filename)
+  (check-type filename (or string pathname))
+  (let ((data (ml-survey/fileops:read-from-file filename)))
+    (make-questionnaire-result :type (getf data :type)
+                               :timestamp (getf data :timestamp)
+                               :post-data (getf data :post-data))))
+
+(defun list-of-categorized-results (result-objs)
+  "Categorize results into different lists based on their type.
+  Apply special calculation for results of type 'sus'."
+  (let ((categorized-results (list :sus nil)))
+    (dolist (result result-objs categorized-results)
+      (let ((type (intern (string-upcase (questionnaire-result-type result)) :keyword))
+            (data (questionnaire-result-post-data result))
+            (timestamp (questionnaire-result-timestamp result)))
+        (cond
+          ((eq type :sus)
+           (setf (getf categorized-results :sus)
+                 (cons (sus-calc (cons timestamp data))
+                       (getf categorized-results :sus))))
+          (t
+           (setf (getf categorized-results type)
+                 (cons (cons timestamp (mapcar #'cdr data))
+                       (getf categorized-results type)))))))))
+
+(defun survey-uri-p (uri)
+  (let ((parts (ml-survey/app:split-uri uri)))
+        (and (= (length parts) 2)
+             (string= (first parts) "survey")
+             (every #'digit-char-p (second parts)))))
+
+(defun survey-uri (request)
+  (survey-uri-p (hunchentoot:request-uri request)))
+
+(define-easy-handler (survey-handler :uri #'survey-uri) ()
+  (let* ((s (make-instance 'survey
+                           :id (ml-survey/app:extract-from (hunchentoot:request-uri*) :survey-id)))
+         (result-objs (mapcar 'questionnaire-result-from-file
+                              (survey-data-dir-files s))))
+
+    (view s (list-of-categorized-results result-objs))))

src/surveys.lisp

@@ -1,21 +1,29 @@
 ;;;; -*- mode: common-lisp; coding: utf-8; -*-
 
-(in-package :ml-survey/views)
+(defpackage ml-survey/surveys
+  (:use :cl)
+  (:import-from #:hunchentoot
+                #:define-easy-handler)
+  (:import-from #:dev.metalisp.sbt
+                #:body-header
+                #:with-page))
+
+(in-package :ml-survey/surveys)
 
 (defun surveys-p (list)
   "Check if all elements in `lst` are instances of the class `survey`."
-  (every (lambda (item) (typep item 'ml-survey:survey)) list))
+  (every (lambda (item) (typep item 'ml-survey/survey:survey)) list))
 
 (deftype surveys-list ()
   '(and list (satisfies surveys-p)))
 
-(defun surveys (surveys)
+(defun view (surveys)
   "Generates the view to show all surveys available.
 
 SURVEYS: List of survey objects."
   (check-type surveys surveys-list)
   (with-page (:title "Surveys" :add-js-urls ("/app.js"))
-    (body-header "Surveys" (navbar-en))
+    (body-header "Surveys" (ml-survey/navbar:navbar-en))
     (:main :id "main-content"
            :class "container"
            (:div :class "btn-toolbar my-3"
@@ -27,9 +35,9 @@ SURVEYS: List of survey objects."
              (:h2 :class "mb-3" "Overview")
              (:ol :class "list-group list-group-numbered"
                   (loop for survey in surveys
-                        for title = (ml-survey:survey-properties-title survey)
+                        for title = (ml-survey/survey:survey-properties-title survey)
-                        for description = (ml-survey:survey-properties-description survey)
+                        for description = (ml-survey/survey:survey-properties-description survey)
-                        for id = (ml-survey:survey-id survey) do
+                        for id = (ml-survey/survey:survey-id survey) do
                           (:li :class "list-group-item d-flex justify-content-between align-items-start"
                                (:div :class "ms-2 me-auto"
                                      (:a :class "fw-bold clearfix"
@@ -38,3 +46,11 @@ SURVEYS: List of survey objects."
                                      (if description
                                          (:span description)
                                          nil)))))))))
+
+(define-easy-handler (surveys-handler :uri "/") nil
+  (let* ((survey-db (ml-survey/fileops:read-from-file (ml-survey/fileops:make-surveys-db-file)))
+         (list-of-surveys (mapcar (lambda (x)
+                                    (make-instance 'ml-survey/survey:survey
+                                                   :id (format nil "~a" (first x))))
+                                  survey-db)))
+    (view list-of-surveys)))

src/views/main.lisp

@@ -1,5 +0,0 @@
-;;;; -*- mode: common-lisp; coding: utf-8; -*-
-
-(in-package :ml-survey/views)
-
-(defparameter *use-cdn* nil)

src/views/package.lisp

@@ -1,30 +0,0 @@
-;;;; -*- mode: common-lisp; coding: utf-8; -*-
-
-(defpackage ml-survey/views
-  (:use #:cl)
-  (:import-from #:hunchentoot
-                #:request-uri*)
-  (:import-from #:spinneret
-                #:*html*)
-  (:import-from #:dev.metalisp.sbt
-                #:find-l10n
-                #:*l10n*
-                #:*use-cdn*
-                #:with-page
-		        #:body-header
-		        #:body-main)
-  (:import-from #:dev.metalisp.sbt/btn
-                #:btn
-                #:btn-primary)
-  (:import-from #:dev.metalisp.sbt/form
-                #:multi-form)
-  (:import-from #:dev.metalisp.sbt/utility
-                #:spacing)
-  (:export #:index
-           #:imprint
-           #:new-survey
-           #:surveys
-           #:create-survey
-           #:survey
-           #:questionnaire-submit
-           #:questionnaire))

src/views/questionnaire-submit.lisp

@@ -1,12 +0,0 @@
-;;;; -*- mode: common-lisp; coding: utf-8; -*-
-
-(in-package :ml-survey/views)
-
-(defun questionnaire-submit ()
-  (with-page (:title "Confirmation")
-    (body-header "Confirmation")
-    (:main :id "main-content"
-           :class "container"
-           (:div :class "alert alert-info"
-                 :role "alert"
-                  "Thank you for filling out the questionnaire."))))

src/views/questionnaire.lisp

@@ -1,38 +0,0 @@
-;;;; -*- mode: common-lisp; coding: utf-8; -*-
-
-(in-package :ml-survey/views)
-
-(defun load-form (lang questionnaire)
-  "Load a Lisp file containing form definitions."
-  (check-type lang string)
-  (check-type questionnaire string)
-  (let* ((form-path (uiop:merge-pathnames* (format nil "~a/~a.lisp" lang questionnaire)
-                                           (ml-survey:ensure-questionnaires-dir))))
-    (unless (probe-file form-path)
-      (error "Form file ~A does not exist." form-path))
-    (load form-path))
-  nil)
-
-(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 my-5"
-           (:p "Please fill out the following forms and press the submit button.")
-           ;; action is defined as hunchentoot:request-uri* function
-           (:form :action (request-uri*)
-                  :method "post"
-                  :class (spacing :property "m" :side "y" :size 5)
-                  ,@body
-                  (btn-primary (:type "submit")
-                    (find-l10n "submit" ml-survey:*html-lang* *l10n*))))))
-
-(defun questionnaire (questionnaire)
-  (with-page (:title "SUS Form" :add-js-urls ("/app.js"))
-    (body-header "System Usability Form")
-    (with-form (load-form ml-survey:*html-lang* questionnaire))))

src/views/survey.lisp

@@ -1,49 +0,0 @@
-;;;; -*- mode: common-lisp; coding: utf-8; -*-
-
-(in-package :ml-survey/views)
-
-(defun results-not-null (results)
-  (some (lambda (x) (and (listp x) (not (null x)))) results))
-
-(defun survey (survey &optional results)
-  "Generates the view to show the survey created."
-  (check-type survey ml-survey:survey)
-  (let ((results-not-null (results-not-null results))
-        (sus-results (getf results :sus)))
-
-    (with-page (:title "Survey Details" :add-js-urls ("/app.js"))
-      (body-header "Survey Details" (navbar-en))
-      (:main :id "main-content"
-	         :class "container"
-	         (:p (format nil "ID: ~a" (ml-survey:survey-id survey)))
-	         (:h2 :class "py-3" "Properties")
-	         (ml-survey:survey-html survey)
-
-	         (when results-not-null
-               (:h2 :class "py-3" "Questionnaire Results")
-
-               (if sus-results
-                   (let ((count-answers (length (cdr (car sus-results)))))
-                     (:h3 :class "py-1" "SUS")
-                     (:table :class "table table-hover"
-                       (:caption "Questionnaire results table")
-		               (:thead
-		                (:tr
-	                     (:th :scope "col" "Time")
-	                     (loop for header from 1 below count-answers
-                               do (:th :scope "col" (format nil "Q ~a" header)))
-                         (:th :scope "col" "SUS Score")))
-		               (:tbody
-		                (loop for row in sus-results
-                              do (:tr (mapcar (lambda (data) (:td data)) row)))))))
-
-               (loop for (type data) on results by #'cddr unless (eq type :sus)
-                     do (progn (:h3 :class "py-1" (format nil "~a" type))
-                               (loop for row in data
-                                     do (:ul :class "list-group py-3"
-                                             (loop for data in row
-                                                   for i from 0
-                                                   do (:li :class (if (zerop i)
-                                                                      "list-group-item active"
-                                                                      "list-group-item")
-                                                           data)))))))))))