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

Robust fileops

Browse source
This commit is contained in:
Marcus Kammer 2024-06-16 20:24:07 +02:00
parent 5578c720df
commit b4afed50e1
Signed by: marcuskammer
GPG key ID: C374817BE285268F
1 changed files with 6 additions and 15 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

21
src/fileops.lisp
View file

@ -2,17 +2,10 @@
(defun base-dir () (defun base-dir ()
(let ((os (uiop:detect-os))) (let ((os (uiop:detect-os)))
(uiop:parse-native-namestring (cond ((eq os :os-windows) (truename "~/AppData/Local/"))
(cond ((eq os :os-windows) ((eq os :os-unix) (truename "~/.local/share/"))
(format nil "~a/" (uiop:getenv "LOCALAPPDATA"))) ((eq os :os-macos) (truename "~/Library/Application Support/"))
(t (error "Unsupported OS")))))
((eq os :os-unix)
(format nil "~a/.local/share/" (user-homedir-pathname)))
((eq os :os-macos)
(format nil "~a/Library/Application Support/" (user-homedir-pathname)))
(t (error "Unsupported OS"))))))
(defun app-dir () (defun app-dir ()
(uiop:merge-pathnames* #P"ml-survey/" (base-dir))) (uiop:merge-pathnames* #P"ml-survey/" (base-dir)))
@ -33,15 +26,14 @@
:if-exists :overwrite :if-exists :overwrite
:if-does-not-exist :create) :if-does-not-exist :create)
(format stream ""))) (format stream "")))
pathname) (truename pathname))
(defun ensure-data-file-exist (survey-id questionnaire-id) (defun ensure-data-file-exist (survey-id questionnaire-id)
(let ((path (format nil "~a~a/~a.lisp" (let ((path (format nil "~a~a/~a.lisp"
(ensure-data-dir) (ensure-data-dir)
survey-id survey-id
questionnaire-id))) questionnaire-id)))
(ensure-directories-exist path) (ensure-file-exist (ensure-directories-exist path))))
(ensure-file-exist path)))
(defun make-db-file (file) (defun make-db-file (file)
"Prepare and ensure a database file at FILE-STR path." "Prepare and ensure a database file at FILE-STR path."
@ -49,7 +41,6 @@
(let ((path (uiop:merge-pathnames* file (ensure-data-dir)))) (let ((path (uiop:merge-pathnames* file (ensure-data-dir))))
(ensure-file-exist path))) (ensure-file-exist path)))
(defun load-response (db) (defun load-response (db)
(check-type db (or string pathname)) (check-type db (or string pathname))
(with-open-file (stream db (with-open-file (stream db