cl-deck-builder2/src/web/search.lisp

#|

src/web/search.lisp

This is some ancient old dusty code that had preminitions of how
things would work in the future.

The idea was that there'd be a list of default parameters, maybe
you've seen it in the code, *SEARCH-DEFAULTS*. And this machinery
would query that default, then build an SQL query to hit the
database based on what was read from Caveman2.

This code needs a rewrite.

|#

(in-package #:cl-deck-builder2.web)

;; TODO defstruct search-params?
(defparameter *search-defaults*
  '(("direction" . "asc")
    ("limit" . "10")
    ("name" . "")
    ("variant" . (1 . "on"))
    ("offset" . "0")
    ("sort-by" . "id")))

(defun make-op-list (kind name value &key (fuzzy nil))
  (if fuzzy
      (setf kind "LIKE"
            value (format nil "%~a%" value)))
  (list
   (alexandria:make-keyword kind)
   (alexandria:make-keyword (string-upcase
                             (substitute #\_ #\- name)))
   value))

(defparameter +param-field-whitelist+
  '("amazon-asin" "barcode" "brand" "buy-price" "category" "code" "created-by"
    "deck-id" "desc" "description" "domestic-only" "edition" "email" "id" "kind"
    "linkmarkers" "linkval" "manufacturer-sku" "max-qty" "msrp" "parent" "price"
    "product-name" "rarity" "rarity-code" "sell-price" "tax-exempt" "total-qty"
    "url" "weight" "wishlists" "atk" "def" "level" "scale" "passcode" "type"
    "frame-type" "race" "attribute" "archetype" "name" "opt-qty" "qty" "condition")
  "A whitelist of keywords allowed by user input on the database side.")

(defun filter-alist (alist &optional (whitelist +param-field-whitelist+))
  "Filter ALIST by CAR matching MEMBER in WHITELIST."
  (remove-if (lambda (pair)
               (destructuring-bind (key . value)
                   pair
                 (if (and (member key whitelist :test #'equal)
                          value
                          (> (length value) 0))
                     nil
                     t)))
             alist))

;; (defparameter *variant-id*
;;   (mito:object-id (find-dao 'variant :name "Near Mint")))

(defun make-where-clause (alist)
  "Helper function. Will rewrite ALIST into a series of SXQL queries. This is terrible, and needs a rewrite."
  (let* ((fuzzy-match (query-param "fuzzy-match" alist))
         (op (or (query-param "and-or" alist) "and"))
         (params (or
                  (remove nil
                          (mapcar
                           (lambda (pair)
                             (destructuring-bind (name . value)
                                 pair
                               (when (string= name "product-name")
                                 (setf name "name"))
                               (when (and value (> (length value) 0))
                                 (let ((kind (make-kind name alist))
                                       (fuzzy (and (string= name "name")
                                                   (string= fuzzy-match "on"))))
                                   (make-op-list kind name value :fuzzy fuzzy)))))
                           (filter-alist alist)))
                  (list (sxql:make-op :not-null :name)))))
    (sxql:where
     (apply #'sxql:make-op (alexandria:make-keyword (string-upcase op))
            params))))

;; TODO This isn't terrible but I don't know how to improve
(defun make-kind (kind alist)
  (if
   (or (string= kind "atk")
       (string= kind "def")
       (string= kind "level")
       (string= kind "scale"))
   (let ((param (query-param (format nil "~a-kind" kind) alist)))
     (cond ((string= "eq" param) "=")
           ((string= "ge" param) ">=")
           ((string= "le" param) "<=")
           ((string= "lt" param) "<")
           ((string= "gt" param) ">")
           (t "=")))
   "="))

;; TODO default arguments
(defun make-search-query (class _parsed)
  (let ((direction (or (query-param "direction" _parsed) "desc"))
        (limit (or (query-param "limit" _parsed) "10"))
        (sort-by (or (query-param "sort-by" _parsed) "id"))
        (offset (or (query-param "offset" _parsed) "0")))
    (with-connection (db)
      (with-transaction
        (mito:select-dao class
          (sxql:limit limit)
          (sxql:offset offset)
          (make-order-by direction sort-by)
          (make-where-clause _parsed))))))

;; TODO this is bad and could be re-written using mito:count-dao maybe?
(defun make-count-query (class _parsed)
  (let ((place  (with-connection (db)
                  (with-transaction
                    (mito:retrieve-by-sql
                     (sxql:select
                         ((:as (:count :id) :count))
                       (sxql:from
                        (alexandria:make-keyword
                         (string-upcase
                          (mito.class:table-name (find-class class)))))
                       (make-where-clause _parsed)))))))
  (getf (car place) :count)))

(defun make-order-by (direction sort-by)
  "Construct SXQL:ORDER-BY list values"
  (let ((dir (if (string= direction "asc")
                 :asc
                 :desc))
        (sortby (if (member sort-by +param-field-whitelist+ :test #'string=)
                    (alexandria:make-keyword
                     (string-upcase sort-by))
                    :id)))
    (sxql:order-by (list dir sortby))))