new file mode 100644

@@ -0,0 +1,2 @@

+*.fasl

+*~

new file mode 100644

@@ -0,0 +1,23 @@

+(in-package :fwoar.lack.cors.middleware)

+;; cors middleware

+(defparameter *acao-lens*

+  (data-lens:<>1 (data-lens.lenses:make-list-lens 1)

+                 (data-lens.lenses:make-plist-lens :Access-Control-Allow-Origin)))

+(defparameter *acah-lens*

+  (data-lens:<>1 (data-lens.lenses:make-list-lens 1)

+                 (data-lens.lenses:make-plist-lens :Access-Control-Allow-Headers)))

+(defparameter *acam-lens*

+  (data-lens:<>1 (data-lens.lenses:make-list-lens 1)

+                 (data-lens.lenses:make-plist-lens :Access-Control-Allow-Methods)))

+

+(defun cors-middleware (app)

+  (lambda (env)

+    (rutilsx.threading:->>

+     (if (eq :options

+             (getf env :request-method))

+         '(200 nil nil)

+         (let ((res (funcall app env)))

+           res))

+     (data-lens.lenses:set *acao-lens* "*")

+     (data-lens.lenses:set *acah-lens* "Content-Type")

+     (data-lens.lenses:set *acam-lens* "GET,POST,DELETE,PATCH"))))

new file mode 100644

@@ -0,0 +1,36 @@

+(in-package :fwoar.lack.json.middleware)

+

+;; json middleware

+(defparameter *result-lens*

+  (data-lens.lenses:make-list-lens 2))

+

+(defun json-middleware (app)

+  (lambda (env)

+    (let ((res (funcall app env)))

+      (data-lens.lenses:over *result-lens* 'encode-result

+                             res))))

+

+(defun encode-json-to-string (v)

+  (yason:with-output-to-string* (:indent t)

+    (yason:encode v

+                  yason::*json-output*)))

+

+(defclass json-result ()

+  ((%v :initarg :v :reader json-value)))

+

+(defun wrap-result (v)

+  (make-instance 'json-result :v v))

+

+(defgeneric encode-result (v)

+  (:method (v)

+    v)

+  (:method ((v json-result))

+    (list (encode-json-to-string (json-value v)))))

+

+(defmethod yason:encode ((o fset:seq) &optional s)

+  (yason:encode (coerce (fset:convert 'list o) 'vector)

+                s))

+

+(defmethod yason:encode ((o fset:map) &optional s)

+  (yason:encode (fset:convert 'hash-table o)

+                s))

new file mode 100644

@@ -0,0 +1,35 @@

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

+  (declare (ignore 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))

new file mode 100644

@@ -0,0 +1,50 @@

+(in-package :fwoar.todo)

+

+;; todo "database" api

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

+

+(defun todos ()

+  (gmap:gmap :seq

+             (lambda (_ b)

+               (declare (ignore _))

+               b)

+             (:map *todos*)))

+

+(defun todo (id)

+  (let ((todo (fset:@ *todos* id)))

+    todo))

+

+(defun (setf todo) (new-value id)

+  (setf *todos*

+        (fset:with *todos* id new-value))

+  new-value)

+

+(defun delete-todo (id)

+  (setf *todos*

+        (fset:less *todos* id)))

+

+(defparameter *cur-id* 0)

+(defun next-id ()

+  (incf *cur-id*))

+

+(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://localhost:5000/todo/~d" id)))

+           :test 'equal))))

+

+(defun clear-todos ()

+  (setf *todos*

+        (fset:empty-map)))

+

+(defun update-todo (id v)

+  (setf (todo id)

+        (serapeum:merge-tables (or (todo id)

+                                   (make-hash-table :test 'equal))

+                               (alexandria:alist-hash-table

+                                v

+                                :test 'equal))))

new file mode 100644

@@ -0,0 +1,11 @@

+(defpackage :fwoar.lack.json.middleware

+  (:use :cl)

+  (:export #:json-middleware))

+

+(defpackage :fwoar.lack.cors.middleware

+  (:use :cl)

+  (:export #:cors-middleware))

+

+(defpackage :fwoar.todo

+  (:use :cl)

+  (:export ))

new file mode 100644

@@ -0,0 +1,38 @@

+(in-package :fwoar.todo)

+

+(defmacro defroutes (app &body routes)

+  "Define a set of routes for given paths. the ROUTES parameter expects this format:

+   ((\"/path/to/{route}\" :method :POST) route-callback) the AS-ROUTE macro helps one

+   avoid binding function values to the route for flexibility."

+  (alexandria:once-only (app)

+    `(progn

+       ,@(loop for ((target &key method) callback) in routes

+               collect `(setf (ningle:route ,app ,target :method ,(or method :GET)) ,callback)))))

+

+

+;; routing

+(defun success (value)

+  (list 200 nil value))

+

+(defmacro handler ((&optional (sym (gensym "PARAMS"))) &body body)

+  `(lambda (,sym)

+     (declare (ignorable ,sym))

+     (success

+      (fwoar.lack.json.middleware::wrap-result

+       (progn ,@body)))))

+

+(defun get-id (params)

+  (parse-integer (serapeum:assocdr :id params)))

+

+(defun setup-routes (app)

+  (defroutes app

+    (("/" :method :GET)            (handler () (todos)))

+    (("/" :method :POST)           (handler (v) (new-todo v)))

+    (("/" :method :DELETE)         (handler () (clear-todos)))

+    (("/todo/:id" :method :GET)    (handler (v) (todo (get-id v))))

+    (("/todo/:id" :method :DELETE) (handler (v)

+                                     (delete-todo (get-id v))

+                                     nil))

+    (("/todo/:id" :method :PATCH)  (handler (v)

+                                     (update-todo (get-id v) 

+                                                  (remove :id v :key #'car))))))

new file mode 100644

@@ -0,0 +1,25 @@

+;;; -*- Mode:Lisp; Syntax:ANSI-Common-Lisp; Package: ASDF-USER -*-

+(in-package :asdf-user)

+

+(defsystem :todo-backend 

+  :description ""

+  :author "Ed L <edward@elangley.org>"

+  :license "MIT"

+  :depends-on (#:alexandria

+               #:uiop

+               #:serapeum

+               #:yason

+               #:fset

+               #:ningle

+               #:alexandria

+               #:clack)

+  :components ((:file "package")

+               (:file "lack-cors-middleware" :depends-on ("package"))

+               (:file "lack-json-middleware" :depends-on ("package"))

+               (:file "model" :depends-on ("package"))

+               (:file "routing" :depends-on ("package"

+                                             "model"))

+               (:file "main" :depends-on ("package"

+                                          "routing"

+                                          "lack-cors-middleware"

+                                          "lack-json-middleware"))))