#| src/models/constructed-deck.lisp Constructed deck model: - CONSTRUCTED-DECK A CONSTRUCTED-DECK is based on a YDK-DECK. The YDK-DECK is built on the YDK object, which keeps track of synchronizing the stuff in the Deck Builder App with the database through YDK-SYNC. Since we don't plan on modifying CONSTRUCTED-DECKs, there is nothing analogous to YDK-SYNC for CONSTRUCTED-DECKs. I think that's what I'm implementing right now, the pull logic. - CONSTRUCTED-DECK-ITEM Analogous to DECK-ITEM. Nothing fancy here. Extra columns: YGO-SET-ITEM, SELL-PRICE. - SOLD-DECK NODO Supposed to represent decks sold in the same way Deck Templates -> Pulled Decks, Pulled Decks -> Sold Decks. |# (in-package #:cl-deck-builder2.models.constructed-decks) (defparameter +default-constructed-deck-sell-price+ "60.00" "Default sell price for constructed decks. We have the price for every card set to 0.50 cents. That works out to $35 for a 70 card deck. This is about twice that.") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defclass constructed-deck () ((;; The name of this CONSTRUCTED-DECK name :accessor deck-name-of :col-type :text :initarg :name) (category :accessor deck-category-of :col-type (or category :null)) (created-by :accessor deck-created-by :col-type :text :initarg :created-by) (;; If the CONSTRUCTED-DECK has a SELL-PRICE, we override the total price of the deck with this price. sell-price :accessor deck-sell-price-of :col-type :integer :initarg :sell-price :initform +default-constructed-deck-sell-price+ :deflate #'currency-deflate :inflate #'currency-inflate) ;; The original ID of the deck, probably from YDK-DECK (ydk-deck :accessor ydk-deck-of :col-type ydk-deck :initarg :ydk-deck) (sold :accessor deck-sold :col-type :binary :initarg :deck-sold :initform 0)) (:metaclass registered-table-class) (:documentation "A Constructed deck is just a deck that has been \"pulled.\" That is, somebody built a deck template, clicked the \"Pull\" button. From what has been explained to me, we'll only pull decks we have. So we'll only construct decks with cards we know or think we know we have or we plan on getting more of. Then the physical cards will need to be collected and assembled into the deck following the template. This physical, real, action is what is recorded by the \"Pull\" action. It's important to note that it is impossible to constrain somebody from pulling arbitrary decks. A physical security device would need to be in place and a framework for authentication with it would be necessary (i.e. it is expected that one will use this tool with intention, respectfully, and will be trained on how to do so). Anyway. You don't actually have to physically pull the cards yet. This is just a record, think an earmark on a page, that these cards from this deck template have been pulled. YDK-DECK-PULL-FROM-INVENTORY does all the heavy lifting, and will return a CONSTRUCTED-DECK object if it was successful. Then, finally, during the deck construction phase, you will be prompted to select the variant of card, language, condition, etc. Once you are happy with your selection the constructed deck will be marked as \"FOR-SALE\".")) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defclass constructed-deck-item () (;; The original ID of the CONSTRUCTED-DECK-ITEM, from DECK-ITEM ;; (passcode :accessor deck-passcode-of :col-type :integer) ;; (inventory-item :accessor deck-inventory-item-of :col-type inventory-item) (ygo-card :accessor ygo-card-of :col-type ygo-card :initarg :ygo-card) (deck-id :accessor deck-id-of :col-type :integer) (deck-item :accessor deck-item-of :col-type deck-item :initarg :deck-item) (ygo-set-item :accessor deck-set-item-of :col-type ygo-set-item :initarg :ygo-set-item)) ;; (variant :accessor deck-item-variant-of ;; :col-type variant ;; :initarg :variant) ;; ;; Shouldn't inventory items have Qty and not constructed deck items? ;; ;; (opt-qty :accessor opt-qty-of ;; :col-type :integer ;; :initarg :opt-qty ;; :initform 0) ;; (qty :accessor qty-of ;; :col-type :integer ;; :initarg :qty ;; :initform 0) (:metaclass registered-table-class) (:documentation "A CONSTRUCTED-DECK-ITEM is pretty much the same as a DECK-ITEM, except it's a \"constructed\" deck. Same index idea and everything. The table is indexed into by CONSTRUCTED-DECK-ID. We subclass YGO-SETS for all the card metadata.")) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Analogous to YDK-DECK -- Do we even need this? I just loop over the SET-ITEMS anyway. (defclass constructed-deck-intermediate () ((deck-item :accessor cdi-deck-item :initarg :deck-item) (deck-set :accessor cdi-deck-set :initarg :deck-set) (set-item :accessor cdi-deck-set-item :initarg :set-item) (condition :accessor cdi-deck-condition :initarg :condition) (card :accessor cdi-deck-card :initarg :card))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Just want the decks to be marked as sold. Easy. ;; ;; (defclass sold-deck (constructed-deck) ;; (;; Has the deck been sold? ;; (deck-sold :accessor constructed-deck-sold ;; :col-type :integer ;; :initarg :sold ;; :initform 0) ;; ;; 60 Doll Hairs ;; (sell-price :accessor deck-sell-price-of ;; :col-type :integer ;; :initarg :sell-price ;; :initform +default-constructed-deck-sell-price+ ;; :deflate #'currency-deflate ;; :inflate #'currency-inflate)) ;; (:metaclass registered-table-class)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; I think this got superseded by CDI-PULL-FROM-INVENTORY since we ;; aren't pulling from YDKs any more but from ;; CONSTRUCTED-DECK-INTERMEDIATE. (defmethod ydk-deck-pull-from-inventory ((deck ydk-deck)) "Attempt to find inventory stock for every card in this deck, and if we are able to secure it, construct and insert a new PULLED-DECK into the database." (with-connection (db) (let ((;; Get the OLD-DECK-ID old-deck-id (mito:object-id deck)) (;; Create a new DECK based on the old DECK new (mito:create-dao 'constructed-deck :name (ydk-name-of deck) :category (ydk-category-of deck) :created-by (ydk-created-by deck) :sell-price +default-constructed-deck-sell-price+ :ydk-deck deck))) ;; If the new deck was created successfully, (when new (let ((;; Get the NEW-DECK-ID new-deck-id (mito:object-id deck)) (;; Get all the items from the old deck deck-items (mito:select-dao 'deck-item (sxql:where (:= :deck-id old-deck-id))))) (with-transaction (dolist (deck-item deck-items new) ;; Create a bunch of CONSTRUCTED-DECK-ITEMs for the ;; corresponding DECK-ITEMs. from the old DECK. (create-dao 'constructed-deck-item :deck-id new-deck-id :ygo-card-id (deck-passcode-of deck-item))))))))) ;; (defmethod mark-as-sold ((sold-deck sold-deck)) ;; "Mark a SOLD-DECK as having been sold." ;; (setf (deck-sold sold-deck) 1) ;; (update-dao sold-deck)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; This expects a list of CONSTRUCTED-DECK-INTERMEDIATE which has no documented format. ;; (defun deck-to-pull-set-items-qty-as-alist (cdi-items) "Construct an ALIST of PASSCODE . QTY from DECK listing. We use a list of CONSTRUCTED-DECK-INTERMEDIATE objects." (let ((alist '())) (dolist (row cdi-items alist) (push (cons (cdi-deck-set-item row) (qty-of (cdi-deck-set-item row))) alist)))) (defun deck-to-pull-desired-qty-as-alist (cdi-items) "Construct an ALIST of PASSCODE . (COUNT PASSCODE) from DECK listing. We use a list of CONSTRUCTED-DECK-INTERMEDIATE objects." (let ((alist '())) (dolist (row cdi-items alist) (if (assoc (cdi-deck-set-item row) alist :test #'mito:object=) (incf (cdr (assoc (cdi-deck-set-item row) alist :test #'mito:object=))) (push (cons (cdi-deck-set-item row) 1) alist))))) (defun subtract-desired-from-set-item-qty-as-alist (set-items-qty desired-items-qty) "Perform a DECF on the CDR of the paired elements from (DECK-TO-PULL-SET-ITEMS-QTY-AS-ALIST) using (DECK-TO-PULL-DESIRED-QTY-AS-ALIST) as the source argument." (dolist (pair desired-items-qty set-items-qty) (if (assoc (car pair) set-items-qty :test #'mito:object=) (decf (cdr (assoc (car pair) set-items-qty :test #'mito:object=)) (cdr pair)) (v:info :construct "Invalid ID pair: ~a" (car pair))))) (defun find-any-invalid-qtys (set-items-qty desired-items-qty) (with-connection (db) (with-transaction (loop for pair in (subtract-desired-from-set-item-qty-as-alist set-items-qty desired-items-qty) do (when (minusp (cdr pair)) (return (ygo-passcode-of (item-of (car pair))))))))) (defun valid-pull-p (set-items-qty desired-items-qty) "Loop over the results of SUBTRACT-DESIRED-FROM-SET-ITEM-QTY-AS-ALIST, looking for any less-than-zero values. If any exist, we took too much out of inventory, and the pull is \"invalid,\" we return NIL. Otherwise, the pull will be successful (we have enough inventory), so return T." (not (find-any-invalid-qtys set-items-qty desired-items-qty))) ;; Actually subtract the amounts from the set item ;; make the CONSTRUCTED-DECK with CONSTRUCTED-DECK-ITEM ;; Make the view panel (defun cdi-pull-from-inventory (cdi-list) "Attempt to find inventory stock for every card in this deck, and if we are able to secure it, construct and insert a new PULLED-DECK into the database." (with-connection (db) (let* ((;; Get the OLD-DECK-ID old-deck-id (deck-id-of (cdi-deck-item (car cdi-list)))) (;; Get the OLD DECK old-deck (mito:find-dao 'ydk-deck :id old-deck-id)) (;; Create a new DECK based on the old DECK new (mito:create-dao 'constructed-deck :name (ydk-name-of old-deck) :category (ydk-category-of old-deck) :created-by (ydk-created-by old-deck) :sell-price +default-constructed-deck-sell-price+ :ydk-deck old-deck))) ;; If the new deck was created successfully, (when new ;; Get the NEW-DECK-ID (let ((new-deck-id (mito:object-id new))) ;; iterate over all the items from the old deck (with-transaction (dolist (row cdi-list new) ;; Create a bunch of CONSTRUCTED-DECK-ITEMs for the ;; corresponding DECK-ITEMs. from the old DECK. (mito:create-dao 'constructed-deck-item :deck-id new-deck-id :deck-item-id (mito:object-id (cdi-deck-item row)) :ygo-set-item-id (mito:object-id (cdi-deck-set-item row)) :ygo-card-id (deck-passcode-of (cdi-deck-item row)))))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun return-to-inventory (cdi-items) "Attempt to find inventory stock for every card in this deck, and increment the count by however many we specify in the CDR." (let ((counts (deck-to-pull-desired-qty-as-alist cdi-items))) (dolist (row counts) (incf (qty-of (car row)) (cdr row)) ;; Update each one and save - wrapping this in a transaction causes issues with pulling multiple items. (save-dao (car row))))) (defun constructed-deck-as-cdi-list (constructed-deck-id) (with-connection (db) (let ((deck (mito:select-dao 'constructed-deck-item (mito:includes 'ygo-card 'deck-item 'ygo-set-item) (sxql:order-by :asc :id) (sxql:where (:= :deck-id constructed-deck-id)))) (lst '())) (dolist (row deck (reverse lst)) (let ((deck-set-item (deck-set-item-of row))) (push (make-instance 'constructed-deck-intermediate :card (ygo-card-by-passcode (ygo-passcode-of (ygo-card-of row))) :condition (variant-of deck-set-item) :deck-item (deck-item-of row) :deck-set (ygo-set-by-id (mito:object-id (item-of deck-set-item))) :set-item deck-set-item) lst)))))) ;; TODO Use STORE-CONSTRUCTED-DECK-AS-CURRENT to load a ;; CONSTRUCTED-DECK out of the database into ;; *CURRENT-CONSTRUCTED-DECK* so we can use RETURN-TO-INVENTORY on it. (defun cdi-return-to-inventory (cdi-list) (error "TODO")) ;; Where did this code from? I feel like it got easily superceded by CALCULATE-OPTIMUM-QTY. ;; I think it was used in CARDS-IN-ALL-DECKS? (defun unique-constructed-deck-item-passcodes () "Select the unique cards in all CONSTRUCTED-DECK-ITEMs" (let ((deck-items (with-connection (db) (mito:select-dao 'constructed-deck-item (sxql:group-by :passcode) (sxql:order-by :passcode :desc)))) (ht (make-hash-table))) (with-connection (db) (with-transaction (dolist (deck-item (reverse deck-items) ht) (pushnew (list :deck-id (deck-id-of deck-item) :constructed-deck (mito:find-dao 'constructed-deck :id (deck-id-of deck-item)) :ygo-card (mito:find-dao 'ygo-card :id (deck-passcode-of deck-item))) (gethash (deck-passcode-of deck-item) ht) :key (lambda (plist) (getf plist :deck-id)))))))) (defun calculate-optimum-qty () (with-connection (db) (let ((count-data (with-transaction (mito:retrieve-by-sql (sxql:select (:passcode (:as (:count :passcode) :count)) (sxql:from :deck_item) (sxql:group-by :passcode) (sxql:order-by (:count :passcode) :asc))))) (lst '())) (with-transaction (mapcar #'mito:execute-sql (dolist (row count-data lst) (let ((passcode (getf row :passcode)) (opt-qty (getf row :count))) (push (sxql:update :ygo_set_item (sxql:set= :opt_qty (* 5 opt-qty)) (sxql:where (:in :item_id (sxql:select :id (sxql:from :ygo_set) (sxql:where (:= :passcode_id passcode)))))) lst))))))))