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

    #if __GLASGOW_HASKELL__ >= 800
    {-# LANGUAGE TemplateHaskellQuotes #-}
    #endif

    {- |
    Module      :  Generics.Deriving.TH.Internal
    Copyright   :  (c) 2008--2009 Universiteit Utrecht
    License     :  BSD3

    Maintainer  :  generics@haskell.org
    Stability   :  experimental
    Portability :  non-portable

    Template Haskell-related utilities.
    -}

    module Generics.Deriving.TH.Internal where

    import           Control.Monad (unless)

    import           Data.Char (isAlphaNum, ord)
    import           Data.Foldable (foldr')
    import qualified Data.List as List
    import qualified Data.Map as Map
    import           Data.Map as Map (Map)
    import           Data.Maybe (mapMaybe)
    import qualified Data.Set as Set
    import           Data.Set (Set)

    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

    #if __GLASGOW_HASKELL__ >= 800
    import qualified Generics.Deriving as GD
    import           Generics.Deriving hiding
                       ( DecidedStrictness(..), Fixity(Infix)
                       , SourceStrictness(..), SourceUnpackedness(..)
                       , datatypeName
                       )
    import           GHC.Exts (Addr#, Char#, Double#, Float#, Int#, Word#)
    #else
    # ifndef CURRENT_PACKAGE_KEY
    import           Data.Version (showVersion)
    import           Paths_generic_deriving (version)
    # endif
    #endif

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

    type TypeSubst = Map Name Type

    applySubstitutionKind :: Map Name Kind -> Type -> Type
    #if MIN_VERSION_template_haskell(2,8,0)
    applySubstitutionKind :: Map Name Type -> Type -> Type
    applySubstitutionKind = Map Name Type -> Type -> Type
    forall a. TypeSubstitution a => Map Name Type -> a -> a
    applySubstitution
    #else
    applySubstitutionKind _ t = t
    #endif

    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
    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

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

    -- | Whether a type is of kind @*@, a kind variable, or some other kind. The
    -- kind variable case is given special treatment solely to support GHC 8.0 and
    -- earlier, in which Generic1 was not poly-kinded. In order to support deriving
    -- Generic1 instances on these versions of GHC, we must substitute such kinds
    -- with @*@ to ensure that the resulting instance is well kinded.
    -- See @Note [Generic1 is polykinded in base-4.10]@ in "Generics.Deriving.TH".
    data StarKindStatus = KindStar
                        | IsKindVar Name
                        | OtherKind
      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
    #if MIN_VERSION_template_haskell(2,8,0)
                         SigT Type
    _ (VarT Name
    k) -> Name -> StarKindStatus
    IsKindVar Name
    k
    #endif
                         Type
    _               -> StarKindStatus
    OtherKind

    -- | 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

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

    -- | Returns True if a Type has kind *.
    hasKindStar :: Type -> Bool
    hasKindStar :: Type -> Bool
    hasKindStar VarT{}         = Bool
    True
    #if MIN_VERSION_template_haskell(2,8,0)
    hasKindStar (SigT Type
    _ Type
    StarT) = Bool
    True
    #else
    hasKindStar (SigT _ StarK) = True
    #endif
    hasKindStar Type
    _              = Bool
    False

    -- | Converts a VarT or a SigT into Just the corresponding TyVarBndr.
    -- Converts other Types to Nothing.
    typeToTyVarBndr :: Type -> Maybe TyVarBndrUnit
    typeToTyVarBndr :: Type -> Maybe TyVarBndrUnit
    typeToTyVarBndr (VarT Name
    n)          = TyVarBndrUnit -> Maybe TyVarBndrUnit
    forall a. a -> Maybe a
    Just (Name -> TyVarBndrUnit
    plainTV Name
    n)
    typeToTyVarBndr (SigT (VarT Name
    n) Type
    k) = TyVarBndrUnit -> Maybe TyVarBndrUnit
    forall a. a -> Maybe a
    Just (Name -> Type -> TyVarBndrUnit
    kindedTV Name
    n Type
    k)
    typeToTyVarBndr Type
    _                 = Maybe TyVarBndrUnit
    forall a. Maybe a
    Nothing

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

    -- | Turns
    --
    -- @
    -- [a, b] c
    -- @
    --
    -- into
    --
    -- @
    -- a -> b -> c
    -- @
    makeFunType :: [Type] -> Type -> Type
    makeFunType :: [Type] -> Type -> Type
    makeFunType [Type]
    argTys Type
    resTy = (Type -> Type -> Type) -> Type -> [Type] -> Type
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr' (Type -> Type -> Type
    AppT (Type -> Type -> Type) -> (Type -> Type) -> Type -> Type -> Type
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Type -> Type -> Type
    AppT Type
    ArrowT) Type
    resTy [Type]
    argTys

    -- | Turns
    --
    -- @
    -- [k1, k2] k3
    -- @
    --
    -- into
    --
    -- @
    -- k1 -> k2 -> k3
    -- @
    makeFunKind :: [Kind] -> Kind -> Kind
    #if MIN_VERSION_template_haskell(2,8,0)
    makeFunKind :: [Type] -> Type -> Type
    makeFunKind = [Type] -> Type -> Type
    makeFunType
    #else
    makeFunKind argKinds resKind = foldr' ArrowK resKind argKinds
    #endif

    -- | Remove any outer `SigT` and `ParensT` constructors, and turn
    -- an outermost `InfixT` constructor into plain applications.
    dustOff :: Type -> Type
    dustOff :: Type -> Type
    dustOff (SigT Type
    ty Type
    _) = Type -> Type
    dustOff Type
    ty
    #if MIN_VERSION_template_haskell(2,11,0)
    dustOff (ParensT Type
    ty) = Type -> Type
    dustOff Type
    ty
    dustOff (InfixT Type
    ty1 Name
    n Type
    ty2) = Name -> Type
    ConT Name
    n Type -> Type -> Type
    `AppT` Type
    ty1 Type -> Type -> Type
    `AppT` Type
    ty2
    #endif
    dustOff Type
    ty = Type
    ty

    -- | Checks whether a type is an unsaturated type family
    -- application.
    isUnsaturatedType :: Type -> Q Bool
    isUnsaturatedType :: Type -> Q Bool
    isUnsaturatedType = Int -> Type -> Q Bool
    go Int
    0 (Type -> Q Bool) -> (Type -> Type) -> Type -> Q Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Type -> Type
    dustOff
      where
        -- Expects its argument to be dusted
        go :: Int -> Type -> Q Bool
        go :: Int -> Type -> Q Bool
    go Int
    d Type
    t = case Type
    t of
          ConT Name
    tcName -> Int -> Name -> Q Bool
    check Int
    d Name
    tcName
          AppT Type
    f Type
    _ -> Int -> Type -> Q Bool
    go (Int
    d Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1) (Type -> Type
    dustOff Type
    f)
          Type
    _ -> Bool -> Q Bool
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False

        check :: Int -> Name -> Q Bool
        check :: Int -> Name -> Q Bool
    check Int
    d Name
    tcName = do
          Maybe [TyVarBndrUnit]
    mbinders <- Name -> Q (Maybe [TyVarBndrUnit])
    getTypeFamilyBinders Name
    tcName
          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
    $ case Maybe [TyVarBndrUnit]
    mbinders of
            Just [TyVarBndrUnit]
    bndrs -> [TyVarBndrUnit] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [TyVarBndrUnit]
    bndrs Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    d
            Maybe [TyVarBndrUnit]
    Nothing -> Bool
    False

    -- | Given a name, check if that name is a type family. If
    -- so, return a list of its binders.
    getTypeFamilyBinders :: Name -> Q (Maybe [TyVarBndrVis])
    getTypeFamilyBinders :: Name -> Q (Maybe [TyVarBndrUnit])
    getTypeFamilyBinders Name
    tcName = do
          Info
    info <- Name -> Q Info
    reify Name
    tcName
          Maybe [TyVarBndrUnit] -> Q (Maybe [TyVarBndrUnit])
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe [TyVarBndrUnit] -> Q (Maybe [TyVarBndrUnit]))
    -> Maybe [TyVarBndrUnit] -> Q (Maybe [TyVarBndrUnit])
    forall a b. (a -> b) -> a -> b
    $ case Info
    info of
    #if MIN_VERSION_template_haskell(2,11,0)
            FamilyI (OpenTypeFamilyD (TypeFamilyHead Name
    _ [TyVarBndrUnit]
    bndrs FamilyResultSig
    _ Maybe InjectivityAnn
    _)) [Dec]
    _
              -> [TyVarBndrUnit] -> Maybe [TyVarBndrUnit]
    forall a. a -> Maybe a
    Just [TyVarBndrUnit]
    bndrs
    #elif MIN_VERSION_template_haskell(2,7,0)
            FamilyI (FamilyD TypeFam _ bndrs _) _
              -> Just bndrs
    #else
            TyConI (FamilyD TypeFam _ bndrs _)
              -> Just bndrs
    #endif

    #if MIN_VERSION_template_haskell(2,11,0)
            FamilyI (ClosedTypeFamilyD (TypeFamilyHead Name
    _ [TyVarBndrUnit]
    bndrs FamilyResultSig
    _ Maybe InjectivityAnn
    _) [TySynEqn]
    _) [Dec]
    _
              -> [TyVarBndrUnit] -> Maybe [TyVarBndrUnit]
    forall a. a -> Maybe a
    Just [TyVarBndrUnit]
    bndrs
    #elif MIN_VERSION_template_haskell(2,9,0)
            FamilyI (ClosedTypeFamilyD _ bndrs _ _) _
              -> Just bndrs
    #endif

            Info
    _ -> Maybe [TyVarBndrUnit]
    forall a. Maybe a
    Nothing

    -- | True if the type does not mention the Name
    ground :: Type -> Name -> Bool
    ground :: Type -> Name -> Bool
    ground Type
    ty Name
    name = Name
    name Name -> [Name] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `notElem` Type -> [Name]
    forall a. TypeSubstitution a => a -> [Name]
    freeVariables Type
    ty

    -- | Construct a type via curried application.
    applyTyToTys :: Type -> [Type] -> Type
    applyTyToTys :: Type -> [Type] -> Type
    applyTyToTys = (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

    -- | Apply a type constructor name to type variable binders.
    applyTyToTvbs :: Name -> [TyVarBndr_ flag] -> Type
    applyTyToTvbs :: forall flag. Name -> [TyVarBndr_ flag] -> Type
    applyTyToTvbs = (Type -> TyVarBndr_ flag -> Type)
    -> Type -> [TyVarBndr_ flag] -> 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
    a -> Type -> Type -> Type
    AppT Type
    a (Type -> Type)
    -> (TyVarBndr_ flag -> Type) -> TyVarBndr_ flag -> Type
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TyVarBndr_ flag -> Type
    forall flag. TyVarBndr_ flag -> Type
    tyVarBndrToType) (Type -> [TyVarBndr_ flag] -> Type)
    -> (Name -> Type) -> Name -> [TyVarBndr_ flag] -> Type
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> Type
    ConT

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

    -- | Like uncurryType, except on a kind level.
    uncurryKind :: Kind -> ([TyVarBndrSpec], [Kind])
    #if MIN_VERSION_template_haskell(2,8,0)
    uncurryKind :: Type -> ([TyVarBndrSpec], [Type])
    uncurryKind = Type -> ([TyVarBndrSpec], [Type])
    uncurryTy
    #else
    uncurryKind (ArrowK k1 k2) =
      let (kvbs, ks) = uncurryKind k2
      in (kvbs, k1:ks)
    uncurryKind k = ([], [k])
    #endif

    tyVarBndrToType :: TyVarBndr_ flag -> Type
    tyVarBndrToType :: forall flag. TyVarBndr_ flag -> Type
    tyVarBndrToType = (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)

    -- | 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]
    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 -> String -> String
    forall a. [a] -> [a] -> [a]
    ++) (String -> String) -> (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]

    -- | 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
           -- 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
    && [Name] -> Bool
    forall a. Ord a => [a] -> Bool
    allDistinct [Name]
    droppedNames
        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 variable. If the argument Type is not a
    -- type variable, throw an error.
    varTToName :: Type -> Name
    varTToName :: Type -> Name
    varTToName (VarT Name
    n)   = Name
    n
    varTToName (SigT Type
    t Type
    _) = Type -> Name
    varTToName Type
    t
    varTToName Type
    _          = String -> Name
    forall a. HasCallStack => String -> a
    error String
    "Not a type variable!"

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

    -- | Is the given kind a variable?
    isKindVar :: Kind -> Bool
    #if MIN_VERSION_template_haskell(2,8,0)
    isKindVar :: Type -> Bool
    isKindVar = Type -> Bool
    isTyVar
    #else
    isKindVar _ = False -- There are no kind variables
    #endif

    -- | Returns 'True' is a 'Type' contains no type variables.
    isTypeMonomorphic :: Type -> Bool
    isTypeMonomorphic :: Type -> Bool
    isTypeMonomorphic = Type -> Bool
    go
      where
        go :: Type -> Bool
        go :: Type -> Bool
    go (AppT Type
    t1 Type
    t2) = Type -> Bool
    go Type
    t1 Bool -> Bool -> Bool
    && Type -> Bool
    go Type
    t2
        go (SigT Type
    t Type
    _k)  = Type -> Bool
    go Type
    t
    #if MIN_VERSION_template_haskell(2,8,0)
                               Bool -> Bool -> Bool
    && Type -> Bool
    go Type
    _k
    #endif
        go VarT{}       = Bool
    False
        go Type
    _            = Bool
    True

    -- | 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

    -- | Peel off a kind signature from a TyVarBndr (if it has one).
    unKindedTV :: TyVarBndrUnit -> TyVarBndrUnit
    unKindedTV :: TyVarBndrUnit -> TyVarBndrUnit
    unKindedTV TyVarBndrUnit
    tvb = (Name -> TyVarBndrUnit)
    -> (Name -> Type -> TyVarBndrUnit)
    -> TyVarBndrUnit
    -> TyVarBndrUnit
    forall r flag.
    (Name -> r) -> (Name -> Type -> r) -> TyVarBndr_ flag -> r
    elimTV (\Name
    _ -> TyVarBndrUnit
    tvb) (\Name
    n Type
    _ -> Name -> TyVarBndrUnit
    plainTV Name
    n) TyVarBndrUnit
    tvb

    -- | 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
    #if MIN_VERSION_template_haskell(2,8,0)
                                  Bool -> Bool -> Bool
    || Type -> [Name] -> Bool
    go Type
    _k [Name]
    names
    #endif
        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

    -- | 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

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

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

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

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

    foldBal :: (a -> a -> a) -> a -> [a] -> a
    {-# INLINE foldBal #-} -- inlined to produce specialised code for each op
    foldBal :: forall a. (a -> a -> a) -> a -> [a] -> a
    foldBal a -> a -> a
    op0 a
    x0 [a]
    xs0 = (a -> a -> a) -> a -> Int -> [a] -> a
    forall {t}. (t -> t -> t) -> t -> Int -> [t] -> t
    fold_bal a -> a -> a
    op0 a
    x0 ([a] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [a]
    xs0) [a]
    xs0
      where
        fold_bal :: (t -> t -> t) -> t -> Int -> [t] -> t
    fold_bal t -> t -> t
    op t
    x !Int
    n [t]
    xs = case [t]
    xs of
          []  -> t
    x
          [t
    a] -> t
    a
          [t]
    _   -> let !nl :: Int
    nl = Int
    n Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `div` Int
    2
                     !nr :: Int
    nr = Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    nl
                     ([t]
    l,[t]
    r) = Int -> [t] -> ([t], [t])
    forall a. Int -> [a] -> ([a], [a])
    splitAt Int
    nl [t]
    xs
                 in (t -> t -> t) -> t -> Int -> [t] -> t
    fold_bal t -> t -> t
    op t
    x Int
    nl [t]
    l
                    t -> t -> t
    `op` (t -> t -> t) -> t -> Int -> [t] -> t
    fold_bal t -> t -> t
    op t
    x Int
    nr [t]
    r

    isNewtypeVariant :: DatatypeVariant_ -> Bool
    isNewtypeVariant :: DatatypeVariant_ -> Bool
    isNewtypeVariant DatatypeVariant_
    Datatype_             = Bool
    False
    isNewtypeVariant DatatypeVariant_
    Newtype_              = Bool
    True
    isNewtypeVariant (DataInstance_ {})    = Bool
    False
    isNewtypeVariant (NewtypeInstance_ {}) = Bool
    True

    -- | Indicates whether Generic or Generic1 is being derived.
    data GenericClass = Generic | Generic1 deriving Int -> GenericClass
    GenericClass -> Int
    GenericClass -> [GenericClass]
    GenericClass -> GenericClass
    GenericClass -> GenericClass -> [GenericClass]
    GenericClass -> GenericClass -> GenericClass -> [GenericClass]
    (GenericClass -> GenericClass)
    -> (GenericClass -> GenericClass)
    -> (Int -> GenericClass)
    -> (GenericClass -> Int)
    -> (GenericClass -> [GenericClass])
    -> (GenericClass -> GenericClass -> [GenericClass])
    -> (GenericClass -> GenericClass -> [GenericClass])
    -> (GenericClass -> GenericClass -> GenericClass -> [GenericClass])
    -> Enum GenericClass
    forall a.
    (a -> a)
    -> (a -> a)
    -> (Int -> a)
    -> (a -> Int)
    -> (a -> [a])
    -> (a -> a -> [a])
    -> (a -> a -> [a])
    -> (a -> a -> a -> [a])
    -> Enum a
    $csucc :: GenericClass -> GenericClass
    succ :: GenericClass -> GenericClass
    $cpred :: GenericClass -> GenericClass
    pred :: GenericClass -> GenericClass
    $ctoEnum :: Int -> GenericClass
    toEnum :: Int -> GenericClass
    $cfromEnum :: GenericClass -> Int
    fromEnum :: GenericClass -> Int
    $cenumFrom :: GenericClass -> [GenericClass]
    enumFrom :: GenericClass -> [GenericClass]
    $cenumFromThen :: GenericClass -> GenericClass -> [GenericClass]
    enumFromThen :: GenericClass -> GenericClass -> [GenericClass]
    $cenumFromTo :: GenericClass -> GenericClass -> [GenericClass]
    enumFromTo :: GenericClass -> GenericClass -> [GenericClass]
    $cenumFromThenTo :: GenericClass -> GenericClass -> GenericClass -> [GenericClass]
    enumFromThenTo :: GenericClass -> GenericClass -> GenericClass -> [GenericClass]
    Enum

    -- | Records information about the type variables of a data type with a
    -- 'Generic' or 'Generic1' instance.
    data GenericTvbs
        -- | Information about a data type with a 'Generic' instance.
      = Gen0
          { GenericTvbs -> [TyVarBndrUnit]
    gen0Tvbs :: [TyVarBndrUnit]
            -- ^ All of the type variable arguments to the data type.
          }
        -- | Information about a data type with a 'Generic1' instance.
      | Gen1
          { GenericTvbs -> [TyVarBndrUnit]
    gen1InitTvbs :: [TyVarBndrUnit]
            -- ^ All of the type variable arguments to the data type except the
            --   last one. In a @'Generic1' (T a_1 ... a_(n-1))@ instance, the
            --   'gen1InitTvbs' would be @[a_1, ..., a_(n-1)]@.
          , GenericTvbs -> Name
    gen1LastTvbName :: Name
            -- ^ The name of the last type variable argument to the data type.
            --   In a @'Generic1' (T a_1 ... a_(n-1))@ instance, the
            --   'gen1LastTvbName' name would be @a_n@.
         , GenericTvbs -> Maybe Name
    gen1LastTvbKindVar :: Maybe Name
            -- ^ If the 'gen1LastTvbName' has kind @k@, where @k@ is some kind
            --   variable, then the 'gen1LastTvbKindVar' is @'Just' k@. Otherwise,
            --   the 'gen1LastTvbKindVar' is 'Nothing'.
          }

    -- | Compute 'GenericTvbs' from a 'GenericClass' and the type variable
    -- arguments to a data type.
    mkGenericTvbs :: GenericClass -> [Type] -> GenericTvbs
    mkGenericTvbs :: GenericClass -> [Type] -> GenericTvbs
    mkGenericTvbs GenericClass
    gClass [Type]
    tySynVars =
      case GenericClass
    gClass of
        GenericClass
    Generic  -> Gen0{gen0Tvbs :: [TyVarBndrUnit]
    gen0Tvbs = [Type] -> [TyVarBndrUnit]
    freeVariablesWellScoped [Type]
    tySynVars}
        GenericClass
    Generic1 -> Gen1{ gen1InitTvbs :: [TyVarBndrUnit]
    gen1InitTvbs       = [Type] -> [TyVarBndrUnit]
    freeVariablesWellScoped [Type]
    initArgs
                        , gen1LastTvbName :: Name
    gen1LastTvbName    = Type -> Name
    varTToName Type
    lastArg
                        , gen1LastTvbKindVar :: Maybe Name
    gen1LastTvbKindVar = Maybe Name
    mbLastArgKindName
                        }
      where
        -- Everything below is only used for Generic1.
        initArgs :: [Type]
        initArgs :: [Type]
    initArgs = [Type] -> [Type]
    forall a. HasCallStack => [a] -> [a]
    init [Type]
    tySynVars

        lastArg :: Type
        lastArg :: Type
    lastArg = [Type] -> Type
    forall a. HasCallStack => [a] -> a
    last [Type]
    tySynVars

        mbLastArgKindName :: Maybe Name
        mbLastArgKindName :: Maybe Name
    mbLastArgKindName = StarKindStatus -> Maybe Name
    starKindStatusToName
                          (StarKindStatus -> Maybe Name) -> StarKindStatus -> Maybe Name
    forall a b. (a -> b) -> a -> b
    $ Type -> StarKindStatus
    canRealizeKindStar Type
    lastArg

    -- | Return the type variable arguments to a data type that appear in a
    -- 'Generic' or 'Generic1' instance. For a 'Generic' instance, this consists of
    -- all the type variable arguments. For a 'Generic1' instance, this consists of
    -- all the type variable arguments except for the last one.
    genericInitTvbs :: GenericTvbs -> [TyVarBndrUnit]
    genericInitTvbs :: GenericTvbs -> [TyVarBndrUnit]
    genericInitTvbs (Gen0{gen0Tvbs :: GenericTvbs -> [TyVarBndrUnit]
    gen0Tvbs = [TyVarBndrUnit]
    tvbs})     = [TyVarBndrUnit]
    tvbs
    genericInitTvbs (Gen1{gen1InitTvbs :: GenericTvbs -> [TyVarBndrUnit]
    gen1InitTvbs = [TyVarBndrUnit]
    tvbs}) = [TyVarBndrUnit]
    tvbs

    -- | A version of 'DatatypeVariant' in which the data family instance
    -- constructors come equipped with the 'ConstructorInfo' of the first
    -- constructor in the family instance (for 'Name' generation purposes).
    data DatatypeVariant_
      = Datatype_
      | Newtype_
      | DataInstance_    ConstructorInfo
      | NewtypeInstance_ ConstructorInfo

    showsDatatypeVariant :: DatatypeVariant_ -> ShowS
    showsDatatypeVariant :: DatatypeVariant_ -> String -> String
    showsDatatypeVariant DatatypeVariant_
    variant = (String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Char
    '_'Char -> String -> String
    forall a. a -> [a] -> [a]
    :String
    label)
      where
        dataPlain :: String
        dataPlain :: String
    dataPlain = String
    "Plain"

        dataFamily :: ConstructorInfo -> String
        dataFamily :: ConstructorInfo -> String
    dataFamily ConstructorInfo
    con = String
    "Family_" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    sanitizeName (Name -> String
    nameBase (Name -> String) -> Name -> String
    forall a b. (a -> b) -> a -> b
    $ ConstructorInfo -> Name
    constructorName ConstructorInfo
    con)

        label :: String
        label :: String
    label = case DatatypeVariant_
    variant of
                  DatatypeVariant_
    Datatype_            -> String
    dataPlain
                  DatatypeVariant_
    Newtype_             -> String
    dataPlain
                  DataInstance_    ConstructorInfo
    con -> ConstructorInfo -> String
    dataFamily ConstructorInfo
    con
                  NewtypeInstance_ ConstructorInfo
    con -> ConstructorInfo -> String
    dataFamily ConstructorInfo
    con

    showNameQual :: Name -> String
    showNameQual :: Name -> String
    showNameQual = String -> String
    sanitizeName (String -> String) -> (Name -> String) -> Name -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> String
    showQual
      where
        showQual :: Name -> String
    showQual (Name OccName
    _ (NameQ ModName
    m))       = ModName -> String
    modString ModName
    m
        showQual (Name OccName
    _ (NameG NameSpace
    _ PkgName
    pkg ModName
    m)) = PkgName -> String
    pkgString PkgName
    pkg String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ":" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ ModName -> String
    modString ModName
    m
        showQual Name
    _                        = String
    ""

    -- | Credit to Víctor López Juan for this trick
    sanitizeName :: String -> String
    sanitizeName :: String -> String
    sanitizeName String
    nb = Char
    'N'Char -> String -> String
    forall a. a -> [a] -> [a]
    :(
        String
    nb String -> (Char -> String) -> String
    forall a b. [a] -> (a -> [b]) -> [b]
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \Char
    x -> case Char
    x of
          Char
    c | Char -> Bool
    isAlphaNum Char
    c Bool -> Bool -> Bool
    || Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '\''-> [Char
    c]
          Char
    '_' -> String
    "__"
          Char
    c   -> String
    "_" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show (Char -> Int
    ord Char
    c))

    -- | 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 -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Type -> String
    forall a. Ppr a => a -> String
    pprint Type
    instanceType

    -- | 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 :: Name -> Q a
    derivingKindError :: forall a. Name -> Q a
    derivingKindError Name
    tyConName = String -> Q a
    forall a. String -> Q a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail
      (String -> Q a) -> (String -> String) -> String -> Q a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    showString String
    "Cannot derive well-kinded instance of form ‘Generic1 "
      (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Bool -> (String -> String) -> String -> String
    showParen Bool
    True
        ( String -> String -> String
    showString (Name -> String
    nameBase Name
    tyConName)
        (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    showString String
    " ..."
        )
      (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    showString String
    "‘\n\tClass Generic1 expects an argument of kind "
    #if MIN_VERSION_base(4,10,0)
      (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    showString String
    "k -> *"
    #else
      . showString "* -> *"
    #endif
      (String -> Q a) -> String -> Q a
    forall a b. (a -> b) -> a -> b
    $ String
    ""

    -- | The data type mentions the last type variable in a place other
    -- than the last position of a data type in a constructor's field.
    outOfPlaceTyVarError :: Q a
    outOfPlaceTyVarError :: forall a. Q a
    outOfPlaceTyVarError = String -> Q a
    forall a. String -> Q a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail
      (String -> Q a) -> (String -> String) -> String -> Q a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    showString String
    "Constructor must only use its last type variable as"
      (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    showString String
    " the last argument of a data type"
      (String -> Q a) -> String -> Q a
    forall a b. (a -> b) -> a -> b
    $ String
    ""

    -- | The data type mentions the last type variable in a type family
    -- application.
    typeFamilyApplicationError :: Q a
    typeFamilyApplicationError :: forall a. Q a
    typeFamilyApplicationError = String -> Q a
    forall a. String -> Q a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail
      (String -> Q a) -> (String -> String) -> String -> Q a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    showString String
    "Constructor must not apply its last type variable"
      (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    showString String
    " to an unsaturated type family"
      (String -> Q a) -> String -> Q a
    forall a b. (a -> b) -> a -> b
    $ String
    ""

    -- | We cannot define implementations for @from(1)@ or @to(1)@ at the term level
    -- for @type data@ declarations, which only exist at the type level.
    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) -> (String -> String) -> String -> Q a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    showString String
    "Cannot derive instance for ‘"
      (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    showString (Name -> String
    nameBase Name
    dataName)
      (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    showString String
    "‘, which is a ‘type data‘ declaration"
      (String -> Q a) -> String -> Q a
    forall a b. (a -> b) -> a -> b
    $ String
    ""

    -- | Cannot have a constructor argument of form (forall a1 ... an. <type>)
    -- when deriving Generic(1)
    rankNError :: Q a
    rankNError :: forall a. Q a
    rankNError = String -> Q a
    forall a. String -> Q a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "Cannot have polymorphic arguments"

    -- | Boilerplate for top level splices.
    --
    -- The given Name must meet one of two criteria:
    --
    -- 1. It must be the name of a type constructor of a plain data type or newtype.
    -- 2. It must be the name of a data family instance or newtype instance constructor.
    --
    -- Any other value will result in an exception.
    reifyDataInfo :: Name
                  -> Q (Either String (Name, [Type], [ConstructorInfo], DatatypeVariant_))
    reifyDataInfo :: Name
    -> Q (Either
            String (Name, [Type], [ConstructorInfo], DatatypeVariant_))
    reifyDataInfo Name
    name = do
      Either String (Name, [Type], [ConstructorInfo], DatatypeVariant_)
    -> Q (Either
            String (Name, [Type], [ConstructorInfo], DatatypeVariant_))
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either String (Name, [Type], [ConstructorInfo], DatatypeVariant_)
     -> Q (Either
             String (Name, [Type], [ConstructorInfo], DatatypeVariant_)))
    -> Either
         String (Name, [Type], [ConstructorInfo], DatatypeVariant_)
    -> Q (Either
            String (Name, [Type], [ConstructorInfo], DatatypeVariant_))
    forall a b. (a -> b) -> a -> b
    $ String
    -> Either
         String (Name, [Type], [ConstructorInfo], DatatypeVariant_)
    forall a b. a -> Either a b
    Left (String
     -> Either
          String (Name, [Type], [ConstructorInfo], DatatypeVariant_))
    -> String
    -> Either
         String (Name, [Type], [ConstructorInfo], DatatypeVariant_)
    forall a b. (a -> b) -> a -> b
    $ String
    ns String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " Could not reify " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Name -> String
    nameBase Name
    name
     Q (Either
         String (Name, [Type], [ConstructorInfo], DatatypeVariant_))
    -> Q (Either
            String (Name, [Type], [ConstructorInfo], DatatypeVariant_))
    -> Q (Either
            String (Name, [Type], [ConstructorInfo], DatatypeVariant_))
    forall a. Q a -> Q a -> Q a
    `recover`
      do DatatypeInfo { datatypeContext :: DatatypeInfo -> [Type]
    datatypeContext   = [Type]
    ctxt
                      , datatypeName :: DatatypeInfo -> Name
    datatypeName      = Name
    parentName
                      , datatypeInstTypes :: DatatypeInfo -> [Type]
    datatypeInstTypes = [Type]
    tys
                      , datatypeVariant :: DatatypeInfo -> DatatypeVariant
    datatypeVariant   = DatatypeVariant
    variant
                      , datatypeCons :: DatatypeInfo -> [ConstructorInfo]
    datatypeCons      = [ConstructorInfo]
    cons
                      } <- Name -> Q DatatypeInfo
    reifyDatatype Name
    name
         DatatypeVariant_
    variant_ <-
           case DatatypeVariant
    variant of
             DatatypeVariant
    Datatype          -> DatatypeVariant_ -> Q DatatypeVariant_
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return DatatypeVariant_
    Datatype_
             DatatypeVariant
    Newtype           -> DatatypeVariant_ -> Q DatatypeVariant_
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return DatatypeVariant_
    Newtype_
             DatatypeVariant
    DataInstance      -> DatatypeVariant_ -> Q DatatypeVariant_
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DatatypeVariant_ -> Q DatatypeVariant_)
    -> DatatypeVariant_ -> Q DatatypeVariant_
    forall a b. (a -> b) -> a -> b
    $ ConstructorInfo -> DatatypeVariant_
    DataInstance_    (ConstructorInfo -> DatatypeVariant_)
    -> ConstructorInfo -> DatatypeVariant_
    forall a b. (a -> b) -> a -> b
    $ Name -> [ConstructorInfo] -> ConstructorInfo
    headDataFamInstCon Name
    parentName [ConstructorInfo]
    cons
             DatatypeVariant
    NewtypeInstance   -> DatatypeVariant_ -> Q DatatypeVariant_
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DatatypeVariant_ -> Q DatatypeVariant_)
    -> DatatypeVariant_ -> Q DatatypeVariant_
    forall a b. (a -> b) -> a -> b
    $ ConstructorInfo -> DatatypeVariant_
    NewtypeInstance_ (ConstructorInfo -> DatatypeVariant_)
    -> ConstructorInfo -> DatatypeVariant_
    forall a b. (a -> b) -> a -> b
    $ Name -> [ConstructorInfo] -> ConstructorInfo
    headDataFamInstCon Name
    parentName [ConstructorInfo]
    cons
    #if MIN_VERSION_th_abstraction(0,5,0)
             DatatypeVariant
    Datatype.TypeData -> Name -> Q DatatypeVariant_
    forall a. Name -> Q a
    typeDataError Name
    parentName
    #endif
         Name
    -> [Type]
    -> Either
         String (Name, [Type], [ConstructorInfo], DatatypeVariant_)
    -> Q (Either
            String (Name, [Type], [ConstructorInfo], DatatypeVariant_))
    forall a. Name -> [Type] -> a -> Q a
    checkDataContext Name
    parentName [Type]
    ctxt (Either String (Name, [Type], [ConstructorInfo], DatatypeVariant_)
     -> Q (Either
             String (Name, [Type], [ConstructorInfo], DatatypeVariant_)))
    -> Either
         String (Name, [Type], [ConstructorInfo], DatatypeVariant_)
    -> Q (Either
            String (Name, [Type], [ConstructorInfo], DatatypeVariant_))
    forall a b. (a -> b) -> a -> b
    $ (Name, [Type], [ConstructorInfo], DatatypeVariant_)
    -> Either
         String (Name, [Type], [ConstructorInfo], DatatypeVariant_)
    forall a b. b -> Either a b
    Right (Name
    parentName, [Type]
    tys, [ConstructorInfo]
    cons, DatatypeVariant_
    variant_)
      where
        ns :: String
        ns :: String
    ns = String
    "Generics.Deriving.TH.reifyDataInfo: "

        -- This isn't total, but the API requires that the data family instance have
        -- at least one constructor anyways, so this will always succeed.
        headDataFamInstCon :: Name -> [ConstructorInfo] -> ConstructorInfo
        headDataFamInstCon :: Name -> [ConstructorInfo] -> ConstructorInfo
    headDataFamInstCon Name
    dataFamName [ConstructorInfo]
    cons =
          case [ConstructorInfo]
    cons of
            ConstructorInfo
    con:[ConstructorInfo]
    _ -> ConstructorInfo
    con
            [] -> String -> ConstructorInfo
    forall a. HasCallStack => String -> a
    error (String -> ConstructorInfo) -> String -> ConstructorInfo
    forall a b. (a -> b) -> a -> b
    $ String
    "reified data family instance without a data constructor: "
                       String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Name -> String
    nameBase Name
    dataFamName

    -- | One cannot derive Generic(1) instance for anything that uses DatatypeContexts,
    -- so check to make sure the Cxt field of a datatype is null.
    checkDataContext :: Name -> Cxt -> a -> Q a
    checkDataContext :: forall a. Name -> [Type] -> a -> Q a
    checkDataContext Name
    _        [] a
    x = a -> Q a
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    x
    checkDataContext Name
    dataName [Type]
    _  a
    _ = 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
    $
      Name -> String
    nameBase Name
    dataName String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " must not have a datatype context"

    -- | Deriving Generic(1) doesn't work with ExistentialQuantification or GADTs.
    checkExistentialContext :: Name -> [TyVarBndrUnit] -> Cxt -> Q ()
    checkExistentialContext :: Name -> [TyVarBndrUnit] -> [Type] -> Q ()
    checkExistentialContext Name
    constrName [TyVarBndrUnit]
    vars [Type]
    ctxt =
      Bool -> Q () -> Q ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless ([TyVarBndrUnit] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [TyVarBndrUnit]
    vars Bool -> Bool -> Bool
    && [Type] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Type]
    ctxt) (Q () -> Q ()) -> Q () -> Q ()
    forall a b. (a -> b) -> a -> b
    $ String -> Q ()
    forall a. String -> Q a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail (String -> Q ()) -> String -> Q ()
    forall a b. (a -> b) -> a -> b
    $
        Name -> String
    nameBase Name
    constrName String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " must be a vanilla data constructor"

    #if !(MIN_VERSION_template_haskell(2,21,0)) && !(MIN_VERSION_th_abstraction(0,6,0))
    type TyVarBndrVis = TyVarBndrUnit

    bndrReq :: ()
    bndrReq :: ()
    bndrReq = ()
    #endif

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

    #if __GLASGOW_HASKELL__ >= 800
    -- With GHC 8.0 or later, we can simply use TemplateHaskellQuotes to quote each
    -- name. Life is good.

    comp1DataName :: Name
    comp1DataName :: Name
    comp1DataName = 'Comp1

    infixDataName :: Name
    infixDataName :: Name
    infixDataName = 'GD.Infix

    k1DataName :: Name
    k1DataName :: Name
    k1DataName = 'K1

    l1DataName :: Name
    l1DataName :: Name
    l1DataName = 'L1

    leftAssociativeDataName :: Name
    leftAssociativeDataName :: Name
    leftAssociativeDataName = 'LeftAssociative

    m1DataName :: Name
    m1DataName :: Name
    m1DataName = 'M1

    notAssociativeDataName :: Name
    notAssociativeDataName :: Name
    notAssociativeDataName = 'NotAssociative

    par1DataName :: Name
    par1DataName :: Name
    par1DataName = 'Par1

    prefixDataName :: Name
    prefixDataName :: Name
    prefixDataName = 'Prefix

    productDataName :: Name
    productDataName :: Name
    productDataName = '(:*:)

    r1DataName :: Name
    r1DataName :: Name
    r1DataName = 'R1

    rec1DataName :: Name
    rec1DataName :: Name
    rec1DataName = 'Rec1

    rightAssociativeDataName :: Name
    rightAssociativeDataName :: Name
    rightAssociativeDataName = 'RightAssociative

    u1DataName :: Name
    u1DataName :: Name
    u1DataName = 'U1

    uAddrDataName :: Name
    uAddrDataName :: Name
    uAddrDataName = 'UAddr

    uCharDataName :: Name
    uCharDataName :: Name
    uCharDataName = 'UChar

    uDoubleDataName :: Name
    uDoubleDataName :: Name
    uDoubleDataName = 'UDouble

    uFloatDataName :: Name
    uFloatDataName :: Name
    uFloatDataName = 'UFloat

    uIntDataName :: Name
    uIntDataName :: Name
    uIntDataName = 'UInt

    uWordDataName :: Name
    uWordDataName :: Name
    uWordDataName = 'UWord

    c1TypeName :: Name
    c1TypeName :: Name
    c1TypeName = ''C1

    composeTypeName :: Name
    composeTypeName :: Name
    composeTypeName = ''(:.:)

    constructorTypeName :: Name
    constructorTypeName :: Name
    constructorTypeName = ''Constructor

    d1TypeName :: Name
    d1TypeName :: Name
    d1TypeName = ''D1

    genericTypeName :: Name
    genericTypeName :: Name
    genericTypeName = ''Generic

    generic1TypeName :: Name
    generic1TypeName :: Name
    generic1TypeName = ''Generic1

    datatypeTypeName :: Name
    datatypeTypeName :: Name
    datatypeTypeName = ''Datatype

    par1TypeName :: Name
    par1TypeName :: Name
    par1TypeName = ''Par1

    productTypeName :: Name
    productTypeName :: Name
    productTypeName = ''(:*:)

    rec0TypeName :: Name
    rec0TypeName :: Name
    rec0TypeName = ''Rec0

    rec1TypeName :: Name
    rec1TypeName :: Name
    rec1TypeName = ''Rec1

    repTypeName :: Name
    repTypeName :: Name
    repTypeName = ''Rep

    rep1TypeName :: Name
    rep1TypeName :: Name
    rep1TypeName = ''Rep1

    s1TypeName :: Name
    s1TypeName :: Name
    s1TypeName = ''S1

    selectorTypeName :: Name
    selectorTypeName :: Name
    selectorTypeName = ''Selector

    sumTypeName :: Name
    sumTypeName :: Name
    sumTypeName = ''(:+:)

    u1TypeName :: Name
    u1TypeName :: Name
    u1TypeName = ''U1

    uAddrTypeName :: Name
    uAddrTypeName :: Name
    uAddrTypeName = ''UAddr

    uCharTypeName :: Name
    uCharTypeName :: Name
    uCharTypeName = ''UChar

    uDoubleTypeName :: Name
    uDoubleTypeName :: Name
    uDoubleTypeName = ''UDouble

    uFloatTypeName :: Name
    uFloatTypeName :: Name
    uFloatTypeName = ''UFloat

    uIntTypeName :: Name
    uIntTypeName :: Name
    uIntTypeName = ''UInt

    uWordTypeName :: Name
    uWordTypeName :: Name
    uWordTypeName = ''UWord

    v1TypeName :: Name
    v1TypeName :: Name
    v1TypeName = ''V1

    conFixityValName :: Name
    conFixityValName :: Name
    conFixityValName = 'conFixity

    conIsRecordValName :: Name
    conIsRecordValName :: Name
    conIsRecordValName = 'conIsRecord

    conNameValName :: Name
    conNameValName :: Name
    conNameValName = 'GD.conName

    datatypeNameValName :: Name
    datatypeNameValName :: Name
    datatypeNameValName = 'GD.datatypeName

    isNewtypeValName :: Name
    isNewtypeValName :: Name
    isNewtypeValName = 'isNewtype

    fromValName :: Name
    fromValName :: Name
    fromValName = 'from

    from1ValName :: Name
    from1ValName :: Name
    from1ValName = 'from1

    moduleNameValName :: Name
    moduleNameValName :: Name
    moduleNameValName = 'moduleName

    selNameValName :: Name
    selNameValName :: Name
    selNameValName = 'selName

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

    toValName :: Name
    toValName :: Name
    toValName = 'to

    to1ValName :: Name
    to1ValName :: Name
    to1ValName = 'to1

    uAddrHashValName :: Name
    uAddrHashValName :: Name
    uAddrHashValName = 'uAddr#

    uCharHashValName :: Name
    uCharHashValName :: Name
    uCharHashValName = 'uChar#

    uDoubleHashValName :: Name
    uDoubleHashValName :: Name
    uDoubleHashValName = 'uDouble#

    uFloatHashValName :: Name
    uFloatHashValName :: Name
    uFloatHashValName = 'uFloat#

    uIntHashValName :: Name
    uIntHashValName :: Name
    uIntHashValName = 'uInt#

    uWordHashValName :: Name
    uWordHashValName :: Name
    uWordHashValName = 'uWord#

    unComp1ValName :: Name
    unComp1ValName :: Name
    unComp1ValName = 'unComp1

    unK1ValName :: Name
    unK1ValName :: Name
    unK1ValName = 'unK1

    unPar1ValName :: Name
    unPar1ValName :: Name
    unPar1ValName = 'unPar1

    unRec1ValName :: Name
    unRec1ValName :: Name
    unRec1ValName = 'unRec1

    trueDataName, falseDataName :: Name
    trueDataName :: Name
    trueDataName  = 'True
    falseDataName :: Name
    falseDataName = 'False

    nothingDataName, justDataName :: Name
    nothingDataName :: Name
    nothingDataName = 'Nothing
    justDataName :: Name
    justDataName    = 'Just

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

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

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

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

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

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

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

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

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

    undefinedValName :: Name
    undefinedValName :: Name
    undefinedValName = 'undefined

    decidedLazyDataName :: Name
    decidedLazyDataName :: Name
    decidedLazyDataName = 'GD.DecidedLazy

    decidedStrictDataName :: Name
    decidedStrictDataName :: Name
    decidedStrictDataName = 'GD.DecidedStrict

    decidedUnpackDataName :: Name
    decidedUnpackDataName :: Name
    decidedUnpackDataName = 'GD.DecidedUnpack

    infixIDataName :: Name
    infixIDataName :: Name
    infixIDataName = 'InfixI

    metaConsDataName :: Name
    metaConsDataName :: Name
    metaConsDataName = 'MetaCons

    metaDataDataName :: Name
    metaDataDataName :: Name
    metaDataDataName = 'MetaData

    metaSelDataName :: Name
    metaSelDataName :: Name
    metaSelDataName = 'MetaSel

    noSourceStrictnessDataName :: Name
    noSourceStrictnessDataName :: Name
    noSourceStrictnessDataName = 'GD.NoSourceStrictness

    noSourceUnpackednessDataName :: Name
    noSourceUnpackednessDataName :: Name
    noSourceUnpackednessDataName = 'GD.NoSourceUnpackedness

    prefixIDataName :: Name
    prefixIDataName :: Name
    prefixIDataName = 'PrefixI

    sourceLazyDataName :: Name
    sourceLazyDataName :: Name
    sourceLazyDataName = 'GD.SourceLazy

    sourceNoUnpackDataName :: Name
    sourceNoUnpackDataName :: Name
    sourceNoUnpackDataName = 'GD.SourceNoUnpack

    sourceStrictDataName :: Name
    sourceStrictDataName :: Name
    sourceStrictDataName = 'GD.SourceStrict

    sourceUnpackDataName :: Name
    sourceUnpackDataName :: Name
    sourceUnpackDataName = 'GD.SourceUnpack

    packageNameValName :: Name
    packageNameValName :: Name
    packageNameValName = 'packageName
    #else
    -- On pre-8.0 GHCs, we do not have access to the TemplateHaskellQuotes
    -- extension, so we construct the Template Haskell names by hand.
    -- By manually generating these names we avoid needing to use the
    -- TemplateHaskell language extension when compiling the generic-deriving library.
    -- This allows the library to be used in stage1 cross-compilers.

    gdPackageKey :: String
    # ifdef CURRENT_PACKAGE_KEY
    gdPackageKey = CURRENT_PACKAGE_KEY
    # else
    gdPackageKey = "generic-deriving-" ++ showVersion version
    # endif

    mkGD4'4_d :: String -> Name
    # if MIN_VERSION_base(4,6,0)
    mkGD4'4_d = mkNameG_d "base" "GHC.Generics"
    # elif MIN_VERSION_base(4,4,0)
    mkGD4'4_d = mkNameG_d "ghc-prim" "GHC.Generics"
    # else
    mkGD4'4_d = mkNameG_d gdPackageKey "Generics.Deriving.Base.Internal"
    # endif

    mkGD4'9_d :: String -> Name
    mkGD4'9_d = mkNameG_d gdPackageKey "Generics.Deriving.Base.Internal"

    mkGD4'4_tc :: String -> Name
    # if MIN_VERSION_base(4,6,0)
    mkGD4'4_tc = mkNameG_tc "base" "GHC.Generics"
    # elif MIN_VERSION_base(4,4,0)
    mkGD4'4_tc = mkNameG_tc "ghc-prim" "GHC.Generics"
    # else
    mkGD4'4_tc = mkNameG_tc gdPackageKey "Generics.Deriving.Base.Internal"
    # endif

    mkGD4'9_tc :: String -> Name
    mkGD4'9_tc = mkNameG_tc gdPackageKey "Generics.Deriving.Base.Internal"

    mkGD4'4_v :: String -> Name
    # if MIN_VERSION_base(4,6,0)
    mkGD4'4_v = mkNameG_v "base" "GHC.Generics"
    # elif MIN_VERSION_base(4,4,0)
    mkGD4'4_v = mkNameG_v "ghc-prim" "GHC.Generics"
    # else
    mkGD4'4_v = mkNameG_v gdPackageKey "Generics.Deriving.Base.Internal"
    # endif

    mkGD4'9_v :: String -> Name
    mkGD4'9_v = mkNameG_v gdPackageKey "Generics.Deriving.Base.Internal"

    mkBaseName_d :: String -> String -> Name
    mkBaseName_d = mkNameG_d "base"

    mkGHCPrimName_d :: String -> String -> Name
    mkGHCPrimName_d = mkNameG_d "ghc-prim"

    mkGHCPrimName_tc :: String -> String -> Name
    mkGHCPrimName_tc = mkNameG_tc "ghc-prim"

    mkGHCPrimName_v :: String -> String -> Name
    mkGHCPrimName_v = mkNameG_v "ghc-prim"

    comp1DataName :: Name
    comp1DataName = mkGD4'4_d "Comp1"

    infixDataName :: Name
    infixDataName = mkGD4'4_d "Infix"

    k1DataName :: Name
    k1DataName = mkGD4'4_d "K1"

    l1DataName :: Name
    l1DataName = mkGD4'4_d "L1"

    leftAssociativeDataName :: Name
    leftAssociativeDataName = mkGD4'4_d "LeftAssociative"

    m1DataName :: Name
    m1DataName = mkGD4'4_d "M1"

    notAssociativeDataName :: Name
    notAssociativeDataName = mkGD4'4_d "NotAssociative"

    par1DataName :: Name
    par1DataName = mkGD4'4_d "Par1"

    prefixDataName :: Name
    prefixDataName = mkGD4'4_d "Prefix"

    productDataName :: Name
    productDataName = mkGD4'4_d ":*:"

    r1DataName :: Name
    r1DataName = mkGD4'4_d "R1"

    rec1DataName :: Name
    rec1DataName = mkGD4'4_d "Rec1"

    rightAssociativeDataName :: Name
    rightAssociativeDataName = mkGD4'4_d "RightAssociative"

    u1DataName :: Name
    u1DataName = mkGD4'4_d "U1"

    uAddrDataName :: Name
    uAddrDataName = mkGD4'9_d "UAddr"

    uCharDataName :: Name
    uCharDataName = mkGD4'9_d "UChar"

    uDoubleDataName :: Name
    uDoubleDataName = mkGD4'9_d "UDouble"

    uFloatDataName :: Name
    uFloatDataName = mkGD4'9_d "UFloat"

    uIntDataName :: Name
    uIntDataName = mkGD4'9_d "UInt"

    uWordDataName :: Name
    uWordDataName = mkGD4'9_d "UWord"

    c1TypeName :: Name
    c1TypeName = mkGD4'4_tc "C1"

    composeTypeName :: Name
    composeTypeName = mkGD4'4_tc ":.:"

    constructorTypeName :: Name
    constructorTypeName = mkGD4'4_tc "Constructor"

    d1TypeName :: Name
    d1TypeName = mkGD4'4_tc "D1"

    genericTypeName :: Name
    genericTypeName = mkGD4'4_tc "Generic"

    generic1TypeName :: Name
    generic1TypeName = mkGD4'4_tc "Generic1"

    datatypeTypeName :: Name
    datatypeTypeName = mkGD4'4_tc "Datatype"

    -- This is only used prior to GHC 8.0.
    noSelectorTypeName :: Name
    noSelectorTypeName = mkGD4'4_tc "NoSelector"

    par1TypeName :: Name
    par1TypeName = mkGD4'4_tc "Par1"

    productTypeName :: Name
    productTypeName = mkGD4'4_tc ":*:"

    rec0TypeName :: Name
    rec0TypeName = mkGD4'4_tc "Rec0"

    rec1TypeName :: Name
    rec1TypeName = mkGD4'4_tc "Rec1"

    repTypeName :: Name
    repTypeName = mkGD4'4_tc "Rep"

    rep1TypeName :: Name
    rep1TypeName = mkGD4'4_tc "Rep1"

    s1TypeName :: Name
    s1TypeName = mkGD4'4_tc "S1"

    selectorTypeName :: Name
    selectorTypeName = mkGD4'4_tc "Selector"

    sumTypeName :: Name
    sumTypeName = mkGD4'4_tc ":+:"

    u1TypeName :: Name
    u1TypeName = mkGD4'4_tc "U1"

    uAddrTypeName :: Name
    uAddrTypeName = mkGD4'9_tc "UAddr"

    uCharTypeName :: Name
    uCharTypeName = mkGD4'9_tc "UChar"

    uDoubleTypeName :: Name
    uDoubleTypeName = mkGD4'9_tc "UDouble"

    uFloatTypeName :: Name
    uFloatTypeName = mkGD4'9_tc "UFloat"

    uIntTypeName :: Name
    uIntTypeName = mkGD4'9_tc "UInt"

    uWordTypeName :: Name
    uWordTypeName = mkGD4'9_tc "UWord"

    v1TypeName :: Name
    v1TypeName = mkGD4'4_tc "V1"

    conFixityValName :: Name
    conFixityValName = mkGD4'4_v "conFixity"

    conIsRecordValName :: Name
    conIsRecordValName = mkGD4'4_v "conIsRecord"

    conNameValName :: Name
    conNameValName = mkGD4'4_v "conName"

    datatypeNameValName :: Name
    datatypeNameValName = mkGD4'4_v "datatypeName"

    isNewtypeValName :: Name
    isNewtypeValName = mkGD4'4_v "isNewtype"

    fromValName :: Name
    fromValName = mkGD4'4_v "from"

    from1ValName :: Name
    from1ValName = mkGD4'4_v "from1"

    moduleNameValName :: Name
    moduleNameValName = mkGD4'4_v "moduleName"

    selNameValName :: Name
    selNameValName = mkGD4'4_v "selName"

    seqValName :: Name
    seqValName = mkGHCPrimName_v "GHC.Prim" "seq"

    toValName :: Name
    toValName = mkGD4'4_v "to"

    to1ValName :: Name
    to1ValName = mkGD4'4_v "to1"

    uAddrHashValName :: Name
    uAddrHashValName = mkGD4'9_v "uAddr#"

    uCharHashValName :: Name
    uCharHashValName = mkGD4'9_v "uChar#"

    uDoubleHashValName :: Name
    uDoubleHashValName = mkGD4'9_v "uDouble#"

    uFloatHashValName :: Name
    uFloatHashValName = mkGD4'9_v "uFloat#"

    uIntHashValName :: Name
    uIntHashValName = mkGD4'9_v "uInt#"

    uWordHashValName :: Name
    uWordHashValName = mkGD4'9_v "uWord#"

    unComp1ValName :: Name
    unComp1ValName = mkGD4'4_v "unComp1"

    unK1ValName :: Name
    unK1ValName = mkGD4'4_v "unK1"

    unPar1ValName :: Name
    unPar1ValName = mkGD4'4_v "unPar1"

    unRec1ValName :: Name
    unRec1ValName = mkGD4'4_v "unRec1"

    trueDataName, falseDataName :: Name
    # if MIN_VERSION_base(4,4,0)
    trueDataName  = mkGHCPrimName_d "GHC.Types" "True"
    falseDataName = mkGHCPrimName_d "GHC.Types" "False"
    # else
    trueDataName  = mkGHCPrimName_d "GHC.Bool"  "True"
    falseDataName = mkGHCPrimName_d "GHC.Bool"  "False"
    # endif

    nothingDataName, justDataName :: Name
    # if MIN_VERSION_base(4,8,0)
    nothingDataName = mkBaseName_d "GHC.Base"   "Nothing"
    justDataName    = mkBaseName_d "GHC.Base"   "Just"
    # else
    nothingDataName = mkBaseName_d "Data.Maybe" "Nothing"
    justDataName    = mkBaseName_d "Data.Maybe" "Just"
    # endif

    mkGHCPrim_tc :: String -> Name
    mkGHCPrim_tc = mkNameG_tc "ghc-prim" "GHC.Prim"

    addrHashTypeName :: Name
    addrHashTypeName = mkGHCPrim_tc "Addr#"

    charHashTypeName :: Name
    charHashTypeName = mkGHCPrim_tc "Char#"

    doubleHashTypeName :: Name
    doubleHashTypeName = mkGHCPrim_tc "Double#"

    floatHashTypeName :: Name
    floatHashTypeName = mkGHCPrim_tc "Float#"

    intHashTypeName :: Name
    intHashTypeName = mkGHCPrim_tc "Int#"

    wordHashTypeName :: Name
    wordHashTypeName = mkGHCPrim_tc "Word#"

    composeValName :: Name
    composeValName = mkNameG_v "base" "GHC.Base" "."

    errorValName :: Name
    errorValName = mkNameG_v "base" "GHC.Err" "error"

    fmapValName :: Name
    fmapValName = mkNameG_v "base" "GHC.Base" "fmap"

    undefinedValName :: Name
    undefinedValName = mkNameG_v "base" "GHC.Err" "undefined"

    decidedLazyDataName :: Name
    decidedLazyDataName = mkGD4'9_d "DecidedLazy"

    decidedStrictDataName :: Name
    decidedStrictDataName = mkGD4'9_d "DecidedStrict"

    decidedUnpackDataName :: Name
    decidedUnpackDataName = mkGD4'9_d "DecidedUnpack"

    infixIDataName :: Name
    infixIDataName = mkGD4'9_d "InfixI"

    metaConsDataName :: Name
    metaConsDataName = mkGD4'9_d "MetaCons"

    metaDataDataName :: Name
    metaDataDataName = mkGD4'9_d "MetaData"

    metaSelDataName :: Name
    metaSelDataName = mkGD4'9_d "MetaSel"

    noSourceStrictnessDataName :: Name
    noSourceStrictnessDataName = mkGD4'9_d "NoSourceStrictness"

    noSourceUnpackednessDataName :: Name
    noSourceUnpackednessDataName = mkGD4'9_d "NoSourceUnpackedness"

    prefixIDataName :: Name
    prefixIDataName = mkGD4'9_d "PrefixI"

    sourceLazyDataName :: Name
    sourceLazyDataName = mkGD4'9_d "SourceLazy"

    sourceNoUnpackDataName :: Name
    sourceNoUnpackDataName = mkGD4'9_d "SourceNoUnpack"

    sourceStrictDataName :: Name
    sourceStrictDataName = mkGD4'9_d "SourceStrict"

    sourceUnpackDataName :: Name
    sourceUnpackDataName = mkGD4'9_d "SourceUnpack"

    packageNameValName :: Name
    packageNameValName = mkGD4'4_v "packageName"
    #endif