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

#|

src/web/builder.lisp

"The Deck Builder"

I figure we can also put YDK stuff here since they sorta do the
same thing. Since CSV import comes from Crystal Commerce I've left
that in the crystal-commerce file.

"The old one used to just have a list of cards, and you would
click it, and add it to the deck."
 - Yuki, ~July 2023

TODO I think some of these modules are going to have conflicting
names, e.g. RENDER-SAVED-DECK-LIST and SAVED-DECK-LIST ... Maybe
I ought to start packaging this up.

|#

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

;; TODO Not in use yet.
;; I really should be using https://github.com/40ants/reblocks
(defclass builder-session ()
  ((current-deck :accessor builder-session-current-deck
                 :initform (make-instance 'ydk)
                 :initarg :deck))
  (:documentation "A BUILDER-SESSION encapsulates a deck building session."))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defparameter *current-deck* (make-instance 'ydk)
  "An instance of YDK that the builder uses as a working region.")

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun render-current-deck-list ()
  "Helper function. Render the current deck list from *CURRENT-DECK*.

The HTMX JS in the builder is what this gets output to."

  (let ((deck-info (ydk-query *current-deck*)))
    ;; No Deck info? Just return an empty list.
    (render-with-env #P"builder/current-deck-list.html"
                     `(:active "/builder"
                       :deck-id ,(ignore-errors (ydk-id-of *current-deck*))
                       :main-deck ,(ignore-errors (getf deck-info :main-deck))
                       :extra-deck ,(ignore-errors (getf deck-info :extra-deck))
                       :side-deck ,(ignore-errors (getf deck-info :side-deck))))))

(defun render-saved-deck-list (&optional id)
  "Helper function. Render the saved deck list from SAVED-DECK-LIST."
  (render-with-env #P"builder/saved-deck-list.html"
                   `(:active "/builder"
                     :current-deck-id ,(ignore-errors
                                        (ydk-id-of *current-deck*))
                     :id ,id
                     :saved-deck-list ,(select-ydk-deck))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Index route
(defroute ("/builder" :method :GET) (&key _parsed)
  "The builder home page. The *CURRENT-DECK* is used as a temporary workspace to create a YDK style deck listing."
  (v:info :builder "GET /builder => ~a" _parsed)

  (with-logged-in-user
    (render-results :active "/builder"
                    :class 'ygo-info
                    :params _parsed
                    :tpl #P"builder/index.html")))

(defroute ("/builder/current-deck-list" :method :GET) ()
  "The endpoint for RENDER-CURRENT-DECK-LIST.

TODO This should be re-written as a Redblocks Widget."

  ;; Haha, I moved the hack somewhere else. Now it's somebody elses
  ;; problem. I actually think I fixed the hack. This comment stays
  ;; for now.
  (with-logged-in-user
    (render-current-deck-list)))

(defroute ("/builder/saved-deck-list" :method :GET) ()
  "The endpoint for RENDER-SAVED-DECK-LIST.

TODO This should be re-written as a Redblocks Widget."
  (with-logged-in-user
    (render-saved-deck-list)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Search route
(defroute ("/builder/search" :method :POST) (&key _parsed)
  "Main deck builder card search route. Will return a list of data from YGOProDeck. Now souped up and using an ALIST to pass parameters around."
  (v:info :builder "POST /builder/search => ~a~%" _parsed)

  (with-logged-in-user
    (render-results :active "/builder"
                    :class 'ygo-info
                    :params _parsed
                    :tpl #P"builder/search-results.html")))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; POST ROUTES
;;
;; TODO Review Logic
;;
;; Always Extra, then Side
;; "fusion"
;; "link"
;; "ritual"
;; "synchro"
;; "xyz"
;; "fusion_pendulum"
;; "ritual_pendulum"
;; "synchro_pendulum"
;; "xyz_pendulum"
;;
;; TODO Pretty Gnarly!
(defroute ("/builder/add/:passcode" :method :POST) (&key passcode _parsed)
  "Try to add PASSCODE to *CURRENT-DECK*.

TODO Parameters: PASSCODE DECK"
  (v:info :builder "POST /builder/add/~d => ~a" passcode _parsed)

  ;; Clumsily enforce login
  (unless (logged-in-p)
    (_ "Oops"))

  (let ((passcode (ignore-errors
                   (parse-integer passcode)))
        (target-deck (alexandria:make-keyword
                      (string-upcase
                       (or
                        (query-param "deck" _parsed)
                        "MAIN")))))
    (when passcode
      (let* ((card-info (ygo-select-info-by-passcode passcode))
             (frame-type (ygo-frame-type-of card-info)))
        (labels ((is-special (frame-type)
                   (or
                    ;; First check what kind of monster it is
                    (string= "fusion" frame-type)
                    (string= "link" frame-type)
                    ;; Ritual cards go in the main deck...
                    ;; (string= "ritual" frame-type)
                    (string= "synchro" frame-type)
                    (string= "xyz" frame-type)
                    (string= "fusion_pendulum" frame-type)
                    ;; (string= "ritual_pendulum" frame-type)
                    (string= "synchro_pendulum" frame-type)
                    (string= "xyz_pendulum" frame-type)))
                 (try-add (frame-type passcode target-deck)
                   (v:info :builder "TRY-ADD ~a ~a ~a" frame-type passcode target-deck)
                   (cond ((is-special frame-type)
                          ;; It's a Special Summon - try to add it to the Extra Deck, then Side Deck.
                          (cond ((< (length (ydk-extra-deck-of *current-deck*)) +extra-deck-card-limit+)
                                 ;; Add to extra deck
                                 (ydk-add *current-deck* :extra passcode))
                                ((< (length (ydk-side-deck-of *current-deck*)) +extra-deck-card-limit+)
                                 ;; Add to side deck
                                 (ydk-add *current-deck* :side passcode))
                                (t (v:info :builder (_ "Deck ~a has too many cards~%") (ydk-name-of *current-deck*)))))
                         ;; So if we get here theoretically the card shouldn't be a "Special Summon"
                         ((and (eq target-deck :main)
                               (< (length (ydk-main-deck-of *current-deck*)) +main-deck-card-limit+))
                          ;; Add to main deck
                          (ydk-add *current-deck* target-deck passcode))
                         ((and (eq target-deck :extra)
                               (< (length (ydk-extra-deck-of *current-deck*)) +extra-deck-card-limit+)
                               (not (equal frame-type "ritual")))
                          ;; Add to extra deck
                          (ydk-add *current-deck* target-deck passcode))
                         ((and (eq target-deck :side)
                               (< (length (ydk-side-deck-of *current-deck*)) +extra-deck-card-limit+)
                               (not (equal frame-type "ritual")))
                          ;; Add to side deck
                          (ydk-add *current-deck* target-deck passcode)))))
          ;; TODO Where should we validate deck constrains? Here or ADD?
          ;; For now we'll do it here.
          (if (< (count passcode (ydk-concatenate *current-deck*)) 3)
              ;; There *are* fewer than three of this card in the deck...
              (try-add frame-type passcode target-deck)
              (flash-error (format nil (_ "Deck ~a has too many cards~%") (ydk-name-of *current-deck*))))))
      (setf (getf (response-headers *response*) :HX-Trigger) "deck-list-changed")
      (render-current-deck-list))))

(defroute ("/builder/remove" :method :POST) (&key _parsed)
  "Try to remove PASSCODE from *CURRENT-DECK*.

TODO Parameters: PASSCODE DECK"
  (v:info :builder "POST /builder/remove => ~a" _parsed)

  (let ((index (query-param "index" _parsed))
        (deck (query-param "deck" _parsed)))
    (handler-case
        (ratify:with-parsed-forms
            ((:integer index)
             (:string deck))
          (ydk-delete-index *current-deck* (alexandria:make-keyword (string-upcase deck)) index)
          (setf (getf (response-headers *response*) :HX-Trigger) "deck-list-changed"))
      (ratify:combined-error (e)
        (flash-error (princ-to-string e))
        (redirect "/builder" 302))))

  (render-current-deck-list))

(defroute ("/builder/clear" :method :POST) ()
  "Clear the *CURRENT-DECK* of any cards using YDK-CLEAR."
  (ydk-clear *current-deck*)
  (render-current-deck-list))

(defroute ("/builder/create" :method :POST) (&key _parsed)
  "Create a new deck. This will preserve some information from *CURRENT-DECK*, giving it a new name, and immediately synchronising it to the database. You may use the CLEAR route to erase the deck."
  (v:info :builder "POST /builder/create => ~a" _parsed)

  (let ((name (query-param "deck-create-name" _parsed)))
    (handler-case
        (ratify:with-parsed-forms
            ((:string name))
          (let ((found (ydk-deck-by-name name)))
            (if found
                ;; The deck already exists
                (progn
                  (flash-message
                         (format nil (_ "Deck ~a already exists in database; loading...") name))
                  (setf *current-deck* (ydk-sync found)))
                (progn
                  (flash-message
                         (format nil (_ "Creating deck ~a into database.") name))
                  (setf *current-deck*
                        (make-instance 'ydk
                                       :name name
                                       :created-by (user-name)
                                       :main-deck (ydk-main-deck-of *current-deck*)
                                       :extra-deck (ydk-extra-deck-of *current-deck*)
                                       :side-deck (ydk-side-deck-of *current-deck*)))
                  ;; Sync it to the database to save it to the
                  ;; names list - doesn't matter if it has no
                  ;; cards in it.
                  (let ((new (ydk-sync *current-deck*)))
                    (when new
                      (setf (ydk-id-of *current-deck*)
                            (mito:object-id new))))))))
      (ratify:combined-error (e)
        (flash-error e))))

  (render-saved-deck-list))

(defroute ("/builder/delete" :method :DELETE) (&key _parsed)
  "Delete the deck specified by DECK-CREATE-NAME in the HTML.

TODO Parameters: NAME The name of the deck to use YDK-DECK-DELETE-BY-NAME on."
  (v:info :builder "DELETE /builder/delete => ~a" _parsed)

  (let ((name (query-param "deck-create-name" _parsed)))
    (handler-case
        (ratify:with-parsed-forms
            ((:string name))
          (ydk-deck-delete-by-name name))
      (ratify:combined-error (e)
        (flash-error e))))

  (render-saved-deck-list))

(defroute ("/builder/save" :method :POST) ()
  "Save *CURRENT-DECK* to the database using YDK-SYNC. Return an updated deck listing with RENDER-CURRENT-DECK-LIST."
  (v:info :builder "POST /builder/save")

  (v:info :builder "~a" (ydk-sync *current-deck*))

  (render-current-deck-list))

(defroute ("/builder/load" :method :POST) (&key _parsed)
  "Load Deck POST Route. Load ID into *CURRENT-DECK*."
  (v:info :builder "POST /builder/load => ~a" _parsed)

  (let ((id (query-param "deck-load-id" _parsed)))
    (handler-case
        (ratify:with-parsed-forms
            ((:integer id))
          (let ((found (ydk-deck-by-id id)))
            (when found
              (setf *current-deck* (ydk-sorted (ydk-sync found)))
              (flash-message
                     (format nil (_ "Found entry ~A (~d); loading...~%")
                             (ydk-name-of found) (mito:object-id found))))))
      (ratify:combined-error (e)
        (flash-error e))))
  
  (render-current-deck-list))

(defroute ("/builder/rename" :method :POST) (&key _parsed)
  "Try to rename a deck. Rename Deck ID to DECK-CREATE-NAME.

TODO There is other code to rename, isn't there? It looks like that code is inteded to be used from the Deck Overview page. This is just in the builder."
  (v:info :builder "POST /builder/rename => ~a" _parsed)

  (let ((create-name (query-param "deck-create-name" _parsed))
        (id (query-param "deck-load-id" _parsed)))
    ;; We want to change the name of LOAD-NAME to CREATE-NAME.
    (handler-case
        (ratify:with-parsed-forms
            ((:integer id))
          (let ((found (ydk-deck-by-id id)))
            (ydk-rename-deck found create-name)
            (flash-message
             (format nil (_ "Found entry ~A (~d); renaming to ~a.~%")
                     (ydk-name-of found) id create-name))))
      (ratify:combined-error (e)
        (flash-error e))))
  
  (render-saved-deck-list))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Since we're doing this in a builder context I thought it would be
;; better to do this here than at /category/saved-category-list as
;; that seemed a bit redundant. Surely there's a better way to
;; organize all this stuff!
(defroute ("/builder/saved-category-list" :method :GET) (&key _parsed)
  "Route for rendering the saved category list.

This is a \"widget\" that we include with Djula, and render separately via HTMX AJAX."
  (let ((id (query-param "id" _parsed)))
    (handler-case
        (ratify:with-parsed-forms
            ((:integer id))
          (let ((found (find-dao 'category :id id)))
            (if found
                (render-category found
                                 :tpl #P"builder/saved-category-list.html"))))
      (ratify:combined-error (e)
        (flash-error e)
        (render-category (find-dao 'category :id (max-dao 'category))
                         :tpl #P"builder/saved-category-list.html")))))

;; TODO This has got to be better!
(defroute ("/builder/decks-by-cat-id" :method :GET) (&key |id|)
  "Saved Deck List helper. Display the saved deck list, and if an |ID| is provided, send that as the current ID."
  (with-logged-in-user
    (render-with-env #P"builder/saved-deck-list.html"
                     `(:active "/builder"
                       :current-deck-id ,(ignore-errors
                                          (ydk-id-of *current-deck*))
                       :id ,|id|
                       :saved-deck-list ,(select-ydk-deck
                                           (if |id|
                                               (sxql:where (:= :category-id |id|))))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defroute ("/builder/move-to-category" :method :POST) (&key _parsed)
  "Move *CURRENT-DECK* into CATEGORY ID. TODO Implement this?"
  (v:info :builder "GET /builder/move-to-category => ~a" _parsed))