    {-# LANGUAGE CPP #-}
    {-# LANGUAGE NoMonomorphismRestriction #-}
    module Language.Haskell.TH.ExpandSyns(-- * Expand synonyms
                                          expandSyns
                                         ,expandSynsWith
                                         ,SynonymExpansionSettings
                                         ,noWarnTypeFamilies

                                          -- * Misc utilities
                                         ,substInType
                                         ,substInCon
                                         ,evades,evade) where

    import Language.Haskell.TH.Datatype
    import Language.Haskell.TH.Datatype.TyVarBndr
    import Language.Haskell.TH hiding(cxt)
    import qualified Data.Map as Map
    import Data.Map (Map)
    import Data.Semigroup as Sem
    import qualified Data.Set as Set
    import Data.Generics
    import Control.Monad
    import Prelude

    packagename :: String
    packagename :: String
    packagename = String
    "th-expand-syns"

    tyVarBndrSetName :: Name -> TyVarBndr_ flag -> TyVarBndr_ flag
    tyVarBndrSetName :: forall flag. Name -> TyVarBndr_ flag -> TyVarBndr_ flag
    tyVarBndrSetName Name
    n = (Name -> Name) -> TyVarBndr_ flag -> TyVarBndr_ flag
    forall flag. (Name -> Name) -> TyVarBndr_ flag -> TyVarBndr_ flag
    mapTVName (Name -> Name -> Name
    forall a b. a -> b -> a
    const Name
    n)

    data SynonymExpansionSettings =
      SynonymExpansionSettings {
        SynonymExpansionSettings -> Bool
    sesWarnTypeFamilies :: Bool
      }

    instance Semigroup SynonymExpansionSettings where
      SynonymExpansionSettings Bool
    w1 <> :: SynonymExpansionSettings
    -> SynonymExpansionSettings -> SynonymExpansionSettings
    <> SynonymExpansionSettings Bool
    w2 =
        Bool -> SynonymExpansionSettings
    SynonymExpansionSettings (Bool
    w1 Bool -> Bool -> Bool
    && Bool
    w2)

    -- | Default settings ('mempty'):
    --
    -- * Warn if type families are encountered.
    --
    -- (The 'mappend' is currently rather useless; the monoid instance is intended for additional settings in the future).
    instance Monoid SynonymExpansionSettings where
      mempty :: SynonymExpansionSettings
    mempty =
        SynonymExpansionSettings {
          sesWarnTypeFamilies :: Bool
    sesWarnTypeFamilies = Bool
    True
        }

    #if !MIN_VERSION_base(4,11,0)
    -- starting with base-4.11, mappend definitions are redundant;
    -- at some point `mappend` will be removed from `Monoid`
      mappend = (Sem.<>)
    #endif

    -- | Suppresses the warning that type families are unsupported.
    noWarnTypeFamilies :: SynonymExpansionSettings
    noWarnTypeFamilies :: SynonymExpansionSettings
    noWarnTypeFamilies = SynonymExpansionSettings
    forall a. Monoid a => a
    mempty { sesWarnTypeFamilies = False }

    warn ::  String -> Q ()
    warn :: String -> Q ()
    warn String
    msg = String -> Q ()
    reportWarning (String
    packagename String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++String
    ": WARNING: "String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++String
    msg)

    warnIfNameIsTypeFamily :: Name -> Q ()
    warnIfNameIsTypeFamily :: Name -> Q ()
    warnIfNameIsTypeFamily Name
    n = do
      i <- Name -> Q Info
    reify Name
    n
      case i of
        ClassI {} -> () -> Q ()
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        ClassOpI {} -> () -> Q ()
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        TyConI Dec
    d -> Dec -> Q ()
    warnIfDecIsTypeFamily Dec
    d
        FamilyI Dec
    d [Dec]
    _ -> Dec -> Q ()
    warnIfDecIsTypeFamily Dec
    d -- Called for warnings
        PrimTyConI {} -> () -> Q ()
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        DataConI {} -> () -> Q ()
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        VarI {} -> () -> Q ()
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        TyVarI {} -> () -> Q ()
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
    #if MIN_VERSION_template_haskell(2,12,0)
        PatSynI {} -> () -> Q ()
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
    #endif

    warnIfDecIsTypeFamily :: Dec -> Q ()
    warnIfDecIsTypeFamily :: Dec -> Q ()
    warnIfDecIsTypeFamily = Dec -> Q ()
    go
      where
        go :: Dec -> Q ()
    go (TySynD {}) = () -> Q ()
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        go (OpenTypeFamilyD (TypeFamilyHead Name
    name [TyVarBndr BndrVis]
    _ FamilyResultSig
    _ Maybe InjectivityAnn
    _)) = Name -> Q ()
    maybeWarnTypeFamily Name
    name
        go (ClosedTypeFamilyD (TypeFamilyHead Name
    name [TyVarBndr BndrVis]
    _ FamilyResultSig
    _ Maybe InjectivityAnn
    _) [TySynEqn]
    _) = Name -> Q ()
    maybeWarnTypeFamily Name
    name
        go (FunD {}) = () -> Q ()
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        go (ValD {}) = () -> Q ()
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        go (DataD {}) = () -> Q ()
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        go (NewtypeD {}) = () -> Q ()
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        go (ClassD {}) = () -> Q ()
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        go (InstanceD {}) = () -> Q ()
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        go (SigD {}) = () -> Q ()
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        go (ForeignD {}) = () -> Q ()
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        go (InfixD {}) = () -> Q ()
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        go (PragmaD {}) = () -> Q ()
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        -- Nothing to expand for data families, so no warning
        go (DataFamilyD {}) = () -> Q ()
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        go (DataInstD {}) = () -> Q ()
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        go (NewtypeInstD {}) = () -> Q ()
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        go (TySynInstD {}) = () -> Q ()
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        go (RoleAnnotD {}) = () -> Q ()
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        go (StandaloneDerivD {}) = () -> Q ()
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        go (DefaultSigD {}) = () -> Q ()
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    #if MIN_VERSION_template_haskell(2,12,0)
        go (PatSynD {}) = () -> Q ()
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        go (PatSynSigD {}) = () -> Q ()
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
    #endif

    #if MIN_VERSION_template_haskell(2,15,0)
        go (ImplicitParamBindD {}) = () -> Q ()
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
    #endif

    #if MIN_VERSION_template_haskell(2,16,0)
        go (KiSigD {}) = () -> Q ()
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
    #endif

    #if MIN_VERSION_template_haskell(2,19,0)
        go (DefaultD {}) = () -> Q ()
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
    #endif

    #if MIN_VERSION_template_haskell(2,20,0)
        go (TypeDataD {}) = () -> Q ()
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
    #endif

    warnTypeFamiliesInType :: Type -> Q ()
    warnTypeFamiliesInType :: Type -> Q ()
    warnTypeFamiliesInType = Type -> Q ()
    go
      where
        go :: Type -> Q ()
        go :: Type -> Q ()
    go (ConT Name
    n)     = Name -> Q ()
    warnIfNameIsTypeFamily Name
    n
        go (AppT Type
    t1 Type
    t2) = Type -> Q ()
    go Type
    t1 Q () -> Q () -> Q ()
    forall a b. Q a -> Q b -> Q b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Type -> Q ()
    go Type
    t2
        go (SigT Type
    t Type
    k)   = Type -> Q ()
    go Type
    t  Q () -> Q () -> Q ()
    forall a b. Q a -> Q b -> Q b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Type -> Q ()
    go Type
    k
        go ListT{}      = () -> Q ()
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        go ArrowT{}     = () -> Q ()
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        go VarT{}       = () -> Q ()
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        go TupleT{}     = () -> Q ()
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        go (ForallT [TyVarBndr Specificity]
    tvbs Cxt
    ctxt Type
    body) = do
          (TyVarBndr Specificity -> Q ()) -> [TyVarBndr Specificity] -> Q ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (Type -> Q ()
    go (Type -> Q ())
    -> (TyVarBndr Specificity -> Type) -> TyVarBndr Specificity -> Q ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TyVarBndr Specificity -> Type
    forall flag. TyVarBndr_ flag -> Type
    tvKind) [TyVarBndr Specificity]
    tvbs
          (Type -> Q ()) -> Cxt -> Q ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ Type -> Q ()
    go Cxt
    ctxt
          Type -> Q ()
    go Type
    body
        go UnboxedTupleT{} = () -> Q ()
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        go PromotedT{}      = () -> Q ()
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        go PromotedTupleT{} = () -> Q ()
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        go PromotedConsT{}  = () -> Q ()
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        go PromotedNilT{}   = () -> Q ()
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        go StarT{}          = () -> Q ()
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        go ConstraintT{}    = () -> Q ()
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        go LitT{}           = () -> Q ()
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        go EqualityT{} = () -> Q ()
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        go (InfixT Type
    t1 Name
    n Type
    t2) = do
          Name -> Q ()
    warnIfNameIsTypeFamily Name
    n
          Type -> Q ()
    go Type
    t1
          Type -> Q ()
    go Type
    t2
        go (UInfixT Type
    t1 Name
    n Type
    t2) = do
          Name -> Q ()
    warnIfNameIsTypeFamily Name
    n
          Type -> Q ()
    go Type
    t1
          Type -> Q ()
    go Type
    t2
        go (ParensT Type
    t) = Type -> Q ()
    go Type
    t
        go WildCardT{} = () -> Q ()
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
    #if MIN_VERSION_template_haskell(2,12,0)
        go UnboxedSumT{} = () -> Q ()
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
    #endif
    #if MIN_VERSION_template_haskell(2,15,0)
        go (AppKindT Type
    t Type
    k)       = Type -> Q ()
    go Type
    t Q () -> Q () -> Q ()
    forall a b. Q a -> Q b -> Q b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Type -> Q ()
    go Type
    k
        go (ImplicitParamT String
    _ Type
    t) = Type -> Q ()
    go Type
    t
    #endif
    #if MIN_VERSION_template_haskell(2,16,0)
        go (ForallVisT [TyVarBndr ()]
    tvbs Type
    body) = do
          (TyVarBndr () -> Q ()) -> [TyVarBndr ()] -> Q ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (Type -> Q ()
    go (Type -> Q ()) -> (TyVarBndr () -> Type) -> TyVarBndr () -> Q ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TyVarBndr () -> Type
    forall flag. TyVarBndr_ flag -> Type
    tvKind) [TyVarBndr ()]
    tvbs
          Type -> Q ()
    go Type
    body
    #endif
    #if MIN_VERSION_template_haskell(2,17,0)
        go MulArrowT{} = () -> Q ()
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
    #endif
    #if MIN_VERSION_template_haskell(2,19,0)
        go (PromotedInfixT Type
    t1 Name
    n Type
    t2) = do
          Name -> Q ()
    warnIfNameIsTypeFamily Name
    n
          Type -> Q ()
    go Type
    t1
          Type -> Q ()
    go Type
    t2
        go (PromotedUInfixT Type
    t1 Name
    n Type
    t2) = do
          Name -> Q ()
    warnIfNameIsTypeFamily Name
    n
          Type -> Q ()
    go Type
    t1
          Type -> Q ()
    go Type
    t2
    #endif

    maybeWarnTypeFamily :: Name -> Q ()
    maybeWarnTypeFamily :: Name -> Q ()
    maybeWarnTypeFamily Name
    name =
      String -> Q ()
    warn (String
    "Type synonym families (and associated type synonyms) are currently not supported (they won't be expanded). Name of unsupported family: "String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++Name -> String
    forall a. Show a => a -> String
    show Name
    name)

    -- | Calls 'expandSynsWith' with the default settings.
    expandSyns :: Type -> Q Type
    expandSyns :: Type -> Q Type
    expandSyns = SynonymExpansionSettings -> Type -> Q Type
    expandSynsWith SynonymExpansionSettings
    forall a. Monoid a => a
    mempty

    -- | Expands all type synonyms in the given type. Type families currently won't be expanded (but will be passed through).
    expandSynsWith :: SynonymExpansionSettings -> Type -> Q Type
    expandSynsWith :: SynonymExpansionSettings -> Type -> Q Type
    expandSynsWith SynonymExpansionSettings
    settings = Type -> Q Type
    expandSyns'
        where
          expandSyns' :: Type -> Q Type
    expandSyns' Type
    x = do
            Bool -> Q () -> Q ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (SynonymExpansionSettings -> Bool
    sesWarnTypeFamilies SynonymExpansionSettings
    settings) (Q () -> Q ()) -> Q () -> Q ()
    forall a b. (a -> b) -> a -> b
    $
              Type -> Q ()
    warnTypeFamiliesInType Type
    x
            Type -> Q Type
    resolveTypeSynonyms Type
    x

    -- | Make a name (based on the first arg) that's distinct from every name in the second arg
    --
    -- Example why this is necessary:
    --
    -- > type E x = forall y. Either x y
    -- >
    -- > ... expandSyns [t| forall y. y -> E y |]
    --
    -- The example as given may actually work correctly without any special capture-avoidance depending
    -- on how GHC handles the @y@s, but in any case, the input type to expandSyns may be an explicit
    -- AST using 'mkName' to ensure a collision.
    --
    evade :: Data d => Name -> d -> Name
    evade :: forall d. Data d => Name -> d -> Name
    evade Name
    n d
    t =
        let
            vars :: Set.Set Name
            vars :: Set Name
    vars = (Set Name -> Set Name -> Set Name)
    -> GenericQ (Set Name) -> GenericQ (Set Name)
    forall r. (r -> r -> r) -> GenericQ r -> GenericQ r
    everything Set Name -> Set Name -> Set Name
    forall a. Ord a => Set a -> Set a -> Set a
    Set.union (Set Name -> (Name -> Set Name) -> a -> Set Name
    forall a b r. (Typeable a, Typeable b) => r -> (b -> r) -> a -> r
    mkQ Set Name
    forall a. Set a
    Set.empty Name -> Set Name
    forall a. a -> Set a
    Set.singleton) d
    t

            go :: Name -> Name
    go Name
    n1 = if Name
    n1 Name -> Set Name -> Bool
    forall a. Ord a => a -> Set a -> Bool
    `Set.member` Set Name
    vars
                    then Name -> Name
    go (Name -> Name
    bump Name
    n1)
                    else Name
    n1

            bump :: Name -> Name
    bump = String -> Name
    mkName (String -> Name) -> (Name -> String) -> Name -> Name
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char
    'f'Char -> String -> String
    forall a. a -> [a] -> [a]
    :) (String -> String) -> (Name -> String) -> Name -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> String
    nameBase
        in
          Name -> Name
    go Name
    n

    -- | Make a list of names (based on the first arg) such that every name in the result
    -- is distinct from every name in the second arg, and from the other results
    evades :: (Data t) => [Name] -> t -> [Name]
    evades :: forall t. Data t => [Name] -> t -> [Name]
    evades [Name]
    ns t
    t = (Name -> [Name] -> [Name]) -> [Name] -> [Name] -> [Name]
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr Name -> [Name] -> [Name]
    c [] [Name]
    ns
        where
          c :: Name -> [Name] -> [Name]
    c Name
    n [Name]
    rec = Name -> ([Name], t) -> Name
    forall d. Data d => Name -> d -> Name
    evade Name
    n ([Name]
    rec,t
    t) Name -> [Name] -> [Name]
    forall a. a -> [a] -> [a]
    : [Name]
    rec

    -- evadeTest = let v = mkName "x"
    --             in
    --               evade v (AppT (VarT v) (VarT (mkName "fx")))

    -- | Capture-free substitution
    substInType :: (Name,Type) -> Type -> Type
    substInType :: (Name, Type) -> Type -> Type
    substInType (Name, Type)
    vt = Map Name Type -> Type -> Type
    forall a. TypeSubstitution a => Map Name Type -> a -> a
    applySubstitution ([(Name, Type)] -> Map Name Type
    forall k a. Ord k => [(k, a)] -> Map k a
    Map.fromList [(Name, Type)
    vt])

    -- | Capture-free substitution
    substInCon :: (Name,Type) -> Con -> Con
    substInCon :: (Name, Type) -> Con -> Con
    substInCon (Name, Type)
    vt = Con -> Con
    go
        where
          vtSubst :: Map Name Type
    vtSubst = [(Name, Type)] -> Map Name Type
    forall k a. Ord k => [(k, a)] -> Map k a
    Map.fromList [(Name, Type)
    vt]
          st :: a -> a
    st = Map Name Type -> a -> a
    forall a. TypeSubstitution a => Map Name Type -> a -> a
    applySubstitution Map Name Type
    vtSubst

          go :: Con -> Con
    go (NormalC Name
    n [BangType]
    ts) = Name -> [BangType] -> Con
    NormalC Name
    n [(Bang
    x, Type -> Type
    forall {a}. TypeSubstitution a => a -> a
    st Type
    y) | (Bang
    x,Type
    y) <- [BangType]
    ts]
          go (RecC Name
    n [VarBangType]
    ts) = Name -> [VarBangType] -> Con
    RecC Name
    n [(Name
    x, Bang
    y, Type -> Type
    forall {a}. TypeSubstitution a => a -> a
    st Type
    z) | (Name
    x,Bang
    y,Type
    z) <- [VarBangType]
    ts]
          go (InfixC (Bang
    y1,Type
    t1) Name
    op (Bang
    y2,Type
    t2)) = BangType -> Name -> BangType -> Con
    InfixC (Bang
    y1,Type -> Type
    forall {a}. TypeSubstitution a => a -> a
    st Type
    t1) Name
    op (Bang
    y2,Type -> Type
    forall {a}. TypeSubstitution a => a -> a
    st Type
    t2)
          go (ForallC [TyVarBndr Specificity]
    vars Cxt
    cxt Con
    body) =
              (Name, Type)
    -> [TyVarBndr Specificity]
    -> (Map Name Type -> [TyVarBndr Specificity] -> Con)
    -> Con
    forall flag a.
    (Name, Type)
    -> [TyVarBndr_ flag]
    -> (Map Name Type -> [TyVarBndr_ flag] -> a)
    -> a
    commonForallCase (Name, Type)
    vt [TyVarBndr Specificity]
    vars ((Map Name Type -> [TyVarBndr Specificity] -> Con) -> Con)
    -> (Map Name Type -> [TyVarBndr Specificity] -> Con) -> Con
    forall a b. (a -> b) -> a -> b
    $ \Map Name Type
    vts' [TyVarBndr Specificity]
    vars' ->
              [TyVarBndr Specificity] -> Cxt -> Con -> Con
    ForallC ((TyVarBndr Specificity -> TyVarBndr Specificity)
    -> [TyVarBndr Specificity] -> [TyVarBndr Specificity]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Type -> Type) -> TyVarBndr Specificity -> TyVarBndr Specificity
    forall flag. (Type -> Type) -> TyVarBndr_ flag -> TyVarBndr_ flag
    mapTVKind (Map Name Type -> Type -> Type
    forall a. TypeSubstitution a => Map Name Type -> a -> a
    applySubstitution Map Name Type
    vts')) [TyVarBndr Specificity]
    vars')
                      (Map Name Type -> Cxt -> Cxt
    forall a. TypeSubstitution a => Map Name Type -> a -> a
    applySubstitution Map Name Type
    vts' Cxt
    cxt)
                      ((Name -> Type -> Con -> Con) -> Con -> Map Name Type -> Con
    forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
    Map.foldrWithKey (\Name
    v Type
    t -> (Name, Type) -> Con -> Con
    substInCon (Name
    v, Type
    t)) Con
    body Map Name Type
    vts')
          go c :: Con
    c@GadtC{} = Con -> Con
    forall {a} {a}. Ppr a => a -> a
    errGadt Con
    c
          go c :: Con
    c@RecGadtC{} = Con -> Con
    forall {a} {a}. Ppr a => a -> a
    errGadt Con
    c

          errGadt :: a -> a
    errGadt a
    c = String -> a
    forall a. HasCallStack => String -> a
    error (String
    packagenameString -> String -> String
    forall a. [a] -> [a] -> [a]
    ++String
    ": substInCon currently doesn't support GADT constructors with GHC >= 8 ("String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++a -> String
    forall a. Ppr a => a -> String
    pprint a
    cString -> String -> String
    forall a. [a] -> [a] -> [a]
    ++String
    ")")

    -- Apply a substitution to something underneath a @forall@. The continuation
    -- argument provides new substitutions and fresh type variable binders to avoid
    -- the outer substitution from capturing the thing underneath the @forall@.
    commonForallCase :: (Name, Type) -> [TyVarBndr_ flag]
                     -> (Map Name Type -> [TyVarBndr_ flag] -> a)
                     -> a
    commonForallCase :: forall flag a.
    (Name, Type)
    -> [TyVarBndr_ flag]
    -> (Map Name Type -> [TyVarBndr_ flag] -> a)
    -> a
    commonForallCase vt :: (Name, Type)
    vt@(Name
    v,Type
    t) [TyVarBndr_ flag]
    bndrs Map Name Type -> [TyVarBndr_ flag] -> a
    k
                -- If a variable with the same name as the one to be replaced is bound by the forall,
                -- the variable to be replaced is shadowed in the body, so we leave the whole thing alone (no recursion)
              | Name
    v Name -> [Name] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` (TyVarBndr_ flag -> Name
    forall flag. TyVarBndr_ flag -> Name
    tvName (TyVarBndr_ flag -> Name) -> [TyVarBndr_ flag] -> [Name]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [TyVarBndr_ flag]
    bndrs) = Map Name Type -> [TyVarBndr_ flag] -> a
    k ([(Name, Type)] -> Map Name Type
    forall k a. Ord k => [(k, a)] -> Map k a
    Map.fromList [(Name, Type)
    vt]) [TyVarBndr_ flag]
    bndrs

              | Bool
    otherwise =
                  let
                      -- prevent capture
                      vars :: [Name]
    vars = TyVarBndr_ flag -> Name
    forall flag. TyVarBndr_ flag -> Name
    tvName (TyVarBndr_ flag -> Name) -> [TyVarBndr_ flag] -> [Name]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [TyVarBndr_ flag]
    bndrs
                      freshes :: [Name]
    freshes = [Name] -> Type -> [Name]
    forall t. Data t => [Name] -> t -> [Name]
    evades [Name]
    vars Type
    t
                      freshTyVarBndrs :: [TyVarBndr_ flag]
    freshTyVarBndrs = (Name -> TyVarBndr_ flag -> TyVarBndr_ flag)
    -> [Name] -> [TyVarBndr_ flag] -> [TyVarBndr_ flag]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith Name -> TyVarBndr_ flag -> TyVarBndr_ flag
    forall flag. Name -> TyVarBndr_ flag -> TyVarBndr_ flag
    tyVarBndrSetName [Name]
    freshes [TyVarBndr_ flag]
    bndrs
                      substs :: [(Name, Type)]
    substs = [Name] -> Cxt -> [(Name, Type)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Name]
    vars (Name -> Type
    VarT (Name -> Type) -> [Name] -> Cxt
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Name]
    freshes)
                  in
                    Map Name Type -> [TyVarBndr_ flag] -> a
    k ([(Name, Type)] -> Map Name Type
    forall k a. Ord k => [(k, a)] -> Map k a
    Map.fromList ((Name, Type)
    vt(Name, Type) -> [(Name, Type)] -> [(Name, Type)]
    forall a. a -> [a] -> [a]
    :[(Name, Type)]
    substs)) [TyVarBndr_ flag]
    freshTyVarBndrs