sing.hs
This commit is contained in:
parent
9e17027db8
commit
79d536cb17
1 changed files with 49 additions and 0 deletions
49
sing.hs
Normal file
49
sing.hs
Normal file
|
@ -0,0 +1,49 @@
|
|||
{-# 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
|
Loading…
Add table
Reference in a new issue