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