(in-package whitespace.utils)

(defun ensure-mapping (list)
  "Make sure that each item of the list is a pair of symbols"
  (mapcar (lambda (x) (if (symbolp x) (list x x) x)) list))
(export 'ensure-mapping)

(defun alist-string-hash-table (alist)
  (alexandria:alist-hash-table alist :test #'string=))
(export 'alist-string-hash-table)

(defun make-pairs (symbols)
  (cons 'list (iterate (for (key value) in symbols)
                       (collect (list 'list* (symbol-name key) value)))))
(export 'make-pairs)

(defmacro copy-slots (slots from-v to-v)
  (with-gensyms (from to)
    `(let ((,from ,from-v) (,to ,to-v))
       ,@(iterate (for (fro-slot to-slot) in (ensure-mapping slots))
                  (collect `(setf (slot-value ,to ',to-slot) (slot-value ,from ',fro-slot))))
       ,to)))
(export 'copy-slots)


(defun transform-alist (pair-transform alist)
  (iterate (for (k . v) in-sequence alist)
           (collect
             (funcall pair-transform k v))))
(export 'transform-alist)

(defun %json-pair-transform (k v)
  (cons (make-keyword (string-downcase k))
        (typecase v
          (string (coerce v 'simple-string))
          (t v))))
(export '%json-pair-transform)

(defun %default-pair-transform (k v)
  (cons (make-keyword (string-upcase k)) v))
(export '%default-pair-transform)

(defmacro default-when (default test &body body)
  (once-only (default)
    `(or (when ,test
           ,@body)
         ,default)))
(export 'default-when)

(defmacro transform-result ((list-transform pair-transform) &body alist)
  `(funcall ,list-transform
            (transform-alist ,pair-transform
                             ,@alist)))
(export 'transform-result)


(defmacro slots-to-pairs (obj (&rest slots))
  (once-only (obj)
    (let* ((slots (ensure-mapping slots))
           (bindings (iterate (for (slot v &key bind-from) in slots)
                              (collect (or bind-from slot)))))
      `(with-slots ,bindings ,obj
         ,(make-pairs slots)))))
(export 'slots-to-pairs)

(defun normalize-html (html)
  (let ((plump-parser:*tag-dispatchers* plump:*html-tags*))
    (with-output-to-string (ss)
      (prog1 ss
        (map 'vector
           (lambda (x) (plump:serialize (plump:parse (plump:text x)) ss))
           html)))))
(export 'normalize-html)