web/dom: unify call pattern for building elements - is always: attrs @body

test/test-web.lisp

@@ -5,9 +5,11 @@
   (:local-nicknames (:config :scopes/config)
                     (:core :scopes/core)
                     (:client :scopes/web/client)
+                    (:dom :scopes/web/dom)
                     (:logging :scopes/logging)
                     (:message :scopes/core/message)
                     (:server :scopes/web/server)
+                    (:util :scopes/util)
                     (:t :scopes/testing))
   (:export #:run)
   (:import-from :scopes/testing #:deftest #:== #:has-prefix))
@@ -32,6 +34,13 @@
       (core:shutdown)
       (t:show-result))))
 
+(deftest test-dom ()
+  (== (dom:render 
+        (dom:link '(:href "https://example.com"
+                    :title "Demo" :class '(:demo-link :plain))
+                  (dom:text "Link to example.com")))
+      "<a href=\"https://example.com\" title=\"Demo\" class=\"demo-link plain\">Link to example.com</a>"))
+
 (deftest test-server-config (server)
   (== (parse-integer (server:port (core:config server))) 8899))
 
@@ -42,5 +51,5 @@
 
 (deftest test-message (client)
   (let ((msg (message:create '(:test :data :field :info) :data '(:info "test data"))))
-    (== (str:trim (client:send-message client msg)) 
+    (== (util:flatten-str (client:send-message client msg)) 
         "<dl><dt>info</dt> <dd>test data</dd> </dl>")))

util.lisp

@@ -2,7 +2,7 @@
 
 (defpackage :scopes/util
   (:use :common-lisp)
-  (:export #:to-keyword #:trunc
+  (:export #:flatten-str #:to-keyword
            #:absolute-dir #:check-dir #:ensure-dir #:home-path #:path-from-string
            #:relative-path #:runtime-path #:system-path))
 
@@ -10,11 +10,8 @@
 
 ;;;; strings, symbols, keywords, ...
 
-(defun trunc (s n)
-  (let ((s1 (str:substring 0 n s)))
-    (if (> (length s) n)
-      (str:concat s1 "...")
-      s1)))
+(defun flatten-str (s &key (with " "))
+  (str:join with (str:lines s)))
 
 (defun to-keyword (s)
   (intern (string-upcase s) :keyword))

web/dom.lisp

@@ -3,39 +3,39 @@
 (defpackage :scopes/web/dom
   (:use :common-lisp)
   (:local-nicknames (:alx :alexandria))
-  (:export #:render #:dl))
+  (:export #:render #:text
+           #:dl #:link))
 
 (in-package :scopes/web/dom)
 
 ;;;; basic / common stuff
 
-(defvar *output* nil)
+(defvar *output* (make-string-output-stream))
 
 (defmacro render (&body body)
   `(let ((*output* (make-string-output-stream)))
      ,@body
      (get-output-stream-string *output*)))
 
+(defmacro text (s)
+  `(put-string (string ,s)))
+
 (defmacro put-string (s)
   `(write-string ,s *output*))
 
 (defmacro put-char (c)
   `(write-char ,c *output*))
 
-(defmacro nested (tag attrs &body body)
+(defmacro element (tag attrs &body body)
   `(progn
      (start ,tag ,attrs)
      ,@body
      (end ,tag t)))
 
-(defun terminal (tag attrs val)
-  (start tag attrs)
-  (put-string val)
-  (end tag))
-
 (defun start (tag &optional attrs)
   (put-char #\<)
   (put-string tag)
+  ;(put-attrs attrs)
   (put-char #\>))
 
 (defun end (tag &optional newline)
@@ -47,15 +47,17 @@
 
 ;;;; tag-specific renderers
 
-(defun dl (plist)
-  (nested "dl" nil
+(defun dl (attrs plist)
+  (element "dl" attrs
     (loop for (key val . r) on plist by #'cddr do
-      (terminal "dt" nil (string-downcase key))
-      (dd val))))
+      (element "dt" nil (put-string (string-downcase key)))
+      (dd nil val))))
 
-(defun dd (v)
+(defun dd (attrs v)
   (if (atom v)
     (setf v (list v)))
   (dolist (el v)
-    (terminal "dd" nil (string el))))
+    (element "dd" attrs (text el))))
 
+(defmacro link (attrs &body body)
+  `(element "a" ,attrs ,@body))

web/response.lisp

@@ -28,8 +28,7 @@
   ((ctype :initform "text/html")))
 
 (defmethod render-content ((resp html-response) msg)
-  (dom:render (dom:dl (message:data msg))))
-  ;(getf (message:data msg) :info))
+  (dom:render (dom:dl nil (message:data msg))))
 
 ;;;; common definitions