├── .gitignore
├── docs
    └── index.md
├── packages.lisp
├── cl-jsx.asd
├── cl-jsx-test.asd
├── circle.yml
├── LICENSE
├── README.md
├── who.lisp
├── cl-jsx.lisp
├── parser.lisp
└── t
    └── cl-jsx.lisp


/.gitignore:
--------------------------------------------------------------------------------
1 | *.FASL
2 | *.fasl
3 | *.lisp-temp
4 | *~
5 | 


--------------------------------------------------------------------------------
/docs/index.md:
--------------------------------------------------------------------------------
1 | # CL-JSX
2 | 
3 | A JSX Compiler for Common Lisp
4 | 
5 | 


--------------------------------------------------------------------------------
/packages.lisp:
--------------------------------------------------------------------------------
 1 | ;; file: packages.lisp
 2 | 
 3 | (in-package :cl-user)
 4 | 
 5 | (defpackage cl-jsx
 6 |   (:nicknames :jsx)
 7 |   (:use :cl)
 8 |   (:export #:enable-jsx-syntax))
 9 | 
10 | ;; EOF
11 | 


--------------------------------------------------------------------------------
/cl-jsx.asd:
--------------------------------------------------------------------------------
 1 | (in-package :cl-user)
 2 | 
 3 | (defpackage cl-jsx-asd
 4 |   (:use :cl :asdf))
 5 | 
 6 | (in-package :cl-jsx-asd)
 7 | 
 8 | (defsystem cl-jsx
 9 |   :serial t
10 |   :license "MIT"
11 |   :author "Mariano Montone <marianomontone@gmail.com>"
12 |   :description "JSX in Common Lisp"
13 |   :version "0.0.1"
14 |   :depends-on (:cl-who
15 |                :esrap
16 |                :named-readtables)
17 |   :components ((:file "packages")
18 |                (:file "parser")
19 |                (:file "who")
20 |                (:file "cl-jsx"))
21 |   :in-order-to ((asdf:test-op (asdf:test-op :cl-jsx-test))))
22 | 


--------------------------------------------------------------------------------
/cl-jsx-test.asd:
--------------------------------------------------------------------------------
 1 | (in-package :cl-user)
 2 | 
 3 | (defpackage cl-jsx-test-asd
 4 |   (:use :cl :asdf))
 5 | 
 6 | (in-package :cl-jsx-test-asd)
 7 | 
 8 | (defsystem cl-jsx-test
 9 |   :serial t
10 |   :version "0.0.1"
11 |   :author "Mariano Montone <marianomontone@gmail.com>"
12 |   :description "Test suite for CL-JSX"
13 |   :license "MIT"
14 |   :depends-on (:cl-jsx
15 |                :prove)
16 |   :components ((:module "t"
17 |                         :serial t
18 |                         :components ((:file "cl-jsx"))))
19 |   :defsystem-depends-on (prove-asdf)
20 |   :perform (test-op :after (op c)
21 |                     (funcall (intern #.(string :run-test-system) :prove-asdf) c)
22 |                     (asdf:clear-system c)))
23 | 


--------------------------------------------------------------------------------
/circle.yml:
--------------------------------------------------------------------------------
 1 | machine:
 2 |   environment:
 3 |     PATH: ~/.roswell/bin:$PATH
 4 | 
 5 | dependencies:
 6 |   pre:
 7 |     - curl -L https://raw.githubusercontent.com/snmsts/roswell/release/scripts/install-for-ci.sh | sh
 8 |     - case $CIRCLE_NODE_INDEX in
 9 |         0) ros config set default.lisp sbcl-bin ;;
10 |         1) ros install ccl-bin;
11 |            ros config set default.lisp ccl-bin ;;
12 |       esac
13 |     - ros run -- --version
14 |   override:
15 |     - git clone https://github.com/fukamachi/cl-coveralls ~/lisp/cl-coveralls
16 |     - git clone https://github.com/fukamachi/prove ~/lisp/prove
17 |     - ros -l ~/lisp/prove/prove.asd install prove
18 | 
19 | test:
20 |   override:
21 |     - if [ "$CIRCLE_NODE_INDEX" = 0 ]; then COVERALLS=true run-prove cl-jsx-test.asd; else run-prove cl-jsx-test.asd; fi: {parallel: true}
22 | 


--------------------------------------------------------------------------------
/LICENSE:
--------------------------------------------------------------------------------
 1 | The MIT License (MIT)
 2 | 
 3 | Copyright (c) 2015, "the Phoeron" Colin J.E. Lupton <sysop@thephoeron.com>
 4 | 
 5 | Permission is hereby granted, free of charge, to any person obtaining a copy
 6 | of this software and associated documentation files (the "Software"), to deal
 7 | in the Software without restriction, including without limitation the rights
 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
 9 | copies of the Software, and to permit persons to whom the Software is
10 | furnished to do so, subject to the following conditions:
11 | 
12 | The above copyright notice and this permission notice shall be included in all
13 | copies or substantial portions of the Software.
14 | 
15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
21 | SOFTWARE.
22 | 
23 | 


--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
 1 | # CL-JSX
 2 | 
 3 | [![Quicklisp](http://quickdocs.org/badge/cl-jsx.svg)](http://quickdocs.org/cl-jsx/)
 4 | [![MIT License](https://img.shields.io/badge/license-MIT-blue.svg)](./LICENSE)
 5 | 
 6 | [JSX](https://facebook.github.io/jsx/) in Common Lisp
 7 | 
 8 | ## Embedded JSX syntax
 9 | 
10 | To enable JSX syntax, evaluate:
11 | 
12 | ```lisp
13 | (jsx:enable-jsx-syntax)
14 | ```
15 | 
16 | JSX elements are specified with ``#<tag></tag>``
17 | 
18 | Example:
19 | 
20 | ```lisp
21 | (who:with-html-output-to-string (html) 
22 |            (let ((hello "asdf")) 
23 |              #<lala aaa="asd {when nil "false"}" yes={hello}>
24 |              {loop 
25 |              for x from 1 to 10
26 |                  do #<p class="{when t "asdf"}">{hello}</p>}
27 |              </lala>))
28 | ```
29 | Result:
30 | 
31 | ```
32 | => "<lala aaa='asd ' yes='asdf'>
33 |              <p class='asdf'>asdf</p><p class='asdf'>asdf</p><p class='asdf'>asdf</p><p class='asdf'>asdf</p><p class='asdf'>asdf</p><p class='asdf'>asdf</p><p class='asdf'>asdf</p><p class='asdf'>asdf</p><p class='asdf'>asdf</p><p class='asdf'>asdf</p>
34 |              </lala>"
35 | ```
36 | 
37 | At the moment, the rendering is done using CL-WHO, but other backends implementations are also possible:
38 | 
39 | Macro expansion of JSX above:
40 | 
41 | ```lisp
42 | (WITH-OUTPUT-TO-STRING (HTML NIL)
43 |   (CL-WHO:WITH-HTML-OUTPUT (HTML NIL :PROLOGUE NIL :INDENT NIL)
44 |     (LET ((HELLO "asdf"))
45 |       (PROGN
46 |        (CL-WHO:HTM
47 |         (:LALA :AAA
48 |          (WITH-OUTPUT-TO-STRING (#:ATTR755)
49 |            (WRITE-STRING "asd " #:ATTR755)
50 |            (LET ((#:ATTRVAL756 (WHEN NIL "false")))
51 |              (WHEN #:ATTRVAL756 (PRINC #:ATTRVAL756 #:ATTR755))))
52 |          :YES HELLO
53 |          (CL-WHO:STR "
54 |              ")
55 |          (CL-WHO:STR
56 |           (LOOP FOR X FROM 1 TO 10
57 |                 DO (PROGN
58 |                     (CL-WHO:HTM
59 |                      (:P :CLASS
60 |                       (WITH-OUTPUT-TO-STRING (#:ATTR757)
61 |                         (LET ((#:ATTRVAL758 (WHEN T "asdf")))
62 |                           (WHEN #:ATTRVAL758 (PRINC #:ATTRVAL758 #:ATTR757))))
63 |                       (CL-WHO:STR HELLO)))
64 |                     NIL)))
65 |          (CL-WHO:STR "
66 |              ")))
67 |        NIL))))
68 | ```
69 | 


--------------------------------------------------------------------------------
/who.lisp:
--------------------------------------------------------------------------------
 1 | (defpackage :jsx.who
 2 |   (:use :cl)
 3 |   (:export #:emit-who))
 4 | 
 5 | (in-package :jsx.who)
 6 | 
 7 | ;; cl-who JSX compiler
 8 | 
 9 | (defun make-keyword (string)
10 |   (intern (string-upcase string) :keyword))
11 | 
12 | (defun emit-who (jsx)
13 |   (%emit-who (first jsx) jsx))
14 | 
15 | (defgeneric %emit-who (element-type element))
16 | 
17 | (defmethod %emit-who ((type (eql :element)) element)
18 |   (destructuring-bind (_ tag-name attributes content) element
19 |     `(progn
20 |        (who:htm
21 |         (,(make-keyword tag-name)
22 |           ,@(emit-attributes attributes)
23 |           ,@(emit-content content)))
24 |        nil)))
25 | 
26 | (defun emit-content (content)
27 |   (loop
28 |      :for elem :in content
29 |      :collect
30 |      (cond
31 |        ((stringp elem)
32 |         `(who:str ,elem))
33 |        ((eql (first elem) :jsx-escape)
34 |         `(who:str ,(read-escaped-jsx (second elem))))
35 |        ((eql (first elem) :element)
36 |         (emit-who elem)))))
37 | 
38 | (defun emit-attributes (attributes)
39 |   (loop
40 |      :for (_ attr value) :in attributes
41 |      :collect
42 |      (make-keyword attr)
43 |      :collect
44 |      (emit-attribute-value value)))
45 | 
46 | (defun emit-attribute-value (value)
47 |   (if (eql (first value) :jsx-escape)
48 |       (read-escaped-jsx (second value))
49 |       ;; else
50 |       (let ((attr (gensym "ATTR")))
51 |         `(with-output-to-string (,attr)
52 |            ,@(loop
53 |                 :for x :in value
54 |                 :collect (cond
55 |                            ((stringp x)
56 |                             `(write-string ,x ,attr))
57 |                            ((eql (first x) :jsx-escape)
58 |                             (let ((val (gensym "ATTRVAL")))
59 |                               `(let ((,val ,(read-escaped-jsx (second x))))
60 |                                  (when ,val (princ ,val ,attr)))))))))))
61 | (defvar *spliced-read* t)
62 | 
63 | (defun read-escaped-jsx (string)
64 |   (let ((trimmed-string (string-trim (list #\space #\newline #\tab) string)))
65 |     (if (and *spliced-read*
66 |              (not (member (aref trimmed-string 0) (list #\" #\()))
67 |              (some (lambda (separator)
68 |                 (find separator trimmed-string))
69 |               (list #\space #\newline #\tab)))
70 |         ;; Assume this is not an atom
71 |         (read-from-string (format nil "(~A)" string))
72 |         ;; else, read normally
73 |         (read-from-string string))))
74 | 


--------------------------------------------------------------------------------
/cl-jsx.lisp:
--------------------------------------------------------------------------------
  1 | (in-package :jsx)
  2 | 
  3 | ;; Reader syntax
  4 | 
  5 | (defun read-until-close-tag (tag-name stream content)
  6 |   (loop
  7 |      :with current-tag-chars := nil
  8 |      :with tag-start := nil
  9 |      :with close-tag-start := nil
 10 |      :for char := (read-char stream)
 11 |      :do
 12 |      (block continue
 13 |        (let ((current-tag-name
 14 |               (coerce
 15 |                (reverse current-tag-chars)
 16 |                'string)))
 17 |          #+debug(format t "~S~%" (list :char char :tag tag-name
 18 |                                        :current current-tag-name
 19 |                                        :start tag-start :close close-tag-start))
 20 |          (cond
 21 |            ((and (not tag-start)
 22 |                  (eql char #\<))
 23 |             ;; Opening a tag
 24 |             (setf tag-start t))
 25 |            ((and tag-start
 26 |                  (eql char #\/))
 27 |             ;; Closing a tag
 28 |             (setf close-tag-start t)
 29 |             (setf tag-start nil))
 30 |            ((and tag-start
 31 |                  (not (eql char #\/)))
 32 |             ;; It is tag open
 33 |             (unread-char char stream)
 34 |             (read-jsx-content stream content :parse-open nil)
 35 |             (setf current-tag-chars nil)
 36 |             (setf tag-start nil)
 37 |             (setf close-tag-start nil)
 38 |             (return-from continue))
 39 |            ((and close-tag-start
 40 |                  (eql char #\>)
 41 |                  (equalp current-tag-name tag-name))
 42 |             ;; Tag-name closed
 43 |             (vector-push-extend char content)
 44 |             (return-from read-until-close-tag))            
 45 |            ((and close-tag-start (not (eql char #\>)))
 46 |             ;; Build the closing tagname
 47 |             (push char current-tag-chars))
 48 |            (t
 49 |             ;; Nothing of the above, clear state variables
 50 |             (setf current-tag-chars nil)
 51 |             (setf tag-start nil)
 52 |             (setf close-tag-start nil)))
 53 |          (vector-push-extend char content)))))
 54 | 
 55 | (defun read-jsx (stream &key (parse-open t))
 56 |   (let ((content (make-array 10000 :fill-pointer 0)))
 57 |     (read-jsx-content stream content :parse-open parse-open)
 58 |     (coerce content 'string)))
 59 | 
 60 | (defun read-jsx-content (stream content &key (parse-open t))
 61 |   ;; First, read the jsx element tag name
 62 |   (let ((tag-name nil))
 63 |     (when parse-open
 64 |       (let ((open-char (read-char stream t :eof t)))
 65 |         (assert (eql open-char #\<)
 66 |                 nil "Error parsing JSX")
 67 |         (vector-push-extend open-char content)))
 68 | 
 69 |     (loop
 70 |        :for char := (peek-char nil stream)
 71 |        :while (not (member char (list #\> #\Space)))
 72 |        :do
 73 |        (push char tag-name)
 74 |        (read-char stream)
 75 |        (vector-push-extend char content)
 76 |        :finally (setf tag-name (coerce (nreverse tag-name) 'string)))
 77 | 
 78 |     ;; Consume to the end of the opening tag
 79 |     (loop
 80 |        :for char := (read-char stream)
 81 |        :while (not (eql char #\>))
 82 |        :do (vector-push-extend char content)
 83 |        :finally (vector-push-extend char content))
 84 | 
 85 |     ;; Read until last </tag-name> is found
 86 |     (read-until-close-tag tag-name stream content)))
 87 | 
 88 | (named-readtables:defreadtable :jsx
 89 |   (:merge :standard)
 90 |   (:dispatch-macro-char
 91 |    #\# #\<
 92 |    (lambda (stream c1 c2)
 93 |      (jsx.who:emit-who
 94 |       (jsx.parser:parse-jsx
 95 |        (concatenate 'string "<" (read-jsx stream :parse-open nil)))))))
 96 | 
 97 | 
 98 | (defun enable-jsx-syntax ()
 99 |   (named-readtables:in-readtable :jsx))
100 | 


--------------------------------------------------------------------------------
/parser.lisp:
--------------------------------------------------------------------------------
  1 | (defpackage :jsx.parser
  2 |   (:use :cl :esrap)
  3 |   (:export #:parse-jsx))
  4 | 
  5 | (in-package :jsx.parser)
  6 | 
  7 | (defrule tag-name (+ (not (or #\> space)))
  8 |   (:text t))
  9 | 
 10 | (defrule space (or #\Newline #\Tab #\Return #\Space)
 11 |   (:text t))
 12 | 
 13 | (defrule space* (* space)
 14 |   (:text t))
 15 | 
 16 | (defrule space+ (+ space)
 17 |   (:text t))
 18 | 
 19 | (defrule attribute (and attribute-name
 20 |                         space*
 21 |                         #\=
 22 |                         space*
 23 |                         attribute-value)
 24 |   (:destructure (name space eq space2 value)
 25 |                 (list :attribute name value)))
 26 | 
 27 | (defrule attribute-name (+ (not (or #\/ #\> #\= space)))
 28 |   (:text t))
 29 | 
 30 | (defrule attribute-value (or jsx-escape
 31 |                              attribute-value-literal
 32 |                              )
 33 |   )
 34 | 
 35 | (defrule attribute-value-literal-plain-text (+ (not (or jsx-escape #\")))
 36 |   (:text t))
 37 | 
 38 | (defrule attribute-value-literal-text (+
 39 |                                        (or jsx-escape
 40 |                                            attribute-value-literal-plain-text))
 41 |   )
 42 | 
 43 | (defrule attribute-value-literal (and #\"
 44 |                                       attribute-value-literal-text
 45 |                                       #\")
 46 |   (:destructure (begin text end)
 47 |                 text))
 48 | 
 49 | (defrule attributes (* (and space* attribute space*))
 50 |   (:function (lambda (attributes)
 51 |                (mapcar #'second attributes))))
 52 | 
 53 | (defrule open-element (and #\<
 54 |                            (! #\/) tag-name
 55 |                            attributes
 56 |                            #\>)
 57 |   (:destructure (open _ tag-name attributes close)
 58 |                 (list :open tag-name attributes)))
 59 | 
 60 | (defrule close-element (and #\< #\/ tag-name #\>)
 61 |   (:destructure (open _ tag-name close)
 62 |                 (list :close tag-name)))
 63 | 
 64 | (defrule jsx-escape-text-ignore (and #\{ (+ (not #\})) #\})
 65 |   (:text t))
 66 | 
 67 | (defrule jsx-escape-text (+ (or jsx-escape-text-ignore (not #\})))
 68 |   (:text t))
 69 | 
 70 | (defrule jsx-escape (and #\{ jsx-escape-text #\})
 71 |   (:destructure (start text end)
 72 |                 (list :jsx-escape text)))
 73 | 
 74 | (defrule text (+ (or plain-text
 75 |                      jsx-escape))
 76 |   (:function (lambda (x)
 77 |                x)))
 78 | 
 79 | (defrule plain-text (+ (not (or open-element
 80 |                                 close-element
 81 |                                 jsx-escape)))
 82 |   (:text t))
 83 | 
 84 | (defrule element-content (+ (or element
 85 |                                 text)))
 86 | 
 87 | (defrule element (and open-element
 88 |                       (? element-content)
 89 |                       close-element)
 90 |   (:destructure (open-tag content close-tag)
 91 |                 (assert (equal (second open-tag)
 92 |                                (second close-tag))
 93 |                         nil "Error parsing element: ~A" open-tag)
 94 |                 (list :element
 95 |                       (second open-tag)
 96 |                       (third open-tag)
 97 |                       (flatten-content content))))
 98 | 
 99 | (defun flatten-content (content)
100 |   (loop
101 |      :with result := nil
102 |      :for elem :in content
103 |      :do
104 |      (if (eql (first elem) :element)
105 |          (push elem result)
106 |          ;; else
107 |          (loop
108 |             :for x :in elem
109 |             :do (push x result)))
110 |      :finally (return (nreverse result))))
111 | 
112 | ;; Toplevel
113 | 
114 | (defun parse-jsx (text &rest args &key (start 0) end junk-allowed raw)
115 |   (apply #'parse 'element text args))
116 | 


--------------------------------------------------------------------------------
/t/cl-jsx.lisp:
--------------------------------------------------------------------------------
  1 | (in-package :cl-user)
  2 | 
  3 | (defpackage jsx.test
  4 |   (:use :cl
  5 |         :jsx
  6 |         :prove))
  7 | 
  8 | (in-package :jsx.test)
  9 | 
 10 | (eval-when (:compile-toplevel :load-toplevel :execute)
 11 |   (jsx:enable-jsx-syntax))
 12 | 
 13 | ;; NOTE: To run this test file, execute `(asdf:test-system :cl-jsx)' in your Lisp.
 14 | 
 15 | (plan 4)
 16 | 
 17 | (setf prove:*enable-colors* nil)
 18 | 
 19 | (deftest sanity-check
 20 |   (pass "PROVE is loaded and ready to go.")
 21 |   (ok (= 1 1)
 22 |       "Numeric equality: (= 1 1) => T.")
 23 |   (is (+ 1 1)
 24 |       2
 25 |       "Addition: (+ 1 1) => 2.")
 26 |   (is (* 2 2)
 27 |       4
 28 |       "Multiplication: (* 2 2) => 4.")
 29 |   (is (mod (+ 10 2) 10)
 30 |       2
 31 |       "Modulus: (mod (+ 10 2) 10) => 2."))
 32 | 
 33 | (deftest parser-tests
 34 |   (is (jsx.parser::parse 'jsx.parser::tag-name "asdf")
 35 |       "asdf")
 36 |   (is-error (jsx.parser::parse 'jsx.parser::tag-name "adfd>") 'error) ;; Error
 37 |   (is-error (jsx.parser::parse 'jsx.parser::tag-name "asdf adsf") 'error) ;; Error
 38 | 
 39 |   (is (jsx.parser::parse 'jsx.parser::jsx-escape "{asdfas}")
 40 |       (list :jsx-escape "asdfas"))
 41 |   (is (jsx.parser::parse 'jsx.parser::jsx-escape "{asd asd fads}")
 42 |       (list :jsx-escape "asd asd fads"))
 43 |   (is (jsx.parser::parse 'jsx.parser::jsx-escape "{hello {world}}")
 44 |       (list :jsx-escape "hello {world}"))
 45 |   (is (jsx.parser::parse 'jsx.parser::jsx-escape "{asdf{}")
 46 |       (list :jsx-escape "asdf{"))
 47 |   (is-error (jsx.parser::parse 'jsx.parser::jsx-escape "{asdfas") 'error) ;; Error
 48 | 
 49 |   (is (jsx.parser::parse 'jsx.parser::attribute "asdf=\"afff\"")
 50 |       '(:ATTRIBUTE "asdf" ("afff")))
 51 |   (is (jsx.parser::parse 'jsx.parser::attribute "adfs = \" asdfasdf \"")
 52 |       '(:ATTRIBUTE "adfs" (" asdfasdf ")))
 53 |   (is (jsx.parser::parse 'jsx.parser::attribute "asdf={aaa}")
 54 |       '(:ATTRIBUTE "asdf" (:JSX-ESCAPE "aaa")))
 55 |   (is (jsx.parser::parse 'jsx.parser::attribute "asdf=\"aaa {hola}\"")
 56 |       '(:ATTRIBUTE "asdf" ("aaa " (:JSX-ESCAPE "hola"))))
 57 |   (is (jsx.parser::parse 'jsx.parser::plain-text "asdf")
 58 |       "asdf")
 59 |   (is (jsx.parser::parse 'jsx.parser::text "asdf {aaa} asdf" )
 60 |       '("asdf " (:JSX-ESCAPE "aaa") " asdf"))
 61 | 
 62 |   (is (jsx.parser::parse 'jsx.parser::open-element "<adsf>")
 63 |       '(:OPEN "adsf" NIL))
 64 |   (is (jsx.parser::parse 'jsx.parser::open-element "<asdf asdf={aaa}>")
 65 |       '(:OPEN "asdf" ((:ATTRIBUTE "asdf" (:JSX-ESCAPE "aaa")))))
 66 |   (is (jsx.parser::parse 'jsx.parser::open-element "<asdf asdf=\"asdf\">")
 67 |       '(:OPEN "asdf" ((:ATTRIBUTE "asdf" ("asdf")))))
 68 |   (is (jsx.parser::parse 'jsx.parser::open-element "<asdf foo=\"foo\" bar=\"bar\">")
 69 |       '(:OPEN "asdf" ((:ATTRIBUTE "foo" ("foo")) (:ATTRIBUTE "bar" ("bar")))))
 70 |   (is (jsx.parser::parse 'jsx.parser::open-element "<asdf asdf=\"asdf {adsf}\">")
 71 |       '(:OPEN "asdf" ((:ATTRIBUTE "asdf" ("asdf " (:JSX-ESCAPE "adsf"))))))
 72 | 
 73 |   (is (jsx.parser::parse 'jsx.parser::close-element "</asdf>")
 74 |       '(:close "asdf"))
 75 | 
 76 |   (is (jsx.parser::parse 'jsx.parser::element "<asdf>asdf</asdf>")
 77 |       '(:ELEMENT "asdf" NIL ("asdf")))
 78 |   (is (jsx.parser::parse 'jsx.parser::element "<asdf></asdf>")
 79 |       '(:ELEMENT "asdf" NIL NIL))
 80 |   (is (jsx.parser::parse 'jsx.parser::element "<asdf>ff <foo></foo> asdf {haha}</asdf>")
 81 |       '(:ELEMENT "asdf" NIL
 82 |         ("ff " (:ELEMENT "foo" NIL NIL) " asdf " (:JSX-ESCAPE "haha"))))
 83 |   (is
 84 |    (jsx.parser::parse 'jsx.parser::element "<asdf foo={bar}>haha</asdf>")
 85 |    '(:ELEMENT "asdf" ((:ATTRIBUTE "foo" (:JSX-ESCAPE "bar"))) ("haha")))
 86 |   (is-error
 87 |    (jsx.parser::parse 'jsx.parser::element "<asdf foo={bar}>haha</fdas>")
 88 |    'error)
 89 |   (is
 90 |    (jsx.parser::parse 'jsx.parser::element "<lala aaa=\"asd\" yes=\"adf\">{(loop for x from 1 to 10
 91 |                    do #<p>{hello}</p>)}
 92 |                    </lala>")
 93 |    '(:ELEMENT "lala" ((:ATTRIBUTE "aaa" ("asd")) (:ATTRIBUTE "yes" ("adf")))
 94 |      ((:JSX-ESCAPE "(loop for x from 1 to 10
 95 |                    do #<p>{hello}</p>)")
 96 |       "
 97 |                    "))))
 98 | 
 99 | (deftest reader-tests
100 |   (is
101 |    (with-input-from-string (s "<lala></lala>")
102 |      (list (jsx::read-jsx s) (read-line s nil nil)))
103 |    '("<lala></lala>" NIL))
104 |   (is
105 |    (with-input-from-string (s "<lala>asdf</lala>")
106 |      (list (jsx::read-jsx s) (read-line s nil nil)))
107 |    '("<lala>asdf</lala>" NIL))
108 |   #+nil(is
109 |    (with-input-from-string (s "<lala>asdf<foo></lala>")
110 |      (list (jsx::read-jsx s) (read-line s nil nil)))
111 |    '("<lala>asdf<foo></lala>" NIL))
112 |   (is
113 |    (with-input-from-string (s "<lala>asdf</foo></lala>")
114 |      (list (jsx::read-jsx s) (read-line s nil nil)))
115 |    '("<lala>asdf</foo></lala>" NIL))
116 |   (is
117 |    (with-input-from-string (s "<lala>asdf<foo></foo></lala>")
118 |      (list (jsx::read-jsx s) (read-line s nil nil)))
119 |    '("<lala>asdf<foo></foo></lala>" NIL))
120 |   (is
121 |    (with-input-from-string (s "<lala foo=\"bar\">asdf<foo></foo></lala>")
122 |      (list (jsx::read-jsx s) (read-line s nil nil)))
123 |    '("<lala foo=\"bar\">asdf<foo></foo></lala>" NIL))
124 |   (is
125 |    (with-input-from-string (s "<lala foo=\"bar\">asdf<foo></foo></lala>asdf")
126 |      (list (jsx::read-jsx s) (read-line s nil nil)))
127 |    '("<lala foo=\"bar\">asdf<foo></foo></lala>" "asdf"))
128 |   (is (with-input-from-string (s "<div>{#<div></div>}</div>")
129 |         (list (jsx::read-jsx s) (read-line s nil nil)))
130 |       '("<div>{#<div></div>}</div>" nil)))
131 | 
132 | (defmacro render-who (jsx)
133 |   `(who:with-html-output-to-string (html)
134 |      ,(jsx.who:emit-who (jsx.parser:parse-jsx jsx))))
135 | 
136 | (deftest test-who-rendering
137 |   ;; Test
138 | 
139 |   (is (render-who "<lala>hello</lala>")
140 |       "<lala>hello</lala>")
141 |   (is (render-who "<foo></foo>")
142 |       "<foo></foo>")
143 |   (is-error (render-who "<foo>yes{asdf}</foo>") 'error)
144 |   (let ((asdf "asdf"))
145 |     (is (render-who "<foo>yes{asdf}</foo>") "<foo>yesasdf</foo>"))
146 |   (is
147 |    (let ((yes "yep"))
148 |      (render-who "<foo bar={yes}>lalal</foo>"))
149 |    "<foo bar='yep'>lalal</foo>")
150 |   (is (let ((now 22)
151 |             (haha nil))
152 |         (render-who "<asdf now={now}>ff <foo></foo> asdf{haha}</asdf>"))
153 |       "<asdf now='22'>ff <foo></foo> asdf</asdf>")
154 |   (is (render-who "<foo bar={nil}></foo>")
155 |       "<foo></foo>")
156 |   (is (render-who "<foo bar={t}><bar>lala</bar></foo>")
157 |       "<foo bar='bar'><bar>lala</bar></foo>")
158 |   (is (render-who "<a href={22}>{#<a>hello{33}</a>}</a>")
159 |       "<a href='22'><a>hello33</a></a>"))
160 | 
161 | (run-test-all)
162 | 


--------------------------------------------------------------------------------