about summary refs log tree commit diff
path: root/src/gemma.lisp
diff options
context:
space:
mode:
authorVincent Ambo <tazjin@gmail.com>2017-12-21T00·21+0100
committerVincent Ambo <tazjin@gmail.com>2017-12-21T00·21+0100
commita8d46a358e9bef845fc6d89d3e7551910f0b3d47 (patch)
tree9588751935dbde948f477f2797be49f99cf11ca5 /src/gemma.lisp
parent51ddb8fb53c6b1ecb9630d6a4cabd16ede07cb22 (diff)
feat(lisp): Implement persistent storage via cl-prevalence
Uses the cl-prevalence system to store tasks on disk. The storage
location is either relative to the working directory in which the
system is started or determined (with priority) by the environment
variable `GEMMA_DATA_DIR`.
Diffstat (limited to 'src/gemma.lisp')
-rw-r--r--src/gemma.lisp59
1 files changed, 41 insertions, 18 deletions
diff --git a/src/gemma.lisp b/src/gemma.lisp
index 975628f3ded9..e103ed92c266 100644
--- a/src/gemma.lisp
+++ b/src/gemma.lisp
@@ -9,7 +9,6 @@
 
 (defpackage gemma
   (:use :cl
-        :alexandria
         :hunchentoot
         :local-time
         :cl-json))
@@ -23,7 +22,10 @@
 ;; Define task management system
 ;;
 (defclass task ()
-  (;; (Unique) name of the task
+  ((id :reader id
+       :initarg :id)
+
+   ;; (Unique) name of the task
    (name :type symbol
          :initarg :name
          :accessor name-of)
@@ -40,24 +42,38 @@
 
    ;; Last completion time
    (done-at :type local-time:timestamp
+            :initarg :done-at
             :accessor last-done-at)))
 
-(defvar *tasks*
-  (make-hash-table)
-  "List of all tasks registered in this Gemma instance.")
+(defvar *gemma-data-dir*
+  (pathname (or (sb-posix:getenv "GEMMA_DATA_DIR")
+                (sb-posix:getcwd)))
+  "Directory in which to store Gemma data.")
+
+(defvar *p-tasks*
+  (cl-prevalence:make-prevalence-system *gemma-data-dir*)
+  "All tasks registered in this Gemma instance.")
+
+;; Initialise database ID counter
+(or (> (length (cl-prevalence:find-all-objects *p-tasks* 'task)) 0)
+    (cl-prevalence:tx-create-id-counter *p-tasks*))
 
 (defmacro deftask (task-name days &optional description)
-  `(setf (gethash (quote ,task-name) *tasks*)
-         (make-instance (quote task)
-                        :name (quote ,task-name)
-                        :days ,days
-                        :description (or ,description ""))))
+  (unless (get-task task-name)
+    `(progn (cl-prevalence:tx-create-object
+             *p-tasks*
+             'task
+             (quote ((name ,task-name)
+                     (days ,days)
+                     (description ,(or description ""))
+                     (done-at ,(local-time:now)))))
+            (cl-prevalence:snapshot *p-tasks*))))
 
 (defun get-task (name)
-  (gethash name *tasks*))
+  (cl-prevalence:find-object-with-slot *p-tasks* 'task 'name name))
 
 (defun list-tasks ()
-  (alexandria:hash-table-values *tasks*))
+  (cl-prevalence:find-all-objects *p-tasks* 'task))
 
 (defun days-remaining (task)
   "Returns the number of days remaining before the supplied TASK reaches its
@@ -76,8 +92,9 @@ maximum interval."
 
 (defun complete-task (name &optional at)
   "Mark the task with NAME as completed, either now or AT specified time."
-  (setf (last-done-at (get-task name))
-        (or at (local-time:now))))
+  (cl-prevalence:tx-change-object-slots *p-tasks* 'task
+                                        (id (get-task name))
+                                        `((done-at ,(or at (local-time:now))))))
 
 ;;
 ;; Define web API
@@ -139,9 +156,15 @@ maximum interval."
 (defun randomise-completion-times ()
   "Set some random completion timestamps for all tasks"
   (mapcar
-   (lambda (key) (complete-task key (local-time:timestamp- (local-time:now)
-                                                           (random 14)
-                                                           :day)))
-   (alexandria:hash-table-keys *tasks*)))
+   (lambda (task)
+     (complete-task (name-of task)
+                    (local-time:timestamp- (local-time:now)
+                                           (random 14)
+                                           :day)))
+   (cl-prevalence:find-all-objects *p-tasks* 'task)))
+
+(defun clear-all-tasks ()
+  (mapcar (lambda (task) (cl-prevalence:tx-delete-object *p-tasks* 'task (id task)))
+          (cl-prevalence:find-all-objects *p-tasks* 'task)))
 
 ;; (randomise-completion-times)