49 lines
1.2 KiB
Haskell
49 lines
1.2 KiB
Haskell
{-# language GHC2024, AllowAmbiguousTypes, TypeAbstractions #-}
|
|
-- AllowAmbiguousTypes for dispatch :: Dispatchable d => String
|
|
|
|
import System.Environment
|
|
|
|
main = do
|
|
[s] <- getArgs
|
|
putStrLn $ maybe "not found" dispatchDyn $ fromString s
|
|
|
|
|
|
data Mode = A | B
|
|
|
|
data SMode m where SA :: SMode A; SB :: SMode B
|
|
|
|
class KnownMode m where knownMode :: SMode m
|
|
instance KnownMode A where knownMode = SA
|
|
instance KnownMode B where knownMode = SB
|
|
|
|
|
|
withMode :: Mode -> (forall m. KnownMode m => r) -> r
|
|
withMode A f = f @A
|
|
withMode B f = f @B
|
|
|
|
|
|
fromString :: String -> Maybe Mode
|
|
fromString "a" = Just A
|
|
fromString "b" = Just B
|
|
fromString _ = Nothing
|
|
|
|
|
|
class Dispatchable d where dispatch :: String
|
|
instance Dispatchable A where dispatch = "A"
|
|
instance Dispatchable B where dispatch = "B"
|
|
|
|
dispatchDyn :: Mode -> String
|
|
dispatchDyn m = withMode m $ \ @m -> dispatch @m \\ allModesDispatchable @m
|
|
|
|
|
|
allModesDispatchable :: KnownMode m :- Dispatchable m
|
|
allModesDispatchable @m =
|
|
Sub $ case knownMode @m of SA -> Dict; SB -> Dict
|
|
|
|
|
|
-- this stuff taken from the `constraints` package
|
|
data Dict c = c => Dict
|
|
data c :- d = Sub (c => Dict d)
|
|
|
|
(\\) :: c => (d => r) -> c :- d -> r
|
|
r \\ Sub Dict = r
|