{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE DuplicateRecordFields #-} module Warlock.ADTSpec (spec) where import Test.Hspec import qualified Witch as W import Warlock -- Multi-constructor ADT with positional constructors data Shape = CircleShape Double | RectangleShape Double Double | TriangleShape Double Double Double deriving (Show, Eq) data ShapeInfo = CircleInfo Double | RectangleInfo Double Double | TriangleInfo Double Double Double deriving (Show, Eq) deriveAutomap ( ByName $ defaultConfig `withConstructorMap` [ ('CircleShape, 'CircleInfo) , ('RectangleShape, 'RectangleInfo) , ('TriangleShape, 'TriangleInfo) ] ) ''Shape ''ShapeInfo -- Field evolution example data PaymentV1 = CardPaymentV1 { cardNumber :: String, expiry :: String } | BankPaymentV1 { accountNumber :: String, routing :: String, bankName :: String } | CashPaymentV1 { amount :: Double } deriving (Show, Eq) data PaymentV2 = CardPaymentV2 { cardNumber :: String, expiry :: String, cvv :: String, cardholderName :: String } | BankPaymentV2 { accountNumber :: String, routing :: String } | CashPaymentV2 { amount :: Double, currency :: String, receiptNumber :: String } deriving (Show, Eq) deriveAutomap ( ByName $ defaultConfig `withConstructorMap` replaceSuffix "V1" "V2" `withDefaults` [ ('cvv, [| "000" |]) , ('cardholderName, [| "Unknown" |]) , ('currency, [| "USD" |]) , ('receiptNumber, [| "N/A" |]) ] ) ''PaymentV1 ''PaymentV2 spec :: Spec spec = do describe "Multi-constructor ADTs" $ do it "maps positional constructors by position" $ do let circle = CircleShape 5.0 let circleInfo = W.from circle :: ShapeInfo circleInfo `shouldBe` CircleInfo 5.0 it "handles multiple constructors with different arities" $ do let rect = RectangleShape 3.0 4.0 let rectInfo = W.from rect :: ShapeInfo rectInfo `shouldBe` RectangleInfo 3.0 4.0 let tri = TriangleShape 3.0 4.0 5.0 let triInfo = W.from tri :: ShapeInfo triInfo `shouldBe` TriangleInfo 3.0 4.0 5.0 describe "Field evolution" $ do it "adds new fields with defaults" $ do let cardV1 = CardPaymentV1 "1234-5678" "12/25" let cardV2 = W.from cardV1 :: PaymentV2 case cardV2 of CardPaymentV2 num exp cvv holder -> do num `shouldBe` "1234-5678" exp `shouldBe` "12/25" cvv `shouldBe` "000" holder `shouldBe` "Unknown" _ -> expectationFailure "Expected CardPaymentV2" it "removes fields silently" $ do let bankV1 = BankPaymentV1 "9876543210" "123456789" "BigBank" let bankV2 = W.from bankV1 :: PaymentV2 case bankV2 of BankPaymentV2 acct rout -> do acct `shouldBe` "9876543210" rout `shouldBe` "123456789" _ -> expectationFailure "Expected BankPaymentV2" it "handles multiple new fields" $ do let cashV1 = CashPaymentV1 100.5 let cashV2 = W.from cashV1 :: PaymentV2 case cashV2 of CashPaymentV2 amt curr receipt -> do amt `shouldBe` 100.5 curr `shouldBe` "USD" receipt `shouldBe` "N/A" _ -> expectationFailure "Expected CashPaymentV2"