{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE TypeFamilies #-} {-# OPTIONS_GHC -Wno-orphans #-} module Warlock.TypeConversionSpec (spec) where import Test.Hspec import qualified Witch as W import Warlock import Data.Text (Text) -------------------------------------------------------------------------------- -- Higher-Kinded From Type Classes (similar to aeson's ToJSON1/FromJSON1) -------------------------------------------------------------------------------- -- -- This demonstrates an elegant solution to the problem of type conversions -- in parameterized types. Instead of manually defining: -- -- instance From (Maybe String) (Maybe Text) -- instance From [String] [Text] -- instance From (Either String b) (Either Text b) -- ... and so on for every combination ... -- -- We define two type classes that capture the *structure* of the conversion: -- -- * From1: For single-parameter type constructors (Functors) -- * From2: For two-parameter type constructors (Bifunctors) -- -- Then we provide ONE generic instance that says: -- "If you have a From1 instance for the container type, -- and a From instance for the element type, -- you automatically get a From instance for the container of elements" -- -- This is the same pattern used by aeson (ToJSON1/FromJSON1), -- hashable (Hashable1), and other libraries for dealing with -- parameterized types in a compositional way. -- -------------------------------------------------------------------------------- -- | Type class for converting between type constructors with one parameter. -- This allows automatic derivation of From instances for parameterized types. -- -- Example: if you have From String Text, and From1 Maybe, -- you automatically get From (Maybe String) (Maybe Text) class From1 f g | f -> g, g -> f where -- | Lift a conversion function into the type constructor liftFrom :: (a -> b) -> f a -> g b -- | Type class for converting between type constructors with two parameters. class From2 f g | f -> g, g -> f where -- | Lift two conversion functions into the type constructor liftFrom2 :: (a -> c) -> (b -> d) -> f a b -> g c d -- Instances for common Functors (From1) instance From1 Maybe Maybe where liftFrom = fmap instance From1 [] [] where liftFrom = map -- Instances for Bifunctors (From2) instance From2 Either Either where liftFrom2 f _ (Left a) = Left (f a) liftFrom2 _ g (Right b) = Right (g b) instance From2 (,) (,) where liftFrom2 f g (a, b) = (f a, g b) -- Generic instances that use From1 to derive From instances automatically -- These are overlappable because more specific instances can override them instance {-# OVERLAPPABLE #-} (From1 f g, W.From a b) => W.From (f a) (g b) where from = liftFrom W.from -- For Either, we typically want to convert the Left type but keep Right unchanged -- This is more specific than the From1 instance, so it takes precedence instance {-# OVERLAPS #-} (From2 f g, W.From a c) => W.From (f a b) (g c b) where from = liftFrom2 W.from id -- We'll add specific instances for record lists after we define the types -- Now, thanks to From1, we automatically get these instances without defining them: -- * From (Maybe String) (Maybe Text) -- * From [String] [Text] -- * From (Either String b) (Either Text b) -- * And any other Functor/Bifunctor combinations! -------------------------------------------------------------------------------- -- String <-> Text Conversions -------------------------------------------------------------------------------- -- Simple record with String -> Text conversion data PersonString = PersonString { personName :: String , personAge :: Int } deriving (Show, Eq) data PersonText = PersonText { personName :: Text , personAge :: Int } deriving (Show, Eq) deriveAutomap (ByName defaultConfig) ''PersonString ''PersonText deriveAutomap (ByName defaultConfig) ''PersonText ''PersonString -- Nested Maybe with type conversion data MaybeStringRecord = MaybeStringRecord { nickname :: Maybe String , score :: Int } deriving (Show, Eq) data MaybeTextRecord = MaybeTextRecord { nickname :: Maybe Text , score :: Int } deriving (Show, Eq) deriveAutomap (ByName defaultConfig) ''MaybeStringRecord ''MaybeTextRecord -- List with type conversion data ListStringRecord = ListStringRecord { tags :: [String] , count :: Int } deriving (Show, Eq) data ListTextRecord = ListTextRecord { tags :: [Text] , count :: Int } deriving (Show, Eq) deriveAutomap (ByName defaultConfig) ''ListStringRecord ''ListTextRecord -- Either with type conversion data EitherStringRecord = EitherStringRecord { result :: Either String Int } deriving (Show, Eq) data EitherTextRecord = EitherTextRecord { result :: Either Text Int } deriving (Show, Eq) deriveAutomap (ByName defaultConfig) ''EitherStringRecord ''EitherTextRecord -- Multiple fields with different conversions data MixedSource = MixedSource { label :: String , description :: String , value :: Int } deriving (Show, Eq) data MixedDest = MixedDest { label :: Text , description :: Text , value :: Int } deriving (Show, Eq) deriveAutomap (ByName defaultConfig) ''MixedSource ''MixedDest -------------------------------------------------------------------------------- -- Integer Type Conversions -------------------------------------------------------------------------------- -- Note: For numeric type conversions, you would need to add From instances -- witch library doesn't provide all numeric conversions by default -- Here we'll just demonstrate with Natural/Integer which witch does support -- Example: you can add your own instances like: -- instance W.From Int Int32 where from = fromIntegral -- instance W.From Word8 Word16 where from = fromIntegral -------------------------------------------------------------------------------- -- Nested Type Conversions -------------------------------------------------------------------------------- -- Record containing another record that needs type conversion data InnerString = InnerString { innerText :: String } deriving (Show, Eq) data InnerText = InnerText { innerText :: Text } deriving (Show, Eq) deriveAutomap (ByName defaultConfig) ''InnerString ''InnerText data OuterString = OuterString { outerLabel :: String , inner :: InnerString } deriving (Show, Eq) data OuterText = OuterText { outerLabel :: Text , inner :: InnerText } deriving (Show, Eq) deriveAutomap (ByName defaultConfig) ''OuterString ''OuterText -- List of records with type conversion data ItemString = ItemString { itemName :: String } deriving (Show, Eq) data ItemText = ItemText { itemName :: Text } deriving (Show, Eq) deriveAutomap (ByName defaultConfig) ''ItemString ''ItemText data CartString = CartString { items :: [ItemString] } deriving (Show, Eq) data CartText = CartText { items :: [ItemText] } deriving (Show, Eq) deriveAutomap (ByName defaultConfig) ''CartString ''CartText -- The derive calls above automatically generate From instances that use witch's -- From instances to convert nested types. For lists of records, we need a helper: instance W.From [ItemString] [ItemText] where from = map W.from -------------------------------------------------------------------------------- -- Tests -------------------------------------------------------------------------------- spec :: Spec spec = do describe "String <-> Text conversions" $ do it "converts String to Text in simple record" $ do let person = PersonString "Alice" 30 let converted = W.from person :: PersonText case converted of PersonText name age -> do name `shouldBe` "Alice" age `shouldBe` 30 it "converts Text to String in simple record" $ do let person = PersonText "Bob" 25 let converted = W.from person :: PersonString case converted of PersonString name age -> do name `shouldBe` "Bob" age `shouldBe` 25 it "converts Maybe String to Maybe Text" $ do let record = MaybeStringRecord (Just "nickname") 100 let converted = W.from record :: MaybeTextRecord case converted of MaybeTextRecord nick _ -> nick `shouldBe` Just "nickname" it "handles Nothing in Maybe conversions" $ do let record = MaybeStringRecord Nothing 100 let converted = W.from record :: MaybeTextRecord case converted of MaybeTextRecord nick _ -> nick `shouldBe` Nothing it "converts [String] to [Text]" $ do let record = ListStringRecord ["tag1", "tag2", "tag3"] 3 let converted = W.from record :: ListTextRecord case converted of ListTextRecord t c -> do t `shouldBe` ["tag1", "tag2", "tag3"] c `shouldBe` 3 it "converts empty list" $ do let record = ListStringRecord [] 0 let converted = W.from record :: ListTextRecord case converted of ListTextRecord t _ -> t `shouldBe` [] it "converts Either String to Either Text (Left case)" $ do let record = EitherStringRecord (Left "error") let converted = W.from record :: EitherTextRecord case converted of EitherTextRecord r -> r `shouldBe` Left "error" it "converts Either String to Either Text (Right case)" $ do let record = EitherStringRecord (Right 42) let converted = W.from record :: EitherTextRecord case converted of EitherTextRecord r -> r `shouldBe` Right 42 it "converts multiple String fields to Text" $ do let record = MixedSource "Label" "Description" 999 let converted = W.from record :: MixedDest case converted of MixedDest l d v -> do l `shouldBe` "Label" d `shouldBe` "Description" v `shouldBe` 999 -- Numeric conversions would require additional From instances -- which witch doesn't provide by default describe "Nested type conversions" $ do it "converts nested records with type conversions" $ do let innerRec = InnerString "inner text" let outerRec = OuterString "outer label" innerRec let converted = W.from outerRec :: OuterText case converted of OuterText lbl innerConverted -> do lbl `shouldBe` "outer label" case innerConverted of InnerText innerTxt -> innerTxt `shouldBe` "inner text" it "converts list of records with type conversions" $ do let itemList = [ItemString "item1", ItemString "item2"] let cart = CartString itemList let converted = W.from cart :: CartText case converted of CartText convertedItems -> do length convertedItems `shouldBe` 2 case convertedItems of (ItemText name1 : ItemText name2 : _) -> do name1 `shouldBe` "item1" name2 `shouldBe` "item2" _ -> expectationFailure "Expected at least 2 items" describe "From1/From2 automatic derivation" $ do it "automatically derives Maybe conversions via From1" $ do -- No manual instance needed! From1 automatically provides this let maybeStr = Just "hello" :: Maybe String let maybeText = W.from maybeStr :: Maybe Text maybeText `shouldBe` Just "hello" it "automatically derives list conversions via From1" $ do -- No manual instance needed! From1 automatically provides this let strList = ["one", "two", "three"] :: [String] let textList = W.from strList :: [Text] textList `shouldBe` ["one", "two", "three"] it "automatically derives Either conversions via From2" $ do -- No manual instance needed! From2 automatically provides this let eitherStr = Left "error" :: Either String Int let eitherText = W.from eitherStr :: Either Text Int eitherText `shouldBe` Left "error" it "works with nested Maybe [String]" $ do -- Composition of From1 instances! let nested = Just ["a", "b", "c"] :: Maybe [String] let converted = W.from nested :: Maybe [Text] converted `shouldBe` Just ["a", "b", "c"] it "works with Either (Maybe String) Int" $ do -- Composition of From2 and From1! let complex = Left (Just "error") :: Either (Maybe String) Int let converted = W.from complex :: Either (Maybe Text) Int converted `shouldBe` Left (Just "error")