{-# OPTIONS_GHC -Wno-simplifiable-class-constraints #-}

{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE EmptyCase #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

-- | Type metadata accessors
--
-- Type names, constructor names...
--
-- === Warning
--
-- This is an internal module: it is not subject to any versioning policy,
-- breaking changes can happen at any time.
--
-- If something here seems useful, please report it or create a pull request to
-- export it from an external module.

module Generic.Data.Internal.Meta where

import Data.Proxy
import GHC.Generics
import GHC.TypeLits (Symbol, Nat, KnownNat, type (+), natVal, TypeError, ErrorMessage(..))

import Generic.Data.Internal.Functions

-- $setup
-- >>> :set -XDataKinds -XTypeApplications
-- >>> import Control.Applicative (ZipList)
-- >>> import Data.Monoid (Sum(..))

-- | Name of the first data constructor in a type as a string.
--
-- >>> gdatatypeName @(Maybe Int)
-- "Maybe"
gdatatypeName :: forall a. (Generic a, GDatatype (Rep a)) => String
gdatatypeName :: String
gdatatypeName = GDatatype (Rep a) => String
forall k (f :: k). GDatatype f => String
gDatatypeName @(Rep a)

-- | Name of the module where the first type constructor is defined.
--
-- >>> gmoduleName @(ZipList Int)
-- "Control.Applicative"
gmoduleName :: forall a. (Generic a, GDatatype (Rep a)) => String
gmoduleName :: String
gmoduleName = GDatatype (Rep a) => String
forall k (f :: k). GDatatype f => String
gModuleName @(Rep a)

-- | Name of the package where the first type constructor is defined.
--
-- >>> gpackageName @(Maybe Int)
-- "base"
gpackageName :: forall a. (Generic a, GDatatype (Rep a)) => String
gpackageName :: String
gpackageName = GDatatype (Rep a) => String
forall k (f :: k). GDatatype f => String
gPackageName @(Rep a)

-- | 'True' if the first type constructor is a newtype.
--
-- >>> gisNewtype @[Int]
-- False
-- >>> gisNewtype @(ZipList Int)
-- True
gisNewtype :: forall a. (Generic a, GDatatype (Rep a)) => Bool
gisNewtype :: Bool
gisNewtype = GDatatype (Rep a) => Bool
forall k (f :: k). GDatatype f => Bool
gIsNewtype @(Rep a)

fromDatatype :: forall d r. Datatype d => (M1 D d Proxy () -> r) -> r
fromDatatype :: (M1 D d Proxy () -> r) -> r
fromDatatype M1 D d Proxy () -> r
f = M1 D d Proxy () -> r
f (Proxy () -> M1 D d Proxy ()
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 Proxy ()
forall k (t :: k). Proxy t
Proxy :: M1 D d Proxy ())

-- | Generic representations that contain datatype metadata.
class GDatatype f where
  gDatatypeName :: String
  gModuleName :: String
  gPackageName :: String
  gIsNewtype :: Bool

instance Datatype d => GDatatype (M1 D d f) where
  gDatatypeName :: String
gDatatypeName = (M1 D d Proxy () -> String) -> String
forall (d :: Meta) r. Datatype d => (M1 D d Proxy () -> r) -> r
fromDatatype @d M1 D d Proxy () -> String
forall k (d :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Datatype d =>
t d f a -> String
datatypeName
  gModuleName :: String
gModuleName = (M1 D d Proxy () -> String) -> String
forall (d :: Meta) r. Datatype d => (M1 D d Proxy () -> r) -> r
fromDatatype @d M1 D d Proxy () -> String
forall k (d :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Datatype d =>
t d f a -> String
moduleName
  gPackageName :: String
gPackageName = (M1 D d Proxy () -> String) -> String
forall (d :: Meta) r. Datatype d => (M1 D d Proxy () -> r) -> r
fromDatatype @d M1 D d Proxy () -> String
forall k (d :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Datatype d =>
t d f a -> String
packageName
  gIsNewtype :: Bool
gIsNewtype = (M1 D d Proxy () -> Bool) -> Bool
forall (d :: Meta) r. Datatype d => (M1 D d Proxy () -> r) -> r
fromDatatype @d M1 D d Proxy () -> Bool
forall k (d :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Datatype d =>
t d f a -> Bool
isNewtype

-- | Name of the first constructor in a value.
--
-- >>> gconName (Just 0)
-- "Just"
gconName :: forall a. Constructors a => a -> String
gconName :: a -> String
gconName = ConId a -> String
forall a. Constructors a => ConId a -> String
conIdToString (ConId a -> String) -> (a -> ConId a) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ConId a
forall a. Constructors a => a -> ConId a
conId

-- | The fixity of the first constructor.
--
-- >>> gconFixity (Just 0)
-- Prefix
-- >>> gconFixity ([] :*: id)
-- Infix RightAssociative 6
gconFixity :: forall a. Constructors a => a -> Fixity
gconFixity :: a -> Fixity
gconFixity = Rep a Any -> Fixity
forall k (r :: k -> *) (p :: k). GConstructors r => r p -> Fixity
gConFixity (Rep a Any -> Fixity) -> (a -> Rep a Any) -> a -> Fixity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Rep a Any
forall a x. Generic a => a -> Rep a x
from

-- | 'True' if the constructor is a record.
--
-- >>> gconIsRecord (Just 0)
-- False
-- >>> gconIsRecord (Sum 0)   -- Note:  newtype Sum a = Sum { getSum :: a }
-- True
gconIsRecord :: forall a. Constructors a => a -> Bool
gconIsRecord :: a -> Bool
gconIsRecord = Rep a Any -> Bool
forall k (r :: k -> *) (p :: k). GConstructors r => r p -> Bool
gConIsRecord (Rep a Any -> Bool) -> (a -> Rep a Any) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Rep a Any
forall a x. Generic a => a -> Rep a x
from

-- | Number of constructors.
--
-- >>> gconNum @(Maybe Int)
-- 2
gconNum :: forall a. Constructors a => Int
gconNum :: Int
gconNum = GConstructors (Rep a) => Int
forall k (r :: k -> *). GConstructors r => Int
gConNum @(Rep a)

-- | Index of a constructor.
--
-- >>> gconIndex Nothing
-- 0
-- >>> gconIndex (Just "test")
-- 1
gconIndex :: forall a. Constructors a => a -> Int
gconIndex :: a -> Int
gconIndex = ConId a -> Int
forall k (a :: k). ConId a -> Int
conIdToInt (ConId a -> Int) -> (a -> ConId a) -> a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ConId a
forall a. Constructors a => a -> ConId a
conId

-- | An opaque identifier for a constructor.
newtype ConId a = ConId Int
  deriving (ConId a -> ConId a -> Bool
(ConId a -> ConId a -> Bool)
-> (ConId a -> ConId a -> Bool) -> Eq (ConId a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k (a :: k). ConId a -> ConId a -> Bool
/= :: ConId a -> ConId a -> Bool
$c/= :: forall k (a :: k). ConId a -> ConId a -> Bool
== :: ConId a -> ConId a -> Bool
$c== :: forall k (a :: k). ConId a -> ConId a -> Bool
Eq, Eq (ConId a)
Eq (ConId a)
-> (ConId a -> ConId a -> Ordering)
-> (ConId a -> ConId a -> Bool)
-> (ConId a -> ConId a -> Bool)
-> (ConId a -> ConId a -> Bool)
-> (ConId a -> ConId a -> Bool)
-> (ConId a -> ConId a -> ConId a)
-> (ConId a -> ConId a -> ConId a)
-> Ord (ConId a)
ConId a -> ConId a -> Bool
ConId a -> ConId a -> Ordering
ConId a -> ConId a -> ConId a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall k (a :: k). Eq (ConId a)
forall k (a :: k). ConId a -> ConId a -> Bool
forall k (a :: k). ConId a -> ConId a -> Ordering
forall k (a :: k). ConId a -> ConId a -> ConId a
min :: ConId a -> ConId a -> ConId a
$cmin :: forall k (a :: k). ConId a -> ConId a -> ConId a
max :: ConId a -> ConId a -> ConId a
$cmax :: forall k (a :: k). ConId a -> ConId a -> ConId a
>= :: ConId a -> ConId a -> Bool
$c>= :: forall k (a :: k). ConId a -> ConId a -> Bool
> :: ConId a -> ConId a -> Bool
$c> :: forall k (a :: k). ConId a -> ConId a -> Bool
<= :: ConId a -> ConId a -> Bool
$c<= :: forall k (a :: k). ConId a -> ConId a -> Bool
< :: ConId a -> ConId a -> Bool
$c< :: forall k (a :: k). ConId a -> ConId a -> Bool
compare :: ConId a -> ConId a -> Ordering
$ccompare :: forall k (a :: k). ConId a -> ConId a -> Ordering
$cp1Ord :: forall k (a :: k). Eq (ConId a)
Ord, Int -> ConId a -> ShowS
[ConId a] -> ShowS
ConId a -> String
(Int -> ConId a -> ShowS)
-> (ConId a -> String) -> ([ConId a] -> ShowS) -> Show (ConId a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (a :: k). Int -> ConId a -> ShowS
forall k (a :: k). [ConId a] -> ShowS
forall k (a :: k). ConId a -> String
showList :: [ConId a] -> ShowS
$cshowList :: forall k (a :: k). [ConId a] -> ShowS
show :: ConId a -> String
$cshow :: forall k (a :: k). ConId a -> String
showsPrec :: Int -> ConId a -> ShowS
$cshowsPrec :: forall k (a :: k). Int -> ConId a -> ShowS
Show)

-- | Identifier of a constructor.
conId :: forall a. Constructors a => a -> ConId a
conId :: a -> ConId a
conId = GConId (Rep a) -> ConId a
forall a. Generic a => GConId (Rep a) -> ConId a
toConId (GConId (Rep a) -> ConId a)
-> (a -> GConId (Rep a)) -> a -> ConId a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rep a Any -> GConId (Rep a)
forall k (r :: k -> *) (p :: k). GConstructors r => r p -> GConId r
gConId (Rep a Any -> GConId (Rep a))
-> (a -> Rep a Any) -> a -> GConId (Rep a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Rep a Any
forall a x. Generic a => a -> Rep a x
from

-- | Index of a constructor, given its identifier.
-- See also 'gconIndex'.
conIdToInt :: forall a. ConId a -> Int
conIdToInt :: ConId a -> Int
conIdToInt (ConId Int
i) = Int
i

-- | Name of a constructor. See also 'gconName'.
conIdToString :: forall a. Constructors a => ConId a -> String
conIdToString :: ConId a -> String
conIdToString = GConId (Rep a) -> String
forall k (r :: k -> *). GConstructors r => GConId r -> String
gConIdToString (GConId (Rep a) -> String)
-> (ConId a -> GConId (Rep a)) -> ConId a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConId a -> GConId (Rep a)
forall a. Generic a => ConId a -> GConId (Rep a)
fromConId

-- | All constructor identifiers.
--
-- @
-- 'gconNum' \@a = length ('conIdEnum' \@a)
-- @
conIdEnum :: forall a. Constructors a => [ConId a]
conIdEnum :: [ConId a]
conIdEnum = (Int -> ConId a) -> [Int] -> [ConId a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> ConId a
forall k (a :: k). Int -> ConId a
ConId [Int
0 .. Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]
  where
    n :: Int
n = GConstructors (Rep a) => Int
forall k (r :: k -> *). GConstructors r => Int
gConNum @(Rep a)

-- | The first constructor. This must not be called on an empty type.
conIdMin :: forall a. (Constructors a, NonEmptyType "conIdMin" a) => ConId a
conIdMin :: ConId a
conIdMin = Int -> ConId a
forall k (a :: k). Int -> ConId a
ConId Int
0

-- | The last constructor. This must not be called on an empty type.
conIdMax :: forall a. (Constructors a, NonEmptyType "conIdMax" a) => ConId a
conIdMax :: ConId a
conIdMax = GConId (Rep a) -> ConId a
forall a. Generic a => GConId (Rep a) -> ConId a
toConId GConId (Rep a)
forall k (r :: k -> *). GConstructors r => GConId r
gConIdMax

-- | Get a 'ConId' by name.
--
-- >>> conIdNamed @"Nothing" :: ConId (Maybe Int)
-- ConId 0
-- >>> conIdNamed @"Just"    :: ConId (Maybe Int)
-- ConId 1
conIdNamed :: forall s a. ConIdNamed s a => ConId a
conIdNamed :: ConId a
conIdNamed = Int -> ConId a
forall k (a :: k). Int -> ConId a
ConId (Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Proxy (GConIdNamedIf s a (GConIdNamed' s (Rep a) 0 'Nothing))
-> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy (GConIdNamedIf s a (GConIdNamed' s (Rep a) 0 'Nothing))
forall k (t :: k). Proxy t
Proxy @(ConIdNamed' s a))))

-- | Constraint synonym for 'Generic' and 'GConstructors'.
class (Generic a, GConstructors (Rep a)) => Constructors a
instance (Generic a, GConstructors (Rep a)) => Constructors a

-- | Constraint synonym for generic types @a@ with a constructor named @n@.
class (Generic a, KnownNat (ConIdNamed' n a)) => ConIdNamed n a
instance (Generic a, KnownNat (ConIdNamed' n a)) => ConIdNamed n a

-- *** Constructor information on generic representations

newtype GConId r = GConId Int
  deriving (GConId r -> GConId r -> Bool
(GConId r -> GConId r -> Bool)
-> (GConId r -> GConId r -> Bool) -> Eq (GConId r)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k (r :: k). GConId r -> GConId r -> Bool
/= :: GConId r -> GConId r -> Bool
$c/= :: forall k (r :: k). GConId r -> GConId r -> Bool
== :: GConId r -> GConId r -> Bool
$c== :: forall k (r :: k). GConId r -> GConId r -> Bool
Eq, Eq (GConId r)
Eq (GConId r)
-> (GConId r -> GConId r -> Ordering)
-> (GConId r -> GConId r -> Bool)
-> (GConId r -> GConId r -> Bool)
-> (GConId r -> GConId r -> Bool)
-> (GConId r -> GConId r -> Bool)
-> (GConId r -> GConId r -> GConId r)
-> (GConId r -> GConId r -> GConId r)
-> Ord (GConId r)
GConId r -> GConId r -> Bool
GConId r -> GConId r -> Ordering
GConId r -> GConId r -> GConId r
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall k (r :: k). Eq (GConId r)
forall k (r :: k). GConId r -> GConId r -> Bool
forall k (r :: k). GConId r -> GConId r -> Ordering
forall k (r :: k). GConId r -> GConId r -> GConId r
min :: GConId r -> GConId r -> GConId r
$cmin :: forall k (r :: k). GConId r -> GConId r -> GConId r
max :: GConId r -> GConId r -> GConId r
$cmax :: forall k (r :: k). GConId r -> GConId r -> GConId r
>= :: GConId r -> GConId r -> Bool
$c>= :: forall k (r :: k). GConId r -> GConId r -> Bool
> :: GConId r -> GConId r -> Bool
$c> :: forall k (r :: k). GConId r -> GConId r -> Bool
<= :: GConId r -> GConId r -> Bool
$c<= :: forall k (r :: k). GConId r -> GConId r -> Bool
< :: GConId r -> GConId r -> Bool
$c< :: forall k (r :: k). GConId r -> GConId r -> Bool
compare :: GConId r -> GConId r -> Ordering
$ccompare :: forall k (r :: k). GConId r -> GConId r -> Ordering
$cp1Ord :: forall k (r :: k). Eq (GConId r)
Ord)

gConIdToInt :: GConId r -> Int
gConIdToInt :: GConId r -> Int
gConIdToInt (GConId Int
i) = Int
i

toConId :: forall a. Generic a => GConId (Rep a) -> ConId a
toConId :: GConId (Rep a) -> ConId a
toConId (GConId Int
i) = Int -> ConId a
forall k (a :: k). Int -> ConId a
ConId Int
i

fromConId :: forall a. Generic a => ConId a -> GConId (Rep a)
fromConId :: ConId a -> GConId (Rep a)
fromConId (ConId Int
i) = Int -> GConId (Rep a)
forall k (r :: k). Int -> GConId r
GConId Int
i

reGConId :: GConId r -> GConId s
reGConId :: GConId r -> GConId s
reGConId (GConId Int
i) = Int -> GConId s
forall k (r :: k). Int -> GConId r
GConId Int
i

gConIdMin :: forall r. GConstructors r => GConId r
gConIdMin :: GConId r
gConIdMin = Int -> GConId r
forall k (r :: k). Int -> GConId r
GConId Int
0

gConIdMax :: forall r. GConstructors r => GConId r
gConIdMax :: GConId r
gConIdMax = Int -> GConId r
forall k (r :: k). Int -> GConId r
GConId (GConstructors r => Int
forall k (r :: k -> *). GConstructors r => Int
gConNum @r Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)

-- | Generic representations that contain constructor metadata.
class GConstructors r where
  gConIdToString :: GConId r -> String
  gConId :: r p -> GConId r
  gConNum :: Int
  gConFixity :: r p -> Fixity
  gConIsRecord :: r p -> Bool

instance GConstructors f => GConstructors (M1 D c f) where
  gConIdToString :: GConId (M1 D c f) -> String
gConIdToString = GConstructors f => GConId f -> String
forall k (r :: k -> *). GConstructors r => GConId r -> String
gConIdToString @f (GConId f -> String)
-> (GConId (M1 D c f) -> GConId f) -> GConId (M1 D c f) -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GConId (M1 D c f) -> GConId f
forall k k (r :: k) (s :: k). GConId r -> GConId s
reGConId
  gConId :: M1 D c f p -> GConId (M1 D c f)
gConId = GConId f -> GConId (M1 D c f)
forall k k (r :: k) (s :: k). GConId r -> GConId s
reGConId (GConId f -> GConId (M1 D c f))
-> (M1 D c f p -> GConId f) -> M1 D c f p -> GConId (M1 D c f)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f p -> GConId f
forall k (r :: k -> *) (p :: k). GConstructors r => r p -> GConId r
gConId (f p -> GConId f) -> (M1 D c f p -> f p) -> M1 D c f p -> GConId f
forall b c a. (b -> c) -> (a -> b) -> a -> c
. M1 D c f p -> f p
forall i (c :: Meta) k (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1
  gConNum :: Int
gConNum = GConstructors f => Int
forall k (r :: k -> *). GConstructors r => Int
gConNum @f
  gConFixity :: M1 D c f p -> Fixity
gConFixity = f p -> Fixity
forall k (r :: k -> *) (p :: k). GConstructors r => r p -> Fixity
gConFixity (f p -> Fixity) -> (M1 D c f p -> f p) -> M1 D c f p -> Fixity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. M1 D c f p -> f p
forall i (c :: Meta) k (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1
  gConIsRecord :: M1 D c f p -> Bool
gConIsRecord = f p -> Bool
forall k (r :: k -> *) (p :: k). GConstructors r => r p -> Bool
gConIsRecord (f p -> Bool) -> (M1 D c f p -> f p) -> M1 D c f p -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. M1 D c f p -> f p
forall i (c :: Meta) k (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1

instance (GConstructors f, GConstructors g) => GConstructors (f :+: g) where
  gConIdToString :: GConId (f :+: g) -> String
gConIdToString (GConId Int
i) =
    if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
nf then
      GConId f -> String
forall k (r :: k -> *). GConstructors r => GConId r -> String
gConIdToString @f (Int -> GConId f
forall k (r :: k). Int -> GConId r
GConId Int
i)
    else
      GConId g -> String
forall k (r :: k -> *). GConstructors r => GConId r -> String
gConIdToString @g (Int -> GConId g
forall k (r :: k). Int -> GConId r
GConId (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
nf))
    where
      nf :: Int
nf = GConstructors f => Int
forall k (r :: k -> *). GConstructors r => Int
gConNum @f
  gConId :: (:+:) f g p -> GConId (f :+: g)
gConId (L1 f p
x) = GConId f -> GConId (f :+: g)
forall k k (r :: k) (s :: k). GConId r -> GConId s
reGConId (f p -> GConId f
forall k (r :: k -> *) (p :: k). GConstructors r => r p -> GConId r
gConId f p
x)
  gConId (R1 g p
y) = let GConId Int
i = g p -> GConId g
forall k (r :: k -> *) (p :: k). GConstructors r => r p -> GConId r
gConId g p
y in Int -> GConId (f :+: g)
forall k (r :: k). Int -> GConId r
GConId (Int
nf Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i)
    where
      GConId Int
nf = GConstructors f => GConId f
forall k (r :: k -> *). GConstructors r => GConId r
gConIdMax @f
  gConNum :: Int
gConNum = GConstructors f => Int
forall k (r :: k -> *). GConstructors r => Int
gConNum @f Int -> Int -> Int
forall a. Num a => a -> a -> a
+ GConstructors g => Int
forall k (r :: k -> *). GConstructors r => Int
gConNum @g
  gConFixity :: (:+:) f g p -> Fixity
gConFixity (L1 f p
x) = f p -> Fixity
forall k (r :: k -> *) (p :: k). GConstructors r => r p -> Fixity
gConFixity f p
x
  gConFixity (R1 g p
y) = g p -> Fixity
forall k (r :: k -> *) (p :: k). GConstructors r => r p -> Fixity
gConFixity g p
y
  gConIsRecord :: (:+:) f g p -> Bool
gConIsRecord (L1 f p
x) = f p -> Bool
forall k (r :: k -> *) (p :: k). GConstructors r => r p -> Bool
gConIsRecord f p
x
  gConIsRecord (R1 g p
y) = g p -> Bool
forall k (r :: k -> *) (p :: k). GConstructors r => r p -> Bool
gConIsRecord g p
y

instance Constructor c => GConstructors (M1 C c f) where
  gConIdToString :: GConId (M1 C c f) -> String
gConIdToString GConId (M1 C c f)
_ = M1 C c Proxy () -> String
forall k (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> String
conName (Proxy () -> M1 C c Proxy ()
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 Proxy ()
forall k (t :: k). Proxy t
Proxy :: M1 C c Proxy ())
  gConId :: M1 C c f p -> GConId (M1 C c f)
gConId M1 C c f p
_ = Int -> GConId (M1 C c f)
forall k (r :: k). Int -> GConId r
GConId Int
0
  gConNum :: Int
gConNum = Int
1
  gConFixity :: M1 C c f p -> Fixity
gConFixity = M1 C c f p -> Fixity
forall k (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> Fixity
conFixity
  gConIsRecord :: M1 C c f p -> Bool
gConIsRecord = M1 C c f p -> Bool
forall k (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> Bool
conIsRecord

instance GConstructors V1 where
  gConIdToString :: GConId V1 -> String
gConIdToString GConId V1
x = GConId V1
x GConId V1 -> ShowS
`seq` ShowS
forall a. HasCallStack => String -> a
error String
"gConIdToString: empty type"  -- Input should be empty.
  gConId :: V1 p -> GConId V1
gConId V1 p
v = case V1 p
v of {}
  gConNum :: Int
gConNum = Int
0
  gConFixity :: V1 p -> Fixity
gConFixity V1 p
v = case V1 p
v of {}
  gConIsRecord :: V1 p -> Bool
gConIsRecord V1 p
v = case V1 p
v of {}

-- *** Find a constructor tag by name

type ConIdNamed' n t = GConIdNamedIf n t (GConIdNamed n (Rep t))

type GConIdNamed n f = GConIdNamed' n f 0 'Nothing

type family GConIdNamed' (n :: Symbol) (f :: k -> *) (i :: Nat) (o :: Maybe Nat) :: Maybe Nat where
  GConIdNamed' n (M1 D _c f) i r = GConIdNamed' n f i r
  GConIdNamed' n (f :+: g) i r = GConIdNamed' n f i (GConIdNamed' n g (i + NConstructors f) r)
  GConIdNamed' n (M1 C ('MetaCons n _f _s) _g) i _r = 'Just i
  GConIdNamed' n (M1 C ('MetaCons _n _f _s) _g) _i r = r
  GConIdNamed' _n V1 _i r = r

type family GConIdNamedIf (n :: Symbol) (t :: *) (o :: Maybe Nat) :: Nat where
  GConIdNamedIf _n _t ('Just i) = i
  GConIdNamedIf  n  t 'Nothing = TypeError
    ('Text "No constructor named " ':<>: 'ShowType n
    ':<>: 'Text " in generic type " ':<>: 'ShowType t)

-- *** Check that a type is not empty

-- | Constraint that a generic type @a@ is not empty.
-- Producing an error message otherwise.
--
-- The 'Symbol' parameter 'fname' is used only for error messages.
--
-- It is implied by the simpler constraint @'IsEmptyType' a ~ 'False@
class    NonEmptyType_ fname a => NonEmptyType fname a
instance NonEmptyType_ fname a => NonEmptyType fname a

-- | Internal definition of 'NonEmptyType'.
-- It is implied by the simpler constraint @'IsEmptyType' a ~ 'False@.
--
-- >>> :set -XTypeFamilies
-- >>> :{
-- conIdMin' :: (Constructors a, IsEmptyType a ~ 'False) => ConId a
-- conIdMin' = conIdMin
-- :}
--
-- >>> :{
-- conIdMax' :: (Constructors a, IsEmptyType a ~ 'False) => ConId a
-- conIdMax' = conIdMax
-- :}
type NonEmptyType_ fname a = (ErrorIfEmpty fname a (IsEmptyType a) ~ '())

-- 'True' if the generic representation is @M1 D _ V1@.
type family GIsEmptyType (r :: k -> *) :: Bool where
  GIsEmptyType (M1 D _d V1) = 'True
  GIsEmptyType (M1 D _d (M1 C _c _f)) = 'False
  GIsEmptyType (M1 D _d (_f :+: _g)) = 'False

-- | 'True' if the generic type @a@ is empty.
type IsEmptyType a = IsEmptyType_ a

-- | Internal definition of 'IsEmptyType'.
type IsEmptyType_ a = GIsEmptyType (Rep a)

-- | Throw an error if the boolean @b@ is true, meaning that the type @a@ is empty.
--
-- Example:
--
-- > ghci> data E deriving Generic
-- > ghci> conIdMin :: ConId E
--
-- Error message:
--
-- > The function 'conIdMin' cannot be used with the empty type E
type family ErrorIfEmpty (fname :: Symbol) (a :: *) (b :: Bool) :: () where
  ErrorIfEmpty fname a 'True = TypeError
    ('Text "The function '" ':<>: 'Text fname
    ':<>: 'Text "' cannot be used with the empty type " ':<>: 'ShowType a)
  ErrorIfEmpty fname a 'False = '()

-- * Type families

-- | 'Meta' field of the 'M1' type constructor.
type family MetaOf (f :: * -> *) :: Meta where
  MetaOf (M1 i d f) = d

-- Variable names borrowed from the documentation on 'Meta'.

-- | Name of the data type ('MetaData').
type family MetaDataName (m :: Meta) :: Symbol where
  MetaDataName ('MetaData n _m _p _nt) = n

-- | Name of the module where the data type is defined ('MetaData')
type family MetaDataModule (m :: Meta) :: Symbol where
  MetaDataModule ('MetaData _n m _p _nt) = m

-- | Name of the package where the data type is defined ('MetaData')
type family MetaDataPackage (m :: Meta) :: Symbol where
  MetaDataPackage ('MetaData _n _m p _nt) = p

-- | @True@ if the data type is a newtype ('MetaData').
type family MetaDataNewtype (m :: Meta) :: Bool where
  MetaDataNewtype ('MetaData _n _m _p nt) = nt

-- | Name of the constructor ('MetaCons').
type family MetaConsName (m :: Meta) :: Symbol where
  MetaConsName ('MetaCons n _f _s) = n

-- | Fixity of the constructor ('MetaCons').
type family MetaConsFixity (m :: Meta) :: FixityI where
  MetaConsFixity ('MetaCons _n f s) = f

-- | @True@ for a record constructor ('MetaCons').
type family MetaConsRecord (m :: Meta) :: Bool where
  MetaConsRecord ('MetaCons _n _f s) = s

-- | @Just@ the name of the record field, if it is one ('MetaSel').
type family MetaSelNameM (m :: Meta) :: Maybe Symbol where
  MetaSelNameM ('MetaSel mn _su _ss _ds) = mn

-- | Name of the record field; undefined for non-record fields ('MetaSel').
type family MetaSelName (m :: Meta) :: Symbol where
  MetaSelName ('MetaSel ('Just n) _su _ss _ds) = n

-- | Unpackedness annotation of a field ('MetaSel').
type family MetaSelUnpack (m :: Meta) :: SourceUnpackedness where
  MetaSelUnpack ('MetaSel _mn su _ss _ds) = su

-- | Strictness annotation of a field ('MetaSel').
type family MetaSelSourceStrictness (m :: Meta) :: SourceStrictness where
  MetaSelSourceStrictness ('MetaSel _mn _su ss _ds) = ss

-- | Inferred strictness of a field ('MetaSel').
type family MetaSelStrictness (m :: Meta) :: DecidedStrictness where
  MetaSelStrictness ('MetaSel _mn _su _ss ds) = ds

-- | A placeholder for 'Meta' values.
type DummyMeta = 'MetaData "" "" "" 'False

-- | Remove an 'M1' type constructor.
type family   UnM1 (f :: k -> *) :: k -> *
type instance UnM1 (M1 i c f) = f