feat(lisp): Initial Gemma backend implementation

Implements the initial - very simple - backend for Gemma, a
task-management app for recurring tasks.

2 files changed, 147 insertions, 0 deletions

diff --git a/gemma.asd b/gemma.asd
new file mode 100644
index 000000000000..82237a6f2809
--- /dev/null
+++ b/gemma.asd
@@ -0,0 +1,22 @@
+#|
+  This file is a part of gemma project.
+  Copyright (c) 2017 Vincent Ambo
+|#
+
+#|
+  Author: Vincent Ambo
+|#
+
+(defsystem "gemma"
+  :version "0.1.0"
+  :author "Vincent Ambo"
+  :license "GPLv3"
+  :depends-on (alexandria local-time hunchentoot yason)
+  :components ((:module "src"
+                :components
+                ((:file "gemma"))))
+  :description "Gemma is a household task management system"
+  :long-description
+  #.(read-file-string
+     (subpathname *load-pathname* "README.markdown"))
+  :in-order-to ((test-op (test-op "gemma-test"))))
diff --git a/src/gemma.lisp b/src/gemma.lisp
new file mode 100644
index 000000000000..a96b722a2299
--- /dev/null
+++ b/src/gemma.lisp
@@ -0,0 +1,125 @@
+(defpackage gemma
+  (:use :cl
+        :alexandria
+        :hunchentoot
+        :local-time
+        :cl-json))
+(in-package :gemma)
+
+;; TODO: Store an average of how many days it was between task
+;; completions. Some of the current numbers are just guesses
+;; anyways.
+
+;;
+;; Define task management system
+;;
+(defclass task ()
+  (;; (Unique) name of the task
+   (name :type symbol
+         :initarg :name
+         :accessor name-of)
+
+   ;; Maximum completion interval
+   (days :type integer
+         :initarg :days
+         :accessor days-of)
+
+   ;; Optional description
+   (description :type string
+                :initarg :description
+                :accessor description-of)
+
+   ;; Last completion time
+   (done-at :type local-time:timestamp
+            :accessor last-done-at)))
+
+(defvar *tasks*
+  (make-hash-table)
+  "List of all tasks registered in this Gemma instance.")
+
+(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 ""))))
+
+(defun get-task (name)
+  (gethash name *tasks*))
+
+(defun list-tasks ()
+  (alexandria:hash-table-values *tasks*))
+
+(defun days-remaining (task)
+  "Returns the number of days remaining before the supplied TASK reaches its
+maximum interval."
+  (let* ((expires-at (local-time:timestamp+ (last-done-at task)
+                                            (days-of task) :day))
+         (secs-until-expiry (local-time:timestamp-difference expires-at
+                                                             (local-time:now))))
+    (round (/ secs-until-expiry 60 60 24))))
+
+(defun sort-tasks (tasks)
+  "Sorts TASKS in descending order by number of days remaining."
+  (sort (copy-list tasks)
+        (lambda (t1 t2) (> (days-remaining t1)
+                           (days-remaining t2)))))
+
+(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))))
+
+;;
+;; Define web API
+;;
+
+(defun start-gemma ()
+  ;; Set up web server
+  (hunchentoot:start (make-instance 'hunchentoot:easy-acceptor :port 4242))
+
+  ;; ... and register all handlers.
+  (hunchentoot:define-easy-handler
+   (get-tasks :uri "/tasks") ()
+
+   (setf (hunchentoot:content-type*) "application/json")
+   (setf (hunchentoot:header-out "Access-Control-Allow-Origin") "*")
+   (json:encode-json-to-string
+    ;; Construct a frontend-friendly representation of the tasks.
+    (mapcar
+     (lambda (task) `((:name . ,(name-of task))
+                      (:description . ,(description-of task))
+                      (:remaining . ,(days-remaining task))))
+     (sort-tasks (list-tasks))))))
+
+;; (not-so) example tasks
+
+;; Bathroom tasks
+(deftask bathroom/wipe-mirror 7)
+(deftask bathroom/wipe-counter 7)
+
+;; Bedroom tasks
+(deftask bedroom/change-sheets 7)
+(deftask bedroom/vacuum 10)
+
+;; Kitchen tasks
+(deftask kitchen/normal-trash 3)
+(deftask kitchen/green-trash 5)
+(deftask kitchen/blue-trash 5)
+(deftask kitchen/wipe-counters 3)
+(deftask kitchen/vacuum 5 "Kitchen has more crumbs and such!")
+
+;; Entire place
+(deftask clean-windows 60)
+
+;; Experimentation / testing stuff
+
+(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*)))
+
+;; (randomise-completion-times)