module IfCxt
( IfCxt (..)
, mkIfCxtInstances
)
where
import Control.Monad
import Data.Proxy
import Language.Haskell.TH.Syntax
class IfCxt cxt where
ifCxt :: proxy cxt -> (cxt => a) -> a -> a
instance IfCxt cxt where ifCxt _ t f = f
mkIfCxtInstances :: Name -> Q [Dec]
mkIfCxtInstances n = do
info <- reify ''IfCxt
let instancesOfIfCxt = case info of
ClassI _ xs -> map (\(InstanceD _ (AppT _ t) _) -> t) xs
isInstanceOfIfCxt t = t `elem` instancesOfIfCxt
info <- reify n
case info of
ClassI _ xs -> fmap concat $ forM xs $ \(InstanceD cxt (AppT classt t) ys) -> return $
if isInstanceOfIfCxt (AppT classt t)
then []
else [ InstanceD
cxt
(AppT
(ConT ''IfCxt)
(AppT
(ConT n)
t
)
)
[ FunD 'ifCxt
[ Clause
[ VarP $ mkName "proxy"
, VarP $ mkName "t"
, VarP $ mkName "f"
]
( NormalB ( VarE $ mkName "t") )
[]
]
]
]
otherwise -> error $ show n ++ " not a class name"