{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-} module Warlock.HKDSpec (spec) where import Test.Hspec import Warlock.HKD import Data.Functor.Identity (Identity(..)) import Witch (From, from) -------------------------------------------------------------------------------- -- Test Types -- Single-constructor record data Person = Person { personName :: String , personAge :: Int } deriving (Show, Eq) deriveHKD (defaultHKDConfig `withFieldPrefix` "hkd") ''Person -- Multi-constructor ADT with records data Payment = CreditCard { cardNumber :: String, cvv :: String } | Cash { amount :: Double } | Check { checkNumber :: Int, bankName :: String } deriving (Show, Eq) deriveHKD (defaultHKDConfig `withFieldPrefix` "pay") ''Payment -- Simple product type (no field names) data Point = Point Int Int deriving (Show, Eq) deriveHKD' ''Point -- Type with custom config (field prefix) data User = User { userName :: String , userEmail :: String } deriving (Show, Eq) deriveHKD (defaultHKDConfig `withFieldPrefix` "hkd") ''User -- Type with custom config (constructor suffix) data Product = Product { productName :: String , productPrice :: Double } deriving (Show, Eq) deriveHKD ((defaultHKDConfig `withConstructorSuffix` "HKD") `withFieldPrefix` "prod") ''Product -- Type without From instances data NoFrom = NoFrom { noFromField :: String } deriving (Show, Eq) deriveHKD (withoutFromInstances (defaultHKDConfig `withFieldPrefix` "nf")) ''NoFrom -------------------------------------------------------------------------------- -- Test Specs spec :: Spec spec = do describe "Warlock.HKD" $ do describe "Single-constructor records" $ do it "generates HKD type with Identity wrapper" $ do let person = Person "Alice" 30 let hkdPerson = from person :: HKD Person Identity let unwrapped = from hkdPerson :: Person unwrapped `shouldBe` person it "can construct HKD types directly" $ do let hkdPerson = Person' (Identity "Bob") (Identity 25) :: HKD Person Identity case hkdPerson of Person' (Identity name) (Identity age) -> do name `shouldBe` "Bob" age `shouldBe` 25 it "round-trips through Identity" $ do let original = Person "Charlie" 35 let roundtripped = from (from original :: HKD Person Identity) :: Person roundtripped `shouldBe` original describe "Multi-constructor ADTs" $ do it "handles CreditCard constructor" $ do let payment = CreditCard "1234-5678" "123" let hkdPayment = from payment :: HKD Payment Identity let unwrapped = from hkdPayment :: Payment unwrapped `shouldBe` payment it "handles Cash constructor" $ do let payment = Cash 50.00 let hkdPayment = from payment :: HKD Payment Identity let unwrapped = from hkdPayment :: Payment unwrapped `shouldBe` payment it "handles Check constructor" $ do let payment = Check 1001 "Bank of Haskell" let hkdPayment = from payment :: HKD Payment Identity let unwrapped = from hkdPayment :: Payment unwrapped `shouldBe` payment it "preserves constructor choice through conversion" $ do let cash = Cash 100.00 let credit = CreditCard "9999" "999" let cashRoundtrip = from (from cash :: HKD Payment Identity) :: Payment let creditRoundtrip = from (from credit :: HKD Payment Identity) :: Payment cashRoundtrip `shouldBe` cash creditRoundtrip `shouldBe` credit describe "Positional constructors" $ do it "handles types without field names" $ do let point = Point 10 20 let hkdPoint = from point :: HKD Point Identity let unwrapped = from hkdPoint :: Point unwrapped `shouldBe` point describe "Custom configuration" $ do it "applies field name prefix" $ do let user = User "alice" "alice@example.com" let hkdUser = from user :: HKD User Identity case hkdUser of User' (Identity name) (Identity email) -> do name `shouldBe` "alice" email `shouldBe` "alice@example.com" it "applies constructor suffix" $ do let product = Product "Widget" 19.99 let hkdProduct = from product :: HKD Product Identity case hkdProduct of ProductHKD (Identity name) (Identity price) -> do name `shouldBe` "Widget" price `shouldBe` 19.99 it "respects withoutFromInstances" $ do -- This should compile - we can still construct the type manually let noFromHKD = NoFrom' (Identity "test") :: HKD NoFrom Identity case noFromHKD of NoFrom' (Identity field) -> field `shouldBe` "test" -- Note: We don't test From instances here because they shouldn't exist