Merge hsx/group into hsx/utils

hsx-test.asd

@@ -4,6 +4,5 @@
   :depends-on ("rove"
                "hsx-test/utils"
                "hsx-test/element"
-               "hsx-test/group"
                "hsx-test/hsx")
   :perform (test-op (o c) (symbol-call :rove :run c :style :dot)))

src/element.lisp

@@ -1,12 +1,10 @@
 (defpackage #:hsx/element
   (:use #:cl)
   (:import-from #:hsx/utils
+                #:defgroup
                 #:escape-html-attribute
                 #:escape-html-text-content
                 #:minify)
-  (:import-from #:hsx/group
-                #:self-closing-tag-p
-                #:non-escaping-tag-p)
   (:export #:element
            #:tag
            #:html-tag
@@ -22,6 +20,15 @@
            #:render-to-string))
 (in-package #:hsx/element)
 
+;;; tag group definitions
+
+(defgroup self-closing-tag
+  area base br col embed hr img input
+  link meta param source track wbr)
+
+(defgroup non-escaping-tag
+  script style)
+
 ;;;; class definitions
 
 (defclass element ()

src/utils.lisp

@@ -1,10 +1,13 @@
 (defpackage #:hsx/utils
   (:use #:cl)
   (:import-from #:alexandria
-                #:alist-hash-table)
+                #:alist-hash-table
+                #:make-keyword
+                #:symbolicate)
   (:export #:escape-html-attribute
            #:escape-html-text-content
-           #:minify))
+           #:minify
+           #:defgroup))
 (in-package #:hsx/utils)
 
 (defparameter *text-content-escape-map*
@@ -55,3 +58,18 @@
 
 (defun whitespace-p (char)
   (member char '(#\Space #\Newline #\Tab #\Return) :test #'char=))
+
+(defun make-keyword-hash-table (symbols)
+  (let ((ht (make-hash-table)))
+    (mapcar (lambda (sym)
+              (setf (gethash (make-keyword sym) ht) t))
+            symbols)
+    ht))
+
+(defmacro defgroup (name &body symbols)
+  (let ((param-name (symbolicate '* name '*))
+        (pred-name (symbolicate name '-p)))
+    `(progn
+       (defparameter ,param-name (make-keyword-hash-table ',symbols))
+       (defun ,pred-name (keyword)
+         (gethash keyword ,param-name)))))

tests/utils.lisp

@@ -21,3 +21,19 @@
                      toggle() { this.open = ! this.open },
                  }")
                  "{ open: false, get isOpen() { return this.open }, toggle() { this.open = ! this.open }, }"))))
+
+(defgroup fruit
+  apple banana)
+
+(deftest group-util-test
+  (testing "defgroup"
+    (ok (expands '(defgroup fruit apple banana)
+                 '(progn
+                   (defparameter *fruit*
+                     (hsx/utils::make-keyword-hash-table '(apple banana)))
+                   (defun fruit-p (keyword)
+                     (gethash keyword *fruit*)))))
+    (ok (hash-table-p *fruit*))
+    (ok (fboundp 'fruit-p))
+    (ok (fruit-p :apple))
+    (ng (fruit-p :tomato))))