cl-deck-builder2/src/models/qr-code.lisp

#|

QR Code Model

Constantly fixing their user input was getting janky. DEFCLASS to the rescue!

TODO This is still pretty clumbsy. I'm generating HTML in here??

Originally I was using INITIALIZE-INSTANCE but that would clobber the
object with the DEFAULT-INITARGS. Now we're overriding
REINITIALIZE-INSTANCE, which seems to work exactly as you'd expect.

|#

(in-package #:cl-deck-builder2.models.qr-code)

;; XXX
(defparameter *qr-public-file* #P"~/public/qr.png")

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defclass qr-settings ()
  ((string :accessor qr-string
           :initarg :string)
   (min-version :accessor qr-min-version
                :initarg :min-version)
   (ec-level :accessor qr-ec-level
             :initarg :ec-level)
   (encoding-mode :accessor qr-encoding-mode
                  :initarg :encoding-mode)
   (mask-number :accessor qr-mask-number
                :initarg :mask-number)
   (output-path :accessor qr-output-path
                :initarg :output))
  (:default-initargs
   :ec-level :L
   :encoding-mode :8-BIT-BYTE
   :mask-number -1
   :min-version 1
   :output #P"/tmp/qr.png"
   :string "Hello World"))

(defmethod reinitialize-instance :after ((qr-settings qr-settings) &rest initargs &key content &allow-other-keys)
  (declare (ignore initargs))
  (when content
    (reinitialize-with-content qr-settings content)))

;; Overwrite existing slots even if they're SLOT-BOUNDP with SLOT-VALUE
(defmethod reinitialize-with-content ((qr-settings qr-settings) content)
  ;; TODO ALIST-PARAMS-to-class? The idea is there...
  (alexandria:if-let ((string (query-param "string" content)))
    (setf (qr-string qr-settings) string))

  (alexandria:if-let ((min-version (query-param "min-version" content)))
    (setf (qr-min-version qr-settings) (parse-integer min-version)))

  (alexandria:if-let ((ec-level (query-param "ec-level" content)))
    (setf (qr-ec-level qr-settings) (alexandria:make-keyword ec-level)))

  (alexandria:if-let ((encoding-mode (query-param "encoding-mode" content)))
    (setf (qr-encoding-mode qr-settings) (alexandria:make-keyword encoding-mode)))

  (alexandria:if-let ((mask-number (query-param "mask-number" content)))
    (setf (qr-mask-number qr-settings) (parse-integer mask-number)))
  qr-settings)

;; TODO %from-plist
;; TODO %from-alist?
(defmethod qr-to-plist ((qr-settings qr-settings) &optional html)
  (let ((params
          (list :ec-level (qr-ec-level qr-settings)
                :encoding-mode (qr-encoding-mode qr-settings)
                :mask-number (qr-mask-number qr-settings)
                :min-version (qr-min-version qr-settings))))
    (when html
      (setf (getf params :string) (qr-string qr-settings)
            (getf params :ec-level) (princ-to-string (getf params :ec-level))
            (getf params :encoding-mode) (princ-to-string (getf params :encoding-mode))))
    params))

(defmethod qr-generate ((qr qr-settings))
  (v:info :qr "QR-STRING: ~a" (qr-string qr))

  (v:info :qr "UIOP:DELETE-FILE-IF-EXISTS: ~a"
          (ignore-errors
           (mapcar #'uiop:delete-file-if-exists '(#P"/tmp/qr.png" #P"~/public/qr.png"))))

  (v:info :qr "LISPQR:ENCODE->IMAGE: ~a"
          (ignore-errors
           (apply #'lispqr:encode->image (qr-string qr) (qr-output-path qr)
                  (qr-to-plist qr))))

  (v:info :qr "UIOP:COPY-FILE: ~a"
          (ignore-errors
           (uiop:copy-file (qr-output-path qr) *qr-public-file*)))

  (if (probe-file *qr-public-file*)
      (qr-format-html (get-universal-time))))

(defun qr-format-html (when)
  (format nil "<img class=\"card image\" src=\"/public/qr.png?~d\" alt=\"QR Code\">" when))