GitHub
commit
5cf3cad8b8
17 changed files with 443 additions and 1211 deletions
379
README.md
379
README.md
|
|
@ -1,382 +1,13 @@
|
|||
# Piccolo
|
||||
# HSX (WIP)
|
||||
|
||||
⚠️ **This repository is undergoing a comprehensive overhaul.** (https://github.com/skyizwhite/piccolo/issues/14)
|
||||
|
||||
Piccolo, a fork of [flute](https://github.com/ailisp/flute), is a beautiful, easily composable HTML5 generation library for Common Lisp.
|
||||
|
||||
It's
|
||||
|
||||
- Simple: the most simplistic syntax, for builtin and customized elements;
|
||||
- Easy to debug: pretty print generated html snippet in REPL;
|
||||
- Powerful: help you define reusable and composable components, like that in React
|
||||
- Modern: focus only on HTML5
|
||||
|
||||
# Differences from Flute
|
||||
|
||||
- New features:
|
||||
- Fragment `(<> ...)`: This allows you to group elements without a wrapper element.
|
||||
- Boolean attributes support (e.g. `checked`, `disabled`): If the value is
|
||||
- `nil`: Nothing is rendered.
|
||||
- `t`: Only the key is rendered.
|
||||
- non-boolean: The key/value pair is rendered.
|
||||
- `props`: If the properties assigned to a component are not declared within the `define-element` macro, they are automatically collected into the `props` property list. This allows for flexible passing of props to the component.
|
||||
|
||||
```lisp
|
||||
(<>
|
||||
(div)
|
||||
(div))
|
||||
|
||||
; <div></div>
|
||||
; <div></div>
|
||||
|
||||
(script :defer t)
|
||||
|
||||
; => <script defer></script>
|
||||
|
||||
(script :defer nil)
|
||||
|
||||
; => <script></script>
|
||||
|
||||
(define-element view-more ()
|
||||
(a props
|
||||
"View More"))
|
||||
|
||||
(view-more :href "/detail" :class "m-1")
|
||||
|
||||
; <a href="/detail" class="m-1">View More</a>
|
||||
|
||||
```
|
||||
|
||||
- Improved:
|
||||
- Element functions are wrapped in macros for natural indentation. To manipulate them directly, prefix '%' to the element name.
|
||||
- Bugfix. https://github.com/ailisp/flute/issues/5, https://github.com/ailisp/flute/issues/7
|
||||
|
||||
```lisp
|
||||
(define-element tag (as)
|
||||
(funcall as props children))
|
||||
|
||||
(tag :as #'%span :class "bold" "child")
|
||||
|
||||
; <span class="bold">child</span>
|
||||
```
|
||||
|
||||
- Removed:
|
||||
- Attributes like CSS selectors (e.g. `div#id.class`)
|
||||
- ASCII-based escaping. Piccolo only supports UTF-8.
|
||||
|
||||
# Getting started
|
||||
|
||||
## Install and run tests
|
||||
|
||||
```lisp
|
||||
(ql:quickload :piccolo)
|
||||
(ql:quickload :piccolo-test)
|
||||
```
|
||||
|
||||
Then define a new package specifically for HTML generation, in its definition:
|
||||
```lisp
|
||||
(defpackage piccolo-user
|
||||
(:use :cl :piccolo))
|
||||
```
|
||||
If you don't want to import all symbols, see [H Macro](#h-macro), which provide a similar interface as a traditional Lisp HTML generation library.
|
||||
|
||||
## Using html elements
|
||||
```
|
||||
(html
|
||||
(head
|
||||
(link :rel "...")
|
||||
(script :src "..." :defer t))
|
||||
(body
|
||||
(div :id "a" :class "b"
|
||||
(p :style "color: red"
|
||||
"Some text")
|
||||
"Some text in div"
|
||||
(img :src "/img/dog.png")
|
||||
(a '(:href "/cat")
|
||||
(img '((:src . "/img/cat.png")))))))
|
||||
```
|
||||
|
||||
These `html`, `div`, etc. are just functions. Element attribute can be given inline as the above example, or as alist/plist/attrs object as the first argument, like the last `a` and `img` in the above example. In this case they can be variables that calculated programmatically.
|
||||
|
||||
The remaining argument will be recognized as the children of this element. Each child can be:
|
||||
1. string;
|
||||
2. element, builtin or user defined;
|
||||
3. list of 1, 2 and 3. Can also be NIL.
|
||||
All children will be flattened as if they're given inline.
|
||||
|
||||
## Define new element
|
||||
```lisp
|
||||
(define-element dog (id size)
|
||||
(if (and (realp size) (> size 10))
|
||||
(div :id id :class "big-dog"
|
||||
children
|
||||
"dog")
|
||||
(div :id id :class "small-dog"
|
||||
children
|
||||
"dog")))
|
||||
```
|
||||
`dog` will be defined as a function that takes `:id` and `:size` keyword arguments. `dog` returns an user-defined element object. Inside it, `children` will be replaced with the children elements you provided when creating this `dog`:
|
||||
```
|
||||
piccolo-USER> (defparameter *dog1* (dog :id "dog1" :size 20))
|
||||
*DOG1*
|
||||
piccolo-USER> *dog1*
|
||||
<div id="dog1" class="big-dog">dog</div>
|
||||
piccolo-USER> (dog :id "dog2" "I am a dog" *)
|
||||
<div id="dog2" class="small-dog">
|
||||
I am a dog
|
||||
<div id="dog1" class="big-dog">dog</div>
|
||||
dog
|
||||
</div>
|
||||
```
|
||||
|
||||
All elements, both builtin and user defined ones are objects, although they're printed as html snippet in REPL. Their attribute can be accessed by `(element-attrs element)`. Their children can be accessed by `(element-children elements)` and tag name by `(element-tag element)`. You can modify an exising element's attrs and children. If you modify a user defined element, the body you defined in it's `define-element` also re-executed to take effect of the the attrs and children change:
|
||||
```
|
||||
piccolo-USER> *dog1*
|
||||
<div id="dog1" class="big-dog">dog</div>
|
||||
piccolo-USER> (setf (attr *dog1* :size) 10
|
||||
;; attr is a helper method to set (piccolo:element-attrs *dog1*)
|
||||
(attr *dog1* :id) "dooooog1"
|
||||
(element-children *dog1*) (list "i'm small now"))
|
||||
("i'm small now")
|
||||
piccolo-USER> *dog1*
|
||||
<div id="dooooog1" class="small-dog">
|
||||
i'm small now
|
||||
dog
|
||||
</div>
|
||||
```
|
||||
|
||||
By default user element is printed as what it expand to. If you have a lot of user defined element nested deeply, you probably want to have a look at the high level:
|
||||
```
|
||||
piccolo-USER> (let ((*expand-user-element* nil))
|
||||
(print *dog1*)
|
||||
(values))
|
||||
|
||||
<dog id="dooooog1" size=10>i'm small now</dog>
|
||||
; No value
|
||||
piccolo-USER>
|
||||
```
|
||||
|
||||
## Generate HTML
|
||||
To generate a piece of HTML string that probably used in a response of a backend service:
|
||||
```lisp
|
||||
(elem-str element)
|
||||
```
|
||||
To generate HTML string that has nice indent as that in REPL:
|
||||
```lisp
|
||||
(element-string element)
|
||||
```
|
||||
To generate that and write to file, just create a stream, then `(write element :stream stream)` for human or `(write element :stream stream :pretty nil)` for production.
|
||||
|
||||
## H macro
|
||||
If you don't want to import all the symbols, you can use the `h` macro:
|
||||
```lisp
|
||||
(defpackage piccolo-min
|
||||
(:use :cl)
|
||||
(:import-from :piccolo
|
||||
:h
|
||||
:define-element))
|
||||
```
|
||||
Then just wrap `h` for all html generation part. In the same examples above, it becomes:
|
||||
``` lisp
|
||||
(in-package :piccolo-min)
|
||||
(h (html
|
||||
(head
|
||||
(link :rel "...")
|
||||
(script :src "..."))
|
||||
(body
|
||||
(div :id "a" :class "b"
|
||||
(p :style "color: red"
|
||||
"Some text")
|
||||
"Some text in div"
|
||||
(img :src "/img/dog.png")
|
||||
(a '(:href "/cat")
|
||||
(img '((:src . "/img/cat.png"))))))))
|
||||
|
||||
(define-element dog (id size)
|
||||
(if (and (realp size) (> size 10))
|
||||
(h (div :id id :class "big-dog"
|
||||
piccolo:children
|
||||
"dog"))
|
||||
(h (div :id id :class "small-dog"
|
||||
piccolo:children
|
||||
"dog"))))
|
||||
|
||||
(defparameter *dog2* (dog :id "dog2" :size 20 "some children"))
|
||||
```
|
||||
|
||||
That's all you need to know to define elements and generate html. Please reference the [API Reference](#api-reference) Section for detailed API.
|
||||
|
||||
# Motivation
|
||||
Currently there're a few HTML generation library in Common Lisp, like [CL-WHO](https://edicl.github.io/cl-who/), [CL-MARKUP](https://github.com/arielnetworks/cl-markup) and [Spinneret](https://github.com/ruricolist/spinneret). They both have good features for generating standard HTML, but not very good at user element (components) that currently widely used in frontend: you need to define all of them as macros and to define components on top of these components, you'll have to make these components more complex macros to composite them. [Spinneret](https://github.com/ruricolist/spinneret) has a `deftag` feature, but `deftag` is still expand to a `defmacro`.
|
||||
|
||||
I'd also want to modify the customer component attribute after create it and incorporate it with it's own logic (like the dog size example above), this logic should be any lisp code. This requires provide all element as object, not plain HTML text generation. With this approach, all elements have a same name function to create it, and returns element that you can modify later. These objects are virtual doms and it's very pleasant to write html code and frontend component by just composite element objects as arguments in element creation function calls. piccolo's composite feature inspired by [Hiccup](https://github.com/weavejester/hiccup) and [Reagent](https://github.com/reagent-project/reagent) but more powerful -- in piccolo, user defined elements is real object with attributes and it's own generation logic.
|
||||
|
||||
# API Reference
|
||||
Here is a draft version of API Reference, draft means it will be better organized and moved to a separate HTML doc, but it's content is already quite complete.
|
||||
|
||||
## Builtin HTML elements
|
||||
```
|
||||
a abbr address area article aside audio b base bdi bdo blockquote
|
||||
body br button canvas caption cite code col colgroup data datalist
|
||||
dd del details dfn dialog div dl dt em embed fieldset figcaption
|
||||
figure footer form h1 h2 h3 h4 h5 h6 head header hr i iframe html
|
||||
img input ins kbd label legend li link main |map| mark meta meter nav
|
||||
noscript object ol optgroup option output p param picture pre progress
|
||||
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
|
||||
thead |time| title tr track u ul var video wbr
|
||||
```
|
||||
All of above HTML5 elements are functions, which support same kinds of parameters, take `A` as example:
|
||||
``` lisp
|
||||
;; Function A &REST ATTRS-AND-CHILREN
|
||||
;;
|
||||
;; Create and return an <a> element object
|
||||
;; ATTRS-AND-CHILDREN can be the following:
|
||||
|
||||
;; 1. an empty <a> tag
|
||||
(a)
|
||||
|
||||
;; 2. attributes of alist, plist or ATTRS object
|
||||
;; The following creates: <a id="aa" customer-attr="bb"></a>
|
||||
(a :id "aa" :customer-attr "bb")
|
||||
(a '(:id "aa" :customer-attr "bb"))
|
||||
(a '((:id . "aa") (:customer-attr . "bb")))
|
||||
;; or assume we have the above one in variable a1
|
||||
(a (element-attrs a1)) ; to share the same attrs with a1
|
||||
(a (copy-attrs (element-attrs a1)))
|
||||
|
||||
;; 3. any of above format attributes with children
|
||||
(a :id "aa" :customer-attr "bb"
|
||||
"Some children"
|
||||
(div '(:id "an element children"))
|
||||
; list of any depth containing elements and texts, will be flattened
|
||||
(list a1 a2 (a '((:id . "aaa")) "some text")
|
||||
(list (h1 "aaa")))
|
||||
"some other text")
|
||||
```
|
||||
The `HTML` element is a little special, it's with `<!DOCTYPE html>` prefix to make sure browser recognize it correctly.
|
||||
|
||||
## User defined elements
|
||||
```lisp
|
||||
;; Macro DEFINE-ELEMENT NAME (&REST ARGS) &BODY BODY
|
||||
;;
|
||||
;; Define a user element with NAME as its tag name and function
|
||||
;; NAME. After DEFINE-ELEMENT, a FUNCTION of NAME in current package
|
||||
;; is defined. ARGS specified the possible keyword ARGS it can take as
|
||||
;; it's ATTRS. You can either use these ARGS as Lisp arguments in the
|
||||
;; BODY of its definition and plug in them to the BODY it expand to.
|
||||
;; You can use piccolo:CHILDREN to get or set it's children that you give
|
||||
;; when call function NAME, piccolo:ATTRS to get or set it's attributes
|
||||
;; and piccolo:TAG to get or set it's tag name.
|
||||
|
||||
;; Variable *EXPAND-USER-ELEMENT*
|
||||
;;
|
||||
;; Bind this variable to specify whether the user elements are print in
|
||||
;; a high level (NIL), or expand to HTML elements (T). T by default.
|
||||
```
|
||||
|
||||
## Attribute accessing utility
|
||||
``` lisp
|
||||
;; Function ATTRS-ALIST ATTRS
|
||||
;; Function (SETF ATTRS-ALIST) ATTRS
|
||||
;;
|
||||
;; Return or set the attrs object in alist format
|
||||
|
||||
;; Function MAKE-ATTRS &KEYS ALIST
|
||||
;;
|
||||
;; Create a attrs aoject, given an alist of (:attr . "attr-value") pair.
|
||||
;; Attribute values (cdr of each element in alist) will be escaped if
|
||||
;; *ESCAPE-HTML* is t.
|
||||
|
||||
;; Function COPY-ATTRS ATTRS
|
||||
;;
|
||||
;; Make a copy and return the copy of ATTRS object
|
||||
|
||||
;; Method ATTR ATTRS KEY
|
||||
;; Method (SETF ATTR) ATTRS KEY
|
||||
;; Method ATTR ELEMENT KEY
|
||||
;; Method (SETF ATTR) ELEMENT KEY
|
||||
;;
|
||||
;; Get or set the attribute value of given KEY. KEY should be an keyword.
|
||||
;; If KEY does not exist, ATTR method will return NIL. (SETF ATTR) method
|
||||
;; will create the (KEY . VALUE) pair. Don't use (SETF (ATTR ATTRS :key) NIL)
|
||||
;; or (SETF (ATTR ELEMENT :key) NIL) to remove an attr, use DELETE-ATTR.
|
||||
|
||||
;; Method DELETE-ATTR ATTRS KEY
|
||||
;; Method DELETE-ATTR ELEMENT KEY
|
||||
;;
|
||||
;; Delete the attribute key value pair from ATTRS or ELEMENT's ELEMENT-ATTRS,
|
||||
;; will ignore if KEY doesn't exist.
|
||||
|
||||
```
|
||||
|
||||
## Element slots
|
||||
```lisp
|
||||
;; Method ELEMENT-TAG ELEMENT
|
||||
;; Method (SETF ELEMENT-TAG) ELEMENT
|
||||
;;
|
||||
;; Get or set the ELEMENT-TAG STRING. For example <html>'s ELEMENT-TAG is "html"
|
||||
|
||||
;; Method ELEMENT-ATTRS ELEMENT
|
||||
;; Method (SETF ELEMENT-ATTRS) ELEMENT
|
||||
;;
|
||||
;; Get or set the ELEMENT-ATTRS. When set this, must be an ATTRS object
|
||||
|
||||
;; Method ELEMENT-CHILDREN ELEMENT
|
||||
;; Method (SETF ELEMENT-CHILDREN) ELEMENT
|
||||
;;
|
||||
;; Get or set element children. When set this manually, must given a flatten list
|
||||
;; of ELEMENT or STRING.
|
||||
|
||||
;; Method USER-ELEMENT-EXPAND-TO USER-ELEMENT
|
||||
;;
|
||||
;; Get what this USER-ELEMENT-TO. Returns the root ELEMENT after it expands.
|
||||
```
|
||||
|
||||
## The H macro
|
||||
```lisp
|
||||
;; Macro H &BODY CHILDREN
|
||||
;;
|
||||
;; Like a PROGN, except it will replace all html tag SYMBOLs with the same name one
|
||||
;; in piccolo PACKAGE, so you don't need to import all of them. As an alternative you
|
||||
;; can import all or part of html element functions in piccolo PACKAGE to use them
|
||||
;; without H macro
|
||||
|
||||
```
|
||||
|
||||
## Escape utility
|
||||
```lisp
|
||||
;; Variable *ESCAPE-HTML*
|
||||
;;
|
||||
;; Specify the escape option when generate html with UTF-8, can be t or NIL.
|
||||
;; If t, escape only #\<, #\> and #\& in body, and \" in attribute keys. #\' will
|
||||
;; in attribute keys will not be escaped since piccolo will always use double quote for
|
||||
;; attribute keys.
|
||||
;; If NIL, nothing is escaped and programmer is responsible to escape elements properly.
|
||||
;; All the escapes are done in element creation time.
|
||||
|
||||
;; Function ESCAPE-STRING STRING TEST
|
||||
;;
|
||||
;; Escape the STRING if it's a STRING and escaping all charaters C that satisfied
|
||||
;; (FUNCALL TEST C). Return the new STRING after escape.
|
||||
```
|
||||
|
||||
## Generate HTML string
|
||||
|
||||
``` lisp
|
||||
;; Method ELEMENT-STRING ELEMENT
|
||||
;;
|
||||
;; Return human readable, indented HTML string for ELEMENT
|
||||
|
||||
;; Method ELEM-STR ELEMENT
|
||||
;;
|
||||
;; Return minify HTML string for ELEMENT
|
||||
```
|
||||
HSX (hypertext s-expression) is an incredibly simple HTML5 generation library for Common Lisp.
|
||||
|
||||
This is a fork project of [flute](https://github.com/ailisp/flute/), originally created by Bo Yao.
|
||||
|
||||
# License
|
||||
|
||||
Licensed under MIT License.
|
||||
|
||||
Copyright (c) 2024, skyizwhite.
|
||||
|
||||
Copyright (c) 2018, Bo Yao.
|
||||
Copyright (c) 2018, Bo Yao.
|
||||
|
|
|
|||
8
hsx-test.asd
Normal file
8
hsx-test.asd
Normal file
|
|
@ -0,0 +1,8 @@
|
|||
(defsystem "hsx-test"
|
||||
:class :package-inferred-system
|
||||
:pathname "tests"
|
||||
:depends-on ("fiveam"
|
||||
"hsx-test/element"
|
||||
"hsx-test/hsx"
|
||||
"hsx-test/hsx-macro")
|
||||
:perform (test-op (op c) (symbol-call :fiveam :run-all-tests)))
|
||||
|
|
@ -1,4 +1,4 @@
|
|||
(defsystem "piccolo"
|
||||
(defsystem "hsx"
|
||||
:version "0.1.0"
|
||||
:description "A beautiful, easily composable HTML5 generation library"
|
||||
:author "Bo Yao, skyizwhite"
|
||||
|
|
@ -6,7 +6,7 @@
|
|||
:license "MIT"
|
||||
:long-description #.(uiop:read-file-string
|
||||
(uiop:subpathname *load-pathname* "README.md"))
|
||||
:in-order-to ((test-op (test-op piccolo-test)))
|
||||
:in-order-to ((test-op (test-op hsx-test)))
|
||||
:class :package-inferred-system
|
||||
:pathname "src"
|
||||
:depends-on ("piccolo/main"))
|
||||
:depends-on ("hsx/main"))
|
||||
|
|
@ -1,9 +0,0 @@
|
|||
(defsystem piccolo-test
|
||||
:author "Bo Yao, skyizwhite"
|
||||
:maintainer "skyizwhite <paku@skyizwhite.dev>"
|
||||
:license "MIT"
|
||||
:depends-on (:piccolo :fiveam)
|
||||
:components ((:module "t"
|
||||
:serial t
|
||||
:components
|
||||
((:file "piccolo")))))
|
||||
1
qlfile
1
qlfile
|
|
@ -1,3 +1,2 @@
|
|||
ql fiveam
|
||||
ql assoc-utils
|
||||
ql alexandria
|
||||
|
|
|
|||
|
|
@ -6,10 +6,6 @@
|
|||
(:class qlot/source/ql:source-ql
|
||||
:initargs (:%version :latest)
|
||||
:version "ql-2023-10-21"))
|
||||
("assoc-utils" .
|
||||
(:class qlot/source/ql:source-ql
|
||||
:initargs (:%version :latest)
|
||||
:version "ql-2023-10-21"))
|
||||
("alexandria" .
|
||||
(:class qlot/source/ql:source-ql
|
||||
:initargs (:%version :latest)
|
||||
|
|
|
|||
120
src/element.lisp
Normal file
120
src/element.lisp
Normal file
|
|
@ -0,0 +1,120 @@
|
|||
(defpackage #:hsx/element
|
||||
(:use #:cl)
|
||||
(:export #:element-type
|
||||
#:element-props
|
||||
#:element-children
|
||||
#:create-element
|
||||
#:expand))
|
||||
(in-package #:hsx/element)
|
||||
|
||||
;;;; class definitions
|
||||
|
||||
(defclass element ()
|
||||
((type
|
||||
:reader element-type
|
||||
:initarg :type)
|
||||
(props
|
||||
:reader element-props
|
||||
:initarg :props)
|
||||
(children
|
||||
:reader element-children
|
||||
:initarg :children)))
|
||||
|
||||
(defclass builtin-element (element) ())
|
||||
|
||||
(defclass tag-element (builtin-element) ())
|
||||
|
||||
(defclass html-tag-element (tag-element) ())
|
||||
|
||||
(defclass fragment-element (builtin-element) ())
|
||||
|
||||
(defclass component-element (element) ())
|
||||
|
||||
|
||||
;;;; constructor
|
||||
|
||||
(defun create-element (type props &rest children)
|
||||
(let ((elm (make-instance (cond ((functionp type) 'component-element)
|
||||
((string= type "<>") 'fragment-element)
|
||||
((string= type "html") 'html-tag-element)
|
||||
(t 'tag-element))
|
||||
:type type
|
||||
:props props
|
||||
:children (flatten children))))
|
||||
(create-element-hook elm)
|
||||
elm))
|
||||
|
||||
(defun flatten (x)
|
||||
(labels ((rec (x acc)
|
||||
(cond ((null x) acc)
|
||||
((atom x) (cons x acc))
|
||||
(t (rec
|
||||
(car x)
|
||||
(rec (cdr x) acc))))))
|
||||
(rec x nil)))
|
||||
|
||||
(defmethod create-element-hook ((elm element)))
|
||||
|
||||
(defmethod create-element-hook ((elm fragment-element))
|
||||
(when (element-props elm)
|
||||
(error "Cannot pass props to fragment.")))
|
||||
|
||||
(defmethod create-element-hook ((elm component-element))
|
||||
;dry-run to validate props
|
||||
(expand elm))
|
||||
|
||||
|
||||
;;;; methods
|
||||
|
||||
(defmethod expand ((elm component-element))
|
||||
(with-accessors ((type element-type)
|
||||
(props element-props)
|
||||
(children element-children)) elm
|
||||
(apply type (merge-children-into-props props children))))
|
||||
|
||||
(defun merge-children-into-props (props children)
|
||||
(append props
|
||||
(and children
|
||||
(list :children children))))
|
||||
|
||||
(defmethod print-object ((elm tag-element) stream)
|
||||
(with-accessors ((type element-type)
|
||||
(props element-props)
|
||||
(children element-children)) elm
|
||||
(if children
|
||||
(format stream (if (rest children)
|
||||
"~@<<~a~a>~2I~:@_~<~@{~a~^~:@_~}~:>~0I~:@_</~a>~:>"
|
||||
"~@<<~a~a>~2I~:_~<~a~^~:@_~:>~0I~_</~a>~:>")
|
||||
type
|
||||
(props->string props)
|
||||
children
|
||||
type)
|
||||
(format stream "<~a~a></~a>"
|
||||
type
|
||||
(props->string props)
|
||||
type))))
|
||||
|
||||
(defun props->string (props)
|
||||
(with-output-to-string (stream)
|
||||
(loop
|
||||
:for (key value) :on props :by #'cddr
|
||||
:do (format stream (if (typep value 'boolean)
|
||||
"~@[ ~a~]"
|
||||
" ~a=~s")
|
||||
(string-downcase key)
|
||||
value))))
|
||||
|
||||
(defmethod print-object ((elm html-tag-element) stream)
|
||||
(format stream "<!DOCTYPE html>~%")
|
||||
(call-next-method))
|
||||
|
||||
(defmethod print-object ((elm fragment-element) stream)
|
||||
(with-accessors ((children element-children)) elm
|
||||
(if children
|
||||
(format stream (if (rest children)
|
||||
"~<~@{~a~^~:@_~}~:>"
|
||||
"~<~a~:>")
|
||||
children))))
|
||||
|
||||
(defmethod print-object ((elm component-element) stream)
|
||||
(print-object (expand elm) stream))
|
||||
|
|
@ -1,284 +0,0 @@
|
|||
(uiop:define-package #:piccolo/elements
|
||||
(:use #:cl)
|
||||
(:import-from #:assoc-utils
|
||||
#:aget
|
||||
#:alistp
|
||||
#:delete-from-alistf
|
||||
#:hash-alist)
|
||||
(:import-from #:alexandria
|
||||
#:make-keyword
|
||||
#:plist-alist
|
||||
#:symbolicate)
|
||||
(:import-from #:piccolo/groups
|
||||
#:non-escape-tag-p)
|
||||
(:import-from #:piccolo/escape
|
||||
#:escape-attrs-alist
|
||||
#:escape-children
|
||||
#:*escape-html*)
|
||||
(:export #:html
|
||||
#:%html
|
||||
#:<>
|
||||
#:%<>
|
||||
#:define-element
|
||||
#:tag
|
||||
#:children
|
||||
#:attrs
|
||||
#:props
|
||||
#:attrs-alist
|
||||
#:make-attrs
|
||||
#:copy-attrs
|
||||
#:attr
|
||||
#:delete-attr
|
||||
#:element
|
||||
#:builtin-element
|
||||
#:builtin-element-with-prefix
|
||||
#:user-element
|
||||
#:fragment
|
||||
#:element-tag
|
||||
#:element-attrs
|
||||
#:element-prefix
|
||||
#:element-children
|
||||
#:user-element-expand-to
|
||||
#:h))
|
||||
(in-package #:piccolo/elements)
|
||||
|
||||
;;; classes
|
||||
|
||||
(defclass element ()
|
||||
((tag :initarg :tag
|
||||
:accessor element-tag)
|
||||
(attrs :initarg :attrs
|
||||
:accessor element-attrs)
|
||||
(children :initarg :children
|
||||
:accessor element-children)))
|
||||
|
||||
(defclass builtin-element (element) ())
|
||||
|
||||
(defclass builtin-element-with-prefix (builtin-element)
|
||||
((prefix :initarg :prefix
|
||||
:accessor element-prefix)))
|
||||
|
||||
(defclass user-element (element)
|
||||
((expand-to :initarg :expander
|
||||
:accessor user-element-expander)))
|
||||
|
||||
(defclass fragment (element) ())
|
||||
|
||||
;;; constructors
|
||||
|
||||
(defun make-builtin-element (&key tag attrs children)
|
||||
(make-instance 'builtin-element
|
||||
:tag tag
|
||||
:attrs attrs
|
||||
:children (if (non-escape-tag-p tag)
|
||||
children
|
||||
(escape-children children))))
|
||||
|
||||
(defun make-builtin-element-with-prefix (&key tag attrs children prefix)
|
||||
(make-instance 'builtin-element-with-prefix
|
||||
:tag tag
|
||||
:attrs attrs
|
||||
:prefix prefix
|
||||
:children (escape-children children)))
|
||||
|
||||
(defun make-user-element (&key tag attrs children expander)
|
||||
(make-instance 'user-element
|
||||
:tag tag
|
||||
:attrs attrs
|
||||
:expander expander
|
||||
:children (escape-children children)))
|
||||
|
||||
(defmethod user-element-expand-to ((element user-element))
|
||||
(funcall (user-element-expander element)
|
||||
(element-tag element)
|
||||
(element-attrs element)
|
||||
(element-children element)))
|
||||
|
||||
(defun make-fragment (&key children)
|
||||
(make-instance 'fragment
|
||||
:tag "fragment"
|
||||
:attrs (make-attrs :alist nil)
|
||||
:children (escape-children children)))
|
||||
|
||||
;;; attributes
|
||||
|
||||
(defstruct (attrs (:constructor %make-attrs))
|
||||
alist)
|
||||
|
||||
(defun make-attrs (&key alist)
|
||||
(if *escape-html*
|
||||
(%make-attrs :alist (escape-attrs-alist alist))
|
||||
(%make-attrs :alist alist)))
|
||||
|
||||
(defmethod (setf attr) (value (attrs attrs) key)
|
||||
(setf (aget (attrs-alist attrs) key) value))
|
||||
|
||||
(defmethod delete-attr ((attrs attrs) key)
|
||||
(delete-from-alistf (attrs-alist attrs) key))
|
||||
|
||||
(defmethod attr ((attrs attrs) key)
|
||||
(aget (attrs-alist attrs) key))
|
||||
|
||||
(defmethod (setf attr) (value (element element) key)
|
||||
(setf (attr (element-attrs element) key) value))
|
||||
|
||||
(defmethod delete-attr ((element element) key)
|
||||
(delete-attr (element-attrs element) key))
|
||||
|
||||
(defmethod attr ((element element) key)
|
||||
(attr (element-attrs element) key))
|
||||
|
||||
;;; elements
|
||||
|
||||
(defun flatten (x)
|
||||
(labels ((rec (x acc)
|
||||
(cond ((null x) acc)
|
||||
((atom x) (cons x acc))
|
||||
(t (rec
|
||||
(car x)
|
||||
(rec (cdr x) acc))))))
|
||||
(rec x nil)))
|
||||
|
||||
(defun split-attrs-and-children (attrs-and-children)
|
||||
(cond
|
||||
((attrs-p (first attrs-and-children))
|
||||
(values (first attrs-and-children) (flatten (rest attrs-and-children))))
|
||||
((alistp (first attrs-and-children))
|
||||
(values (make-attrs :alist (first attrs-and-children))
|
||||
(flatten (rest attrs-and-children))))
|
||||
((and (listp (first attrs-and-children))
|
||||
(keywordp (first (first attrs-and-children)))) ;plist
|
||||
(values (make-attrs :alist (plist-alist (first attrs-and-children)))
|
||||
(flatten (rest attrs-and-children))))
|
||||
((hash-table-p (first attrs-and-children))
|
||||
(values (make-attrs :alist (hash-alist (first attrs-and-children)))
|
||||
(flatten (rest attrs-and-children))))
|
||||
((keywordp (first attrs-and-children)) ;inline-plist
|
||||
(loop :for thing :on attrs-and-children :by #'cddr
|
||||
:for (k v) := thing
|
||||
:when (and (keywordp k) v)
|
||||
:collect (cons k v) :into attrs
|
||||
:when (not (keywordp k))
|
||||
:return (values (make-attrs :alist attrs) (flatten thing))
|
||||
:finally (return (values (make-attrs :alist attrs) nil))))
|
||||
(t
|
||||
(values (make-attrs :alist nil) (flatten attrs-and-children)))))
|
||||
|
||||
(defparameter *builtin-elements* (make-hash-table))
|
||||
(setf (gethash :html *builtin-elements*) t)
|
||||
|
||||
(defun %html (&rest attrs-and-children)
|
||||
(multiple-value-bind (attrs children)
|
||||
(split-attrs-and-children attrs-and-children)
|
||||
(make-builtin-element-with-prefix :tag "html"
|
||||
:attrs attrs
|
||||
:children children
|
||||
:prefix "<!DOCTYPE html>")))
|
||||
|
||||
(defmacro html (&body attrs-and-children)
|
||||
`(%html ,@attrs-and-children))
|
||||
|
||||
(defmacro define-builtin-element (element-name)
|
||||
(let ((%element-name (symbolicate '% element-name)))
|
||||
`(progn
|
||||
(defun ,%element-name (&rest attrs-and-children)
|
||||
(multiple-value-bind (attrs children)
|
||||
(split-attrs-and-children attrs-and-children)
|
||||
(make-builtin-element :tag (string-downcase ',element-name)
|
||||
:attrs attrs
|
||||
:children children)))
|
||||
(defmacro ,element-name (&body attrs-and-children)
|
||||
`(,',%element-name ,@attrs-and-children)))))
|
||||
|
||||
(defmacro define-and-export-builtin-elements (&rest element-names)
|
||||
`(progn
|
||||
,@(mapcan (lambda (e)
|
||||
(list `(define-builtin-element ,e)
|
||||
`(setf (gethash (make-keyword ',e) *builtin-elements*) t)
|
||||
`(export ',e)
|
||||
`(export ',(symbolicate '% e))))
|
||||
element-names)))
|
||||
|
||||
(define-and-export-builtin-elements
|
||||
a abbr address area article aside audio b base bdi bdo blockquote
|
||||
body br button canvas caption cite code col colgroup data datalist
|
||||
dd del details dfn dialog div dl dt em embed fieldset figcaption
|
||||
figure footer form h1 h2 h3 h4 h5 h6 head header hr i iframe
|
||||
img input ins kbd label legend li link main |map| mark meta meter nav
|
||||
noscript object ol optgroup option output p param picture pre progress
|
||||
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
|
||||
thead |time| title tr track u ul var video wbr)
|
||||
|
||||
(defmacro define-element (name (&rest props) &body body)
|
||||
(let ((%name (symbolicate '% name))
|
||||
(attrs (gensym "attrs"))
|
||||
(children (gensym "children"))
|
||||
(raw-children (gensym "raw-children")))
|
||||
`(eval-when (:compile-toplevel :load-toplevel :execute)
|
||||
(defun ,%name (&rest attrs-and-children)
|
||||
(multiple-value-bind (,attrs ,children)
|
||||
(split-attrs-and-children attrs-and-children)
|
||||
(make-user-element
|
||||
:tag (string-downcase ',name)
|
||||
:attrs ,attrs
|
||||
:children ,children
|
||||
:expander (lambda (tag attrs ,raw-children)
|
||||
(declare (ignorable tag attrs))
|
||||
(let ((children (and ,raw-children (apply #'%<> ,raw-children))))
|
||||
(declare (ignorable children))
|
||||
(let ,(mapcar (lambda (prop)
|
||||
(list prop `(attr attrs (make-keyword ',prop))))
|
||||
props)
|
||||
(let ((props
|
||||
(loop
|
||||
:for (key . value) in (attrs-alist attrs)
|
||||
:unless (member key ',(mapcar #'make-keyword props))
|
||||
:append (list key value))))
|
||||
(declare (ignorable props))
|
||||
(progn ,@body))))))))
|
||||
(defmacro ,name (&body attrs-and-children)
|
||||
`(,',%name ,@attrs-and-children)))))
|
||||
|
||||
(defun %<> (&rest attrs-and-children)
|
||||
(multiple-value-bind (attrs children)
|
||||
(split-attrs-and-children attrs-and-children)
|
||||
(declare (ignore attrs))
|
||||
(make-fragment :children children)))
|
||||
|
||||
(defmacro <> (&body children)
|
||||
`(%<> ,@children))
|
||||
|
||||
;;; h macro
|
||||
|
||||
(defun html-element-p (node)
|
||||
(and (symbolp node)
|
||||
(not (keywordp node))
|
||||
(gethash (make-keyword node) *builtin-elements*)))
|
||||
|
||||
(defun fragment-p (node)
|
||||
(string= node '<>))
|
||||
|
||||
(defun modify-first-leaves (tree test result)
|
||||
(if tree
|
||||
(cons (let ((first-node (first tree)))
|
||||
(cond
|
||||
((listp first-node)
|
||||
(modify-first-leaves first-node test result))
|
||||
((funcall test first-node)
|
||||
(funcall result first-node))
|
||||
(t first-node)))
|
||||
(mapcar (lambda (node)
|
||||
(if (listp node)
|
||||
(modify-first-leaves node test result)
|
||||
node))
|
||||
(rest tree)))))
|
||||
|
||||
(defmacro h (&body body)
|
||||
`(progn
|
||||
,@(modify-first-leaves
|
||||
body
|
||||
(lambda (node)
|
||||
(or (html-element-p node) (fragment-p node)))
|
||||
(lambda (node)
|
||||
(find-symbol (string node) :piccolo)))))
|
||||
|
|
@ -1,48 +0,0 @@
|
|||
(uiop:define-package #:piccolo/escape
|
||||
(:use #:cl)
|
||||
(:export #:*escape-html*
|
||||
#:*html-escape-map*
|
||||
#:*attr-escape-map*
|
||||
#:escape-string
|
||||
#:escape-attrs-alist
|
||||
#:escape-children))
|
||||
(in-package #:piccolo/escape)
|
||||
|
||||
(defparameter *escape-html* t)
|
||||
|
||||
(defparameter *html-escape-map*
|
||||
'((#\& . "&")
|
||||
(#\< . "<")
|
||||
(#\> . ">")
|
||||
(#\" . """)
|
||||
(#\' . "'")
|
||||
(#\/ . "/")
|
||||
(#\` . "`")
|
||||
(#\= . "=")))
|
||||
|
||||
(defparameter *attr-escape-map*
|
||||
'((#\" . """)))
|
||||
|
||||
(defun escape-char (char escape-map)
|
||||
(or (cdr (assoc 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-attrs-alist (alist)
|
||||
(mapcar (lambda (kv)
|
||||
(cons (car kv) (escape-string (cdr kv) *attr-escape-map*)))
|
||||
alist))
|
||||
|
||||
(defun escape-children (children)
|
||||
(mapcar (lambda (child)
|
||||
(if (and (stringp child) *escape-html*)
|
||||
(escape-string child *html-escape-map*)
|
||||
child))
|
||||
children))
|
||||
|
|
@ -1,75 +0,0 @@
|
|||
(uiop:define-package #:piccolo/generator
|
||||
(:use #:cl)
|
||||
(:import-from #:piccolo/groups
|
||||
#:self-closing-tag-p)
|
||||
(:import-from #:piccolo/elements
|
||||
#:attrs
|
||||
#:attrs-alist
|
||||
#:element
|
||||
#:element-tag
|
||||
#:element-attrs
|
||||
#:element-children
|
||||
#:element-prefix
|
||||
#:builtin-element-with-prefix
|
||||
#:user-element
|
||||
#:user-element-expand-to
|
||||
#:fragment)
|
||||
(:export #:*expand-user-element*
|
||||
#:element-string
|
||||
#:elem-str))
|
||||
(in-package #:piccolo/generator)
|
||||
|
||||
;;; print-object
|
||||
|
||||
(defparameter *expand-user-element* t)
|
||||
|
||||
(defmethod print-object ((attrs attrs) stream)
|
||||
(loop
|
||||
:for (key . value) :in (attrs-alist attrs)
|
||||
:do (format stream (if (typep value 'boolean)
|
||||
"~@[ ~a~]"
|
||||
" ~a=~s")
|
||||
(string-downcase key)
|
||||
value)))
|
||||
|
||||
(defmethod print-object ((element element) stream)
|
||||
(if (element-children element)
|
||||
(format stream (if (rest (element-children element))
|
||||
"~@<<~a~a>~2I~:@_~<~@{~a~^~:@_~}~:>~0I~:@_</~a>~:>"
|
||||
"~@<<~a~a>~2I~:_~<~a~^~:@_~:>~0I~_</~a>~:>")
|
||||
(element-tag element)
|
||||
(element-attrs element)
|
||||
(element-children element)
|
||||
(element-tag element))
|
||||
(format stream (if (self-closing-tag-p (element-tag element))
|
||||
"<~a~a>"
|
||||
"<~a~a></~a>")
|
||||
(element-tag element)
|
||||
(element-attrs element)
|
||||
(element-tag element))))
|
||||
|
||||
(defmethod print-object ((element builtin-element-with-prefix) stream)
|
||||
(format stream "~a~%" (element-prefix element))
|
||||
(call-next-method))
|
||||
|
||||
(defmethod print-object ((element user-element) stream)
|
||||
(if *expand-user-element*
|
||||
(print-object (user-element-expand-to element) stream)
|
||||
(call-next-method)))
|
||||
|
||||
(defmethod print-object ((element fragment) stream)
|
||||
(if (element-children element)
|
||||
(format stream (if (rest (element-children element))
|
||||
"~<~@{~a~^~:@_~}~:>"
|
||||
"~<~a~:>")
|
||||
(element-children element))))
|
||||
|
||||
;;; helper for generate html string
|
||||
|
||||
(defmethod element-string ((element element))
|
||||
(with-output-to-string (s)
|
||||
(write element :stream s :pretty t)))
|
||||
|
||||
(defmethod elem-str ((element element))
|
||||
(with-output-to-string (s)
|
||||
(write element :stream s :pretty nil)))
|
||||
|
|
@ -1,30 +0,0 @@
|
|||
(defpackage #:piccolo/groups
|
||||
(:use #:cl)
|
||||
(:import-from #:alexandria
|
||||
#:with-gensyms
|
||||
#:symbolicate
|
||||
#:make-keyword)
|
||||
(:export #:self-closing-tag-p
|
||||
#:non-escape-tag-p))
|
||||
(in-package #:piccolo/groups)
|
||||
|
||||
(defun symbols-hash-table (symbols)
|
||||
(let ((ht (make-hash-table)))
|
||||
(mapcar (lambda (sym)
|
||||
(setf (gethash (make-keyword sym) ht) t))
|
||||
symbols)
|
||||
ht))
|
||||
|
||||
(defmacro define-group (name &body symbols)
|
||||
(with-gensyms (ht)
|
||||
`(progn
|
||||
(let ((,ht (symbols-hash-table ',symbols)))
|
||||
(defun ,(symbolicate name '-p) (symbol)
|
||||
(gethash (make-keyword (string-upcase symbol)) ,ht))))))
|
||||
|
||||
(define-group self-closing-tag
|
||||
area base br col embed hr img input keygen
|
||||
link meta param source track wbr)
|
||||
|
||||
(define-group non-escape-tag
|
||||
style script textarea pre)
|
||||
93
src/hsx.lisp
Normal file
93
src/hsx.lisp
Normal file
|
|
@ -0,0 +1,93 @@
|
|||
(uiop:define-package #:hsx/hsx
|
||||
(:use #:cl)
|
||||
(:import-from #:alexandria
|
||||
#:symbolicate
|
||||
#:make-keyword)
|
||||
(:import-from #:hsx/element
|
||||
#:create-element)
|
||||
(:export #:defhsx
|
||||
#:defcomp
|
||||
#:hsx))
|
||||
(in-package #:hsx/hsx)
|
||||
|
||||
|
||||
;;;; hsx definitions
|
||||
|
||||
(defmacro defhsx (name element-type)
|
||||
`(defmacro ,name (&body body)
|
||||
(multiple-value-bind (props children)
|
||||
(parse-body body)
|
||||
`(create-element ,',element-type (list ,@props) ,@children))))
|
||||
|
||||
(defparameter *builtin-elements* (make-hash-table))
|
||||
|
||||
(defmacro define-and-export-builtin-elements (&body names)
|
||||
`(progn
|
||||
,@(mapcan (lambda (name)
|
||||
(list `(defhsx ,name ,(string-downcase name))
|
||||
`(setf (gethash (make-keyword ',name) *builtin-elements*) t)
|
||||
`(export ',name)))
|
||||
names)))
|
||||
|
||||
(define-and-export-builtin-elements
|
||||
; tag-elements
|
||||
a abbr address area article aside audio b base bdi bdo blockquote
|
||||
body br button canvas caption cite code col colgroup data datalist
|
||||
dd del details dfn dialog div dl dt em embed fieldset figcaption
|
||||
figure footer form h1 h2 h3 h4 h5 h6 head header hr i iframe
|
||||
img input ins kbd label legend li link main |map| mark meta meter nav
|
||||
noscript object ol optgroup option output p param picture pre progress
|
||||
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
|
||||
thead |time| title tr track u ul var video wbr
|
||||
; html-tag-element
|
||||
html
|
||||
; fragment-element
|
||||
<>)
|
||||
|
||||
(defmacro defcomp (name props &body body)
|
||||
(let ((%name (symbolicate '% name)))
|
||||
`(eval-when (:compile-toplevel :load-toplevel :execute)
|
||||
(defun ,%name ,props
|
||||
,@body)
|
||||
(defhsx ,name (fdefinition ',%name)))))
|
||||
|
||||
(defun parse-body (body)
|
||||
(if (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)))
|
||||
(values nil body)))
|
||||
|
||||
|
||||
;;;; hsx macro to find hsx symbols
|
||||
|
||||
(defmacro hsx (&body body)
|
||||
`(progn
|
||||
,@(modify-first-leaves body
|
||||
#'builtin-element-p
|
||||
(lambda (node)
|
||||
(find-symbol (string node) :hsx/hsx)))))
|
||||
|
||||
(defun modify-first-leaves (tree test result)
|
||||
(if tree
|
||||
(cons (let ((first-node (first tree)))
|
||||
(cond
|
||||
((listp first-node)
|
||||
(modify-first-leaves first-node test result))
|
||||
((funcall test first-node)
|
||||
(funcall result first-node))
|
||||
(t first-node)))
|
||||
(mapcar (lambda (node)
|
||||
(if (listp node)
|
||||
(modify-first-leaves node test result)
|
||||
node))
|
||||
(rest tree)))))
|
||||
|
||||
(defun builtin-element-p (node)
|
||||
(and (symbolp node)
|
||||
(gethash (make-keyword node) *builtin-elements*)))
|
||||
|
|
@ -1,7 +1,4 @@
|
|||
(uiop:define-package :piccolo
|
||||
(:nicknames #:piccolo/main)
|
||||
(:use #:cl)
|
||||
(:use-reexport #:piccolo/escape)
|
||||
(:use-reexport #:piccolo/elements)
|
||||
(:use-reexport #:piccolo/generator))
|
||||
(in-package :piccolo)
|
||||
(defpackage :hsx
|
||||
(:nicknames #:hsx/main)
|
||||
(:use #:cl))
|
||||
(in-package :hsx)
|
||||
|
|
|
|||
376
t/piccolo.lisp
376
t/piccolo.lisp
|
|
@ -1,376 +0,0 @@
|
|||
(in-package :cl-user)
|
||||
(defpackage piccolo.test
|
||||
(:use :cl :piccolo :fiveam))
|
||||
(in-package :piccolo.test)
|
||||
|
||||
(def-suite builtin-element)
|
||||
(def-suite escape)
|
||||
(def-suite attr-access)
|
||||
(def-suite user-element)
|
||||
(def-suite h-macro)
|
||||
|
||||
(in-suite builtin-element)
|
||||
|
||||
(test empty-attr
|
||||
(let* ((div1 (div))
|
||||
(div2 (div "the children text"))
|
||||
(div3 (div "text 1" "text 2"))
|
||||
(div4 (div (h1 "text 0") "text 01"
|
||||
(list (list "text 3" div2) div3) "text 4")))
|
||||
(is (eql nil (attrs-alist (element-attrs div1))))
|
||||
(is (eql nil (element-children div1)))
|
||||
(is (eql nil (attrs-alist (element-attrs div2))))
|
||||
(is (equal (list "the children text") (element-children div2)))
|
||||
(is (eql nil (attrs-alist (element-attrs div3))))
|
||||
(is (equal (list "text 1" "text 2") (element-children div3)))
|
||||
(is (eql nil (attrs-alist (element-attrs div4))))
|
||||
(is (= 6 (length (element-children div4))))
|
||||
(let ((child1 (first (element-children div4)))
|
||||
(child2 (second (element-children div4)))
|
||||
(child3 (third (element-children div4)))
|
||||
(child4 (fourth (element-children div4)))
|
||||
(child5 (fifth (element-children div4)))
|
||||
(child6 (sixth (element-children div4))))
|
||||
(is (equal "h1" (element-tag child1)))
|
||||
(is (equal "text 01" child2))
|
||||
(is (equal "text 3" child3))
|
||||
(is (eql div2 child4))
|
||||
(is (eql div3 child5))
|
||||
(is (equal "text 4" child6)))))
|
||||
|
||||
(test attr-given-by-inline-args
|
||||
(let* ((div1 (div :id "container"))
|
||||
(div2 (div :id "cat" :class "happy"))
|
||||
(div3 (div :id "container" "some children text" div1))
|
||||
(div4 (div :id "dog" :class "happy" (list (list div1) div2) (list div3))))
|
||||
(is (equal '((:id . "container")) (attrs-alist (element-attrs div1))))
|
||||
(is (eql nil (element-children div1)))
|
||||
(is (equal '((:id . "cat") (:class . "happy")) (attrs-alist (element-attrs div2))))
|
||||
(is (eql nil (element-children div2)))
|
||||
(is (equal '((:id . "container")) (attrs-alist (element-attrs div3))))
|
||||
(is (equal (list "some children text" div1) (element-children div3)))
|
||||
(is (equal '((:id . "dog") (:class . "happy")) (attrs-alist (element-attrs div4))))
|
||||
(is (equal (list div1 div2 div3) (element-children div4)))))
|
||||
|
||||
(test attr-given-by-attrs
|
||||
(let* ((div00 (div (make-attrs)))
|
||||
(div01 (div (make-attrs :alist nil) "some text"))
|
||||
(div1 (div (make-attrs :alist '((:id . "container")))))
|
||||
(div2 (div (make-attrs :alist '((:id . "cat") (:class . "happy")))))
|
||||
(div3 (div (make-attrs :alist '((:id . "container"))) "some children text" div1))
|
||||
(div4 (div (make-attrs :alist '((:id . "dog") (:class . "happy"))) (list (list div1) div2) (list div3))))
|
||||
(is (eql nil (attrs-alist (element-attrs div00))))
|
||||
(is (eql nil (element-children div00)))
|
||||
(is (eql nil (attrs-alist (element-attrs div01))))
|
||||
(is (equal (list "some text") (element-children div01)))
|
||||
(is (equal '((:id . "container")) (attrs-alist (element-attrs div1))))
|
||||
(is (eql nil (element-children div1)))
|
||||
(is (equal '((:id . "cat") (:class . "happy")) (attrs-alist (element-attrs div2))))
|
||||
(is (eql nil (element-children div2)))
|
||||
(is (equal '((:id . "container")) (attrs-alist (element-attrs div3))))
|
||||
(is (equal (list "some children text" div1) (element-children div3)))
|
||||
(is (equal '((:id . "dog") (:class . "happy")) (attrs-alist (element-attrs div4))))
|
||||
(is (equal (list div1 div2 div3) (element-children div4)))))
|
||||
|
||||
(test attr-given-by-alist
|
||||
(let* ((div00 (div nil))
|
||||
(div01 (div nil "some text"))
|
||||
(div1 (div '((:id . "container"))))
|
||||
(div2 (div '((:id . "cat") (:class . "happy"))))
|
||||
(div3 (div '((:id . "container")) "some children text" div1))
|
||||
(div4 (div '((:id . "dog") (:class . "happy")) (list (list div1) div2) (list div3))))
|
||||
(is (eql nil (attrs-alist (element-attrs div00))))
|
||||
(is (eql nil (element-children div00)))
|
||||
(is (eql nil (attrs-alist (element-attrs div01))))
|
||||
(is (equal (list "some text") (element-children div01)))
|
||||
(is (equal '((:id . "container")) (attrs-alist (element-attrs div1))))
|
||||
(is (eql nil (element-children div1)))
|
||||
(is (equal '((:id . "cat") (:class . "happy")) (attrs-alist (element-attrs div2))))
|
||||
(is (eql nil (element-children div2)))
|
||||
(is (equal '((:id . "container")) (attrs-alist (element-attrs div3))))
|
||||
(is (equal (list "some children text" div1) (element-children div3)))
|
||||
(is (equal '((:id . "dog") (:class . "happy")) (attrs-alist (element-attrs div4))))
|
||||
(is (equal (list div1 div2 div3) (element-children div4)))))
|
||||
|
||||
(test attr-given-by-plist
|
||||
(let* ((div00 (div nil))
|
||||
(div01 (div nil "some text"))
|
||||
(div1 (div '(:id "container")))
|
||||
(div2 (div '(:id "cat" :class "happy")))
|
||||
(div3 (div '(:id "container") "some children text" div1))
|
||||
(div4 (div '(:id "dog" :class "happy") (list (list div1) div2) (list div3))))
|
||||
(is (eql nil (attrs-alist (element-attrs div00))))
|
||||
(is (eql nil (element-children div00)))
|
||||
(is (eql nil (attrs-alist (element-attrs div01))))
|
||||
(is (equal (list "some text") (element-children div01)))
|
||||
(is (equal '((:id . "container")) (attrs-alist (element-attrs div1))))
|
||||
(is (eql nil (element-children div1)))
|
||||
(is (equal '((:id . "cat") (:class . "happy")) (attrs-alist (element-attrs div2))))
|
||||
(is (eql nil (element-children div2)))
|
||||
(is (equal '((:id . "container")) (attrs-alist (element-attrs div3))))
|
||||
(is (equal (list "some children text" div1) (element-children div3)))
|
||||
(is (equal '((:id . "dog") (:class . "happy")) (attrs-alist (element-attrs div4))))
|
||||
(is (equal (list div1 div2 div3) (element-children div4)))))
|
||||
|
||||
(test builtin-element-html-generation
|
||||
(let* ((html (html))
|
||||
(div0 (div))
|
||||
(div1 (div "some text"))
|
||||
(div2 (div :id "2"))
|
||||
(div3 (div :id "3" div1 div2 "some other text"))
|
||||
(div4 (div :id "4" div3 (div :id "5" (a :href "a.html" "a")))))
|
||||
(is (string= "<!DOCTYPE html>
|
||||
<html></html>" (element-string html)))
|
||||
(is (string= "<div></div>" (element-string div0)))
|
||||
(is (string= "<div>some text</div>" (element-string div1)))
|
||||
(is (string= "<div id=\"2\"></div>" (element-string div2)))
|
||||
(is (string= "<div id=\"3\">
|
||||
<div>some text</div>
|
||||
<div id=\"2\"></div>
|
||||
some other text
|
||||
</div>" (element-string div3)))
|
||||
(is (string= "<div id=\"4\">
|
||||
<div id=\"3\">
|
||||
<div>some text</div>
|
||||
<div id=\"2\"></div>
|
||||
some other text
|
||||
</div>
|
||||
<div id=\"5\"><a href=\"a.html\">a</a></div>
|
||||
</div>" (element-string div4)))
|
||||
|
||||
(is (string= "<!DOCTYPE html>
|
||||
<html></html>" (elem-str html)))
|
||||
(is (string= "<div></div>" (element-string div0)))
|
||||
(is (string= "<div>some text</div>" (elem-str div1)))
|
||||
(is (string= "<div id=\"2\"></div>" (elem-str div2)))
|
||||
(is (string= "<div id=\"3\"><div>some text</div><div id=\"2\"></div>some other text</div>"
|
||||
(elem-str div3)))
|
||||
(is (string= "<div id=\"4\"><div id=\"3\"><div>some text</div><div id=\"2\"></div>some other text</div><div id=\"5\"><a href=\"a.html\">a</a></div></div>"
|
||||
(elem-str div4)))))
|
||||
|
||||
(test boolean-attrs
|
||||
(let ((script1 (script :defer t :data-domain "example.com" :src "example.com/script.js"))
|
||||
(script2 (script :defer nil :data-domain "example.com" :src "example.com/script.js")))
|
||||
(is (string= "<script defer data-domain=\"example.com\" src=\"example.com/script.js\"></script>"
|
||||
(element-string script1)))
|
||||
(is (string= "<script data-domain=\"example.com\" src=\"example.com/script.js\"></script>"
|
||||
(element-string script2)))))
|
||||
|
||||
(in-suite escape)
|
||||
|
||||
(defparameter *a-attrs*
|
||||
'((:id . "nothing-to-escape")
|
||||
(:class . "something-with-\"-in-value")
|
||||
(:href . "http://localhost:3000/id=3&name=foo")
|
||||
(:data . "'<>")))
|
||||
|
||||
(defun new-a ()
|
||||
(a *a-attrs*
|
||||
"child text 1"
|
||||
"child text 2 <br> &"
|
||||
(a :href "child'<>\".html" "child'<>\"" (string (code-char 128)))
|
||||
(string (code-char 128))))
|
||||
|
||||
(test escape-attr
|
||||
(let ((escaped-attrs-alist '((:id . "nothing-to-escape")
|
||||
(:class . "something-with-"-in-value")
|
||||
(:href . "http://localhost:3000/id=3&name=foo")
|
||||
(:data . "'<>")) ))
|
||||
(is (equal escaped-attrs-alist (attrs-alist (element-attrs (new-a)))))
|
||||
(let ((*escape-html* nil))
|
||||
(is (equal *a-attrs* (attrs-alist (element-attrs (new-a))))))))
|
||||
|
||||
(test escape-children
|
||||
(let ((a (new-a)))
|
||||
(is (string= "child text 1" (first (element-children a))))
|
||||
(is (string= "child text 2 <br> &" (second (element-children a))))
|
||||
(is (string= "child'<>".html" (attr (element-attrs (third (element-children a))) :href)))
|
||||
(is (string= "child'<>"" (first (element-children (third (element-children a))))))
|
||||
(is (string= (string (code-char 128)) (second (element-children (third (element-children a))))))
|
||||
(is (string= (string (code-char 128)) (fourth (element-children a))))))
|
||||
|
||||
(in-suite attr-access)
|
||||
|
||||
(test attr-get
|
||||
(is (eql nil (attr (a) :id)))
|
||||
(is (eql nil (attr (new-a) :foo)))
|
||||
(is (equal "nothing-to-escape" (attr (new-a) :id)))
|
||||
(is (equal "'<>" (attr (element-attrs (new-a)) :data))))
|
||||
|
||||
(test attr-set
|
||||
(let ((a (new-a)))
|
||||
(setf (attr a :id) "a")
|
||||
(setf (attr a :foo) "b")
|
||||
(setf (attr (element-attrs a) :class) "c")
|
||||
(setf (attr (element-attrs a) :bar) "d")
|
||||
(is (equal "a" (attr a :id)))
|
||||
(is (equal "b" (attr a :foo)))
|
||||
(is (equal "c" (attr a :class)))
|
||||
(is (equal "d" (attr a :bar)))))
|
||||
|
||||
(test attr-delete
|
||||
(let ((a (new-a)))
|
||||
(delete-attr a :id)
|
||||
(delete-attr a :foo)
|
||||
(delete-attr a :class)
|
||||
(delete-attr (element-attrs a) :bar)
|
||||
(delete-attr a :href)
|
||||
(is (equal '((:data . "'<>")) (attrs-alist (element-attrs a))))))
|
||||
|
||||
(in-suite user-element)
|
||||
|
||||
(define-element cat ()
|
||||
(div :id "cat"
|
||||
(img :src "cat.png")
|
||||
"I'm a cat"))
|
||||
|
||||
(test user-element-simple
|
||||
(let ((cat (cat)))
|
||||
(is (string= "cat" (attr (user-element-expand-to cat) :id)))
|
||||
(is (string= "cat.png" (attr (first (element-children (user-element-expand-to cat))) :src)))
|
||||
(is (string= "I'm a cat" (car (last (element-children (user-element-expand-to cat))))))))
|
||||
|
||||
(define-element dog (id size)
|
||||
(if (and (realp size) (> size 10))
|
||||
(div :id id :class "big-dog"
|
||||
children
|
||||
"dog")
|
||||
(div :id id :class "small-dog"
|
||||
children
|
||||
"dog")))
|
||||
|
||||
(test user-element-with-attrs
|
||||
(let ((dog1 (dog))
|
||||
(dog2 (dog :size 15))
|
||||
(dog3 (dog (img :src "dog.png")))
|
||||
(dog4 (dog :id "dog" :size 10 (img :src "dog4.png") "woo")))
|
||||
(is (eql nil (attrs-alist (element-attrs dog1))))
|
||||
(is (string= "dog" (first (element-children (user-element-expand-to dog1)))))
|
||||
(is (string= "small-dog" (attr (user-element-expand-to dog1) :class)))
|
||||
(is (eql nil (element-children dog1)))
|
||||
(is (string= "dog" (element-tag dog1)))
|
||||
|
||||
(is (equal '((:size . 15)) (attrs-alist (element-attrs dog2))))
|
||||
(is (equal '((:class . "big-dog")) (attrs-alist (element-attrs (user-element-expand-to dog2)))))
|
||||
(is (string= "dog" (first (element-children (user-element-expand-to dog2)))))
|
||||
(is (eql nil (element-children dog2)))
|
||||
|
||||
(is (eql nil (attrs-alist (element-attrs dog3))))
|
||||
(is (string= "dog" (second (element-children (user-element-expand-to dog3)))))
|
||||
(is (string= "dog.png" (attr (first (element-children
|
||||
(first (element-children (user-element-expand-to dog3))))) :src)))
|
||||
(is (string= "dog.png" (attr (first (element-children dog3)) :src)))
|
||||
|
||||
(is (equal '((:id . "dog") (:size . 10)) (attrs-alist (element-attrs dog4))))
|
||||
(is (= 10 (attr dog4 :size)))
|
||||
(is (string= "img" (element-tag (first (element-children dog4)))))
|
||||
(is (string= "dog4.png" (attr (first (element-children
|
||||
(first (element-children (user-element-expand-to dog4))))) :src)))
|
||||
(is (string= "woo" (second (element-children dog4))))
|
||||
|
||||
(setf (attr dog4 :size) 16)
|
||||
(is (string= "big-dog" (attr (user-element-expand-to dog4) :class)))
|
||||
(setf (element-children dog4) (list dog1 dog2 dog3))
|
||||
(is (equal (list dog1 dog2 dog3) (element-children
|
||||
(first (element-children (user-element-expand-to dog4))))))))
|
||||
|
||||
(test user-element-html-generation
|
||||
(LET* ((dog1 (dog))
|
||||
(dog2 (dog :size 15))
|
||||
(dog3 (dog (img :src "dog.png")))
|
||||
(dog4 (dog :id "dog" :size 10 (img :src "dog4.png") "woo"))
|
||||
(home (div :id "home"
|
||||
(cat)
|
||||
;; dog4 below is ignored because cat not accepting children
|
||||
(cat dog4)
|
||||
(dog :id "doge" (cat)))))
|
||||
(is (string= "<div class=\"small-dog\">dog</div>" (element-string dog1)))
|
||||
(is (string= "<div class=\"big-dog\">dog</div>" (element-string dog2)))
|
||||
(is (string= "<div class=\"small-dog\">
|
||||
<img src=\"dog.png\">
|
||||
dog
|
||||
</div>" (element-string dog3)))
|
||||
(is (string= "<div id=\"dog\" class=\"small-dog\">
|
||||
<img src=\"dog4.png\">
|
||||
woo
|
||||
dog
|
||||
</div>" (element-string dog4)))
|
||||
(is (string= "<div id=\"home\">
|
||||
<div id=\"cat\">
|
||||
<img src=\"cat.png\">
|
||||
I'm a cat
|
||||
</div>
|
||||
<div id=\"cat\">
|
||||
<img src=\"cat.png\">
|
||||
I'm a cat
|
||||
</div>
|
||||
<div id=\"doge\" class=\"small-dog\">
|
||||
<div id=\"cat\">
|
||||
<img src=\"cat.png\">
|
||||
I'm a cat
|
||||
</div>
|
||||
dog
|
||||
</div>
|
||||
</div>" (element-string home)))
|
||||
|
||||
(let ((*expand-user-element* nil))
|
||||
(is (string= "<dog></dog>" (element-string dog1)))
|
||||
(is (string= "<dog size=15></dog>" (element-string dog2)))
|
||||
(is (string= "<dog><img src=\"dog.png\"></dog>" (element-string dog3)))
|
||||
(is (string= "<dog id=\"dog\" size=10>
|
||||
<img src=\"dog4.png\">
|
||||
woo
|
||||
</dog>" (element-string dog4)))
|
||||
(is (string= "<div id=\"home\">
|
||||
<cat></cat>
|
||||
<cat>
|
||||
<dog id=\"dog\" size=10>
|
||||
<img src=\"dog4.png\">
|
||||
woo
|
||||
</dog>
|
||||
</cat>
|
||||
<dog id=\"doge\"><cat></cat></dog>
|
||||
</div>" (element-string home))))))
|
||||
|
||||
(in-suite h-macro)
|
||||
|
||||
(in-package :cl-user)
|
||||
(defpackage piccolo.h-macro.test
|
||||
(:use :cl :fiveam)
|
||||
(:import-from :piccolo
|
||||
:h
|
||||
:element-string
|
||||
:define-element))
|
||||
(in-package :piccolo.h-macro.test)
|
||||
|
||||
(define-element duck (id color)
|
||||
(h (div :id (format nil "duck~a" id)
|
||||
:style (format nil "color:~a" color)
|
||||
"ga ga ga"
|
||||
piccolo:children)))
|
||||
|
||||
(test h-macro
|
||||
(let ((some-var 3))
|
||||
(is (string=
|
||||
"<div id=\"a\">
|
||||
<img href=\"a.png\">
|
||||
<div id=\"b\">foo</div>
|
||||
some text
|
||||
</div>" (element-string
|
||||
(h (div :id "a"
|
||||
(img :href "a.png")
|
||||
(div (if (> some-var 0)
|
||||
'(:id "b")
|
||||
'(:id "c"))
|
||||
"foo")
|
||||
"some text")))))
|
||||
(is (string=
|
||||
"<div id=\"duck5\" style=\"color:blue\">
|
||||
ga ga ga
|
||||
<img href=\"duck.png\">
|
||||
</div>"
|
||||
(element-string
|
||||
(h (duck :id 5 :color "blue"
|
||||
(img :href "duck.png"))))))))
|
||||
|
||||
(run-all-tests)
|
||||
93
tests/element.lisp
Normal file
93
tests/element.lisp
Normal file
|
|
@ -0,0 +1,93 @@
|
|||
(defpackage :hsx-test/element
|
||||
(:use :cl
|
||||
:fiveam
|
||||
:hsx/element))
|
||||
(in-package :hsx-test/element)
|
||||
|
||||
(def-suite element-test)
|
||||
(in-suite element-test)
|
||||
|
||||
(test tag-element
|
||||
(let ((elm (create-element "p"
|
||||
'(:class "red")
|
||||
"Hello,"
|
||||
"World")))
|
||||
(is (string= (element-type elm) "p"))
|
||||
(is (equal (element-props elm) '(:class "red")))
|
||||
(is (equal (element-children elm) (list "Hello," "World")))))
|
||||
|
||||
(test flatten-children
|
||||
(let* ((elm (create-element "p"
|
||||
nil
|
||||
"a"
|
||||
nil
|
||||
(list "b" (list nil "c"))
|
||||
(cons "d" "e"))))
|
||||
(is (equal (element-children elm) (list "a" "b" "c" "d" "e")))))
|
||||
|
||||
(defun comp1 (&key title children)
|
||||
(create-element "div"
|
||||
nil
|
||||
title
|
||||
children))
|
||||
|
||||
(test component-elment-with-keyword-args
|
||||
(let* ((elm (create-element #'comp1
|
||||
'(:title "foo")
|
||||
"bar"))
|
||||
(expanded (expand elm)))
|
||||
(is (eql (element-type elm) #'comp1))
|
||||
(is (equal (element-props elm) '(:title "foo")))
|
||||
(is (equal (element-children elm) (list "bar")))
|
||||
(is (string= (element-type expanded) "div"))
|
||||
(is (equal (element-children expanded) (list "foo" "bar")))
|
||||
(signals error
|
||||
(create-element #'comp1
|
||||
'(:title "foo" :other-key "baz")
|
||||
"bar"))))
|
||||
|
||||
(defun comp2 (&rest props)
|
||||
(create-element "div"
|
||||
nil
|
||||
(getf props :title)
|
||||
(getf props :children)))
|
||||
|
||||
(test component-element-with-property-list
|
||||
(let* ((elm (create-element #'comp2
|
||||
'(:title "foo")
|
||||
"bar"))
|
||||
(expanded (expand elm)))
|
||||
(is (eql (element-type elm) #'comp2))
|
||||
(is (equal (element-props elm) '(:title "foo")))
|
||||
(is (equal (element-children elm) (list "bar")))
|
||||
(is (string= (element-type expanded) "div"))
|
||||
(is (equal (element-children expanded) (list "foo" "bar")))))
|
||||
|
||||
(defun comp3 (&rest props &key title children &allow-other-keys)
|
||||
(create-element "div"
|
||||
nil
|
||||
title
|
||||
children
|
||||
(getf props :other-key)))
|
||||
|
||||
(defun comp4 (&rest props &key title children)
|
||||
(create-element "div"
|
||||
nil
|
||||
title
|
||||
children
|
||||
(getf props :other-key)))
|
||||
|
||||
(test component-element-with-keyword-args-and-property-list
|
||||
(let* ((elm (create-element #'comp3
|
||||
'(:title "foo" :other-key "baz")
|
||||
"bar"))
|
||||
(expanded (expand elm)))
|
||||
(is (eql (element-type elm) #'comp3))
|
||||
(is (equal (element-props elm) '(:title "foo" :other-key "baz")))
|
||||
(is (equal (element-children elm) (list "bar")))
|
||||
(is (string= (element-type expanded) "div"))
|
||||
(is (equal (element-children expanded) (list "foo" "bar" "baz")))
|
||||
(signals error
|
||||
(create-element #'comp4
|
||||
'(:title "foo" :other-key "baz")
|
||||
"bar"))))
|
||||
31
tests/hsx-macro.lisp
Normal file
31
tests/hsx-macro.lisp
Normal file
|
|
@ -0,0 +1,31 @@
|
|||
(defpackage #:hsx-test/hsx-macro
|
||||
(:use #:cl
|
||||
#:fiveam)
|
||||
(:import-from #:hsx/element
|
||||
#:element-type
|
||||
#:element-children)
|
||||
(:import-from #:hsx/hsx
|
||||
#:hsx
|
||||
#:defcomp))
|
||||
(in-package #:hsx-test/hsx-macro)
|
||||
|
||||
(def-suite hsx-macro-test)
|
||||
(in-suite hsx-macro-test)
|
||||
|
||||
(defcomp div (&rest props)
|
||||
(declare (ignore props))
|
||||
"This is fake!")
|
||||
|
||||
(defcomp p (&rest props)
|
||||
(declare (ignore props))
|
||||
"This is fake!")
|
||||
|
||||
(test find-symbols
|
||||
(let ((fake-elm (div :prop "value"
|
||||
(p "brah"))))
|
||||
(is (eql (element-type fake-elm) #'%div)
|
||||
(eql (element-type (first (element-children fake-elm))) #'%p)))
|
||||
(let ((true-elm (hsx (div :prop "value"
|
||||
(p "brah")))))
|
||||
(is (equal (element-type true-elm) "div")
|
||||
(equal (element-type (first (element-children true-elm))) "p"))))
|
||||
86
tests/hsx.lisp
Normal file
86
tests/hsx.lisp
Normal file
|
|
@ -0,0 +1,86 @@
|
|||
(defpackage #:hsx-test/hsx
|
||||
(:use #:cl
|
||||
#:fiveam
|
||||
#:hsx/hsx)
|
||||
(:import-from #:hsx/element
|
||||
#:create-element))
|
||||
(in-package #:hsx-test/hsx)
|
||||
|
||||
(def-suite hsx-test)
|
||||
(in-suite hsx-test)
|
||||
|
||||
(test empty-hsx
|
||||
(is (equal (macroexpand-1
|
||||
'(div))
|
||||
'(create-element
|
||||
"div"
|
||||
(list)))))
|
||||
|
||||
(test hsx-with-props
|
||||
(is (equal (macroexpand-1
|
||||
'(div :prop1 "value1" :prop2 "value2"))
|
||||
'(create-element
|
||||
"div"
|
||||
(list :prop1 "value1" :prop2 "value2")))))
|
||||
|
||||
(test hsx-with-children
|
||||
(is (equal (macroexpand-1
|
||||
'(div
|
||||
"child1"
|
||||
"child2"))
|
||||
'(create-element
|
||||
"div"
|
||||
(list)
|
||||
"child1"
|
||||
"child2"))))
|
||||
|
||||
(test hsx-with-props-and-children
|
||||
(is (equal (macroexpand-1
|
||||
'(div :prop1 "value1" :prop2 "value2"
|
||||
"child1"
|
||||
"child2"))
|
||||
'(create-element
|
||||
"div"
|
||||
(list :prop1 "value1" :prop2 "value2")
|
||||
"child1"
|
||||
"child2"))))
|
||||
|
||||
(defhsx custom "custom")
|
||||
|
||||
(test hsx-for-custom-tag-element
|
||||
(is (equal (macroexpand-1
|
||||
'(custom :prop1 "value1" :prop2 "value2"
|
||||
"child1"
|
||||
"child2"))
|
||||
'(create-element
|
||||
"custom"
|
||||
(list :prop1 "value1" :prop2 "value2")
|
||||
"child1"
|
||||
"child2"))))
|
||||
|
||||
(defun %comp1 (&key prop1 prop2 children)
|
||||
(declare (ignore prop1 prop2 children)))
|
||||
(defhsx comp1 #'%comp1)
|
||||
|
||||
(defcomp comp2 (&key prop1 prop2 children)
|
||||
(declare (ignore prop1 prop2 children)))
|
||||
|
||||
(test hsx-for-component-element
|
||||
(is (equal (macroexpand-1
|
||||
'(comp1 :prop1 "value1" :prop2 "value2"
|
||||
"child1"
|
||||
"child2"))
|
||||
'(create-element
|
||||
#'%comp1
|
||||
(list :prop1 "value1" :prop2 "value2")
|
||||
"child1"
|
||||
"child2")))
|
||||
(is (equal (macroexpand-1
|
||||
'(comp2 :prop1 "value1" :prop2 "value2"
|
||||
"child1"
|
||||
"child2"))
|
||||
'(create-element
|
||||
(fdefinition '%comp2)
|
||||
(list :prop1 "value1" :prop2 "value2")
|
||||
"child1"
|
||||
"child2"))))
|
||||
Loading…
Reference in a new issue