35 lines
1.1 KiB
Haskell
35 lines
1.1 KiB
Haskell
{-# language GHC2024, AllowAmbiguousTypes, TemplateHaskell, TypeAbstractions #-}
|
|
|
|
import Dispatchable
|
|
-- due to TH's staging restriction (cannot splice definitions from the same
|
|
-- file), the dispatchable stuff has to be separated out
|
|
|
|
import Data.Maybe
|
|
import Data.Type.Equality
|
|
import GHC.TypeLits
|
|
import System.Environment
|
|
|
|
|
|
stringDispatchableWith :: KnownSymbol m =>
|
|
[DispatchableInstance] -> Maybe (Dict (Dispatchable m))
|
|
stringDispatchableWith @_ [] = Nothing
|
|
stringDispatchableWith @m (DI (SSymbol @s) Dict : insts)
|
|
| Just Refl <- is @s @m = Just Dict
|
|
| otherwise = stringDispatchableWith @m insts
|
|
where is :: (KnownSymbol a, KnownSymbol b) => Maybe (a :~: b)
|
|
is @a @b = sameSymbol (SSymbol @a) (SSymbol @b)
|
|
|
|
stringDispatchable :: KnownSymbol m => Maybe (Dict (Dispatchable m))
|
|
stringDispatchable = stringDispatchableWith $instances
|
|
|
|
|
|
dispatchDyn :: String -> Maybe String
|
|
dispatchDyn m = withSomeSSymbol m $ \(SSymbol @m) ->
|
|
case stringDispatchable @m of
|
|
Just Dict -> Just $ dispatch @m
|
|
Nothing -> Nothing
|
|
|
|
|
|
main = do
|
|
[s] <- getArgs
|
|
putStrLn $ fromMaybe "some default value" $ dispatchDyn s
|