(define
is-html-tag?
(fn
(name)
(contains?
(list "div" "span" "h1" "h2" "h3" "p" "a" "button" "section" "nav")
name)))
(define
split-tag
(fn
(expr result)
(cond
(not (list? expr))
(append! result {:expr expr :type "leaf"})
(empty? expr)
nil
(not (= (type-of (first expr)) "symbol"))
(append! result {:expr expr :type "leaf"})
(is-html-tag? (symbol-name (first expr)))
(let
((ctag (symbol-name (first expr)))
(cargs (rest expr))
(cch (list))
(cat (list))
(spreads (list))
(ckw false))
(for-each
(fn
(a)
(cond
(= (type-of a) "keyword")
(do (set! ckw true) (append! cat a))
ckw
(do (set! ckw false) (append! cat a))
(and
(list? a)
(not (empty? a))
(= (type-of (first a)) "symbol")
(starts-with? (symbol-name (first a)) "~"))
(do (set! ckw false) (append! spreads a))
:else (do (set! ckw false) (append! cch a))))
cargs)
(append! result {:spreads spreads :tag ctag :type "open" :attrs cat})
(for-each (fn (c) (split-tag c result)) cch)
(append! result {:tag ctag :type "close"}))
:else (append! result {:expr expr :type "expr"}))))
(define
steps-to-preview
(fn
(all-steps target)
(if
(or (empty? all-steps) (<= target 0))
nil
(let
((pos (dict "i" 0)) (max-i (min target (len all-steps))))
(letrec
((bc-loop (fn (children) (if (>= (get pos "i") max-i) children (let ((step (nth all-steps (get pos "i"))) (stype (get step "type"))) (cond (= stype "open") (do (dict-set! pos "i" (+ (get pos "i") 1)) (let ((tag (get step "tag")) (inner (bc-loop (list)))) (append! children (concat (list (make-symbol tag)) inner))) (bc-loop children)) (= stype "close") (do (dict-set! pos "i" (+ (get pos "i") 1)) children) (= stype "leaf") (do (dict-set! pos "i" (+ (get pos "i") 1)) (append! children (get step "expr")) (bc-loop children)) :else (do (dict-set! pos "i" (+ (get pos "i") 1)) (bc-loop children))))))))
(let
((root (bc-loop (list))))
(cond
(= (len root) 1)
(first root)
(empty? root)
nil
:else (concat (list (make-symbol "<>")) root))))))))
(define
test-src
(quote (div (h1 (span "the ") (span "joy ") (span "of ") (span "sx")))))
(defsuite
"stepper-split-tag"
(deftest
"produces 16 steps for nested 4-span expression"
(let
((result (list)))
(split-tag test-src result)
(assert-equal 16 (len result))))
(deftest
"step sequence is open/open/.../close/close"
(let
((result (list)))
(split-tag test-src result)
(assert-equal "open" (get (first result) "type"))
(assert-equal "div" (get (first result) "tag"))
(assert-equal "leaf" (get (nth result 3) "type"))
(assert-equal "the " (get (nth result 3) "expr"))
(assert-equal "close" (get (last result) "type"))
(assert-equal "div" (get (last result) "tag"))))
(deftest
"children are correctly nested"
(let
((result (list)))
(split-tag test-src result)
(assert-equal "span" (get (nth result 2) "tag"))
(assert-equal "the " (get (nth result 3) "expr"))
(assert-equal "span" (get (nth result 4) "tag"))
(assert-equal "span" (get (nth result 8) "tag"))
(assert-equal "of " (get (nth result 9) "expr"))
(assert-equal "span" (get (nth result 10) "tag")))))
(defsuite
"stepper-preview"
(deftest
"full preview at step 16 equals source"
(let
((result (list)))
(split-tag test-src result)
(let
((expr (steps-to-preview result 16)))
(assert-equal test-src expr))))
(deftest
"step 10 includes of"
(let
((result (list)))
(split-tag test-src result)
(let
((expr (steps-to-preview result 10)))
(assert-true (string-contains? (str expr) "of ")))))
(deftest
"step 9 does NOT include of (leaf not yet processed)"
(let
((result (list)))
(split-tag test-src result)
(let
((expr (steps-to-preview result 9)))
(assert-false (string-contains? (str expr) "of ")))))
(deftest
"step 8 shows the and joy only"
(let
((result (list)))
(split-tag test-src result)
(let
((expr (steps-to-preview result 8)))
(assert-true (string-contains? (str expr) "the "))
(assert-true (string-contains? (str expr) "joy "))
(assert-false (string-contains? (str expr) "of "))))))