cl-deck-builder2/src/models/crystal-commerce-csv.lisp

#|

src/models/crystal-commerce-csv.lisp

Crystal Commerce Search CSV Export / Import functionality.

This code is so old. It dates back to May. I mistakenly assumed we
would get access to Crystal Commerce or TCGPlayer API data.

Instead, I based my initial database design off of the CSV export
data. The CSV export data does not supply the following necessary
fields: Passcode (Card Image), Variants (Condition).

I learned July 15 that this design was insufficient and set out to
replace it with something more robust. Within 2 weeks by the beginning
of August I had conceptualized a new design, and by the second week of
August, had implemented that design. That is currenly YGOPRODECK-2.

There is some munging facility in here that I wrote while munging the
YGOProDeck API data during the v2 rewrite.

TODO This needs to be rewritten to match the new YGOProDeck v3
API. Currently we scan in the Product Name, it could be split out to
match the corresponding db entry.

TODO Some time in October I became aware we have access to Crystal Commerce API now.

https://crystal-service.readme.io/docs/get-started-with-the-admin-api
https://crystal-service.readme.io/reference/get_api-v1-activity-logs

|#

(in-package #:cl-user)

(defpackage #:cl-deck-builder2.models.crystal-commerce.csv
  (:use #:cl
        #:cl-deck-builder2.db
        #:cl-deck-builder2.models.generics
        #:cl-deck-builder2.models.crystal-commerce)
  (:import-from #:cl-deck-builder2.toolkit
                #:grouped)
  (:local-nicknames (#:v #:org.shirakumo.verbose))
  (:export #:*cc-csv-import-fields*
           #:*cc-csv-header-fields*
           #:csv-import-cc))

(in-package #:cl-deck-builder2.models.crystal-commerce.csv)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; CSV Import
(defvar *csv* nil
  "The currently loaded CSV data.")

(defvar *card-sets* nil
  "Data loaded from CARD-SET table. We use datafly for this one because
mito conses a lot for CLOS. A PLIST is faster.")

(defvar *cc-csv-import-fields*
  '("Product Name"
    "Category"
    "Total Qty"
    "Wishlists"
    "Buy Price"
    "Sell Price"
    "URL"
    "Barcode"
    "Manufacturer SKU"
    "Amazon ASIN"
    "MSRP"
    "Brand"
    "Weight"
    "Description"
    "Max Qty"
    "Domestic Only"
    "Tax Exempt")
  "Crystal Commerce header fields via CSV import. We transform this into *CC-CSV-HEADER-FIELDS*.

SEE *CC-CSV-HEADER-FIELDS*.")

(defvar *cc-csv-header-fields*
  (mapcar (lambda (s)
            (alexandria:make-keyword
             (string-upcase
              (substitute #\- #\Space s))))
          *cc-csv-import-fields*)
  "Transformed list of Keyword-ified header fields. That is, we take *CC-CSV-IMPORT-FIELDS* and transform the strings into keywords:

    \"Product Name\" => :PRODUCT-NAME.")

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun load-csv (maybe-pathname &optional (force nil))
  "Cache CSV data from MAYBE-PATHNAME which may be a PATHNAME or a STRING containing CSV data."
  (if (or force
          (null *csv*))
      (progn
        (v:info :cc-csv "Loading CSV from ~A~%"
                (typecase maybe-pathname
                  (pathname maybe-pathname)
                  (string 'STRING)))
        (setf *csv*
              ;; Skip the first header line
              (rest
               (cl-csv:read-csv maybe-pathname))))
      (v:info :cc-csv "Using previously loaded CSV data of length ~d~%" (length *csv*))))

(defun load-card-sets ()
  "Cache CARD-SET info to match up from PRODUCT-NAME."
  (unless *card-sets*
    (with-datafly-connection (db)
      (with-datafly-transaction
        (setf *card-sets*
              (datafly:retrieve-all
               (sxql:select (:code :passcode)
                 (sxql:from :ygo_set))))))))

;; TODO update this code with the new YGOProDeck stuff
(defun normalize-product-name (name)
  "Given a PRODUCT-NAME, apply the extracted data from the string: Name,
Set Code, Rarity, and Edition. Return a property list that can be
passed to SXQL:SET=."
  (let ((normalized-name name))
    ;; XXX EW
    ;; Replace things like "Rare-" and "Common-" With "Rare" and "Common"
    (setf normalized-name (cl-ppcre:regex-replace "(\\w+)- " normalized-name "\\1"))
    ;; A few single cards is borked
    (setf normalized-name (cl-ppcre:regex-replace "MRD-EN134 - Unlimited" normalized-name "MRD-EN134 - Common - Unlimited"))
    (setf normalized-name (cl-ppcre:regex-replace "SXG3-ENE05" normalized-name "SGX3-ENE05"))
    (setf normalized-name (cl-ppcre:regex-replace "wCPP-EN002" normalized-name "WCPP-EN002"))
    ;; This set was borknd
    ;; Maybe not, maybe it just doesn't have a Limited/Unlimited status?
    ;; (setf normalized-name (cl-ppcre:regex-replace "TKN4-([^ ]+) - Super Rare" normalized-name "TKN4-\\1 - Super Rare - Unlimited"))
    ;; Replace things like Rare 1st Edition with Rare - 1st Edition
    (setf normalized-name (cl-ppcre:regex-replace "(Common|Rare) (1st|Limited|Unlimited)" normalized-name "\\1 - \\2"))
    (let ((parts (reverse
                  (cl-ppcre:split " \\s?[-–] \\s?" normalized-name))))
      (case (length parts)
        (1 `(:name ,(first parts)))
        (2 `(:name ,(format nil "~{~A~^ - ~}" parts)))
        (3 `(:name ,(first parts)
             :code ,(second parts)
             :rarity ,(third parts)))
        (4 `(:name ,(first parts)
             :code ,(second parts)
             :rarity ,(third parts)
             :edition ,(fourth parts)))
        (5 `(:name ,(format nil "~{~A~^ - ~}" (subseq parts 0 2))
             :code ,(third parts)
             :rarity ,(fourth parts)
             :edition ,(fifth parts)))
        (6 `(:name ,(format nil "~{~A~^ - ~}" (subseq parts 0 3))
             :code ,(fourth parts)
             :rarity ,(fifth parts)
             :edition ,(sixth parts)))
        (otherwise (format t "Skipping data: ~a~%" name))))))

;; (defparameter *db-variants*
;;   (let ((ht (make-hash-table)))
;;     (loop for variant in (select-dao 'variant) do
;;       (setf (gethash (variant-name-of variant) ht) variant))
;;     ht))

;; TODO clean up the field names to auto generate
;;
;; TODO I added some additional fields, opt-qty reserved-qty condition language
;; I guess we will need one of each in the db...
(defun csv-import-cc (csv)
  "Import the perfect data from Crystal Commerce. Do nothing with it but import it into the table."
  (load-csv csv)

  (v:info :cc-csv "CSV Loaded")
  ;; (load-card-sets)
  ;; (format t "Card sets loaded from DB~&")
  
  (let ((csv-items (seed-csv-items)))
    (pre-seed-db-items csv-items))

  (v:info :cc-csv "done.~&"))

(defun seed-csv-items ()
  (let ((csv-items '()))
    (with-connection (db)
      (with-transaction
        (dolist (row *csv*)
          (let ((row-plist (mapcan #'list *cc-csv-header-fields* row)))
            (push (or (mito:find-dao 'cc-item :product-name (getf row-plist :product-name))
                      (apply #'make-instance 'cc-item row-plist))
                  csv-items)))))
    (v:info :cc-csv "CSV Items: ~d" (length csv-items))

    (unless (mito:dao-synced (car csv-items))
      (do-grouped-insert csv-items))))

(defun pre-seed-db-items (cc-items)
  (let ((db-items '()))
    (with-connection (db)
      (with-transaction
        (dolist (cc-item cc-items)
          (dolist (variant (select-dao 'variant))
            (push (or (mito:find-dao 'ygo-cc-item :item-id (mito:object-id cc-item)
                                                  :variant-id (mito:object-id variant))
                      (make-instance 'ygo-cc-item
                                     :item cc-item
                                     :variant variant))
                  db-items)))))
    (v:info :cc-csv "DB Items: ~d" (length db-items))

    (unless (mito:dao-synced (car db-items))
      (do-grouped-insert db-items))))