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