git.fiddlerwoaroof.com
name mode size
..
workflows 040000
README.org
#+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: