From f086e13e04950f715ba1664d435da3919c58f8b7 Mon Sep 17 00:00:00 2001 From: paku Date: Mon, 20 May 2024 14:38:28 +0900 Subject: [PATCH 01/17] Resetting --- README.md | 374 +------------------------------------------- piccolo-test.asd | 14 +- qlfile | 2 - qlfile.lock | 8 - src/elements.lisp | 284 ---------------------------------- src/escape.lisp | 48 ------ src/generator.lisp | 75 --------- src/groups.lisp | 30 ---- src/main.lisp | 7 +- t/piccolo.lisp | 376 --------------------------------------------- tests/.keep | 0 11 files changed, 8 insertions(+), 1210 deletions(-) delete mode 100644 src/elements.lisp delete mode 100644 src/escape.lisp delete mode 100644 src/generator.lisp delete mode 100644 src/groups.lisp delete mode 100644 t/piccolo.lisp create mode 100644 tests/.keep diff --git a/README.md b/README.md index 1062132..11bf815 100644 --- a/README.md +++ b/README.md @@ -1,382 +1,10 @@ # Piccolo -⚠️ **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)) - -;
-;
- -(script :defer t) - -; => - -(script :defer nil) - -; => - -(define-element view-more () - (a props - "View More")) - -(view-more :href "/detail" :class "m-1") - -; View More - -``` - -- 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") - -; child -``` - -- 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* -
dog
-piccolo-USER> (dog :id "dog2" "I am a dog" *) -
- I am a dog -
dog
- dog -
-``` - -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* -
dog
-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* -
- i'm small now - dog -
-``` - -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)) - -i'm small now -; 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 element object -;; ATTRS-AND-CHILDREN can be the following: - -;; 1. an empty tag -(a) - -;; 2. attributes of alist, plist or ATTRS object -;; The following creates: -(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 `` 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 '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 -``` - - # License Licensed under MIT License.  Copyright (c) 2024, skyizwhite. -Copyright (c) 2018, Bo Yao. \ No newline at end of file +Copyright (c) 2018, Bo Yao. diff --git a/piccolo-test.asd b/piccolo-test.asd index 4a19ad8..4bb1d78 100644 --- a/piccolo-test.asd +++ b/piccolo-test.asd @@ -1,9 +1,5 @@ -(defsystem piccolo-test - :author "Bo Yao, skyizwhite" - :maintainer "skyizwhite " - :license "MIT" - :depends-on (:piccolo :fiveam) - :components ((:module "t" - :serial t - :components - ((:file "piccolo"))))) +(defsystem "piccolo-test" + :class :package-inferred-system + :pathname "tests" + :depends-on ("fiveam") + :perform (test-op (op c) (symbol-call :fiveam :run-all-tests))) diff --git a/qlfile b/qlfile index 542356a..856c2fc 100644 --- a/qlfile +++ b/qlfile @@ -1,3 +1 @@ ql fiveam -ql assoc-utils -ql alexandria diff --git a/qlfile.lock b/qlfile.lock index 8889fa1..0e284d6 100644 --- a/qlfile.lock +++ b/qlfile.lock @@ -6,11 +6,3 @@ (: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) - :version "ql-2023-10-21")) diff --git a/src/elements.lisp b/src/elements.lisp deleted file mode 100644 index d387e50..0000000 --- a/src/elements.lisp +++ /dev/null @@ -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 ""))) - -(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))))) diff --git a/src/escape.lisp b/src/escape.lisp deleted file mode 100644 index cd5d98d..0000000 --- a/src/escape.lisp +++ /dev/null @@ -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)) diff --git a/src/generator.lisp b/src/generator.lisp deleted file mode 100644 index d94bed6..0000000 --- a/src/generator.lisp +++ /dev/null @@ -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>~2I~:_~<~a~^~:@_~:>~0I~_~:>") - (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>") - (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))) diff --git a/src/groups.lisp b/src/groups.lisp deleted file mode 100644 index 514624d..0000000 --- a/src/groups.lisp +++ /dev/null @@ -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) diff --git a/src/main.lisp b/src/main.lisp index 66aefde..bdd1554 100644 --- a/src/main.lisp +++ b/src/main.lisp @@ -1,7 +1,4 @@ -(uiop:define-package :piccolo +(defpackage :piccolo (:nicknames #:piccolo/main) - (:use #:cl) - (:use-reexport #:piccolo/escape) - (:use-reexport #:piccolo/elements) - (:use-reexport #:piccolo/generator)) + (:use #:cl)) (in-package :piccolo) diff --git a/t/piccolo.lisp b/t/piccolo.lisp deleted file mode 100644 index ad9cc35..0000000 --- a/t/piccolo.lisp +++ /dev/null @@ -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= " -" (element-string html))) - (is (string= "
" (element-string div0))) - (is (string= "
some text
" (element-string div1))) - (is (string= "
" (element-string div2))) - (is (string= "
-
some text
-
- some other text -
" (element-string div3))) - (is (string= "
-
-
some text
-
- some other text -
- -
" (element-string div4))) - - (is (string= " -" (elem-str html))) - (is (string= "
" (element-string div0))) - (is (string= "
some text
" (elem-str div1))) - (is (string= "
" (elem-str div2))) - (is (string= "
some text
some other text
" - (elem-str div3))) - (is (string= "
some text
some other text
" - (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= "" - (element-string script1))) - (is (string= "" - (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
&" - (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= "
dog
" (element-string dog1))) - (is (string= "
dog
" (element-string dog2))) - (is (string= "
- - dog -
" (element-string dog3))) - (is (string= "
- - woo - dog -
" (element-string dog4))) - (is (string= "
-
- - I'm a cat -
-
- - I'm a cat -
-
-
- - I'm a cat -
- dog -
-
" (element-string home))) - - (let ((*expand-user-element* nil)) - (is (string= "" (element-string dog1))) - (is (string= "" (element-string dog2))) - (is (string= "" (element-string dog3))) - (is (string= " - - woo -" (element-string dog4))) - (is (string= "
- - - - - woo - - - -
" (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= - "
- -
foo
- some text -
" (element-string - (h (div :id "a" - (img :href "a.png") - (div (if (> some-var 0) - '(:id "b") - '(:id "c")) - "foo") - "some text"))))) - (is (string= - "
- ga ga ga - -
" - (element-string - (h (duck :id 5 :color "blue" - (img :href "duck.png")))))))) - -(run-all-tests) diff --git a/tests/.keep b/tests/.keep new file mode 100644 index 0000000..e69de29 From f8171dd47f3a236f665583357d11f02b5c616da3 Mon Sep 17 00:00:00 2001 From: paku Date: Sat, 25 May 2024 12:00:39 +0900 Subject: [PATCH 02/17] Add create-element --- piccolo-test.asd | 3 ++- src/element.lisp | 38 +++++++++++++++++++++++++++++++++++++ tests/.keep | 0 tests/element.lisp | 47 ++++++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 87 insertions(+), 1 deletion(-) create mode 100644 src/element.lisp delete mode 100644 tests/.keep create mode 100644 tests/element.lisp diff --git a/piccolo-test.asd b/piccolo-test.asd index 4bb1d78..0f7e34b 100644 --- a/piccolo-test.asd +++ b/piccolo-test.asd @@ -1,5 +1,6 @@ (defsystem "piccolo-test" :class :package-inferred-system :pathname "tests" - :depends-on ("fiveam") + :depends-on ("fiveam" + "piccolo-test/element") :perform (test-op (op c) (symbol-call :fiveam :run-all-tests))) diff --git a/src/element.lisp b/src/element.lisp new file mode 100644 index 0000000..09c41e4 --- /dev/null +++ b/src/element.lisp @@ -0,0 +1,38 @@ +(defpackage #:piccolo/element + (:use #:cl) + (:export #:element-kind + #:element-props + #:create-element + #:expand)) +(in-package #:piccolo/element) + +(defclass element () + ((kind + :reader element-kind + :initarg :kind) + (props + :reader element-props + :initarg :props))) + +(defun create-element (kind props &rest children) + (make-instance 'element + :kind kind + :props (append props + (and children + (list :children (flatten children)))))) + +(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 expand ((elm element)) + (with-accessors ((kind element-kind) + (props element-props)) elm + (if (functionp kind) + (apply kind props) + (error "element-kind is not a function.")))) diff --git a/tests/.keep b/tests/.keep deleted file mode 100644 index e69de29..0000000 diff --git a/tests/element.lisp b/tests/element.lisp new file mode 100644 index 0000000..db2887d --- /dev/null +++ b/tests/element.lisp @@ -0,0 +1,47 @@ +(defpackage :piccolo-test/element + (:use :cl + :fiveam + :piccolo/element)) +(in-package :piccolo-test/element) + +(def-suite create-element) + +(in-suite create-element) + +(test create-html-element + (let* ((inner (create-element "span" + '(:class "red") + "World!")) + (outer (create-element "p" + nil + "Hello," + inner))) + (with-accessors ((kind element-kind) + (props element-props)) inner + (is (string= kind "span")) + (is (equal props `(:class "red" :children ("World!"))))) + (with-accessors ((kind element-kind) + (props element-props)) outer + (is (string= kind "p")) + (is (equal props `(:children ("Hello," ,inner))))))) + +(test create-component-element + (labels ((comp (&key variant children) + (create-element "p" + `(:class ,variant) + "Hello," + children))) + (let* ((inner (create-element "span" + nil + "World!")) + (outer (create-element #'comp + '(:variant "red") + inner))) + (with-accessors ((kind element-kind) + (props element-props)) outer + (is (eql kind #'comp)) + (is (equal props `(:variant "red" :children (,inner))))) + (with-accessors ((kind element-kind) + (props element-props)) (expand outer) + (is (string= kind "p")) + (is (equal props `(:class "red" :children ("Hello," ,inner)))))))) From dbe249fbd8d6729765adb50fa74866a42a4941ea Mon Sep 17 00:00:00 2001 From: paku Date: Sat, 25 May 2024 19:38:54 +0900 Subject: [PATCH 03/17] Add flatten-element-children test --- tests/element.lisp | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/tests/element.lisp b/tests/element.lisp index db2887d..53f26aa 100644 --- a/tests/element.lisp +++ b/tests/element.lisp @@ -25,6 +25,16 @@ (is (string= kind "p")) (is (equal props `(:children ("Hello," ,inner))))))) +(test flatten-element-children + (let* ((elm (create-element "p" + nil + "a" + nil + (list "b" (list nil "c")) + (cons "d" "e"))) + (children (getf (element-props elm) :children))) + (is (equal children (list "a" "b" "c" "d" "e"))))) + (test create-component-element (labels ((comp (&key variant children) (create-element "p" From 988aa8d67232ba9e58e42021561a4e0044b0f291 Mon Sep 17 00:00:00 2001 From: paku Date: Sat, 25 May 2024 20:09:09 +0900 Subject: [PATCH 04/17] Return itself when the html element is expanded --- src/element.lisp | 16 +++++++++------- 1 file changed, 9 insertions(+), 7 deletions(-) diff --git a/src/element.lisp b/src/element.lisp index 09c41e4..22b18db 100644 --- a/src/element.lisp +++ b/src/element.lisp @@ -21,6 +21,15 @@ (and children (list :children (flatten children)))))) +(defmethod expand ((elm element)) + (with-accessors ((kind element-kind) + (props element-props)) elm + (if (functionp kind) + (apply kind props) + elm))) + +;;;; utils + (defun flatten (x) (labels ((rec (x acc) (cond ((null x) acc) @@ -29,10 +38,3 @@ (car x) (rec (cdr x) acc)))))) (rec x nil))) - -(defmethod expand ((elm element)) - (with-accessors ((kind element-kind) - (props element-props)) elm - (if (functionp kind) - (apply kind props) - (error "element-kind is not a function.")))) From 6ddf42f6a40f7ef779a9d4dcfb7965b4a2bcdd90 Mon Sep 17 00:00:00 2001 From: paku Date: Sat, 25 May 2024 21:48:35 +0900 Subject: [PATCH 05/17] Rename piccolo to hsx --- README.md | 7 +++++-- piccolo-test.asd => hsx-test.asd | 4 ++-- piccolo.asd => hsx.asd | 6 +++--- src/element.lisp | 4 ++-- src/main.lisp | 6 +++--- tests/element.lisp | 6 +++--- 6 files changed, 18 insertions(+), 15 deletions(-) rename piccolo-test.asd => hsx-test.asd (68%) rename piccolo.asd => hsx.asd (77%) diff --git a/README.md b/README.md index 11bf815..f91f029 100644 --- a/README.md +++ b/README.md @@ -1,8 +1,11 @@ -# Piccolo +# HSX -Piccolo, a fork of [flute](https://github.com/ailisp/flute), is a beautiful, easily composable HTML5 generation library for Common Lisp. +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/), created by Bo Yao. # License + Licensed under MIT License.  Copyright (c) 2024, skyizwhite. diff --git a/piccolo-test.asd b/hsx-test.asd similarity index 68% rename from piccolo-test.asd rename to hsx-test.asd index 0f7e34b..1936af1 100644 --- a/piccolo-test.asd +++ b/hsx-test.asd @@ -1,6 +1,6 @@ -(defsystem "piccolo-test" +(defsystem "hsx-test" :class :package-inferred-system :pathname "tests" :depends-on ("fiveam" - "piccolo-test/element") + "hsx-test/element") :perform (test-op (op c) (symbol-call :fiveam :run-all-tests))) diff --git a/piccolo.asd b/hsx.asd similarity index 77% rename from piccolo.asd rename to hsx.asd index f1be9da..89e4be6 100644 --- a/piccolo.asd +++ b/hsx.asd @@ -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")) diff --git a/src/element.lisp b/src/element.lisp index 22b18db..5de37e8 100644 --- a/src/element.lisp +++ b/src/element.lisp @@ -1,10 +1,10 @@ -(defpackage #:piccolo/element +(defpackage #:hsx/element (:use #:cl) (:export #:element-kind #:element-props #:create-element #:expand)) -(in-package #:piccolo/element) +(in-package #:hsx/element) (defclass element () ((kind diff --git a/src/main.lisp b/src/main.lisp index bdd1554..76a9f69 100644 --- a/src/main.lisp +++ b/src/main.lisp @@ -1,4 +1,4 @@ -(defpackage :piccolo - (:nicknames #:piccolo/main) +(defpackage :hsx + (:nicknames #:hsx/main) (:use #:cl)) -(in-package :piccolo) +(in-package :hsx) diff --git a/tests/element.lisp b/tests/element.lisp index 53f26aa..93d6322 100644 --- a/tests/element.lisp +++ b/tests/element.lisp @@ -1,8 +1,8 @@ -(defpackage :piccolo-test/element +(defpackage :hsx-test/element (:use :cl :fiveam - :piccolo/element)) -(in-package :piccolo-test/element) + :hsx/element)) +(in-package :hsx-test/element) (def-suite create-element) From 3eea6a4e396c616b46ad8557671b4db1488b68fe Mon Sep 17 00:00:00 2001 From: paku Date: Sun, 26 May 2024 00:57:06 +0900 Subject: [PATCH 06/17] Add children slot to element --- src/element.lisp | 18 ++++++++++++------ tests/element.lisp | 36 ++++++++++++++++-------------------- 2 files changed, 28 insertions(+), 26 deletions(-) diff --git a/src/element.lisp b/src/element.lisp index 5de37e8..8fab306 100644 --- a/src/element.lisp +++ b/src/element.lisp @@ -2,6 +2,7 @@ (:use #:cl) (:export #:element-kind #:element-props + #:element-children #:create-element #:expand)) (in-package #:hsx/element) @@ -12,20 +13,25 @@ :initarg :kind) (props :reader element-props - :initarg :props))) + :initarg :props) + (children + :reader element-children + :initarg :children))) (defun create-element (kind props &rest children) (make-instance 'element :kind kind - :props (append props - (and children - (list :children (flatten children)))))) + :props props + :children (flatten children))) (defmethod expand ((elm element)) (with-accessors ((kind element-kind) - (props element-props)) elm + (props element-props) + (children element-children)) elm (if (functionp kind) - (apply kind props) + (apply kind (append props + (and children + (list :children children)))) elm))) ;;;; utils diff --git a/tests/element.lisp b/tests/element.lisp index 93d6322..b73b944 100644 --- a/tests/element.lisp +++ b/tests/element.lisp @@ -8,7 +8,7 @@ (in-suite create-element) -(test create-html-element +(test create-builtin-element (let* ((inner (create-element "span" '(:class "red") "World!")) @@ -16,14 +16,12 @@ nil "Hello," inner))) - (with-accessors ((kind element-kind) - (props element-props)) inner - (is (string= kind "span")) - (is (equal props `(:class "red" :children ("World!"))))) - (with-accessors ((kind element-kind) - (props element-props)) outer - (is (string= kind "p")) - (is (equal props `(:children ("Hello," ,inner))))))) + (is (string= (element-kind inner) "span")) + (is (equal (element-props inner) `(:class "red"))) + (is (equal (element-children inner) (list "World!"))) + (is (string= (element-kind outer) "p")) + (is (null (element-props outer))) + (is (equal (element-children outer) (list "Hello," inner))))) (test flatten-element-children (let* ((elm (create-element "p" @@ -31,9 +29,8 @@ "a" nil (list "b" (list nil "c")) - (cons "d" "e"))) - (children (getf (element-props elm) :children))) - (is (equal children (list "a" "b" "c" "d" "e"))))) + (cons "d" "e")))) + (is (equal (element-children elm) (list "a" "b" "c" "d" "e"))))) (test create-component-element (labels ((comp (&key variant children) @@ -47,11 +44,10 @@ (outer (create-element #'comp '(:variant "red") inner))) - (with-accessors ((kind element-kind) - (props element-props)) outer - (is (eql kind #'comp)) - (is (equal props `(:variant "red" :children (,inner))))) - (with-accessors ((kind element-kind) - (props element-props)) (expand outer) - (is (string= kind "p")) - (is (equal props `(:class "red" :children ("Hello," ,inner)))))))) + (is (eql (element-kind outer) #'comp)) + (is (equal (element-props outer) `(:variant "red"))) + (is (equal (element-children outer) (list inner))) + (let ((expanded-elm (expand outer))) + (is (string= (element-kind expanded-elm) "p")) + (is (equal (element-props expanded-elm) `(:class "red"))) + (is (equal (element-children expanded-elm) (list "Hello," inner))))))) From 803b9add1407b685e24250186fdaa3bed1e9daad Mon Sep 17 00:00:00 2001 From: paku Date: Sun, 26 May 2024 01:26:26 +0900 Subject: [PATCH 07/17] Add hsx/hsx package --- hsx-test.asd | 3 ++- qlfile | 1 + qlfile.lock | 4 ++++ src/hsx.lisp | 57 ++++++++++++++++++++++++++++++++++++++++++++++++++ tests/hsx.lisp | 32 ++++++++++++++++++++++++++++ 5 files changed, 96 insertions(+), 1 deletion(-) create mode 100644 src/hsx.lisp create mode 100644 tests/hsx.lisp diff --git a/hsx-test.asd b/hsx-test.asd index 1936af1..cb03e2f 100644 --- a/hsx-test.asd +++ b/hsx-test.asd @@ -2,5 +2,6 @@ :class :package-inferred-system :pathname "tests" :depends-on ("fiveam" - "hsx-test/element") + "hsx-test/element" + "hsx-test/hsx") :perform (test-op (op c) (symbol-call :fiveam :run-all-tests))) diff --git a/qlfile b/qlfile index 856c2fc..bf1c3a3 100644 --- a/qlfile +++ b/qlfile @@ -1 +1,2 @@ ql fiveam +ql alexandria diff --git a/qlfile.lock b/qlfile.lock index 0e284d6..22f6050 100644 --- a/qlfile.lock +++ b/qlfile.lock @@ -6,3 +6,7 @@ (:class qlot/source/ql:source-ql :initargs (:%version :latest) :version "ql-2023-10-21")) +("alexandria" . + (:class qlot/source/ql:source-ql + :initargs (:%version :latest) + :version "ql-2023-10-21")) diff --git a/src/hsx.lisp b/src/hsx.lisp new file mode 100644 index 0000000..0eef85a --- /dev/null +++ b/src/hsx.lisp @@ -0,0 +1,57 @@ +(uiop:define-package #:hsx/hsx + (:use #:cl) + (:import-from #:alexandria + #:symbolicate) + (:import-from #:hsx/element + #:create-element) + (:export #:defcomp)) +(in-package #:hsx/hsx) + +(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))) + +(defmacro define-builtin-element (name) + `(defmacro ,name (&body body) + (multiple-value-bind (props children) + (parse-body body) + `(create-element ,',(string-downcase name) + ',props + ,@children)))) + +(defmacro define-and-export-builtin-elements (&body names) + `(progn + ,@(mapcan (lambda (name) + (list `(define-builtin-element ,name) + `(export ',name))) + 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 html 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 defcomp (name props &body body) + (let ((%name (symbolicate '% name))) + `(eval-when (:compile-toplevel :load-toplevel :execute) + (defun ,%name ,props + ,@body) + (defmacro ,name (&body body) + (multiple-value-bind (props children) + (parse-body body) + `(create-element #',',%name + ',props + ,@children)))))) diff --git a/tests/hsx.lisp b/tests/hsx.lisp new file mode 100644 index 0000000..1f123cc --- /dev/null +++ b/tests/hsx.lisp @@ -0,0 +1,32 @@ +(defpackage #:hsx-test/hsx + (:use #:cl + #:fiveam + #:hsx/element + #:hsx/hsx)) +(in-package #:hsx-test/hsx) + +(def-suite builtin-element-hsx) +(def-suite component-element-hsx) +(in-suite builtin-element-hsx) + +(test empty-hsx + (let ((elm (div))) + (is (null (element-props elm))) + (is (null (element-children elm))))) + +(test hsx-with-props + (let ((elm (div :prop1 "value1" :prop2 "value2"))) + (is (equal (element-props elm) '(:prop1 "value1" :prop2 "value2"))) + (is (null (element-children elm))))) + +(test hsx-with-children + (let ((elm (div "child1" "child2"))) + (is (null (element-props elm))) + (is (equal (element-children elm) (list "child1" "child2"))))) + +(test hsx-with-props-and-children + (test hsx-with-props + (let ((elm (div :prop1 "value1" :prop2 "value2" + "child1" "child2"))) + (is (equal (element-props elm) '(:prop1 "value1" :prop2 "value2"))) + (is (equal (element-children elm) (list "child1" "child2")))))) From 42a0828f896945865809920b1d5ed691571dfb47 Mon Sep 17 00:00:00 2001 From: paku Date: Sun, 26 May 2024 01:29:58 +0900 Subject: [PATCH 08/17] Rename kind to type --- src/element.lisp | 18 +++++++++--------- tests/element.lisp | 8 ++++---- 2 files changed, 13 insertions(+), 13 deletions(-) diff --git a/src/element.lisp b/src/element.lisp index 8fab306..7a74346 100644 --- a/src/element.lisp +++ b/src/element.lisp @@ -1,6 +1,6 @@ (defpackage #:hsx/element (:use #:cl) - (:export #:element-kind + (:export #:element-type #:element-props #:element-children #:create-element @@ -8,9 +8,9 @@ (in-package #:hsx/element) (defclass element () - ((kind - :reader element-kind - :initarg :kind) + ((type + :reader element-type + :initarg :type) (props :reader element-props :initarg :props) @@ -18,18 +18,18 @@ :reader element-children :initarg :children))) -(defun create-element (kind props &rest children) +(defun create-element (type props &rest children) (make-instance 'element - :kind kind + :type type :props props :children (flatten children))) (defmethod expand ((elm element)) - (with-accessors ((kind element-kind) + (with-accessors ((type element-type) (props element-props) (children element-children)) elm - (if (functionp kind) - (apply kind (append props + (if (functionp type) + (apply type (append props (and children (list :children children)))) elm))) diff --git a/tests/element.lisp b/tests/element.lisp index b73b944..a7d9666 100644 --- a/tests/element.lisp +++ b/tests/element.lisp @@ -16,10 +16,10 @@ nil "Hello," inner))) - (is (string= (element-kind inner) "span")) + (is (string= (element-type inner) "span")) (is (equal (element-props inner) `(:class "red"))) (is (equal (element-children inner) (list "World!"))) - (is (string= (element-kind outer) "p")) + (is (string= (element-type outer) "p")) (is (null (element-props outer))) (is (equal (element-children outer) (list "Hello," inner))))) @@ -44,10 +44,10 @@ (outer (create-element #'comp '(:variant "red") inner))) - (is (eql (element-kind outer) #'comp)) + (is (eql (element-type outer) #'comp)) (is (equal (element-props outer) `(:variant "red"))) (is (equal (element-children outer) (list inner))) (let ((expanded-elm (expand outer))) - (is (string= (element-kind expanded-elm) "p")) + (is (string= (element-type expanded-elm) "p")) (is (equal (element-props expanded-elm) `(:class "red"))) (is (equal (element-children expanded-elm) (list "Hello," inner))))))) From c29e8d4882b79c2f2d170f95c57380022d7b7773 Mon Sep 17 00:00:00 2001 From: paku Date: Sun, 26 May 2024 01:49:34 +0900 Subject: [PATCH 09/17] Fix test --- tests/hsx.lisp | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/tests/hsx.lisp b/tests/hsx.lisp index 1f123cc..eb05560 100644 --- a/tests/hsx.lisp +++ b/tests/hsx.lisp @@ -25,8 +25,7 @@ (is (equal (element-children elm) (list "child1" "child2"))))) (test hsx-with-props-and-children - (test hsx-with-props - (let ((elm (div :prop1 "value1" :prop2 "value2" - "child1" "child2"))) - (is (equal (element-props elm) '(:prop1 "value1" :prop2 "value2"))) - (is (equal (element-children elm) (list "child1" "child2")))))) + (let ((elm (div :prop1 "value1" :prop2 "value2" + "child1" "child2"))) + (is (equal (element-props elm) '(:prop1 "value1" :prop2 "value2"))) + (is (equal (element-children elm) (list "child1" "child2"))))) From 55cf69582f7bb34d78101ee63bf7d5b29df94143 Mon Sep 17 00:00:00 2001 From: paku Date: Sun, 26 May 2024 12:26:09 +0900 Subject: [PATCH 10/17] Add test for hsx/hsx package --- src/element.lisp | 13 +++--- src/hsx.lisp | 4 +- tests/element.lisp | 113 ++++++++++++++++++++++++++++++--------------- tests/hsx.lisp | 68 +++++++++++++++++++-------- 4 files changed, 136 insertions(+), 62 deletions(-) diff --git a/src/element.lisp b/src/element.lisp index 7a74346..965eb17 100644 --- a/src/element.lisp +++ b/src/element.lisp @@ -19,10 +19,13 @@ :initarg :children))) (defun create-element (type props &rest children) - (make-instance 'element - :type type - :props props - :children (flatten children))) + (let ((elm (make-instance 'element + :type type + :props props + :children (flatten children)))) + (prog1 elm + ;dry-run to validate props + (expand elm)))) (defmethod expand ((elm element)) (with-accessors ((type element-type) @@ -34,8 +37,6 @@ (list :children children)))) elm))) -;;;; utils - (defun flatten (x) (labels ((rec (x acc) (cond ((null x) acc) diff --git a/src/hsx.lisp b/src/hsx.lisp index 0eef85a..6aa8c3f 100644 --- a/src/hsx.lisp +++ b/src/hsx.lisp @@ -26,7 +26,7 @@ ',props ,@children)))) -(defmacro define-and-export-builtin-elements (&body names) +(defmacro define-and-export-builtin-elements (&rest names) `(progn ,@(mapcan (lambda (name) (list `(define-builtin-element ,name) @@ -34,7 +34,7 @@ names))) (define-and-export-builtin-elements - a abbr address area article aside audio b base bdi bdo blockquote + 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 html hr i iframe diff --git a/tests/element.lisp b/tests/element.lisp index a7d9666..43575b7 100644 --- a/tests/element.lisp +++ b/tests/element.lisp @@ -4,26 +4,20 @@ :hsx/element)) (in-package :hsx-test/element) -(def-suite create-element) +(def-suite element-test) -(in-suite create-element) +(in-suite element-test) -(test create-builtin-element - (let* ((inner (create-element "span" - '(:class "red") - "World!")) - (outer (create-element "p" - nil - "Hello," - inner))) - (is (string= (element-type inner) "span")) - (is (equal (element-props inner) `(:class "red"))) - (is (equal (element-children inner) (list "World!"))) - (is (string= (element-type outer) "p")) - (is (null (element-props outer))) - (is (equal (element-children outer) (list "Hello," inner))))) +(test builtin-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-element-children +(test flatten-children (let* ((elm (create-element "p" nil "a" @@ -32,22 +26,69 @@ (cons "d" "e")))) (is (equal (element-children elm) (list "a" "b" "c" "d" "e"))))) -(test create-component-element - (labels ((comp (&key variant children) - (create-element "p" - `(:class ,variant) - "Hello," - children))) - (let* ((inner (create-element "span" - nil - "World!")) - (outer (create-element #'comp - '(:variant "red") - inner))) - (is (eql (element-type outer) #'comp)) - (is (equal (element-props outer) `(:variant "red"))) - (is (equal (element-children outer) (list inner))) - (let ((expanded-elm (expand outer))) - (is (string= (element-type expanded-elm) "p")) - (is (equal (element-props expanded-elm) `(:class "red"))) - (is (equal (element-children expanded-elm) (list "Hello," inner))))))) +(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")))) diff --git a/tests/hsx.lisp b/tests/hsx.lisp index eb05560..4d891d0 100644 --- a/tests/hsx.lisp +++ b/tests/hsx.lisp @@ -1,31 +1,63 @@ (defpackage #:hsx-test/hsx (:use #:cl #:fiveam - #:hsx/element - #:hsx/hsx)) + #:hsx/hsx) + (:import-from #:hsx/element + #:create-element)) (in-package #:hsx-test/hsx) -(def-suite builtin-element-hsx) -(def-suite component-element-hsx) -(in-suite builtin-element-hsx) +(def-suite hsx-test) +(in-suite hsx-test) (test empty-hsx - (let ((elm (div))) - (is (null (element-props elm))) - (is (null (element-children elm))))) + (is (equal (macroexpand-1 + '(div)) + '(create-element + "div" + 'nil)))) (test hsx-with-props - (let ((elm (div :prop1 "value1" :prop2 "value2"))) - (is (equal (element-props elm) '(:prop1 "value1" :prop2 "value2"))) - (is (null (element-children elm))))) + (is (equal (macroexpand-1 + '(div :prop1 "value1" :prop2 "value2")) + '(create-element + "div" + '(:prop1 "value1" :prop2 "value2"))))) (test hsx-with-children - (let ((elm (div "child1" "child2"))) - (is (null (element-props elm))) - (is (equal (element-children elm) (list "child1" "child2"))))) + (is (equal (macroexpand-1 + '(div + "child1" + "child2")) + '(create-element + "div" + 'nil + "child1" + "child2")))) (test hsx-with-props-and-children - (let ((elm (div :prop1 "value1" :prop2 "value2" - "child1" "child2"))) - (is (equal (element-props elm) '(:prop1 "value1" :prop2 "value2"))) - (is (equal (element-children elm) (list "child1" "child2"))))) + (is (equal (macroexpand-1 + '(div :prop1 "value1" :prop2 "value2" + "child1" + "child2")) + '(create-element + "div" + '(:prop1 "value1" :prop2 "value2") + "child1" + "child2")))) + +(defcomp comp (&key prop1 prop2 children) + (div + prop1 + prop2 + children)) + +(test component-hsx + (is (equal (macroexpand-1 + '(comp :prop1 "value1" :prop2 "value2" + "child1" + "child2")) + '(create-element + #'%comp + '(:prop1 "value1" :prop2 "value2") + "child1" + "child2")))) From ab34b5dbb627d597340a0029f0b3ccc45c10b4bd Mon Sep 17 00:00:00 2001 From: paku Date: Sun, 26 May 2024 13:57:51 +0900 Subject: [PATCH 11/17] Add merge-children-into-props function --- src/element.lisp | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/src/element.lisp b/src/element.lisp index 965eb17..1110b56 100644 --- a/src/element.lisp +++ b/src/element.lisp @@ -32,9 +32,8 @@ (props element-props) (children element-children)) elm (if (functionp type) - (apply type (append props - (and children - (list :children children)))) + (apply type + (merge-children-into-props props children)) elm))) (defun flatten (x) @@ -45,3 +44,8 @@ (car x) (rec (cdr x) acc)))))) (rec x nil))) + +(defun merge-children-into-props (props children) + (append props + (and children + (list :children children)))) From 422b111114b79822f76c01c6a6f1cb19343776a6 Mon Sep 17 00:00:00 2001 From: paku Date: Sun, 26 May 2024 16:14:33 +0900 Subject: [PATCH 12/17] Remove implements --- tests/hsx.lisp | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/tests/hsx.lisp b/tests/hsx.lisp index 4d891d0..e511f85 100644 --- a/tests/hsx.lisp +++ b/tests/hsx.lisp @@ -46,10 +46,7 @@ "child2")))) (defcomp comp (&key prop1 prop2 children) - (div - prop1 - prop2 - children)) + (declare (ignore prop1 prop2 children))) (test component-hsx (is (equal (macroexpand-1 From 6c6dce401ec8922d52e4f4039912cacadab5a0ee Mon Sep 17 00:00:00 2001 From: paku Date: Sun, 26 May 2024 19:48:09 +0900 Subject: [PATCH 13/17] Add hsx macro --- hsx-test.asd | 3 ++- src/hsx.lisp | 35 +++++++++++++++++++++++++++++++++-- tests/element.lisp | 1 - tests/hsx-macro.lisp | 31 +++++++++++++++++++++++++++++++ tests/hsx.lisp | 1 - 5 files changed, 66 insertions(+), 5 deletions(-) create mode 100644 tests/hsx-macro.lisp diff --git a/hsx-test.asd b/hsx-test.asd index cb03e2f..b118701 100644 --- a/hsx-test.asd +++ b/hsx-test.asd @@ -3,5 +3,6 @@ :pathname "tests" :depends-on ("fiveam" "hsx-test/element" - "hsx-test/hsx") + "hsx-test/hsx" + "hsx-test/hsx-macro") :perform (test-op (op c) (symbol-call :fiveam :run-all-tests))) diff --git a/src/hsx.lisp b/src/hsx.lisp index 6aa8c3f..ac49790 100644 --- a/src/hsx.lisp +++ b/src/hsx.lisp @@ -1,10 +1,12 @@ (uiop:define-package #:hsx/hsx (:use #:cl) (:import-from #:alexandria - #:symbolicate) + #:symbolicate + #:make-keyword) (:import-from #:hsx/element #:create-element) - (:export #:defcomp)) + (:export #:defcomp + #:hsx)) (in-package #:hsx/hsx) (defun parse-body (body) @@ -26,10 +28,13 @@ ',props ,@children)))) +(defparameter *builtin-elements* (make-hash-table)) + (defmacro define-and-export-builtin-elements (&rest names) `(progn ,@(mapcan (lambda (name) (list `(define-builtin-element ,name) + `(setf (gethash (make-keyword ',name) *builtin-elements*) t) `(export ',name))) names))) @@ -55,3 +60,29 @@ `(create-element #',',%name ',props ,@children)))))) + +(defun builtin-element-p (node) + (and (symbolp node) + (gethash (make-keyword node) *builtin-elements*))) + +(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 hsx (&body body) + `(progn + ,@(modify-first-leaves body + #'builtin-element-p + (lambda (node) + (find-symbol (string node) :hsx/hsx))))) diff --git a/tests/element.lisp b/tests/element.lisp index 43575b7..027574e 100644 --- a/tests/element.lisp +++ b/tests/element.lisp @@ -5,7 +5,6 @@ (in-package :hsx-test/element) (def-suite element-test) - (in-suite element-test) (test builtin-element diff --git a/tests/hsx-macro.lisp b/tests/hsx-macro.lisp new file mode 100644 index 0000000..6829c27 --- /dev/null +++ b/tests/hsx-macro.lisp @@ -0,0 +1,31 @@ +(defpackage #:hsx-test/hsx-macro + (:use #:cl + #:fiveam) + (:import-from #:hsx/element + #:element-type + #:element-props) + (: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")))) diff --git a/tests/hsx.lisp b/tests/hsx.lisp index e511f85..81783ef 100644 --- a/tests/hsx.lisp +++ b/tests/hsx.lisp @@ -8,7 +8,6 @@ (def-suite hsx-test) (in-suite hsx-test) - (test empty-hsx (is (equal (macroexpand-1 '(div)) From c24da9a7e96c788247dd8d419bc0d01575beb7ef Mon Sep 17 00:00:00 2001 From: paku Date: Sun, 26 May 2024 21:45:49 +0900 Subject: [PATCH 14/17] Fix bug --- src/hsx.lisp | 4 ++-- tests/hsx-macro.lisp | 2 +- tests/hsx.lisp | 10 +++++----- 3 files changed, 8 insertions(+), 8 deletions(-) diff --git a/src/hsx.lisp b/src/hsx.lisp index ac49790..db0ac09 100644 --- a/src/hsx.lisp +++ b/src/hsx.lisp @@ -25,7 +25,7 @@ (multiple-value-bind (props children) (parse-body body) `(create-element ,',(string-downcase name) - ',props + (list ,@props) ,@children)))) (defparameter *builtin-elements* (make-hash-table)) @@ -58,7 +58,7 @@ (multiple-value-bind (props children) (parse-body body) `(create-element #',',%name - ',props + (list ,@props) ,@children)))))) (defun builtin-element-p (node) diff --git a/tests/hsx-macro.lisp b/tests/hsx-macro.lisp index 6829c27..d6eeac5 100644 --- a/tests/hsx-macro.lisp +++ b/tests/hsx-macro.lisp @@ -3,7 +3,7 @@ #:fiveam) (:import-from #:hsx/element #:element-type - #:element-props) + #:element-children) (:import-from #:hsx/hsx #:hsx #:defcomp)) diff --git a/tests/hsx.lisp b/tests/hsx.lisp index 81783ef..2d0c6da 100644 --- a/tests/hsx.lisp +++ b/tests/hsx.lisp @@ -13,14 +13,14 @@ '(div)) '(create-element "div" - 'nil)))) + (list))))) (test hsx-with-props (is (equal (macroexpand-1 '(div :prop1 "value1" :prop2 "value2")) '(create-element "div" - '(:prop1 "value1" :prop2 "value2"))))) + (list :prop1 "value1" :prop2 "value2"))))) (test hsx-with-children (is (equal (macroexpand-1 @@ -29,7 +29,7 @@ "child2")) '(create-element "div" - 'nil + (list) "child1" "child2")))) @@ -40,7 +40,7 @@ "child2")) '(create-element "div" - '(:prop1 "value1" :prop2 "value2") + (list :prop1 "value1" :prop2 "value2") "child1" "child2")))) @@ -54,6 +54,6 @@ "child2")) '(create-element #'%comp - '(:prop1 "value1" :prop2 "value2") + (list :prop1 "value1" :prop2 "value2") "child1" "child2")))) From 9d0a425b49e607116a9e548855639f3b171b515a Mon Sep 17 00:00:00 2001 From: paku Date: Sun, 26 May 2024 23:29:30 +0900 Subject: [PATCH 15/17] define print-object method for element --- src/element.lisp | 95 +++++++++++++++++++++++++++++++++++++++------- src/hsx.lisp | 61 +++++++++++++++++------------ tests/element.lisp | 2 +- 3 files changed, 119 insertions(+), 39 deletions(-) diff --git a/src/element.lisp b/src/element.lisp index 1110b56..bd9b120 100644 --- a/src/element.lisp +++ b/src/element.lisp @@ -7,6 +7,8 @@ #:expand)) (in-package #:hsx/element) +;;;; class definitions + (defclass element () ((type :reader element-type @@ -18,23 +20,29 @@ :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 'element + (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)))) - (prog1 elm - ;dry-run to validate props - (expand elm)))) - -(defmethod expand ((elm element)) - (with-accessors ((type element-type) - (props element-props) - (children element-children)) elm - (if (functionp type) - (apply type - (merge-children-into-props props children)) - elm))) + (create-element-hook elm) + elm)) (defun flatten (x) (labels ((rec (x acc) @@ -45,7 +53,68 @@ (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>~2I~:_~<~a~^~:@_~:>~0I~_~:>") + type + (props->string props) + children + type) + (format stream "<~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 "~%") + (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)) diff --git a/src/hsx.lisp b/src/hsx.lisp index db0ac09..3b3bf08 100644 --- a/src/hsx.lisp +++ b/src/hsx.lisp @@ -9,16 +9,10 @@ #:hsx)) (in-package #:hsx/hsx) -(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 definitions + +(defparameter *builtin-elements* (make-hash-table)) (defmacro define-builtin-element (name) `(defmacro ,name (&body body) @@ -28,9 +22,7 @@ (list ,@props) ,@children)))) -(defparameter *builtin-elements* (make-hash-table)) - -(defmacro define-and-export-builtin-elements (&rest names) +(defmacro define-and-export-builtin-elements (&body names) `(progn ,@(mapcan (lambda (name) (list `(define-builtin-element ,name) @@ -39,15 +31,20 @@ names))) (define-and-export-builtin-elements - a abbr address area article aside audio b base bdi bdo blockquote + ; 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 html hr i iframe + 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) + 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))) @@ -61,9 +58,26 @@ (list ,@props) ,@children)))))) -(defun builtin-element-p (node) - (and (symbolp node) - (gethash (make-keyword node) *builtin-elements*))) +(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 @@ -80,9 +94,6 @@ node)) (rest tree))))) -(defmacro hsx (&body body) - `(progn - ,@(modify-first-leaves body - #'builtin-element-p - (lambda (node) - (find-symbol (string node) :hsx/hsx))))) +(defun builtin-element-p (node) + (and (symbolp node) + (gethash (make-keyword node) *builtin-elements*))) diff --git a/tests/element.lisp b/tests/element.lisp index 027574e..5c7f0c8 100644 --- a/tests/element.lisp +++ b/tests/element.lisp @@ -7,7 +7,7 @@ (def-suite element-test) (in-suite element-test) -(test builtin-element +(test tag-element (let ((elm (create-element "p" '(:class "red") "Hello," From a85fc323848e249a707a8fa9d40858c3fb202bd0 Mon Sep 17 00:00:00 2001 From: paku Date: Mon, 27 May 2024 11:10:11 +0900 Subject: [PATCH 16/17] Add defhsx macro --- src/hsx.lisp | 22 ++++++++-------------- tests/hsx.lisp | 37 ++++++++++++++++++++++++++++++++----- 2 files changed, 40 insertions(+), 19 deletions(-) diff --git a/src/hsx.lisp b/src/hsx.lisp index 3b3bf08..1ba7a5c 100644 --- a/src/hsx.lisp +++ b/src/hsx.lisp @@ -5,27 +5,26 @@ #:make-keyword) (:import-from #:hsx/element #:create-element) - (:export #:defcomp + (:export #:defhsx + #:defcomp #:hsx)) (in-package #:hsx/hsx) ;;;; hsx definitions -(defparameter *builtin-elements* (make-hash-table)) - -(defmacro define-builtin-element (name) +(defmacro defhsx (name element-type) `(defmacro ,name (&body body) (multiple-value-bind (props children) (parse-body body) - `(create-element ,',(string-downcase name) - (list ,@props) - ,@children)))) + `(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 `(define-builtin-element ,name) + (list `(defhsx ,name ,(string-downcase name)) `(setf (gethash (make-keyword ',name) *builtin-elements*) t) `(export ',name))) names))) @@ -51,12 +50,7 @@ `(eval-when (:compile-toplevel :load-toplevel :execute) (defun ,%name ,props ,@body) - (defmacro ,name (&body body) - (multiple-value-bind (props children) - (parse-body body) - `(create-element #',',%name - (list ,@props) - ,@children)))))) + (defhsx ,name (fdefinition ',%name))))) (defun parse-body (body) (if (keywordp (first body)) diff --git a/tests/hsx.lisp b/tests/hsx.lisp index 2d0c6da..7cfe79e 100644 --- a/tests/hsx.lisp +++ b/tests/hsx.lisp @@ -8,6 +8,7 @@ (def-suite hsx-test) (in-suite hsx-test) + (test empty-hsx (is (equal (macroexpand-1 '(div)) @@ -44,16 +45,42 @@ "child1" "child2")))) -(defcomp comp (&key prop1 prop2 children) - (declare (ignore prop1 prop2 children))) +(defhsx custom "custom") -(test component-hsx +(test hsx-for-custom-tag-element (is (equal (macroexpand-1 - '(comp :prop1 "value1" :prop2 "value2" + '(custom :prop1 "value1" :prop2 "value2" "child1" "child2")) '(create-element - #'%comp + "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")))) From 0ca26375ad2f001f79373a0bdbfcfd5c4493a04a Mon Sep 17 00:00:00 2001 From: paku Date: Mon, 27 May 2024 11:39:52 +0900 Subject: [PATCH 17/17] Update README --- README.md | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/README.md b/README.md index f91f029..32ae8e9 100644 --- a/README.md +++ b/README.md @@ -1,8 +1,8 @@ -# HSX +# HSX (WIP) 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/), created by Bo Yao. +This is a fork project of [flute](https://github.com/ailisp/flute/), originally created by Bo Yao. # License