(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 "))))))