about summary refs log tree commit diff
path: root/services/gemma/src/gemma.lisp
diff options
context:
space:
mode:
authorVincent Ambo <tazjin@google.com>2019-12-20T20·18+0000
committerVincent Ambo <tazjin@google.com>2019-12-20T20·18+0000
commit03bfe08e1dd9faf48b06cb146bfa446575cde88a (patch)
tree55317968922a9b2a01516f1b79527874df037517 /services/gemma/src/gemma.lisp
parente52eed3cd4f73779c2e7c350537fb346835ba9f3 (diff)
chore: Significantly restructure folder layout r/237
This moves the various projects from "type-based" folders (such as
"services" or "tools") into more appropriate semantic folders (such as
"nix", "ops" or "web").

Deprecated projects (nixcon-demo & gotest) which only existed for
testing/demonstration purposes have been removed.

(Note: *all* builds are broken with this commit)
Diffstat (limited to 'services/gemma/src/gemma.lisp')
-rw-r--r--services/gemma/src/gemma.lisp192
1 files changed, 0 insertions, 192 deletions
diff --git a/services/gemma/src/gemma.lisp b/services/gemma/src/gemma.lisp
deleted file mode 100644
index b8a20addd907..000000000000
--- a/services/gemma/src/gemma.lisp
+++ /dev/null
@@ -1,192 +0,0 @@
-;; Copyright (C) 2016-2017  Vincent Ambo <mail@tazj.in>
-;;
-;; This file is part of Gemma.
-;;
-;; Gemma is free software: you can redistribute it and/or modify it
-;; under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-(defpackage gemma
-  (:use :cl
-        :local-time
-        :cl-json)
-  (:import-from :sb-posix :getenv)
-  (:shadowing-import-from :sb-posix :getcwd)
-  (:export :start-gemma :config :entrypoint))
-(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.
-
-(defmacro in-case-of (x &body body)
-  "Evaluate BODY if X is non-nil, binding the value of X to IT."
-  `(let ((it ,x))
-     (when it ,@body)))
-
-;; Set default configuration parameters
-(defvar *gemma-port* 4242
-  "Port on which the Gemma web server listens.")
-
-(defvar *static-file-location*
-  (or (in-case-of (sb-posix:getenv "out")
-        (concatenate 'string it "/share/gemma/"))
-      "frontend/")
-  "Folder from which to serve static assets. If built inside of Nix,
-  the folder is concatenated with the output path at which the files
-  are expected to be.")
-
-(defun initialise-persistence (data-dir)
-  (defvar *p-tasks*
-    (cl-prevalence:make-prevalence-system 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*)))
-
-(defun config (&key port data-dir)
-  "Configuration function for use in the Gemma configuration file."
-
-  (in-package :gemma)
-  (in-case-of port (defparameter *gemma-port* it))
-  (initialise-persistence (or data-dir "data/")))
-
-;;
-;; Define task management system
-;;
-
-(defclass task ()
-  ((id :reader id
-       :initarg :id)
-
-   ;; (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 timestamp
-            :initarg :done-at
-            :accessor last-done-at)))
-
-(defmacro deftask (task-name days &optional 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 ,(now)))))
-            (cl-prevalence:snapshot *p-tasks*))))
-
-(defun get-task (name)
-  (cl-prevalence:find-object-with-slot *p-tasks* 'task 'name name))
-
-(defun list-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
-maximum interval."
-  (let* ((expires-at (timestamp+ (last-done-at task)
-                                 (days-of task) :day))
-         (secs-until-expiry (timestamp-difference expires-at (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."
-  (cl-prevalence:tx-change-object-slots *p-tasks* 'task
-                                        (id (get-task name))
-                                        `((done-at ,(or at (now)))))
-  (cl-prevalence:snapshot *p-tasks*))
-
-;;
-;; Define web API
-;;
-
-(defun response-for (task)
-  "Create a response object to be JSON encoded for TASK."
-  `((:name . ,(name-of task))
-    (:description . ,(description-of task))
-    (:remaining . ,(days-remaining task))))
-
-(defun start-gemma ()
-  (in-package :gemma)
-
-  ;; Load configuration
-  (load (pathname (or (getenv "GEMMA_CONFIG")
-                      "/etc/gemma/config.lisp")))
-
-  ;; Set up web server
-  (hunchentoot:start
-   (make-instance 'hunchentoot:easy-acceptor
-                  :port *gemma-port*
-                  :document-root *static-file-location*))
-
-  ;; Task listing handler
-  (hunchentoot:define-easy-handler
-   (get-tasks :uri "/tasks") ()
-
-   (setf (hunchentoot:content-type*) "application/json")
-   (setf (hunchentoot:header-out "Access-Control-Allow-Origin") "*")
-   (encode-json-to-string
-    ;; Construct a frontend-friendly representation of the tasks.
-    (mapcar #'response-for (sort-tasks (list-tasks)))))
-
-  ;; Task completion handler
-  (hunchentoot:define-easy-handler
-   (complete-task-handler :uri "/complete") (task)
-   (setf (hunchentoot:content-type*) "application/json")
-   (let* ((key (find-symbol (camel-case-to-lisp task) "GEMMA")))
-     (format t "Marking task ~A as completed" key)
-     (complete-task key)
-     (encode-json-to-string (response-for (get-task key))))))
-
-(defun entrypoint ()
-  "This function serves as the entrypoint for ASDF-built executables.
-  It joins the Hunchentoot server thread to keep the process running
-  for as long as the server is alive."
-
-  (start-gemma)
-  (sb-thread:join-thread
-   (find-if (lambda (th)
-              (string= (sb-thread:thread-name th)
-                       (format nil "hunchentoot-listener-*:~A" *gemma-port*)))
-            (sb-thread:list-all-threads))))
-
-;; Experimentation / testing stuff
-
-(defun randomise-completion-times ()
-  "Set some random completion timestamps for all tasks"
-  (mapcar
-   (lambda (task)
-     (complete-task (name-of task)
-                    (timestamp- (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)