#| src/models/ydk/classes.lisp # YDK Yu-Gi-Oh! Pro Deck YDK Importer And Models TODO This can be a stand-alone package CL-YDK + the CL-YDK+MITO mixin probably. |# (in-package #:cl-deck-builder2.models.ydk) (defclass deck-item () (;; 0 => Main Deck ;; 1 => Extra Deck ;; 2 => Side Deck (deck-id :accessor deck-id-of :col-type :integer) (kind :accessor deck-kind-of :col-type :integer) (passcode :accessor deck-passcode-of :col-type :integer)) (:metaclass registered-table-class) (:documentation "DECK-LIST is a representation of a single card in a YDK deck in SQL. Since SQL doesn't have a LIST type, we use a bunch of these (60-90 rows generally make up a deck). The ID field supplied by MITO:DAO-TABLE-CLASS is the \"Deck ID\" in the builder system.")) (defclass ydk-deck () (;; (id :accessor ydk-id-of :col-type :integer :primary-key t) (category :accessor ydk-category-of :col-type (or category :null)) (created-by :accessor ydk-created-by :col-type :text :initarg :created-by) (name :accessor ydk-name-of :col-type :text :initarg :name)) (:unique-keys name) (:metaclass registered-table-class) (:documentation "A YDK-DECK is an in-database representation of a deck. It's really actually just an index to keep track of metadata, with the ID field used to key into DECK-ITEM. SQL doesn't allow us to store anything as a list. We take advantage of Mito's INSERT-DAO, SELECT-DAO, etc. being methods which we can define :BEFORE :AFTER and :AROUND methods for. The YDK-DECK class is an intermediate representation of a deck. Bookeeping for the \"Deck ID\", CREATED-BY, and NAME.")) (defclass ydk () ((;; I think this is supposed to be the MITO:OBJECT-ID to keep tabs ;; on the SYNC status... Looks like I never wrote it down, but I'm ;; pretty sure that was my intention with this SLOT. It's been a ;; pain point previously (PPP). deck-id :accessor ydk-id-of :initarg :deck-id) (created-by :accessor ydk-created-by :initarg :created-by :initform nil) (name :accessor ydk-name-of :initarg :name :initform nil) (main-deck :accessor ydk-main-deck-of :initarg :main-deck :initform '()) (extra-deck :accessor ydk-extra-deck-of :initarg :extra-deck :initform '()) (side-deck :accessor ydk-side-deck-of :initarg :side-deck :initform '())) (:documentation "Intermediate YDK representation. This is what's stored in-memory during program operation, and then gets synced to the database. Notice this class does not draw from MITO:DAO-TABLE-CLASS.")) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Helper functions ;; ;; TODO maybe I don't have to duplicate this data? ;; ;; I tried using defparameter but defmacro complained when I tried to ;; load it. ;; ;; Aha, The Original Variant. ;; This code needs to be incorporated into the VARIANT code. (defmacro %sql-to-keyword (type) `(ecase ,type (0 :main-deck) (1 :extra-deck) (2 :side-deck))) (defmacro %keyword-to-sql (type) `(ecase ,type (:main-deck 0) (:extra-deck 1) (:side-deck 2))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; TODO I think I'm going to erase all these DEFUNs since they're kinda ;; outdated now with the changes I made in db.lisp ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Delete (defun ydk-deck-delete-from (&rest clauses) (apply #'delete-from 'ydk-deck clauses)) (defun ydk-deck-item-delete-from (&rest clauses) (apply #'delete-from 'deck-item clauses)) (defun ydk-deck-delete-by-id (id) "Remove all matching ID from YDK-DECK and DECK-ITEM, effectively erasing the deck from the database." (ydk-deck-delete-from (sxql:where (:= :id id))) (ydk-deck-item-delete-from (sxql:where (:= :deck_id id)))) (defun ydk-deck-delete-by-name (name) (let ((found (ydk-deck-by-name name))) (when found ;; Delete from both the DECK-ITEM and the YDK-DECK reference ;; table. The :deck_item table doesn't have a :NAME field, it ;; only has the :DECK_ID field. So we need to use ;; SELECT-DECK-BY-NAME anyway. (ydk-deck-delete-by-id (mito:object-id found))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Select (defmacro ydk-table-select (&body body) `(select-dao 'ydk-deck ,@body)) (defun ydk-table-select-count (&optional fields-and-values) (apply #'count-dao 'ydk-deck fields-and-values)) (defun ydk-deck-by-id (id &rest args) (apply #'find-dao 'ydk-deck :id id args)) (defun ydk-deck-by-name (name &rest args) (apply #'find-dao 'ydk-deck :name name args)) ;; Very cool to have figured this out. To get info on a deck, select ;; the deck_item where the deck_id is the deck you want. Then INNER ;; JOIN on :card_info. It just works. One db trip. Aweseome! ;; ;; TODO how can we do this with SELECT-DAO? ;; ;; For now since this is only getting used in one place, RENDER-YDK, ;; which is albeit, a pretty core component, ... I'll use ;; datafly. Until I figure out how to relate these columns. ;; ;; I think this is a duplicate of YDK-QUERY... Okay it occured to ;; me. I used to use YDK-QUERY before I figured this one out and I ;; think I know what's going on. ;; ;; So YDK-DECK-INFO-BY-ID uses SQL to do an INNER JOIN to get the data ;; from the deck. YDK-QUERY works on decks that aren't in the database ;; and only returns partial information. I have to use that info to ;; re-construct the data. The original purpose of YDK-QUERY was to use ;; it like a look-up table, based on that sorting dev.to article. ;; ;; But then I realized, it's a lot more efficient to do it at the ;; database level. so that's where YDK-DECK-INFO-BY-ID was born ;; from. It works on existing decks in the database. (defgeneric ydk-query (id)) (defmethod ydk-query ((id integer)) "Query the database for information from YGO_INFO about the DECK ID." (with-connection (db) (with-transaction (mito:retrieve-by-sql (sxql:select :* (sxql:from :ygo_info) (sxql:inner-join :deck_item :on (:= :deck_item.passcode :ygo_info.passcode)) (sxql:order-by :asc :deck_item.id) (sxql:where (:= :deck_id id))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defmethod ydk-query ((ydk-deck ydk-deck)) "Query the YDK-DECK by its MITO:OBJECT-ID" (ydk-query (mito:object-id ydk-deck))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defmethod ydk-query ((ydk ydk)) "Select entries from :YGOPRODECK-DATA corresponding to the unique list of cards in DECK. This can be used as a look up table to construct a deck description. It looks like I updated YDK-QUERY to work with the new YDK-ALL output. Neat!" (let* ((all (ydk-all ydk)) (cards (ydk-concatenate ydk)) (info (with-datafly-connection (db) (with-datafly-transaction (db) (datafly:retrieve-all (sxql:select :* (sxql:from :ygo_info) (sxql:where (:in :passcode cards)))))))) (labels ((query-deck (kind) (loop for passcode in (getf all kind) collect (find passcode info :key (lambda (plist) (getf plist :passcode)))))) (list :main-deck (query-deck :main-deck) :extra-deck (query-deck :extra-deck) :side-deck (query-deck :side-deck))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Update (defmethod ydk-rename-deck ((ydk-deck ydk-deck) new-name) (setf (ydk-name-of ydk-deck) new-name) (save-dao ydk-deck)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun normalize-content (content) "Strip UTF-8 BOM, \"\r\n\" sequences, then split on #\Newline into a list." (etypecase content ;; It's a LIST - pass it on (list content) ;; It's a PATHNAME - UIOP:READ-FILE-STRING and then treat it like ;; a STRING. (pathname (split-sequence:split-sequence #\Newline (normalize-newlines (strip-bom (uiop:read-file-string content))))) ;; It's a STRING: strip BOM and normalize newlines. (string (split-sequence:split-sequence #\Newline (normalize-newlines (strip-bom content)))))) (defmethod initialize-with-content ((ydk ydk) content) (let ((created-by nil) (main-deck '()) (extra-deck '()) (side-deck '()) (state :in-created-by)) (dolist (itm (normalize-content content)) ;; A bunch of :END2 checks to prevent overrun. (unless ;; Detect state change (cond ((string-equal "#main" itm :end2 (min (length itm) 5)) (setf state :in-main) t) ((string-equal "#extra" itm :end2 (min (length itm) 6)) (setf state :in-extra) t) ((string-equal "!side" itm :end2 (min (length itm) 5)) (setf state :in-side) t) ((equal "" itm) t)) ; Skip blank lines! ;; Otherwise, we assume it's a valid PASSCODE. (ccase state (:in-created-by (setf created-by itm)) (:in-main (push (parse-integer itm) main-deck)) (:in-side (push (parse-integer itm) side-deck)) (:in-extra (push (parse-integer itm) extra-deck))))) (unless (and (slot-boundp ydk 'created-by) (slot-value ydk 'created-by)) (setf (ydk-created-by ydk) created-by)) ;; Currently we don't read the NAME of the YDK from anywhere ;; *inside* the file contents, it is provided externally, ;; e.g. file name. ;; ;; (unless (and (slot-boundp ydk 'name) ;; (slot-value ydk 'name)) ;; (setf (ydk-name-of ydk) name)) (unless (and (slot-boundp ydk 'main-deck) (slot-value ydk 'main-deck)) (setf (ydk-main-deck-of ydk) (reverse main-deck))) (unless (and (slot-boundp ydk 'extra-deck) (slot-value ydk 'extra-deck)) (setf (ydk-extra-deck-of ydk) (reverse extra-deck))) (unless (and (slot-boundp ydk 'side-deck) (slot-value ydk 'side-deck)) (setf (ydk-side-deck-of ydk) (reverse side-deck))))) (defmethod initialize-instance :after ((ydk ydk) &rest initargs &key content &allow-other-keys) (declare (ignore initargs)) (when content (initialize-with-content ydk content))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defmethod ydk-add ((ydk ydk) target-deck passcode) (let ((deck (ecase target-deck (:main (ydk-main-deck-of ydk)) (:extra (ydk-extra-deck-of ydk)) (:side (ydk-side-deck-of ydk))))) (ccase target-deck (:main (setf (ydk-main-deck-of ydk) (append deck (list passcode)))) (:extra (setf (ydk-extra-deck-of ydk) (append deck (list passcode)))) (:side (setf (ydk-side-deck-of ydk) (append deck (list passcode))))))) ;; TODO Deprecated. Remove this code. YDK-DELETE-INDEX is ;; superior. How are we going to tackle moving cards? (defmethod ydk-delete ((ydk ydk) kind passcode &optional (count 1)) "Sloppily remove PASSCODE from YDK KIND deck. KIND is one of :MAIN :EXTRA or :SIDE. Optionally specify how many to remove with COUNT, default of 1." (labels ((remove-fn (array) (remove-if (lambda (lst) (eq lst passcode)) array :count count))) (with-slots (main-deck extra-deck side-deck) ydk (ccase kind (:main (setf main-deck (remove-fn main-deck))) (:side (setf side-deck (remove-fn side-deck))) (:extra (setf extra-deck (remove-fn extra-deck))))))) (defmethod ydk-delete-index ((ydk ydk) kind index &optional (count 1)) "Delete COUNT sequential cards at INDEX from the KIND of deck. KIND is one of :MAIN :EXTRA or :SIDE." (with-slots (main-deck extra-deck side-deck) ydk (ccase kind (:main (setf main-deck (append (subseq main-deck 0 index) (subseq main-deck (+ count index))))) (:extra (setf extra-deck (append (subseq extra-deck 0 index) (subseq extra-deck (+ count index))))) (:side (setf side-deck (append (subseq side-deck 0 index) (subseq side-deck (+ count index)))))))) (defmethod ydk-clear ((ydk ydk) &optional target-deck) "Clear out the YDK." (case target-deck (:main (setf (ydk-main-deck-of ydk) nil)) (:side (setf (ydk-side-deck-of ydk) nil)) (:extra (setf (ydk-extra-deck-of ydk) nil)) (t (progn (ydk-clear ydk :main) (ydk-clear ydk :extra) (ydk-clear ydk :side))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defmethod ydk-sync ((ydk ydk)) "Synchronize this YDK intermediate deck to the database. If there's already a deck by this name, we \"update\" it by erasing all the entries matching that DECK ID using YDK-DECK-ITEM-DELETE-FROM. That is, YDK => SQL." (let ((deck-list '()) (deck (ydk-deck-by-name (ydk-name-of ydk)))) ;; Create the new deck if it does not exist. (unless deck (setf deck (create-dao 'ydk-deck :name (ydk-name-of ydk) :created-by (ydk-created-by ydk)))) ;; If A deck with this name already exists: clear out the old ;; list. This no longer erases the YDK-DECK entry, so DECK-ID ;; should stay consistent now. (ydk-deck-item-delete-from (sxql:where (:= :deck_item.deck_id (mito:object-id deck)))) ;; Insert new deck_items into the database. How do we do ;; that? We create a bunch of objects then MITO:INSERT-DAO them. (loop for (kind lst) on (ydk-all ydk) by #'cddr do (dolist (passcode lst) (push (make-instance 'deck-item :deck-id (mito:object-id deck) :kind (%keyword-to-sql kind) :passcode passcode) deck-list))) (if (do-grouped-insert deck-list) deck))) (defmethod ydk-sync ((ydk-deck ydk-deck)) "Query the database deck with this YDK-DECK. That is, SQL => YDK. TODO Why not WITH-SLOTS?" (with-connection (db) (let* ((id (mito:object-id ydk-deck)) (created-by (ydk-created-by ydk-deck)) (name (ydk-name-of ydk-deck)) (deck-list (mito:retrieve-dao 'deck-item :deck-id id)) (main-deck '()) (extra-deck '()) (side-deck '())) (dolist (deck-item deck-list) (let ((passcode (deck-passcode-of deck-item))) ;; TODO There could be a macro (with-main-side-extra-decks) ;; or something to suplliment %keyword-to-sql and ;; %sql-to-keyword. (ccase (deck-kind-of deck-item) (0 (push passcode main-deck)) (1 (push passcode extra-deck)) (2 (push passcode side-deck))))) (make-instance 'ydk :deck-id id :name name :created-by created-by :main-deck main-deck :extra-deck extra-deck :side-deck side-deck)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defmethod ydk-all ((ydk ydk)) "Get the list of cards from a deck, duplicates included. Generally this order is retained from e.g. file upload or deck creation. SEE YDK-SORTED." (with-slots (main-deck extra-deck side-deck) ydk (list :main-deck main-deck :side-deck side-deck :extra-deck extra-deck))) (defmethod ydk-concatenate ((ydk ydk)) "Get the list of cards from a deck, duplicates included. Generally this order is retained from e.g. file upload or deck creation. SEE YDK-SORTED." (with-slots (main-deck extra-deck side-deck) ydk (concatenate 'list main-deck extra-deck side-deck))) (defmethod ydk-unique ((ydk ydk)) "Get the unique list of cards from a deck." (remove-duplicates (ydk-concatenate ydk))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; (with-datafly-connection (db) ;; (with-datafly-transaction ;; (datafly:retrieve-all ;; (select (:frame_type) (from :ygo_info) (group-by :frame_type))))) ;; ((:FRAME-TYPE "effect") (:FRAME-TYPE "effect_pendulum") (:FRAME-TYPE "fusion") ;; (:FRAME-TYPE "fusion_pendulum") (:FRAME-TYPE "link") (:FRAME-TYPE "normal") ;; (:FRAME-TYPE "normal_pendulum") (:FRAME-TYPE "ritual") ;; (:FRAME-TYPE "ritual_pendulum") (:FRAME-TYPE "skill") (:FRAME-TYPE "spell") ;; (:FRAME-TYPE "synchro") (:FRAME-TYPE "synchro_pendulum") (:FRAME-TYPE "token") ;; (:FRAME-TYPE "trap") (:FRAME-TYPE "xyz") (:FRAME-TYPE "xyz_pendulum")) (defmethod ydk-sorted ((ydk ydk)) "Sort the YDK according to FRAME-TYPE-PRIO." (let ((deck-info (copy-list (ydk-query ydk)))) (labels ((frame-type-prio (plist) (let ((kind (getf plist :frame-type))) (cond ((string= kind "normal") 0) ((string= kind "effect") 1) ((string= kind "ritual") 2) ((string= kind "fusion") 3) ((string= kind "link") 4) ((string= kind "skill") 5) ((string= kind "synchro") 6) ((string= kind "token") 7) ((string= kind "xyz") 8) ((string= kind "spell") 9) ((string= kind "trap") 10) ((string= kind "effect_pendulum") 11) ((string= kind "fusion_pendulum") 12) ((string= kind "normal_pendulum") 13) ((string= kind "ritual_pendulum") 14) ((string= kind "synchro_pendulum") 15) ((string= kind "xyz_pendulum") 16) (t 17)))) (sort-and-extract (kind) (mapcar (lambda (plist) (getf plist :passcode)) (sort (sort (copy-list (getf deck-info kind)) #'string< :key (lambda (plist) (princ-to-string (getf plist :name)))) #'< :key #'frame-type-prio)))) (make-instance 'ydk :created-by (ydk-created-by ydk) ;; Sometimes unbound - on unsaved decks. :deck-id (ignore-errors (ydk-id-of ydk)) :name (ydk-name-of ydk) :main-deck (sort-and-extract :main-deck) :extra-deck (sort-and-extract :extra-deck) :side-deck (sort-and-extract :side-deck))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Now where on earth does this belong? Probably with the YDK stuff maybe? ;; ;; Maybe this will go back to the toolkit This code might be useful for parsing CSVs or similar. ;; #+nil (defun parse-decklist (string) (let ((split-query (mapcar #'(lambda (s) (string-trim '(#\Newline #\Return #\Tab #\Space) s)) (remove "" (split-sequence:split-sequence #\Newline (normalize-newlines string)) :test #'equal))) (new-list '())) (dolist (line split-query) (multiple-value-bind (string substrings) (cl-ppcre:scan-to-strings "^(\\d+)x (.*)" line) (declare (ignore string)) (cond (substrings (let ((card-name (svref substrings 1)) (as-number (read-from-string (svref substrings 0)))) ;; 10x => dotimes 10 (dotimes (_ as-number) (push card-name new-list)))) (t (push line new-list))))) (reverse new-list))) (defmethod ydk-filter-frame-type ((ydk ydk) kind) (let ((monster '("normal" "effect" "ritual" "fusion" "link" "synchro" "xyz" "effect_pendulum" "fusion_pendulum" "normal_pendulum" "ritual_pendulum" "synchro_pendulum" "xyz_pendulum")) (spell '("spell")) (trap '("trap")) (deck-info (ydk-query ydk))) (labels ((filter (plist) (remove-if (lambda (itm) (if (member (getf itm :frame-type) (case kind (:monster monster) (:spell spell) (:trap trap)) :test #'equal) nil t)) plist))) (filter (getf deck-info :main-deck))))) (defmethod ydk-monster-cards ((ydk ydk)) (ydk-filter-frame-type ydk :monster)) (defmethod ydk-spell-cards ((ydk ydk)) (ydk-filter-frame-type ydk :spell)) (defmethod ydk-trap-cards ((ydk ydk)) (ydk-filter-frame-type ydk :trap)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defmethod ydk-length ((ydk ydk)) (reduce #'+ (list (length (ydk-main-deck-of ydk)) (length (ydk-extra-deck-of ydk)) (length (ydk-side-deck-of ydk))))) (defmethod ydk-to-kde ((ydk ydk)) "Transform the YDK according to KDE Team List." (let ((created-by (ydk-created-by ydk)) (deck-info (ydk-query ydk)) (monster-cards (ydk-monster-cards ydk)) (spell-cards (ydk-spell-cards ydk)) (trap-cards (ydk-trap-cards ydk))) (let ((main-deck (getf deck-info :main-deck)) (extra-deck (getf deck-info :extra-deck)) (side-deck (getf deck-info :side-deck))) (let ((main-deck-rle (rle-encode-plist main-deck)) (extra-deck-rle (rle-encode-plist extra-deck)) (side-deck-rle (rle-encode-plist side-deck)) (monster-cards-rle (rle-encode-plist monster-cards)) (spell-cards-rle (rle-encode-plist spell-cards)) (trap-cards-rle (rle-encode-plist trap-cards))) (labels ((pad (lst) (let ((max 17)) (append lst (loop for i from (length lst) upto max collect '("" :name "")))))) (list :name (ydk-name-of ydk) :set nil :length (ydk-length ydk) :created-by created-by :first-date nil :final-date nil :monster-cards monster-cards :spell-cards spell-cards :trap-cards trap-cards :main-deck main-deck :side-deck side-deck :extra-deck extra-deck :monster-cards-rle (pad monster-cards-rle) :spell-cards-rle (pad spell-cards-rle) :trap-cards-rle (pad trap-cards-rle) :main-deck-rle (pad main-deck-rle) :side-deck-rle (pad side-deck-rle) :extra-deck-rle (pad extra-deck-rle))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defmethod %to-string ((ydk ydk)) (with-slots (created-by main-deck extra-deck side-deck) ydk (with-output-to-string (s) (format s "~A~%" (if created-by created-by "created by...")) (format s "#main~%") (dolist (card-name (coerce main-deck 'list)) (format s "~A~%" card-name)) (format s "#extra~%") (dolist (card-name (coerce extra-deck 'list)) (format s "~A~%" card-name)) (format s "!side~%") (dolist (card-name (coerce side-deck 'list)) (format s "~A~%" card-name)) s)))