{-# LANGUAGE CPP #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeSynonymInstances #-}
#ifndef MIN_VERSION_template_haskell
#define MIN_VERSION_template_haskell(x,y,z) (defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 706)
#endif
#if MIN_VERSION_template_haskell(2,12,0)
{-# LANGUAGE Safe #-}
#else
{-# LANGUAGE Trustworthy #-}
#endif
module Lens.Micro.TH.Internal
(
HasName(..),
newNames,
HasTypeVars(..),
typeVars,
substTypeVars,
inlinePragma,
conAppsT,
quantifyType, quantifyType',
elemOf,
lengthOf,
setOf,
_ForallT,
)
where
import Data.Monoid
import qualified Data.Map as Map
import Data.Map (Map)
import qualified Data.Set as Set
import Data.Set (Set)
import Data.List (nub)
import Data.Maybe
import Lens.Micro
import Language.Haskell.TH
import Language.Haskell.TH.Datatype.TyVarBndr
#if __GLASGOW_HASKELL__ < 710
import Control.Applicative
import Data.Traversable (traverse)
#endif
class HasName t where
name :: Lens' t Name
instance HasName (TyVarBndr_ flag) where
name :: (Name -> f Name) -> TyVarBndr_ flag -> f (TyVarBndr_ flag)
name = (Name -> f Name) -> TyVarBndr_ flag -> f (TyVarBndr_ flag)
forall (f :: * -> *) flag.
Functor f =>
(Name -> f Name) -> TyVarBndr_ flag -> f (TyVarBndr_ flag)
traverseTVName
instance HasName Name where
name :: (Name -> f Name) -> Name -> f Name
name = (Name -> f Name) -> Name -> f Name
forall a. a -> a
id
instance HasName Con where
name :: (Name -> f Name) -> Con -> f Con
name Name -> f Name
f (NormalC Name
n [BangType]
tys) = (Name -> [BangType] -> Con
`NormalC` [BangType]
tys) (Name -> Con) -> f Name -> f Con
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> f Name
f Name
n
name Name -> f Name
f (RecC Name
n [VarBangType]
tys) = (Name -> [VarBangType] -> Con
`RecC` [VarBangType]
tys) (Name -> Con) -> f Name -> f Con
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> f Name
f Name
n
name Name -> f Name
f (InfixC BangType
l Name
n BangType
r) = (\Name
n' -> BangType -> Name -> BangType -> Con
InfixC BangType
l Name
n' BangType
r) (Name -> Con) -> f Name -> f Con
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> f Name
f Name
n
name Name -> f Name
f (ForallC [TyVarBndr_ flag]
bds Cxt
ctx Con
con) = [TyVarBndr_ flag] -> Cxt -> Con -> Con
ForallC [TyVarBndr_ flag]
bds Cxt
ctx (Con -> Con) -> f Con -> f Con
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Name -> f Name) -> Con -> f Con
forall t. HasName t => Lens' t Name
name Name -> f Name
f Con
con
#if MIN_VERSION_template_haskell(2,11,0)
name Name -> f Name
f (GadtC [Name]
ns [BangType]
argTys Type
retTy) =
(\Name
n -> [Name] -> [BangType] -> Type -> Con
GadtC [Name
n] [BangType]
argTys Type
retTy) (Name -> Con) -> f Name -> f Con
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> f Name
f ([Name] -> Name
forall a. [a] -> a
head [Name]
ns)
name Name -> f Name
f (RecGadtC [Name]
ns [VarBangType]
argTys Type
retTy) =
(\Name
n -> [Name] -> [VarBangType] -> Type -> Con
RecGadtC [Name
n] [VarBangType]
argTys Type
retTy) (Name -> Con) -> f Name -> f Con
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> f Name
f ([Name] -> Name
forall a. [a] -> a
head [Name]
ns)
#endif
newNames :: String -> Int -> Q [Name]
newNames :: String -> Int -> Q [Name]
newNames String
base Int
n = [Q Name] -> Q [Name]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [ String -> Q Name
newName (String
baseString -> String -> String
forall a. [a] -> [a] -> [a]
++Int -> String
forall a. Show a => a -> String
show Int
i) | Int
i <- [Int
1..Int
n] ]
class HasTypeVars t where
typeVarsEx :: Set Name -> Traversal' t Name
instance HasTypeVars (TyVarBndr_ flag) where
typeVarsEx :: Set Name -> Traversal' (TyVarBndr_ flag) Name
typeVarsEx Set Name
s Name -> f Name
f TyVarBndr_ flag
b
| Name -> Set Name -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member (TyVarBndr_ flag
bTyVarBndr_ flag -> Getting Name (TyVarBndr_ flag) Name -> Name
forall s a. s -> Getting a s a -> a
^.Getting Name (TyVarBndr_ flag) Name
forall t. HasName t => Lens' t Name
name) Set Name
s = TyVarBndr_ flag -> f (TyVarBndr_ flag)
forall (f :: * -> *) a. Applicative f => a -> f a
pure TyVarBndr_ flag
b
| Bool
otherwise = (Name -> f Name) -> TyVarBndr_ flag -> f (TyVarBndr_ flag)
forall t. HasName t => Lens' t Name
name Name -> f Name
f TyVarBndr_ flag
b
instance HasTypeVars Name where
typeVarsEx :: Set Name -> Traversal' Name Name
typeVarsEx Set Name
s Name -> f Name
f Name
n
| Name -> Set Name -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member Name
n Set Name
s = Name -> f Name
forall (f :: * -> *) a. Applicative f => a -> f a
pure Name
n
| Bool
otherwise = Name -> f Name
f Name
n
instance HasTypeVars Type where
typeVarsEx :: Set Name -> Traversal' Type Name
typeVarsEx Set Name
s Name -> f Name
f (VarT Name
n) = Name -> Type
VarT (Name -> Type) -> f Name -> f Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set Name -> (Name -> f Name) -> Name -> f Name
forall t. HasTypeVars t => Set Name -> Traversal' t Name
typeVarsEx Set Name
s Name -> f Name
f Name
n
typeVarsEx Set Name
s Name -> f Name
f (AppT Type
l Type
r) = Type -> Type -> Type
AppT (Type -> Type -> Type) -> f Type -> f (Type -> Type)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set Name -> (Name -> f Name) -> Type -> f Type
forall t. HasTypeVars t => Set Name -> Traversal' t Name
typeVarsEx Set Name
s Name -> f Name
f Type
l f (Type -> Type) -> f Type -> f Type
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Set Name -> (Name -> f Name) -> Type -> f Type
forall t. HasTypeVars t => Set Name -> Traversal' t Name
typeVarsEx Set Name
s Name -> f Name
f Type
r
typeVarsEx Set Name
s Name -> f Name
f (ForallT [TyVarBndr_ flag]
bs Cxt
ctx Type
ty) = [TyVarBndr_ flag] -> Cxt -> Type -> Type
ForallT [TyVarBndr_ flag]
bs (Cxt -> Type -> Type) -> f Cxt -> f (Type -> Type)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set Name -> (Name -> f Name) -> Cxt -> f Cxt
forall t. HasTypeVars t => Set Name -> Traversal' t Name
typeVarsEx Set Name
s' Name -> f Name
f Cxt
ctx f (Type -> Type) -> f Type -> f Type
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Set Name -> (Name -> f Name) -> Type -> f Type
forall t. HasTypeVars t => Set Name -> Traversal' t Name
typeVarsEx Set Name
s' Name -> f Name
f Type
ty
where s' :: Set Name
s' = Set Name
s Set Name -> Set Name -> Set Name
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` Getting (Endo [Name]) [TyVarBndr_ flag] Name
-> [TyVarBndr_ flag] -> Set Name
forall a s. Ord a => Getting (Endo [a]) s a -> s -> Set a
setOf Getting (Endo [Name]) [TyVarBndr_ flag] Name
forall t. HasTypeVars t => Traversal' t Name
typeVars [TyVarBndr_ flag]
bs
typeVarsEx Set Name
_ Name -> f Name
_ t :: Type
t@ConT{} = Type -> f Type
forall (f :: * -> *) a. Applicative f => a -> f a
pure Type
t
typeVarsEx Set Name
_ Name -> f Name
_ t :: Type
t@TupleT{} = Type -> f Type
forall (f :: * -> *) a. Applicative f => a -> f a
pure Type
t
typeVarsEx Set Name
_ Name -> f Name
_ t :: Type
t@ListT{} = Type -> f Type
forall (f :: * -> *) a. Applicative f => a -> f a
pure Type
t
typeVarsEx Set Name
_ Name -> f Name
_ t :: Type
t@ArrowT{} = Type -> f Type
forall (f :: * -> *) a. Applicative f => a -> f a
pure Type
t
typeVarsEx Set Name
_ Name -> f Name
_ t :: Type
t@UnboxedTupleT{} = Type -> f Type
forall (f :: * -> *) a. Applicative f => a -> f a
pure Type
t
#if MIN_VERSION_template_haskell(2,8,0)
typeVarsEx Set Name
s Name -> f Name
f (SigT Type
t Type
k) = Type -> Type -> Type
SigT (Type -> Type -> Type) -> f Type -> f (Type -> Type)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set Name -> (Name -> f Name) -> Type -> f Type
forall t. HasTypeVars t => Set Name -> Traversal' t Name
typeVarsEx Set Name
s Name -> f Name
f Type
t
f (Type -> Type) -> f Type -> f Type
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Set Name -> (Name -> f Name) -> Type -> f Type
forall t. HasTypeVars t => Set Name -> Traversal' t Name
typeVarsEx Set Name
s Name -> f Name
f Type
k
#else
typeVarsEx s f (SigT t k) = (`SigT` k) <$> typeVarsEx s f t
#endif
#if MIN_VERSION_template_haskell(2,8,0)
typeVarsEx Set Name
_ Name -> f Name
_ t :: Type
t@PromotedT{} = Type -> f Type
forall (f :: * -> *) a. Applicative f => a -> f a
pure Type
t
typeVarsEx Set Name
_ Name -> f Name
_ t :: Type
t@PromotedTupleT{} = Type -> f Type
forall (f :: * -> *) a. Applicative f => a -> f a
pure Type
t
typeVarsEx Set Name
_ Name -> f Name
_ t :: Type
t@PromotedNilT{} = Type -> f Type
forall (f :: * -> *) a. Applicative f => a -> f a
pure Type
t
typeVarsEx Set Name
_ Name -> f Name
_ t :: Type
t@PromotedConsT{} = Type -> f Type
forall (f :: * -> *) a. Applicative f => a -> f a
pure Type
t
typeVarsEx Set Name
_ Name -> f Name
_ t :: Type
t@StarT{} = Type -> f Type
forall (f :: * -> *) a. Applicative f => a -> f a
pure Type
t
typeVarsEx Set Name
_ Name -> f Name
_ t :: Type
t@ConstraintT{} = Type -> f Type
forall (f :: * -> *) a. Applicative f => a -> f a
pure Type
t
typeVarsEx Set Name
_ Name -> f Name
_ t :: Type
t@LitT{} = Type -> f Type
forall (f :: * -> *) a. Applicative f => a -> f a
pure Type
t
#endif
#if MIN_VERSION_template_haskell(2,10,0)
typeVarsEx Set Name
_ Name -> f Name
_ t :: Type
t@EqualityT{} = Type -> f Type
forall (f :: * -> *) a. Applicative f => a -> f a
pure Type
t
#endif
#if MIN_VERSION_template_haskell(2,11,0)
typeVarsEx Set Name
s Name -> f Name
f (InfixT Type
t1 Name
n Type
t2) = Type -> Name -> Type -> Type
InfixT (Type -> Name -> Type -> Type)
-> f Type -> f (Name -> Type -> Type)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set Name -> (Name -> f Name) -> Type -> f Type
forall t. HasTypeVars t => Set Name -> Traversal' t Name
typeVarsEx Set Name
s Name -> f Name
f Type
t1
f (Name -> Type -> Type) -> f Name -> f (Type -> Type)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Name -> f Name
forall (f :: * -> *) a. Applicative f => a -> f a
pure Name
n
f (Type -> Type) -> f Type -> f Type
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Set Name -> (Name -> f Name) -> Type -> f Type
forall t. HasTypeVars t => Set Name -> Traversal' t Name
typeVarsEx Set Name
s Name -> f Name
f Type
t2
typeVarsEx Set Name
s Name -> f Name
f (UInfixT Type
t1 Name
n Type
t2) = Type -> Name -> Type -> Type
UInfixT (Type -> Name -> Type -> Type)
-> f Type -> f (Name -> Type -> Type)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set Name -> (Name -> f Name) -> Type -> f Type
forall t. HasTypeVars t => Set Name -> Traversal' t Name
typeVarsEx Set Name
s Name -> f Name
f Type
t1
f (Name -> Type -> Type) -> f Name -> f (Type -> Type)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Name -> f Name
forall (f :: * -> *) a. Applicative f => a -> f a
pure Name
n
f (Type -> Type) -> f Type -> f Type
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Set Name -> (Name -> f Name) -> Type -> f Type
forall t. HasTypeVars t => Set Name -> Traversal' t Name
typeVarsEx Set Name
s Name -> f Name
f Type
t2
typeVarsEx Set Name
s Name -> f Name
f (ParensT Type
t) = Type -> Type
ParensT (Type -> Type) -> f Type -> f Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set Name -> (Name -> f Name) -> Type -> f Type
forall t. HasTypeVars t => Set Name -> Traversal' t Name
typeVarsEx Set Name
s Name -> f Name
f Type
t
typeVarsEx Set Name
_ Name -> f Name
_ t :: Type
t@WildCardT{} = Type -> f Type
forall (f :: * -> *) a. Applicative f => a -> f a
pure Type
t
#endif
#if MIN_VERSION_template_haskell(2,12,0)
typeVarsEx Set Name
_ Name -> f Name
_ t :: Type
t@UnboxedSumT{} = Type -> f Type
forall (f :: * -> *) a. Applicative f => a -> f a
pure Type
t
#endif
#if MIN_VERSION_template_haskell(2,15,0)
typeVarsEx Set Name
s Name -> f Name
f (AppKindT Type
t Type
k) = Type -> Type -> Type
AppKindT (Type -> Type -> Type) -> f Type -> f (Type -> Type)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set Name -> (Name -> f Name) -> Type -> f Type
forall t. HasTypeVars t => Set Name -> Traversal' t Name
typeVarsEx Set Name
s Name -> f Name
f Type
t
f (Type -> Type) -> f Type -> f Type
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Set Name -> (Name -> f Name) -> Type -> f Type
forall t. HasTypeVars t => Set Name -> Traversal' t Name
typeVarsEx Set Name
s Name -> f Name
f Type
k
typeVarsEx Set Name
s Name -> f Name
f (ImplicitParamT String
n Type
t) = String -> Type -> Type
ImplicitParamT String
n (Type -> Type) -> f Type -> f Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set Name -> (Name -> f Name) -> Type -> f Type
forall t. HasTypeVars t => Set Name -> Traversal' t Name
typeVarsEx Set Name
s Name -> f Name
f Type
t
#endif
#if MIN_VERSION_template_haskell(2,16,0)
typeVarsEx Set Name
s Name -> f Name
f (ForallVisT [TyVarBndr_ flag]
bs Type
ty) = [TyVarBndr_ flag] -> Type -> Type
ForallVisT [TyVarBndr_ flag]
bs (Type -> Type) -> f Type -> f Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set Name -> (Name -> f Name) -> Type -> f Type
forall t. HasTypeVars t => Set Name -> Traversal' t Name
typeVarsEx Set Name
s' Name -> f Name
f Type
ty
where s' :: Set Name
s' = Set Name
s Set Name -> Set Name -> Set Name
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` Getting (Endo [Name]) [TyVarBndr_ flag] Name
-> [TyVarBndr_ flag] -> Set Name
forall a s. Ord a => Getting (Endo [a]) s a -> s -> Set a
setOf Getting (Endo [Name]) [TyVarBndr_ flag] Name
forall t. HasTypeVars t => Traversal' t Name
typeVars [TyVarBndr_ flag]
bs
#endif
#if MIN_VERSION_template_haskell(2,17,0)
typeVarsEx _ _ t@MulArrowT{} = pure t
#endif
#if !MIN_VERSION_template_haskell(2,10,0)
instance HasTypeVars Pred where
typeVarsEx s f (ClassP n ts) = ClassP n <$> typeVarsEx s f ts
typeVarsEx s f (EqualP l r) = EqualP <$> typeVarsEx s f l <*> typeVarsEx s f r
#endif
instance HasTypeVars Con where
typeVarsEx :: Set Name -> Traversal' Con Name
typeVarsEx Set Name
s Name -> f Name
f (NormalC Name
n [BangType]
ts) = Name -> [BangType] -> Con
NormalC Name
n ([BangType] -> Con) -> f [BangType] -> f Con
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((BangType -> f BangType) -> [BangType] -> f [BangType]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((BangType -> f BangType) -> [BangType] -> f [BangType])
-> ((Type -> f Type) -> BangType -> f BangType)
-> (Type -> f Type)
-> [BangType]
-> f [BangType]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Type -> f Type) -> BangType -> f BangType
forall s t a b. Field2 s t a b => Lens s t a b
_2) (Set Name -> (Name -> f Name) -> Type -> f Type
forall t. HasTypeVars t => Set Name -> Traversal' t Name
typeVarsEx Set Name
s Name -> f Name
f) [BangType]
ts
typeVarsEx Set Name
s Name -> f Name
f (RecC Name
n [VarBangType]
ts) = Name -> [VarBangType] -> Con
RecC Name
n ([VarBangType] -> Con) -> f [VarBangType] -> f Con
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((VarBangType -> f VarBangType) -> [VarBangType] -> f [VarBangType]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((VarBangType -> f VarBangType)
-> [VarBangType] -> f [VarBangType])
-> ((Type -> f Type) -> VarBangType -> f VarBangType)
-> (Type -> f Type)
-> [VarBangType]
-> f [VarBangType]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Type -> f Type) -> VarBangType -> f VarBangType
forall s t a b. Field3 s t a b => Lens s t a b
_3) (Set Name -> (Name -> f Name) -> Type -> f Type
forall t. HasTypeVars t => Set Name -> Traversal' t Name
typeVarsEx Set Name
s Name -> f Name
f) [VarBangType]
ts
typeVarsEx Set Name
s Name -> f Name
f (InfixC BangType
l Name
n BangType
r) = BangType -> Name -> BangType -> Con
InfixC (BangType -> Name -> BangType -> Con)
-> f BangType -> f (Name -> BangType -> Con)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BangType -> f BangType
forall b a. HasTypeVars b => (a, b) -> f (a, b)
g BangType
l f (Name -> BangType -> Con) -> f Name -> f (BangType -> Con)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Name -> f Name
forall (f :: * -> *) a. Applicative f => a -> f a
pure Name
n f (BangType -> Con) -> f BangType -> f Con
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BangType -> f BangType
forall b a. HasTypeVars b => (a, b) -> f (a, b)
g BangType
r
where g :: (a, b) -> f (a, b)
g (a
i, b
t) = (,) a
i (b -> (a, b)) -> f b -> f (a, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set Name -> (Name -> f Name) -> b -> f b
forall t. HasTypeVars t => Set Name -> Traversal' t Name
typeVarsEx Set Name
s Name -> f Name
f b
t
typeVarsEx Set Name
s Name -> f Name
f (ForallC [TyVarBndr_ flag]
bs Cxt
ctx Con
c) = [TyVarBndr_ flag] -> Cxt -> Con -> Con
ForallC [TyVarBndr_ flag]
bs (Cxt -> Con -> Con) -> f Cxt -> f (Con -> Con)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set Name -> (Name -> f Name) -> Cxt -> f Cxt
forall t. HasTypeVars t => Set Name -> Traversal' t Name
typeVarsEx Set Name
s' Name -> f Name
f Cxt
ctx f (Con -> Con) -> f Con -> f Con
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Set Name -> (Name -> f Name) -> Con -> f Con
forall t. HasTypeVars t => Set Name -> Traversal' t Name
typeVarsEx Set Name
s' Name -> f Name
f Con
c
where s' :: Set Name
s' = Set Name
s Set Name -> Set Name -> Set Name
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` [Name] -> Set Name
forall a. Ord a => [a] -> Set a
Set.fromList ([TyVarBndr_ flag]
bs [TyVarBndr_ flag]
-> Getting (Endo [Name]) [TyVarBndr_ flag] Name -> [Name]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. Getting (Endo [Name]) [TyVarBndr_ flag] Name
forall t. HasTypeVars t => Traversal' t Name
typeVars)
#if MIN_VERSION_template_haskell(2,11,0)
typeVarsEx Set Name
s Name -> f Name
f (GadtC [Name]
ns [BangType]
argTys Type
retTy) =
[Name] -> [BangType] -> Type -> Con
GadtC [Name]
ns ([BangType] -> Type -> Con) -> f [BangType] -> f (Type -> Con)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((BangType -> f BangType) -> [BangType] -> f [BangType]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((BangType -> f BangType) -> [BangType] -> f [BangType])
-> ((Type -> f Type) -> BangType -> f BangType)
-> (Type -> f Type)
-> [BangType]
-> f [BangType]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Type -> f Type) -> BangType -> f BangType
forall s t a b. Field2 s t a b => Lens s t a b
_2) (Set Name -> (Name -> f Name) -> Type -> f Type
forall t. HasTypeVars t => Set Name -> Traversal' t Name
typeVarsEx Set Name
s Name -> f Name
f) [BangType]
argTys
f (Type -> Con) -> f Type -> f Con
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Set Name -> (Name -> f Name) -> Type -> f Type
forall t. HasTypeVars t => Set Name -> Traversal' t Name
typeVarsEx Set Name
s Name -> f Name
f Type
retTy
typeVarsEx Set Name
s Name -> f Name
f (RecGadtC [Name]
ns [VarBangType]
argTys Type
retTy) =
[Name] -> [VarBangType] -> Type -> Con
RecGadtC [Name]
ns ([VarBangType] -> Type -> Con)
-> f [VarBangType] -> f (Type -> Con)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((VarBangType -> f VarBangType) -> [VarBangType] -> f [VarBangType]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((VarBangType -> f VarBangType)
-> [VarBangType] -> f [VarBangType])
-> ((Type -> f Type) -> VarBangType -> f VarBangType)
-> (Type -> f Type)
-> [VarBangType]
-> f [VarBangType]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Type -> f Type) -> VarBangType -> f VarBangType
forall s t a b. Field3 s t a b => Lens s t a b
_3) (Set Name -> (Name -> f Name) -> Type -> f Type
forall t. HasTypeVars t => Set Name -> Traversal' t Name
typeVarsEx Set Name
s Name -> f Name
f) [VarBangType]
argTys
f (Type -> Con) -> f Type -> f Con
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Set Name -> (Name -> f Name) -> Type -> f Type
forall t. HasTypeVars t => Set Name -> Traversal' t Name
typeVarsEx Set Name
s Name -> f Name
f Type
retTy
#endif
instance HasTypeVars t => HasTypeVars [t] where
typeVarsEx :: Set Name -> Traversal' [t] Name
typeVarsEx Set Name
s = (t -> f t) -> [t] -> f [t]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((t -> f t) -> [t] -> f [t])
-> ((Name -> f Name) -> t -> f t)
-> (Name -> f Name)
-> [t]
-> f [t]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set Name -> Traversal' t Name
forall t. HasTypeVars t => Set Name -> Traversal' t Name
typeVarsEx Set Name
s
instance HasTypeVars t => HasTypeVars (Maybe t) where
typeVarsEx :: Set Name -> Traversal' (Maybe t) Name
typeVarsEx Set Name
s = (t -> f t) -> Maybe t -> f (Maybe t)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((t -> f t) -> Maybe t -> f (Maybe t))
-> ((Name -> f Name) -> t -> f t)
-> (Name -> f Name)
-> Maybe t
-> f (Maybe t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set Name -> Traversal' t Name
forall t. HasTypeVars t => Set Name -> Traversal' t Name
typeVarsEx Set Name
s
typeVars :: HasTypeVars t => Traversal' t Name
typeVars :: Traversal' t Name
typeVars = Set Name -> Traversal' t Name
forall t. HasTypeVars t => Set Name -> Traversal' t Name
typeVarsEx Set Name
forall a. Monoid a => a
mempty
substTypeVars :: HasTypeVars t => Map Name Name -> t -> t
substTypeVars :: Map Name Name -> t -> t
substTypeVars Map Name Name
m = ASetter t t Name Name -> (Name -> Name) -> t -> t
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter t t Name Name
forall t. HasTypeVars t => Traversal' t Name
typeVars ((Name -> Name) -> t -> t) -> (Name -> Name) -> t -> t
forall a b. (a -> b) -> a -> b
$ \Name
n -> Name -> Maybe Name -> Name
forall a. a -> Maybe a -> a
fromMaybe Name
n (Name -> Map Name Name -> Maybe Name
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
n Map Name Name
m)
inlinePragma :: Name -> [DecQ]
#if MIN_VERSION_template_haskell(2,8,0)
inlinePragma :: Name -> [DecQ]
inlinePragma Name
methodName = [Name -> Inline -> RuleMatch -> Phases -> DecQ
pragInlD Name
methodName Inline
Inline RuleMatch
FunLike Phases
AllPhases]
#else
inlinePragma methodName = [pragInlD methodName (inlineSpecNoPhase True False)]
#endif
conAppsT :: Name -> [Type] -> Type
conAppsT :: Name -> Cxt -> Type
conAppsT Name
conName = (Type -> Type -> Type) -> Type -> Cxt -> Type
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Type -> Type -> Type
AppT (Name -> Type
ConT Name
conName)
quantifyType :: Cxt -> Type -> Type
quantifyType :: Cxt -> Type -> Type
quantifyType = Set Name -> Cxt -> Type -> Type
quantifyType' Set Name
forall a. Set a
Set.empty
quantifyType' :: Set Name -> Cxt -> Type -> Type
quantifyType' :: Set Name -> Cxt -> Type -> Type
quantifyType' Set Name
exclude Cxt
c Type
t = [TyVarBndr_ flag] -> Cxt -> Type -> Type
ForallT [TyVarBndr_ flag]
vs Cxt
c Type
t
where
vs :: [TyVarBndr_ flag]
vs = (Name -> TyVarBndr_ flag) -> [Name] -> [TyVarBndr_ flag]
forall a b. (a -> b) -> [a] -> [b]
map Name -> TyVarBndr_ flag
plainTVSpecified
([Name] -> [TyVarBndr_ flag]) -> [Name] -> [TyVarBndr_ flag]
forall a b. (a -> b) -> a -> b
$ (Name -> Bool) -> [Name] -> [Name]
forall a. (a -> Bool) -> [a] -> [a]
filter (Name -> Set Name -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.notMember` Set Name
exclude)
([Name] -> [Name]) -> [Name] -> [Name]
forall a b. (a -> b) -> a -> b
$ [Name] -> [Name]
forall a. Eq a => [a] -> [a]
nub
([Name] -> [Name]) -> [Name] -> [Name]
forall a b. (a -> b) -> a -> b
$ Getting (Endo [Name]) Type Name -> Type -> [Name]
forall a s. Getting (Endo [a]) s a -> s -> [a]
toListOf Getting (Endo [Name]) Type Name
forall t. HasTypeVars t => Traversal' t Name
typeVars Type
t
elemOf :: Eq a => Getting (Endo [a]) s a -> a -> s -> Bool
elemOf :: Getting (Endo [a]) s a -> a -> s -> Bool
elemOf Getting (Endo [a]) s a
l a
x s
s = a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem a
x (s
s s -> Getting (Endo [a]) s a -> [a]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. Getting (Endo [a]) s a
l)
lengthOf :: Getting (Endo [a]) s a -> s -> Int
lengthOf :: Getting (Endo [a]) s a -> s -> Int
lengthOf Getting (Endo [a]) s a
l s
s = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (s
s s -> Getting (Endo [a]) s a -> [a]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. Getting (Endo [a]) s a
l)
setOf :: Ord a => Getting (Endo [a]) s a -> s -> Set a
setOf :: Getting (Endo [a]) s a -> s -> Set a
setOf Getting (Endo [a]) s a
l s
s = [a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList (s
s s -> Getting (Endo [a]) s a -> [a]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. Getting (Endo [a]) s a
l)
_ForallT :: Traversal' Type ([TyVarBndrSpec], Cxt, Type)
_ForallT :: (([TyVarBndr_ flag], Cxt, Type)
-> f ([TyVarBndr_ flag], Cxt, Type))
-> Type -> f Type
_ForallT ([TyVarBndr_ flag], Cxt, Type) -> f ([TyVarBndr_ flag], Cxt, Type)
f (ForallT [TyVarBndr_ flag]
a Cxt
b Type
c) = (\([TyVarBndr_ flag]
x, Cxt
y, Type
z) -> [TyVarBndr_ flag] -> Cxt -> Type -> Type
ForallT [TyVarBndr_ flag]
x Cxt
y Type
z) (([TyVarBndr_ flag], Cxt, Type) -> Type)
-> f ([TyVarBndr_ flag], Cxt, Type) -> f Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([TyVarBndr_ flag], Cxt, Type) -> f ([TyVarBndr_ flag], Cxt, Type)
f ([TyVarBndr_ flag]
a, Cxt
b, Type
c)
_ForallT ([TyVarBndr_ flag], Cxt, Type) -> f ([TyVarBndr_ flag], Cxt, Type)
_ Type
other = Type -> f Type
forall (f :: * -> *) a. Applicative f => a -> f a
pure Type
other