;; Runtime constructor-registry tests. Built-ins are pre-registered
;; when lib/haskell/runtime.sx loads; user types are registered by
;; walking a parsed+desugared AST with hk-register-program! (or the
;; `hk-load-source!` convenience).

;; ── Pre-registered built-ins ──
(hk-test "True is a con" (hk-is-con? "True") true)
(hk-test "False is a con" (hk-is-con? "False") true)
(hk-test "[] is a con" (hk-is-con? "[]") true)
(hk-test ": (cons) is a con" (hk-is-con? ":") true)
(hk-test "() is a con" (hk-is-con? "()") true)

(hk-test "True arity 0" (hk-con-arity "True") 0)
(hk-test ": arity 2" (hk-con-arity ":") 2)
(hk-test "[] arity 0" (hk-con-arity "[]") 0)
(hk-test "True type Bool" (hk-con-type "True") "Bool")
(hk-test "False type Bool" (hk-con-type "False") "Bool")
(hk-test ": type List" (hk-con-type ":") "List")
(hk-test "() type Unit" (hk-con-type "()") "Unit")

;; ── Unknown names ──
(hk-test "is-con? false for varid" (hk-is-con? "foo") false)
(hk-test "arity nil for unknown" (hk-con-arity "NotACon") nil)
(hk-test "type nil for unknown" (hk-con-type "NotACon") nil)

;; ── data MyBool = Yes | No ──
(hk-test
  "register simple data"
  (do
    (hk-load-source! "data MyBool = Yes | No")
    (list
      (hk-con-arity "Yes")
      (hk-con-arity "No")
      (hk-con-type "Yes")
      (hk-con-type "No")))
  (list 0 0 "MyBool" "MyBool"))

;; ── data Maybe a = Nothing | Just a ──
(hk-test
  "register Maybe"
  (do
    (hk-load-source! "data Maybe a = Nothing | Just a")
    (list
      (hk-con-arity "Nothing")
      (hk-con-arity "Just")
      (hk-con-type "Nothing")
      (hk-con-type "Just")))
  (list 0 1 "Maybe" "Maybe"))

;; ── data Either a b = Left a | Right b ──
(hk-test
  "register Either"
  (do
    (hk-load-source! "data Either a b = Left a | Right b")
    (list
      (hk-con-arity "Left")
      (hk-con-arity "Right")
      (hk-con-type "Left")
      (hk-con-type "Right")))
  (list 1 1 "Either" "Either"))

;; ── Recursive data ──
(hk-test
  "register recursive Tree"
  (do
    (hk-load-source!
      "data Tree a = Leaf | Node (Tree a) a (Tree a)")
    (list
      (hk-con-arity "Leaf")
      (hk-con-arity "Node")
      (hk-con-type "Leaf")
      (hk-con-type "Node")))
  (list 0 3 "Tree" "Tree"))

;; ── newtype ──
(hk-test
  "register newtype"
  (do
    (hk-load-source! "newtype Age = MkAge Int")
    (list
      (hk-con-arity "MkAge")
      (hk-con-type "MkAge")))
  (list 1 "Age"))

;; ── Multiple data decls in one program ──
(hk-test
  "multiple data decls"
  (do
    (hk-load-source!
      "data Color = Red | Green | Blue\ndata Shape = Circle | Square\nf x = x")
    (list
      (hk-con-type "Red")
      (hk-con-type "Green")
      (hk-con-type "Blue")
      (hk-con-type "Circle")
      (hk-con-type "Square")))
  (list "Color" "Color" "Color" "Shape" "Shape"))

;; ── Inside a module header ──
(hk-test
  "register from module body"
  (do
    (hk-load-source!
      "module M where\ndata Pair a = Pair a a")
    (list
      (hk-con-arity "Pair")
      (hk-con-type "Pair")))
  (list 2 "Pair"))

;; ── Non-data decls are ignored ──
(hk-test
  "program with only fun-decl leaves registry unchanged for that name"
  (do
    (hk-load-source! "myFunctionNotACon x = x + 1")
    (hk-is-con? "myFunctionNotACon"))
  false)

;; ── Re-registering overwrites (last wins) ──
(hk-test
  "re-registration overwrites the entry"
  (do
    (hk-load-source! "data Foo = Bar Int")
    (hk-load-source! "data Foo = Bar Int Int")
    (hk-con-arity "Bar"))
  2)

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