(defsuite
  "algebraic-data-types"
  (deftest
    "constructor creates dict with adt marker"
    (do
      (define-type Maybe (Just value) (Nothing))
      (assert= true (get (Just 42) :_adt))))
  (deftest
    "constructor stores type name"
    (do
      (define-type Shape (Circle radius) (Square side))
      (assert= "Shape" (get (Circle 5) :_type))
      (assert= "Shape" (get (Square 3) :_type))))
  (deftest
    "constructor stores constructor name"
    (do
      (define-type Opt (Some val) (None))
      (assert= "Some" (get (Some 1) :_ctor))
      (assert= "None" (get (None) :_ctor))))
  (deftest
    "constructor stores fields as list"
    (do
      (define-type Pair (Pair-of fst snd))
      (assert-equal
        (list 1 2)
        (get (Pair-of 1 2) :_fields))))
  (deftest
    "zero-arg constructor has empty fields"
    (do
      (define-type Flag (Set) (Unset))
      (assert-equal (list) (get (Set) :_fields))
      (assert-equal (list) (get (Unset) :_fields))))
  (deftest
    "type predicate true for all constructors"
    (do
      (define-type Expr (Num n) (Add left right) (Neg e))
      (assert= true (Expr? (Num 5)))
      (assert= true (Expr? (Add (Num 1) (Num 2))))
      (assert= true (Expr? (Neg (Num 3))))))
  (deftest
    "type predicate false for non-adt values"
    (do
      (define-type Box (Box-of x))
      (assert= false (Box? 42))
      (assert= false (Box? "hello"))
      (assert= false (Box? nil))
      (assert= false (Box? (list 1 2)))
      (assert= false (Box? {}))))
  (deftest
    "type predicate false for wrong adt type"
    (do
      (define-type AT (AV x))
      (define-type BT (BV x))
      (assert= false (AT? (BV 1)))
      (assert= false (BT? (AV 1)))))
  (deftest
    "constructor predicate true for matching constructor"
    (do
      (define-type Result (Ok value) (Err msg))
      (assert= true (Ok? (Ok 42)))
      (assert= true (Err? (Err "bad")))))
  (deftest
    "constructor predicate false for wrong constructor"
    (do
      (define-type Coin (Heads) (Tails))
      (assert= false (Heads? (Tails)))
      (assert= false (Tails? (Heads)))))
  (deftest
    "constructor predicate false for non-adt"
    (do
      (define-type Wrap (Wrapped x))
      (assert= false (Wrapped? 42))
      (assert= false (Wrapped? nil))
      (assert= false (Wrapped? "str"))))
  (deftest
    "single-field accessor returns field value"
    (do
      (define-type Holder (Held content))
      (assert= 99 (Held-content (Held 99)))
      (assert= "hello" (Held-content (Held "hello")))))
  (deftest
    "multi-field accessors return correct fields"
    (do
      (define-type Triple (Triple-of a b c))
      (let
        ((t (Triple-of 10 20 30)))
        (assert= 10 (Triple-of-a t))
        (assert= 20 (Triple-of-b t))
        (assert= 30 (Triple-of-c t)))))
  (deftest
    "tree constructors and accessors"
    (do
      (define-type Tree (Leaf) (Node left val right))
      (let
        ((t (Node (Leaf) 5 (Node (Leaf) 3 (Leaf)))))
        (assert= true (Node? t))
        (assert= 5 (Node-val t))
        (assert= true (Leaf? (Node-left t)))
        (assert= true (Node? (Node-right t)))
        (assert= 3 (Node-val (Node-right t))))))
  (deftest
    "arity error on too few args"
    (do
      (define-type Pair2 (Pair2-of a b))
      (let
        ((ok false))
        (guard (exn (else (set! ok true))) (Pair2-of 1))
        (assert ok))))
  (deftest
    "arity error on too many args"
    (do
      (define-type Single (Single-of x))
      (let
        ((ok false))
        (guard
          (exn (else (set! ok true)))
          (Single-of 1 2))
        (assert ok))))
  (deftest
    "multiple types are independent"
    (do
      (define-type Color2 (Red2) (Green2) (Blue2))
      (define-type Suit (Hearts) (Diamonds) (Clubs) (Spades))
      (assert= false (Color2? (Hearts)))
      (assert= false (Suit? (Red2)))
      (assert= true (Color2? (Blue2)))
      (assert= true (Suit? (Spades)))))
  (deftest
    "adt fields can hold any value"
    (do
      (define-type Container (Hold x))
      (assert-equal
        (list 1 2 3)
        (Hold-x (Hold (list 1 2 3))))
      (assert-equal {:a 1} (Hold-x (Hold {:a 1})))))
  (deftest
    "adt-registry tracks type constructor names"
    (do
      (define-type Days (Mon) (Tue) (Wed) (Thu) (Fri))
      (assert-equal
        (list "Mon" "Tue" "Wed" "Thu" "Fri")
        (get *adt-registry* "Days"))))
  (deftest
    "constructors with same field name in different types are independent"
    (do
      (define-type P1 (P1-ctor value))
      (define-type P2 (P2-ctor value))
      (assert= 10 (P1-ctor-value (P1-ctor 10)))
      (assert= 20 (P2-ctor-value (P2-ctor 20)))))
  (deftest
    "match dispatches on first matching constructor"
    (do
      (define-type Color (Red) (Green) (Blue))
      (assert=
        "red"
        (match (Red) ((Red) "red") ((Green) "green") ((Blue) "blue")))
      (assert=
        "green"
        (match (Green) ((Red) "red") ((Green) "green") ((Blue) "blue")))
      (assert=
        "blue"
        (match (Blue) ((Red) "red") ((Green) "green") ((Blue) "blue")))))
  (deftest
    "match binds field to variable"
    (do
      (define-type Wrapper (Wrap val))
      (assert= 42 (match (Wrap 42) ((Wrap v) v)))
      (assert= "hi" (match (Wrap "hi") ((Wrap v) v)))))
  (deftest
    "match zero-arg constructor"
    (do
      (define-type Signal (On) (Off))
      (assert= "on" (match (On) ((On) "on") ((Off) "off")))
      (assert= "off" (match (Off) ((On) "on") ((Off) "off")))))
  (deftest
    "match multi-field constructor binds all fields"
    (do
      (define-type Vec2 (V2 x y))
      (let
        ((v (V2 3 4)))
        (assert= 7 (match v ((V2 a b) (+ a b)))))))
  (deftest
    "match with else clause"
    (do
      (define-type Opt2 (Some2 val) (None2))
      (assert=
        10
        (match (Some2 10) ((Some2 v) v) (else 0)))
      (assert= 0 (match (None2) ((Some2 v) v) (else 0)))))
  (deftest
    "match else catches non-adt values"
    (do
      (assert= "other" (match 42 ((else) "other") (else "other")))
      (assert= "other" (match "str" (else "other")))))
  (deftest
    "match returns body expression value"
    (do
      (define-type Num (Num-of n))
      (assert=
        100
        (match (Num-of 10) ((Num-of n) (* n n))))))
  (deftest
    "match second arm fires when first does not match"
    (do
      (define-type Either (Left val) (Right val))
      (assert=
        "left-1"
        (match
          (Left 1)
          ((Left v) (str "left-" v))
          ((Right v) (str "right-" v))))
      (assert=
        "right-2"
        (match
          (Right 2)
          ((Left v) (str "left-" v))
          ((Right v) (str "right-" v))))))
  (deftest
    "match wildcard _ in constructor pattern"
    (do
      (define-type Pair3 (Pair3-of a b))
      (assert=
        5
        (match (Pair3-of 5 99) ((Pair3-of x _) x)))
      (assert=
        99
        (match (Pair3-of 5 99) ((Pair3-of _ y) y)))))
  (deftest
    "match nested adt constructor pattern"
    (do
      (define-type Tree2 (Leaf2) (Node2 left val right))
      (let
        ((t (Node2 (Leaf2) 7 (Leaf2))))
        (assert= 7 (match t ((Node2 _ v _) v)))
        (assert= true (match t ((Node2 (Leaf2) _ _) true) (else false))))))
  (deftest
    "match literal pattern"
    (do
      (assert=
        "zero"
        (match 0 (0 "zero") (else "nonzero")))
      (assert= "hello" (match "hello" ("hello" "hello") (else "other")))))
  (deftest
    "match symbol binding pattern"
    (do (assert= 42 (match 42 (x x)))))
  (deftest
    "match no matching clause raises error"
    (do
      (define-type AB (A-val) (B-val))
      (let
        ((ok false))
        (guard
          (exn (else (set! ok true)))
          (match (A-val) ((B-val) "b")))
        (assert ok))))
  (deftest
    "match result used in further computation"
    (do
      (define-type Num2 (N v))
      (assert=
        30
        (+
          (match (N 10) ((N v) v))
          (match (N 20) ((N v) v))))))
  (deftest
    "match with define"
    (do
      (define-type Tag (Tagged label value))
      (define get-label (fn (t) (match t ((Tagged lbl _) lbl))))
      (define get-value (fn (t) (match t ((Tagged _ val) val))))
      (let
        ((t (Tagged "name" 99)))
        (assert= "name" (get-label t))
        (assert= 99 (get-value t)))))
  (deftest
    "match three-field constructor"
    (do
      (define-type Triple2 (T3 a b c))
      (assert=
        6
        (match
          (T3 1 2 3)
          ((T3 a b c) (+ a b c))))))
  (deftest
    "match clauses tried in order"
    (do
      (define-type Expr2 (Lit n) (Add l r) (Mul l r))
      (define
        eval-expr2
        (fn
          (e)
          (match
            e
            ((Lit n) n)
            ((Add l r) (+ (eval-expr2 l) (eval-expr2 r)))
            ((Mul l r) (* (eval-expr2 l) (eval-expr2 r))))))
      (assert=
        7
        (eval-expr2 (Add (Lit 3) (Lit 4))))
      (assert=
        12
        (eval-expr2 (Mul (Lit 3) (Lit 4))))
      (assert=
        11
        (eval-expr2
          (Add (Lit 2) (Mul (Lit 3) (Lit 3)))))))
  (deftest
    "match else binding captures value"
    (do
      (define-type Coin2 (Heads2) (Tails2))
      (assert=
        "Tails2"
        (match (Tails2) ((Heads2) "Heads2") (x (get x :_ctor))))))
  (deftest
    "match on adt with string field"
    (do
      (define-type Msg (Hello name) (Bye name))
      (assert=
        "Hello, Alice"
        (match
          (Hello "Alice")
          ((Hello n) (str "Hello, " n))
          ((Bye n) (str "Bye, " n))))
      (assert=
        "Bye, Bob"
        (match
          (Bye "Bob")
          ((Hello n) (str "Hello, " n))
          ((Bye n) (str "Bye, " n))))))
  (deftest
    "type-of returns adt type name"
    (do
      (define-type Maybe2 (Just2 v) (Nothing2))
      (assert= "Maybe2" (type-of (Just2 7)))
      (assert= "Maybe2" (type-of (Nothing2)))))
  (deftest
    "adt? predicate distinguishes adt values"
    (do
      (define-type Box3 (Boxed3 x))
      (assert= true (adt? (Boxed3 1)))
      (assert= false (adt? 1))
      (assert= false (adt? "str"))
      (assert= false (adt? (list 1 2)))
      (assert= false (adt? {:a 1}))))
  (deftest
    "inspect renders adt as constructor call"
    (do
      (define-type Pt (Pt-of x y) (Origin))
      (assert= "(Pt-of 3 4)" (inspect (Pt-of 3 4)))
      (assert= "(Origin)" (inspect (Origin)))))
  (deftest
    "match nested pattern with variable binding"
    (do
      (define-type Box2 (Box2-of v))
      (define-type Inner (Inner-of n))
      (assert=
        5
        (match (Box2-of (Inner-of 5)) ((Box2-of (Inner-of n)) n)))))
  (deftest
    "match nested constructor sanity (Phase 6b)"
    (do
      (define-type MaybeP6b (JustP6b v) (NothingP6b))
      (assert= 42 (match (JustP6b 42) ((JustP6b x) x) (else 0)))
      (assert= 0 (match (NothingP6b) ((JustP6b x) x) (else 0)))))
  (deftest
    "match nested constructor binds inner fields"
    (do
      (define-type MaybeN (JustN v) (NothingN))
      (define-type PairN (PairN-of a b))
      (assert=
        3
        (match
          (JustN (PairN-of 1 2))
          ((JustN (PairN-of a b)) (+ a b))
          (else 0)))
      (assert=
        0
        (match
          (NothingN)
          ((JustN (PairN-of a b)) (+ a b))
          (else 0)))))
  (deftest
    "match nested wildcard ignores inner field"
    (do
      (define-type MaybeW (JustW v) (NothingW))
      (assert=
        "yes"
        (match (JustW 42) ((JustW _) "yes") (else "no")))
      (assert=
        "no"
        (match (NothingW) ((JustW _) "yes") (else "no")))))
  (deftest
    "match nested literal pattern requires equality"
    (do
      (define-type MaybeL (JustL v) (NothingL))
      (assert=
        "literal"
        (match (JustL 42) ((JustL 42) "literal") (else "var")))
      (assert=
        "var"
        (match (JustL 7) ((JustL 42) "literal") (else "var")))))
  (deftest
    "match falls through nested literal to variable clause"
    (do
      (define-type MaybeF (JustF v) (NothingF))
      (assert=
        1
        (match (JustF 1) ((JustF 99) "wrong") ((JustF x) x)))
      (assert=
        "wrong"
        (match (JustF 99) ((JustF 99) "wrong") ((JustF x) x)))))
  (deftest
    "match deeply nested constructors bind innermost"
    (do
      (define-type Wrap1 (W1 inner))
      (define-type Wrap2 (W2 inner))
      (define-type Leaf3 (L3 n))
      (assert=
        7
        (match
          (W1 (W2 (L3 7)))
          ((W1 (W2 (L3 n))) n)
          (else 0)))))
  (deftest
    "match nested constructor mixed bind and wildcard"
    (do
      (define-type PairM (PairM-of a b))
      (define-type BoxM (BoxM-of inner))
      (assert=
        10
        (match
          (BoxM-of (PairM-of 10 99))
          ((BoxM-of (PairM-of x _)) x)
          (else 0)))
      (assert=
        99
        (match
          (BoxM-of (PairM-of 10 99))
          ((BoxM-of (PairM-of _ y)) y)
          (else 0)))))
  (deftest
    "match nested pattern fails when inner ctor differs"
    (do
      (define-type EitherX (LeftX v) (RightX v))
      (define-type WrapX (WX inner))
      (assert=
        "right-1"
        (match
          (WX (RightX 1))
          ((WX (LeftX v)) (str "left-" v))
          ((WX (RightX v)) (str "right-" v))))
      (assert=
        "left-9"
        (match
          (WX (LeftX 9))
          ((WX (LeftX v)) (str "left-" v))
          ((WX (RightX v)) (str "right-" v))))))
  (deftest
    "exhaustive match runs without error"
    (do
      (define-type ExA1 (CaA1 v) (CbA1))
      (assert= 1 (match (CaA1 1) ((CaA1 x) x) ((CbA1) 0)))
      (assert= 0 (match (CbA1) ((CaA1 x) x) ((CbA1) 0)))))
  (deftest
    "non-exhaustive match still returns value (warning is non-fatal)"
    (do
      (define-type ExA2 (CaA2 v) (CbA2))
      (assert= 9 (match (CaA2 9) ((CaA2 x) x)))))
  (deftest
    "match with else clause suppresses non-exhaustive warning"
    (do
      (define-type ExA3 (CaA3 v) (CbA3) (CcA3))
      (assert= "a" (match (CaA3 1) ((CaA3 x) "a") (else "other")))
      (assert= "other" (match (CbA3) ((CaA3 x) "a") (else "other")))))
  (deftest
    "match with all-but-one constructor still runs"
    (do
      (define-type ExA4 (CaA4 v) (CbA4) (CcA4))
      (assert= 5 (match (CaA4 5) ((CaA4 x) x) ((CbA4) 0)))
      (assert= 0 (match (CbA4) ((CaA4 x) x) ((CbA4) 0)))))
  (deftest
    "match wildcard pattern suppresses non-exhaustive warning"
    (do
      (define-type ExA5 (CaA5 v) (CbA5))
      (assert= 7 (match (CaA5 7) ((CaA5 x) x) (_ 0)))
      (assert= 0 (match (CbA5) ((CaA5 x) x) (_ 0))))))
