VirtualFieldsSpec.hs

{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE UndecidableInstances #-}
module Warlock.VirtualFieldsSpec (spec) where

import Test.Hspec
import Warlock
import qualified Witch as W
import GHC.Records (HasField(..))

-- Virtual field example: Person with computed fullName
data Person = Person
  { firstName :: String
  , lastName :: String
  , age :: Int
  } deriving (Show, Eq)

instance HasField "fullName" Person String where
  getField (Person first last _) = first ++ " " ++ last

instance HasField "category" Person String where
  getField (Person _ _ a) = if a < 18 then "minor" else "adult"

data Employee = Employee
  { empName :: String
  , empAge :: Int
  , ageGroup :: String
  } deriving (Show, Eq)

deriveAutomap
  ( ByName $
    defaultConfig
    `withRules`
    [ virtualField 'empName "fullName"
    , rename 'empAge 'age
    , virtualField 'ageGroup "category"
    ]
  )
  ''Person
  ''Employee

-- Rectangle with computed fields
data Rectangle = Rectangle
  { width :: Double
  , height :: Double
  } deriving (Show, Eq)

instance HasField "area" Rectangle Double where
  getField (Rectangle w h) = w * h

instance HasField "perimeter" Rectangle Double where
  getField (Rectangle w h) = 2 * (w + h)

instance HasField "aspectRatio" Rectangle Double where
  getField (Rectangle w h) = w / h

data RectangleInfo = RectangleInfo
  { size :: Double
  , border :: Double
  , ratio :: Double
  } deriving (Show, Eq)

deriveAutomap
  ( ByName $
    defaultConfig
    { staticRules =
        [ virtualField 'size "area"
        , virtualField 'border "perimeter"
        , virtualField 'ratio "aspectRatio"
        ]
    }
  )
  ''Rectangle
  ''RectangleInfo

spec :: Spec
spec = do
  describe "Virtual fields (HasField)" $ do
    it "can map from computed fullName field" $ do
      let person = Person "Alice" "Smith" 30
      let employee = W.from person :: Employee
      empName employee `shouldBe` "Alice Smith"
      empAge employee `shouldBe` 30
      ageGroup employee `shouldBe` "adult"

    it "computes category based on age" $ do
      let minor = Person "Bob" "Jones" 15
      let emp = W.from minor :: Employee
      ageGroup emp `shouldBe` "minor"

    it "can map multiple computed fields at once" $ do
      let rect = Rectangle 4.0 3.0
      let info = W.from rect :: RectangleInfo
      size info `shouldBe` 12.0
      border info `shouldBe` 14.0
      ratio info `shouldSatisfy` (\r -> abs (r - 1.333333) < 0.001)