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