;; Strict evaluator tests. Each test parses, desugars, and evaluates
;; either an expression (hk-eval-expr-source) or a full program
;; (hk-eval-program → look up a named value).

(define
  hk-prog-val
  (fn
    (src name)
    (hk-deep-force (get (hk-eval-program (hk-core src)) name))))

;; ── Literals ──
(hk-test "int literal" (hk-eval-expr-source "42") 42)
(hk-test "float literal" (hk-eval-expr-source "3.14") 3.14)
(hk-test "string literal" (hk-eval-expr-source "\"hi\"") "hi")
(hk-test "char literal" (hk-eval-expr-source "'a'") "a")
(hk-test "negative literal" (hk-eval-expr-source "- 5") -5)

;; ── Arithmetic ──
(hk-test "addition" (hk-eval-expr-source "1 + 2") 3)
(hk-test
  "precedence"
  (hk-eval-expr-source "1 + 2 * 3")
  7)
(hk-test
  "parens override precedence"
  (hk-eval-expr-source "(1 + 2) * 3")
  9)
(hk-test
  "subtraction left-assoc"
  (hk-eval-expr-source "10 - 3 - 2")
  5)

;; ── Comparison + Bool ──
(hk-test
  "less than is True"
  (hk-eval-expr-source "3 < 5")
  (list "True"))
(hk-test
  "equality is False"
  (hk-eval-expr-source "1 == 2")
  (list "False"))
(hk-test
  "&& shortcuts"
  (hk-eval-expr-source "(1 == 1) && (2 == 2)")
  (list "True"))

;; ── if / otherwise ──
(hk-test
  "if True"
  (hk-eval-expr-source "if True then 1 else 2")
  1)
(hk-test
  "if comparison branch"
  (hk-eval-expr-source "if 5 > 3 then \"yes\" else \"no\"")
  "yes")
(hk-test "otherwise is True" (hk-eval-expr-source "otherwise") (list "True"))

;; ── let ──
(hk-test
  "let single binding"
  (hk-eval-expr-source "let x = 5 in x + 1")
  6)
(hk-test
  "let two bindings"
  (hk-eval-expr-source "let x = 1; y = 2 in x + y")
  3)
(hk-test
  "let recursive: factorial 5"
  (hk-eval-expr-source
    "let f n = if n == 0 then 1 else n * f (n - 1) in f 5")
  120)

;; ── Lambdas ──
(hk-test
  "lambda apply"
  (hk-eval-expr-source "(\\x -> x + 1) 5")
  6)
(hk-test
  "lambda multi-arg"
  (hk-eval-expr-source "(\\x y -> x * y) 3 4")
  12)
(hk-test
  "lambda with constructor pattern"
  (hk-eval-expr-source "(\\(Just x) -> x + 1) (Just 7)")
  8)

;; ── Constructors ──
(hk-test
  "0-arity constructor"
  (hk-eval-expr-source "Nothing")
  (list "Nothing"))
(hk-test
  "1-arity constructor applied"
  (hk-eval-expr-source "Just 5")
  (list "Just" 5))
(hk-test
  "True / False as bools"
  (hk-eval-expr-source "True")
  (list "True"))

;; ── case ──
(hk-test
  "case Just"
  (hk-eval-expr-source
    "case Just 7 of Just x -> x ; Nothing -> 0")
  7)
(hk-test
  "case Nothing"
  (hk-eval-expr-source
    "case Nothing of Just x -> x ; Nothing -> 99")
  99)
(hk-test
  "case literal pattern"
  (hk-eval-expr-source
    "case 0 of 0 -> \"zero\" ; n -> \"other\"")
  "zero")
(hk-test
  "case tuple"
  (hk-eval-expr-source
    "case (1, 2) of (a, b) -> a + b")
  3)
(hk-test
  "case wildcard fallback"
  (hk-eval-expr-source
    "case 5 of 0 -> \"z\" ; _ -> \"nz\"")
  "nz")

;; ── List literals + cons ──
(hk-test
  "list literal as cons spine"
  (hk-eval-expr-source "[1, 2, 3]")
  (list ":" 1 (list ":" 2 (list ":" 3 (list "[]")))))
(hk-test
  "empty list literal"
  (hk-eval-expr-source "[]")
  (list "[]"))
(hk-test
  "cons via :"
  (hk-eval-expr-source "1 : []")
  (list ":" 1 (list "[]")))
(hk-test
  "++ concatenates lists"
  (hk-eval-expr-source "[1, 2] ++ [3]")
  (list ":" 1 (list ":" 2 (list ":" 3 (list "[]")))))

;; ── Tuples ──
(hk-test
  "2-tuple"
  (hk-eval-expr-source "(1, 2)")
  (list "Tuple" 1 2))
(hk-test
  "3-tuple"
  (hk-eval-expr-source "(\"a\", 5, True)")
  (list "Tuple" "a" 5 (list "True")))

;; ── Sections ──
(hk-test
  "right section (+ 1) applied"
  (hk-eval-expr-source "(+ 1) 5")
  6)
(hk-test
  "left section (10 -) applied"
  (hk-eval-expr-source "(10 -) 4")
  6)

;; ── Multi-clause top-level functions ──
(hk-test
  "multi-clause: factorial"
  (hk-prog-val
    "fact 0 = 1\nfact n = n * fact (n - 1)\nresult = fact 6"
    "result")
  720)

(hk-test
  "multi-clause: list length via cons pattern"
  (hk-prog-val
    "len [] = 0\nlen (x:xs) = 1 + len xs\nresult = len [10, 20, 30, 40]"
    "result")
  4)

(hk-test
  "multi-clause: Maybe handler"
  (hk-prog-val
    "fromMaybe d Nothing = d\nfromMaybe _ (Just x) = x\nresult = fromMaybe 0 (Just 9)"
    "result")
  9)

(hk-test
  "multi-clause: Maybe with default"
  (hk-prog-val
    "fromMaybe d Nothing = d\nfromMaybe _ (Just x) = x\nresult = fromMaybe 0 Nothing"
    "result")
  0)

;; ── User-defined data and matching ──
(hk-test
  "custom data with pattern match"
  (hk-prog-val
    "data Color = Red | Green | Blue\nname Red = \"red\"\nname Green = \"green\"\nname Blue = \"blue\"\nresult = name Green"
    "result")
  "green")

(hk-test
  "custom binary tree height"
  (hk-prog-val
    "data Tree = Leaf | Node Tree Tree\nh Leaf = 0\nh (Node l r) = 1 + max (h l) (h r)\nmax a b = if a > b then a else b\nresult = h (Node (Node Leaf Leaf) Leaf)"
    "result")
  2)

;; ── Currying ──
(hk-test
  "partial application"
  (hk-prog-val
    "add x y = x + y\nadd5 = add 5\nresult = add5 7"
    "result")
  12)

;; ── Higher-order ──
(hk-test
  "higher-order: function as arg"
  (hk-prog-val
    "twice f x = f (f x)\ninc x = x + 1\nresult = twice inc 10"
    "result")
  12)

;; ── Error built-in ──
(hk-test
  "error short-circuits via if"
  (hk-eval-expr-source
    "if True then 1 else error \"unreachable\"")
  1)

;; ── Laziness: app args evaluate only when forced ──
(hk-test
  "second arg never forced"
  (hk-eval-expr-source
    "(\\x y -> x) 1 (error \"never\")")
  1)

(hk-test
  "first arg never forced"
  (hk-eval-expr-source
    "(\\x y -> y) (error \"never\") 99")
  99)

(hk-test
  "constructor argument is lazy under wildcard pattern"
  (hk-eval-expr-source
    "case Just (error \"deeply\") of Just _ -> 7 ; Nothing -> 0")
  7)

(hk-test
  "lazy: const drops its second argument"
  (hk-prog-val
    "const x y = x\nresult = const 5 (error \"boom\")"
    "result")
  5)

(hk-test
  "lazy: head ignores tail"
  (hk-prog-val
    "myHead (x:_) = x\nresult = myHead (1 : (error \"tail\") : [])"
    "result")
  1)

(hk-test
  "lazy: Just on undefined evaluates only on force"
  (hk-prog-val
    "wrapped = Just (error \"oh no\")\nresult = case wrapped of Just _ -> True ; Nothing -> False"
    "result")
  (list "True"))

;; ── not / id built-ins ──
(hk-test "not True" (hk-eval-expr-source "not True") (list "False"))
(hk-test "not False" (hk-eval-expr-source "not False") (list "True"))
(hk-test "id" (hk-eval-expr-source "id 42") 42)

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