module Language.Haskell.TH.Utils(
appExp,
appConT,
curryType,
genBT,
genPE,
appKinds,
curryKind,
getTypeNames,
getTVBName ,
getCompositeType
)
where
import Language.Haskell.TH
import Language.Haskell.TH.Lib
import Data.List (foldl1,foldr1)
appExp :: [ExpQ] -> ExpQ
appExp = appsE
appConT :: [TypeQ] -> TypeQ
appConT = foldl1 appT
curryType :: [TypeQ] -> TypeQ
curryType = foldr1 (\t1 -> appT (appT arrowT t1))
genBT :: String -> Int -> Q ([TyVarBndr], [TypeQ])
genBT name n = do
let ns = [name++ (show i) | i <- [1..n]]
tvb <- sequence $ map (return.plainTV.mkName) ns
typ <- sequence $ map (return.varT.mkName) ns
return (tvb,typ)
genPE :: String -> Int -> Q ([PatQ],[ExpQ])
genPE name n = do
let ns = [name++ (show i) | i <- [1..n]]
pat <- sequence $ map (return.varP.mkName) ns
exp <- sequence $ map (return.varE.mkName) ns
return (pat,exp)
appKinds :: [Kind] -> Kind
appKinds = foldr1 AppT
curryKind :: [Kind] -> Kind
curryKind = foldr1 (\t1 -> appK (appK arrowK t1))
getTypeNames :: Type -> [Name]
getTypeNames (ForallT tvbs cxt t) = getTypeNames t
getTypeNames (ConT n) = [n]
getTypeNames (AppT t1 t2) = getTypeNames t1 ++ getTypeNames t2
getTypeNames _ = []
getTVBName :: TyVarBndr -> Name
getTVBName (PlainTV name ) = name
getTVBName (KindedTV name _) = name
third (a,b,c) = c
getCompositeType :: Con -> [Name]
getCompositeType (NormalC n sts) = concatMap getTypeNames (map snd sts)
getCompositeType (RecC n vars) = concatMap getTypeNames (map third vars)
getCompositeType (InfixC st1 n st2) = concatMap getTypeNames [snd st1 , snd st2]
getCompositeType (ForallC tvbs cxt con) = getCompositeType con