rose-ash/lib/guest/tests/layout.sx

;; lib/guest/tests/layout.sx — synthetic Python-ish off-side fixture.
;;
;; Exercises lib/guest/layout.sx with a config different from Haskell's
;; (no module-prelude, layout opens via trailing `:` not via reserved
;; keyword) to prove the kit isn't Haskell-shaped.

(define glayout-test-pass 0)
(define glayout-test-fail 0)
(define glayout-test-fails (list))

(define
  glayout-test
  (fn (name actual expected)
    (if (= actual expected)
      (set! glayout-test-pass (+ glayout-test-pass 1))
      (begin
        (set! glayout-test-fail (+ glayout-test-fail 1))
        (append! glayout-test-fails {:name name :expected expected :actual actual})))))

;; Convenience: build a token from {type value line col}.
(define
  glayout-tok
  (fn (ty val line col)
    {:type ty :value val :line line :col col}))

;; Project a token list to ((type value) ...) for compact comparison.
(define
  glayout-shape
  (fn (toks)
    (map (fn (t) (list (get t :type) (get t :value))) toks)))

;; ── Haskell-flavour: keyword opens block ─────────────────────────
(define
  glayout-haskell-cfg
  {:open-keywords (list "let" "where" "do" "of")
   :open-trailing-fn nil
   :open-token   {:type "vlbrace" :value "{"}
   :close-token  {:type "vrbrace" :value "}"}
   :sep-token    {:type "vsemi"   :value ";"}
   :module-prelude? false
   :explicit-open? (fn (tok) (= (get tok :type) "lbrace"))})

;;   do
;;     a
;;     b
;;   c       ← outside the do-block
(glayout-test "haskell-do-block"
  (glayout-shape
    (layout-pass
      glayout-haskell-cfg
      (list (glayout-tok "reserved" "do" 1 1)
            (glayout-tok "ident" "a" 2 3)
            (glayout-tok "ident" "b" 3 3)
            (glayout-tok "ident" "c" 4 1))))
  (list (list "reserved" "do")
        (list "vlbrace" "{")
        (list "ident" "a")
        (list "vsemi" ";")
        (list "ident" "b")
        (list "vrbrace" "}")
        (list "ident" "c")))

;; Explicit `{` after `do` suppresses virtual layout.
(glayout-test "haskell-explicit-brace"
  (glayout-shape
    (layout-pass
      glayout-haskell-cfg
      (list (glayout-tok "reserved" "do" 1 1)
            (glayout-tok "lbrace" "{" 1 4)
            (glayout-tok "ident" "a" 1 6)
            (glayout-tok "rbrace" "}" 1 8))))
  (list (list "reserved" "do")
        (list "lbrace" "{")
        (list "ident" "a")
        (list "rbrace" "}")))

;; Single-statement do-block on the same line.
(glayout-test "haskell-do-inline"
  (glayout-shape
    (layout-pass
      glayout-haskell-cfg
      (list (glayout-tok "reserved" "do" 1 1)
            (glayout-tok "ident" "a" 1 4))))
  (list (list "reserved" "do")
        (list "vlbrace" "{")
        (list "ident" "a")
        (list "vrbrace" "}")))

;; Module-prelude: wrap whole input in implicit layout block at first
;; tok's column.
(glayout-test "haskell-module-prelude"
  (glayout-shape
    (layout-pass
      (assoc glayout-haskell-cfg :module-prelude? true)
      (list (glayout-tok "ident" "x" 1 1)
            (glayout-tok "ident" "y" 2 1)
            (glayout-tok "ident" "z" 3 1))))
  (list (list "vlbrace" "{")
        (list "ident" "x")
        (list "vsemi" ";")
        (list "ident" "y")
        (list "vsemi" ";")
        (list "ident" "z")
        (list "vrbrace" "}")))

;; ── Python-flavour: trailing `:` opens block ─────────────────────
(define
  glayout-python-cfg
  {:open-keywords (list)
   :open-trailing-fn (fn (tok) (and (= (get tok :type) "punct")
                                    (= (get tok :value) ":")))
   :open-token   {:type "indent" :value "INDENT"}
   :close-token  {:type "dedent" :value "DEDENT"}
   :sep-token    {:type "newline" :value "NEWLINE"}
   :module-prelude? false
   :explicit-open? nil})

;;   if x:
;;       a
;;       b
;;   c
(glayout-test "python-if-block"
  (glayout-shape
    (layout-pass
      glayout-python-cfg
      (list (glayout-tok "reserved" "if" 1 1)
            (glayout-tok "ident" "x" 1 4)
            (glayout-tok "punct" ":" 1 5)
            (glayout-tok "ident" "a" 2 5)
            (glayout-tok "ident" "b" 3 5)
            (glayout-tok "ident" "c" 4 1))))
  (list (list "reserved" "if")
        (list "ident" "x")
        (list "punct" ":")
        (list "indent" "INDENT")
        (list "ident" "a")
        (list "newline" "NEWLINE")
        (list "ident" "b")
        (list "dedent" "DEDENT")
        (list "ident" "c")))

;; Nested Python-style blocks.
;;   def f():
;;       if x:
;;           a
;;       b
(glayout-test "python-nested"
  (glayout-shape
    (layout-pass
      glayout-python-cfg
      (list (glayout-tok "reserved" "def" 1 1)
            (glayout-tok "ident" "f" 1 5)
            (glayout-tok "punct" "(" 1 6)
            (glayout-tok "punct" ")" 1 7)
            (glayout-tok "punct" ":" 1 8)
            (glayout-tok "reserved" "if" 2 5)
            (glayout-tok "ident" "x" 2 8)
            (glayout-tok "punct" ":" 2 9)
            (glayout-tok "ident" "a" 3 9)
            (glayout-tok "ident" "b" 4 5))))
  (list (list "reserved" "def")
        (list "ident" "f")
        (list "punct" "(")
        (list "punct" ")")
        (list "punct" ":")
        (list "indent" "INDENT")
        (list "reserved" "if")
        (list "ident" "x")
        (list "punct" ":")
        (list "indent" "INDENT")
        (list "ident" "a")
        (list "dedent" "DEDENT")
        (list "ident" "b")
        (list "dedent" "DEDENT")))

(define glayout-tests-run!
  (fn ()
    {:passed glayout-test-pass
     :failed glayout-test-fail
     :total  (+ glayout-test-pass glayout-test-fail)}))