#+TITLE: TODO backend implementation using CL and fukamachi/ningle
* Setup
- src_sh[:exports code]{git clone https://github.com/fiddlerwoaroof/data-lens.git ~/quicklisp/local-projects/data-lens}
- src_sh[:exports code]{git clone https://github.com/fukamachi/lack.git ~/quicklisp/local-projects/lack}
#+BEGIN_SRC sh
sbcl --eval '(asdf:load-asd (truename "todo-backend.asd"))'
--eval '(ql:quickload :todo-backend)'
--eval '(fwoar.todo::ensure-started)'
#+END_SRC
After this, all the tests [[http://www.todobackend.com/specs/index.html?http://localhost:5000][here]] should pass and the frontend [[http://www.todobackend.com/client/index.html?http://localhost:5000][here]] should work.
* todo API
We use a fairly simple structure for our "database": a fset map (a
clojure-inspired persistent data structure) and a handful of
interface functions that wrap it. In this code, this fset map is
referenced as =*todo*=, but this is a detail hidden behind the API.
** List-level APIs
These are functions for getting the todo list and clearing
it. These are activated by the root route: =todos= for GET requests
and =clear-todos= for DELETE requests.
#+NAME: todolist-manipulation
#+BEGIN_SRC lisp :tangle no
(defun todos ()
(gmap:gmap :seq
(lambda (_ b)
(declare (ignore _))
b)
(:map *todos*)))
(defun clear-todos ()
(setf *todos*
(fset:empty-map)))
#+END_SRC
** Getting/Replacing a todo
This uses lisp's [[http://www.lispworks.com/documentation/HyperSpec/Body/05_a.htm][generalized references]] to abstract away the
storage details of the todos. We also provide a =delete-todo=
function for removing a todo from the list. =todo= is what backs
the GET request for a specific todo by id.
#+NAME: todo-accessor
#+BEGIN_SRC lisp :tangle no
(defun todo (id)
(let ((todo (fset:@ *todos* id)))
todo))
(defun (setf todo) (new-value id)
(setf (fset:@ *todos* id)
new-value))
(defun delete-todo (id)
(setf *todos*
(fset:less *todos* id)))
#+END_SRC
** Adding and modifying todos
=new-todo= is fairly trivial. It's main feature is that it has to
make sure the =completed= and =url= keys are set to the appropriate
values. Completed isn't a lisp boolean, so it serializes to JSON
properly. =new-todo= backs POST requests to the root endpoint.
#+NAME: new-todo
#+BEGIN_SRC lisp :tangle no
(defvar *external-host*
"localhost")
(defvar *external-port*
5000)
(defun new-todo (value)
(let ((id (next-id)))
(setf (todo id)
(alexandria:alist-hash-table
(rutilsx.threading:->>
value
(acons "completed" 'yason:false)
(acons "url"
(format nil "http://~a:~d/todo/~d"
,*external-host*
,*external-port*
id)))
:test 'equal))))
#+END_SRC
=update-todo= just merges the input from the frontend into the
relevant todo and then makes sure that the =completed= key is a
yason-compatible boolean. =update-todo= backs PATCH requests to the
todo endpoint for a specific ID.
#+NAME: update-todo
#+BEGIN_SRC lisp :tangle no
(defun update-todo (id v)
(let* ((old-todo (or (todo id)
(make-hash-table :test 'equal)))
(in-hash-table (alexandria:alist-hash-table v :test 'equal))
(update (data-lens.lenses:over *completed-lens*
'bool-to-yason
in-hash-table)))
(setf (todo id)
(serapeum:merge-tables old-todo
update))))
#+END_SRC
** Examples
#+BEGIN_SRC lisp :tangle no :noweb yes :exports both :results verbatim
<<example-setup>>
(with-fresh-todos ()
(new-todo '(("title" . "get groceries")))
(new-todo '(("title" . "write-better-documentation")))
(fset:convert 'list (todos)))
#+END_SRC
#+RESULTS:
: (#<hash-table "url": "http://localhost:5000/todo/22",
: "title": "get groceries",
: "completed": YASON:FALSE>
: #<hash-table "url": "http://localhost:5000/todo/23",
: "title": "write-better-documentation",
: "completed": YASON:FALSE>)
* Routing
** Routing utilities
The core utility here is the =defroutes= macro. This takes a
sequence of endpoint descriptions which contain nested definitions
for HTTP verbs and expands to ningle's functions for manipulating
routes.
#+NAME: defroutes
#+BEGIN_SRC lisp
(defmacro defroutes (app &body routes)
(alexandria:once-only (app)
`(setf
,@(loop for (target . descriptors) in routes
append (loop for (method callback) in descriptors
append `((ningle:route ,app ,target
:method ,method)
,callback))))))
#+END_SRC
This macro organizes all the HTTP verbs for a given endpoint under
the path to that endpoint. A more complete version might allow for
a list of verbs =(:GET :POST)= in the head of each handler clause.
#+BEGIN_SRC lisp :exports both :tangle no :results verbatim
(macroexpand-1
'(defroutes app
("/"
(:GET (handler () (todos)))
(:POST (handler (v) (new-todo v)))
(:DELETE (handler () (clear-todos))))))
#+END_SRC
#+RESULTS:
#+begin_example
(LET ((#:APP1852 APP))
(SETF (NINGLE/APP:ROUTE #:APP1852 "/" :METHOD METHOD)
(HANDLER NIL
(TODOS))
(NINGLE/APP:ROUTE #:APP1852 "/" :METHOD METHOD)
(HANDLER (V)
(NEW-TODO V))
(NINGLE/APP:ROUTE #:APP1852 "/" :METHOD METHOD)
(HANDLER NIL
(CLEAR-TODOS))))
T
#+end_example
Finally, there are some simple helpers to handle some of the
boilerplate in a clack webserver. Of particular interest is the
=handler= macro, which (since this is a json-only API) makes sure
that all the API results get JSON encoded.
#+NAME: routing-helpers
#+BEGIN_SRC lisp
(defun success (value)
(list 200 '(:conent-type "application/json") value))
(defmacro handler ((&optional (sym (gensym "PARAMS"))) &body body)
`(lambda (,sym)
(declare (ignorable ,sym))
(success
(fwoar.lack.json.middleware:wrap-result
(progn ,@body)))))
#+END_SRC
** todo routes
=setup-routes= binds the endpoints to handlers: ="/"= to handlers
that handle the todo lists while ="/todo/:id"= to handlers that
handle individual todos. The =:id= indicates that the
corresponding segment of the path is bound to =:id= in the param
alist. =get-id= handles this, and extracts an integer for the id
(since we are using successive integers for the todo ids).
#+NAME: todo-routes
#+BEGIN_SRC lisp
;; routing
(defun get-id (params)
(parse-integer (serapeum:assocdr :id params)))
(defun setup-routes (app)
(defroutes app
("/" (:GET (handler () (todos)))
(:POST (handler (v) (new-todo v)))
(:DELETE (handler () (clear-todos))))
("/todo/:id" (:GET (handler (v) (todo (get-id v))))
(:DELETE (handler (v)
(delete-todo (get-id v))
nil))
(:PATCH (handler (v)
(update-todo (get-id v)
(remove :id v :key #'car)))))))
#+END_SRC
* Source
** model.lisp source code
#+BEGIN_SRC lisp :tangle model.lisp :noweb yes :comments noweb
<<package-include>>
<<model-utils>>
(defvar *todos* (fset:empty-map))
<<todolist-manipulation>>
<<todo-accessor>>
<<new-todo>>
<<update-todo>>
(defmacro with-fresh-todos (() &body body)
`(let ((*todos* (fset:empty-map)))
,@body))
#+END_SRC
** routing.lisp source
#+BEGIN_SRC lisp :tangle routing.lisp :noweb yes :comments noweb
<<package-include>>
<<defroutes>>
<<routing-helpers>>
<<todo-routes>>
#+END_SRC
** main.lisp source
#+BEGIN_SRC lisp :tangle main.lisp :noweb yes
<<package-include>>
;;; entrypoint
(defun setup ()
(let ((app (make-instance 'ningle:<app>)))
(prog1 app (setup-routes app))))
(defvar *handler*)
(defun is-running ()
(and (boundp '*handler*)
,*handler*))
(defun ensure-started (&rest r &key (address "127.0.0.1") (port 5000))
(declare (ignore address port))
(let ((app (setup)))
(values app
(setf *handler*
(if (not (is-running))
(apply 'clack:clackup
(lack.builder:builder
:accesslog
'fwoar.lack.cors.middleware:cors-middleware
'fwoar.lack.json.middleware:json-middleware
app)
r)
,*handler*)))))
(defun stop ()
(if (is-running)
(progn
(clack:stop *handler*)
(makunbound '*handler*)
nil)
nil))
(defun main (&rest _)
(declare (ignore _))
(ensure-started :address "0.0.0.0" :port 5000)
(loop (sleep 5)))
#+END_SRC
#+NAME: package-include
#+BEGIN_SRC lisp :tangle no :exports none
(in-package :fwoar.todo)
#+END_SRC
#+NAME: model-utils
#+BEGIN_SRC lisp :tangle no :exports none
(defparameter *cur-id* 0)
(defun next-id ()
(incf *cur-id*))
(defparameter *completed-lens*
(data-lens.lenses:make-hash-table-lens "completed"))
(defun bool-to-yason (bool)
(if bool
'yason:true
'yason:false))
#+END_SRC
#+NAME: example-setup
#+BEGIN_SRC lisp :tangle no :noweb yes :exports none
<<package-include>>
(load "pprint-setup")
#+END_SRC
#+HTML_HEAD: <style>
#+HTML_HEAD: :root {
#+HTML_HEAD: --zenburn-fg-plus-2: #ffffef;
#+HTML_HEAD: --zenburn-fg-plus-1: #f5f5d6;
#+HTML_HEAD: --zenburn-fg: #dcdccc;
#+HTML_HEAD: --zenburn-bg: #3f3f3f;
#+HTML_HEAD: --zenburn-bg-plus-1: #4f4f4f;
#+HTML_HEAD: --zenburn-bg-plus-2: #5f5f5f;
#+HTML_HEAD: --zenburn-blue: #8cd0d3;
#+HTML_HEAD: }
#+HTML_HEAD:
#+HTML_HEAD: #table-of-contents h2 {
#+HTML_HEAD: text-align: center;
#+HTML_HEAD: padding-top: 3.5em;
#+HTML_HEAD: }
#+HTML_HEAD:
#+HTML_HEAD: #table-of-contents {
#+HTML_HEAD: width: 25rem;
#+HTML_HEAD: position: fixed;
#+HTML_HEAD: left: 0;
#+HTML_HEAD: top: 0;
#+HTML_HEAD: height: 100%;
#+HTML_HEAD: overflow-y: scroll;
#+HTML_HEAD: scrollbar-width: thin;
#+HTML_HEAD: }
#+HTML_HEAD:
#+HTML_HEAD: #table-of-contents::-webkit-scrollbar { width :6px; }
#+HTML_HEAD:
#+HTML_HEAD: * {box-sizing: border-box;}
#+HTML_HEAD:
#+HTML_HEAD: body {
#+HTML_HEAD: font-size: 1.2rem;
#+HTML_HEAD: width: 75rem;
#+HTML_HEAD: margin: 0 0 0 25rem;
#+HTML_HEAD: background: var(--zenburn-bg);
#+HTML_HEAD: color: var(--zenburn-fg);
#+HTML_HEAD: font-family: "Alegreya Sans", "Lato", "Roboto", "Open Sans", "Helvetica", sans-serif;
#+HTML_HEAD: }
#+HTML_HEAD:
#+HTML_HEAD: a {color: var(--zenburn-blue);}
#+HTML_HEAD:
#+HTML_HEAD: h1, h2, h3, h4, h5, h6 {margin: 0; margin-top: 1.5em; margin-bottom: 0.5em;}
#+HTML_HEAD:
#+HTML_HEAD: pre {margin: 0; box-shadow: none; border-width: 0.5em;}
#+HTML_HEAD:
#+HTML_HEAD: pre.example {
#+HTML_HEAD: background-color: var(--zenburn-bg-plus-2);
#+HTML_HEAD: color: var(--zenburn-fg-plus-2);
#+HTML_HEAD: border: none;
#+HTML_HEAD: padding-left: 4em;
#+HTML_HEAD: }
#+HTML_HEAD:
#+HTML_HEAD: pre.src {
#+HTML_HEAD: background-color: var(--zenburn-bg-plus-1);
#+HTML_HEAD: border-color: var(--zenburn-bg-plus-2);
#+HTML_HEAD: color: var(--zenburn-fg-plus-1);
#+HTML_HEAD: }
#+HTML_HEAD:
#+HTML_HEAD: pre.src::before {
#+HTML_HEAD: background-color: var(--zenburn-bg-plus-1);
#+HTML_HEAD: border-color: var(--zenburn-bg-plus-2);
#+HTML_HEAD: color: var(--zenburn-fg-plus-1);
#+HTML_HEAD: }
#+HTML_HEAD: </style>
# Local Variables:
# after-save-hook: (lambda nil (org-babel-tangle) (when (org-html-export-to-html) (rename-file "README.html" "docs/index.html" t)))
# End: