TODO backend implementation using CL and fukamachi/ningle

1. Setup
2. todo API
3. Routing
- 3.1. Routing utilities
- 3.2. todo routes
4. Source

1 Setup

git clone https://github.com/fiddlerwoaroof/data-lens.git ~/quicklisp/local-projects/data-lens
git clone https://github.com/fukamachi/lack.git ~/quicklisp/local-projects/lack

sbcl --eval '(asdf:load-asd (truename "todo-backend.asd"))' 
     --eval '(ql:quickload :todo-backend)' 
     --eval '(fwoar.todo::ensure-started)'

After this, all the tests here should pass and the frontend here should work.

2 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.

2.1 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.

(defun todos ()
  (gmap:gmap :seq
             (lambda (_ b)
               (declare (ignore _))
               b)
             (:map *todos*)))

(defun clear-todos ()
  (setf *todos*
        (fset:empty-map)))

2.2 Getting/Replacing a todo

This uses lisp's 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.

(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)))

2.3 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.

(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))))

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.

(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))))

2.4 Examples

(in-package :fwoar.todo)

(load "pprint-setup")

(with-fresh-todos ()
  (new-todo '(("title" . "get groceries")))
  (new-todo '(("title" . "write-better-documentation")))
  (fset:convert 'list (todos)))

(#<hash-table "url": "http://localhost:5000/todo/1",
              "title": "get groceries",
              "completed": YASON:FALSE>
 #<hash-table "url": "http://localhost:5000/todo/2",
              "title": "write-better-documentation",
              "completed": YASON:FALSE>)

3 Routing

3.1 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.

(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))))))

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.

(macroexpand-1
 '(defroutes app
   ("/"
    (:GET (handler () (todos)))
    (:POST (handler (v) (new-todo v)))
    (:DELETE (handler () (clear-todos))))))

(DEFROUTES APP
 ("/" (:GET (HANDLER NIL (TODOS))) (:POST (HANDLER (V) (NEW-TODO V)))
  (:DELETE (HANDLER NIL (CLEAR-TODOS)))))
NIL

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.

(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)))))

3.2 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).

;; 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)))))))

4 Source

4.1 model.lisp source code

;; [[file:~/git_repos/lisp-sandbox/todo/README.org::package-include][package-include]]
(in-package :fwoar.todo)

;; package-include ends here
;; [[file:~/git_repos/lisp-sandbox/todo/README.org::model-utils][model-utils]]
(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))
;; model-utils ends here

(defvar *todos* (fset:empty-map))

;; [[file:~/git_repos/lisp-sandbox/todo/README.org::todolist-manipulation][todolist-manipulation]]
(defun todos ()
  (gmap:gmap :seq
             (lambda (_ b)
               (declare (ignore _))
               b)
             (:map *todos*)))

(defun clear-todos ()
  (setf *todos*
        (fset:empty-map)))
;; todolist-manipulation ends here

;; [[file:~/git_repos/lisp-sandbox/todo/README.org::todo-accessor][todo-accessor]]
(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)))
;; todo-accessor ends here

;; [[file:~/git_repos/lisp-sandbox/todo/README.org::new-todo][new-todo]]
(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))))
;; new-todo ends here

;; [[file:~/git_repos/lisp-sandbox/todo/README.org::update-todo][update-todo]]
(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))))
;; update-todo ends here

(defmacro with-fresh-todos (() &body body)
  `(let ((*todos* (fset:empty-map)))
     ,@body))

4.2 routing.lisp source

;; [[file:~/git_repos/lisp-sandbox/todo/README.org::package-include][package-include]]
(in-package :fwoar.todo)

;; package-include ends here

;; [[file:~/git_repos/lisp-sandbox/todo/README.org::defroutes][defroutes]]
(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))))))
;; defroutes ends here

;; [[file:~/git_repos/lisp-sandbox/todo/README.org::routing-helpers][routing-helpers]]
(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)))))
;; routing-helpers ends here

;; [[file:~/git_repos/lisp-sandbox/todo/README.org::todo-routes][todo-routes]]
;; 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)))))))
;; todo-routes ends here

4.3 main.lisp source

(in-package :fwoar.todo)

;;; 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)))