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

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

#ifndef CURRENT_PACKAGE_KEY
import           Data.Version (showVersion)
import           Paths_generic_deriving (version)
#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 = 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 (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 = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr' (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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StarKindStatus -> StarKindStatus -> Bool
$c/= :: StarKindStatus -> StarKindStatus -> Bool
== :: StarKindStatus -> StarKindStatus -> Bool
$c== :: 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) = forall a. a -> Maybe a
Just Name
n
starKindStatusToName StarKindStatus
_             = 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 = 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)          = forall a. a -> Maybe a
Just (Name -> TyVarBndrUnit
plainTV Name
n)
typeToTyVarBndr (SigT (VarT Name
n) Type
k) = forall a. a -> Maybe a
Just (Name -> Type -> TyVarBndrUnit
kindedTV Name
n Type
k)
typeToTyVarBndr Type
_                 = 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 = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr' (Type -> Type -> Type
AppT 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 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 forall a. Num a => a -> a -> a
+ Int
1) (Type -> Type
dustOff Type
f)
      Type
_ -> 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
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Maybe [TyVarBndrUnit]
mbinders of
        Just [TyVarBndrUnit]
bndrs -> forall (t :: * -> *) a. Foldable t => t a -> Int
length [TyVarBndrUnit]
bndrs 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 [TyVarBndr_ ()])
getTypeFamilyBinders :: Name -> Q (Maybe [TyVarBndrUnit])
getTypeFamilyBinders Name
tcName = do
      Info
info <- Name -> Q Info
reify Name
tcName
      forall (m :: * -> *) a. Monad m => a -> m a
return 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]
_
          -> 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]
_
          -> forall a. a -> Maybe a
Just [TyVarBndrUnit]
bndrs
#elif MIN_VERSION_template_haskell(2,9,0)
        FamilyI (ClosedTypeFamilyD _ bndrs _ _) _
          -> Just bndrs
#endif

        Info
_ -> 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 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` forall a. TypeSubstitution a => a -> [Name]
freeVariables Type
ty

-- | Construct a type via curried application.
applyTyToTys :: Type -> [Type] -> Type
applyTyToTys :: Type -> [Type] -> Type
applyTyToTys = 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 = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' (\Type
a -> Type -> Type -> Type
AppT Type
a forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall flag. TyVarBndr_ flag -> Type
tyVarBndrToType) 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
t1forall 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 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 = 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 = forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *). Quote m => String -> m Name
newName forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
prefix forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 =
       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
&& forall a. Ord a => [a] -> Bool
allDistinct [Name]
droppedNames
    Bool -> Bool -> Bool
&& Bool -> Bool
not (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 = 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
_          = 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 = 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 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 = forall a. Ord a => Set a -> [a] -> Bool
allDistinct' 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 forall a. Ord a => a -> Set a -> Bool
`Set.member` Set a
uniqs = Bool
False
        | Bool
otherwise            = forall a. Ord a => Set a -> [a] -> Bool
allDistinct' (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 = forall {t}. (t -> t -> t) -> t -> Int -> [t] -> t
fold_bal a -> a -> a
op0 a
x0 (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 forall a. Integral a => a -> a -> a
`div` Int
2
                 !nr :: Int
nr = Int
n forall a. Num a => a -> a -> a
- Int
nl
                 ([t]
l,[t]
r) = 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]
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 :: GenericClass -> GenericClass -> GenericClass -> [GenericClass]
$cenumFromThenTo :: GenericClass -> GenericClass -> GenericClass -> [GenericClass]
enumFromTo :: GenericClass -> GenericClass -> [GenericClass]
$cenumFromTo :: GenericClass -> GenericClass -> [GenericClass]
enumFromThen :: GenericClass -> GenericClass -> [GenericClass]
$cenumFromThen :: GenericClass -> GenericClass -> [GenericClass]
enumFrom :: GenericClass -> [GenericClass]
$cenumFrom :: GenericClass -> [GenericClass]
fromEnum :: GenericClass -> Int
$cfromEnum :: GenericClass -> Int
toEnum :: Int -> GenericClass
$ctoEnum :: Int -> GenericClass
pred :: GenericClass -> GenericClass
$cpred :: GenericClass -> GenericClass
succ :: GenericClass -> GenericClass
$csucc :: 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 = forall a. [a] -> [a]
init [Type]
tySynVars

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

    mbLastArgKindName :: Maybe Name
    mbLastArgKindName :: Maybe Name
mbLastArgKindName = StarKindStatus -> Maybe Name
starKindStatusToName
                      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 = (forall a. [a] -> [a] -> [a]
++ Char
'_'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_" forall a. [a] -> [a] -> [a]
++ String -> String
sanitizeName (Name -> String
nameBase 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 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 forall a. [a] -> [a] -> [a]
++ 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'forall a. a -> [a] -> [a]
:(
    String
nb 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 forall a. Eq a => a -> a -> Bool
== Char
'\''-> [Char
c]
      Char
'_' -> String
"__"
      Char
c   -> String
"_" forall a. [a] -> [a] -> [a]
++ 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 = forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$
  String
"Cannot eta-reduce to an instance of form \n\tinstance (...) => "
  forall a. [a] -> [a] -> [a]
++ 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 = forall (m :: * -> *) a. MonadFail m => String -> m a
fail
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
showString String
"Cannot derive well-kinded instance of form ‘Generic1 "
  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)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
showString 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)
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
showString String
"k -> *"
#else
  . showString "* -> *"
#endif
  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 = forall (m :: * -> *) a. MonadFail m => String -> m a
fail
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
showString String
"Constructor must only use its last type variable as"
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
showString String
" the last argument of a data type"
  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 = forall (m :: * -> *) a. MonadFail m => String -> m a
fail
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
showString String
"Constructor must not apply its last type variable"
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
showString String
" to an unsaturated type family"
  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 = forall (m :: * -> *) a. MonadFail m => String -> m a
fail
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
showString String
"Cannot derive instance for ‘"
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
showString (Name -> String
nameBase Name
dataName)
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
showString String
"‘, which is a ‘type data‘ declaration"
  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 = 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
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
ns forall a. [a] -> [a] -> [a]
++ String
" Could not reify " forall a. [a] -> [a] -> [a]
++ Name -> String
nameBase Name
name
 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        -> forall (m :: * -> *) a. Monad m => a -> m a
return DatatypeVariant_
Datatype_
                   DatatypeVariant
Newtype         -> forall (m :: * -> *) a. Monad m => a -> m a
return DatatypeVariant_
Newtype_
                   -- This isn't total, but the API requires that the data
                   -- family instance have at least one constructor anyways,
                   -- so this will always succeed.
                   DatatypeVariant
DataInstance    -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ConstructorInfo -> DatatypeVariant_
DataInstance_    forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head [ConstructorInfo]
cons
                   DatatypeVariant
NewtypeInstance -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ConstructorInfo -> DatatypeVariant_
NewtypeInstance_ forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head [ConstructorInfo]
cons
#if MIN_VERSION_th_abstraction(0,5,0)
                   DatatypeVariant
Datatype.TypeData -> forall a. Name -> Q a
typeDataError Name
parentName
#endif
     forall a. Name -> [Type] -> a -> Q a
checkDataContext Name
parentName [Type]
ctxt forall a b. (a -> b) -> a -> b
$ 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: "

-- | 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 = forall (m :: * -> *) a. Monad m => a -> m a
return a
x
checkDataContext Name
dataName [Type]
_  a
_ = forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$
  Name -> String
nameBase Name
dataName 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
conName [TyVarBndrUnit]
vars [Type]
ctxt =
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TyVarBndrUnit]
vars Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Type]
ctxt) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$
    Name -> String
nameBase Name
conName forall a. [a] -> [a] -> [a]
++ String
" must be a vanilla data constructor"

-------------------------------------------------------------------------------
-- Manually quoted names
-------------------------------------------------------------------------------

-- 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 :: String
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 :: String -> Name
mkGD4'4_d = String -> String -> String -> Name
mkNameG_d String
"base" String
"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
#if MIN_VERSION_base(4,9,0)
mkGD4'9_d :: String -> Name
mkGD4'9_d = String -> String -> String -> Name
mkNameG_d String
"base" String
"GHC.Generics"
#else
mkGD4'9_d = mkNameG_d gdPackageKey "Generics.Deriving.Base.Internal"
#endif

mkGD4'4_tc :: String -> Name
#if MIN_VERSION_base(4,6,0)
mkGD4'4_tc :: String -> Name
mkGD4'4_tc = String -> String -> String -> Name
mkNameG_tc String
"base" String
"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
#if MIN_VERSION_base(4,9,0)
mkGD4'9_tc :: String -> Name
mkGD4'9_tc = String -> String -> String -> Name
mkNameG_tc String
"base" String
"GHC.Generics"
#else
mkGD4'9_tc = mkNameG_tc gdPackageKey "Generics.Deriving.Base.Internal"
#endif

mkGD4'4_v :: String -> Name
#if MIN_VERSION_base(4,6,0)
mkGD4'4_v :: String -> Name
mkGD4'4_v = String -> String -> String -> Name
mkNameG_v String
"base" String
"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
#if MIN_VERSION_base(4,9,0)
mkGD4'9_v :: String -> Name
mkGD4'9_v = String -> String -> String -> Name
mkNameG_v String
"base" String
"GHC.Generics"
#else
mkGD4'9_v = mkNameG_v gdPackageKey "Generics.Deriving.Base.Internal"
#endif

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

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

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

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

comp1DataName :: Name
comp1DataName :: Name
comp1DataName = String -> Name
mkGD4'4_d String
"Comp1"

infixDataName :: Name
infixDataName :: Name
infixDataName = String -> Name
mkGD4'4_d String
"Infix"

k1DataName :: Name
k1DataName :: Name
k1DataName = String -> Name
mkGD4'4_d String
"K1"

l1DataName :: Name
l1DataName :: Name
l1DataName = String -> Name
mkGD4'4_d String
"L1"

leftAssociativeDataName :: Name
leftAssociativeDataName :: Name
leftAssociativeDataName = String -> Name
mkGD4'4_d String
"LeftAssociative"

m1DataName :: Name
m1DataName :: Name
m1DataName = String -> Name
mkGD4'4_d String
"M1"

notAssociativeDataName :: Name
notAssociativeDataName :: Name
notAssociativeDataName = String -> Name
mkGD4'4_d String
"NotAssociative"

par1DataName :: Name
par1DataName :: Name
par1DataName = String -> Name
mkGD4'4_d String
"Par1"

prefixDataName :: Name
prefixDataName :: Name
prefixDataName = String -> Name
mkGD4'4_d String
"Prefix"

productDataName :: Name
productDataName :: Name
productDataName = String -> Name
mkGD4'4_d String
":*:"

r1DataName :: Name
r1DataName :: Name
r1DataName = String -> Name
mkGD4'4_d String
"R1"

rec1DataName :: Name
rec1DataName :: Name
rec1DataName = String -> Name
mkGD4'4_d String
"Rec1"

rightAssociativeDataName :: Name
rightAssociativeDataName :: Name
rightAssociativeDataName = String -> Name
mkGD4'4_d String
"RightAssociative"

u1DataName :: Name
u1DataName :: Name
u1DataName = String -> Name
mkGD4'4_d String
"U1"

uAddrDataName :: Name
uAddrDataName :: Name
uAddrDataName = String -> Name
mkGD4'9_d String
"UAddr"

uCharDataName :: Name
uCharDataName :: Name
uCharDataName = String -> Name
mkGD4'9_d String
"UChar"

uDoubleDataName :: Name
uDoubleDataName :: Name
uDoubleDataName = String -> Name
mkGD4'9_d String
"UDouble"

uFloatDataName :: Name
uFloatDataName :: Name
uFloatDataName = String -> Name
mkGD4'9_d String
"UFloat"

uIntDataName :: Name
uIntDataName :: Name
uIntDataName = String -> Name
mkGD4'9_d String
"UInt"

uWordDataName :: Name
uWordDataName :: Name
uWordDataName = String -> Name
mkGD4'9_d String
"UWord"

c1TypeName :: Name
c1TypeName :: Name
c1TypeName = String -> Name
mkGD4'4_tc String
"C1"

composeTypeName :: Name
composeTypeName :: Name
composeTypeName = String -> Name
mkGD4'4_tc String
":.:"

constructorTypeName :: Name
constructorTypeName :: Name
constructorTypeName = String -> Name
mkGD4'4_tc String
"Constructor"

d1TypeName :: Name
d1TypeName :: Name
d1TypeName = String -> Name
mkGD4'4_tc String
"D1"

genericTypeName :: Name
genericTypeName :: Name
genericTypeName = String -> Name
mkGD4'4_tc String
"Generic"

generic1TypeName :: Name
generic1TypeName :: Name
generic1TypeName = String -> Name
mkGD4'4_tc String
"Generic1"

datatypeTypeName :: Name
datatypeTypeName :: Name
datatypeTypeName = String -> Name
mkGD4'4_tc String
"Datatype"

noSelectorTypeName :: Name
noSelectorTypeName :: Name
noSelectorTypeName = String -> Name
mkGD4'4_tc String
"NoSelector"

par1TypeName :: Name
par1TypeName :: Name
par1TypeName = String -> Name
mkGD4'4_tc String
"Par1"

productTypeName :: Name
productTypeName :: Name
productTypeName = String -> Name
mkGD4'4_tc String
":*:"

rec0TypeName :: Name
rec0TypeName :: Name
rec0TypeName = String -> Name
mkGD4'4_tc String
"Rec0"

rec1TypeName :: Name
rec1TypeName :: Name
rec1TypeName = String -> Name
mkGD4'4_tc String
"Rec1"

repTypeName :: Name
repTypeName :: Name
repTypeName = String -> Name
mkGD4'4_tc String
"Rep"

rep1TypeName :: Name
rep1TypeName :: Name
rep1TypeName = String -> Name
mkGD4'4_tc String
"Rep1"

s1TypeName :: Name
s1TypeName :: Name
s1TypeName = String -> Name
mkGD4'4_tc String
"S1"

selectorTypeName :: Name
selectorTypeName :: Name
selectorTypeName = String -> Name
mkGD4'4_tc String
"Selector"

sumTypeName :: Name
sumTypeName :: Name
sumTypeName = String -> Name
mkGD4'4_tc String
":+:"

u1TypeName :: Name
u1TypeName :: Name
u1TypeName = String -> Name
mkGD4'4_tc String
"U1"

uAddrTypeName :: Name
uAddrTypeName :: Name
uAddrTypeName = String -> Name
mkGD4'9_tc String
"UAddr"

uCharTypeName :: Name
uCharTypeName :: Name
uCharTypeName = String -> Name
mkGD4'9_tc String
"UChar"

uDoubleTypeName :: Name
uDoubleTypeName :: Name
uDoubleTypeName = String -> Name
mkGD4'9_tc String
"UDouble"

uFloatTypeName :: Name
uFloatTypeName :: Name
uFloatTypeName = String -> Name
mkGD4'9_tc String
"UFloat"

uIntTypeName :: Name
uIntTypeName :: Name
uIntTypeName = String -> Name
mkGD4'9_tc String
"UInt"

uWordTypeName :: Name
uWordTypeName :: Name
uWordTypeName = String -> Name
mkGD4'9_tc String
"UWord"

v1TypeName :: Name
v1TypeName :: Name
v1TypeName = String -> Name
mkGD4'4_tc String
"V1"

conFixityValName :: Name
conFixityValName :: Name
conFixityValName = String -> Name
mkGD4'4_v String
"conFixity"

conIsRecordValName :: Name
conIsRecordValName :: Name
conIsRecordValName = String -> Name
mkGD4'4_v String
"conIsRecord"

conNameValName :: Name
conNameValName :: Name
conNameValName = String -> Name
mkGD4'4_v String
"conName"

datatypeNameValName :: Name
datatypeNameValName :: Name
datatypeNameValName = String -> Name
mkGD4'4_v String
"datatypeName"

isNewtypeValName :: Name
isNewtypeValName :: Name
isNewtypeValName = String -> Name
mkGD4'4_v String
"isNewtype"

fromValName :: Name
fromValName :: Name
fromValName = String -> Name
mkGD4'4_v String
"from"

from1ValName :: Name
from1ValName :: Name
from1ValName = String -> Name
mkGD4'4_v String
"from1"

moduleNameValName :: Name
moduleNameValName :: Name
moduleNameValName = String -> Name
mkGD4'4_v String
"moduleName"

selNameValName :: Name
selNameValName :: Name
selNameValName = String -> Name
mkGD4'4_v String
"selName"

seqValName :: Name
seqValName :: Name
seqValName = String -> String -> Name
mkGHCPrimName_v String
"GHC.Prim" String
"seq"

toValName :: Name
toValName :: Name
toValName = String -> Name
mkGD4'4_v String
"to"

to1ValName :: Name
to1ValName :: Name
to1ValName = String -> Name
mkGD4'4_v String
"to1"

uAddrHashValName :: Name
uAddrHashValName :: Name
uAddrHashValName = String -> Name
mkGD4'9_v String
"uAddr#"

uCharHashValName :: Name
uCharHashValName :: Name
uCharHashValName = String -> Name
mkGD4'9_v String
"uChar#"

uDoubleHashValName :: Name
uDoubleHashValName :: Name
uDoubleHashValName = String -> Name
mkGD4'9_v String
"uDouble#"

uFloatHashValName :: Name
uFloatHashValName :: Name
uFloatHashValName = String -> Name
mkGD4'9_v String
"uFloat#"

uIntHashValName :: Name
uIntHashValName :: Name
uIntHashValName = String -> Name
mkGD4'9_v String
"uInt#"

uWordHashValName :: Name
uWordHashValName :: Name
uWordHashValName = String -> Name
mkGD4'9_v String
"uWord#"

unComp1ValName :: Name
unComp1ValName :: Name
unComp1ValName = String -> Name
mkGD4'4_v String
"unComp1"

unK1ValName :: Name
unK1ValName :: Name
unK1ValName = String -> Name
mkGD4'4_v String
"unK1"

unPar1ValName :: Name
unPar1ValName :: Name
unPar1ValName = String -> Name
mkGD4'4_v String
"unPar1"

unRec1ValName :: Name
unRec1ValName :: Name
unRec1ValName = String -> Name
mkGD4'4_v String
"unRec1"

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

nothingDataName, justDataName :: Name
#if MIN_VERSION_base(4,12,0)
nothingDataName :: Name
nothingDataName = String -> String -> Name
mkBaseName_d String
"GHC.Maybe"  String
"Nothing"
justDataName :: Name
justDataName    = String -> String -> Name
mkBaseName_d String
"GHC.Maybe"  String
"Just"
#elif 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 :: String -> Name
mkGHCPrim_tc = String -> String -> String -> Name
mkNameG_tc String
"ghc-prim" String
"GHC.Prim"

addrHashTypeName :: Name
addrHashTypeName :: Name
addrHashTypeName = String -> Name
mkGHCPrim_tc String
"Addr#"

charHashTypeName :: Name
charHashTypeName :: Name
charHashTypeName = String -> Name
mkGHCPrim_tc String
"Char#"

doubleHashTypeName :: Name
doubleHashTypeName :: Name
doubleHashTypeName = String -> Name
mkGHCPrim_tc String
"Double#"

floatHashTypeName :: Name
floatHashTypeName :: Name
floatHashTypeName = String -> Name
mkGHCPrim_tc String
"Float#"

intHashTypeName :: Name
intHashTypeName :: Name
intHashTypeName = String -> Name
mkGHCPrim_tc String
"Int#"

wordHashTypeName :: Name
wordHashTypeName :: Name
wordHashTypeName = String -> Name
mkGHCPrim_tc String
"Word#"

composeValName :: Name
composeValName :: Name
composeValName = String -> String -> String -> Name
mkNameG_v String
"base" String
"GHC.Base" String
"."

errorValName :: Name
errorValName :: Name
errorValName = String -> String -> String -> Name
mkNameG_v String
"base" String
"GHC.Err" String
"error"

fmapValName :: Name
fmapValName :: Name
fmapValName = String -> String -> String -> Name
mkNameG_v String
"base" String
"GHC.Base" String
"fmap"

undefinedValName :: Name
undefinedValName :: Name
undefinedValName = String -> String -> String -> Name
mkNameG_v String
"base" String
"GHC.Err" String
"undefined"

decidedLazyDataName :: Name
decidedLazyDataName :: Name
decidedLazyDataName = String -> Name
mkGD4'9_d String
"DecidedLazy"

decidedStrictDataName :: Name
decidedStrictDataName :: Name
decidedStrictDataName = String -> Name
mkGD4'9_d String
"DecidedStrict"

decidedUnpackDataName :: Name
decidedUnpackDataName :: Name
decidedUnpackDataName = String -> Name
mkGD4'9_d String
"DecidedUnpack"

infixIDataName :: Name
infixIDataName :: Name
infixIDataName = String -> Name
mkGD4'9_d String
"InfixI"

metaConsDataName :: Name
metaConsDataName :: Name
metaConsDataName = String -> Name
mkGD4'9_d String
"MetaCons"

metaDataDataName :: Name
metaDataDataName :: Name
metaDataDataName = String -> Name
mkGD4'9_d String
"MetaData"

metaNoSelDataName :: Name
metaNoSelDataName :: Name
metaNoSelDataName = String -> Name
mkGD4'9_d String
"MetaNoSel"

metaSelDataName :: Name
metaSelDataName :: Name
metaSelDataName = String -> Name
mkGD4'9_d String
"MetaSel"

noSourceStrictnessDataName :: Name
noSourceStrictnessDataName :: Name
noSourceStrictnessDataName = String -> Name
mkGD4'9_d String
"NoSourceStrictness"

noSourceUnpackednessDataName :: Name
noSourceUnpackednessDataName :: Name
noSourceUnpackednessDataName = String -> Name
mkGD4'9_d String
"NoSourceUnpackedness"

prefixIDataName :: Name
prefixIDataName :: Name
prefixIDataName = String -> Name
mkGD4'9_d String
"PrefixI"

sourceLazyDataName :: Name
sourceLazyDataName :: Name
sourceLazyDataName = String -> Name
mkGD4'9_d String
"SourceLazy"

sourceNoUnpackDataName :: Name
sourceNoUnpackDataName :: Name
sourceNoUnpackDataName = String -> Name
mkGD4'9_d String
"SourceNoUnpack"

sourceStrictDataName :: Name
sourceStrictDataName :: Name
sourceStrictDataName = String -> Name
mkGD4'9_d String
"SourceStrict"

sourceUnpackDataName :: Name
sourceUnpackDataName :: Name
sourceUnpackDataName = String -> Name
mkGD4'9_d String
"SourceUnpack"

packageNameValName :: Name
packageNameValName :: Name
packageNameValName = String -> Name
mkGD4'4_v String
"packageName"