cl-deck-builder2/src/models/ydk.lisp

#|

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