feat(lisp): Initial Gemma backend implementation
Implements the initial - very simple - backend for Gemma, a task-management app for recurring tasks.
This commit is contained in:
		
						commit
						95e4971908
					
				
					 2 changed files with 147 additions and 0 deletions
				
			
		
							
								
								
									
										125
									
								
								src/gemma.lisp
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										125
									
								
								src/gemma.lisp
									
										
									
									
									
										Normal file
									
								
							| 
						 | 
				
			
			@ -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)
 | 
			
		||||
		Loading…
	
	Add table
		Add a link
		
	
		Reference in a new issue