HKDSpec.hs

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