cl-deck-builder2/src/web/category.lisp

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