    {-# LANGUAGE CPP, TemplateHaskell #-}
    module Language.Haskell.TH.Extras where

    import Control.Monad
    import Data.Generics
    import Data.Maybe
    import Data.Set (Set)
    import qualified Data.Set as Set
    import Language.Haskell.TH
    import Language.Haskell.TH.Syntax
    import Language.Haskell.TH.Datatype.TyVarBndr

    intIs64 :: Bool
    intIs64 :: Bool
    intIs64 = Int -> Integer
    forall a. Integral a => a -> Integer
    toInteger (Int
    forall a. Bounded a => a
    maxBound :: Int) Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    > Integer
    2Integer -> Integer -> Integer
    forall a b. (Num a, Integral b) => a -> b -> a
    ^(Integer
    32 :: Integer)

    replace :: (a -> Maybe a) -> (a -> a)
    replace :: forall a. (a -> Maybe a) -> a -> a
    replace = (a -> Maybe a -> a) -> (a -> Maybe a) -> a -> a
    forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
    ap a -> Maybe a -> a
    forall a. a -> Maybe a -> a
    fromMaybe

    composeExprs :: [ExpQ] -> ExpQ
    composeExprs :: [ExpQ] -> ExpQ
    composeExprs [] = [| id |]
    composeExprs [ExpQ
    f] = ExpQ
    f
    composeExprs (ExpQ
    f:[ExpQ]
    fs) = [| $ExpQ
    f . $([ExpQ] -> ExpQ
    composeExprs [ExpQ]
    fs) |]

    -- | Determines the name of a data constructor. It's an error if the 'Con' binds more than one name (which
    -- happens in the case where you use GADT syntax, and give multiple data constructor names separated by commas
    -- in a type signature in the where clause).
    nameOfCon :: Con -> Name
    nameOfCon :: Con -> Name
    nameOfCon (NormalC  Name
    name [BangType]
    _) = Name
    name
    nameOfCon (RecC     Name
    name [VarBangType]
    _) = Name
    name
    nameOfCon (InfixC BangType
    _ Name
    name BangType
    _) = Name
    name
    nameOfCon (ForallC [TyVarBndr Specificity]
    _ Cxt
    _ Con
    con) = Con -> Name
    nameOfCon Con
    con
    #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 800
    nameOfCon (GadtC [Name
    name] [BangType]
    _ Type
    _)    = Name
    name
    nameOfCon (GadtC [Name]
    _ [BangType]
    _ Type
    _)    = [Char] -> Name
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> Name) -> [Char] -> Name
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "nameOfCon: GadtC: only single constructor names are supported"
    nameOfCon (RecGadtC [Name
    name] [VarBangType]
    _ Type
    _) = Name
    name
    nameOfCon (RecGadtC [Name]
    _ [VarBangType]
    _ Type
    _)    = [Char] -> Name
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> Name) -> [Char] -> Name
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "nameOfCon: RecGadtC: only single constructor names are supported"
    #endif

    -- |WARNING: discards binders in GADTs and existentially-quantified constructors
    argTypesOfCon :: Con -> [Type]
    argTypesOfCon :: Con -> Cxt
    argTypesOfCon (NormalC  Name
    _ [BangType]
    args) = (BangType -> Type) -> [BangType] -> Cxt
    forall a b. (a -> b) -> [a] -> [b]
    map BangType -> Type
    forall a b. (a, b) -> b
    snd [BangType]
    args
    argTypesOfCon (RecC     Name
    _ [VarBangType]
    args) = [Type
    t | (Name
    _,Bang
    _,Type
    t) <- [VarBangType]
    args]
    argTypesOfCon (InfixC BangType
    x Name
    _ BangType
    y)    = (BangType -> Type) -> [BangType] -> Cxt
    forall a b. (a -> b) -> [a] -> [b]
    map BangType -> Type
    forall a b. (a, b) -> b
    snd [BangType
    x,BangType
    y]
    argTypesOfCon (ForallC [TyVarBndr Specificity]
    _ Cxt
    _ Con
    con) = Con -> Cxt
    argTypesOfCon Con
    con
    #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 800
    argTypesOfCon (GadtC [Name]
    _ [BangType]
    args Type
    _)    = (BangType -> Type) -> [BangType] -> Cxt
    forall a b. (a -> b) -> [a] -> [b]
    map BangType -> Type
    forall a b. (a, b) -> b
    snd [BangType]
    args
    argTypesOfCon (RecGadtC [Name]
    _ [VarBangType]
    args Type
    _) = [Type
    t | (Name
    _,Bang
    _,Type
    t) <- [VarBangType]
    args]
    #endif

    nameOfBinder :: TyVarBndr_ a -> Name
    nameOfBinder :: forall a. TyVarBndr_ a -> Name
    nameOfBinder = TyVarBndr_ a -> Name
    forall a. TyVarBndr_ a -> Name
    tvName

    varsBoundInCon :: Con -> [TyVarBndrSpec]
    varsBoundInCon :: Con -> [TyVarBndr Specificity]
    varsBoundInCon (ForallC [TyVarBndr Specificity]
    bndrs Cxt
    _ Con
    con) = [TyVarBndr Specificity]
    bndrs [TyVarBndr Specificity]
    -> [TyVarBndr Specificity] -> [TyVarBndr Specificity]
    forall a. [a] -> [a] -> [a]
    ++ Con -> [TyVarBndr Specificity]
    varsBoundInCon Con
    con
    varsBoundInCon Con
    _ = []

    namesBoundInPat :: Pat -> [Name]
    namesBoundInPat :: Pat -> [Name]
    namesBoundInPat (VarP Name
    name)             = [Name
    name]
    namesBoundInPat (TupP [Pat]
    pats)             = [Pat]
    pats [Pat] -> (Pat -> [Name]) -> [Name]
    forall a b. [a] -> (a -> [b]) -> [b]
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Pat -> [Name]
    namesBoundInPat
    #if MIN_VERSION_template_haskell(2,18,0)
    namesBoundInPat (ConP Name
    _ Cxt
    _ [Pat]
    pats)         = [Pat]
    pats [Pat] -> (Pat -> [Name]) -> [Name]
    forall a b. [a] -> (a -> [b]) -> [b]
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Pat -> [Name]
    namesBoundInPat
    #else
    namesBoundInPat (ConP _ pats)           = pats >>= namesBoundInPat
    #endif
    namesBoundInPat (InfixP Pat
    p1 Name
    _ Pat
    p2)        = Pat -> [Name]
    namesBoundInPat Pat
    p1 [Name] -> [Name] -> [Name]
    forall a. [a] -> [a] -> [a]
    ++ Pat -> [Name]
    namesBoundInPat Pat
    p2
    namesBoundInPat (TildeP Pat
    pat)            = Pat -> [Name]
    namesBoundInPat Pat
    pat
    namesBoundInPat (AsP Name
    name Pat
    pat)          = Name
    name Name -> [Name] -> [Name]
    forall a. a -> [a] -> [a]
    : Pat -> [Name]
    namesBoundInPat Pat
    pat
    namesBoundInPat (RecP Name
    _ [FieldPat]
    fieldPats)      = (FieldPat -> Pat) -> [FieldPat] -> [Pat]
    forall a b. (a -> b) -> [a] -> [b]
    map FieldPat -> Pat
    forall a b. (a, b) -> b
    snd [FieldPat]
    fieldPats [Pat] -> (Pat -> [Name]) -> [Name]
    forall a b. [a] -> (a -> [b]) -> [b]
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Pat -> [Name]
    namesBoundInPat
    namesBoundInPat (ListP [Pat]
    pats)            = [Pat]
    pats [Pat] -> (Pat -> [Name]) -> [Name]
    forall a b. [a] -> (a -> [b]) -> [b]
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Pat -> [Name]
    namesBoundInPat
    namesBoundInPat (SigP Pat
    pat Type
    _)            = Pat -> [Name]
    namesBoundInPat Pat
    pat

    #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 612
    namesBoundInPat (BangP Pat
    pat)             = Pat -> [Name]
    namesBoundInPat Pat
    pat
    #endif

    #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 700
    namesBoundInPat (ViewP Exp
    _ Pat
    pat)           = Pat -> [Name]
    namesBoundInPat Pat
    pat
    #endif

    #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702
    namesBoundInPat (UnboxedTupP [Pat]
    pats)      = [Pat]
    pats [Pat] -> (Pat -> [Name]) -> [Name]
    forall a b. [a] -> (a -> [b]) -> [b]
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Pat -> [Name]
    namesBoundInPat
    #endif

    namesBoundInPat Pat
    _                       = []

    namesBoundInDec :: Dec -> [Name]
    namesBoundInDec :: Dec -> [Name]
    namesBoundInDec (FunD Name
    name [Clause]
    _)                       = [Name
    name]
    namesBoundInDec (ValD Pat
    pat Body
    _ [Dec]
    _)                      = Pat -> [Name]
    namesBoundInPat Pat
    pat

    #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 800
    namesBoundInDec (DataD Cxt
    _ Name
    name [TyVarBndr ()]
    _ Maybe Type
    _ [Con]
    _ [DerivClause]
    _)              = [Name
    name]
    namesBoundInDec (NewtypeD Cxt
    _ Name
    name [TyVarBndr ()]
    _ Maybe Type
    _ Con
    _ [DerivClause]
    _)           = [Name
    name]
    #else
    namesBoundInDec (DataD _ name _ _ _)                = [name]
    namesBoundInDec (NewtypeD _ name _ _ _)             = [name]
    #endif

    namesBoundInDec (TySynD Name
    name [TyVarBndr ()]
    _ Type
    _)                   = [Name
    name]
    namesBoundInDec (ClassD Cxt
    _ Name
    name [TyVarBndr ()]
    _ [FunDep]
    _ [Dec]
    _)               = [Name
    name]
    namesBoundInDec (ForeignD (ImportF Callconv
    _ Safety
    _ [Char]
    _ Name
    name Type
    _))   = [Name
    name]

    #if defined(__GLASGOW_HASKELL__)
    #if __GLASGOW_HASKELL__ >= 800
    namesBoundInDec (OpenTypeFamilyD (TypeFamilyHead Name
    name [TyVarBndr ()]
    _ FamilyResultSig
    _ Maybe InjectivityAnn
    _))     = [Name
    name]
    namesBoundInDec (ClosedTypeFamilyD (TypeFamilyHead Name
    name [TyVarBndr ()]
    _ FamilyResultSig
    _ Maybe InjectivityAnn
    _) [TySynEqn]
    _) = [Name
    name]
    #elif __GLASGOW_HASKELL__ >= 612
    namesBoundInDec (FamilyD _ name _ _)                = [name]
    #endif
    #endif

    namesBoundInDec Dec
    _                                   = []

    genericalizeName :: Name -> Name
    genericalizeName :: Name -> Name
    genericalizeName = [Char] -> Name
    mkName ([Char] -> Name) -> (Name -> [Char]) -> Name -> Name
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> [Char]
    nameBase

    -- Genericalize all names defined at the top level, to fix the lunacy introduced in GHC 7.2.
    -- Why they should be fresh is beyond me; it really seems absurd because there is no way whatsoever
    -- to refer to names known to be bound in [d||] quotes other than to scrounge around inside the
    -- generated 'Dec's.
    genericalizeDecs :: [Dec] -> [Dec]
    genericalizeDecs :: [Dec] -> [Dec]
    genericalizeDecs [Dec]
    decs = (forall a. Data a => a -> a) -> forall a. Data a => a -> a
    everywhere ((Name -> Name) -> a -> a
    forall a b. (Typeable a, Typeable b) => (b -> b) -> a -> a
    mkT Name -> Name
    fixName) [Dec]
    decs
        where
            -- get all names bound in the decs and make them generic
            -- at every occurrence in decs.
            names :: [Name]
    names = [Dec]
    decs [Dec] -> (Dec -> [Name]) -> [Name]
    forall a b. [a] -> (a -> [b]) -> [b]
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Dec -> [Name]
    namesBoundInDec
            genericalizedNames :: [(Name, Name)]
    genericalizedNames = [ (Name
    n, Name -> Name
    genericalizeName Name
    n) | Name
    n <- [Name]
    names]
            fixName :: Name -> Name
    fixName = (Name -> Maybe Name) -> Name -> Name
    forall a. (a -> Maybe a) -> a -> a
    replace (Name -> [(Name, Name)] -> Maybe Name
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    `lookup` [(Name, Name)]
    genericalizedNames)

    headOfType :: Type -> Name
    headOfType :: Type -> Name
    headOfType (ForallT [TyVarBndr Specificity]
    _ Cxt
    _ Type
    ty) = Type -> Name
    headOfType Type
    ty
    headOfType (VarT Name
    name) = Name
    name
    headOfType (ConT Name
    name) = Name
    name
    headOfType (TupleT Int
    n) = Int -> Name
    tupleTypeName Int
    n
    headOfType Type
    ArrowT = ''(->)
    headOfType Type
    ListT = ''[]
    headOfType (AppT Type
    t Type
    _) = Type -> Name
    headOfType Type
    t
    #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 612
    headOfType (SigT Type
    t Type
    _) = Type -> Name
    headOfType Type
    t
    #endif
    #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702
    headOfType (UnboxedTupleT Int
    n) = Int -> Name
    unboxedTupleTypeName Int
    n
    #endif
    #if defined (__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 704
    headOfType Type
    ty = [Char] -> Name
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> Name) -> [Char] -> Name
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "headOfType: Unhandled type: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Type -> [Char]
    forall a. Show a => a -> [Char]
    show Type
    ty
    #endif

    occursInType :: Name -> Type -> Bool
    occursInType :: Name -> Type -> Bool
    occursInType Name
    var Type
    ty = case Type
    ty of
            ForallT [TyVarBndr Specificity]
    bndrs Cxt
    _ Type
    ty'
                | (Name -> Bool) -> [Name] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (Name
    var Name -> Name -> Bool
    forall a. Eq a => a -> a -> Bool
    ==) ((TyVarBndr Specificity -> Name)
    -> [TyVarBndr Specificity] -> [Name]
    forall a b. (a -> b) -> [a] -> [b]
    map TyVarBndr Specificity -> Name
    forall a. TyVarBndr_ a -> Name
    tvName [TyVarBndr Specificity]
    bndrs)
                    -> Bool
    False
                | Bool
    otherwise
                    -> Name -> Type -> Bool
    occursInType Name
    var Type
    ty'
            VarT Name
    name
                | Name
    name Name -> Name -> Bool
    forall a. Eq a => a -> a -> Bool
    == Name
    var -> Bool
    True
                | Bool
    otherwise   -> Bool
    False
            AppT Type
    ty1 Type
    ty2 -> Name -> Type -> Bool
    occursInType Name
    var Type
    ty1 Bool -> Bool -> Bool
    || Name -> Type -> Bool
    occursInType Name
    var Type
    ty2
    #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 612
            SigT Type
    ty' Type
    _ -> Name -> Type -> Bool
    occursInType Name
    var Type
    ty'
    #endif
            Type
    _ -> Bool
    False

    -- | Assuming that we're building an instance of the form C (T v_1 ... v_(n-1)) for some GADT T, this function
    -- takes a list of the variables v_1 ... v_(n-1) used in the instance head, as well as the result type of some data
    -- constructor, say T x_1 ... x_(n-1) x_n, as well as the type t of some argument to it, and substitutes any of
    -- x_i (1 <= i <= n-1) occurring in t for the corresponding v_i, taking care to avoid name capture by foralls in t.
    substVarsWith
      :: [Name] -- Names of variables used in the instance head in argument order
      -> Type -- Result type of constructor
      -> Type -- Type of argument to the constructor
      -> Type -- Type of argument with variables substituted for instance head variables.
    substVarsWith :: [Name] -> Type -> Type -> Type
    substVarsWith [Name]
    topVars Type
    resultType Type
    argType = Set Name -> Type -> Type
    subst Set Name
    forall a. Set a
    Set.empty Type
    argType
      where
        topVars' :: [Name]
    topVars' = [Name] -> [Name]
    forall a. [a] -> [a]
    reverse [Name]
    topVars
        AppT Type
    resultType' Type
    _indexType = Type
    resultType
        subst :: Set Name -> Type -> Type
        subst :: Set Name -> Type -> Type
    subst Set Name
    bs Type
    ty = case Type
    ty of
          -- Several of the following cases could all be covered by an "x -> x" case, but
          -- I'd rather know if new cases need to be handled specially in future versions
          -- of Template Haskell.
    #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 710
          ForallT [TyVarBndr Specificity]
    bndrs Cxt
    cxt Type
    t ->
            let bs' :: Set Name
    bs' = Set Name -> Set Name -> Set Name
    forall a. Ord a => Set a -> Set a -> Set a
    Set.union Set Name
    bs ([Name] -> Set Name
    forall a. Ord a => [a] -> Set a
    Set.fromList ((TyVarBndr Specificity -> Name)
    -> [TyVarBndr Specificity] -> [Name]
    forall a b. (a -> b) -> [a] -> [b]
    map TyVarBndr Specificity -> Name
    forall a. TyVarBndr_ a -> Name
    tvName [TyVarBndr Specificity]
    bndrs))
            in [TyVarBndr Specificity] -> Cxt -> Type -> Type
    ForallT [TyVarBndr Specificity]
    bndrs ((Type -> Type) -> Cxt -> Cxt
    forall a b. (a -> b) -> [a] -> [b]
    map (Set Name -> Type -> Type
    subst Set Name
    bs') Cxt
    cxt) (Set Name -> Type -> Type
    subst Set Name
    bs' Type
    t)
    #else
          ForallT {} -> error "substVarsWith: ForallT substitutions have not been implemented for GHCs prior to 7.10"
    #endif
          AppT Type
    f Type
    x -> Type -> Type -> Type
    AppT (Set Name -> Type -> Type
    subst Set Name
    bs Type
    f) (Set Name -> Type -> Type
    subst Set Name
    bs Type
    x)
          SigT Type
    t Type
    k -> Type -> Type -> Type
    SigT (Set Name -> Type -> Type
    subst Set Name
    bs Type
    t) Type
    k
          VarT Name
    v -> if Name -> Set Name -> Bool
    forall a. Ord a => a -> Set a -> Bool
    Set.member Name
    v Set Name
    bs
            then Name -> Type
    VarT Name
    v
            else Name -> Type
    VarT (Name -> [Name] -> Type -> Name
    forall {a}. Name -> [a] -> Type -> a
    findVar Name
    v [Name]
    topVars' Type
    resultType')
          ConT Name
    n -> Name -> Type
    ConT Name
    n
          TupleT Int
    k -> Int -> Type
    TupleT Int
    k
          Type
    ArrowT -> Type
    ArrowT
          Type
    ListT -> Type
    ListT
    #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 800
          InfixT Type
    t1 Name
    x Type
    t2 -> Type -> Name -> Type -> Type
    InfixT (Set Name -> Type -> Type
    subst Set Name
    bs Type
    t1) Name
    x (Set Name -> Type -> Type
    subst Set Name
    bs Type
    t2)
          ParensT Type
    t -> Type -> Type
    ParensT (Set Name -> Type -> Type
    subst Set Name
    bs Type
    t)
          UInfixT Type
    t1 Name
    x Type
    t2 -> Type -> Name -> Type -> Type
    UInfixT (Set Name -> Type -> Type
    subst Set Name
    bs Type
    t1) Name
    x (Set Name -> Type -> Type
    subst Set Name
    bs Type
    t2)
          Type
    WildCardT -> Type
    WildCardT
    #endif
    #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 802
          UnboxedSumT Int
    k -> Int -> Type
    UnboxedSumT Int
    k
    #endif
    #if defined (__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 710
          Type
    EqualityT -> Type
    EqualityT
    #endif
    #if defined (__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 706
          Type
    ConstraintT -> Type
    ConstraintT
          LitT TyLit
    l -> TyLit -> Type
    LitT TyLit
    l
          Type
    PromotedConsT -> Type
    PromotedConsT
          Type
    PromotedNilT -> Type
    PromotedNilT
          PromotedT Name
    n -> Name -> Type
    PromotedT Name
    n
          PromotedTupleT Int
    k -> Int -> Type
    PromotedTupleT Int
    k
          Type
    StarT -> Type
    StarT
    #endif
    #if defined (__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ > 700
          UnboxedTupleT Int
    k -> Int -> Type
    UnboxedTupleT Int
    k
    #endif
        findVar :: Name -> [a] -> Type -> a
    findVar Name
    v (a
    tv:[a]
    _) (AppT Type
    _ (VarT Name
    v')) | Name
    v Name -> Name -> Bool
    forall a. Eq a => a -> a -> Bool
    == Name
    v' = a
    tv
        findVar Name
    v (a
    _:[a]
    tvs) (AppT Type
    t (VarT Name
    _)) = Name -> [a] -> Type -> a
    findVar Name
    v [a]
    tvs Type
    t
        findVar Name
    v [a]
    _ Type
    _ = [Char] -> a
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> a) -> [Char] -> a
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "substVarsWith: couldn't look up variable substitution for " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Name -> [Char]
    forall a. Show a => a -> [Char]
    show Name
    v
          [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " with topVars: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Name] -> [Char]
    forall a. Show a => a -> [Char]
    show [Name]
    topVars [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " resultType: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Type -> [Char]
    forall a. Show a => a -> [Char]
    show Type
    resultType [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " argType: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Type -> [Char]
    forall a. Show a => a -> [Char]
    show Type
    argType

    -- | Determine the arity of a kind.
    -- Starting in template-haskell 2.8.0.0, 'Kind' and 'Type' became synonymous.
    kindArity :: Kind -> Int
    #if defined (__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 706
    kindArity k = case k of
      StarK -> 0
      ArrowK _ k2 -> 1 + kindArity k2
    #else
    kindArity :: Type -> Int
    kindArity Type
    k = case Type
    k of
      ForallT [TyVarBndr Specificity]
    _ Cxt
    _ Type
    t -> Type -> Int
    kindArity Type
    t
      AppT (AppT Type
    ArrowT Type
    _) Type
    t -> Int
    1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Type -> Int
    kindArity Type
    t
      SigT Type
    t Type
    _ -> Type -> Int
    kindArity Type
    t
    #if defined (__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 800
      ParensT Type
    t -> Type -> Int
    kindArity Type
    t
    #endif
      Type
    _ -> Int
    0
    #endif

    -- | Given the name of a type constructor, determine its full arity
    tyConArity :: Name -> Q Int
    tyConArity :: Name -> Q Int
    tyConArity Name
    n = do
      ([TyVarBndr ()]
    ts, Int
    ka) <- Name -> Q ([TyVarBndr ()], Int)
    tyConArity' Name
    n
      Int -> Q Int
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([TyVarBndr ()] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [TyVarBndr ()]
    ts Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    ka)

    -- | Given the name of a type constructor, determine a list of type variables bound as parameters by
    -- its declaration, and the arity of the kind of type being defined (i.e. how many more arguments would
    -- need to be supplied in addition to the bound parameters in order to obtain an ordinary type of kind *).
    -- If the supplied 'Name' is anything other than a data or newtype, produces an error.
    #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 908
    tyConArity' :: Name -> Q ([TyVarBndrUnit], Int)
    #else
    tyConArity' :: Name -> Q ([TyVarBndr BndrVis], Int)
    #endif
    tyConArity' :: Name -> Q ([TyVarBndr ()], Int)
    tyConArity' Name
    n = do
      Info
    r <- Name -> Q Info
    reify Name
    n
      ([TyVarBndr ()], Int) -> Q ([TyVarBndr ()], Int)
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (([TyVarBndr ()], Int) -> Q ([TyVarBndr ()], Int))
    -> ([TyVarBndr ()], Int) -> Q ([TyVarBndr ()], Int)
    forall a b. (a -> b) -> a -> b
    $ case Info
    r of
    #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 800
        TyConI (DataD Cxt
    _ Name
    _ [TyVarBndr ()]
    ts Maybe Type
    mk [Con]
    _ [DerivClause]
    _) -> ([TyVarBndr ()]
    ts, Int -> Maybe Int -> Int
    forall a. a -> Maybe a -> a
    fromMaybe Int
    0 ((Type -> Int) -> Maybe Type -> Maybe Int
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Type -> Int
    kindArity Maybe Type
    mk))
        TyConI (NewtypeD Cxt
    _ Name
    _ [TyVarBndr ()]
    ts Maybe Type
    mk Con
    _ [DerivClause]
    _) -> ([TyVarBndr ()]
    ts, Int -> Maybe Int -> Int
    forall a. a -> Maybe a -> a
    fromMaybe Int
    0 ((Type -> Int) -> Maybe Type -> Maybe Int
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Type -> Int
    kindArity Maybe Type
    mk))
    #else
        TyConI (DataD _ _ ts _ _) -> (ts, 0)
        TyConI (NewtypeD _ _ ts _ _) -> (ts, 0)
    #endif
        Info
    _ -> [Char] -> ([TyVarBndr ()], Int)
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> ([TyVarBndr ()], Int))
    -> [Char] -> ([TyVarBndr ()], Int)
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "tyConArity': Supplied name reified to something other than a data declaration: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Name -> [Char]
    forall a. Show a => a -> [Char]
    show Name
    n

    -- | Determine the constructors bound by a data or newtype declaration. Errors out if supplied with another
    -- sort of declaration.
    decCons :: Dec -> [Con]
    decCons :: Dec -> [Con]
    decCons Dec
    d = case Dec
    d of
    #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 800
      DataD Cxt
    _ Name
    _ [TyVarBndr ()]
    _ Maybe Type
    _ [Con]
    cs [DerivClause]
    _ -> [Con]
    cs
      NewtypeD Cxt
    _ Name
    _ [TyVarBndr ()]
    _ Maybe Type
    _ Con
    c [DerivClause]
    _ -> [Con
    c]
    #else
      DataD _ _ _ cs _ -> cs
      NewtypeD _ _ _ c _ -> [c]
    #endif
      Dec
    _ -> [Char] -> [Con]
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "decCons: Declaration found was not a data or newtype declaration."

    -- | Determine the arity of a data constructor.
    conArity :: Con -> Int
    conArity :: Con -> Int
    conArity Con
    c = case Con
    c of
      NormalC Name
    _ [BangType]
    ts -> [BangType] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [BangType]
    ts
      RecC Name
    _ [VarBangType]
    ts -> [VarBangType] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [VarBangType]
    ts
      InfixC BangType
    _ Name
    _ BangType
    _ -> Int
    2
      ForallC [TyVarBndr Specificity]
    _ Cxt
    _ Con
    c' -> Con -> Int
    conArity Con
    c'
    #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 800
      GadtC [Name]
    _ [BangType]
    ts Type
    _ -> [BangType] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [BangType]
    ts
      RecGadtC [Name]
    _ [VarBangType]
    ts Type
    _ -> [VarBangType] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [VarBangType]
    ts
    #endif