Created
August 15, 2024 04:11
-
-
Save frasertweedale/76914422e62d92c2507e0c2b55acf3b3 to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| module Experiement where | |
| import Data.Kind (Type) | |
| import Data.Proxy (Proxy(..)) | |
| data VariantA | |
| data VariantB | |
| data VariantC | |
| data Object (a :: Type) = Object | |
| deriving (Show) | |
| -- | |
| -- Option 1: explicit discriminated union | |
| -- | |
| data WrappedObject | |
| = WrappedObjectA (Object VariantA) | |
| | WrappedObjectB (Object VariantB) | |
| | WrappedObjectC (Object VariantC) | |
| go1 :: String -> WrappedObject | |
| go1 variant = case variant of | |
| "a" -> WrappedObjectA Object | |
| "b" -> WrappedObjectB Object | |
| "c" -> WrappedObjectC Object | |
| _ -> error "unrecognised variant" | |
| main1 :: IO () | |
| main1 = do | |
| let obj = go1 "a" | |
| case obj of | |
| WrappedObjectA _ -> putStrLn "a" | |
| WrappedObjectB _ -> putStrLn "b" | |
| WrappedObjectC _ -> putStrLn "c" | |
| -- | |
| -- Option 2: if all behaviour for each variant can be | |
| -- defined via a type class interface, you can use a GADT | |
| -- to monomorphise. | |
| -- | |
| class Variant a where | |
| variantName :: Proxy a -> String | |
| instance Variant VariantA where | |
| variantName _ = "a" | |
| instance Variant VariantB where | |
| variantName _ = "b" | |
| instance Variant VariantC where | |
| variantName _ = "c" | |
| data Object' where | |
| Object' :: (Variant a) => Object a -> Object' | |
| go2 :: String -> Object' | |
| go2 variant = case variant of | |
| "a" -> Object' (Object :: Object VariantA) | |
| "b" -> Object' (Object :: Object VariantB) | |
| "c" -> Object' (Object :: Object VariantC) | |
| _ -> error "unrecognised variant" | |
| main2 :: IO () | |
| main2 = do | |
| let obj' = go2 "b" | |
| case obj' of | |
| Object' obj -> putStrLn (variantName (variantProxy obj)) | |
| variantProxy :: forall t a. t a -> Proxy a | |
| variantProxy _ = Proxy @a |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment