{-# 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           Data.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
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 Kind -> Kind -> Kind
applySubstitutionKind = Map Name Kind -> Kind -> Kind
forall a. TypeSubstitution a => Map Name Kind -> a -> a
applySubstitution
#else
applySubstitutionKind _ t = t
#endif

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

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

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

-- | Whether a type is not of kind *, is of kind *, or is a kind variable.
data StarKindStatus = NotKindStar
                    | KindStar
                    | IsKindVar Name
  deriving StarKindStatus -> StarKindStatus -> Bool
(StarKindStatus -> StarKindStatus -> Bool)
-> (StarKindStatus -> StarKindStatus -> Bool) -> Eq StarKindStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: 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 :: Kind -> StarKindStatus
canRealizeKindStar t :: Kind
t
  | Kind -> Bool
hasKindStar Kind
t = StarKindStatus
KindStar
  | Bool
otherwise = case Kind
t of
#if MIN_VERSION_template_haskell(2,8,0)
                     SigT _ (VarT k :: Name
k) -> Name -> StarKindStatus
IsKindVar Name
k
#endif
                     _               -> StarKindStatus
NotKindStar

-- | Returns 'Just' the kind variable 'Name' of a 'StarKindStatus' if it exists.
-- Otherwise, returns 'Nothing'.
starKindStatusToName :: StarKindStatus -> Maybe Name
starKindStatusToName :: StarKindStatus -> Maybe Name
starKindStatusToName (IsKindVar n :: Name
n) = Name -> Maybe Name
forall a. a -> Maybe a
Just Name
n
starKindStatusToName _             = 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 :: Kind -> Bool
hasKindStar VarT{}         = Bool
True
#if MIN_VERSION_template_haskell(2,8,0)
hasKindStar (SigT _ StarT) = Bool
True
#else
hasKindStar (SigT _ StarK) = True
#endif
hasKindStar _              = Bool
False

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

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

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

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

-- | Is the given type a type family constructor (and not a data family constructor)?
isTyFamily :: Type -> Q Bool
isTyFamily :: Kind -> Q Bool
isTyFamily (ConT n :: Name
n) = do
    Info
info <- Name -> Q Info
reify Name
n
    Bool -> Q Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Q Bool) -> Bool -> Q Bool
forall a b. (a -> b) -> a -> b
$ case Info
info of
#if MIN_VERSION_template_haskell(2,11,0)
         FamilyI OpenTypeFamilyD{} _       -> Bool
True
#elif MIN_VERSION_template_haskell(2,7,0)
         FamilyI (FamilyD TypeFam _ _ _) _ -> True
#else
         TyConI  (FamilyD TypeFam _ _ _)   -> True
#endif
#if MIN_VERSION_template_haskell(2,9,0)
         FamilyI ClosedTypeFamilyD{} _     -> Bool
True
#endif
         _ -> Bool
False
isTyFamily _ = Bool -> Q Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

-- | True if the type does not mention the Name
ground :: Type -> Name -> Bool
ground :: Kind -> Name -> Bool
ground (AppT t1 :: Kind
t1 t2 :: Kind
t2) name :: Name
name = Kind -> Name -> Bool
ground Kind
t1 Name
name Bool -> Bool -> Bool
&& Kind -> Name -> Bool
ground Kind
t2 Name
name
ground (SigT t :: Kind
t _)   name :: Name
name = Kind -> Name -> Bool
ground Kind
t Name
name
ground (VarT t :: Name
t)     name :: Name
name = Name
t Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
/= Name
name
ground ForallT{}    _    = Bool
forall a. a
rankNError
ground _            _    = Bool
True

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

-- | Apply a type constructor name to type variable binders.
applyTyToTvbs :: Name -> [TyVarBndr] -> Type
applyTyToTvbs :: Name -> [TyVarBndr] -> Kind
applyTyToTvbs = (Kind -> TyVarBndr -> Kind) -> Kind -> [TyVarBndr] -> Kind
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\a :: Kind
a -> Kind -> Kind -> Kind
AppT Kind
a (Kind -> Kind) -> (TyVarBndr -> Kind) -> TyVarBndr -> Kind
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TyVarBndr -> Kind
tyVarBndrToType) (Kind -> [TyVarBndr] -> Kind)
-> (Name -> Kind) -> Name -> [TyVarBndr] -> Kind
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Kind
ConT

-- | Split an applied type into its individual components. For example, this:
--
-- @
-- Either Int Char
-- @
--
-- would split to this:
--
-- @
-- [Either, Int, Char]
-- @
unapplyTy :: Type -> [Type]
unapplyTy :: Kind -> [Kind]
unapplyTy = [Kind] -> [Kind]
forall a. [a] -> [a]
reverse ([Kind] -> [Kind]) -> (Kind -> [Kind]) -> Kind -> [Kind]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Kind -> [Kind]
go
  where
    go :: Type -> [Type]
    go :: Kind -> [Kind]
go (AppT t1 :: Kind
t1 t2 :: Kind
t2)    = Kind
t2 Kind -> [Kind] -> [Kind]
forall a. a -> [a] -> [a]
: Kind -> [Kind]
go Kind
t1
    go (SigT t :: Kind
t _)      = Kind -> [Kind]
go Kind
t
    go (ForallT _ _ t :: Kind
t) = Kind -> [Kind]
go Kind
t
    go t :: Kind
t               = [Kind
t]

-- | 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 -> ([TyVarBndr], [Type])
uncurryTy :: Kind -> ([TyVarBndr], [Kind])
uncurryTy (AppT (AppT ArrowT t1 :: Kind
t1) t2 :: Kind
t2) =
  let (tvbs :: [TyVarBndr]
tvbs, tys :: [Kind]
tys) = Kind -> ([TyVarBndr], [Kind])
uncurryTy Kind
t2
  in ([TyVarBndr]
tvbs, Kind
t1Kind -> [Kind] -> [Kind]
forall a. a -> [a] -> [a]
:[Kind]
tys)
uncurryTy (SigT t :: Kind
t _) = Kind -> ([TyVarBndr], [Kind])
uncurryTy Kind
t
uncurryTy (ForallT tvbs :: [TyVarBndr]
tvbs _ t :: Kind
t) =
  let (tvbs' :: [TyVarBndr]
tvbs', tys :: [Kind]
tys) = Kind -> ([TyVarBndr], [Kind])
uncurryTy Kind
t
  in ([TyVarBndr]
tvbs [TyVarBndr] -> [TyVarBndr] -> [TyVarBndr]
forall a. [a] -> [a] -> [a]
++ [TyVarBndr]
tvbs', [Kind]
tys)
uncurryTy t :: Kind
t = ([], [Kind
t])

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

tyVarBndrToType :: TyVarBndr -> Type
tyVarBndrToType :: TyVarBndr -> Kind
tyVarBndrToType (PlainTV n :: Name
n)    = Name -> Kind
VarT Name
n
tyVarBndrToType (KindedTV n :: Name
n k :: Kind
k) = Kind -> Kind -> Kind
SigT (Name -> Kind
VarT Name
n) Kind
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 prefix :: String
prefix n :: 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)
mapM (String -> Q 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) [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 :: [Kind] -> [Kind] -> Bool
canEtaReduce remaining :: [Kind]
remaining dropped :: [Kind]
dropped =
       (Kind -> Bool) -> [Kind] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Kind -> Bool
isTyVar [Kind]
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 ((Kind -> Bool) -> [Kind] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Kind -> [Name] -> Bool
`mentionsName` [Name]
droppedNames) [Kind]
remaining)
  where
    droppedNames :: [Name]
    droppedNames :: [Name]
droppedNames = (Kind -> Name) -> [Kind] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map Kind -> Name
varTToName [Kind]
dropped

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

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

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

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

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

-- | Peel off a kind signature from a TyVarBndr (if it has one).
unKindedTV :: TyVarBndr -> TyVarBndr
unKindedTV :: TyVarBndr -> TyVarBndr
unKindedTV (KindedTV n :: Name
n _) = Name -> TyVarBndr
PlainTV Name
n
unKindedTV tvb :: TyVarBndr
tvb            = TyVarBndr
tvb

-- | Does the given type mention any of the Names in the list?
mentionsName :: Type -> [Name] -> Bool
mentionsName :: Kind -> [Name] -> Bool
mentionsName = Kind -> [Name] -> Bool
go
  where
    go :: Type -> [Name] -> Bool
    go :: Kind -> [Name] -> Bool
go (AppT t1 :: Kind
t1 t2 :: Kind
t2) names :: [Name]
names = Kind -> [Name] -> Bool
go Kind
t1 [Name]
names Bool -> Bool -> Bool
|| Kind -> [Name] -> Bool
go Kind
t2 [Name]
names
    go (SigT t :: Kind
t _k :: Kind
_k)  names :: [Name]
names = Kind -> [Name] -> Bool
go Kind
t [Name]
names
#if MIN_VERSION_template_haskell(2,8,0)
                              Bool -> Bool -> Bool
|| Kind -> [Name] -> Bool
go Kind
_k [Name]
names
#endif
    go (VarT n :: Name
n)     names :: [Name]
names = Name
n Name -> [Name] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Name]
names
    go _            _     = 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 :: [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' :: Set a -> [a] -> Bool
allDistinct' uniqs :: Set a
uniqs (x :: a
x:xs :: [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' _ _           = Bool
True

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

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

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

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

foldBal :: (a -> a -> a) -> a -> [a] -> a
foldBal :: (a -> a -> a) -> a -> [a] -> a
foldBal _  x :: a
x []  = a
x
foldBal _  _ [y :: a
y] = a
y
foldBal op :: a -> a -> a
op x :: a
x l :: [a]
l   = let (a :: [a]
a,b :: [a]
b) = Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
l Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` 2) [a]
l
                   in (a -> a -> a) -> a -> [a] -> a
forall a. (a -> a -> a) -> a -> [a] -> a
foldBal a -> a -> a
op a
x [a]
a a -> a -> a
`op` (a -> a -> a) -> a -> [a] -> a
forall a. (a -> a -> a) -> a -> [a] -> a
foldBal a -> a -> a
op a
x [a]
b

isNewtypeVariant :: DatatypeVariant_ -> Bool
isNewtypeVariant :: DatatypeVariant_ -> Bool
isNewtypeVariant Datatype_             = Bool
False
isNewtypeVariant 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
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

-- | Like 'GenericArity', but bundling two things in the 'Gen1' case:
--
-- 1. The 'Name' of the last type parameter.
-- 2. If that last type parameter had kind k (where k is some kind variable),
--    then it has 'Just' the kind variable 'Name'. Otherwise, it has 'Nothing'.
data GenericKind = Gen0
                 | Gen1 Name (Maybe Name)

-- Determines the universally quantified type variables (possibly after
-- substituting * in the case of Generic1) and the last type parameter name
-- (if there is one).
genericKind :: GenericClass -> [Type] -> ([TyVarBndr], GenericKind)
genericKind :: GenericClass -> [Kind] -> ([TyVarBndr], GenericKind)
genericKind gClass :: GenericClass
gClass tySynVars :: [Kind]
tySynVars =
  case GenericClass
gClass of
    Generic  -> ([Kind] -> [TyVarBndr]
freeVariablesWellScoped [Kind]
tySynVars, GenericKind
Gen0)
    Generic1 -> ([Kind] -> [TyVarBndr]
freeVariablesWellScoped [Kind]
initArgs, Name -> Maybe Name -> GenericKind
Gen1 (Kind -> Name
varTToName Kind
lastArg) Maybe Name
mbLastArgKindName)
  where
    -- Everything below is only used for Generic1.
    initArgs :: [Type]
    initArgs :: [Kind]
initArgs = [Kind] -> [Kind]
forall a. [a] -> [a]
init [Kind]
tySynVars

    lastArg :: Type
    lastArg :: Kind
lastArg = [Kind] -> Kind
forall a. [a] -> a
last [Kind]
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
$ Kind -> StarKindStatus
canRealizeKindStar Kind
lastArg

-- | 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 variant :: DatatypeVariant_
variant = (String -> String -> String
forall a. [a] -> [a] -> [a]
++ '_'Char -> String -> String
forall a. a -> [a] -> [a]
:String
label)
  where
    dataPlain :: String
    dataPlain :: String
dataPlain = "Plain"

    dataFamily :: ConstructorInfo -> String
    dataFamily :: ConstructorInfo -> String
dataFamily con :: ConstructorInfo
con = "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
              Datatype_            -> String
dataPlain
              Newtype_             -> String
dataPlain
              DataInstance_    con :: ConstructorInfo
con -> ConstructorInfo -> String
dataFamily ConstructorInfo
con
              NewtypeInstance_ con :: 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 _ (NameQ m :: ModName
m))       = ModName -> String
modString ModName
m
    showQual (Name _ (NameG _ pkg :: PkgName
pkg m :: ModName
m)) = PkgName -> String
pkgString PkgName
pkg String -> String -> String
forall a. [a] -> [a] -> [a]
++ ":" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ModName -> String
modString ModName
m
    showQual _                        = ""

-- | Credit to Víctor López Juan for this trick
sanitizeName :: String -> String
sanitizeName :: String -> String
sanitizeName nb :: String
nb = 'N'Char -> String -> String
forall a. a -> [a] -> [a]
:(
    String
nb String -> (Char -> String) -> String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \x :: Char
x -> case Char
x of
      c :: Char
c | Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\''-> [Char
c]
      '_' -> "__"
      c :: Char
c   -> "_" 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 :: Kind -> Q a
etaReductionError instanceType :: Kind
instanceType = 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
$
  "Cannot eta-reduce to an instance of form \n\tinstance (...) => "
  String -> String -> String
forall a. [a] -> [a] -> [a]
++ Kind -> String
forall a. Ppr a => a -> String
pprint Kind
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 :: Name -> Q a
derivingKindError tyConName :: Name
tyConName = 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 "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
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
showString "‘\n\tClass Generic1 expects an argument of kind * -> *"
  (String -> Q a) -> String -> Q a
forall a b. (a -> b) -> a -> b
$ ""

outOfPlaceTyVarError :: Q a
outOfPlaceTyVarError :: Q a
outOfPlaceTyVarError = String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail
    "Type applied to an argument involving the last parameter is not of kind * -> *"

-- | Cannot have a constructor argument of form (forall a1 ... an. <type>)
-- when deriving Generic(1)
rankNError :: a
rankNError :: a
rankNError = String -> a
forall a. HasCallStack => String -> a
error "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, [Kind], [ConstructorInfo], DatatypeVariant_))
reifyDataInfo name :: Name
name = do
  Either String (Name, [Kind], [ConstructorInfo], DatatypeVariant_)
-> Q (Either
        String (Name, [Kind], [ConstructorInfo], DatatypeVariant_))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String (Name, [Kind], [ConstructorInfo], DatatypeVariant_)
 -> Q (Either
         String (Name, [Kind], [ConstructorInfo], DatatypeVariant_)))
-> Either
     String (Name, [Kind], [ConstructorInfo], DatatypeVariant_)
-> Q (Either
        String (Name, [Kind], [ConstructorInfo], DatatypeVariant_))
forall a b. (a -> b) -> a -> b
$ String
-> Either
     String (Name, [Kind], [ConstructorInfo], DatatypeVariant_)
forall a b. a -> Either a b
Left (String
 -> Either
      String (Name, [Kind], [ConstructorInfo], DatatypeVariant_))
-> String
-> Either
     String (Name, [Kind], [ConstructorInfo], DatatypeVariant_)
forall a b. (a -> b) -> a -> b
$ String
ns String -> String -> String
forall a. [a] -> [a] -> [a]
++ " Could not reify " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Name -> String
nameBase Name
name
 Q (Either
     String (Name, [Kind], [ConstructorInfo], DatatypeVariant_))
-> Q (Either
        String (Name, [Kind], [ConstructorInfo], DatatypeVariant_))
-> Q (Either
        String (Name, [Kind], [ConstructorInfo], DatatypeVariant_))
forall a. Q a -> Q a -> Q a
`recover`
  do DatatypeInfo { datatypeContext :: DatatypeInfo -> [Kind]
datatypeContext   = [Kind]
ctxt
                  , datatypeName :: DatatypeInfo -> Name
datatypeName      = Name
parentName
                  , datatypeInstTypes :: DatatypeInfo -> [Kind]
datatypeInstTypes = [Kind]
tys
                  , datatypeVariant :: DatatypeInfo -> DatatypeVariant
datatypeVariant   = DatatypeVariant
variant
                  , datatypeCons :: DatatypeInfo -> [ConstructorInfo]
datatypeCons      = [ConstructorInfo]
cons
                  } <- Name -> Q DatatypeInfo
reifyDatatype Name
name
     let variant_ :: DatatypeVariant_
variant_ = case DatatypeVariant
variant of
                      Datatype        -> DatatypeVariant_
Datatype_
                      Newtype         -> 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.
                      DataInstance    -> ConstructorInfo -> DatatypeVariant_
DataInstance_    (ConstructorInfo -> DatatypeVariant_)
-> ConstructorInfo -> DatatypeVariant_
forall a b. (a -> b) -> a -> b
$ [ConstructorInfo] -> ConstructorInfo
forall a. [a] -> a
head [ConstructorInfo]
cons
                      NewtypeInstance -> ConstructorInfo -> DatatypeVariant_
NewtypeInstance_ (ConstructorInfo -> DatatypeVariant_)
-> ConstructorInfo -> DatatypeVariant_
forall a b. (a -> b) -> a -> b
$ [ConstructorInfo] -> ConstructorInfo
forall a. [a] -> a
head [ConstructorInfo]
cons
     Name
-> [Kind]
-> Either
     String (Name, [Kind], [ConstructorInfo], DatatypeVariant_)
-> Q (Either
        String (Name, [Kind], [ConstructorInfo], DatatypeVariant_))
forall a. Name -> [Kind] -> a -> Q a
checkDataContext Name
parentName [Kind]
ctxt (Either String (Name, [Kind], [ConstructorInfo], DatatypeVariant_)
 -> Q (Either
         String (Name, [Kind], [ConstructorInfo], DatatypeVariant_)))
-> Either
     String (Name, [Kind], [ConstructorInfo], DatatypeVariant_)
-> Q (Either
        String (Name, [Kind], [ConstructorInfo], DatatypeVariant_))
forall a b. (a -> b) -> a -> b
$ (Name, [Kind], [ConstructorInfo], DatatypeVariant_)
-> Either
     String (Name, [Kind], [ConstructorInfo], DatatypeVariant_)
forall a b. b -> Either a b
Right (Name
parentName, [Kind]
tys, [ConstructorInfo]
cons, DatatypeVariant_
variant_)
  where
    ns :: String
    ns :: String
ns = "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 :: Name -> [Kind] -> a -> Q a
checkDataContext _        [] x :: a
x = a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
checkDataContext dataName :: Name
dataName _  _ = 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]
++ " must not have a datatype context"

-- | Deriving Generic(1) doesn't work with ExistentialQuantification or GADTs.
checkExistentialContext :: Name -> [TyVarBndr] -> Cxt -> Q ()
checkExistentialContext :: Name -> [TyVarBndr] -> [Kind] -> Q ()
checkExistentialContext conName :: Name
conName vars :: [TyVarBndr]
vars ctxt :: [Kind]
ctxt =
  Bool -> Q () -> Q ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([TyVarBndr] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TyVarBndr]
vars Bool -> Bool -> Bool
&& [Kind] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Kind]
ctxt) (Q () -> Q ()) -> Q () -> Q ()
forall a b. (a -> b) -> a -> b
$ String -> Q ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Q ()) -> String -> Q ()
forall a b. (a -> b) -> a -> b
$
    Name -> String
nameBase Name
conName String -> String -> String
forall a. [a] -> [a] -> [a]
++ " 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 "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
#if MIN_VERSION_base(4,9,0)
mkGD4'9_d :: String -> Name
mkGD4'9_d = String -> String -> String -> Name
mkNameG_d "base" "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 "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
#if MIN_VERSION_base(4,9,0)
mkGD4'9_tc :: String -> Name
mkGD4'9_tc = String -> String -> String -> Name
mkNameG_tc "base" "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 "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
#if MIN_VERSION_base(4,9,0)
mkGD4'9_v :: String -> Name
mkGD4'9_v = String -> String -> String -> Name
mkNameG_v "base" "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 "base"

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

trueDataName, falseDataName :: Name
#if MIN_VERSION_base(4,4,0)
trueDataName :: Name
trueDataName  = String -> String -> Name
mkGHCPrimName_d "GHC.Types" "True"
falseDataName :: Name
falseDataName = String -> String -> Name
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,12,0)
nothingDataName :: Name
nothingDataName = String -> String -> Name
mkBaseName_d "GHC.Maybe"  "Nothing"
justDataName :: Name
justDataName    = String -> String -> Name
mkBaseName_d "GHC.Maybe"  "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 "ghc-prim" "GHC.Prim"

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

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

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

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

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

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

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

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

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

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

starKindName :: Name
starKindName :: Name
starKindName = String -> String -> Name
mkGHCPrimName_tc "GHC.Prim" "*"

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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