warlock-0.1.0.0: test/Warlock/TweakSpec.hs
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
module Warlock.TweakSpec (spec) where
import Test.Hspec
import Warlock
import qualified Warlock.Tweak as Tweak
import Warlock.Tweak (tweakType, TweakStrategy(..), defaultTweakConfig, withFields, withoutFields, withAutoDerive, pick, omit, pick', omit')
import Witch (From, from)
import Language.Haskell.TH (mkName)
--------------------------------------------------------------------------------
-- Test Types
data User = User
{ userId :: Int
, userName :: String
, userEmail :: String
, userPassword :: String
, userCreatedAt :: String
} deriving (Show, Eq)
data Product = Product
{ productId :: Int
, productName :: String
, productPrice :: Double
, productDescription :: String
} deriving (Show, Eq)
--------------------------------------------------------------------------------
-- Test 1: Drop specific fields (DTO pattern) with prefix to avoid collision
tweakType (DropFrom $ (defaultTweakConfig
`withoutFields` ['userPassword, 'userCreatedAt])
`Tweak.addPrefix` "dto")
"UserDTO"
''User
--------------------------------------------------------------------------------
-- Test 2: Keep only specific fields with prefix
tweakType (KeepOnly $ (defaultTweakConfig
`withFields` ['userId, 'userName])
`Tweak.addPrefix` "min")
"UserMinimal"
''User
--------------------------------------------------------------------------------
-- Test 3: Strip prefix (avoiding 'id' conflict with Prelude)
tweakType (KeepOnly $ (defaultTweakConfig
`withFields` ['userName, 'userEmail])
`Tweak.stripPrefix` "user")
"UserClean"
''User
--------------------------------------------------------------------------------
-- Test 4: Add prefix
tweakType (KeepOnly $ (defaultTweakConfig
`withFields` ['productId, 'productName])
`Tweak.addPrefix` "dto")
"ProductDTO"
''Product
--------------------------------------------------------------------------------
-- Test 5: Replace prefix
tweakType (KeepOnly $ (defaultTweakConfig
`withFields` ['productId, 'productName, 'productPrice])
`Tweak.replacePrefix` ("product", "item"))
"ItemSummary"
''Product
--------------------------------------------------------------------------------
-- Test 6: Explicit field renaming
tweakType (KeepOnly $ (defaultTweakConfig
`withFields` ['userId, 'userName])
`Tweak.withRenames` [('userId, mkName "renamedId"), ('userName, mkName "renamedName")])
"UserRenamed"
''User
--------------------------------------------------------------------------------
-- Test 7: Disable auto-derive
tweakType (KeepOnly $ ((defaultTweakConfig
`withFields` ['userId, 'userName])
`Tweak.addPrefix` "no")
`withAutoDerive` False)
"UserNoInstances"
''User
-- Note: Not manually deriving instance for this test since it's about disabling auto-derive
--------------------------------------------------------------------------------
-- TypeScript-style API Tests
-- Test 8: pick (TypeScript-style) with prefix to avoid collision
pick' (defaultTweakConfig `Tweak.addPrefix` "pick") ''User "UserPick" ['userId, 'userName]
-- Test 9: omit (TypeScript-style) with prefix to avoid collision
omit' (defaultTweakConfig `Tweak.addPrefix` "omit") ''User "UserOmit" ['userPassword, 'userCreatedAt]
-- Test 10: pick with config (add prefix to avoid collision with test 3)
pick' (defaultTweakConfig `Tweak.stripPrefix` "user" `Tweak.addPrefix` "ts") ''User "UserPickStripped" ['userName, 'userEmail]
-- Test 11: omit with config (use different prefix to avoid collision with test 1)
omit' (defaultTweakConfig `Tweak.addPrefix` "api") ''User "UserOmitAPI" ['userPassword]
--------------------------------------------------------------------------------
-- Test Specs
spec :: Spec
spec = do
describe "Warlock.Tweak" $ do
describe "DropFrom" $ do
it "creates type without specified fields" $ do
let user = User 1 "Alice" "alice@example.com" "secret123" "2025-01-01"
let dto = from user :: UserDTO
case dto of
UserDTO dtouid dtoname dtoemail -> do
dtouid `shouldBe` 1
dtoname `shouldBe` "Alice"
dtoemail `shouldBe` "alice@example.com"
describe "KeepOnly" $ do
it "creates type with only specified fields" $ do
let user = User 2 "Bob" "bob@example.com" "secret456" "2025-01-02"
let minimal = from user :: UserMinimal
case minimal of
UserMinimal minuid minname -> do
minuid `shouldBe` 2
minname `shouldBe` "Bob"
describe "stripPrefix" $ do
it "removes prefix from field names" $ do
let user = User 3 "Charlie" "charlie@example.com" "secret789" "2025-01-03"
let clean = from user :: UserClean
case clean of
UserClean cleanname cleanemail -> do
cleanname `shouldBe` "Charlie"
cleanemail `shouldBe` "charlie@example.com"
describe "addPrefix" $ do
it "adds prefix to field names" $ do
let product = Product 1 "Widget" 19.99 "A useful widget"
let dto = from product :: ProductDTO
case dto of
ProductDTO dtoid dtoname -> do
dtoid `shouldBe` 1
dtoname `shouldBe` "Widget"
describe "replacePrefix" $ do
it "replaces one prefix with another" $ do
let product = Product 2 "Gadget" 29.99 "An amazing gadget"
let summary = from product :: ItemSummary
case summary of
ItemSummary itemid itemname itemprice -> do
itemid `shouldBe` 2
itemname `shouldBe` "Gadget"
itemprice `shouldBe` 29.99
describe "withRenames" $ do
it "applies explicit field renames" $ do
let user = User 4 "Diana" "diana@example.com" "secret000" "2025-01-04"
let renamed = from user :: UserRenamed
case renamed of
UserRenamed rid rname -> do
rid `shouldBe` 4
rname `shouldBe` "Diana"
describe "withAutoDerive False" $ do
it "creates type without auto-generating instances" $ do
-- Just test that the type was created successfully
-- We can't test conversion since no instance was generated
let noInstUser = UserNoInstances 5 "Eve"
case noInstUser of
UserNoInstances nouid noname -> do
nouid `shouldBe` 5
noname `shouldBe` "Eve"
describe "TypeScript-style API" $ do
describe "pick" $ do
it "picks specific fields (TypeScript Pick<T, K> style)" $ do
let user = User 6 "Frank" "frank@example.com" "secret222" "2025-01-06"
let picked = from user :: UserPick
case picked of
UserPick pickuid pickname -> do
pickuid `shouldBe` 6
pickname `shouldBe` "Frank"
describe "omit" $ do
it "omits specific fields (TypeScript Omit<T, K> style)" $ do
let user = User 7 "Grace" "grace@example.com" "secret333" "2025-01-07"
let omitted = from user :: UserOmit
case omitted of
UserOmit omituid omitname omitemail -> do
omituid `shouldBe` 7
omitname `shouldBe` "Grace"
omitemail `shouldBe` "grace@example.com"
describe "pick with config" $ do
it "picks fields and applies prefix operations" $ do
let user = User 8 "Henry" "henry@example.com" "secret444" "2025-01-08"
let picked = from user :: UserPickStripped
case picked of
UserPickStripped tsname tsemail -> do
tsname `shouldBe` "Henry"
tsemail `shouldBe` "henry@example.com"
describe "omit with config" $ do
it "omits fields and applies prefix operations" $ do
let user = User 9 "Iris" "iris@example.com" "secret555" "2025-01-09"
let omitted = from user :: UserOmitAPI
case omitted of
UserOmitAPI apiuid apiname apiemail apicreated -> do
apiuid `shouldBe` 9
apiname `shouldBe` "Iris"
apiemail `shouldBe` "iris@example.com"
apicreated `shouldBe` "2025-01-09"