    {-# LANGUAGE CPP #-}
    {-# LANGUAGE GADTs #-}

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

    Exports functions to mechanically derive 'Eq', 'Eq1', and 'Eq2' instances.

    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.Eq.Deriving.Internal (
          -- * 'Eq'
          deriveEq
        , makeEq
        , makeNotEq
          -- * 'Eq1'
        , deriveEq1
    #if defined(NEW_FUNCTOR_CLASSES)
        , makeLiftEq
    #endif
        , makeEq1
    #if defined(NEW_FUNCTOR_CLASSES)
          -- * 'Eq2'
        , deriveEq2
        , makeLiftEq2
        , makeEq2
    #endif
        ) where

    import           Data.Deriving.Internal
    import           Data.List (foldl1', partition)
    import qualified Data.Map as Map

    import           Language.Haskell.TH.Datatype
    import           Language.Haskell.TH.Lib
    import           Language.Haskell.TH.Syntax

    -- | Generates an 'Eq' instance declaration for the given data type or data
    -- family instance.
    deriveEq :: Name -> Q [Dec]
    deriveEq :: Name -> Q [Dec]
    deriveEq = EqClass -> Name -> Q [Dec]
    deriveEqClass EqClass
    Eq

    -- | Generates a lambda expression which behaves like '(==)' (without
    -- requiring an 'Eq' instance).
    makeEq :: Name -> Q Exp
    makeEq :: Name -> Q Exp
    makeEq = EqClass -> Name -> Q Exp
    makeEqClass EqClass
    Eq

    -- | Generates a lambda expression which behaves like '(/=)' (without
    -- requiring an 'Eq' instance).
    makeNotEq :: Name -> Q Exp
    makeNotEq :: Name -> Q Exp
    makeNotEq name :: Name
    name = do
        Name
    x1 <- String -> Q Name
    newName "x1"
        Name
    x2 <- String -> Q Name
    newName "x2"
        [PatQ] -> Q Exp -> Q Exp
    lamE [Name -> PatQ
    varP Name
    x1, Name -> PatQ
    varP Name
    x2] (Q Exp -> Q Exp) -> Q Exp -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ Name -> Q Exp
    varE Name
    notValName Q Exp -> Q Exp -> Q Exp
    `appE`
            (Name -> Q Exp
    makeEq Name
    name Q Exp -> Q Exp -> Q Exp
    `appE` Name -> Q Exp
    varE Name
    x1 Q Exp -> Q Exp -> Q Exp
    `appE` Name -> Q Exp
    varE Name
    x2)

    -- | Generates an 'Eq1' instance declaration for the given data type or data
    -- family instance.
    deriveEq1 :: Name -> Q [Dec]
    deriveEq1 :: Name -> Q [Dec]
    deriveEq1 = EqClass -> Name -> Q [Dec]
    deriveEqClass EqClass
    Eq1

    #if defined(NEW_FUNCTOR_CLASSES)
    -- | Generates a lambda expression which behaves like 'liftEq' (without
    -- requiring an 'Eq1' instance).
    --
    -- This function is not available with @transformers-0.4@.
    makeLiftEq :: Name -> Q Exp
    makeLiftEq :: Name -> Q Exp
    makeLiftEq = EqClass -> Name -> Q Exp
    makeEqClass EqClass
    Eq1

    -- | Generates a lambda expression which behaves like 'eq1' (without
    -- requiring an 'Eq1' instance).
    makeEq1 :: Name -> Q Exp
    makeEq1 :: Name -> Q Exp
    makeEq1 name :: Name
    name = Name -> Q Exp
    makeLiftEq Name
    name Q Exp -> Q Exp -> Q Exp
    `appE` Name -> Q Exp
    varE Name
    eqValName
    #else
    -- | Generates a lambda expression which behaves like 'eq1' (without
    -- requiring an 'Eq1' instance).
    makeEq1 :: Name -> Q Exp
    makeEq1 = makeEqClass Eq1
    #endif

    #if defined(NEW_FUNCTOR_CLASSES)
    -- | Generates an 'Eq2' instance declaration for the given data type or data
    -- family instance.
    --
    -- This function is not available with @transformers-0.4@.
    deriveEq2 :: Name -> Q [Dec]
    deriveEq2 :: Name -> Q [Dec]
    deriveEq2 = EqClass -> Name -> Q [Dec]
    deriveEqClass EqClass
    Eq2

    -- | Generates a lambda expression which behaves like 'liftEq2' (without
    -- requiring an 'Eq2' instance).
    --
    -- This function is not available with @transformers-0.4@.
    makeLiftEq2 :: Name -> Q Exp
    makeLiftEq2 :: Name -> Q Exp
    makeLiftEq2 = EqClass -> Name -> Q Exp
    makeEqClass EqClass
    Eq2

    -- | Generates a lambda expression which behaves like 'eq2' (without
    -- requiring an 'Eq2' instance).
    --
    -- This function is not available with @transformers-0.4@.
    makeEq2 :: Name -> Q Exp
    makeEq2 :: Name -> Q Exp
    makeEq2 name :: Name
    name = Name -> Q Exp
    makeLiftEq Name
    name Q Exp -> Q Exp -> Q Exp
    `appE` Name -> Q Exp
    varE Name
    eqValName Q Exp -> Q Exp -> Q Exp
    `appE` Name -> Q Exp
    varE Name
    eqValName
    #endif

    -------------------------------------------------------------------------------
    -- Code generation
    -------------------------------------------------------------------------------

    -- | Derive an Eq(1)(2) instance declaration (depending on the EqClass
    -- argument's value).
    deriveEqClass :: EqClass -> Name -> Q [Dec]
    deriveEqClass :: EqClass -> Name -> Q [Dec]
    deriveEqClass eClass :: EqClass
    eClass name :: Name
    name = do
      DatatypeInfo
    info <- Name -> Q DatatypeInfo
    reifyDatatype Name
    name
      case DatatypeInfo
    info of
        DatatypeInfo { datatypeContext :: DatatypeInfo -> Cxt
    datatypeContext   = Cxt
    ctxt
                     , datatypeName :: DatatypeInfo -> Name
    datatypeName      = Name
    parentName
                     , datatypeInstTypes :: DatatypeInfo -> Cxt
    datatypeInstTypes = Cxt
    instTypes
                     , datatypeVariant :: DatatypeInfo -> DatatypeVariant
    datatypeVariant   = DatatypeVariant
    variant
                     , datatypeCons :: DatatypeInfo -> [ConstructorInfo]
    datatypeCons      = [ConstructorInfo]
    cons
                     } -> do
          (instanceCxt :: Cxt
    instanceCxt, instanceType :: Type
    instanceType)
              <- EqClass -> Name -> Cxt -> Cxt -> DatatypeVariant -> Q (Cxt, Type)
    forall a.
    ClassRep a =>
    a -> Name -> Cxt -> Cxt -> DatatypeVariant -> Q (Cxt, Type)
    buildTypeInstance EqClass
    eClass Name
    parentName Cxt
    ctxt Cxt
    instTypes DatatypeVariant
    variant
          (Dec -> [Dec] -> [Dec]
    forall a. a -> [a] -> [a]
    :[]) (Dec -> [Dec]) -> Q Dec -> Q [Dec]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` CxtQ -> TypeQ -> [Q Dec] -> Q Dec
    instanceD (Cxt -> CxtQ
    forall (m :: * -> *) a. Monad m => a -> m a
    return Cxt
    instanceCxt)
                                 (Type -> TypeQ
    forall (m :: * -> *) a. Monad m => a -> m a
    return Type
    instanceType)
                                 (EqClass -> Cxt -> [ConstructorInfo] -> [Q Dec]
    eqDecs EqClass
    eClass Cxt
    instTypes [ConstructorInfo]
    cons)

    -- | Generates a declaration defining the primary function corresponding to a
    -- particular class ((==) for Eq, liftEq for Eq1, and
    -- liftEq2 for Eq2).
    eqDecs :: EqClass -> [Type] -> [ConstructorInfo] -> [Q Dec]
    eqDecs :: EqClass -> Cxt -> [ConstructorInfo] -> [Q Dec]
    eqDecs eClass :: EqClass
    eClass instTypes :: Cxt
    instTypes cons :: [ConstructorInfo]
    cons =
        [ Name -> [ClauseQ] -> Q Dec
    funD (EqClass -> Name
    eqName EqClass
    eClass)
               [ [PatQ] -> BodyQ -> [Q Dec] -> ClauseQ
    clause []
                        (Q Exp -> BodyQ
    normalB (Q Exp -> BodyQ) -> Q Exp -> BodyQ
    forall a b. (a -> b) -> a -> b
    $ EqClass -> Cxt -> [ConstructorInfo] -> Q Exp
    makeEqForCons EqClass
    eClass Cxt
    instTypes [ConstructorInfo]
    cons)
                        []
               ]
        ]

    -- | Generates a lambda expression which behaves like (==) (for Eq),
    -- liftEq (for Eq1), or liftEq2 (for Eq2).
    makeEqClass :: EqClass -> Name -> Q Exp
    makeEqClass :: EqClass -> Name -> Q Exp
    makeEqClass eClass :: EqClass
    eClass name :: Name
    name = do
      DatatypeInfo
    info <- Name -> Q DatatypeInfo
    reifyDatatype Name
    name
      case DatatypeInfo
    info of
        DatatypeInfo { datatypeContext :: DatatypeInfo -> Cxt
    datatypeContext   = Cxt
    ctxt
                     , datatypeName :: DatatypeInfo -> Name
    datatypeName      = Name
    parentName
                     , datatypeInstTypes :: DatatypeInfo -> Cxt
    datatypeInstTypes = Cxt
    instTypes
                     , datatypeVariant :: DatatypeInfo -> DatatypeVariant
    datatypeVariant   = DatatypeVariant
    variant
                     , datatypeCons :: DatatypeInfo -> [ConstructorInfo]
    datatypeCons      = [ConstructorInfo]
    cons
                     } -> do
          -- We force buildTypeInstance here since it performs some checks for whether
          -- or not the provided datatype can actually have (==)/liftEq/etc.
          -- implemented for it, and produces errors if it can't.
          EqClass -> Name -> Cxt -> Cxt -> DatatypeVariant -> Q (Cxt, Type)
    forall a.
    ClassRep a =>
    a -> Name -> Cxt -> Cxt -> DatatypeVariant -> Q (Cxt, Type)
    buildTypeInstance EqClass
    eClass Name
    parentName Cxt
    ctxt Cxt
    instTypes DatatypeVariant
    variant
            Q (Cxt, Type) -> Q Exp -> Q Exp
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> EqClass -> Cxt -> [ConstructorInfo] -> Q Exp
    makeEqForCons EqClass
    eClass Cxt
    instTypes [ConstructorInfo]
    cons

    -- | Generates a lambda expression for (==)/liftEq/etc. for the
    -- given constructors. All constructors must be from the same type.
    makeEqForCons :: EqClass -> [Type] -> [ConstructorInfo] -> Q Exp
    makeEqForCons :: EqClass -> Cxt -> [ConstructorInfo] -> Q Exp
    makeEqForCons eClass :: EqClass
    eClass instTypes :: Cxt
    instTypes cons :: [ConstructorInfo]
    cons = do
        Name
    value1 <- String -> Q Name
    newName "value1"
        Name
    value2 <- String -> Q Name
    newName "value2"
        Name
    eqDefn <- String -> Q Name
    newName "eqDefn"
        [Name]
    eqs    <- String -> Int -> Q [Name]
    newNameList "eq" (Int -> Q [Name]) -> Int -> Q [Name]
    forall a b. (a -> b) -> a -> b
    $ EqClass -> Int
    forall a. ClassRep a => a -> Int
    arity EqClass
    eClass

        let lastTyVars :: [Name]
    lastTyVars = (Type -> Name) -> Cxt -> [Name]
    forall a b. (a -> b) -> [a] -> [b]
    map Type -> Name
    varTToName (Cxt -> [Name]) -> Cxt -> [Name]
    forall a b. (a -> b) -> a -> b
    $ Int -> Cxt -> Cxt
    forall a. Int -> [a] -> [a]
    drop (Cxt -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length Cxt
    instTypes Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - EqClass -> Int
    forall a. Enum a => a -> Int
    fromEnum EqClass
    eClass) Cxt
    instTypes
            tvMap :: Map Name (OneOrTwoNames One)
    tvMap      = [(Name, OneOrTwoNames One)] -> Map Name (OneOrTwoNames One)
    forall k a. Ord k => [(k, a)] -> Map k a
    Map.fromList ([(Name, OneOrTwoNames One)] -> Map Name (OneOrTwoNames One))
    -> [(Name, OneOrTwoNames One)] -> Map Name (OneOrTwoNames One)
    forall a b. (a -> b) -> a -> b
    $ (Name -> Name -> (Name, OneOrTwoNames One))
    -> [Name] -> [Name] -> [(Name, OneOrTwoNames One)]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith (\x :: Name
    x y :: Name
    y -> (Name
    x, Name -> OneOrTwoNames One
    OneName Name
    y)) [Name]
    lastTyVars [Name]
    eqs

        [PatQ] -> Q Exp -> Q Exp
    lamE ((Name -> PatQ) -> [Name] -> [PatQ]
    forall a b. (a -> b) -> [a] -> [b]
    map Name -> PatQ
    varP ([Name] -> [PatQ]) -> [Name] -> [PatQ]
    forall a b. (a -> b) -> a -> b
    $
    #if defined(NEW_FUNCTOR_CLASSES)
                         [Name]
    eqs [Name] -> [Name] -> [Name]
    forall a. [a] -> [a] -> [a]
    ++
    #endif
                         [Name
    value1, Name
    value2]
             ) (Q Exp -> Q Exp) -> ([Q Exp] -> Q Exp) -> [Q Exp] -> Q Exp
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Q Exp] -> Q Exp
    appsE
             ([Q Exp] -> Q Exp) -> [Q Exp] -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ [ Name -> Q Exp
    varE (Name -> Q Exp) -> Name -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ EqClass -> Name
    eqConstName EqClass
    eClass
               , [Q Dec] -> Q Exp -> Q Exp
    letE [ Name -> [ClauseQ] -> Q Dec
    funD Name
    eqDefn ([ClauseQ] -> Q Dec) -> [ClauseQ] -> Q Dec
    forall a b. (a -> b) -> a -> b
    $ (ConstructorInfo -> ClauseQ) -> [ConstructorInfo] -> [ClauseQ]
    forall a b. (a -> b) -> [a] -> [b]
    map (EqClass
    -> Map Name (OneOrTwoNames One) -> ConstructorInfo -> ClauseQ
    makeCaseForCon EqClass
    eClass Map Name (OneOrTwoNames One)
    tvMap) [ConstructorInfo]
    patMatchCons
                                   [ClauseQ] -> [ClauseQ] -> [ClauseQ]
    forall a. [a] -> [a] -> [a]
    ++ [ClauseQ]
    fallThroughCase
                      ] (Q Exp -> Q Exp) -> Q Exp -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ Name -> Q Exp
    varE Name
    eqDefn Q Exp -> Q Exp -> Q Exp
    `appE` Name -> Q Exp
    varE Name
    value1 Q Exp -> Q Exp -> Q Exp
    `appE` Name -> Q Exp
    varE Name
    value2
               ]
    #if defined(NEW_FUNCTOR_CLASSES)
                 [Q Exp] -> [Q Exp] -> [Q Exp]
    forall a. [a] -> [a] -> [a]
    ++ (Name -> Q Exp) -> [Name] -> [Q Exp]
    forall a b. (a -> b) -> [a] -> [b]
    map Name -> Q Exp
    varE [Name]
    eqs
    #endif
                 [Q Exp] -> [Q Exp] -> [Q Exp]
    forall a. [a] -> [a] -> [a]
    ++ [Name -> Q Exp
    varE Name
    value1, Name -> Q Exp
    varE Name
    value2]
      where
        nullaryCons, nonNullaryCons :: [ConstructorInfo]
        (nullaryCons :: [ConstructorInfo]
    nullaryCons, nonNullaryCons :: [ConstructorInfo]
    nonNullaryCons) = (ConstructorInfo -> Bool)
    -> [ConstructorInfo] -> ([ConstructorInfo], [ConstructorInfo])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    partition ConstructorInfo -> Bool
    isNullaryCon [ConstructorInfo]
    cons

        tagMatchCons, patMatchCons :: [ConstructorInfo]
        (tagMatchCons :: [ConstructorInfo]
    tagMatchCons, patMatchCons :: [ConstructorInfo]
    patMatchCons)
          | [ConstructorInfo] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [ConstructorInfo]
    nullaryCons Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > 10 = ([ConstructorInfo]
    nullaryCons, [ConstructorInfo]
    nonNullaryCons)
          | Bool
    otherwise               = ([],          [ConstructorInfo]
    cons)

        fallThroughCase :: [Q Clause]
        fallThroughCase :: [ClauseQ]
    fallThroughCase
          | [ConstructorInfo] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [ConstructorInfo]
    tagMatchCons = case [ConstructorInfo]
    patMatchCons of
              []  -> [ClauseQ
    makeFallThroughCaseTrue]  -- No constructors: _ == _ = True
              [_] -> []                         -- One constructor: no fall-through case
              _   -> [ClauseQ
    makeFallThroughCaseFalse] -- Two or more constructors:
                                                --   _ == _ = False
          | Bool
    otherwise = [ClauseQ
    makeTagCase]

    makeTagCase :: Q Clause
    makeTagCase :: ClauseQ
    makeTagCase = do
        Name
    a     <- String -> Q Name
    newName "a"
        Name
    aHash <- String -> Q Name
    newName "a#"
        Name
    b     <- String -> Q Name
    newName "b"
        Name
    bHash <- String -> Q Name
    newName "b#"
        [PatQ] -> BodyQ -> [Q Dec] -> ClauseQ
    clause ((Name -> PatQ) -> [Name] -> [PatQ]
    forall a b. (a -> b) -> [a] -> [b]
    map Name -> PatQ
    varP [Name
    a,Name
    b])
               (Q Exp -> BodyQ
    normalB (Q Exp -> BodyQ) -> Q Exp -> BodyQ
    forall a b. (a -> b) -> a -> b
    $ [(Name, Name)] -> Q Exp -> Q Exp
    untagExpr [(Name
    a, Name
    aHash), (Name
    b, Name
    bHash)] (Q Exp -> Q Exp) -> Q Exp -> Q Exp
    forall a b. (a -> b) -> a -> b
    $
                   Q Exp -> Name -> Q Exp -> Q Exp
    primOpAppExpr (Name -> Q Exp
    varE Name
    aHash) Name
    eqIntHashValName (Name -> Q Exp
    varE Name
    bHash)) []

    makeFallThroughCaseFalse, makeFallThroughCaseTrue :: Q Clause
    makeFallThroughCaseFalse :: ClauseQ
    makeFallThroughCaseFalse = Name -> ClauseQ
    makeFallThroughCase Name
    falseDataName
    makeFallThroughCaseTrue :: ClauseQ
    makeFallThroughCaseTrue  = Name -> ClauseQ
    makeFallThroughCase Name
    trueDataName

    makeFallThroughCase :: Name -> Q Clause
    makeFallThroughCase :: Name -> ClauseQ
    makeFallThroughCase dataName :: Name
    dataName = [PatQ] -> BodyQ -> [Q Dec] -> ClauseQ
    clause [PatQ
    wildP, PatQ
    wildP] (Q Exp -> BodyQ
    normalB (Q Exp -> BodyQ) -> Q Exp -> BodyQ
    forall a b. (a -> b) -> a -> b
    $ Name -> Q Exp
    conE Name
    dataName) []

    makeCaseForCon :: EqClass -> TyVarMap1 -> ConstructorInfo -> Q Clause
    makeCaseForCon :: EqClass
    -> Map Name (OneOrTwoNames One) -> ConstructorInfo -> ClauseQ
    makeCaseForCon eClass :: EqClass
    eClass tvMap :: Map Name (OneOrTwoNames One)
    tvMap
      (ConstructorInfo { constructorName :: ConstructorInfo -> Name
    constructorName = Name
    conName, constructorFields :: ConstructorInfo -> Cxt
    constructorFields = Cxt
    ts }) = do
        Cxt
    ts' <- (Type -> TypeQ) -> Cxt -> CxtQ
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM Type -> TypeQ
    resolveTypeSynonyms Cxt
    ts
        let tsLen :: Int
    tsLen = Cxt -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length Cxt
    ts'
        [Name]
    as <- String -> Int -> Q [Name]
    newNameList "a" Int
    tsLen
        [Name]
    bs <- String -> Int -> Q [Name]
    newNameList "b" Int
    tsLen
        [PatQ] -> BodyQ -> [Q Dec] -> ClauseQ
    clause [Name -> [PatQ] -> PatQ
    conP Name
    conName ((Name -> PatQ) -> [Name] -> [PatQ]
    forall a b. (a -> b) -> [a] -> [b]
    map Name -> PatQ
    varP [Name]
    as), Name -> [PatQ] -> PatQ
    conP Name
    conName ((Name -> PatQ) -> [Name] -> [PatQ]
    forall a b. (a -> b) -> [a] -> [b]
    map Name -> PatQ
    varP [Name]
    bs)]
               (Q Exp -> BodyQ
    normalB (Q Exp -> BodyQ) -> Q Exp -> BodyQ
    forall a b. (a -> b) -> a -> b
    $ EqClass
    -> Map Name (OneOrTwoNames One)
    -> Name
    -> Cxt
    -> [Name]
    -> [Name]
    -> Q Exp
    makeCaseForArgs EqClass
    eClass Map Name (OneOrTwoNames One)
    tvMap Name
    conName Cxt
    ts' [Name]
    as [Name]
    bs)
               []

    makeCaseForArgs :: EqClass
                    -> TyVarMap1
                    -> Name
                    -> [Type]
                    -> [Name]
                    -> [Name]
                    -> Q Exp
    makeCaseForArgs :: EqClass
    -> Map Name (OneOrTwoNames One)
    -> Name
    -> Cxt
    -> [Name]
    -> [Name]
    -> Q Exp
    makeCaseForArgs _ _ _ [] [] [] = Name -> Q Exp
    conE Name
    trueDataName
    makeCaseForArgs eClass :: EqClass
    eClass tvMap :: Map Name (OneOrTwoNames One)
    tvMap conName :: Name
    conName tys :: Cxt
    tys as :: [Name]
    as bs :: [Name]
    bs =
        (Q Exp -> Q Exp -> Q Exp) -> [Q Exp] -> Q Exp
    forall a. (a -> a -> a) -> [a] -> a
    foldl1' (\q :: Q Exp
    q e :: Q Exp
    e -> Q Exp -> Q Exp -> Q Exp -> Q Exp
    infixApp Q Exp
    q (Name -> Q Exp
    varE Name
    andValName) Q Exp
    e)
                ((Type -> Name -> Name -> Q Exp)
    -> Cxt -> [Name] -> [Name] -> [Q Exp]
    forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
    zipWith3 (EqClass
    -> Map Name (OneOrTwoNames One)
    -> Name
    -> Type
    -> Name
    -> Name
    -> Q Exp
    makeCaseForArg EqClass
    eClass Map Name (OneOrTwoNames One)
    tvMap Name
    conName) Cxt
    tys [Name]
    as [Name]
    bs)

    makeCaseForArg :: EqClass
                   -> TyVarMap1
                   -> Name
                   -> Type
                   -> Name
                   -> Name
                   -> Q Exp
    makeCaseForArg :: EqClass
    -> Map Name (OneOrTwoNames One)
    -> Name
    -> Type
    -> Name
    -> Name
    -> Q Exp
    makeCaseForArg _ _ _ (ConT tyName :: Name
    tyName) a :: Name
    a b :: Name
    b = Q Exp
    primEqExpr
      where
        aExpr, bExpr :: Q Exp
        aExpr :: Q Exp
    aExpr = Name -> Q Exp
    varE Name
    a
        bExpr :: Q Exp
    bExpr = Name -> Q Exp
    varE Name
    b

        makePrimEqExpr :: Name -> Q Exp
        makePrimEqExpr :: Name -> Q Exp
    makePrimEqExpr n :: Name
    n = Q Exp -> Name -> Q Exp -> Q Exp
    primOpAppExpr Q Exp
    aExpr Name
    n Q Exp
    bExpr

        primEqExpr :: Q Exp
        primEqExpr :: Q Exp
    primEqExpr =
          case Name
    -> Map Name (Name, Name, Name, Name, Name)
    -> Maybe (Name, Name, Name, Name, Name)
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup Name
    tyName Map Name (Name, Name, Name, Name, Name)
    primOrdFunTbl of
            Just (_, _, eq :: Name
    eq, _, _) -> Name -> Q Exp
    makePrimEqExpr Name
    eq
            Nothing               -> Q Exp -> Q Exp -> Q Exp -> Q Exp
    infixApp Q Exp
    aExpr (Name -> Q Exp
    varE Name
    eqValName) Q Exp
    bExpr
    makeCaseForArg eClass :: EqClass
    eClass tvMap :: Map Name (OneOrTwoNames One)
    tvMap conName :: Name
    conName ty :: Type
    ty a :: Name
    a b :: Name
    b =
        EqClass -> Map Name (OneOrTwoNames One) -> Name -> Type -> Q Exp
    makeCaseForType EqClass
    eClass Map Name (OneOrTwoNames One)
    tvMap Name
    conName Type
    ty Q Exp -> Q Exp -> Q Exp
    `appE` Name -> Q Exp
    varE Name
    a Q Exp -> Q Exp -> Q Exp
    `appE` Name -> Q Exp
    varE Name
    b

    makeCaseForType :: EqClass
                    -> TyVarMap1
                    -> Name
                    -> Type
                    -> Q Exp
    #if defined(NEW_FUNCTOR_CLASSES)
    makeCaseForType :: EqClass -> Map Name (OneOrTwoNames One) -> Name -> Type -> Q Exp
    makeCaseForType _ tvMap :: Map Name (OneOrTwoNames One)
    tvMap _ (VarT tyName :: Name
    tyName) =
        Name -> Q Exp
    varE (Name -> Q Exp) -> Name -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ case Name -> Map Name (OneOrTwoNames One) -> Maybe (OneOrTwoNames One)
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup Name
    tyName Map Name (OneOrTwoNames One)
    tvMap of
          Just (OneName eq :: Name
    eq) -> Name
    eq
          Nothing           -> Name
    eqValName
    #else
    makeCaseForType _ _ _ VarT{} = varE eqValName
    #endif
    makeCaseForType eClass :: EqClass
    eClass tvMap :: Map Name (OneOrTwoNames One)
    tvMap conName :: Name
    conName (SigT ty :: Type
    ty _)      = EqClass -> Map Name (OneOrTwoNames One) -> Name -> Type -> Q Exp
    makeCaseForType EqClass
    eClass Map Name (OneOrTwoNames One)
    tvMap Name
    conName Type
    ty
    makeCaseForType eClass :: EqClass
    eClass tvMap :: Map Name (OneOrTwoNames One)
    tvMap conName :: Name
    conName (ForallT _ _ ty :: Type
    ty) = EqClass -> Map Name (OneOrTwoNames One) -> Name -> Type -> Q Exp
    makeCaseForType EqClass
    eClass Map Name (OneOrTwoNames One)
    tvMap Name
    conName Type
    ty
    #if defined(NEW_FUNCTOR_CLASSES)
    makeCaseForType eClass :: EqClass
    eClass tvMap :: Map Name (OneOrTwoNames One)
    tvMap conName :: Name
    conName ty :: Type
    ty = do
        let tyCon :: Type
            tyArgs :: [Type]
            (tyCon :: Type
    tyCon, tyArgs :: Cxt
    tyArgs) = Type -> (Type, Cxt)
    unapplyTy Type
    ty

            numLastArgs :: Int
            numLastArgs :: Int
    numLastArgs = Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    min (EqClass -> Int
    forall a. ClassRep a => a -> Int
    arity EqClass
    eClass) (Cxt -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length Cxt
    tyArgs)

            lhsArgs, rhsArgs :: [Type]
            (lhsArgs :: Cxt
    lhsArgs, rhsArgs :: Cxt
    rhsArgs) = Int -> Cxt -> (Cxt, Cxt)
    forall a. Int -> [a] -> ([a], [a])
    splitAt (Cxt -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length Cxt
    tyArgs Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    numLastArgs) Cxt
    tyArgs

            tyVarNames :: [Name]
            tyVarNames :: [Name]
    tyVarNames = Map Name (OneOrTwoNames One) -> [Name]
    forall k a. Map k a -> [k]
    Map.keys Map Name (OneOrTwoNames One)
    tvMap

        Bool
    itf <- [Name] -> Type -> Cxt -> Q Bool
    isInTypeFamilyApp [Name]
    tyVarNames Type
    tyCon Cxt
    tyArgs
        if (Type -> Bool) -> Cxt -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (Type -> [Name] -> Bool
    `mentionsName` [Name]
    tyVarNames) Cxt
    lhsArgs
              Bool -> Bool -> Bool
    || Bool
    itf Bool -> Bool -> Bool
    && (Type -> Bool) -> Cxt -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (Type -> [Name] -> Bool
    `mentionsName` [Name]
    tyVarNames) Cxt
    tyArgs
           then EqClass -> Name -> Q Exp
    forall a b. ClassRep a => a -> Name -> Q b
    outOfPlaceTyVarError EqClass
    eClass Name
    conName
           else if (Type -> Bool) -> Cxt -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (Type -> [Name] -> Bool
    `mentionsName` [Name]
    tyVarNames) Cxt
    rhsArgs
                   then [Q Exp] -> Q Exp
    appsE ([Q Exp] -> Q Exp) -> [Q Exp] -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ [ Name -> Q Exp
    varE (Name -> Q Exp) -> (EqClass -> Name) -> EqClass -> Q Exp
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . EqClass -> Name
    eqName (EqClass -> Q Exp) -> EqClass -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ Int -> EqClass
    forall a. Enum a => Int -> a
    toEnum Int
    numLastArgs]
                                [Q Exp] -> [Q Exp] -> [Q Exp]
    forall a. [a] -> [a] -> [a]
    ++ (Type -> Q Exp) -> Cxt -> [Q Exp]
    forall a b. (a -> b) -> [a] -> [b]
    map (EqClass -> Map Name (OneOrTwoNames One) -> Name -> Type -> Q Exp
    makeCaseForType EqClass
    eClass Map Name (OneOrTwoNames One)
    tvMap Name
    conName) Cxt
    rhsArgs
                   else Name -> Q Exp
    varE Name
    eqValName
    #else
    makeCaseForType eClass tvMap conName ty = do
      let varNames = Map.keys tvMap

      a' <- newName "a'"
      b' <- newName "b'"
      case varNames of
        [] -> varE eqValName
        varName:_ ->
          if mentionsName ty varNames
             then lamE (map varP [a',b']) $ varE eq1ValName
                    `appE` (makeFmapApplyNeg eClass conName ty varName `appE` varE a')
                    `appE` (makeFmapApplyNeg eClass conName ty varName `appE` varE b')
             else varE eqValName
    #endif

    -------------------------------------------------------------------------------
    -- Class-specific constants
    -------------------------------------------------------------------------------

    -- | A representation of which @Eq@ variant is being derived.
    data EqClass = Eq
                 | Eq1
    #if defined(NEW_FUNCTOR_CLASSES)
                 | Eq2
    #endif
      deriving (EqClass
    EqClass -> EqClass -> Bounded EqClass
    forall a. a -> a -> Bounded a
    maxBound :: EqClass
    $cmaxBound :: EqClass
    minBound :: EqClass
    $cminBound :: EqClass
    Bounded, Int -> EqClass
    EqClass -> Int
    EqClass -> [EqClass]
    EqClass -> EqClass
    EqClass -> EqClass -> [EqClass]
    EqClass -> EqClass -> EqClass -> [EqClass]
    (EqClass -> EqClass)
    -> (EqClass -> EqClass)
    -> (Int -> EqClass)
    -> (EqClass -> Int)
    -> (EqClass -> [EqClass])
    -> (EqClass -> EqClass -> [EqClass])
    -> (EqClass -> EqClass -> [EqClass])
    -> (EqClass -> EqClass -> EqClass -> [EqClass])
    -> Enum EqClass
    forall a.
    (a -> a)
    -> (a -> a)
    -> (Int -> a)
    -> (a -> Int)
    -> (a -> [a])
    -> (a -> a -> [a])
    -> (a -> a -> [a])
    -> (a -> a -> a -> [a])
    -> Enum a
    enumFromThenTo :: EqClass -> EqClass -> EqClass -> [EqClass]
    $cenumFromThenTo :: EqClass -> EqClass -> EqClass -> [EqClass]
    enumFromTo :: EqClass -> EqClass -> [EqClass]
    $cenumFromTo :: EqClass -> EqClass -> [EqClass]
    enumFromThen :: EqClass -> EqClass -> [EqClass]
    $cenumFromThen :: EqClass -> EqClass -> [EqClass]
    enumFrom :: EqClass -> [EqClass]
    $cenumFrom :: EqClass -> [EqClass]
    fromEnum :: EqClass -> Int
    $cfromEnum :: EqClass -> Int
    toEnum :: Int -> EqClass
    $ctoEnum :: Int -> EqClass
    pred :: EqClass -> EqClass
    $cpred :: EqClass -> EqClass
    succ :: EqClass -> EqClass
    $csucc :: EqClass -> EqClass
    Enum)

    instance ClassRep EqClass where
        arity :: EqClass -> Int
    arity = EqClass -> Int
    forall a. Enum a => a -> Int
    fromEnum

        allowExQuant :: EqClass -> Bool
    allowExQuant _ = Bool
    True

        fullClassName :: EqClass -> Name
    fullClassName Eq  = Name
    eqTypeName
        fullClassName Eq1 = Name
    eq1TypeName
    #if defined(NEW_FUNCTOR_CLASSES)
        fullClassName Eq2 = Name
    eq2TypeName
    #endif

        classConstraint :: EqClass -> Int -> Maybe Name
    classConstraint eClass :: EqClass
    eClass i :: Int
    i
          | Int
    eMin Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    i Bool -> Bool -> Bool
    && Int
    i Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    eMax = Name -> Maybe Name
    forall a. a -> Maybe a
    Just (Name -> Maybe Name) -> Name -> Maybe Name
    forall a b. (a -> b) -> a -> b
    $ EqClass -> Name
    forall a. ClassRep a => a -> Name
    fullClassName (Int -> EqClass
    forall a. Enum a => Int -> a
    toEnum Int
    i :: EqClass)
          | Bool
    otherwise              = Maybe Name
    forall a. Maybe a
    Nothing
          where
            eMin, eMax :: Int
            eMin :: Int
    eMin = EqClass -> Int
    forall a. Enum a => a -> Int
    fromEnum (EqClass
    forall a. Bounded a => a
    minBound :: EqClass)
            eMax :: Int
    eMax = EqClass -> Int
    forall a. Enum a => a -> Int
    fromEnum EqClass
    eClass

    eqConstName :: EqClass -> Name
    eqConstName :: EqClass -> Name
    eqConstName Eq  = Name
    eqConstValName
    #if defined(NEW_FUNCTOR_CLASSES)
    eqConstName Eq1 = Name
    liftEqConstValName
    eqConstName Eq2 = Name
    liftEq2ConstValName
    #else
    eqConstName Eq1 = eq1ConstValName
    #endif

    eqName :: EqClass -> Name
    eqName :: EqClass -> Name
    eqName Eq  = Name
    eqValName
    #if defined(NEW_FUNCTOR_CLASSES)
    eqName Eq1 = Name
    liftEqValName
    eqName Eq2 = Name
    liftEq2ValName
    #else
    eqName Eq1 = eq1ValName
    #endif