paku/hsx
1
0
Fork 0
Code Issues Pull requests Projects Releases 1 Packages Wiki Activity Actions

reorganize and add create element tests

Browse source
This commit is contained in:
Bo Yao 2018-06-28 23:04:10 -04:00
parent c73384a44e
commit 3c79ec676f
5 changed files with 146 additions and 33 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
system-test.asd → flute-test.asd
View file

@ -1,7 +1,7 @@
(defsystem flute-test (defsystem flute-test
:author "Your Name <your.name@example.com>" :author "Your Name <your.name@example.com>"
:license "Specify license here" :license "Specify license here"
:depends-on (:flute) :depends-on (:flute :fiveam)
:components ((:module "t" :components ((:module "t"
:serial t :serial t
:components :components

26
src/flute.lisp
View file

@ -44,7 +44,7 @@ If NIL, nothing is escaped and programmer is responsible to escape elements prop
When given :ASCII and :ATTR, it's possible to insert html text as a children, e.g. When given :ASCII and :ATTR, it's possible to insert html text as a children, e.g.
(div :id \"container\" \"Some <b>text</b>\")") (div :id \"container\" \"Some <b>text</b>\")")
(defun make-attrs (&keys alist) (defun make-attrs (&key alist)
(if *escape-html* (if *escape-html*
(%make-attrs :alist (escape-attrs-alist alist)) (%make-attrs :alist (escape-attrs-alist alist))
(%make-attrs :alist alist))) (%make-attrs :alist alist)))
@ -67,30 +67,6 @@ When given :ASCII and :ATTR, it's possible to insert html text as a children, e.
(defmethod attr ((element element) key) (defmethod attr ((element element) key)
(attr (element-attrs element))) (attr (element-attrs element)))
(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))))
((listp (first attrs-and-children))
(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))
(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)))))
(defvar *builtin-elements* (make-hash-table)) (defvar *builtin-elements* (make-hash-table))
(defun html (&rest attrs-and-children) (defun html (&rest attrs-and-children)

7
src/package.lisp
View file

@ -28,4 +28,9 @@
:element-children :element-children
:user-element-expand-to :user-element-expand-to
:*expand-user-element* :*expand-user-element*
:h)) :h
:*escape-html*
:escape-string
:utf8-html-escape-char-p
:ascii-html-escape-char-p
:attr-value-escape-char-p))

24
src/util.lisp
View file

@ -70,3 +70,27 @@
(otherwise child)) (otherwise child))
child)) child))
children)) children))
(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))))
((listp (first attrs-and-children))
(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))
(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)))))

120
t/flute.lisp
View file

@ -1,10 +1,118 @@
(in-package :cl-user) (in-package :cl-user)
(defpackage flute.test (defpackage flute.test
(:use :cl :flute)) (:use :cl :flute :fiveam))
(in-package :flute.test) (in-package :flute.test)
(define-element clock (id size) (def-suite simple-builtin-element)
(div :id id (in-suite simple-builtin-element)
(h1 "clock")
(img "blabal" :size size) (test empty-attr
children)) (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)))))
(run-all-tests)
;; (define-element clock (id size)
;; (div :id id
;; (h1 "clock")
;; (img "blabal" :size size)
;; children))