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

;; records.sx — Phase 14 record syntax tests.

(define
  hk-person-source
  "data Person = Person { name :: String, age :: Int }\n")

(define hk-pt-source "data Pt = Pt { x :: Int, y :: Int }\n")

;; ── Creation ────────────────────────────────────────────────
(hk-test
  "creation: Person { name = \"a\", age = 1 } via accessor name"
  (hk-deep-force
    (hk-run
      (str
        hk-person-source
        "main = name (Person { name = \"alice\", age = 30 })")))
  "alice")

(hk-test
  "creation: source order doesn't matter (age first)"
  (hk-deep-force
    (hk-run
      (str hk-person-source "main = name (Person { age = 99, name = \"bob\" })")))
  "bob")

(hk-test
  "creation: age accessor returns the right field"
  (hk-deep-force
    (hk-run
      (str hk-person-source "main = age (Person { age = 99, name = \"bob\" })")))
  99)

;; ── Accessors ──────────────────────────────────────────────
(hk-test
  "accessor: x of Pt"
  (hk-deep-force
    (hk-run (str hk-pt-source "main = x (Pt { x = 7, y = 99 })")))
  7)

(hk-test
  "accessor: y of Pt"
  (hk-deep-force
    (hk-run (str hk-pt-source "main = y (Pt { x = 7, y = 99 })")))
  99)

;; ── Update — single field ──────────────────────────────────
(hk-test
  "update one field: age changes"
  (hk-deep-force
    (hk-run
      (str
        hk-person-source
        "alice = Person { name = \"alice\", age = 30 }\nmain = age (alice { age = 31 })")))
  31)

(hk-test
  "update one field: name preserved"
  (hk-deep-force
    (hk-run
      (str
        hk-person-source
        "alice = Person { name = \"alice\", age = 30 }\nmain = name (alice { age = 31 })")))
  "alice")

;; ── Update — two fields ────────────────────────────────────
(hk-test
  "update two fields: both changed"
  (hk-deep-force
    (hk-run
      (str
        hk-person-source
        "alice = Person { name = \"alice\", age = 30 }\nbob = alice { name = \"bob\", age = 50 }\nmain = age bob")))
  50)

(hk-test
  "update two fields: name takes new value"
  (hk-deep-force
    (hk-run
      (str
        hk-person-source
        "alice = Person { name = \"alice\", age = 30 }\nbob = alice { name = \"bob\", age = 50 }\nmain = name bob")))
  "bob")

;; ── Record patterns ────────────────────────────────────────
(hk-test
  "case-alt record pattern: Pt { x = a }"
  (hk-deep-force
    (hk-run
      (str
        hk-pt-source
        "getX p = case p of Pt { x = a } -> a\nmain = getX (Pt { x = 7, y = 99 })")))
  7)

(hk-test
  "case-alt record pattern: multi-field bind"
  (hk-deep-force
    (hk-run
      (str
        hk-pt-source
        "sumPt p = case p of Pt { x = a, y = b } -> a + b\nmain = sumPt (Pt { x = 3, y = 4 })")))
  7)

(hk-test
  "fun-LHS record pattern"
  (hk-deep-force
    (hk-run
      (str
        hk-person-source
        "getName (Person { name = n }) = n\nmain = getName (Person { name = \"alice\", age = 30 })")))
  "alice")

;; ── deriving Show on a record ───────────────────────────────
(hk-test
  "deriving Show on a record produces positional output"
  (hk-deep-force
    (hk-run
      "data Person = Person { name :: String, age :: Int } deriving (Show)\nmain = show (Person { name = \"alice\", age = 30 })"))
  "Person \"alice\" 30")

(hk-test
  "deriving Show on Pt"
  (hk-deep-force
    (hk-run
      "data Pt = Pt { x :: Int, y :: Int } deriving (Show)\nmain = show (Pt { x = 3, y = 4 })"))
  "Pt 3 4")

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