{-# LANGUAGE CPP #-}
{-# LANGUAGE RankNTypes #-}
#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
#if __GLASGOW_HASKELL__ < 710
import Control.Applicative
import Data.Traversable (traverse)
#endif
class HasName t where
name :: Lens' t Name
instance HasName TyVarBndr where
name :: (Name -> f Name) -> TyVarBndr -> f TyVarBndr
name f :: Name -> f Name
f (PlainTV n :: Name
n) = Name -> TyVarBndr
PlainTV (Name -> TyVarBndr) -> f Name -> f TyVarBndr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> f Name
f Name
n
name f :: Name -> f Name
f (KindedTV n :: Name
n k :: Kind
k) = (Name -> Kind -> TyVarBndr
`KindedTV` Kind
k) (Name -> TyVarBndr) -> f Name -> f TyVarBndr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> f Name
f Name
n
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 f :: Name -> f Name
f (NormalC n :: Name
n tys :: [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 f :: Name -> f Name
f (RecC n :: Name
n tys :: [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 f :: Name -> f Name
f (InfixC l :: BangType
l n :: Name
n r :: BangType
r) = (\n' :: 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 f :: Name -> f Name
f (ForallC bds :: [TyVarBndr]
bds ctx :: Cxt
ctx con :: Con
con) = [TyVarBndr] -> Cxt -> Con -> Con
ForallC [TyVarBndr]
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 f :: Name -> f Name
f (GadtC ns :: [Name]
ns argTys :: [BangType]
argTys retTy :: Kind
retTy) =
(\n :: Name
n -> [Name] -> [BangType] -> Kind -> Con
GadtC [Name
n] [BangType]
argTys Kind
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 f :: Name -> f Name
f (RecGadtC ns :: [Name]
ns argTys :: [VarBangType]
argTys retTy :: Kind
retTy) =
(\n :: Name
n -> [Name] -> [VarBangType] -> Kind -> Con
RecGadtC [Name
n] [VarBangType]
argTys Kind
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 base :: String
base n :: 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 <- [1..Int
n] ]
class HasTypeVars t where
typeVarsEx :: Set Name -> Traversal' t Name
instance HasTypeVars TyVarBndr where
typeVarsEx :: Set Name -> Traversal' TyVarBndr Name
typeVarsEx s :: Set Name
s f :: Name -> f Name
f b :: TyVarBndr
b
| Name -> Set Name -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member (TyVarBndr
bTyVarBndr -> Getting Name TyVarBndr Name -> Name
forall s a. s -> Getting a s a -> a
^.Getting Name TyVarBndr Name
forall t. HasName t => Lens' t Name
name) Set Name
s = TyVarBndr -> f TyVarBndr
forall (f :: * -> *) a. Applicative f => a -> f a
pure TyVarBndr
b
| Bool
otherwise = (Name -> f Name) -> TyVarBndr -> f TyVarBndr
forall t. HasName t => Lens' t Name
name Name -> f Name
f TyVarBndr
b
instance HasTypeVars Name where
typeVarsEx :: Set Name -> Traversal' Name Name
typeVarsEx s :: Set Name
s f :: Name -> f Name
f n :: 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' Kind Name
typeVarsEx s :: Set Name
s f :: Name -> f Name
f (VarT n :: Name
n) = Name -> Kind
VarT (Name -> Kind) -> f Name -> f Kind
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 s :: Set Name
s f :: Name -> f Name
f (AppT l :: Kind
l r :: Kind
r) = Kind -> Kind -> Kind
AppT (Kind -> Kind -> Kind) -> f Kind -> f (Kind -> Kind)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set Name -> (Name -> f Name) -> Kind -> f Kind
forall t. HasTypeVars t => Set Name -> Traversal' t Name
typeVarsEx Set Name
s Name -> f Name
f Kind
l f (Kind -> Kind) -> f Kind -> f Kind
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Set Name -> (Name -> f Name) -> Kind -> f Kind
forall t. HasTypeVars t => Set Name -> Traversal' t Name
typeVarsEx Set Name
s Name -> f Name
f Kind
r
typeVarsEx s :: Set Name
s f :: Name -> f Name
f (ForallT bs :: [TyVarBndr]
bs ctx :: Cxt
ctx ty :: Kind
ty) = [TyVarBndr] -> Cxt -> Kind -> Kind
ForallT [TyVarBndr]
bs (Cxt -> Kind -> Kind) -> f Cxt -> f (Kind -> Kind)
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 (Kind -> Kind) -> f Kind -> f Kind
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Set Name -> (Name -> f Name) -> Kind -> f Kind
forall t. HasTypeVars t => Set Name -> Traversal' t Name
typeVarsEx Set Name
s' Name -> f Name
f Kind
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] Name -> [TyVarBndr] -> Set Name
forall a s. Ord a => Getting (Endo [a]) s a -> s -> Set a
setOf Getting (Endo [Name]) [TyVarBndr] Name
forall t. HasTypeVars t => Traversal' t Name
typeVars [TyVarBndr]
bs
typeVarsEx _ _ t :: Kind
t@ConT{} = Kind -> f Kind
forall (f :: * -> *) a. Applicative f => a -> f a
pure Kind
t
typeVarsEx _ _ t :: Kind
t@TupleT{} = Kind -> f Kind
forall (f :: * -> *) a. Applicative f => a -> f a
pure Kind
t
typeVarsEx _ _ t :: Kind
t@ListT{} = Kind -> f Kind
forall (f :: * -> *) a. Applicative f => a -> f a
pure Kind
t
typeVarsEx _ _ t :: Kind
t@ArrowT{} = Kind -> f Kind
forall (f :: * -> *) a. Applicative f => a -> f a
pure Kind
t
typeVarsEx _ _ t :: Kind
t@UnboxedTupleT{} = Kind -> f Kind
forall (f :: * -> *) a. Applicative f => a -> f a
pure Kind
t
#if MIN_VERSION_template_haskell(2,8,0)
typeVarsEx s :: Set Name
s f :: Name -> f Name
f (SigT t :: Kind
t k :: Kind
k) = Kind -> Kind -> Kind
SigT (Kind -> Kind -> Kind) -> f Kind -> f (Kind -> Kind)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set Name -> (Name -> f Name) -> Kind -> f Kind
forall t. HasTypeVars t => Set Name -> Traversal' t Name
typeVarsEx Set Name
s Name -> f Name
f Kind
t
f (Kind -> Kind) -> f Kind -> f Kind
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Set Name -> (Name -> f Name) -> Kind -> f Kind
forall t. HasTypeVars t => Set Name -> Traversal' t Name
typeVarsEx Set Name
s Name -> f Name
f Kind
k
#else
typeVarsEx s f (SigT t k) = (`SigT` k) <$> typeVarsEx s f t
#endif
#if MIN_VERSION_template_haskell(2,8,0)
typeVarsEx _ _ t :: Kind
t@PromotedT{} = Kind -> f Kind
forall (f :: * -> *) a. Applicative f => a -> f a
pure Kind
t
typeVarsEx _ _ t :: Kind
t@PromotedTupleT{} = Kind -> f Kind
forall (f :: * -> *) a. Applicative f => a -> f a
pure Kind
t
typeVarsEx _ _ t :: Kind
t@PromotedNilT{} = Kind -> f Kind
forall (f :: * -> *) a. Applicative f => a -> f a
pure Kind
t
typeVarsEx _ _ t :: Kind
t@PromotedConsT{} = Kind -> f Kind
forall (f :: * -> *) a. Applicative f => a -> f a
pure Kind
t
typeVarsEx _ _ t :: Kind
t@StarT{} = Kind -> f Kind
forall (f :: * -> *) a. Applicative f => a -> f a
pure Kind
t
typeVarsEx _ _ t :: Kind
t@ConstraintT{} = Kind -> f Kind
forall (f :: * -> *) a. Applicative f => a -> f a
pure Kind
t
typeVarsEx _ _ t :: Kind
t@LitT{} = Kind -> f Kind
forall (f :: * -> *) a. Applicative f => a -> f a
pure Kind
t
#endif
#if MIN_VERSION_template_haskell(2,10,0)
typeVarsEx _ _ t :: Kind
t@EqualityT{} = Kind -> f Kind
forall (f :: * -> *) a. Applicative f => a -> f a
pure Kind
t
#endif
#if MIN_VERSION_template_haskell(2,11,0)
typeVarsEx s :: Set Name
s f :: Name -> f Name
f (InfixT t1 :: Kind
t1 n :: Name
n t2 :: Kind
t2) = Kind -> Name -> Kind -> Kind
InfixT (Kind -> Name -> Kind -> Kind)
-> f Kind -> f (Name -> Kind -> Kind)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set Name -> (Name -> f Name) -> Kind -> f Kind
forall t. HasTypeVars t => Set Name -> Traversal' t Name
typeVarsEx Set Name
s Name -> f Name
f Kind
t1
f (Name -> Kind -> Kind) -> f Name -> f (Kind -> Kind)
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 (Kind -> Kind) -> f Kind -> f Kind
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Set Name -> (Name -> f Name) -> Kind -> f Kind
forall t. HasTypeVars t => Set Name -> Traversal' t Name
typeVarsEx Set Name
s Name -> f Name
f Kind
t2
typeVarsEx s :: Set Name
s f :: Name -> f Name
f (UInfixT t1 :: Kind
t1 n :: Name
n t2 :: Kind
t2) = Kind -> Name -> Kind -> Kind
UInfixT (Kind -> Name -> Kind -> Kind)
-> f Kind -> f (Name -> Kind -> Kind)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set Name -> (Name -> f Name) -> Kind -> f Kind
forall t. HasTypeVars t => Set Name -> Traversal' t Name
typeVarsEx Set Name
s Name -> f Name
f Kind
t1
f (Name -> Kind -> Kind) -> f Name -> f (Kind -> Kind)
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 (Kind -> Kind) -> f Kind -> f Kind
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Set Name -> (Name -> f Name) -> Kind -> f Kind
forall t. HasTypeVars t => Set Name -> Traversal' t Name
typeVarsEx Set Name
s Name -> f Name
f Kind
t2
typeVarsEx s :: Set Name
s f :: Name -> f Name
f (ParensT t :: Kind
t) = Kind -> Kind
ParensT (Kind -> Kind) -> f Kind -> f Kind
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set Name -> (Name -> f Name) -> Kind -> f Kind
forall t. HasTypeVars t => Set Name -> Traversal' t Name
typeVarsEx Set Name
s Name -> f Name
f Kind
t
typeVarsEx _ _ t :: Kind
t@WildCardT{} = Kind -> f Kind
forall (f :: * -> *) a. Applicative f => a -> f a
pure Kind
t
#endif
#if MIN_VERSION_template_haskell(2,12,0)
typeVarsEx _ _ t :: Kind
t@UnboxedSumT{} = Kind -> f Kind
forall (f :: * -> *) a. Applicative f => a -> f a
pure Kind
t
#endif
#if MIN_VERSION_template_haskell(2,15,0)
typeVarsEx s :: Set Name
s f :: Name -> f Name
f (AppKindT t :: Kind
t k :: Kind
k) = Kind -> Kind -> Kind
AppKindT (Kind -> Kind -> Kind) -> f Kind -> f (Kind -> Kind)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set Name -> (Name -> f Name) -> Kind -> f Kind
forall t. HasTypeVars t => Set Name -> Traversal' t Name
typeVarsEx Set Name
s Name -> f Name
f Kind
t
f (Kind -> Kind) -> f Kind -> f Kind
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Set Name -> (Name -> f Name) -> Kind -> f Kind
forall t. HasTypeVars t => Set Name -> Traversal' t Name
typeVarsEx Set Name
s Name -> f Name
f Kind
k
typeVarsEx s :: Set Name
s f :: Name -> f Name
f (ImplicitParamT n :: String
n t :: Kind
t) = String -> Kind -> Kind
ImplicitParamT String
n (Kind -> Kind) -> f Kind -> f Kind
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set Name -> (Name -> f Name) -> Kind -> f Kind
forall t. HasTypeVars t => Set Name -> Traversal' t Name
typeVarsEx Set Name
s Name -> f Name
f Kind
t
#endif
#if MIN_VERSION_template_haskell(2,16,0)
typeVarsEx s f (ForallVisT bs ty) = ForallVisT bs <$> typeVarsEx s' f ty
where s' = s `Set.union` setOf typeVars bs
#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 s :: Set Name
s f :: Name -> f Name
f (NormalC n :: Name
n ts :: [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])
-> ((Kind -> f Kind) -> BangType -> f BangType)
-> (Kind -> f Kind)
-> [BangType]
-> f [BangType]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Kind -> f Kind) -> BangType -> f BangType
forall s t a b. Field2 s t a b => Lens s t a b
_2) (Set Name -> (Name -> f Name) -> Kind -> f Kind
forall t. HasTypeVars t => Set Name -> Traversal' t Name
typeVarsEx Set Name
s Name -> f Name
f) [BangType]
ts
typeVarsEx s :: Set Name
s f :: Name -> f Name
f (RecC n :: Name
n ts :: [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])
-> ((Kind -> f Kind) -> VarBangType -> f VarBangType)
-> (Kind -> f Kind)
-> [VarBangType]
-> f [VarBangType]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Kind -> f Kind) -> VarBangType -> f VarBangType
forall s t a b. Field3 s t a b => Lens s t a b
_3) (Set Name -> (Name -> f Name) -> Kind -> f Kind
forall t. HasTypeVars t => Set Name -> Traversal' t Name
typeVarsEx Set Name
s Name -> f Name
f) [VarBangType]
ts
typeVarsEx s :: Set Name
s f :: Name -> f Name
f (InfixC l :: BangType
l n :: Name
n r :: 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 (i :: a
i, t :: 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 s :: Set Name
s f :: Name -> f Name
f (ForallC bs :: [TyVarBndr]
bs ctx :: Cxt
ctx c :: Con
c) = [TyVarBndr] -> Cxt -> Con -> Con
ForallC [TyVarBndr]
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]
bs [TyVarBndr] -> Getting (Endo [Name]) [TyVarBndr] Name -> [Name]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. Getting (Endo [Name]) [TyVarBndr] Name
forall t. HasTypeVars t => Traversal' t Name
typeVars)
#if MIN_VERSION_template_haskell(2,11,0)
typeVarsEx s :: Set Name
s f :: Name -> f Name
f (GadtC ns :: [Name]
ns argTys :: [BangType]
argTys retTy :: Kind
retTy) =
[Name] -> [BangType] -> Kind -> Con
GadtC [Name]
ns ([BangType] -> Kind -> Con) -> f [BangType] -> f (Kind -> 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])
-> ((Kind -> f Kind) -> BangType -> f BangType)
-> (Kind -> f Kind)
-> [BangType]
-> f [BangType]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Kind -> f Kind) -> BangType -> f BangType
forall s t a b. Field2 s t a b => Lens s t a b
_2) (Set Name -> (Name -> f Name) -> Kind -> f Kind
forall t. HasTypeVars t => Set Name -> Traversal' t Name
typeVarsEx Set Name
s Name -> f Name
f) [BangType]
argTys
f (Kind -> Con) -> f Kind -> f Con
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Set Name -> (Name -> f Name) -> Kind -> f Kind
forall t. HasTypeVars t => Set Name -> Traversal' t Name
typeVarsEx Set Name
s Name -> f Name
f Kind
retTy
typeVarsEx s :: Set Name
s f :: Name -> f Name
f (RecGadtC ns :: [Name]
ns argTys :: [VarBangType]
argTys retTy :: Kind
retTy) =
[Name] -> [VarBangType] -> Kind -> Con
RecGadtC [Name]
ns ([VarBangType] -> Kind -> Con)
-> f [VarBangType] -> f (Kind -> 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])
-> ((Kind -> f Kind) -> VarBangType -> f VarBangType)
-> (Kind -> f Kind)
-> [VarBangType]
-> f [VarBangType]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Kind -> f Kind) -> VarBangType -> f VarBangType
forall s t a b. Field3 s t a b => Lens s t a b
_3) (Set Name -> (Name -> f Name) -> Kind -> f Kind
forall t. HasTypeVars t => Set Name -> Traversal' t Name
typeVarsEx Set Name
s Name -> f Name
f) [VarBangType]
argTys
f (Kind -> Con) -> f Kind -> f Con
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Set Name -> (Name -> f Name) -> Kind -> f Kind
forall t. HasTypeVars t => Set Name -> Traversal' t Name
typeVarsEx Set Name
s Name -> f Name
f Kind
retTy
#endif
instance HasTypeVars t => HasTypeVars [t] where
typeVarsEx :: Set Name -> Traversal' [t] Name
typeVarsEx s :: 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 s :: 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 m :: 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
$ \n :: 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 methodName :: 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 -> Kind
conAppsT conName :: Name
conName = (Kind -> Kind -> Kind) -> Kind -> Cxt -> Kind
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Kind -> Kind -> Kind
AppT (Name -> Kind
ConT Name
conName)
quantifyType :: Cxt -> Type -> Type
quantifyType :: Cxt -> Kind -> Kind
quantifyType = Set Name -> Cxt -> Kind -> Kind
quantifyType' Set Name
forall a. Set a
Set.empty
quantifyType' :: Set Name -> Cxt -> Type -> Type
quantifyType' :: Set Name -> Cxt -> Kind -> Kind
quantifyType' exclude :: Set Name
exclude c :: Cxt
c t :: Kind
t = [TyVarBndr] -> Cxt -> Kind -> Kind
ForallT [TyVarBndr]
vs Cxt
c Kind
t
where
vs :: [TyVarBndr]
vs = (Name -> TyVarBndr) -> [Name] -> [TyVarBndr]
forall a b. (a -> b) -> [a] -> [b]
map Name -> TyVarBndr
PlainTV
([Name] -> [TyVarBndr]) -> [Name] -> [TyVarBndr]
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]) Kind Name -> Kind -> [Name]
forall a s. Getting (Endo [a]) s a -> s -> [a]
toListOf Getting (Endo [Name]) Kind Name
forall t. HasTypeVars t => Traversal' t Name
typeVars Kind
t
elemOf :: Eq a => Getting (Endo [a]) s a -> a -> s -> Bool
elemOf :: Getting (Endo [a]) s a -> a -> s -> Bool
elemOf l :: Getting (Endo [a]) s a
l x :: a
x s :: 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 l :: Getting (Endo [a]) s a
l s :: 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 l :: Getting (Endo [a]) s a
l s :: 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 ([TyVarBndr], Cxt, Type)
_ForallT :: (([TyVarBndr], Cxt, Kind) -> f ([TyVarBndr], Cxt, Kind))
-> Kind -> f Kind
_ForallT f :: ([TyVarBndr], Cxt, Kind) -> f ([TyVarBndr], Cxt, Kind)
f (ForallT a :: [TyVarBndr]
a b :: Cxt
b c :: Kind
c) = (\(x :: [TyVarBndr]
x, y :: Cxt
y, z :: Kind
z) -> [TyVarBndr] -> Cxt -> Kind -> Kind
ForallT [TyVarBndr]
x Cxt
y Kind
z) (([TyVarBndr], Cxt, Kind) -> Kind)
-> f ([TyVarBndr], Cxt, Kind) -> f Kind
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([TyVarBndr], Cxt, Kind) -> f ([TyVarBndr], Cxt, Kind)
f ([TyVarBndr]
a, Cxt
b, Kind
c)
_ForallT _ other :: Kind
other = Kind -> f Kind
forall (f :: * -> *) a. Applicative f => a -> f a
pure Kind
other