;; case-of and do-notation parser tests.
;; Covers the minimal patterns needed to make these meaningful: var,
;; wildcard, literal, constructor (with and without args), tuple, list.

;; ── Patterns (in case arms) ──
(hk-test
  "wildcard pat"
  (hk-parse "case x of _ -> 0")
  (list
    :case
    (list :var "x")
    (list (list :alt (list :p-wild) (list :int 0)))))

(hk-test
  "var pat"
  (hk-parse "case x of y -> y")
  (list
    :case
    (list :var "x")
    (list
      (list :alt (list :p-var "y") (list :var "y")))))

(hk-test
  "0-arity constructor pat"
  (hk-parse "case x of\n  Nothing -> 0\n  Just y -> y")
  (list
    :case
    (list :var "x")
    (list
      (list :alt (list :p-con "Nothing" (list)) (list :int 0))
      (list
        :alt
        (list :p-con "Just" (list (list :p-var "y")))
        (list :var "y")))))

(hk-test
  "int literal pat"
  (hk-parse "case n of\n  0 -> 1\n  _ -> n")
  (list
    :case
    (list :var "n")
    (list
      (list :alt (list :p-int 0) (list :int 1))
      (list :alt (list :p-wild) (list :var "n")))))

(hk-test
  "string literal pat"
  (hk-parse "case s of\n  \"hi\" -> 1\n  _ -> 0")
  (list
    :case
    (list :var "s")
    (list
      (list :alt (list :p-string "hi") (list :int 1))
      (list :alt (list :p-wild) (list :int 0)))))

(hk-test
  "tuple pat"
  (hk-parse "case p of (a, b) -> a")
  (list
    :case
    (list :var "p")
    (list
      (list
        :alt
        (list
          :p-tuple
          (list (list :p-var "a") (list :p-var "b")))
        (list :var "a")))))

(hk-test
  "list pat"
  (hk-parse "case xs of\n  [] -> 0\n  [a] -> a")
  (list
    :case
    (list :var "xs")
    (list
      (list :alt (list :p-list (list)) (list :int 0))
      (list
        :alt
        (list :p-list (list (list :p-var "a")))
        (list :var "a")))))

(hk-test
  "nested constructor pat"
  (hk-parse "case x of\n  Just (a, b) -> a\n  _ -> 0")
  (list
    :case
    (list :var "x")
    (list
      (list
        :alt
        (list
          :p-con
          "Just"
          (list
            (list
              :p-tuple
              (list (list :p-var "a") (list :p-var "b")))))
        (list :var "a"))
      (list :alt (list :p-wild) (list :int 0)))))

(hk-test
  "constructor with multiple var args"
  (hk-parse "case t of Pair a b -> a")
  (list
    :case
    (list :var "t")
    (list
      (list
        :alt
        (list
          :p-con
          "Pair"
          (list (list :p-var "a") (list :p-var "b")))
        (list :var "a")))))

;; ── case-of shapes ──
(hk-test
  "case with explicit braces"
  (hk-parse "case x of { Just y -> y ; Nothing -> 0 }")
  (list
    :case
    (list :var "x")
    (list
      (list
        :alt
        (list :p-con "Just" (list (list :p-var "y")))
        (list :var "y"))
      (list :alt (list :p-con "Nothing" (list)) (list :int 0)))))

(hk-test
  "case scrutinee is a full expression"
  (hk-parse "case f x + 1 of\n  y -> y")
  (list
    :case
    (list
      :op
      "+"
      (list :app (list :var "f") (list :var "x"))
      (list :int 1))
    (list (list :alt (list :p-var "y") (list :var "y")))))

(hk-test
  "case arm body is full expression"
  (hk-parse "case x of\n  Just y -> y + 1")
  (list
    :case
    (list :var "x")
    (list
      (list
        :alt
        (list :p-con "Just" (list (list :p-var "y")))
        (list :op "+" (list :var "y") (list :int 1))))))

;; ── do blocks ──
(hk-test
  "do with two expressions"
  (hk-parse "do\n  putStrLn \"hi\"\n  return 0")
  (list
    :do
    (list
      (list
        :do-expr
        (list :app (list :var "putStrLn") (list :string "hi")))
      (list
        :do-expr
        (list :app (list :var "return") (list :int 0))))))

(hk-test
  "do with bind"
  (hk-parse "do\n  x <- getLine\n  putStrLn x")
  (list
    :do
    (list
      (list :do-bind (list :p-var "x") (list :var "getLine"))
      (list
        :do-expr
        (list :app (list :var "putStrLn") (list :var "x"))))))

(hk-test
  "do with let"
  (hk-parse "do\n  let y = 5\n  print y")
  (list
    :do
    (list
      (list
        :do-let
        (list (list :bind (list :p-var "y") (list :int 5))))
      (list
        :do-expr
        (list :app (list :var "print") (list :var "y"))))))

(hk-test
  "do with multiple let bindings"
  (hk-parse "do\n  let x = 1\n      y = 2\n  print (x + y)")
  (list
    :do
    (list
      (list
        :do-let
        (list
          (list :bind (list :p-var "x") (list :int 1))
          (list :bind (list :p-var "y") (list :int 2))))
      (list
        :do-expr
        (list
          :app
          (list :var "print")
          (list :op "+" (list :var "x") (list :var "y")))))))

(hk-test
  "do with bind using constructor pat"
  (hk-parse "do\n  Just x <- getMaybe\n  return x")
  (list
    :do
    (list
      (list
        :do-bind
        (list :p-con "Just" (list (list :p-var "x")))
        (list :var "getMaybe"))
      (list
        :do-expr
        (list :app (list :var "return") (list :var "x"))))))

(hk-test
  "do with explicit braces"
  (hk-parse "do { x <- a ; y <- b ; return (x + y) }")
  (list
    :do
    (list
      (list :do-bind (list :p-var "x") (list :var "a"))
      (list :do-bind (list :p-var "y") (list :var "b"))
      (list
        :do-expr
        (list
          :app
          (list :var "return")
          (list :op "+" (list :var "x") (list :var "y")))))))

;; ── Mixing case/do inside expressions ──
(hk-test
  "case inside let"
  (hk-parse "let f = \\x -> case x of\n                 Just y -> y\n                 _ -> 0\nin f 5")
  (list
    :let
    (list
      (list
        :bind
        (list :p-var "f")
        (list
          :lambda
          (list (list :p-var "x"))
          (list
            :case
            (list :var "x")
            (list
              (list
                :alt
                (list :p-con "Just" (list (list :p-var "y")))
                (list :var "y"))
              (list :alt (list :p-wild) (list :int 0)))))))
    (list :app (list :var "f") (list :int 5))))

(hk-test
  "lambda containing do"
  (hk-parse "\\x -> do\n  y <- x\n  return y")
  (list
    :lambda
    (list (list :p-var "x"))
    (list
      :do
      (list
        (list :do-bind (list :p-var "y") (list :var "x"))
        (list
          :do-expr
          (list :app (list :var "return") (list :var "y")))))))

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