mdebray/tvl-depot
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

refactor(lisp): Use imported symbols with local qualification

Browse source 
... except hunchentoot, I like using that fully-qualified because it's
a great word.
This commit is contained in:
Vincent Ambo 2017-12-21 13:54:02 +01:00
parent 8d1c9df434
commit bf9991026a
1 changed files with 12 additions and 14 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

20
src/gemma.lisp
View file

@ -9,7 +9,6 @@
(defpackage gemma (defpackage gemma
(:use :cl (:use :cl
:hunchentoot
:local-time :local-time
:cl-json)) :cl-json))
(in-package :gemma) (in-package :gemma)
@ -41,7 +40,7 @@
:accessor description-of) :accessor description-of)
;; Last completion time ;; Last completion time
(done-at :type local-time:timestamp (done-at :type timestamp
:initarg :done-at :initarg :done-at
:accessor last-done-at))) :accessor last-done-at)))
@ -66,7 +65,7 @@
(quote ((name ,task-name) (quote ((name ,task-name)
(days ,days) (days ,days)
(description ,(or description "")) (description ,(or description ""))
(done-at ,(local-time:now))))) (done-at ,(now)))))
(cl-prevalence:snapshot *p-tasks*)))) (cl-prevalence:snapshot *p-tasks*))))
(defun get-task (name) (defun get-task (name)
@ -78,10 +77,9 @@
(defun days-remaining (task) (defun days-remaining (task)
"Returns the number of days remaining before the supplied TASK reaches its "Returns the number of days remaining before the supplied TASK reaches its
maximum interval." maximum interval."
(let* ((expires-at (local-time:timestamp+ (last-done-at task) (let* ((expires-at (timestamp+ (last-done-at task)
(days-of task) :day)) (days-of task) :day))
(secs-until-expiry (local-time:timestamp-difference expires-at (secs-until-expiry (timestamp-difference expires-at (now))))
(local-time:now))))
(round (/ secs-until-expiry 60 60 24)))) (round (/ secs-until-expiry 60 60 24))))
(defun sort-tasks (tasks) (defun sort-tasks (tasks)
@ -94,7 +92,7 @@ maximum interval."
"Mark the task with NAME as completed, either now or AT specified time." "Mark the task with NAME as completed, either now or AT specified time."
(cl-prevalence:tx-change-object-slots *p-tasks* 'task (cl-prevalence:tx-change-object-slots *p-tasks* 'task
(id (get-task name)) (id (get-task name))
`((done-at ,(or at (local-time:now))))) `((done-at ,(or at (now)))))
(cl-prevalence:snapshot *p-tasks*)) (cl-prevalence:snapshot *p-tasks*))
;; ;;
@ -119,7 +117,7 @@ maximum interval."
(setf (hunchentoot:content-type*) "application/json") (setf (hunchentoot:content-type*) "application/json")
(setf (hunchentoot:header-out "Access-Control-Allow-Origin") "*") (setf (hunchentoot:header-out "Access-Control-Allow-Origin") "*")
(json:encode-json-to-string (encode-json-to-string
;; Construct a frontend-friendly representation of the tasks. ;; Construct a frontend-friendly representation of the tasks.
(mapcar #'response-for (sort-tasks (list-tasks))))) (mapcar #'response-for (sort-tasks (list-tasks)))))
@ -127,10 +125,10 @@ maximum interval."
(hunchentoot:define-easy-handler (hunchentoot:define-easy-handler
(complete-task-handler :uri "/complete") (task) (complete-task-handler :uri "/complete") (task)
(setf (hunchentoot:content-type*) "application/json") (setf (hunchentoot:content-type*) "application/json")
(let* ((key (intern (json:camel-case-to-lisp task) "GEMMA"))) (let* ((key (intern (camel-case-to-lisp task) "GEMMA")))
(format t "Marking task ~A as completed" key) (format t "Marking task ~A as completed" key)
(complete-task key) (complete-task key)
(json:encode-json-to-string (response-for (get-task key)))))) (encode-json-to-string (response-for (get-task key))))))
;; (not-so) example tasks ;; (not-so) example tasks
@ -159,7 +157,7 @@ maximum interval."
(mapcar (mapcar
(lambda (task) (lambda (task)
(complete-task (name-of task) (complete-task (name-of task)
(local-time:timestamp- (local-time:now) (timestamp- (now)
(random 14) (random 14)
:day))) :day)))
(cl-prevalence:find-all-objects *p-tasks* 'task))) (cl-prevalence:find-all-objects *p-tasks* 'task)))