Refactor file/dir operations

dev.metalisp.survey.asd

@@ -10,6 +10,7 @@
   ((:module "src"
     :components
     ((:file "package")
+     (:file "fileops")
      (:file "app")
      (:file "survey")))
 

src/fileops.lisp

@@ -0,0 +1,75 @@
+(in-package :ml-survey)
+
+(defun base-dir ()
+  (let ((os (uiop:detect-os)))
+    (cond ((eq os :os-windows)
+           (format nil "~a/" (uiop:getenv "LOCALAPPDATA")))
+
+          ((eq os :os-unix)
+           (format nil "~a" (uiop:merge-pathnames*
+                             ".local/share/"
+                             (format nil
+                                     "~a/"
+                                     (uiop:getenv "HOME")))))
+
+          ((eq os :os-macos)
+           (format nil "~a" (uiop:merge-pathnames*
+                             "Library/Application Support/"
+                             (format nil
+                                     "~a/"
+                                     (uiop:getenv "HOME")))))
+
+          (t (error "Unsupported OS")))))
+
+(defun app-dir ()
+  (uiop:merge-pathnames* "ml-survey/" (base-dir)))
+
+(defun data-dir ()
+  (uiop:merge-pathnames* "data/surveys/" (app-dir)))
+
+(defun ensure-data-dir ()
+  (let ((data-dir (data-dir)))
+    (ensure-directories-exist (data-dir))
+  data-dir))
+
+(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)
+    (with-open-file (stream pathname
+                            :direction :output
+                            :if-exists :overwrite
+                            :if-does-not-exist :create)
+      (format stream "")))
+  pathname)
+
+(defun ensure-data-file-exist (survey-id questionnaire-id)
+  (let ((path (format nil "~a~a/~a.lisp"
+                      (ensure-data-dir)
+                      survey-id
+                      questionnaire-id)))
+    (ensure-directories-exist path)
+    (ensure-file-exist path)))
+
+(defun make-db-file (file)
+  "Prepare and ensure a database file at FILE-STR path."
+  (check-type file string)
+  (let ((path (uiop:merge-pathnames* file (ensure-data-dir))))
+    (ensure-file-exist path)))
+
+
+(defun load-response (db)
+  (check-type db (or string pathname))
+  (with-open-file (stream db
+                          :direction :input
+                          :if-does-not-exist :create)
+    (if (= (file-length stream) 0)
+        (list)
+        (read stream))))
+
+(defun store-response (db responses)
+  (check-type db (or string pathname))
+  (check-type responses list)
+  (with-open-file (stream db
+                          :direction :output
+                          :if-exists :supersede)
+    (prin1 responses stream)))

src/handlers/main.lisp

@@ -1,37 +1,5 @@
 (in-package :ml-survey/handlers)
 
-(defun base-dir ()
-  (let ((os (uiop:detect-os)))
-    (cond ((eq os :os-windows)
-           (format nil "~a/" (uiop:getenv "LOCALAPPDATA")))
-
-          ((eq os :os-unix)
-           (format nil "~a" (uiop:merge-pathnames*
-                             ".local/share/"
-                             (format nil
-                                     "~a/"
-                                     (uiop:getenv "HOME")))))
-
-          ((eq os :os-macos)
-           (format nil "~a" (uiop:merge-pathnames*
-                             "Library/Application Support/"
-                             (format nil
-                                     "~a/"
-                                     (uiop:getenv "HOME")))))
-
-          (t (error "Unsupported OS")))))
-
-(defun app-dir ()
-  (uiop:merge-pathnames* "ml-survey/" (base-dir)))
-
-(defun data-dir ()
-  (uiop:merge-pathnames* "data/surveys/" (app-dir)))
-
-(defun ensure-data-dir ()
-  (let ((data-dir (data-dir)))
-    (ensure-directories-exist (data-dir))
-  data-dir))
-
 (defun split-uri (uri)
   (check-type uri string)
   (remove-if #'string-empty-p
@@ -56,50 +24,6 @@
                                 (local-time:now)
                                 :format '((:hour 2) ":" (:min 2) ":" (:sec 2))))
 
-(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)
-    (with-open-file (stream pathname
-                            :direction :output
-                            :if-exists :overwrite
-                            :if-does-not-exist :create)
-      (format stream "")))
-  pathname)
-
-(defun ensure-data-file-exist (survey-id questionnaire-id)
-  (let ((path (format nil "~a~a/~a.lisp"
-                      (ensure-data-dir)
-                      survey-id
-                      questionnaire-id)))
-    (ensure-directories-exist path)
-    (ensure-file-exist path)))
-
-(defun make-db-file (file)
-  "Prepare and ensure a database file at FILE-STR path."
-  (check-type file string)
-  (let ((path (uiop:merge-pathnames* file (ensure-data-dir))))
-    (ensure-file-exist path)))
-
-(defun make-surveys-db-file ()
-  (make-db-file "surveys-db.lisp"))
-
-(defun load-response (db)
-  (check-type db (or string pathname))
-  (with-open-file (stream db
-                          :direction :input
-                          :if-does-not-exist :create)
-    (if (= (file-length stream) 0)
-        (list)
-        (read stream))))
-
-(defun store-response (db responses)
-  (check-type db (or string pathname))
-  (check-type responses list)
-  (with-open-file (stream db
-                          :direction :output
-                          :if-exists :supersede)
-    (prin1 responses stream)))
-
 (defun generate-uuid ()
   (parse-integer (format nil "~A~A~A"
                          (sb-posix:getpid)

src/handlers/package.lisp

@@ -9,4 +9,10 @@
                 #:content-type*
                 #:request-uri
                 #:request-uri*
-                #:*request*))
+                #:*request*)
+  (:import-from #:ml-survey
+                #:ensure-data-dir
+                #:ensure-data-file-exist
+                #:store-response
+                #:load-response
+                #:make-surveys-db-file))

src/handlers/questionnaire.lisp

@@ -20,20 +20,20 @@
 
 (defun process-questionnaire-get (lang s)
   (check-type lang string)
-  (check-type s survey)
+  (check-type s ml-survey:survey)
   (setf *html-lang* lang)
-  (funcall (choose-sus-form lang) (survey-id s)))
+  (funcall (choose-sus-form lang) (ml-survey:survey-id s)))
 
 (defun process-questionnaire-post (request s)
   (let ((post-params (post-parameters* request))
         (questionnaire-id (generate-uuid)))
-    (store-response (ensure-data-file-exist (survey-id s)
+    (store-response (ensure-data-file-exist (ml-survey:survey-id s)
                                             questionnaire-id)
                     post-params)
     (ml-survey/views:questionnaire-submit)))
 
 (define-easy-handler (questionnaire :uri #'questionnaire-uri) (lang)
-  (let ((s (make-instance 'survey :id (get-survey-id (request-uri*)))))
+  (let ((s (make-instance 'ml-survey:survey :id (get-survey-id (request-uri*)))))
     (cond ((eq (hunchentoot:request-method*) :get)
            (process-questionnaire-get lang s))
           ((eq (hunchentoot:request-method*) :post)

src/package.lisp

@@ -8,6 +8,11 @@
    #:survey-data-dir-p
    #:survey-data-dir-files
    #:survey-html
+   #:ensure-data-dir
+   #:ensure-data-file-exist
+   #:store-response
+   #:load-response
+   #:make-surveys-db-file
    #:start
    #:*app*
    #:set-default-directory

src/survey.lisp

@@ -1,3 +1,8 @@
+(in-package :ml-survey)
+
+(defun make-surveys-db-file ()
+  (make-db-file "surveys-db.lisp"))
+
 (defclass survey ()
   ((id :initarg :id :reader survey-id)
    (data-dir :initarg :data-dir :reader survey-data-dir)

src/views/survey.lisp

@@ -1,6 +1,7 @@
 (in-package :ml-survey/views)
 
 (defun survey (survey &optional results)
+  (check-type survey ml-survey:survey)
   "Generates the view to show the survey created."
   (with-page (:title "Survey Details")
     (navbar-en)