rose-ash/lib/haskell/tests/parser-patterns.sx

;; Full-pattern parser tests: as-patterns, lazy ~, negative literals,
;; infix constructor patterns (`:`, any consym), lambda pattern args,
;; and let pattern-bindings.

;; ── as-patterns ──
(hk-test
  "as pattern, wraps constructor"
  (hk-parse "case x of n@(Just y) -> n")
  (list
    :case
    (list :var "x")
    (list
      (list
        :alt
        (list
          :p-as
          "n"
          (list :p-con "Just" (list (list :p-var "y"))))
        (list :var "n")))))

(hk-test
  "as pattern, wraps wildcard"
  (hk-parse "case x of all@_ -> all")
  (list
    :case
    (list :var "x")
    (list
      (list
        :alt
        (list :p-as "all" (list :p-wild))
        (list :var "all")))))

(hk-test
  "as in lambda"
  (hk-parse "\\xs@(a : rest) -> xs")
  (list
    :lambda
    (list
      (list
        :p-as
        "xs"
        (list
          :p-con
          ":"
          (list (list :p-var "a") (list :p-var "rest")))))
    (list :var "xs")))

;; ── lazy patterns ──
(hk-test
  "lazy var"
  (hk-parse "case x of ~y -> y")
  (list
    :case
    (list :var "x")
    (list
      (list :alt (list :p-lazy (list :p-var "y")) (list :var "y")))))

(hk-test
  "lazy constructor"
  (hk-parse "\\(~(Just x)) -> x")
  (list
    :lambda
    (list
      (list
        :p-lazy
        (list :p-con "Just" (list (list :p-var "x")))))
    (list :var "x")))

;; ── negative literal patterns ──
(hk-test
  "negative int pattern"
  (hk-parse "case n of\n  -1 -> 0\n  _ -> n")
  (list
    :case
    (list :var "n")
    (list
      (list :alt (list :p-int -1) (list :int 0))
      (list :alt (list :p-wild) (list :var "n")))))

(hk-test
  "negative float pattern"
  (hk-parse "case x of -0.5 -> 1")
  (list
    :case
    (list :var "x")
    (list (list :alt (list :p-float -0.5) (list :int 1)))))

;; ── infix constructor patterns (`:` and any consym) ──
(hk-test
  "cons pattern"
  (hk-parse "case xs of x : rest -> x")
  (list
    :case
    (list :var "xs")
    (list
      (list
        :alt
        (list
          :p-con
          ":"
          (list (list :p-var "x") (list :p-var "rest")))
        (list :var "x")))))

(hk-test
  "cons is right-associative in pats"
  (hk-parse "case xs of a : b : rest -> rest")
  (list
    :case
    (list :var "xs")
    (list
      (list
        :alt
        (list
          :p-con
          ":"
          (list
            (list :p-var "a")
            (list
              :p-con
              ":"
              (list (list :p-var "b") (list :p-var "rest")))))
        (list :var "rest")))))

(hk-test
  "consym pattern"
  (hk-parse "case p of a :+: b -> a")
  (list
    :case
    (list :var "p")
    (list
      (list
        :alt
        (list
          :p-con
          ":+:"
          (list (list :p-var "a") (list :p-var "b")))
        (list :var "a")))))

;; ── lambda with pattern args ──
(hk-test
  "lambda with constructor pattern"
  (hk-parse "\\(Just x) -> x")
  (list
    :lambda
    (list (list :p-con "Just" (list (list :p-var "x"))))
    (list :var "x")))

(hk-test
  "lambda with tuple pattern"
  (hk-parse "\\(a, b) -> a + b")
  (list
    :lambda
    (list
      (list
        :p-tuple
        (list (list :p-var "a") (list :p-var "b"))))
    (list :op "+" (list :var "a") (list :var "b"))))

(hk-test
  "lambda with wildcard"
  (hk-parse "\\_ -> 42")
  (list :lambda (list (list :p-wild)) (list :int 42)))

(hk-test
  "lambda with mixed apats"
  (hk-parse "\\x _ (Just y) -> y")
  (list
    :lambda
    (list
      (list :p-var "x")
      (list :p-wild)
      (list :p-con "Just" (list (list :p-var "y"))))
    (list :var "y")))

;; ── let pattern-bindings ──
(hk-test
  "let tuple pattern-binding"
  (hk-parse "let (x, y) = pair in x + y")
  (list
    :let
    (list
      (list
        :bind
        (list
          :p-tuple
          (list (list :p-var "x") (list :p-var "y")))
        (list :var "pair")))
    (list :op "+" (list :var "x") (list :var "y"))))

(hk-test
  "let constructor pattern-binding"
  (hk-parse "let Just x = m in x")
  (list
    :let
    (list
      (list
        :bind
        (list :p-con "Just" (list (list :p-var "x")))
        (list :var "m")))
    (list :var "x")))

(hk-test
  "let cons pattern-binding"
  (hk-parse "let (x : rest) = xs in x")
  (list
    :let
    (list
      (list
        :bind
        (list
          :p-con
          ":"
          (list (list :p-var "x") (list :p-var "rest")))
        (list :var "xs")))
    (list :var "x")))

;; ── do with constructor-pattern binds ──
(hk-test
  "do bind to tuple pattern"
  (hk-parse "do\n  (a, b) <- pairs\n  return a")
  (list
    :do
    (list
      (list
        :do-bind
        (list
          :p-tuple
          (list (list :p-var "a") (list :p-var "b")))
        (list :var "pairs"))
      (list
        :do-expr
        (list :app (list :var "return") (list :var "a"))))))

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