|
- (in-package #:cl-deck-builder2.web)
-
- (defparameter *current-category* nil)
-
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- (defun render-category (id &key (tpl #P"category/index.html") env)
- "Helper function. Use RENDER-WITH-ENV to display template TPL with environment ENV.
-
- ID is the CATEGORY we wish to render.
-
- TODO etypecase? defmethod?"
- (let ((found (ignore-errors
- (find-dao 'category :id id))))
- (render-with-env tpl
- (append env
- `(:active "/category"
- :category ,found
- :categories ,(select-category)
- :children ,(ignore-errors (category-full-tree :node.name (category-name-of found)))
- :id ,(ignore-errors (mito:object-id found)))))))
-
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- (defroute ("/category" :method :GET) (&key _parsed)
- "Category Viewer Main Route.
-
- TODO Parameters: ID The desired CATEGORY ID."
- (with-logged-in-user
- (render-category (query-param "id" _parsed))))
-
- (defroute ("/category/search" :method :POST) (&key _parsed)
- "POST Category Search Route.
-
- TODO Implement this?"
- (with-logged-in-user
- (render-category (query-param "id" _parsed))))
-
- (defroute ("/category/:id/view" :method :GET) (&key id)
- "Category Viewer Single Route.
-
- TODO Parameters: ID The desired CATEGORY ID."
- (with-logged-in-user
- (render-category id)))
-
- (defroute ("/category/list" :method :GET) (&key _parsed)
- "GET route for the list of categories."
- (v:info :web "GET /category/list => ~a" _parsed)
-
- (with-logged-in-user
- (render-category (query-param "id" _parsed))))
-
- (defroute ("/category/:id/delete" :method :DELETE) (&key id)
- "DELETE a CATEGORY.
-
- TODO Parameters: ID The ID of the CATEGORY to remove.
- TODO Also delete associated deck metadata?"
- (v:info :web "DELETE /category/:id/delete" id)
-
- (handler-case
- (ratify:with-parsed-forms
- ((:integer id))
- (let ((found (find-dao 'category :id id)))
- (when found
- (category-delete-tree (category-name-of found))
- (v:info :web "DELETE /category/:id/delete OK" id)
- (flash-message (_ "Success!")))))
- (ratify:combined-error (e)
- (flash-error e))))
-
- (defroute ("/category/:id/rename" :method :POST) (&key id _parsed)
- "POST route to RENAME a CATEGORY.
-
- TODO Parameters: NAME The new name of the CATEGORY. ID of the CATEGORY to be RENAMEd."
- (v:info :web "POST /category/~d/rename => ~a" id _parsed)
-
- (let ((name (query-param "name" _parsed)))
- (handler-case
- (ratify:with-parsed-forms
- ((:integer id)
- (:string name))
- (if (category-rename (find-dao 'category :id id) name)
- (format nil "OK!")
- (format nil "Error!")))
- (ratify:combined-error (e)
- (flash-error e)))))
-
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
- (defroute ("/category/fake-data" :method :GET) ()
- "Route to generate new fake CATEGORY data.
-
- TODO Parameters: NAME The name of the new child CATEGORY. ID The parent of the new child CATEGORY."
-
- (v:info :web "GET /category/fake-data")
- (category-insert-fake-data)
- (v:info :web "GET /category/fake-data OK"))
-
- (defroute ("/category/new-parent" :method :POST) (&key _parsed)
- "Create a new parent by NAME. We use CATEGORY-INSERT-RIGHT-OF."
- (v:info :web "POST /category/new-parent => ~a" _parsed)
-
- (let ((id (or (query-param "id" _parsed) 0))
- (name (query-param "name" _parsed)))
- (handler-case
- (ratify:with-parsed-forms
- ((:integer id)
- (:string name))
- (let ((left-of (ignore-errors
- (category-name-of (find-dao 'category :id id)))))
- (category-insert-right-of name left-of)))
- (ratify:combined-error (e)
- (flash-error e)))))
-
- (defroute ("/category/new-child" :method :POST) (&key _parsed)
- "POST route for a new child CATEGORY.
-
- TODO Parameters: NAME The name of the new child CATEGORY. ID The parent of the new child CATEGORY."
- (v:info :web "POST /category/new-child => ~a" _parsed)
-
- (let ((id (query-param "id" _parsed))
- (name (query-param "name" _parsed)))
- (handler-case
- (ratify:with-parsed-forms
- ((:integer id)
- (:string name))
- (let ((left-of (ignore-errors
- (category-name-of (find-dao 'category :id id)))))
- (category-insert-new-child name left-of)
- (format nil "OK!")))
- (ratify:combined-error (e)
- (flash-error e)))))
-
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- (defroute ("/category/explain" :method :GET) ()
- "TODO This needs to be incorporated into the documentation."
- (with-logged-in-user
- (render-with-env #P"category/explain.html"
- `(:active "/category"
- :categories ,(select-category)))))
|