(in-package #:shtml)

(defun trim-flatten-assoc (lst)
  (loop :for (i . j) :in lst
        :when j :append (list i j)))

(defun downcase-name (s)
  (string-downcase (symbol-name s)))

(defun separate-keys (lst)
  (let (keys body)
    (loop :while lst
          :if (keywordp (car lst))
          :do (progn
                (push (pop lst) keys)
                (push (pop lst) keys))
          :else
          :do (push (pop lst) body))
    (cons (cons 'list (reverse body)) (reverse keys))))

(defmacro define-html (tag &key single attrs)
  (let* ((args (gensym))
         (attrs (append (list 'style 'lang 'id 'class 'title 'hidden) attrs))
         (tag-name (downcase-name tag))
         (attrs-and-values (cons 'list
                                 (mapcar (lambda (attr)
                                           (list 'cons (downcase-name attr) attr))
                                         attrs))))
    (if (eq single nil)
      `(defmacro ,tag (&rest ,args)
         (let ((body (gensym))
               (parsed-args (separate-keys ,args)))
           `((lambda (,body &key ,@',attrs)
              (format nil "<~a~{ ~a=~s~}>~{~a~^ ~}</~a>"
                      ,,tag-name
                      (trim-flatten-assoc ,',attrs-and-values)
                      ,body
                      ,,tag-name)) ,@parsed-args)))
      `(defun ,tag (&key ,@attrs)
         (format nil "<~a ~{~a=~s~^ ~}>"
                 ,tag-name
                 (trim-flatten-assoc ,attrs-and-values))))))

(define-html html)
(define-html head)
(define-html title)
(define-html body)
(define-html h1)
(define-html h2)
(define-html h3)
(define-html h4)
(define-html h5)
(define-html h6)
(define-html p)
(define-html br :single t)
(define-html hr :single t)