32 lines
972 B
Haskell
32 lines
972 B
Haskell
{-# language GHC2024, AllowAmbiguousTypes, TemplateHaskell, TypeAbstractions #-}
|
|
|
|
module Dispatchable where
|
|
|
|
import GHC.TypeLits
|
|
import Language.Haskell.TH
|
|
|
|
|
|
data Dict c = c => Dict
|
|
|
|
-- since TH needs to run code during compilation it introduces order-dependence.
|
|
-- declaration splices split the file up into chunks that are checked
|
|
-- separately, and `reify` (for example) can only see chunks that have already
|
|
-- been done. so that `pure []` is to cause `Dispatchable` to be processed and
|
|
-- be visible
|
|
|
|
class Dispatchable d where dispatch :: String
|
|
instance Dispatchable "a" where dispatch = "A"
|
|
instance Dispatchable "b" where dispatch = "B"
|
|
|
|
pure []
|
|
|
|
data DispatchableInstance = forall s. DI (SSymbol s) (Dict (Dispatchable s))
|
|
|
|
instances :: Q Exp
|
|
instances = do
|
|
ClassI _ insts <- reify ''Dispatchable
|
|
listE $ map fromInstance insts
|
|
where
|
|
fromInstance :: Dec -> Q Exp
|
|
fromInstance (InstanceD _ _ (AppT _ str) _) =
|
|
[| DI (SSymbol @($(pure str))) Dict |]
|