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

#|

src/web/decks.lisp

Deck Overview Web Interface

Here we see the cards in the deck, we have the option to generate
deck images, and we have the option to pull the deck from
inventory.

|#

(in-package #:cl-deck-builder2.web)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; TODO both YDK-DATA-TO-TEMPLATE and RENDER-YDK desperately need an overhaul.
(defun ydk-to-template-data (ydk)
  "Transform information from YDK-QUERY on YDK into: main, side, extra decks, with RLE encodings of all three, plus metadata."
  (let ((data (ydk-query ydk)))
    (when data
      (labels ((filter-kind (lst kind)
                 (remove-if
                  (lambda (card)
                    (if (eq (getf card :kind) kind)
                        nil
                        t))
                  (reverse lst))))
        (let ((main-deck (filter-kind data 0))
              (extra-deck (filter-kind data 1))
              (side-deck (filter-kind data 2)))
          (list
           :name (ydk-name-of ydk)
           :created-by (ydk-created-by ydk)

           :main-deck main-deck
           :extra-deck extra-deck
           :side-deck side-deck

           :main-deck-rle (rle-encode-plist main-deck :key (lambda (plist) (getf plist :name)) :test #'string=)
           :extra-deck-rle (rle-encode-plist extra-deck :key (lambda (plist) (getf plist :name)) :test #'string=)
           :side-deck-rle (rle-encode-plist side-deck :key (lambda (plist) (getf plist :name)) :test #'string=)))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; TODO This is ugly still. Fix it.
(defun draw-deck-image-by-id (id)
  (let ((found (find-dao 'ydk-deck :id id)))
    (when found
      (let ((ydk (ydk-sync found)))
        (draw-deck-image ydk (ydk-name-of ydk))))))

;; TODO this only works with decks from the database as it uses
;; YDK-DECK-INFO-BY-ID, making the name of this function a
;; misnomer. It should be RENDER-YDK-BY-DECK-ID. I'd use YDK-QUERY for
;; now beacuse that nets you INNER-JOIN with fields coming from
;; datafly as an associated list... sloppy work.
(defun render-ydk (id tpl)
  "Render a YDK-DECK from the databse with ID using template TPL. We also use YDK-TO-TEMPLATE-DATA to query additional deck information."
  (let ((found (ydk-deck-by-id id)))
    (if found
        (render-with-env
         tpl
         (append
          (list :active "/decks"
                :id id
                :category (with-connection (db)
                            (ydk-category-of found))
                :saved-deck-list (select-ydk-deck)
                :saved-category-list (select-category)
                :files (probe-image-files-list
                        (ydk-name-of found)))
          (ydk-to-template-data found)))
        (_ "Nothing to see here..."))))

(defgeneric ydk-listing-as (id tpl)
  (:documentation "Looks like this is a kludge to accept ID as a string or integer. TODO Move to generics.lisp")
  (:method ((id string) (tpl pathname))
    (ydk-listing-as (parse-integer id) tpl))
  (:method ((id integer) (tpl pathname))
    (render-ydk id tpl)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defroute ("/decks" :method :GET) (&key _parsed)
  "Deck List Main Route. Login Required."
  (with-logged-in-user
    (let ((id (query-param "deck-load-id" _parsed)))
      (if id
          (let ((found (ydk-deck-by-id id)))
            (render-with-env #P"decks/index.html"
                             `(:active "/decks"
                               :files ,(probe-image-files-list (ydk-name-of found))
                               :id ,id
                               :category ,(ydk-category-of found)
                               :saved-deck-list ,(select-ydk-deck)
                               :saved-category-list ,(select-category))))
          (render-with-env #P"decks/index.html"
                           `(:active "/decks"
                             :saved-deck-list ,(select-ydk-deck)
                             :saved-category-list ,(select-category)))))))

(defroute ("/decks/:id/view" :method :GET) (&key id)
  "Deck Viewer Main Route. Login Required. View YDK-DECK with YDK-DECK-BY-ID. Uses RENDER-YDK."
  (with-logged-in-user
    (handler-case
        (ratify:with-parsed-forms
            ((:integer id))
          (let ((found (ydk-deck-by-id id)))
            (if found
                (render-ydk id #P"decks/index.html")
                (progn
                  (flash-error (format nil (_ "No Deck ID ~d") id))
                  (render-with-env #P"decks/index.html"
                                   `(:active "/decks"
                                     :saved-deck-list ,(select-ydk-deck)
                                     :saved-category-list ,(select-category)))))))
      (ratify:combined-error (e)
        (flash-error (format nil "~a~%" e))
        (render-with-env #P"decks/index.html"
                         `(:active "/decks"
                           :saved-deck-list ,(select-ydk-deck)
                           :saved-category-list ,(select-category)))))))

(defroute ("/decks/:id/generate-cover-images" :method :GET) (&key id)
  "Deck Viewer - Generate Cover Image. Login Required. Render a static image and display it with DECK-IMAGE-LISTING template."
  (v:info :decks "GET /decks/~d/generate-cover-images" id)

  (with-logged-in-user
    (handler-case
        (ratify:with-parsed-forms
            ((:integer id))
          (if (draw-deck-image-by-id id)
              (ydk-listing-as id #P"decks/deck-image-listing.html")
              (_ "Something went wrong. Try again?")))
      (ratify:combined-error (e)
        (flash-error e)))))

(defroute ("/decks/:id/delete-generated-images" :method :DELETE) (&key id)
  "Deck Viewer - Delete Generate Cover Image. Login Required."
  (v:info :decks "DELETE /decks/~d/delete-generated-images" id)

  (with-logged-in-user
    (handler-case
        (ratify:with-parsed-forms
            ((:integer id))
          (let ((found (ydk-deck-by-id id)))
            (when found
              (if (notany #'null
                          (mapcar #'uiop:delete-file-if-exists
                                  (probe-image-files-list (ydk-name-of found) nil)))
                  (flash-message (_ "Success!"))
                  (flash-error (_ "Something went wrong. Try again?"))))))
      (ratify:combined-error (e)
        (flash-error e)))))

(defroute ("/decks/:id/to-category" :method :POST) (&key id _parsed)
  "POST route to send deck ID to category ID."
  (v:info :decks "POST /decks/~d/to-category._parsed = ~a~%" id _parsed)

  (with-logged-in-user
    (let ((cat-id (query-param "category-id" _parsed)))
      (handler-case
          (ratify:with-parsed-forms
              ((:integer id)
               (:integer cat-id))
            (let ((found (ydk-deck-by-id id)))
              (when found
                (setf (ydk-category-of found)
                      (find-dao 'category :id cat-id))
                (with-connection (db)
                  (mito:save-dao found))
                (render-with-env #P"decks/category-select.html"
                                 `(:category-id ,(mito:object-id
                                                  (ydk-category-of found))
                                   :deck-id ,(mito:object-id found)
                                   :categories ,(select-category))))))
        (ratify:combined-error (e)
          (flash-error e))))))

(defroute ("/decks/:id/rename" :method :POST) (&key id _parsed)
  "Deck Viewer - Rename deck ID with new name. Will also rename the generated image files, if they exist."
  (v:info :decks "GET /decks/~d/rename._parsed = ~a~%" id _parsed)

  (with-logged-in-user
    (let ((name (query-param "name" _parsed)))
      ;; We want to change the name of LOAD-NAME to CREATE-NAME.
      (handler-case
          (ratify:with-parsed-forms
              ((:integer id)
               (:string name))
            (let ((found (ydk-deck-by-id id)))
              ;; Ahaha that was a fun hunt. Using YDK-DECK-RENAME
              ;; before RENAME-FILES caused the OLD-NAME in
              ;; RENAME-FILES to be NEW-NAME... Rename the files
              ;; before renaming the database entry.
              (v:info :decks "RENAME ~a => ~a" (ydk-name-of found) name)
              (ydk-rename-files (ydk-name-of found) name)
              (ydk-rename-deck found name)
              (flash-message
               (format nil "Found entry ~A (~d); renaming to ~a.~%"
                       (ydk-name-of found) id name))
              (redirect (format nil "/decks/~d/view" id) 302)))
        (ratify:combined-error (e)
          (flash-error e))))))

(defroute ("/decks/:id/pull" :method :GET) (&key id)
  "Pull deck ID using YDK-DECK-PULL-FROM-INVENTORY.

TODO I think This is outdated."
  (v:info :decks "GET /decks/~d/pull" id)

  ;; We want to "pull" the deck from inventory. That is, take the list
  ;; of cards in the deck and remove them from the inventory count.
  
  (with-logged-in-user
    (handler-case
        (ratify:with-parsed-forms
            ((:integer id))
          (let ((found (ydk-deck-by-id id)))
            ;; The deck exists by ID
            (when found
              (let ((pulled (ydk-deck-pull-from-inventory found)))
                (if pulled
                    (progn
                      (flash-message
                       (format nil "Found entry ~A (~d); pulling cards.~%"
                               (ydk-name-of found) id))
                      (redirect (format nil "/construct/~d/view"
                                        (mito:object-id pulled))
                                302))
                    (flash-message
                     (format nil "Unable to pull deck ~d?~%" id)))))))
      (ratify:combined-error (e)
        (flash-error e)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defroute ("/decks/cards-in-decks" :method :GET) (&key _parsed)
  "Route to display all the unique cards in all decks."
  (v:info :decks "GET /decks/cards-in-decks => ~a" _parsed)
  
  (render #P"decks/cards-in-decks.html"
          (list :active "/decks"
                :table (cards-in-all-decks))))

(defroute ("/decks/:id/name" :method :GET) (&key id)
  "Route to display the name of the YDK-DECK by this ID.

TODO This should be a batch request."
  (with-logged-in-user
    (handler-case
        (ratify:with-parsed-forms
            ((:integer id))
          (let ((found (ydk-deck-by-id id)))
            (if found
                ;; Deck names like "29036" are coming back as INTEGER
                ;; which is causing issues with Caveman2. It seems to
                ;; use REDUCE #'LENGTH to measure the content length.
                ;; It didn't like: (LENGTH 29036)
                (princ-to-string (ydk-name-of found))
                (_ "No Name")))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defroute ("/decks/by-category/:id" :method :GET) (&key id _parsed)
  "Query a list of decks by category."
  (v:info :decks "GET /decks/by-category/~d => ~a" id _parsed)
  
  (with-logged-in-user
    (render #P"decks/decks-by-category.html"
            (list :active "/decks"
                  :table (by-category 'ydk-deck id)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; All the various kinds of deck representations: HTML, HTML as Text,
;; Text as Text Area, Resulting Deck File Images
(defroute ("/decks/:id/html-listing" :method :GET) (&key id _parsed)
  "Helper route. Get the builder HTML listing using YDK-LISTING-AS and DECK-HTML-RESULTS template."
  (v:info :decks "GET /decks/~d/html-listing => ~a" id _parsed)

  (with-logged-in-user
    (ydk-listing-as id #P"decks/deck-html-results.html")))

(defroute ("/decks/:id/html-text-listing" :method :GET) (&key id _parsed)
  "Helper route. Get the HTML listing using YDK-LISTING-AS and DECK-TEXT-THREE-COLUMN template."
  (v:info :decks "GET /decks/~d/html-text-listing => ~a" id _parsed)

  (with-logged-in-user
    (ydk-listing-as id #P"decks/deck-text-three-column.html")))

(defroute ("/decks/:id/text-listing" :method :GET) (&key id _parsed)
  "Helper route. Get the text listing using YDK-LISTING-AS and DECK-TEXT-TEXTAREA template."
  (v:info :decks "GET /decks/~d/text-listing => ~a" id _parsed)

  (with-logged-in-user
    (ydk-listing-as id #P"decks/deck-text-textarea.html")))

(defroute ("/decks/:id/text-listing-with-brs" :method :GET) (&key id _parsed)
  "Helper route. Get the text listing using YDK-LISTING-AS and DECK-TEXT-TEXTAREA template with <brs>."
  (v:info :decks "GET /decks/~d/text-listing-with-brs => ~a" id _parsed)

  (with-logged-in-user
    (ydk-listing-as id #P"decks/deck-text-textarea-with-brs.html")))

(defroute ("/decks/:id/image-listing" :method :GET) (&key id _parsed)
  "Helper route. Get the image listing using YDK-LISTING-AS and DECK-IMAGE-LISTING template."
  (v:info :decks "GET /decks/~d/text-listing => ~a" id _parsed)

  (with-logged-in-user
    (ydk-listing-as id #P"decks/deck-image-listing.html")))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defroute ("/decks/:id/delete" :method :DELETE) (&key id)
  "Delete Deck by ID."
  (v:info :builder "DELETE /decks/:id/delete => ~a" id)

  (with-logged-in-user
    (handler-case
        (ratify:with-parsed-forms
            ((:integer id))
          (ydk-deck-delete-by-id id)
          (flash-message (format nil (_ "Deck ~a deleted success!" id))))
      (ratify:combined-error (e)
        (flash-error e)))

    (redirect "/decks")))

(defroute ("/decks/search" :method :GET) (&key _parsed)
  "Deck Viewer Search Main Route."
  (v:info :builder "GET /decks/search => ~a" _parsed)

  (with-logged-in-user
    (render-with-env #P"decks/search.html"
                     (list :active "/decks"))))

(defroute ("/decks/search" :method :POST) (&key _parsed)
  "Deck Viewer Search POST route.

TODO Ensure this is functional."
  (v:info :builder "GET /decks/search => ~a" _parsed)

  (with-logged-in-user
    (let* ((name (query-param "name" _parsed))
           (decks (select-ydk-deck
                    (sxql:where (%sxql-like :name name)))))

      (render-with-env #P"decks/search.html"
                       (list :active "/decks"
                             :decks decks)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; XXX Duplicate code from /builder/saved-deck-list
(defroute ("/decks/deck-select" :method :GET) (&key |id|)
  "Deck Select Route Helper."
  (with-logged-in-user
    (render-with-env #P"decks/deck-select.html"
                     (list :active "/decks"
                           :id (ignore-errors
                                (parse-integer |id|))
                           :decks (select-ydk-deck)))))

(defroute ("/decks/category-select" :method :GET) (&key |deck-id| |category-id|)
  "Category Select Route Helper.
TODO Return Sub-categories."
  (with-logged-in-user
    (render-with-env #P"decks/category-select.html"
                     (list :active "/decks"
                           :category-id (ignore-errors
                                         (parse-integer |category-id|))
                           :deck-id (ignore-errors
                                     (parse-integer |deck-id|))
                           :categories (select-category)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defroute ("/decks/kde/:id" :method :GET) (&key id)
  "KDE Team Deck List Viewer. View Deck by ID"
  (render-with-env #P"kde-team.html"
                   (ydk-to-kde
                    (ydk-sync
                     (ydk-deck-by-id id)))))