From 79d536cb17922a2ea610ddb2842dcc751845b870 Mon Sep 17 00:00:00 2001
From: rhiannon morris <rhi@rhiannon.website>
Date: Thu, 9 Jan 2025 18:07:00 +0100
Subject: [PATCH] sing.hs

---
 sing.hs | 49 +++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 49 insertions(+)
 create mode 100644 sing.hs

diff --git a/sing.hs b/sing.hs
new file mode 100644
index 0000000..5fc21b2
--- /dev/null
+++ b/sing.hs
@@ -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