diff options
-rw-r--r-- | gemma.asd | 22 | ||||
-rw-r--r-- | src/gemma.lisp | 125 |
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) |