#+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: