cl-deck-builder2/src/models/ygoprodeck-methods.lisp

#|

src/models/ygoprodeck-2.lisp

Yu-Gi-Oh! Pro Deck Database Interface v2

TODO Documentation

|#

(in-package #:cl-deck-builder2.models.ygoprodeck.methods)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defmacro ygo-card (&body body)
  `(with-includes
       'ygo-card
       (mito:includes
        'ygo-card-archetype
        'ygo-card-attribute
        'ygo-card-frame-type
        'ygo-card-race
        'ygo-card-type)
     ,@body))

(defmacro ygo-set (&body body)
  `(with-includes 'ygo-set
       (mito:includes
        'ygo-card
        'ygo-set-code
        'ygo-set-edition
        'ygo-set-name
        'ygo-set-rarity
        'ygo-set-rarity-code)
     ;; (mito:includes
     ;;  'ygo-card-name)
     ,@body))

(defun ygo-set-by-id (id)
  (first (ygo-set (sxql:where (:= :id id)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defmethod split-code ((set-code ygo-set-code))
  (cl-ppcre:split "-" (name-of set-code)))

(defmethod ygo-card-sets ((obj ygo-card))
  (ygo-card-sets (ygo-passcode-of obj)))

(defmethod ygo-card-sets ((passcode integer))
  ;; If alternate IDs exist, just mush them in
  (let ((alt-id (has-alternative-artwork passcode)))
    (when alt-id
      ;; XXX Why the long accessor name here? How can we get this accessor? Maybe I have to specify it manually.
      (with-slots ((alternate-id cl-deck-builder2.models.ygoprodeck.classes::alternate-id)) alt-id
        (setf passcode alternate-id)))
    (let ((sets
            (ygo-set
              ;; (sxql:left-join :ygo_card_name :on (:= :ygo-card.name-id :ygo-card-name.id))
              (sxql:where (:= :passcode-id passcode))
              (sxql:order-by :price :desc))))
      sets)))

;; Only showing cards with inventory

;; (with-connection (db)
;;   (mito:select-dao 'cl-deck-builder2.models.ygoprodeck.classes::ygo-set-item
;;     (sxql:where (:and (:in :item_id
;;                            (sxql:select :id
;;                              (sxql:from :ygo_set)
;;                              (sxql:where (:= :passcode-id 89631139))))
;;                       (:> :qty 0)))))

;; (mapcar (alexandria:compose #'cl-deck-builder2.models.ygoprodeck2::ygo-card-sets #'deck-passcode-of)
;;         (retrieve-dao 'deck-item :deck-id 5))

;; (reduce #'+ (mapcar (alexandria:compose #'read-from-string #'cl-deck-builder2.models.ygoprodeck2::ygo-price-of)
;;                     (cl-deck-builder2.models.ygoprodeck2::ygo-card-sets (deck-passcode-of (find-dao 'deck-item)))))

;; price of a deck by id using #'first of the ygo-card-sets
;;
;; (reduce '+ (mapcar (alexandria:compose #'read-from-string #'cl-deck-builder2.models.ygoprodeck.classes::ygo-price-of)
;;                    (mapcar #'first
;;                            (mapcar (alexandria:compose #'cl-deck-builder2.models.ygoprodeck.methods::ygo-card-sets #'deck-passcode-of)
;;                                    (retrieve-dao 'deck-item :deck-id 308)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun ygo-card-by-name (name &optional (test :=))
  (let ((clauses (case test
                   (:= (sxql:where (:= :name name)))
                   (:like (sxql:where (:like :name (format nil "%~a%" name)))))))
    (ygo-card clauses)))

(defun ygo-card-by-passcode (passcode)
  (first (ygo-card (sxql:where (:= :id passcode)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun ygo-set-by-code (name &optional (test :=))
  (let ((clauses (case test
                   (:= (sxql:where (:= :name name)))
                   (:like (sxql:where (:like :name (format nil "%~a%" name)))))))
    (ygo-set
      (sxql:where (:in :code-id
                       (sxql:select :id
                         (sxql:from (sxql:make-sql-symbol
                                     (mito.class.table:table-name
                                      (find-class 'ygo-set-code))))
                         clauses))))))

(defun ygo-set-by-name (name &optional (test :=))
  (let ((clauses (case test
                   (:= (sxql:where (:= :set_name name)))
                   (:like (sxql:where (:like :set_name (format nil "%~a%" name)))))))
    (ygo-set
      (sxql:where (:in :code-id
                       (sxql:select :id
                         (sxql:from (sxql:make-sql-symbol
                                     (mito.class.table:table-name
                                      (find-class 'ygo-set-name))))
                         clauses))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun ygo-select-set-item (item-id variant-id)
  "Helper function. Select a single YGO-SET-ITEM by ITEM-ID and VARIANT-ID."
  (mito:select-dao 'ygo-set-item 
    (mito:includes 'ygo-set 'variant-condition)
    (sxql:where (:and (:= :item-id item-id)
                      (:= :variant-id variant-id)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; https://lispcookbook.github.io/cl-cookbook/clos.html#pretty-printing
;;
;; (defmethod print-object ((obj person) stream)
;;   (print-unreadable-object (obj stream :type t)
;;     (with-accessors ((name name)
;;                      (lisper lisper))
;;         obj
;;       (format stream "~a, lisper: ~a" name lisper))))
;;
;; (defmethod print-object ((obj person) stream)
;;   (print-unreadable-object (obj stream :type t)
;;     (format stream "~a, lisper: ~a" (name obj) (lisper obj))))
;;
;; (defmethod print-object ((obj person) stream)
;;   (print-unreadable-object (obj stream :type t :identity t)))
;;
;; Caution: trying to access a slot that is not bound by default will lead to an error. Use slot-boundp.

(defmethod print-object ((obj ygo-card) stream)
  (print-unreadable-object (obj stream :type t)
    (let ((args))
      (when (ygo-passcode-of obj)
        (push (ygo-passcode-of obj) args))
      (ignore-errors
       (with-accessors ((name name-of))
           obj
         (when (and (slot-boundp obj 'name)
                    (slot-value obj 'name))
           (push (name-of name) args))))
      (when args
        (format stream "~{~a~^ - ~}" (reverse args))))))

(defmethod print-object ((obj ygo-set) stream)
  (print-unreadable-object (obj stream :type t)
    (let ((args))
      (when (mito:object-id obj)
        (push (mito:object-id obj) args))
      (ignore-errors
       (with-accessors ((passcode ygo-passcode-of)
                        (name name-of)
                        (code ygo-code-of)
                        (rarity ygo-rarity-of)
                        (edition ygo-edition-of))
           obj
         (when (and (slot-boundp obj 'passcode)
                    (slot-value obj 'passcode))
           (push (ygo-passcode-of passcode) args))
         (when (and (slot-boundp obj 'code)
                    (slot-value obj 'code))
           (push (ygo-set-code-of code) args))
         (when (and (slot-boundp obj 'rarity)
                    (slot-value obj 'rarity))
           (push (ygo-rarity-of rarity) args))
         (when (and (slot-boundp obj 'edition)
                    (slot-value obj 'edition))
           (push (ygo-edition-of edition) args))
         (when (and (slot-boundp obj 'name)
                    (slot-value obj 'name))
           (push (name-of name) args))))
      (when args
        (format stream "~{~a~^ - ~}" (reverse args))))))

(defun ygo-card-names-from-list (&rest args)
  (with-connection (db)
    (with-transaction
      (mito:retrieve-by-sql
       (sxql:select (:ygo_card.id :name)
         (sxql:from :ygo_card)
         (sxql:left-join :ygo_card_name :on (:= :ygo_card.name_id :ygo_card_name.id))
         (sxql:where (:in :ygo_card_name.id
                          (sxql:select :name_id
                            (sxql:from :ygo_card)
                            (sxql:where (:in :id args))))))))))

(defun ygo-card-names-by-deck-id (id)
  (with-connection (db)
    (with-transaction
      (mito:retrieve-by-sql
       (sxql:select (:ygo_card.id :name)
         (sxql:from :ygo_card)
         (sxql:left-join :ygo_card_name :on (:= :ygo_card.name_id :ygo_card_name.id))
         (sxql:where (:in :ygo_card_name.id
                          (sxql:select :name_id
                            (sxql:from :ygo_card)
                            (sxql:where (:in :id
                                             (sxql:select :passcode
                                               (sxql:from :deck_item)
                                               (sxql:where (:= :deck_id id)))))))))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun count-all-dao ()
  (let ((class-list (append (registered-classes (registry) :cl-deck-builder2.models.ygoprodeck.fields)
                            (registered-classes (registry) :cl-deck-builder2.models.ygoprodeck.classes)))
        (lst '()))
    (with-connection (db)
      (with-transaction
        (dolist (class class-list lst)
          (push (list class (mito:count-dao class)) lst))))))

;; If you have altnerative artwork and you are the main card, youll get a list with length > 1
;; If you have alternative artwork and you are an alternative artwork card, you'll get the main list with length 1
(defmethod has-alternative-artwork ((id integer))
  (find-dao 'ygo-alternative-artwork :passcode-id id))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; So in the CSV importer I had a function PRE-SEED-DB-ITEMS that
;; would copy CC-ITEM x5 VARIANT-CONDITION to seed something like 250k
;; items in the db. We're just going to duplicate the logic here.
;;
;; INPUT: (select-dao 'ygo-set)
(defun pre-seed-db-items (ygo-sets)
  (let ((variants (select-dao 'variant-condition)))
    (with-connection (db)
      (with-transaction
        (dolist (itm ygo-sets)
          (dolist (variant variants)
            (mito:create-dao 'ygo-set-item :item-id (mito:object-id itm)
                                           :variant-id (mito:object-id variant))))
        (mito:count-dao 'ygo-set-item)))))

(defun set-ygo-set-item-qty (amt)
  "Helper function. Set the QTY of every YGO-SET-ITEM to AMT."
  (with-connection (db)
    (with-transaction
      (mito:execute-sql
       (sxql:update (sxql:make-sql-symbol
                     (mito.class.table:table-name
                      (find-class 'ygo-set-item)))
         (sxql:set= :qty amt))))))