    {-# LANGUAGE BangPatterns #-}
    {-# LANGUAGE CPP #-}
    {-# LANGUAGE GADTs #-}
    {-# LANGUAGE MagicHash #-}
    {-# LANGUAGE TemplateHaskellQuotes #-}

    {-|
    Module:      Data.Deriving.Internal
    Copyright:   (C) 2015-2017 Ryan Scott
    License:     BSD-style (see the file LICENSE)
    Maintainer:  Ryan Scott
    Portability: Template Haskell

    Template Haskell-related utilities.

    Note: this is an internal module, and as such, the API presented here is not
    guaranteed to be stable, even between minor releases of this library.
    -}
    module Data.Deriving.Internal where

    import qualified Control.Applicative as App
    import           Control.Monad (when, unless)

    import qualified Data.Foldable as F
    import           Data.Functor.Classes
                       ( Eq1(..), Ord1(..), Read1(..), Show1(..)
                       , Eq2(..), Ord2(..), Read2(..), Show2(..)
    #if MIN_VERSION_base(4,10,0)
                       , liftReadListPrecDefault, liftReadListPrec2Default
    #endif
                       )
    import qualified Data.List as List
    import           Data.List.NonEmpty (NonEmpty(..))
    import qualified Data.Map as Map
    import           Data.Map (Map)
    import           Data.Maybe
    import           Data.Monoid (Dual(..), Endo(..))
    import qualified Data.Set as Set
    import           Data.Set (Set)
    import qualified Data.Traversable as T

    import           GHC.Arr (Ix(..))
    import           GHC.Base (getTag)
    import           GHC.Exts
    import           GHC.Lexeme (startsConSym, startsVarSym)
    import           GHC.Read (choose, expectP, list, paren)
    import           GHC.Show (showSpace)
    #if MIN_VERSION_base(4,19,0)
    import           GHC.Int (Int8(..), Int16(..), Int32(..), Int64(..))
    import           GHC.Word (Word8(..), Word16(..), Word32(..), Word64(..))
    #endif

    import           Text.ParserCombinators.ReadPrec
                       ( ReadPrec, (+++), pfail, prec, readPrec_to_S, readS_to_Prec
                       , reset, step
                       )
    import           Text.Read (Read(..), parens, readListPrecDefault)
    import qualified Text.Read.Lex as L
    import           Text.Show (showListWith)

    #if MIN_VERSION_base(4,10,0)
    import           GHC.Show (showCommaSpace)
    #endif

    #if MIN_VERSION_base(4,11,0)
    import           GHC.Read (readField, readSymField)
    #endif

    import           Language.Haskell.TH.Datatype as Datatype
    import           Language.Haskell.TH.Datatype.TyVarBndr
    import           Language.Haskell.TH.Lib
    import           Language.Haskell.TH.Ppr (pprint)
    import           Language.Haskell.TH.Syntax

    -- Ensure, beyond a shadow of a doubt, that the instances are in-scope
    import           Data.Functor ()
    import           Data.Functor.Classes ()
    import           Data.Foldable ()
    import           Data.Traversable ()

    -------------------------------------------------------------------------------
    -- Expanding type synonyms
    -------------------------------------------------------------------------------

    applySubstitutionKind :: Map Name Kind -> Type -> Type
    applySubstitutionKind :: Map Name Type -> Type -> Type
    applySubstitutionKind = Map Name Type -> Type -> Type
    forall a. TypeSubstitution a => Map Name Type -> a -> a
    applySubstitution

    substNameWithKind :: Name -> Kind -> Type -> Type
    substNameWithKind :: Name -> Type -> Type -> Type
    substNameWithKind Name
    n Type
    k = Map Name Type -> Type -> Type
    applySubstitutionKind (Name -> Type -> Map Name Type
    forall k a. k -> a -> Map k a
    Map.singleton Name
    n Type
    k)

    substNamesWithKindStar :: [Name] -> Type -> Type
    substNamesWithKindStar :: [Name] -> Type -> Type
    substNamesWithKindStar [Name]
    ns Type
    t = (Name -> Type -> Type) -> Type -> [Name] -> Type
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    F.foldr' ((Name -> Type -> Type -> Type) -> Type -> Name -> Type -> Type
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip Name -> Type -> Type -> Type
    substNameWithKind Type
    starK) Type
    t [Name]
    ns

    -------------------------------------------------------------------------------
    -- Via
    -------------------------------------------------------------------------------

    -- | A type-level modifier intended to be used in conjunction with 'deriveVia'.
    -- Refer to the documentation for 'deriveVia' for more details.
    data a `Via` b
    infix 0 `Via`

    -------------------------------------------------------------------------------
    -- Type-specialized const functions
    -------------------------------------------------------------------------------

    fmapConst :: f b -> (a -> b) -> f a -> f b
    fmapConst :: forall (f :: * -> *) b a. f b -> (a -> b) -> f a -> f b
    fmapConst f b
    x a -> b
    _ f a
    _ = f b
    x
    {-# INLINE fmapConst #-}

    replaceConst :: f a -> a -> f b -> f a
    replaceConst :: forall (f :: * -> *) a b. f a -> a -> f b -> f a
    replaceConst f a
    x a
    _ f b
    _ = f a
    x
    {-# INLINE replaceConst #-}

    foldrConst :: b -> (a -> b -> b) -> b -> t a -> b
    foldrConst :: forall b a (t :: * -> *). b -> (a -> b -> b) -> b -> t a -> b
    foldrConst b
    x a -> b -> b
    _ b
    _ t a
    _ = b
    x
    {-# INLINE foldrConst #-}

    foldMapConst :: m -> (a -> m) -> t a -> m
    foldMapConst :: forall m a (t :: * -> *). m -> (a -> m) -> t a -> m
    foldMapConst m
    x a -> m
    _ t a
    _ = m
    x
    {-# INLINE foldMapConst #-}

    nullConst :: Bool -> t a -> Bool
    nullConst :: forall (t :: * -> *) a. Bool -> t a -> Bool
    nullConst Bool
    x t a
    _ = Bool
    x
    {-# INLINE nullConst #-}

    traverseConst :: f (t b) -> (a -> f b) -> t a -> f (t b)
    traverseConst :: forall (f :: * -> *) (t :: * -> *) b a.
    f (t b) -> (a -> f b) -> t a -> f (t b)
    traverseConst f (t b)
    x a -> f b
    _ t a
    _ = f (t b)
    x
    {-# INLINE traverseConst #-}

    eqConst :: Bool
            -> a -> a -> Bool
    eqConst :: forall a. Bool -> a -> a -> Bool
    eqConst Bool
    x a
    _ a
    _ = Bool
    x
    {-# INLINE eqConst #-}

    eq1Const :: Bool
             -> f a -> f a-> Bool
    eq1Const :: forall (f :: * -> *) a. Bool -> f a -> f a -> Bool
    eq1Const Bool
    x f a
    _ f a
    _ = Bool
    x
    {-# INLINE eq1Const #-}

    liftEqConst :: Bool
                -> (a -> b -> Bool) -> f a -> f b -> Bool
    liftEqConst :: forall a b (f :: * -> *).
    Bool -> (a -> b -> Bool) -> f a -> f b -> Bool
    liftEqConst Bool
    x a -> b -> Bool
    _ f a
    _ f b
    _ = Bool
    x
    {-# INLINE liftEqConst #-}

    liftEq2Const :: Bool
                 -> (a -> b -> Bool) -> (c -> d -> Bool)
                 -> f a c -> f b d -> Bool
    liftEq2Const :: forall a b c d (f :: * -> * -> *).
    Bool
    -> (a -> b -> Bool) -> (c -> d -> Bool) -> f a c -> f b d -> Bool
    liftEq2Const Bool
    x a -> b -> Bool
    _ c -> d -> Bool
    _ f a c
    _ f b d
    _ = Bool
    x
    {-# INLINE liftEq2Const #-}

    compareConst :: Ordering -> a -> a -> Ordering
    compareConst :: forall a. Ordering -> a -> a -> Ordering
    compareConst Ordering
    x a
    _ a
    _ = Ordering
    x
    {-# INLINE compareConst #-}

    ltConst :: Bool -> a -> a -> Bool
    ltConst :: forall a. Bool -> a -> a -> Bool
    ltConst Bool
    x a
    _ a
    _ = Bool
    x
    {-# INLINE ltConst #-}

    compare1Const :: Ordering -> f a -> f a -> Ordering
    compare1Const :: forall (f :: * -> *) a. Ordering -> f a -> f a -> Ordering
    compare1Const Ordering
    x f a
    _ f a
    _ = Ordering
    x
    {-# INLINE compare1Const #-}

    liftCompareConst :: Ordering
                     -> (a -> b -> Ordering) -> f a -> f b -> Ordering
    liftCompareConst :: forall a b (f :: * -> *).
    Ordering -> (a -> b -> Ordering) -> f a -> f b -> Ordering
    liftCompareConst Ordering
    x a -> b -> Ordering
    _ f a
    _ f b
    _ = Ordering
    x
    {-# INLINE liftCompareConst #-}

    liftCompare2Const :: Ordering
                      -> (a -> b -> Ordering) -> (c -> d -> Ordering)
                      -> f a c -> f b d -> Ordering
    liftCompare2Const :: forall a b c d (f :: * -> * -> *).
    Ordering
    -> (a -> b -> Ordering)
    -> (c -> d -> Ordering)
    -> f a c
    -> f b d
    -> Ordering
    liftCompare2Const Ordering
    x a -> b -> Ordering
    _ c -> d -> Ordering
    _ f a c
    _ f b d
    _ = Ordering
    x
    {-# INLINE liftCompare2Const #-}

    readsPrecConst :: ReadS a -> Int -> ReadS a
    readsPrecConst :: forall a. ReadS a -> Int -> ReadS a
    readsPrecConst ReadS a
    x Int
    _ = ReadS a
    x
    {-# INLINE readsPrecConst #-}

    -- This isn't really necessary, but it makes for an easier implementation
    readPrecConst :: ReadPrec a -> ReadPrec a
    readPrecConst :: forall a. ReadPrec a -> ReadPrec a
    readPrecConst ReadPrec a
    x = ReadPrec a
    x
    {-# INLINE readPrecConst #-}

    readsPrec1Const :: ReadS (f a) -> Int -> ReadS (f a)
    readsPrec1Const :: forall (f :: * -> *) a. ReadS (f a) -> Int -> ReadS (f a)
    readsPrec1Const ReadS (f a)
    x Int
    _ = ReadS (f a)
    x
    {-# INLINE readsPrec1Const #-}

    liftReadsPrecConst :: ReadS (f a)
                       -> (Int -> ReadS a) -> ReadS [a]
                       -> Int -> ReadS (f a)
    liftReadsPrecConst :: forall (f :: * -> *) a.
    ReadS (f a) -> (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (f a)
    liftReadsPrecConst ReadS (f a)
    x Int -> ReadS a
    _ ReadS [a]
    _ Int
    _ = ReadS (f a)
    x
    {-# INLINE liftReadsPrecConst #-}

    liftReadPrecConst :: ReadPrec (f a)
                      -> ReadPrec a -> ReadPrec [a]
                      -> ReadPrec (f a)
    liftReadPrecConst :: forall (f :: * -> *) a.
    ReadPrec (f a) -> ReadPrec a -> ReadPrec [a] -> ReadPrec (f a)
    liftReadPrecConst ReadPrec (f a)
    x ReadPrec a
    _ ReadPrec [a]
    _ = ReadPrec (f a)
    x
    {-# INLINE liftReadPrecConst #-}

    liftReadsPrec2Const :: ReadS (f a b)
                        -> (Int -> ReadS a) -> ReadS [a]
                        -> (Int -> ReadS b) -> ReadS [b]
                        -> Int -> ReadS (f a b)
    liftReadsPrec2Const :: forall (f :: * -> * -> *) a b.
    ReadS (f a b)
    -> (Int -> ReadS a)
    -> ReadS [a]
    -> (Int -> ReadS b)
    -> ReadS [b]
    -> Int
    -> ReadS (f a b)
    liftReadsPrec2Const ReadS (f a b)
    x Int -> ReadS a
    _ ReadS [a]
    _ Int -> ReadS b
    _ ReadS [b]
    _ Int
    _ = ReadS (f a b)
    x
    {-# INLINE liftReadsPrec2Const #-}

    liftReadPrec2Const :: ReadPrec (f a b)
                       -> ReadPrec a -> ReadPrec [a]
                       -> ReadPrec b -> ReadPrec [b]
                       -> ReadPrec (f a b)
    liftReadPrec2Const :: forall (f :: * -> * -> *) a b.
    ReadPrec (f a b)
    -> ReadPrec a
    -> ReadPrec [a]
    -> ReadPrec b
    -> ReadPrec [b]
    -> ReadPrec (f a b)
    liftReadPrec2Const ReadPrec (f a b)
    x ReadPrec a
    _ ReadPrec [a]
    _ ReadPrec b
    _ ReadPrec [b]
    _ = ReadPrec (f a b)
    x
    {-# INLINE liftReadPrec2Const #-}

    showsPrecConst :: ShowS
                   -> Int -> a -> ShowS
    showsPrecConst :: forall a. ShowS -> Int -> a -> ShowS
    showsPrecConst ShowS
    x Int
    _ a
    _ = ShowS
    x
    {-# INLINE showsPrecConst #-}

    showsPrec1Const :: ShowS
                    -> Int -> f a -> ShowS
    showsPrec1Const :: forall (f :: * -> *) a. ShowS -> Int -> f a -> ShowS
    showsPrec1Const ShowS
    x Int
    _ f a
    _ = ShowS
    x
    {-# INLINE showsPrec1Const #-}

    liftShowsPrecConst :: ShowS
                       -> (Int -> a -> ShowS) -> ([a] -> ShowS)
                       -> Int -> f a -> ShowS
    liftShowsPrecConst :: forall a (f :: * -> *).
    ShowS
    -> (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
    liftShowsPrecConst ShowS
    x Int -> a -> ShowS
    _ [a] -> ShowS
    _ Int
    _ f a
    _ = ShowS
    x
    {-# INLINE liftShowsPrecConst #-}

    liftShowsPrec2Const :: ShowS
                        -> (Int -> a -> ShowS) -> ([a] -> ShowS)
                        -> (Int -> b -> ShowS) -> ([b] -> ShowS)
                        -> Int -> f a b -> ShowS
    liftShowsPrec2Const :: forall a b (f :: * -> * -> *).
    ShowS
    -> (Int -> a -> ShowS)
    -> ([a] -> ShowS)
    -> (Int -> b -> ShowS)
    -> ([b] -> ShowS)
    -> Int
    -> f a b
    -> ShowS
    liftShowsPrec2Const ShowS
    x Int -> a -> ShowS
    _ [a] -> ShowS
    _ Int -> b -> ShowS
    _ [b] -> ShowS
    _ Int
    _ f a b
    _ = ShowS
    x
    {-# INLINE liftShowsPrec2Const #-}

    -------------------------------------------------------------------------------
    -- StarKindStatus
    -------------------------------------------------------------------------------

    -- | Whether a type is not of kind *, is of kind *, or is a kind variable.
    data StarKindStatus = NotKindStar
                        | KindStar
                        | IsKindVar Name
      deriving StarKindStatus -> StarKindStatus -> Bool
    (StarKindStatus -> StarKindStatus -> Bool)
    -> (StarKindStatus -> StarKindStatus -> Bool) -> Eq StarKindStatus
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: StarKindStatus -> StarKindStatus -> Bool
    == :: StarKindStatus -> StarKindStatus -> Bool
    $c/= :: StarKindStatus -> StarKindStatus -> Bool
    /= :: StarKindStatus -> StarKindStatus -> Bool
    Eq

    -- | Does a Type have kind * or k (for some kind variable k)?
    canRealizeKindStar :: Type -> StarKindStatus
    canRealizeKindStar :: Type -> StarKindStatus
    canRealizeKindStar Type
    t
      | Type -> Bool
    hasKindStar Type
    t = StarKindStatus
    KindStar
      | Bool
    otherwise = case Type
    t of
                         SigT Type
    _ (VarT Name
    k) -> Name -> StarKindStatus
    IsKindVar Name
    k
                         Type
    _               -> StarKindStatus
    NotKindStar

    -- | Returns 'Just' the kind variable 'Name' of a 'StarKindStatus' if it exists.
    -- Otherwise, returns 'Nothing'.
    starKindStatusToName :: StarKindStatus -> Maybe Name
    starKindStatusToName :: StarKindStatus -> Maybe Name
    starKindStatusToName (IsKindVar Name
    n) = Name -> Maybe Name
    forall a. a -> Maybe a
    Just Name
    n
    starKindStatusToName StarKindStatus
    _             = Maybe Name
    forall a. Maybe a
    Nothing

    -- | Concat together all of the StarKindStatuses that are IsKindVar and extract
    -- the kind variables' Names out.
    catKindVarNames :: [StarKindStatus] -> [Name]
    catKindVarNames :: [StarKindStatus] -> [Name]
    catKindVarNames = (StarKindStatus -> Maybe Name) -> [StarKindStatus] -> [Name]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe StarKindStatus -> Maybe Name
    starKindStatusToName

    -------------------------------------------------------------------------------
    -- ClassRep
    -------------------------------------------------------------------------------

    class ClassRep a where
        arity           :: a -> Int
        allowExQuant    :: a -> Bool
        fullClassName   :: a -> Name
        classConstraint :: a -> Int -> Maybe Name

    -------------------------------------------------------------------------------
    -- Template Haskell reifying and AST manipulation
    -------------------------------------------------------------------------------

    -- For the given Types, generate an instance context and head. Coming up with
    -- the instance type isn't as simple as dropping the last types, as you need to
    -- be wary of kinds being instantiated with *.
    -- See Note [Type inference in derived instances]
    buildTypeInstance :: ClassRep a
                      => a
                      -- ^ The typeclass for which an instance should be derived
                      -> Name
                      -- ^ The type constructor or data family name
                      -> Cxt
                      -- ^ The datatype context
                      -> [Type]
                      -- ^ The types to instantiate the instance with
                      -> DatatypeVariant
                      -- ^ Are we dealing with a data family instance or not
                      -> Q (Cxt, Type)
    buildTypeInstance :: forall a.
    ClassRep a =>
    a
    -> Name -> [Type] -> [Type] -> DatatypeVariant -> Q ([Type], Type)
    buildTypeInstance a
    cRep Name
    tyConName [Type]
    dataCxt [Type]
    varTysOrig DatatypeVariant
    variant = do
        -- Make sure to expand through type/kind synonyms! Otherwise, the
        -- eta-reduction check might get tripped up over type variables in a
        -- synonym that are actually dropped.
        -- (See GHC Trac #11416 for a scenario where this actually happened.)
        varTysExp <- (Type -> Q Type) -> [Type] -> Q [Type]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    T.mapM Type -> Q Type
    resolveTypeSynonyms [Type]
    varTysOrig

        let remainingLength :: Int
            remainingLength = [Type] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Type]
    varTysOrig Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - a -> Int
    forall a. ClassRep a => a -> Int
    arity a
    cRep

            droppedTysExp :: [Type]
            droppedTysExp = Int -> [Type] -> [Type]
    forall a. Int -> [a] -> [a]
    drop Int
    remainingLength [Type]
    varTysExp

            droppedStarKindStati :: [StarKindStatus]
            droppedStarKindStati = (Type -> StarKindStatus) -> [Type] -> [StarKindStatus]
    forall a b. (a -> b) -> [a] -> [b]
    map Type -> StarKindStatus
    canRealizeKindStar [Type]
    droppedTysExp

        -- Check there are enough types to drop and that all of them are either of
        -- kind * or kind k (for some kind variable k). If not, throw an error.
        when (remainingLength < 0 || any (== NotKindStar) droppedStarKindStati) $
          derivingKindError cRep tyConName

        let droppedKindVarNames :: [Name]
            droppedKindVarNames = [StarKindStatus] -> [Name]
    catKindVarNames [StarKindStatus]
    droppedStarKindStati

            -- Substitute kind * for any dropped kind variables
            varTysExpSubst :: [Type]
            varTysExpSubst = (Type -> Type) -> [Type] -> [Type]
    forall a b. (a -> b) -> [a] -> [b]
    map ([Name] -> Type -> Type
    substNamesWithKindStar [Name]
    droppedKindVarNames) [Type]
    varTysExp

            remainingTysExpSubst, droppedTysExpSubst :: [Type]
            (remainingTysExpSubst, droppedTysExpSubst) =
              splitAt remainingLength varTysExpSubst

            -- All of the type variables mentioned in the dropped types
            -- (post-synonym expansion)
            droppedTyVarNames :: [Name]
            droppedTyVarNames = [Type] -> [Name]
    forall a. TypeSubstitution a => a -> [Name]
    freeVariables [Type]
    droppedTysExpSubst

        -- If any of the dropped types were polykinded, ensure that they are of kind *
        -- after substituting * for the dropped kind variables. If not, throw an error.
        unless (all hasKindStar droppedTysExpSubst) $
          derivingKindError cRep tyConName

        let preds    :: [Maybe Pred]
            kvNames  :: [[Name]]
            kvNames' :: [Name]
            -- Derive instance constraints (and any kind variables which are specialized
            -- to * in those constraints)
            (preds, kvNames) = unzip $ map (deriveConstraint cRep) remainingTysExpSubst
            kvNames' = [[Name]] -> [Name]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [[Name]]
    kvNames

            -- Substitute the kind variables specialized in the constraints with *
            remainingTysExpSubst' :: [Type]
            remainingTysExpSubst' =
              (Type -> Type) -> [Type] -> [Type]
    forall a b. (a -> b) -> [a] -> [b]
    map ([Name] -> Type -> Type
    substNamesWithKindStar [Name]
    kvNames') [Type]
    remainingTysExpSubst

            -- We now substitute all of the specialized-to-* kind variable names with
            -- *, but in the original types, not the synonym-expanded types. The reason
            -- we do this is a superficial one: we want the derived instance to resemble
            -- the datatype written in source code as closely as possible. For example,
            -- for the following data family instance:
            --
            --   data family Fam a
            --   newtype instance Fam String = Fam String
            --
            -- We'd want to generate the instance:
            --
            --   instance C (Fam String)
            --
            -- Not:
            --
            --   instance C (Fam [Char])
            remainingTysOrigSubst :: [Type]
            remainingTysOrigSubst =
              (Type -> Type) -> [Type] -> [Type]
    forall a b. (a -> b) -> [a] -> [b]
    map ([Name] -> Type -> Type
    substNamesWithKindStar ([Name] -> [Name] -> [Name]
    forall a. Eq a => [a] -> [a] -> [a]
    List.union [Name]
    droppedKindVarNames [Name]
    kvNames'))
                ([Type] -> [Type]) -> [Type] -> [Type]
    forall a b. (a -> b) -> a -> b
    $ Int -> [Type] -> [Type]
    forall a. Int -> [a] -> [a]
    take Int
    remainingLength [Type]
    varTysOrig

        isDataFamily <-
          case variant of
            DatatypeVariant
    Datatype          -> Bool -> Q Bool
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False
            DatatypeVariant
    Newtype           -> Bool -> Q Bool
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False
            DatatypeVariant
    DataInstance      -> Bool -> Q Bool
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True
            DatatypeVariant
    NewtypeInstance   -> Bool -> Q Bool
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True
            DatatypeVariant
    Datatype.TypeData -> Name -> Q Bool
    forall a. Name -> Q a
    typeDataError Name
    tyConName

        let remainingTysOrigSubst' :: [Type]
            -- See Note [Kind signatures in derived instances] for an explanation
            -- of the isDataFamily check.
            remainingTysOrigSubst' =
              if Bool
    isDataFamily
                 then [Type]
    remainingTysOrigSubst
                 else (Type -> Type) -> [Type] -> [Type]
    forall a b. (a -> b) -> [a] -> [b]
    map Type -> Type
    unSigT [Type]
    remainingTysOrigSubst

            instanceCxt :: Cxt
            instanceCxt = [Maybe Type] -> [Type]
    forall a. [Maybe a] -> [a]
    catMaybes [Maybe Type]
    preds

            instanceType :: Type
            instanceType = Type -> Type -> Type
    AppT (Name -> Type
    ConT (a -> Name
    forall a. ClassRep a => a -> Name
    fullClassName a
    cRep))
                         (Type -> Type) -> Type -> Type
    forall a b. (a -> b) -> a -> b
    $ Name -> [Type] -> Type
    applyTyCon Name
    tyConName [Type]
    remainingTysOrigSubst'

        -- If the datatype context mentions any of the dropped type variables,
        -- we can't derive an instance, so throw an error.
        when (any (`mentionsName` droppedTyVarNames) dataCxt) $
          datatypeContextError tyConName instanceType
        -- Also ensure the dropped types can be safely eta-reduced. Otherwise,
        -- throw an error.
        unless (canEtaReduce remainingTysExpSubst' droppedTysExpSubst) $
          etaReductionError instanceType
        return (instanceCxt, instanceType)

    -- | Attempt to derive a constraint on a Type. If successful, return
    -- Just the constraint and any kind variable names constrained to *.
    -- Otherwise, return Nothing and the empty list.
    --
    -- See Note [Type inference in derived instances] for the heuristics used to
    -- come up with constraints.
    deriveConstraint :: ClassRep a => a -> Type -> (Maybe Pred, [Name])
    deriveConstraint :: forall a. ClassRep a => a -> Type -> (Maybe Type, [Name])
    deriveConstraint a
    cRep Type
    t
      | Bool -> Bool
    not (Type -> Bool
    isTyVar Type
    t) = (Maybe Type
    forall a. Maybe a
    Nothing, [])
      | Type -> Bool
    hasKindStar Type
    t   = ((Name -> Name -> Type
    `applyClass` Name
    tName) (Name -> Type) -> Maybe Name -> Maybe Type
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` a -> Int -> Maybe Name
    forall a. ClassRep a => a -> Int -> Maybe Name
    classConstraint a
    cRep Int
    0, [])
      | Bool
    otherwise = case Int -> Type -> Maybe [Name]
    hasKindVarChain Int
    1 Type
    t of
          Just [Name]
    ns | Int
    cRepArity Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    1
                  -> ((Name -> Name -> Type
    `applyClass` Name
    tName) (Name -> Type) -> Maybe Name -> Maybe Type
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` a -> Int -> Maybe Name
    forall a. ClassRep a => a -> Int -> Maybe Name
    classConstraint a
    cRep Int
    1, [Name]
    ns)
          Maybe [Name]
    _ -> case Int -> Type -> Maybe [Name]
    hasKindVarChain Int
    2 Type
    t of
               Just [Name]
    ns | Int
    cRepArity Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    2
                       -> ((Name -> Name -> Type
    `applyClass` Name
    tName) (Name -> Type) -> Maybe Name -> Maybe Type
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` a -> Int -> Maybe Name
    forall a. ClassRep a => a -> Int -> Maybe Name
    classConstraint a
    cRep Int
    2, [Name]
    ns)
               Maybe [Name]
    _ -> (Maybe Type
    forall a. Maybe a
    Nothing, [])
      where
        tName :: Name
        tName :: Name
    tName     = Type -> Name
    varTToName Type
    t

        cRepArity :: Int
        cRepArity :: Int
    cRepArity = a -> Int
    forall a. ClassRep a => a -> Int
    arity a
    cRep

    {-
    Note [Kind signatures in derived instances]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

    It is possible to put explicit kind signatures into the derived instances, e.g.,

      instance C a => C (Data (f :: * -> *)) where ...

    But it is preferable to avoid this if possible. If we come up with an incorrect
    kind signature (which is entirely possible, since our type inferencer is pretty
    unsophisticated - see Note [Type inference in derived instances]), then GHC will
    flat-out reject the instance, which is quite unfortunate.

    Plain old datatypes have the advantage that you can avoid using any kind signatures
    at all in their instances. This is because a datatype declaration uses all type
    variables, so the types that we use in a derived instance uniquely determine their
    kinds. As long as we plug in the right types, the kind inferencer can do the rest
    of the work. For this reason, we use unSigT to remove all kind signatures before
    splicing in the instance context and head.

    Data family instances are trickier, since a data family can have two instances that
    are distinguished by kind alone, e.g.,

      data family Fam (a :: k)
      data instance Fam (a :: * -> *)
      data instance Fam (a :: *)

    If we dropped the kind signatures for C (Fam a), then GHC will have no way of
    knowing which instance we are talking about. To avoid this scenario, we always
    include explicit kind signatures in data family instances. There is a chance that
    the inferred kind signatures will be incorrect, but if so, we can always fall back
    on the make- functions.

    Note [Type inference in derived instances]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

    Type inference is can be tricky to get right, and we want to avoid recreating the
    entirety of GHC's type inferencer in Template Haskell. For this reason, we will
    probably never come up with derived instance contexts that are as accurate as
    GHC's. But that doesn't mean we can't do anything! There are a couple of simple
    things we can do to make instance contexts that work for 80% of use cases:

    1. If one of the last type parameters is polykinded, then its kind will be
       specialized to * in the derived instance. We note what kind variable the type
       parameter had and substitute it with * in the other types as well. For example,
       imagine you had

         data Data (a :: k) (b :: k)

       Then you'd want to derived instance to be:

         instance C (Data (a :: *))

       Not:

         instance C (Data (a :: k))

    2. We naïvely come up with instance constraints using the following criteria, using
       Show(1)(2) as the example typeclasses:

       (i)   If there's a type parameter n of kind *, generate a Show n constraint.
       (ii)  If there's a type parameter n of kind k1 -> k2 (where k1/k2 are * or kind
             variables), then generate a Show1 n constraint, and if k1/k2 are kind
             variables, then substitute k1/k2 with * elsewhere in the types. We must
             consider the case where they are kind variables because you might have a
             scenario like this:

               newtype Compose (f :: k2 -> *) (g :: k1 -> k2) (a :: k1)
                 = Compose (f (g a))

             Which would have a derived Show1 instance of:

               instance (Show1 f, Show1 g) => Show1 (Compose f g) where ...
       (iii) If there's a type parameter n of kind k1 -> k2 -> k3 (where k1/k2/k3 are
             * or kind variables), then generate a Show2 constraint and perform
             kind substitution as in the other cases.
    -}

    checkExistentialContext :: ClassRep a => a -> TyVarMap b -> Cxt -> Name
                            -> Q c -> Q c
    checkExistentialContext :: forall a b c.
    ClassRep a =>
    a -> TyVarMap b -> [Type] -> Name -> Q c -> Q c
    checkExistentialContext a
    cRep TyVarMap b
    tvMap [Type]
    ctxt Name
    conName Q c
    q =
      if ((Type -> Bool) -> [Type] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (Type -> [Name] -> Bool
    `mentionsName` TyVarMap b -> [Name]
    forall k a. Map k a -> [k]
    Map.keys TyVarMap b
    tvMap) [Type]
    ctxt
           Bool -> Bool -> Bool
    || TyVarMap b -> Int
    forall k a. Map k a -> Int
    Map.size TyVarMap b
    tvMap Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < a -> Int
    forall a. ClassRep a => a -> Int
    arity a
    cRep)
           Bool -> Bool -> Bool
    && Bool -> Bool
    not (a -> Bool
    forall a. ClassRep a => a -> Bool
    allowExQuant a
    cRep)
         then Name -> Q c
    forall a. Name -> Q a
    existentialContextError Name
    conName
         else Q c
    q

    {-
    Note [Matching functions with GADT type variables]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

    When deriving category-2 classes like Show2, there is a tricky corner case to consider:

      data Both a b where
        BothCon :: x -> x -> Both x x

    Which show functions should be applied to which arguments of BothCon? We have a
    choice, since both the function of type (Int -> a -> ShowS) and of type
    (Int -> b -> ShowS) can be applied to either argument. In such a scenario, the
    second show function takes precedence over the first show function, so the
    derived Show2 instance would be:

      instance Show2 Both where
        liftShowsPrec2 sp1 sp2 p (BothCon x1 x2) =
          showsParen (p > appPrec) $
            showString "BothCon " . sp2 appPrec1 x1 . showSpace . sp2 appPrec1 x2

    This is not an arbitrary choice, as this definition ensures that
    liftShowsPrec2 showsPrec = liftShowsPrec for a derived Show1 instance for
    Both.
    -}

    -------------------------------------------------------------------------------
    -- Error messages
    -------------------------------------------------------------------------------

    -- | The given datatype has no constructors, and we don't know what to do with it.
    noConstructorsError :: Q a
    noConstructorsError :: forall a. Q a
    noConstructorsError = String -> Q a
    forall a. String -> Q a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "Must have at least one data constructor"

    -- | Either the given data type doesn't have enough type variables, or one of
    -- the type variables to be eta-reduced cannot realize kind *.
    derivingKindError :: ClassRep a => a ->  Name -> Q b
    derivingKindError :: forall a b. ClassRep a => a -> Name -> Q b
    derivingKindError a
    cRep Name
    tyConName = String -> Q b
    forall a. String -> Q a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail
      (String -> Q b) -> ShowS -> String -> Q b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    showString String
    "Cannot derive well-kinded instance of form ‘"
      ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    showString String
    className
      ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> ShowS
    showChar Char
    ' '
      ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Bool -> ShowS -> ShowS
    showParen Bool
    True
        ( String -> ShowS
    showString (Name -> String
    nameBase Name
    tyConName)
        ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    showString String
    " ..."
        )
      ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    showString String
    "‘\n\tClass "
      ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    showString String
    className
      ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    showString String
    " expects an argument of kind "
      ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    showString (Type -> String
    forall a. Ppr a => a -> String
    pprint (Type -> String) -> (Int -> Type) -> Int -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> Type
    createKindChain (Int -> String) -> Int -> String
    forall a b. (a -> b) -> a -> b
    $ a -> Int
    forall a. ClassRep a => a -> Int
    arity a
    cRep)
      (String -> Q b) -> String -> Q b
    forall a b. (a -> b) -> a -> b
    $ String
    ""
      where
        className :: String
        className :: String
    className = Name -> String
    nameBase (Name -> String) -> Name -> String
    forall a b. (a -> b) -> a -> b
    $ a -> Name
    forall a. ClassRep a => a -> Name
    fullClassName a
    cRep

    -- | The last type variable appeared in a contravariant position
    -- when deriving Functor.
    contravarianceError :: Name -> Q a
    contravarianceError :: forall a. Name -> Q a
    contravarianceError Name
    conName = String -> Q a
    forall a. String -> Q a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail
      (String -> Q a) -> ShowS -> String -> Q a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    showString String
    "Constructor ‘"
      ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    showString (Name -> String
    nameBase Name
    conName)
      ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    showString String
    "‘ must not use the last type variable in a function argument"
      (String -> Q a) -> String -> Q a
    forall a b. (a -> b) -> a -> b
    $ String
    ""

    -- | A constructor has a function argument in a derived Foldable or Traversable
    -- instance.
    noFunctionsError :: Name -> Q a
    noFunctionsError :: forall a. Name -> Q a
    noFunctionsError Name
    conName = String -> Q a
    forall a. String -> Q a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail
      (String -> Q a) -> ShowS -> String -> Q a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    showString String
    "Constructor ‘"
      ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    showString (Name -> String
    nameBase Name
    conName)
      ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    showString String
    "‘ must not contain function types"
      (String -> Q a) -> String -> Q a
    forall a b. (a -> b) -> a -> b
    $ String
    ""

    -- | One of the last type variables cannot be eta-reduced (see the canEtaReduce
    -- function for the criteria it would have to meet).
    etaReductionError :: Type -> Q a
    etaReductionError :: forall a. Type -> Q a
    etaReductionError Type
    instanceType = String -> Q a
    forall a. String -> Q a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail (String -> Q a) -> String -> Q a
    forall a b. (a -> b) -> a -> b
    $
      String
    "Cannot eta-reduce to an instance of form \n\tinstance (...) => "
      String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Type -> String
    forall a. Ppr a => a -> String
    pprint Type
    instanceType

    -- | The data type has a DatatypeContext which mentions one of the eta-reduced
    -- type variables.
    datatypeContextError :: Name -> Type -> Q a
    datatypeContextError :: forall a. Name -> Type -> Q a
    datatypeContextError Name
    dataName Type
    instanceType = String -> Q a
    forall a. String -> Q a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail
      (String -> Q a) -> ShowS -> String -> Q a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    showString String
    "Can't make a derived instance of ‘"
      ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    showString (Type -> String
    forall a. Ppr a => a -> String
    pprint Type
    instanceType)
      ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    showString String
    "‘:\n\tData type ‘"
      ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    showString (Name -> String
    nameBase Name
    dataName)
      ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    showString String
    "‘ must not have a class context involving the last type argument(s)"
      (String -> Q a) -> String -> Q a
    forall a b. (a -> b) -> a -> b
    $ String
    ""

    -- | The data type has an existential constraint which mentions one of the
    -- eta-reduced type variables.
    existentialContextError :: Name -> Q a
    existentialContextError :: forall a. Name -> Q a
    existentialContextError Name
    conName = String -> Q a
    forall a. String -> Q a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail
      (String -> Q a) -> ShowS -> String -> Q a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    showString String
    "Constructor ‘"
      ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    showString (Name -> String
    nameBase Name
    conName)
      ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    showString String
    "‘ must be truly polymorphic in the last argument(s) of the data type"
      (String -> Q a) -> String -> Q a
    forall a b. (a -> b) -> a -> b
    $ String
    ""

    -- | The data type mentions one of the n eta-reduced type variables in a place other
    -- than the last nth positions of a data type in a constructor's field.
    outOfPlaceTyVarError :: ClassRep a => a -> Name -> Q b
    outOfPlaceTyVarError :: forall a b. ClassRep a => a -> Name -> Q b
    outOfPlaceTyVarError a
    cRep Name
    conName = String -> Q b
    forall a. String -> Q a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail
        (String -> Q b) -> ShowS -> String -> Q b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    showString String
    "Constructor ‘"
        ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    showString (Name -> String
    nameBase Name
    conName)
        ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    showString String
    "‘ must only use its last "
        ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> ShowS
    forall a. Show a => a -> ShowS
    shows Int
    n
        ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    showString String
    " type variable(s) within the last "
        ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> ShowS
    forall a. Show a => a -> ShowS
    shows Int
    n
        ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    showString String
    " argument(s) of a data type"
        (String -> Q b) -> String -> Q b
    forall a b. (a -> b) -> a -> b
    $ String
    ""
      where
        n :: Int
        n :: Int
    n = a -> Int
    forall a. ClassRep a => a -> Int
    arity a
    cRep

    enumerationError :: String -> Q a
    enumerationError :: forall a. String -> Q a
    enumerationError = String -> Q a
    forall a. String -> Q a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail (String -> Q a) -> ShowS -> String -> Q a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ShowS
    enumerationErrorStr

    enumerationOrProductError :: String -> Q a
    enumerationOrProductError :: forall a. String -> Q a
    enumerationOrProductError String
    nb = String -> Q a
    forall a. String -> Q a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail (String -> Q a) -> String -> Q a
    forall a b. (a -> b) -> a -> b
    $ [String] -> String
    unlines
        [ ShowS
    enumerationErrorStr String
    nb
        , String
    "\tor a product type (precisely one constructor)"
        ]

    enumerationErrorStr :: String -> String
    enumerationErrorStr :: ShowS
    enumerationErrorStr String
    nb =
        Char
    '\''Char -> ShowS
    forall a. a -> [a] -> [a]
    :String
    nb String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "’ must be an enumeration type"
                String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    " (one or more nullary, non-GADT constructors)"

    typeDataError :: Name -> Q a
    typeDataError :: forall a. Name -> Q a
    typeDataError Name
    dataName = String -> Q a
    forall a. String -> Q a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail
      (String -> Q a) -> ShowS -> String -> Q a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    showString String
    "Cannot derive instance for ‘"
      ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    showString (Name -> String
    nameBase Name
    dataName)
      ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    showString String
    "‘, which is a ‘type data‘ declaration"
      (String -> Q a) -> String -> Q a
    forall a b. (a -> b) -> a -> b
    $ String
    ""

    -------------------------------------------------------------------------------
    -- Assorted utilities
    -------------------------------------------------------------------------------

    -- | A mapping of type variable Names to their auxiliary function Names.
    type TyVarMap a = Map Name (OneOrTwoNames a)
    type TyVarMap1 = TyVarMap One
    type TyVarMap2 = TyVarMap Two

    data OneOrTwoNames a where
        OneName  :: Name         -> OneOrTwoNames One
        TwoNames :: Name -> Name -> OneOrTwoNames Two

    data One
    data Two

    interleave :: [a] -> [a] -> [a]
    interleave :: forall a. [a] -> [a] -> [a]
    interleave (a
    a1:[a]
    a1s) (a
    a2:[a]
    a2s) = a
    a1a -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :a
    a2a -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :[a] -> [a] -> [a]
    forall a. [a] -> [a] -> [a]
    interleave [a]
    a1s [a]
    a2s
    interleave [a]
    _        [a]
    _        = []

    -- filterByList, filterByLists, and partitionByList taken from GHC (BSD3-licensed)

    -- | 'filterByList' takes a list of Bools and a list of some elements and
    -- filters out these elements for which the corresponding value in the list of
    -- Bools is False. This function does not check whether the lists have equal
    -- length.
    filterByList :: [Bool] -> [a] -> [a]
    filterByList :: forall a. [Bool] -> [a] -> [a]
    filterByList (Bool
    True:[Bool]
    bs)  (a
    x:[a]
    xs) = a
    x a -> [a] -> [a]
    forall a. a -> [a] -> [a]
    : [Bool] -> [a] -> [a]
    forall a. [Bool] -> [a] -> [a]
    filterByList [Bool]
    bs [a]
    xs
    filterByList (Bool
    False:[Bool]
    bs) (a
    _:[a]
    xs) =     [Bool] -> [a] -> [a]
    forall a. [Bool] -> [a] -> [a]
    filterByList [Bool]
    bs [a]
    xs
    filterByList [Bool]
    _          [a]
    _      = []

    -- | 'filterByLists' takes a list of Bools and two lists as input, and
    -- outputs a new list consisting of elements from the last two input lists. For
    -- each Bool in the list, if it is 'True', then it takes an element from the
    -- former list. If it is 'False', it takes an element from the latter list.
    -- The elements taken correspond to the index of the Bool in its list.
    -- For example:
    --
    -- @
    -- filterByLists [True, False, True, False] \"abcd\" \"wxyz\" = \"axcz\"
    -- @
    --
    -- This function does not check whether the lists have equal length.
    filterByLists :: [Bool] -> [a] -> [a] -> [a]
    filterByLists :: forall a. [Bool] -> [a] -> [a] -> [a]
    filterByLists (Bool
    True:[Bool]
    bs)  (a
    x:[a]
    xs) (a
    _:[a]
    ys) = a
    x a -> [a] -> [a]
    forall a. a -> [a] -> [a]
    : [Bool] -> [a] -> [a] -> [a]
    forall a. [Bool] -> [a] -> [a] -> [a]
    filterByLists [Bool]
    bs [a]
    xs [a]
    ys
    filterByLists (Bool
    False:[Bool]
    bs) (a
    _:[a]
    xs) (a
    y:[a]
    ys) = a
    y a -> [a] -> [a]
    forall a. a -> [a] -> [a]
    : [Bool] -> [a] -> [a] -> [a]
    forall a. [Bool] -> [a] -> [a] -> [a]
    filterByLists [Bool]
    bs [a]
    xs [a]
    ys
    filterByLists [Bool]
    _          [a]
    _      [a]
    _      = []

    -- | 'partitionByList' takes a list of Bools and a list of some elements and
    -- partitions the list according to the list of Bools. Elements corresponding
    -- to 'True' go to the left; elements corresponding to 'False' go to the right.
    -- For example, @partitionByList [True, False, True] [1,2,3] == ([1,3], [2])@
    -- This function does not check whether the lists have equal
    -- length.
    partitionByList :: [Bool] -> [a] -> ([a], [a])
    partitionByList :: forall a. [Bool] -> [a] -> ([a], [a])
    partitionByList = [a] -> [a] -> [Bool] -> [a] -> ([a], [a])
    forall {a}. [a] -> [a] -> [Bool] -> [a] -> ([a], [a])
    go [] []
      where
        go :: [a] -> [a] -> [Bool] -> [a] -> ([a], [a])
    go [a]
    trues [a]
    falses (Bool
    True  : [Bool]
    bs) (a
    x : [a]
    xs) = [a] -> [a] -> [Bool] -> [a] -> ([a], [a])
    go (a
    xa -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :[a]
    trues) [a]
    falses [Bool]
    bs [a]
    xs
        go [a]
    trues [a]
    falses (Bool
    False : [Bool]
    bs) (a
    x : [a]
    xs) = [a] -> [a] -> [Bool] -> [a] -> ([a], [a])
    go [a]
    trues (a
    xa -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :[a]
    falses) [Bool]
    bs [a]
    xs
        go [a]
    trues [a]
    falses [Bool]
    _ [a]
    _ = ([a] -> [a]
    forall a. [a] -> [a]
    reverse [a]
    trues, [a] -> [a]
    forall a. [a] -> [a]
    reverse [a]
    falses)

    integerE :: Int -> Q Exp
    integerE :: Int -> Q Exp
    integerE = Lit -> Q Exp
    forall (m :: * -> *). Quote m => Lit -> m Exp
    litE (Lit -> Q Exp) -> (Int -> Lit) -> Int -> Q Exp
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Integer -> Lit
    integerL (Integer -> Lit) -> (Int -> Integer) -> Int -> Lit
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> Integer
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral

    -- | Returns True if a Type has kind *.
    hasKindStar :: Type -> Bool
    hasKindStar :: Type -> Bool
    hasKindStar VarT{}         = Bool
    True
    hasKindStar (SigT Type
    _ Type
    StarT) = Bool
    True
    hasKindStar Type
    _              = Bool
    False

    -- Returns True is a kind is equal to *, or if it is a kind variable.
    isStarOrVar :: Kind -> Bool
    isStarOrVar :: Type -> Bool
    isStarOrVar Type
    StarT  = Bool
    True
    isStarOrVar VarT{} = Bool
    True
    isStarOrVar Type
    _      = Bool
    False

    -- | @hasKindVarChain n kind@ Checks if @kind@ is of the form
    -- k_0 -> k_1 -> ... -> k_(n-1), where k0, k1, ..., and k_(n-1) can be * or
    -- kind variables.
    hasKindVarChain :: Int -> Type -> Maybe [Name]
    hasKindVarChain :: Int -> Type -> Maybe [Name]
    hasKindVarChain Int
    kindArrows Type
    t =
      let uk :: [Type]
    uk = Type -> [Type]
    uncurryKind (Type -> Type
    tyKind Type
    t)
      in if ([Type] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Type]
    uk Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1 Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    kindArrows) Bool -> Bool -> Bool
    && (Type -> Bool) -> [Type] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all Type -> Bool
    isStarOrVar [Type]
    uk
            then [Name] -> Maybe [Name]
    forall a. a -> Maybe a
    Just ([Type] -> [Name]
    forall a. TypeSubstitution a => a -> [Name]
    freeVariables [Type]
    uk)
            else Maybe [Name]
    forall a. Maybe a
    Nothing

    -- | If a Type is a SigT, returns its kind signature. Otherwise, return *.
    tyKind :: Type -> Kind
    tyKind :: Type -> Type
    tyKind (SigT Type
    _ Type
    k) = Type
    k
    tyKind Type
    _ = Type
    starK

    zipWithAndUnzipM :: Monad m
                     => (a -> b -> m (c, d)) -> [a] -> [b] -> m ([c], [d])
    zipWithAndUnzipM :: forall (m :: * -> *) a b c d.
    Monad m =>
    (a -> b -> m (c, d)) -> [a] -> [b] -> m ([c], [d])
    zipWithAndUnzipM a -> b -> m (c, d)
    f (a
    x:[a]
    xs) (b
    y:[b]
    ys) = do
        (c, d) <- a -> b -> m (c, d)
    f a
    x b
    y
        (cs, ds) <- zipWithAndUnzipM f xs ys
        return (c:cs, d:ds)
    zipWithAndUnzipM a -> b -> m (c, d)
    _ [a]
    _ [b]
    _ = ([c], [d]) -> m ([c], [d])
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([], [])
    {-# INLINE zipWithAndUnzipM #-}

    zipWith3AndUnzipM :: Monad m
                     => (a -> b -> c -> m (d, e)) -> [a] -> [b] -> [c]
                     -> m ([d], [e])
    zipWith3AndUnzipM :: forall (m :: * -> *) a b c d e.
    Monad m =>
    (a -> b -> c -> m (d, e)) -> [a] -> [b] -> [c] -> m ([d], [e])
    zipWith3AndUnzipM a -> b -> c -> m (d, e)
    f (a
    x:[a]
    xs) (b
    y:[b]
    ys) (c
    z:[c]
    zs) = do
        (d, e) <- a -> b -> c -> m (d, e)
    f a
    x b
    y c
    z
        (ds, es) <- zipWith3AndUnzipM f xs ys zs
        return (d:ds, e:es)
    zipWith3AndUnzipM a -> b -> c -> m (d, e)
    _ [a]
    _ [b]
    _ [c]
    _ = ([d], [e]) -> m ([d], [e])
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([], [])
    {-# INLINE zipWith3AndUnzipM #-}

    thd3 :: (a, b, c) -> c
    thd3 :: forall a b c. (a, b, c) -> c
    thd3 (a
    _, b
    _, c
    c) = c
    c

    unsnoc :: [a] -> Maybe ([a], a)
    unsnoc :: forall a. [a] -> Maybe ([a], a)
    unsnoc []     = Maybe ([a], a)
    forall a. Maybe a
    Nothing
    unsnoc (a
    x:[a]
    xs) = case [a] -> Maybe ([a], a)
    forall a. [a] -> Maybe ([a], a)
    unsnoc [a]
    xs of
                      Maybe ([a], a)
    Nothing    -> ([a], a) -> Maybe ([a], a)
    forall a. a -> Maybe a
    Just ([], a
    x)
                      Just ([a]
    a,a
    b) -> ([a], a) -> Maybe ([a], a)
    forall a. a -> Maybe a
    Just (a
    xa -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :[a]
    a, a
    b)

    isNullaryCon :: ConstructorInfo -> Bool
    isNullaryCon :: ConstructorInfo -> Bool
    isNullaryCon (ConstructorInfo { constructorFields :: ConstructorInfo -> [Type]
    constructorFields = [Type]
    tys }) = [Type] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Type]
    tys

    -- | Returns the number of fields for the constructor.
    conArity :: ConstructorInfo -> Int
    conArity :: ConstructorInfo -> Int
    conArity (ConstructorInfo { constructorFields :: ConstructorInfo -> [Type]
    constructorFields = [Type]
    tys }) = [Type] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Type]
    tys

    -- | Returns 'True' if it's a datatype with exactly one, non-existential constructor.
    isProductType :: NonEmpty ConstructorInfo -> Bool
    isProductType :: NonEmpty ConstructorInfo -> Bool
    isProductType (ConstructorInfo
    con :| []) = [TyVarBndrUnit] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null (ConstructorInfo -> [TyVarBndrUnit]
    constructorVars ConstructorInfo
    con)
    isProductType NonEmpty ConstructorInfo
    _           = Bool
    False

    -- | Returns 'True' if it's a datatype with one or more nullary, non-GADT
    -- constructors.
    isEnumerationType :: NonEmpty ConstructorInfo -> Bool
    isEnumerationType :: NonEmpty ConstructorInfo -> Bool
    isEnumerationType NonEmpty ConstructorInfo
    cons = (ConstructorInfo -> Bool) -> NonEmpty ConstructorInfo -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    F.all ((Bool -> Bool -> Bool)
    -> (ConstructorInfo -> Bool)
    -> (ConstructorInfo -> Bool)
    -> ConstructorInfo
    -> Bool
    forall a b c.
    (a -> b -> c)
    -> (ConstructorInfo -> a)
    -> (ConstructorInfo -> b)
    -> ConstructorInfo
    -> c
    forall (f :: * -> *) a b c.
    Applicative f =>
    (a -> b -> c) -> f a -> f b -> f c
    App.liftA2 Bool -> Bool -> Bool
    (&&) ConstructorInfo -> Bool
    isNullaryCon ConstructorInfo -> Bool
    isVanillaCon) NonEmpty ConstructorInfo
    cons

    -- | Returns 'False' if we're dealing with existential quantification or GADTs.
    isVanillaCon :: ConstructorInfo -> Bool
    isVanillaCon :: ConstructorInfo -> Bool
    isVanillaCon (ConstructorInfo { constructorContext :: ConstructorInfo -> [Type]
    constructorContext = [Type]
    ctxt, constructorVars :: ConstructorInfo -> [TyVarBndrUnit]
    constructorVars = [TyVarBndrUnit]
    vars }) =
      [Type] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Type]
    ctxt Bool -> Bool -> Bool
    && [TyVarBndrUnit] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [TyVarBndrUnit]
    vars

    -- | Generate a list of fresh names with a common prefix, and numbered suffixes.
    newNameList :: String -> Int -> Q [Name]
    newNameList :: String -> Int -> Q [Name]
    newNameList String
    prefix Int
    n = (Int -> Q Name) -> [Int] -> Q [Name]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    T.mapM (String -> Q Name
    forall (m :: * -> *). Quote m => String -> m Name
    newName (String -> Q Name) -> (Int -> String) -> Int -> Q Name
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String
    prefix String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++) ShowS -> (Int -> String) -> Int -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> String
    forall a. Show a => a -> String
    show) [Int
    1..Int
    n]

    -- | Extracts the kind from a TyVarBndr.
    tvbKind :: TyVarBndr_ flag -> Kind
    tvbKind :: forall flag. TyVarBndr_ flag -> Type
    tvbKind = (Name -> Type) -> (Name -> Type -> Type) -> TyVarBndr_ flag -> Type
    forall r flag.
    (Name -> r) -> (Name -> Type -> r) -> TyVarBndr_ flag -> r
    elimTV (\Name
    _ -> Type
    starK) (\Name
    _ Type
    k -> Type
    k)

    -- | Convert a TyVarBndr to a Type.
    tvbToType :: TyVarBndr_ flag -> Type
    tvbToType :: forall flag. TyVarBndr_ flag -> Type
    tvbToType = (Name -> Type) -> (Name -> Type -> Type) -> TyVarBndr_ flag -> Type
    forall r flag.
    (Name -> r) -> (Name -> Type -> r) -> TyVarBndr_ flag -> r
    elimTV Name -> Type
    VarT (\Name
    n Type
    k -> Type -> Type -> Type
    SigT (Name -> Type
    VarT Name
    n) Type
    k)

    -- | Applies a typeclass constraint to a type.
    applyClass :: Name -> Name -> Pred
    applyClass :: Name -> Name -> Type
    applyClass Name
    con Name
    t = Type -> Type -> Type
    AppT (Name -> Type
    ConT Name
    con) (Name -> Type
    VarT Name
    t)

    createKindChain :: Int -> Kind
    createKindChain :: Int -> Type
    createKindChain = Type -> Int -> Type
    go Type
    starK
      where
        go :: Kind -> Int -> Kind
        go :: Type -> Int -> Type
    go Type
    k !Int
    0 = Type
    k
        go Type
    k !Int
    n = Type -> Int -> Type
    go (Type -> Type -> Type
    AppT (Type -> Type -> Type
    AppT Type
    ArrowT Type
    StarT) Type
    k) (Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1)

    -- | Checks to see if the last types in a data family instance can be safely eta-
    -- reduced (i.e., dropped), given the other types. This checks for three conditions:
    --
    -- (1) All of the dropped types are type variables
    -- (2) All of the dropped types are distinct
    -- (3) None of the remaining types mention any of the dropped types
    canEtaReduce :: [Type] -> [Type] -> Bool
    canEtaReduce :: [Type] -> [Type] -> Bool
    canEtaReduce [Type]
    remaining [Type]
    dropped =
           (Type -> Bool) -> [Type] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all Type -> Bool
    isTyVar [Type]
    dropped
        Bool -> Bool -> Bool
    && [Name] -> Bool
    forall a. Ord a => [a] -> Bool
    allDistinct [Name]
    droppedNames -- Make sure not to pass something of type [Type], since Type
                                    -- didn't have an Ord instance until template-haskell-2.10.0.0
        Bool -> Bool -> Bool
    && Bool -> Bool
    not ((Type -> Bool) -> [Type] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (Type -> [Name] -> Bool
    `mentionsName` [Name]
    droppedNames) [Type]
    remaining)
      where
        droppedNames :: [Name]
        droppedNames :: [Name]
    droppedNames = (Type -> Name) -> [Type] -> [Name]
    forall a b. (a -> b) -> [a] -> [b]
    map Type -> Name
    varTToName [Type]
    dropped

    -- | Extract the Name from a type constructor. If the argument Type is not a
    -- type variable, throw an error.
    conTToName :: Type -> Name
    conTToName :: Type -> Name
    conTToName (ConT Name
    n)   = Name
    n
    conTToName (SigT Type
    t Type
    _) = Type -> Name
    conTToName Type
    t
    conTToName Type
    _          = String -> Name
    forall a. HasCallStack => String -> a
    error String
    "Not a type constructor!"

    -- | Extract Just the Name from a type variable. If the argument Type is not a
    -- type variable, return Nothing.
    varTToName_maybe :: Type -> Maybe Name
    varTToName_maybe :: Type -> Maybe Name
    varTToName_maybe (VarT Name
    n)   = Name -> Maybe Name
    forall a. a -> Maybe a
    Just Name
    n
    varTToName_maybe (SigT Type
    t Type
    _) = Type -> Maybe Name
    varTToName_maybe Type
    t
    varTToName_maybe Type
    _          = Maybe Name
    forall a. Maybe a
    Nothing

    -- | Extract the Name from a type variable. If the argument Type is not a
    -- type variable, throw an error.
    varTToName :: Type -> Name
    varTToName :: Type -> Name
    varTToName = Name -> Maybe Name -> Name
    forall a. a -> Maybe a -> a
    fromMaybe (String -> Name
    forall a. HasCallStack => String -> a
    error String
    "Not a type variable!") (Maybe Name -> Name) -> (Type -> Maybe Name) -> Type -> Name
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Type -> Maybe Name
    varTToName_maybe

    -- | Peel off a kind signature from a Type (if it has one).
    unSigT :: Type -> Type
    unSigT :: Type -> Type
    unSigT (SigT Type
    t Type
    _) = Type
    t
    unSigT Type
    t          = Type
    t

    -- | Is the given type a variable?
    isTyVar :: Type -> Bool
    isTyVar :: Type -> Bool
    isTyVar (VarT Name
    _)   = Bool
    True
    isTyVar (SigT Type
    t Type
    _) = Type -> Bool
    isTyVar Type
    t
    isTyVar Type
    _          = Bool
    False

    -- | Detect if a Name in a list of provided Names occurs as an argument to some
    -- type family. This makes an effort to exclude /oversaturated/ arguments to
    -- type families. For instance, if one declared the following type family:
    --
    -- @
    -- type family F a :: Type -> Type
    -- @
    --
    -- Then in the type @F a b@, we would consider @a@ to be an argument to @F@,
    -- but not @b@.
    isInTypeFamilyApp :: [Name] -> Type -> [Type] -> Q Bool
    isInTypeFamilyApp :: [Name] -> Type -> [Type] -> Q Bool
    isInTypeFamilyApp [Name]
    names Type
    tyFun [Type]
    tyArgs =
      case Type
    tyFun of
        ConT Name
    tcName -> Name -> Q Bool
    go Name
    tcName
        Type
    _           -> Bool -> Q Bool
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False
      where
        go :: Name -> Q Bool
        go :: Name -> Q Bool
    go Name
    tcName = do
          info <- Name -> Q Info
    reify Name
    tcName
          case info of
            FamilyI (OpenTypeFamilyD (TypeFamilyHead Name
    _ [TyVarBndr BndrVis]
    bndrs FamilyResultSig
    _ Maybe InjectivityAnn
    _)) [Dec]
    _
              -> [TyVarBndr BndrVis] -> Q Bool
    forall a. [a] -> Q Bool
    withinFirstArgs [TyVarBndr BndrVis]
    bndrs
            FamilyI (ClosedTypeFamilyD (TypeFamilyHead Name
    _ [TyVarBndr BndrVis]
    bndrs FamilyResultSig
    _ Maybe InjectivityAnn
    _) [TySynEqn]
    _) [Dec]
    _
              -> [TyVarBndr BndrVis] -> Q Bool
    forall a. [a] -> Q Bool
    withinFirstArgs [TyVarBndr BndrVis]
    bndrs
            Info
    _ -> Bool -> Q Bool
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False
          where
            withinFirstArgs :: [a] -> Q Bool
            withinFirstArgs :: forall a. [a] -> Q Bool
    withinFirstArgs [a]
    bndrs =
              let firstArgs :: [Type]
    firstArgs = Int -> [Type] -> [Type]
    forall a. Int -> [a] -> [a]
    take ([a] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [a]
    bndrs) [Type]
    tyArgs
                  argFVs :: [Name]
    argFVs    = [Type] -> [Name]
    forall a. TypeSubstitution a => a -> [Name]
    freeVariables [Type]
    firstArgs
              in Bool -> Q Bool
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool -> Q Bool) -> Bool -> Q Bool
    forall a b. (a -> b) -> a -> b
    $ (Name -> Bool) -> [Name] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (Name -> [Name] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Name]
    argFVs) [Name]
    names

    -- | Are all of the items in a list (which have an ordering) distinct?
    --
    -- This uses Set (as opposed to nub) for better asymptotic time complexity.
    allDistinct :: Ord a => [a] -> Bool
    allDistinct :: forall a. Ord a => [a] -> Bool
    allDistinct = Set a -> [a] -> Bool
    forall a. Ord a => Set a -> [a] -> Bool
    allDistinct' Set a
    forall a. Set a
    Set.empty
      where
        allDistinct' :: Ord a => Set a -> [a] -> Bool
        allDistinct' :: forall a. Ord a => Set a -> [a] -> Bool
    allDistinct' Set a
    uniqs (a
    x:[a]
    xs)
            | a
    x a -> Set a -> Bool
    forall a. Ord a => a -> Set a -> Bool
    `Set.member` Set a
    uniqs = Bool
    False
            | Bool
    otherwise            = Set a -> [a] -> Bool
    forall a. Ord a => Set a -> [a] -> Bool
    allDistinct' (a -> Set a -> Set a
    forall a. Ord a => a -> Set a -> Set a
    Set.insert a
    x Set a
    uniqs) [a]
    xs
        allDistinct' Set a
    _ [a]
    _           = Bool
    True

    -- | Does the given type mention any of the Names in the list?
    mentionsName :: Type -> [Name] -> Bool
    mentionsName :: Type -> [Name] -> Bool
    mentionsName = Type -> [Name] -> Bool
    go
      where
        go :: Type -> [Name] -> Bool
        go :: Type -> [Name] -> Bool
    go (AppT Type
    t1 Type
    t2) [Name]
    names = Type -> [Name] -> Bool
    go Type
    t1 [Name]
    names Bool -> Bool -> Bool
    || Type -> [Name] -> Bool
    go Type
    t2 [Name]
    names
        go (SigT Type
    t Type
    k)   [Name]
    names = Type -> [Name] -> Bool
    go Type
    t [Name]
    names Bool -> Bool -> Bool
    || Type -> [Name] -> Bool
    go Type
    k [Name]
    names
        go (VarT Name
    n)     [Name]
    names = Name
    n Name -> [Name] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Name]
    names
        go Type
    _            [Name]
    _     = Bool
    False

    -- | Construct a type via curried application.
    applyTy :: Type -> [Type] -> Type
    applyTy :: Type -> [Type] -> Type
    applyTy = (Type -> Type -> Type) -> Type -> [Type] -> Type
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    List.foldl' Type -> Type -> Type
    AppT

    -- | Fully applies a type constructor to its type variables.
    applyTyCon :: Name -> [Type] -> Type
    applyTyCon :: Name -> [Type] -> Type
    applyTyCon = Type -> [Type] -> Type
    applyTy (Type -> [Type] -> Type)
    -> (Name -> Type) -> Name -> [Type] -> Type
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> Type
    ConT

    -- | Split an applied type into its individual components. For example, this:
    --
    -- @
    -- Either Int Char
    -- @
    --
    -- would split to this:
    --
    -- @
    -- [Either, Int, Char]
    -- @
    unapplyTy :: Type -> (Type, [Type])
    unapplyTy :: Type -> (Type, [Type])
    unapplyTy Type
    ty = Type -> Type -> [Type] -> (Type, [Type])
    go Type
    ty Type
    ty []
      where
        go :: Type -> Type -> [Type] -> (Type, [Type])
        go :: Type -> Type -> [Type] -> (Type, [Type])
    go Type
    _      (AppT Type
    ty1 Type
    ty2)     [Type]
    args = Type -> Type -> [Type] -> (Type, [Type])
    go Type
    ty1 Type
    ty1 (Type
    ty2Type -> [Type] -> [Type]
    forall a. a -> [a] -> [a]
    :[Type]
    args)
        go Type
    origTy (SigT Type
    ty' Type
    _)       [Type]
    args = Type -> Type -> [Type] -> (Type, [Type])
    go Type
    origTy Type
    ty' [Type]
    args
        go Type
    origTy (InfixT Type
    ty1 Name
    n Type
    ty2) [Type]
    args = Type -> Type -> [Type] -> (Type, [Type])
    go Type
    origTy (Name -> Type
    ConT Name
    n Type -> Type -> Type
    `AppT` Type
    ty1 Type -> Type -> Type
    `AppT` Type
    ty2) [Type]
    args
        go Type
    origTy (ParensT Type
    ty')      [Type]
    args = Type -> Type -> [Type] -> (Type, [Type])
    go Type
    origTy Type
    ty' [Type]
    args
        go Type
    origTy Type
    _                  [Type]
    args = (Type
    origTy, [Type]
    args)

    -- | Split a type signature by the arrows on its spine. For example, this:
    --
    -- @
    -- forall a b. (a ~ b) => (a -> b) -> Char -> ()
    -- @
    --
    -- would split to this:
    --
    -- @
    -- (a ~ b, [a -> b, Char, ()])
    -- @
    uncurryTy :: Type -> (Cxt, [Type])
    uncurryTy :: Type -> ([Type], [Type])
    uncurryTy (AppT (AppT Type
    ArrowT Type
    t1) Type
    t2) =
      let ([Type]
    ctxt, [Type]
    tys) = Type -> ([Type], [Type])
    uncurryTy Type
    t2
      in ([Type]
    ctxt, Type
    t1Type -> [Type] -> [Type]
    forall a. a -> [a] -> [a]
    :[Type]
    tys)
    uncurryTy (SigT Type
    t Type
    _) = Type -> ([Type], [Type])
    uncurryTy Type
    t
    uncurryTy (ForallT [TyVarBndr Specificity]
    _ [Type]
    ctxt Type
    t) =
      let ([Type]
    ctxt', [Type]
    tys) = Type -> ([Type], [Type])
    uncurryTy Type
    t
      in ([Type]
    ctxt [Type] -> [Type] -> [Type]
    forall a. [a] -> [a] -> [a]
    ++ [Type]
    ctxt', [Type]
    tys)
    uncurryTy Type
    t = ([], [Type
    t])

    -- | Like uncurryType, except on a kind level.
    uncurryKind :: Kind -> [Kind]
    uncurryKind :: Type -> [Type]
    uncurryKind = ([Type], [Type]) -> [Type]
    forall a b. (a, b) -> b
    snd (([Type], [Type]) -> [Type])
    -> (Type -> ([Type], [Type])) -> Type -> [Type]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Type -> ([Type], [Type])
    uncurryTy

    untagExpr :: [(Name, Name)] -> Q Exp -> Q Exp
    untagExpr :: [(Name, Name)] -> Q Exp -> Q Exp
    untagExpr [] Q Exp
    e = Q Exp
    e
    untagExpr ((Name
    untagThis, Name
    putTagHere) : [(Name, Name)]
    more) Q Exp
    e =
        Q Exp -> [Q Match] -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> [m Match] -> m Exp
    caseE (Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    getTagValName Q Exp -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
    `appE` Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    untagThis)
              [Q Pat -> Q Body -> [Q Dec] -> Q Match
    forall (m :: * -> *).
    Quote m =>
    m Pat -> m Body -> [m Dec] -> m Match
    match (Name -> Q Pat
    forall (m :: * -> *). Quote m => Name -> m Pat
    varP Name
    putTagHere)
                     (Q Exp -> Q Body
    forall (m :: * -> *). Quote m => m Exp -> m Body
    normalB (Q Exp -> Q Body) -> Q Exp -> Q Body
    forall a b. (a -> b) -> a -> b
    $ [(Name, Name)] -> Q Exp -> Q Exp
    untagExpr [(Name, Name)]
    more Q Exp
    e)
                     []]

    tag2ConExpr :: Type -> Q Exp
    tag2ConExpr :: Type -> Q Exp
    tag2ConExpr Type
    ty = do
        iHash  <- String -> Q Name
    forall (m :: * -> *). Quote m => String -> m Name
    newName String
    "i#"
        ty' <- freshenType ty
        lam1E (conP iHashDataName [varP iHash]) $
            varE tagToEnumHashValName `appE` varE iHash
                `sigE` return (quantifyType ty')
                -- tagToEnum# is a hack, and won't typecheck unless it's in the
                -- immediate presence of a type ascription like so:
                --
                --   tagToEnum# x :: Foo
                --
                -- We have to be careful when dealing with datatypes with type
                -- variables, since Template Haskell might reject the type variables
                -- we use for being out-of-scope. To avoid this, we explicitly
                -- collect the type variable binders and shove them into a ForallT
                -- (using th-abstraction's quantifyType function). Also make sure
                -- to freshen the bound type variables to avoid shadowed variable
                -- warnings on old versions of GHC when -Wall is enabled.

    primOrdFunTbl :: Map Name (Name, Name, Name, Name, Name)
    primOrdFunTbl :: Map Name (Name, Name, Name, Name, Name)
    primOrdFunTbl = [(Name, (Name, Name, Name, Name, Name))]
    -> Map Name (Name, Name, Name, Name, Name)
    forall k a. Ord k => [(k, a)] -> Map k a
    Map.fromList
        [ (Name
    addrHashTypeName,   ( Name
    ltAddrHashValName
                               , Name
    leAddrHashValName
                               , Name
    eqAddrHashValName
                               , Name
    geAddrHashValName
                               , Name
    gtAddrHashValName
                               ))
        , (Name
    charHashTypeName,   ( Name
    ltCharHashValName
                               , Name
    leCharHashValName
                               , Name
    eqCharHashValName
                               , Name
    geCharHashValName
                               , Name
    gtCharHashValName
                               ))
        , (Name
    doubleHashTypeName, ( Name
    ltDoubleHashValName
                               , Name
    leDoubleHashValName
                               , Name
    eqDoubleHashValName
                               , Name
    geDoubleHashValName
                               , Name
    gtDoubleHashValName
                               ))
        , (Name
    floatHashTypeName,  ( Name
    ltFloatHashValName
                               , Name
    leFloatHashValName
                               , Name
    eqFloatHashValName
                               , Name
    geFloatHashValName
                               , Name
    gtFloatHashValName
                               ))
        , (Name
    intHashTypeName,    ( Name
    ltIntHashValName
                               , Name
    leIntHashValName
                               , Name
    eqIntHashValName
                               , Name
    geIntHashValName
                               , Name
    gtIntHashValName
                               ))
        , (Name
    wordHashTypeName,   ( Name
    ltWordHashValName
                               , Name
    leWordHashValName
                               , Name
    eqWordHashValName
                               , Name
    geWordHashValName
                               , Name
    gtWordHashValName
                               ))
    #if MIN_VERSION_base(4,13,0)
        , (Name
    int8HashTypeName,   ( Name
    ltInt8HashValName
                               , Name
    leInt8HashValName
                               , Name
    eqInt8HashValName
                               , Name
    geInt8HashValName
                               , Name
    gtInt8HashValName
                               ))
        , (Name
    int16HashTypeName,  ( Name
    ltInt16HashValName
                               , Name
    leInt16HashValName
                               , Name
    eqInt16HashValName
                               , Name
    geInt16HashValName
                               , Name
    gtInt16HashValName
                               ))
        , (Name
    word8HashTypeName,  ( Name
    ltWord8HashValName
                               , Name
    leWord8HashValName
                               , Name
    eqWord8HashValName
                               , Name
    geWord8HashValName
                               , Name
    gtWord8HashValName
                               ))
        , (Name
    word16HashTypeName, ( Name
    ltWord16HashValName
                               , Name
    leWord16HashValName
                               , Name
    eqWord16HashValName
                               , Name
    geWord16HashValName
                               , Name
    gtWord16HashValName
                               ))
    #endif
    #if MIN_VERSION_base(4,16,0)
        , (Name
    int32HashTypeName,  ( Name
    ltInt32HashValName
                               , Name
    leInt32HashValName
                               , Name
    eqInt32HashValName
                               , Name
    geInt32HashValName
                               , Name
    gtInt32HashValName
                               ))
        , (Name
    word32HashTypeName, ( Name
    ltWord32HashValName
                               , Name
    leWord32HashValName
                               , Name
    eqWord32HashValName
                               , Name
    geWord32HashValName
                               , Name
    gtWord32HashValName
                               ))
    #endif
        ]

    removeClassApp :: Type -> Type
    removeClassApp :: Type -> Type
    removeClassApp (AppT Type
    _ Type
    t2) = Type
    t2
    removeClassApp Type
    t           = Type
    t

    -- This is an ugly, but unfortunately necessary hack on older versions of GHC which
    -- don't have a properly working newName. On those GHCs, even running newName on a
    -- variable isn't enought to avoid shadowed variable warnings, so we "fix" the issue by
    -- appending an uncommonly used string to the end of the name. This isn't foolproof,
    -- since a user could freshen a variable named x and still have another x_' variable in
    -- scope, but at least it's unlikely.
    freshen :: Name -> Q Name
    freshen :: Name -> Q Name
    freshen Name
    n = String -> Q Name
    forall (m :: * -> *). Quote m => String -> m Name
    newName (Name -> String
    nameBase Name
    n String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "_'")

    freshenType :: Type -> Q Type
    freshenType :: Type -> Q Type
    freshenType Type
    t =
      do let xs :: [(Name, Q Type)]
    xs = [(Name
    n, Name -> Type
    VarT (Name -> Type) -> Q Name -> Q Type
    forall a b. (a -> b) -> Q a -> Q b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` Name -> Q Name
    freshen Name
    n) | Name
    n <- Type -> [Name]
    forall a. TypeSubstitution a => a -> [Name]
    freeVariables Type
    t]
         subst <- Map Name (Q Type) -> Q (Map Name Type)
    forall (t :: * -> *) (m :: * -> *) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    forall (m :: * -> *) a. Monad m => Map Name (m a) -> m (Map Name a)
    T.sequence ([(Name, Q Type)] -> Map Name (Q Type)
    forall k a. Ord k => [(k, a)] -> Map k a
    Map.fromList [(Name, Q Type)]
    xs)
         return (applySubstitution subst t)

    enumFromToExpr :: Q Exp -> Q Exp -> Q Exp
    enumFromToExpr :: Q Exp -> Q Exp -> Q Exp
    enumFromToExpr Q Exp
    f Q Exp
    t = Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    enumFromToValName Q Exp -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
    `appE` Q Exp
    f Q Exp -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
    `appE` Q Exp
    t

    primOpAppExpr :: Q Exp -> Name -> Q Exp -> Q Exp
    primOpAppExpr :: Q Exp -> Name -> Q Exp -> Q Exp
    primOpAppExpr Q Exp
    e1 Name
    op Q Exp
    e2 = Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    isTrueHashValName Q Exp -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
    `appE`
                               Q Exp -> Q Exp -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp -> m Exp
    infixApp Q Exp
    e1 (Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    op) Q Exp
    e2

    -- | Checks if a 'Name' represents a tuple type constructor (other than '()')
    isNonUnitTuple :: Name -> Bool
    isNonUnitTuple :: Name -> Bool
    isNonUnitTuple = String -> Bool
    isNonUnitTupleString (String -> Bool) -> (Name -> String) -> Name -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> String
    nameBase

    -- | Checks if a 'String' represents a tuple (other than '()')
    isNonUnitTupleString :: String -> Bool
    isNonUnitTupleString :: String -> Bool
    isNonUnitTupleString (Char
    '(':Char
    ',':String
    _) = Bool
    True
    isNonUnitTupleString String
    _           = Bool
    False

    -- | Checks if a 'String' names a valid Haskell infix data constructor (i.e., does
    -- it begin with a colon?).
    isInfixDataCon :: String -> Bool
    isInfixDataCon :: String -> Bool
    isInfixDataCon (Char
    ':':String
    _) = Bool
    True
    isInfixDataCon String
    _       = Bool
    False

    isSym :: String -> Bool
    isSym :: String -> Bool
    isSym String
    ""      = Bool
    False
    isSym (Char
    c : String
    _) = Char -> Bool
    startsVarSym Char
    c Bool -> Bool -> Bool
    || Char -> Bool
    startsConSym Char
    c

    -------------------------------------------------------------------------------
    -- Quoted names
    -------------------------------------------------------------------------------

    -- With GHC 8.0 or later, we can simply use TemplateHaskellQuotes to quote each
    -- name, which allows deriving-compat to be built with compilers that do not
    -- support Template Haskell (e.g., stage-1 cross compilers). Unfortunately,
    -- older versions of GHC must fall back on full-blown Template Haskell.

    isTrueHashValName :: Name
    isTrueHashValName :: Name
    isTrueHashValName = 'isTrue#

    fmapConstValName :: Name
    fmapConstValName :: Name
    fmapConstValName = 'fmapConst

    replaceConstValName :: Name
    replaceConstValName :: Name
    replaceConstValName = 'replaceConst

    foldrConstValName :: Name
    foldrConstValName :: Name
    foldrConstValName = 'foldrConst

    foldMapConstValName :: Name
    foldMapConstValName :: Name
    foldMapConstValName = 'foldMapConst

    nullConstValName :: Name
    nullConstValName :: Name
    nullConstValName = 'nullConst

    traverseConstValName :: Name
    traverseConstValName :: Name
    traverseConstValName = 'traverseConst

    eqConstValName :: Name
    eqConstValName :: Name
    eqConstValName = 'eqConst

    eq1ConstValName :: Name
    eq1ConstValName :: Name
    eq1ConstValName = 'eq1Const

    liftEqConstValName :: Name
    liftEqConstValName :: Name
    liftEqConstValName = 'liftEqConst

    liftEq2ConstValName :: Name
    liftEq2ConstValName :: Name
    liftEq2ConstValName = 'liftEq2Const

    compareConstValName :: Name
    compareConstValName :: Name
    compareConstValName = 'compareConst

    ltConstValName :: Name
    ltConstValName :: Name
    ltConstValName = 'ltConst

    compare1ConstValName :: Name
    compare1ConstValName :: Name
    compare1ConstValName = 'compare1Const

    liftCompareConstValName :: Name
    liftCompareConstValName :: Name
    liftCompareConstValName = 'liftCompareConst

    liftCompare2ConstValName :: Name
    liftCompare2ConstValName :: Name
    liftCompare2ConstValName = 'liftCompare2Const

    readsPrecConstValName :: Name
    readsPrecConstValName :: Name
    readsPrecConstValName = 'readsPrecConst

    readPrecConstValName :: Name
    readPrecConstValName :: Name
    readPrecConstValName = 'readPrecConst

    readsPrec1ConstValName :: Name
    readsPrec1ConstValName :: Name
    readsPrec1ConstValName = 'readsPrec1Const

    liftReadsPrecConstValName :: Name
    liftReadsPrecConstValName :: Name
    liftReadsPrecConstValName = 'liftReadsPrecConst

    liftReadPrecConstValName :: Name
    liftReadPrecConstValName :: Name
    liftReadPrecConstValName = 'liftReadPrecConst

    liftReadsPrec2ConstValName :: Name
    liftReadsPrec2ConstValName :: Name
    liftReadsPrec2ConstValName = 'liftReadsPrec2Const

    liftReadPrec2ConstValName :: Name
    liftReadPrec2ConstValName :: Name
    liftReadPrec2ConstValName = 'liftReadPrec2Const

    showsPrecConstValName :: Name
    showsPrecConstValName :: Name
    showsPrecConstValName = 'showsPrecConst

    showsPrec1ConstValName :: Name
    showsPrec1ConstValName :: Name
    showsPrec1ConstValName = 'showsPrec1Const

    liftShowsPrecConstValName :: Name
    liftShowsPrecConstValName :: Name
    liftShowsPrecConstValName = 'liftShowsPrecConst

    liftShowsPrec2ConstValName :: Name
    liftShowsPrec2ConstValName :: Name
    liftShowsPrec2ConstValName = 'liftShowsPrec2Const

    viaTypeName :: Name
    viaTypeName :: Name
    viaTypeName = ''Via

    cHashDataName :: Name
    cHashDataName :: Name
    cHashDataName = 'C#

    dHashDataName :: Name
    dHashDataName :: Name
    dHashDataName = 'D#

    fHashDataName :: Name
    fHashDataName :: Name
    fHashDataName = 'F#

    identDataName :: Name
    identDataName :: Name
    identDataName = 'L.Ident

    iHashDataName :: Name
    iHashDataName :: Name
    iHashDataName = 'I#

    puncDataName :: Name
    puncDataName :: Name
    puncDataName = 'L.Punc

    symbolDataName :: Name
    symbolDataName :: Name
    symbolDataName = 'L.Symbol

    wrapMonadDataName :: Name
    wrapMonadDataName :: Name
    wrapMonadDataName = 'App.WrapMonad

    addrHashTypeName :: Name
    addrHashTypeName :: Name
    addrHashTypeName = ''Addr#

    boundedTypeName :: Name
    boundedTypeName :: Name
    boundedTypeName = ''Bounded

    charHashTypeName :: Name
    charHashTypeName :: Name
    charHashTypeName = ''Char#

    doubleHashTypeName :: Name
    doubleHashTypeName :: Name
    doubleHashTypeName = ''Double#

    enumTypeName :: Name
    enumTypeName :: Name
    enumTypeName = ''Enum

    floatHashTypeName :: Name
    floatHashTypeName :: Name
    floatHashTypeName = ''Float#

    foldableTypeName :: Name
    foldableTypeName :: Name
    foldableTypeName = ''Foldable

    functorTypeName :: Name
    functorTypeName :: Name
    functorTypeName = ''Functor

    intTypeName :: Name
    intTypeName :: Name
    intTypeName = ''Int

    intHashTypeName :: Name
    intHashTypeName :: Name
    intHashTypeName = ''Int#

    ixTypeName :: Name
    ixTypeName :: Name
    ixTypeName = ''Ix

    readTypeName :: Name
    readTypeName :: Name
    readTypeName = ''Read

    showTypeName :: Name
    showTypeName :: Name
    showTypeName = ''Show

    traversableTypeName :: Name
    traversableTypeName :: Name
    traversableTypeName = ''Traversable

    wordHashTypeName :: Name
    wordHashTypeName :: Name
    wordHashTypeName = ''Word#

    altValName :: Name
    altValName :: Name
    altValName = '(+++)

    appendValName :: Name
    appendValName :: Name
    appendValName = '(++)

    chooseValName :: Name
    chooseValName :: Name
    chooseValName = 'choose

    composeValName :: Name
    composeValName :: Name
    composeValName = '(.)

    constValName :: Name
    constValName :: Name
    constValName = 'const

    enumFromValName :: Name
    enumFromValName :: Name
    enumFromValName = 'enumFrom

    enumFromThenValName :: Name
    enumFromThenValName :: Name
    enumFromThenValName = 'enumFromThen

    enumFromThenToValName :: Name
    enumFromThenToValName :: Name
    enumFromThenToValName = 'enumFromThenTo

    enumFromToValName :: Name
    enumFromToValName :: Name
    enumFromToValName = 'enumFromTo

    eqAddrHashValName :: Name
    eqAddrHashValName :: Name
    eqAddrHashValName = 'eqAddr#

    eqCharHashValName :: Name
    eqCharHashValName :: Name
    eqCharHashValName = 'eqChar#

    eqDoubleHashValName :: Name
    eqDoubleHashValName :: Name
    eqDoubleHashValName = '(==##)

    eqFloatHashValName :: Name
    eqFloatHashValName :: Name
    eqFloatHashValName = 'eqFloat#

    eqIntHashValName :: Name
    eqIntHashValName :: Name
    eqIntHashValName = '(==#)

    eqWordHashValName :: Name
    eqWordHashValName :: Name
    eqWordHashValName = 'eqWord#

    errorValName :: Name
    errorValName :: Name
    errorValName = 'error

    flipValName :: Name
    flipValName :: Name
    flipValName = 'flip

    fmapValName :: Name
    fmapValName :: Name
    fmapValName = 'fmap

    foldrValName :: Name
    foldrValName :: Name
    foldrValName = 'F.foldr

    foldMapValName :: Name
    foldMapValName :: Name
    foldMapValName = 'foldMap

    fromEnumValName :: Name
    fromEnumValName :: Name
    fromEnumValName = 'fromEnum

    geAddrHashValName :: Name
    geAddrHashValName :: Name
    geAddrHashValName = 'geAddr#

    geCharHashValName :: Name
    geCharHashValName :: Name
    geCharHashValName = 'geChar#

    geDoubleHashValName :: Name
    geDoubleHashValName :: Name
    geDoubleHashValName = '(>=##)

    geFloatHashValName :: Name
    geFloatHashValName :: Name
    geFloatHashValName = 'geFloat#

    geIntHashValName :: Name
    geIntHashValName :: Name
    geIntHashValName = '(>=#)

    getTagValName :: Name
    getTagValName :: Name
    getTagValName = 'getTag

    geWordHashValName :: Name
    geWordHashValName :: Name
    geWordHashValName = 'geWord#

    gtAddrHashValName :: Name
    gtAddrHashValName :: Name
    gtAddrHashValName = 'gtAddr#

    gtCharHashValName :: Name
    gtCharHashValName :: Name
    gtCharHashValName = 'gtChar#

    gtDoubleHashValName :: Name
    gtDoubleHashValName :: Name
    gtDoubleHashValName = '(>##)

    gtFloatHashValName :: Name
    gtFloatHashValName :: Name
    gtFloatHashValName = 'gtFloat#

    gtIntHashValName :: Name
    gtIntHashValName :: Name
    gtIntHashValName = '(>#)

    gtWordHashValName :: Name
    gtWordHashValName :: Name
    gtWordHashValName = 'gtWord#

    idValName :: Name
    idValName :: Name
    idValName = 'id

    indexValName :: Name
    indexValName :: Name
    indexValName = 'index

    inRangeValName :: Name
    inRangeValName :: Name
    inRangeValName = 'inRange

    leAddrHashValName :: Name
    leAddrHashValName :: Name
    leAddrHashValName = 'leAddr#

    leCharHashValName :: Name
    leCharHashValName :: Name
    leCharHashValName = 'leChar#

    leDoubleHashValName :: Name
    leDoubleHashValName :: Name
    leDoubleHashValName = '(<=##)

    leFloatHashValName :: Name
    leFloatHashValName :: Name
    leFloatHashValName = 'leFloat#

    leIntHashValName :: Name
    leIntHashValName :: Name
    leIntHashValName = '(<=#)

    leWordHashValName :: Name
    leWordHashValName :: Name
    leWordHashValName = 'leWord#

    listValName :: Name
    listValName :: Name
    listValName = 'list

    ltAddrHashValName :: Name
    ltAddrHashValName :: Name
    ltAddrHashValName = 'ltAddr#

    ltCharHashValName :: Name
    ltCharHashValName :: Name
    ltCharHashValName = 'ltChar#

    ltDoubleHashValName :: Name
    ltDoubleHashValName :: Name
    ltDoubleHashValName = '(<##)

    ltFloatHashValName :: Name
    ltFloatHashValName :: Name
    ltFloatHashValName = 'ltFloat#

    ltIntHashValName :: Name
    ltIntHashValName :: Name
    ltIntHashValName = '(<#)

    ltWordHashValName :: Name
    ltWordHashValName :: Name
    ltWordHashValName = 'ltWord#

    minBoundValName :: Name
    minBoundValName :: Name
    minBoundValName = 'minBound

    mapValName :: Name
    mapValName :: Name
    mapValName = 'map

    maxBoundValName :: Name
    maxBoundValName :: Name
    maxBoundValName = 'maxBound

    minusIntHashValName :: Name
    minusIntHashValName :: Name
    minusIntHashValName = '(-#)

    neqIntHashValName :: Name
    neqIntHashValName :: Name
    neqIntHashValName = '(/=#)

    parenValName :: Name
    parenValName :: Name
    parenValName = 'paren

    parensValName :: Name
    parensValName :: Name
    parensValName = 'parens

    pfailValName :: Name
    pfailValName :: Name
    pfailValName = 'pfail

    plusValName :: Name
    plusValName :: Name
    plusValName = '(+)

    precValName :: Name
    precValName :: Name
    precValName = 'prec

    predValName :: Name
    predValName :: Name
    predValName = 'pred

    rangeSizeValName :: Name
    rangeSizeValName :: Name
    rangeSizeValName = 'rangeSize

    rangeValName :: Name
    rangeValName :: Name
    rangeValName = 'range

    readFieldHash :: String -> ReadPrec a -> ReadPrec a
    readFieldHash :: forall a. String -> ReadPrec a -> ReadPrec a
    readFieldHash String
    fieldName ReadPrec a
    readVal = do
            Lexeme -> ReadPrec ()
    expectP (String -> Lexeme
    L.Ident String
    fieldName)
            Lexeme -> ReadPrec ()
    expectP (String -> Lexeme
    L.Symbol String
    "#")
            Lexeme -> ReadPrec ()
    expectP (String -> Lexeme
    L.Punc String
    "=")
            ReadPrec a
    readVal
    {-# NOINLINE readFieldHash #-}

    readFieldHashValName :: Name
    readFieldHashValName :: Name
    readFieldHashValName = 'readFieldHash

    readListValName :: Name
    readListValName :: Name
    readListValName = 'readList

    readListPrecDefaultValName :: Name
    readListPrecDefaultValName :: Name
    readListPrecDefaultValName = 'readListPrecDefault

    readListPrecValName :: Name
    readListPrecValName :: Name
    readListPrecValName = 'readListPrec

    readPrec_to_SValName :: Name
    readPrec_to_SValName :: Name
    readPrec_to_SValName = 'readPrec_to_S

    readPrecValName :: Name
    readPrecValName :: Name
    readPrecValName = 'readPrec

    readS_to_PrecValName :: Name
    readS_to_PrecValName :: Name
    readS_to_PrecValName = 'readS_to_Prec

    readsPrecValName :: Name
    readsPrecValName :: Name
    readsPrecValName = 'readsPrec

    replaceValName :: Name
    replaceValName :: Name
    replaceValName = '(<$)

    resetValName :: Name
    resetValName :: Name
    resetValName = 'reset

    returnValName :: Name
    returnValName :: Name
    returnValName = 'return

    seqValName :: Name
    seqValName :: Name
    seqValName = 'seq

    showCharValName :: Name
    showCharValName :: Name
    showCharValName = 'showChar

    showListValName :: Name
    showListValName :: Name
    showListValName = 'showList

    showListWithValName :: Name
    showListWithValName :: Name
    showListWithValName = 'showListWith

    showParenValName :: Name
    showParenValName :: Name
    showParenValName = 'showParen

    showsPrecValName :: Name
    showsPrecValName :: Name
    showsPrecValName = 'showsPrec

    showSpaceValName :: Name
    showSpaceValName :: Name
    showSpaceValName = 'showSpace

    showStringValName :: Name
    showStringValName :: Name
    showStringValName = 'showString

    stepValName :: Name
    stepValName :: Name
    stepValName = 'step

    succValName :: Name
    succValName :: Name
    succValName = 'succ

    tagToEnumHashValName :: Name
    tagToEnumHashValName :: Name
    tagToEnumHashValName = 'tagToEnum#

    timesValName :: Name
    timesValName :: Name
    timesValName = '(*)

    toEnumValName :: Name
    toEnumValName :: Name
    toEnumValName = 'toEnum

    traverseValName :: Name
    traverseValName :: Name
    traverseValName = 'traverse

    unsafeIndexValName :: Name
    unsafeIndexValName :: Name
    unsafeIndexValName = 'unsafeIndex

    unsafeRangeSizeValName :: Name
    unsafeRangeSizeValName :: Name
    unsafeRangeSizeValName = 'unsafeRangeSize

    unwrapMonadValName :: Name
    unwrapMonadValName :: Name
    unwrapMonadValName = 'App.unwrapMonad

    boolTypeName :: Name
    boolTypeName :: Name
    boolTypeName = ''Bool

    falseDataName :: Name
    falseDataName :: Name
    falseDataName = 'False

    trueDataName :: Name
    trueDataName :: Name
    trueDataName = 'True

    eqDataName :: Name
    eqDataName :: Name
    eqDataName = 'EQ

    gtDataName :: Name
    gtDataName :: Name
    gtDataName = 'GT

    ltDataName :: Name
    ltDataName :: Name
    ltDataName = 'LT

    eqTypeName :: Name
    eqTypeName :: Name
    eqTypeName = ''Eq

    ordTypeName :: Name
    ordTypeName :: Name
    ordTypeName = ''Ord

    andValName :: Name
    andValName :: Name
    andValName = '(&&)

    compareValName :: Name
    compareValName :: Name
    compareValName = 'compare

    eqValName :: Name
    eqValName :: Name
    eqValName = '(==)

    geValName :: Name
    geValName :: Name
    geValName = '(>=)

    gtValName :: Name
    gtValName :: Name
    gtValName = '(>)

    leValName :: Name
    leValName :: Name
    leValName = '(<=)

    ltValName :: Name
    ltValName :: Name
    ltValName = '(<)

    notValName :: Name
    notValName :: Name
    notValName = 'not

    wHashDataName :: Name
    wHashDataName :: Name
    wHashDataName = 'W#

    expectPValName :: Name
    expectPValName :: Name
    expectPValName = 'expectP

    allValName :: Name
    allValName :: Name
    allValName = 'all

    apValName :: Name
    apValName :: Name
    apValName = '(<*>)

    pureValName :: Name
    pureValName :: Name
    pureValName = 'pure

    liftA2ValName :: Name
    liftA2ValName :: Name
    liftA2ValName = 'App.liftA2

    mappendValName :: Name
    mappendValName :: Name
    mappendValName = 'mappend

    memptyValName :: Name
    memptyValName :: Name
    memptyValName = 'mempty

    nullValName :: Name
    nullValName :: Name
    nullValName = 'null

    eq1TypeName :: Name
    eq1TypeName :: Name
    eq1TypeName = ''Eq1

    ord1TypeName :: Name
    ord1TypeName :: Name
    ord1TypeName = ''Ord1

    read1TypeName :: Name
    read1TypeName :: Name
    read1TypeName = ''Read1

    show1TypeName :: Name
    show1TypeName :: Name
    show1TypeName = ''Show1

    eq2TypeName :: Name
    eq2TypeName :: Name
    eq2TypeName = ''Eq2

    ord2TypeName :: Name
    ord2TypeName :: Name
    ord2TypeName = ''Ord2

    read2TypeName :: Name
    read2TypeName :: Name
    read2TypeName = ''Read2

    show2TypeName :: Name
    show2TypeName :: Name
    show2TypeName = ''Show2

    liftEqValName :: Name
    liftEqValName :: Name
    liftEqValName = 'liftEq

    liftEq2ValName :: Name
    liftEq2ValName :: Name
    liftEq2ValName = 'liftEq2

    liftCompareValName :: Name
    liftCompareValName :: Name
    liftCompareValName = 'liftCompare

    liftCompare2ValName :: Name
    liftCompare2ValName :: Name
    liftCompare2ValName = 'liftCompare2

    liftReadsPrecValName :: Name
    liftReadsPrecValName :: Name
    liftReadsPrecValName = 'liftReadsPrec

    liftReadListValName :: Name
    liftReadListValName :: Name
    liftReadListValName = 'liftReadList

    liftReadsPrec2ValName :: Name
    liftReadsPrec2ValName :: Name
    liftReadsPrec2ValName = 'liftReadsPrec2

    liftReadList2ValName :: Name
    liftReadList2ValName :: Name
    liftReadList2ValName = 'liftReadList2

    liftShowListValName :: Name
    liftShowListValName :: Name
    liftShowListValName = 'liftShowList

    liftShowsPrecValName :: Name
    liftShowsPrecValName :: Name
    liftShowsPrecValName = 'liftShowsPrec

    liftShowList2ValName :: Name
    liftShowList2ValName :: Name
    liftShowList2ValName = 'liftShowList2

    liftShowsPrec2ValName :: Name
    liftShowsPrec2ValName :: Name
    liftShowsPrec2ValName = 'liftShowsPrec2

    coerceValName :: Name
    coerceValName :: Name
    coerceValName = 'coerce

    #if MIN_VERSION_base(4,10,0)
    liftReadListPrecDefaultValName :: Name
    liftReadListPrecDefaultValName :: Name
    liftReadListPrecDefaultValName = 'liftReadListPrecDefault

    liftReadListPrec2DefaultValName :: Name
    liftReadListPrec2DefaultValName :: Name
    liftReadListPrec2DefaultValName = 'liftReadListPrec2Default

    liftReadListPrecValName :: Name
    liftReadListPrecValName :: Name
    liftReadListPrecValName = 'liftReadListPrec

    liftReadListPrec2ValName :: Name
    liftReadListPrec2ValName :: Name
    liftReadListPrec2ValName = 'liftReadListPrec2

    liftReadPrecValName :: Name
    liftReadPrecValName :: Name
    liftReadPrecValName = 'liftReadPrec

    liftReadPrec2ValName :: Name
    liftReadPrec2ValName :: Name
    liftReadPrec2ValName = 'liftReadPrec2
    #else
    -- This is a gross hack to avoid needing to guard some uses of these two Names
    -- in Text.Read.Deriving.Internal with even grosser CPP.

    liftReadListPrecDefaultValName :: Name
    liftReadListPrecDefaultValName =
      error "using liftReadListPrecDefault before base-4.10.*"

    liftReadListPrec2DefaultValName :: Name
    liftReadListPrec2DefaultValName =
      error "using liftReadListPrec2Default before base-4.10.*"

    liftReadListPrecValName :: Name
    liftReadListPrecValName =
      error "using liftReadListPrec before base-4.10.*"

    liftReadListPrec2ValName :: Name
    liftReadListPrec2ValName =
      error "using liftReadListPrec2 before base-4.10.*"

    liftReadPrecValName :: Name
    liftReadPrecValName =
      error "using liftReadPrec before base-4.10.*"

    liftReadPrec2ValName :: Name
    liftReadPrec2ValName =
      error "using liftReadPrec2 before base-4.10.*"
    #endif

    #if !(MIN_VERSION_base(4,10,0))
    showCommaSpace :: ShowS
    showCommaSpace = showString ", "
    #endif

    showCommaSpaceValName :: Name
    showCommaSpaceValName :: Name
    showCommaSpaceValName = 'showCommaSpace

    appEndoValName :: Name
    appEndoValName :: Name
    appEndoValName = 'appEndo

    dualDataName :: Name
    dualDataName :: Name
    dualDataName = 'Dual

    endoDataName :: Name
    endoDataName :: Name
    endoDataName = 'Endo

    getDualValName :: Name
    getDualValName :: Name
    getDualValName = 'getDual

    #if !(MIN_VERSION_base(4,11,0))
    readField :: String -> ReadPrec a -> ReadPrec a
    readField fieldName readVal = do
            expectP (L.Ident fieldName)
            expectP (L.Punc "=")
            readVal
    {-# NOINLINE readField #-}

    readSymField :: String -> ReadPrec a -> ReadPrec a
    readSymField fieldName readVal = do
            expectP (L.Punc "(")
            expectP (L.Symbol fieldName)
            expectP (L.Punc ")")
            expectP (L.Punc "=")
            readVal
    {-# NOINLINE readSymField #-}
    #endif

    readFieldValName :: Name
    readFieldValName :: Name
    readFieldValName = 'readField

    readSymFieldValName :: Name
    readSymFieldValName :: Name
    readSymFieldValName = 'readSymField

    #if MIN_VERSION_base(4,13,0)
    eqInt8HashValName :: Name
    eqInt8HashValName :: Name
    eqInt8HashValName = 'eqInt8#

    eqInt16HashValName :: Name
    eqInt16HashValName :: Name
    eqInt16HashValName = 'eqInt16#

    eqWord8HashValName :: Name
    eqWord8HashValName :: Name
    eqWord8HashValName = 'eqWord8#

    eqWord16HashValName :: Name
    eqWord16HashValName :: Name
    eqWord16HashValName = 'eqWord16#

    geInt8HashValName :: Name
    geInt8HashValName :: Name
    geInt8HashValName = 'geInt8#

    geInt16HashValName :: Name
    geInt16HashValName :: Name
    geInt16HashValName = 'geInt16#

    geWord8HashValName :: Name
    geWord8HashValName :: Name
    geWord8HashValName = 'geWord8#

    geWord16HashValName :: Name
    geWord16HashValName :: Name
    geWord16HashValName = 'geWord16#

    gtInt8HashValName :: Name
    gtInt8HashValName :: Name
    gtInt8HashValName = 'gtInt8#

    gtInt16HashValName :: Name
    gtInt16HashValName :: Name
    gtInt16HashValName = 'gtInt16#

    gtWord8HashValName :: Name
    gtWord8HashValName :: Name
    gtWord8HashValName = 'gtWord8#

    gtWord16HashValName :: Name
    gtWord16HashValName :: Name
    gtWord16HashValName = 'gtWord16#

    int8HashTypeName :: Name
    int8HashTypeName :: Name
    int8HashTypeName = ''Int8#

    int8ToIntHashValName :: Name
    int8ToIntHashValName :: Name
    int8ToIntHashValName =
    # if MIN_VERSION_base(4,16,0)
      'int8ToInt#
    # else
      'extendInt8#
    # endif

    int16HashTypeName :: Name
    int16HashTypeName :: Name
    int16HashTypeName = ''Int16#

    int16ToIntHashValName :: Name
    int16ToIntHashValName :: Name
    int16ToIntHashValName =
    # if MIN_VERSION_base(4,16,0)
      'int16ToInt#
    # else
      'extendInt16#
    # endif

    intToInt8HashValName :: Name
    intToInt8HashValName :: Name
    intToInt8HashValName =
    # if MIN_VERSION_base(4,16,0)
      'intToInt8#
    # else
      'narrowInt8#
    # endif

    intToInt16HashValName :: Name
    intToInt16HashValName :: Name
    intToInt16HashValName =
    # if MIN_VERSION_base(4,16,0)
      'intToInt16#
    # else
      'narrowInt16#
    # endif

    leInt8HashValName :: Name
    leInt8HashValName :: Name
    leInt8HashValName = 'leInt8#

    leInt16HashValName :: Name
    leInt16HashValName :: Name
    leInt16HashValName = 'leInt16#

    leWord8HashValName :: Name
    leWord8HashValName :: Name
    leWord8HashValName = 'leWord8#

    leWord16HashValName :: Name
    leWord16HashValName :: Name
    leWord16HashValName = 'leWord16#

    ltInt8HashValName :: Name
    ltInt8HashValName :: Name
    ltInt8HashValName = 'ltInt8#

    ltInt16HashValName :: Name
    ltInt16HashValName :: Name
    ltInt16HashValName = 'ltInt16#

    ltWord8HashValName :: Name
    ltWord8HashValName :: Name
    ltWord8HashValName = 'ltWord8#

    ltWord16HashValName :: Name
    ltWord16HashValName :: Name
    ltWord16HashValName = 'ltWord16#

    word8HashTypeName :: Name
    word8HashTypeName :: Name
    word8HashTypeName = ''Word8#

    word8ToWordHashValName :: Name
    word8ToWordHashValName :: Name
    word8ToWordHashValName =
    # if MIN_VERSION_base(4,16,0)
      'word8ToWord#
    # else
      'extendWord8#
    # endif

    word16HashTypeName :: Name
    word16HashTypeName :: Name
    word16HashTypeName = ''Word16#

    word16ToWordHashValName :: Name
    word16ToWordHashValName :: Name
    word16ToWordHashValName =
    # if MIN_VERSION_base(4,16,0)
      'word16ToWord#
    # else
      'extendWord16#
    # endif

    wordToWord8HashValName :: Name
    wordToWord8HashValName :: Name
    wordToWord8HashValName =
    # if MIN_VERSION_base(4,16,0)
      'wordToWord8#
    # else
      'narrowWord8#
    # endif

    wordToWord16HashValName :: Name
    wordToWord16HashValName :: Name
    wordToWord16HashValName =
    # if MIN_VERSION_base(4,16,0)
      'wordToWord16#
    # else
      'narrowWord16#
    # endif
    #endif

    #if MIN_VERSION_base(4,16,0)
    eqInt32HashValName :: Name
    eqInt32HashValName :: Name
    eqInt32HashValName = 'eqInt32#

    eqWord32HashValName :: Name
    eqWord32HashValName :: Name
    eqWord32HashValName = 'eqWord32#

    geInt32HashValName :: Name
    geInt32HashValName :: Name
    geInt32HashValName = 'geInt32#

    geWord32HashValName :: Name
    geWord32HashValName :: Name
    geWord32HashValName = 'geWord32#

    gtInt32HashValName :: Name
    gtInt32HashValName :: Name
    gtInt32HashValName = 'gtInt32#

    gtWord32HashValName :: Name
    gtWord32HashValName :: Name
    gtWord32HashValName = 'gtWord32#

    int32HashTypeName :: Name
    int32HashTypeName :: Name
    int32HashTypeName = ''Int32#

    int32ToIntHashValName :: Name
    int32ToIntHashValName :: Name
    int32ToIntHashValName = 'int32ToInt#

    intToInt32HashValName :: Name
    intToInt32HashValName :: Name
    intToInt32HashValName = 'intToInt32#

    leInt32HashValName :: Name
    leInt32HashValName :: Name
    leInt32HashValName = 'leInt32#

    leWord32HashValName :: Name
    leWord32HashValName :: Name
    leWord32HashValName = 'leWord32#

    ltInt32HashValName :: Name
    ltInt32HashValName :: Name
    ltInt32HashValName = 'ltInt32#

    ltWord32HashValName :: Name
    ltWord32HashValName :: Name
    ltWord32HashValName = 'ltWord32#

    word32HashTypeName :: Name
    word32HashTypeName :: Name
    word32HashTypeName = ''Word32#

    word32ToWordHashValName :: Name
    word32ToWordHashValName :: Name
    word32ToWordHashValName = 'word32ToWord#

    wordToWord32HashValName :: Name
    wordToWord32HashValName :: Name
    wordToWord32HashValName = 'wordToWord32#
    #endif

    #if MIN_VERSION_base(4,19,0)
    i8HashDataName :: Name
    i8HashDataName :: Name
    i8HashDataName = 'I8#

    i16HashDataName :: Name
    i16HashDataName :: Name
    i16HashDataName = 'I16#

    i32HashDataName :: Name
    i32HashDataName :: Name
    i32HashDataName = 'I32#

    i64HashDataName :: Name
    i64HashDataName :: Name
    i64HashDataName = 'I64#

    int64HashTypeName :: Name
    int64HashTypeName :: Name
    int64HashTypeName = ''Int64#

    w8HashDataName :: Name
    w8HashDataName :: Name
    w8HashDataName = 'W8#

    w16HashDataName :: Name
    w16HashDataName :: Name
    w16HashDataName = 'W16#

    w32HashDataName :: Name
    w32HashDataName :: Name
    w32HashDataName = 'W32#

    w64HashDataName :: Name
    w64HashDataName :: Name
    w64HashDataName = 'W64#

    word64HashTypeName :: Name
    word64HashTypeName :: Name
    word64HashTypeName = ''Word64#
    #endif