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

;; Haskell layout-rule tests. hk-tokenizer + hk-layout produce a
;; virtual-brace-annotated stream; these tests cover the algorithm
;; from Haskell 98 §10.3 plus the pragmatic let/in single-line rule.

;; Convenience — tokenize, run layout, strip eof, keep :type/:value.
(define
  hk-lay
  (fn
    (src)
    (map
      (fn (tok) {:value (get tok "value") :type (get tok "type")})
      (filter
        (fn (tok) (not (= (get tok "type") "eof")))
        (hk-layout (hk-tokenize src))))))

;; ── 1. Basics ──
(hk-test
  "empty input produces empty module { }"
  (hk-lay "")
  (list
    {:value "{" :type "vlbrace"}
    {:value "}" :type "vrbrace"}))

(hk-test
  "single token → module open+close"
  (hk-lay "foo")
  (list
    {:value "{" :type "vlbrace"}
    {:value "foo" :type "varid"}
    {:value "}" :type "vrbrace"}))

(hk-test
  "two top-level decls get vsemi between"
  (hk-lay "foo = 1\nbar = 2")
  (list
    {:value "{" :type "vlbrace"}
    {:value "foo" :type "varid"}
    {:value "=" :type "reservedop"}
    {:value 1 :type "integer"}
    {:value ";" :type "vsemi"}
    {:value "bar" :type "varid"}
    {:value "=" :type "reservedop"}
    {:value 2 :type "integer"}
    {:value "}" :type "vrbrace"}))

;; ── 2. Layout keywords — do / let / where / of ──
(hk-test
  "do block with two stmts"
  (hk-lay "f = do\n  x\n  y")
  (list
    {:value "{" :type "vlbrace"}
    {:value "f" :type "varid"}
    {:value "=" :type "reservedop"}
    {:value "do" :type "reserved"}
    {:value "{" :type "vlbrace"}
    {:value "x" :type "varid"}
    {:value ";" :type "vsemi"}
    {:value "y" :type "varid"}
    {:value "}" :type "vrbrace"}
    {:value "}" :type "vrbrace"}))

(hk-test
  "single-line let ... in"
  (hk-lay "let x = 1 in x")
  (list
    {:value "{" :type "vlbrace"}
    {:value "let" :type "reserved"}
    {:value "{" :type "vlbrace"}
    {:value "x" :type "varid"}
    {:value "=" :type "reservedop"}
    {:value 1 :type "integer"}
    {:value "}" :type "vrbrace"}
    {:value "in" :type "reserved"}
    {:value "x" :type "varid"}
    {:value "}" :type "vrbrace"}))

(hk-test
  "where block with two bindings"
  (hk-lay "f = g\n  where\n    g = 1\n    h = 2")
  (list
    {:value "{" :type "vlbrace"}
    {:value "f" :type "varid"}
    {:value "=" :type "reservedop"}
    {:value "g" :type "varid"}
    {:value "where" :type "reserved"}
    {:value "{" :type "vlbrace"}
    {:value "g" :type "varid"}
    {:value "=" :type "reservedop"}
    {:value 1 :type "integer"}
    {:value ";" :type "vsemi"}
    {:value "h" :type "varid"}
    {:value "=" :type "reservedop"}
    {:value 2 :type "integer"}
    {:value "}" :type "vrbrace"}
    {:value "}" :type "vrbrace"}))

(hk-test
  "case … of with arms"
  (hk-lay "f x = case x of\n  Just y -> y\n  Nothing -> 0")
  (list
    {:value "{" :type "vlbrace"}
    {:value "f" :type "varid"}
    {:value "x" :type "varid"}
    {:value "=" :type "reservedop"}
    {:value "case" :type "reserved"}
    {:value "x" :type "varid"}
    {:value "of" :type "reserved"}
    {:value "{" :type "vlbrace"}
    {:value "Just" :type "conid"}
    {:value "y" :type "varid"}
    {:value "->" :type "reservedop"}
    {:value "y" :type "varid"}
    {:value ";" :type "vsemi"}
    {:value "Nothing" :type "conid"}
    {:value "->" :type "reservedop"}
    {:value 0 :type "integer"}
    {:value "}" :type "vrbrace"}
    {:value "}" :type "vrbrace"}))

;; ── 3. Explicit braces disable layout ──
(hk-test
  "explicit braces — no implicit vlbrace/vsemi/vrbrace inside"
  (hk-lay "do { x ; y }")
  (list
    {:value "{" :type "vlbrace"}
    {:value "do" :type "reserved"}
    {:value "{" :type "lbrace"}
    {:value "x" :type "varid"}
    {:value ";" :type "semi"}
    {:value "y" :type "varid"}
    {:value "}" :type "rbrace"}
    {:value "}" :type "vrbrace"}))

;; ── 4. Dedent closes nested blocks ──
(hk-test
  "dedent back to module level closes do block"
  (hk-lay "f = do\n  x\n  y\ng = 2")
  (list
    {:value "{" :type "vlbrace"}
    {:value "f" :type "varid"}
    {:value "=" :type "reservedop"}
    {:value "do" :type "reserved"}
    {:value "{" :type "vlbrace"}
    {:value "x" :type "varid"}
    {:value ";" :type "vsemi"}
    {:value "y" :type "varid"}
    {:value "}" :type "vrbrace"}
    {:value ";" :type "vsemi"}
    {:value "g" :type "varid"}
    {:value "=" :type "reservedop"}
    {:value 2 :type "integer"}
    {:value "}" :type "vrbrace"}))

(hk-test
  "dedent closes inner let, emits vsemi at outer do level"
  (hk-lay "main = do\n  let x = 1\n  print x")
  (list
    {:value "{" :type "vlbrace"}
    {:value "main" :type "varid"}
    {:value "=" :type "reservedop"}
    {:value "do" :type "reserved"}
    {:value "{" :type "vlbrace"}
    {:value "let" :type "reserved"}
    {:value "{" :type "vlbrace"}
    {:value "x" :type "varid"}
    {:value "=" :type "reservedop"}
    {:value 1 :type "integer"}
    {:value "}" :type "vrbrace"}
    {:value ";" :type "vsemi"}
    {:value "print" :type "varid"}
    {:value "x" :type "varid"}
    {:value "}" :type "vrbrace"}
    {:value "}" :type "vrbrace"}))

;; ── 5. Module header skips outer implicit open ──
(hk-test
  "module M where — only where opens a block"
  (hk-lay "module M where\n  f = 1")
  (list
    {:value "module" :type "reserved"}
    {:value "M" :type "conid"}
    {:value "where" :type "reserved"}
    {:value "{" :type "vlbrace"}
    {:value "f" :type "varid"}
    {:value "=" :type "reservedop"}
    {:value 1 :type "integer"}
    {:value "}" :type "vrbrace"}))

;; ── 6. Newlines are stripped ──
(hk-test
  "newline tokens do not appear in output"
  (let
    ((toks (hk-layout (hk-tokenize "foo\nbar"))))
    (every?
      (fn (t) (not (= (get t "type") "newline")))
      toks))
  true)

;; ── 7. Continuation — deeper indent does NOT emit vsemi ──
(hk-test
  "line continuation (deeper indent) just merges"
  (hk-lay "foo = 1 +\n   2")
  (list
    {:value "{" :type "vlbrace"}
    {:value "foo" :type "varid"}
    {:value "=" :type "reservedop"}
    {:value 1 :type "integer"}
    {:value "+" :type "varsym"}
    {:value 2 :type "integer"}
    {:value "}" :type "vrbrace"}))

;; ── 8. Stack closing at EOF ──
(hk-test
  "EOF inside nested do closes all implicit blocks"
  (let
    ((toks (hk-lay "main = do\n  do\n    x")))
    (let
      ((n (len toks)))
      (list
        (get (nth toks (- n 1)) "type")
        (get (nth toks (- n 2)) "type")
        (get (nth toks (- n 3)) "type"))))
  (list "vrbrace" "vrbrace" "vrbrace"))

;; ── 9. Qualified-newline: x at deeper col than stack top does nothing ──
(hk-test
  "mixed where + do"
  (hk-lay "f = do\n    x\n  where\n    x = 1")
  (list
    {:value "{" :type "vlbrace"}
    {:value "f" :type "varid"}
    {:value "=" :type "reservedop"}
    {:value "do" :type "reserved"}
    {:value "{" :type "vlbrace"}
    {:value "x" :type "varid"}
    {:value "}" :type "vrbrace"}
    {:value "where" :type "reserved"}
    {:value "{" :type "vlbrace"}
    {:value "x" :type "varid"}
    {:value "=" :type "reservedop"}
    {:value 1 :type "integer"}
    {:value "}" :type "vrbrace"}
    {:value "}" :type "vrbrace"}))

{:fails hk-test-fails :pass hk-test-pass :fail hk-test-fail}