module Control.Lens.Util.TH where
import Language.Haskell.TH
bndrName :: TyVarBndr -> Name
bndrName (PlainTV n) = n
bndrName (KindedTV n _) = n
replaceTypeVar :: Name -> Name -> Type -> Type
replaceTypeVar l m (VarT n) = VarT $ judgeName l m n
replaceTypeVar l m (ForallT tvbs c t) =
ForallT (replaceTvbsVar l m tvbs) (replaceCxtVar l m c) (replaceTypeVar l m t)
replaceTypeVar l m (AppT t1 t2) = AppT (replaceTypeVar l m t1) (replaceTypeVar l m t2)
replaceTypeVar l m (SigT t k) = SigT (replaceTypeVar l m t) k
replaceTypeVar _ _ t = t
replaceCxtVar :: Name -> Name -> Cxt -> Cxt
replaceCxtVar l m = map rep
where
rep :: Pred -> Pred
rep (ClassP n ts) = ClassP n $ map (replaceTypeVar l m) ts
rep (EqualP t1 t2) = EqualP (replaceTypeVar l m t1) (replaceTypeVar l m t2)
replaceTvbsVar :: Name -> Name -> [TyVarBndr] -> [TyVarBndr]
replaceTvbsVar l m = map rep
where
rep :: TyVarBndr -> TyVarBndr
rep (PlainTV n) = PlainTV $ judgeName l m n
rep (KindedTV n k) = KindedTV (judgeName l m n) k
judgeName :: Name -> Name -> Name -> Name
judgeName l m n = if l == n then m else n
type2List :: Type -> [Name]
type2List (VarT n) = [n]
type2List (ForallT tvbs c t) = tvbs2List tvbs ++ cxt2List c ++ type2List t
type2List (AppT t1 t2) = type2List t1 ++ type2List t2
type2List (SigT t _) = type2List t
type2List t = []
cxt2List :: Cxt -> [Name]
cxt2List = concatMap rep
where
rep :: Pred -> [Name]
rep (ClassP n ts) = concatMap type2List ts
rep (EqualP t1 t2) = type2List t1 ++ type2List t2
tvbs2List :: [TyVarBndr] -> [Name]
tvbs2List = map rep
where
rep :: TyVarBndr -> Name
rep (PlainTV n) = n
rep (KindedTV n k) = n