module GTA.Util.TypeInfo (TypeInfo, typeInfo, simpleName) where
import Language.Haskell.TH
type TypeInfo = (Name, [TyVarBndr], [(Name, [(Maybe Name, Type)])])
typeInfo :: Name -> Q TypeInfo
typeInfo name = do
info' <- reify name
case info' of
TyConI d -> typeInfo' ((return d) :: Q Dec)
_ -> error ("typeInfo: can't be used on anything but a type " ++
"constructor of an algebraic data type")
typeInfo' :: DecQ -> Q TypeInfo
typeInfo' m =
do d <- m
case d of
d@(DataD _ _ _ _ _) ->
return $ (name d, paramsA d, termsA d)
d@(NewtypeD _ _ _ _ _) ->
return $ (name d, paramsA d, termsA d)
_ -> error ("typeInfo': not a data type declaration: " ++ show d)
where
paramsA (DataD _ _ ps _ _) = ps
paramsA (NewtypeD _ _ ps _ _) = ps
termsA (DataD _ _ _ cs _) = map termA cs
termsA (NewtypeD _ _ _ c _) = [ termA c ]
termA (NormalC c xs) = (c, map (\x -> (Nothing, snd x)) xs)
termA (RecC c xs) = (c, map (\(n, _, t) -> (Just n, t)) xs)
termA (InfixC t1 c t2) = (c, [(Nothing, snd t1), (Nothing, snd t2)])
name (DataD _ n _ _ _) = n
name (NewtypeD _ n _ _ _) = n
name d = error $ show d
simpleName :: Name -> Name
simpleName = mkName . nameBase