add html parsing - for testing and dom manipulations

scopes-web.asd

@@ -6,7 +6,7 @@
   :version "0.0.1"
   :homepage "https://www.cyberconcepts.org"
   :description "Web client and server functionality."
-  :depends-on (:cl-cookie :clack :dexador :flexi-streams 
+  :depends-on (:cl-cookie :cl-html-parse :clack :dexador :flexi-streams 
                :lack :lack-component :lack-app-file :quri
                :scopes-core)
   :components ((:file "frontend/cs-hx" :depends-on ("web/dom" "web/response"))

test/test-web.lisp

@@ -29,6 +29,7 @@
         (core:setup-services)
         (let ((server (core:find-service :server))
               (client (core:find-service :client)))
+          (test-dom-parse)
           (test-dom)
           (test-jwt)
           (test-server-config server)
@@ -39,6 +40,18 @@
       (core:shutdown)
       (t:show-result))))
 
+;;;; the tests
+
+(deftest test-dom-parse ()
+  (let (inp parsed rendered)
+    (setf inp "<a href=\"https://example.com\">Link</a>")
+    (setf parsed '(((:a :href "https://example.com") "Link")))
+    (== (dom:parse inp) parsed)
+    ;(setf wanted (dom:a '(:href "https://example.com") "Link"))
+    (== (dom:render (dom:from-list parsed)) inp)
+    )
+         )
+
 (deftest test-dom ()
   (== (dom:render 
         (dom:a '(:href "https://example.com"

web/dom.lisp

@@ -3,14 +3,17 @@
 (defpackage :scopes/web/dom
   (:use :common-lisp)
   (:local-nicknames (:util :scopes/util)
+                    (:hp :html-parse)
                     (:alx :alexandria))
   (:export #:xml-element
            #:elem #:element #:void-element #:render
            #:dlist
            #:a #:dd #:div #:dl #:dt #:label
-           #:br #:input))
+           #:br #:input
+           #:parse #:from-list))
 
 (in-package :scopes/web/dom)
+(defvar *this* *package*)
 
 ;;;; basic definitions
 
@@ -142,3 +145,22 @@
 (defun newline ()
   (put-char #\Newline))
 
+;;;; create elements from list of symbols
+
+(defun from-list (lst)
+  (mapcar #'(lambda (part) 
+    (etypecase part
+      (string part)
+      (symbol (funcall (find-symbol (string part) *this*)))
+      (list 
+        (etypecase (car part)
+          (symbol (apply (find-symbol (string (car part)) *this*) 
+                         nil (from-list (cdr part))))
+          (list (apply (find-symbol (string (caar part)) *this*) 
+                       (cdar part) (from-list (cdr part))))
+    )))) lst))
+
+;;;; parsing (for testing or manipulation of HTML using dom)
+
+(defun parse (html)
+  (hp:parse-html html))