ADTSpec.hs

{-# 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"