rose-ash/spec/tests/test-stepper.sx

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