{-# LANGUAGE AllowAmbiguousTypes #-}
module Database.GP.TypeInfo
( TypeInfo,
fieldNames,
fieldTypes,
constructorName,
typeInfo,
HasConstructor (..),
HasSelectors (..),
)
where
import Data.Kind (Type)
import GHC.Generics
import Type.Reflection (SomeTypeRep (..), Typeable, typeRep)
data TypeInfo a = TypeInfo
{ forall {k} (a :: k). TypeInfo a -> String
constructorName :: String,
forall {k} (a :: k). TypeInfo a -> [String]
fieldNames :: [String],
forall {k} (a :: k). TypeInfo a -> [SomeTypeRep]
fieldTypes :: [SomeTypeRep]
}
deriving (Int -> TypeInfo a -> ShowS
[TypeInfo a] -> ShowS
TypeInfo a -> String
(Int -> TypeInfo a -> ShowS)
-> (TypeInfo a -> String)
-> ([TypeInfo a] -> ShowS)
-> Show (TypeInfo a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (a :: k). Int -> TypeInfo a -> ShowS
forall k (a :: k). [TypeInfo a] -> ShowS
forall {k} (a :: k). TypeInfo a -> String
$cshowsPrec :: forall k (a :: k). Int -> TypeInfo a -> ShowS
showsPrec :: Int -> TypeInfo a -> ShowS
$cshow :: forall {k} (a :: k). TypeInfo a -> String
show :: TypeInfo a -> String
$cshowList :: forall k (a :: k). [TypeInfo a] -> ShowS
showList :: [TypeInfo a] -> ShowS
Show)
typeInfo :: forall a. (HasConstructor (Rep a), HasSelectors (Rep a), Generic a) => TypeInfo a
typeInfo :: forall a.
(HasConstructor (Rep a), HasSelectors (Rep a), Generic a) =>
TypeInfo a
typeInfo =
TypeInfo
{ constructorName :: String
constructorName = a -> String
forall a. (HasConstructor (Rep a), Generic a) => a -> String
gConstrName a
x,
fieldNames :: [String]
fieldNames = ((String, SomeTypeRep) -> String)
-> [(String, SomeTypeRep)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, SomeTypeRep) -> String
forall a b. (a, b) -> a
fst (a -> [(String, SomeTypeRep)]
forall a. HasSelectors (Rep a) => a -> [(String, SomeTypeRep)]
gSelectors a
x),
fieldTypes :: [SomeTypeRep]
fieldTypes = ((String, SomeTypeRep) -> SomeTypeRep)
-> [(String, SomeTypeRep)] -> [SomeTypeRep]
forall a b. (a -> b) -> [a] -> [b]
map (String, SomeTypeRep) -> SomeTypeRep
forall a b. (a, b) -> b
snd (a -> [(String, SomeTypeRep)]
forall a. HasSelectors (Rep a) => a -> [(String, SomeTypeRep)]
gSelectors a
x)
}
where
x :: a
x = a
forall a. HasCallStack => a
undefined :: a
gConstrName :: (HasConstructor (Rep a), Generic a) => a -> String
gConstrName :: forall a. (HasConstructor (Rep a), Generic a) => a -> String
gConstrName = Rep a Any -> String
forall x. Rep a x -> String
forall (f :: * -> *) x. HasConstructor f => f x -> String
genericConstrName (Rep a Any -> String) -> (a -> Rep a Any) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Rep a Any
forall x. a -> Rep a x
forall a x. Generic a => a -> Rep a x
from
class HasConstructor (f :: Type -> Type) where
genericConstrName :: f x -> String
instance HasConstructor f => HasConstructor (D1 c f) where
genericConstrName :: forall x. D1 c f x -> String
genericConstrName (M1 f x
x) = f x -> String
forall x. f x -> String
forall (f :: * -> *) x. HasConstructor f => f x -> String
genericConstrName f x
x
instance (HasConstructor x, HasConstructor y) => HasConstructor (x :+: y) where
genericConstrName :: forall x. (:+:) x y x -> String
genericConstrName (L1 x x
l) = x x -> String
forall x. x x -> String
forall (f :: * -> *) x. HasConstructor f => f x -> String
genericConstrName x x
l
genericConstrName (R1 y x
r) = y x -> String
forall x. y x -> String
forall (f :: * -> *) x. HasConstructor f => f x -> String
genericConstrName y x
r
instance Constructor c => HasConstructor (C1 c f) where
genericConstrName :: forall x. C1 c f x -> String
genericConstrName = M1 C c f x -> String
forall {k} (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
(f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> String
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
(a :: k1).
t c f a -> String
conName
gSelectors :: forall a. (HasSelectors (Rep a)) => a -> [(String, SomeTypeRep)]
gSelectors :: forall a. HasSelectors (Rep a) => a -> [(String, SomeTypeRep)]
gSelectors a
_x = forall {k} (rep :: k). HasSelectors rep => [(String, SomeTypeRep)]
forall (rep :: * -> *). HasSelectors rep => [(String, SomeTypeRep)]
selectors @(Rep a)
class HasSelectors rep where
selectors :: [(String, SomeTypeRep)]
instance HasSelectors f => HasSelectors (M1 D x f) where
selectors :: [(String, SomeTypeRep)]
selectors = forall {k} (rep :: k). HasSelectors rep => [(String, SomeTypeRep)]
forall (rep :: k -> *). HasSelectors rep => [(String, SomeTypeRep)]
selectors @f
instance HasSelectors f => HasSelectors (M1 C x f) where
selectors :: [(String, SomeTypeRep)]
selectors = forall {k} (rep :: k). HasSelectors rep => [(String, SomeTypeRep)]
forall (rep :: k -> *). HasSelectors rep => [(String, SomeTypeRep)]
selectors @f
instance (Selector s, Typeable t) => HasSelectors (M1 S s (K1 R t)) where
selectors :: [(String, SomeTypeRep)]
selectors =
[(M1 S s (K1 R t) () -> String
forall {k} (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
(f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> String
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
(a :: k1).
t s f a -> String
selName (M1 S s (K1 R t) ()
forall a. HasCallStack => a
undefined :: M1 S s (K1 R t) ()), TypeRep t -> SomeTypeRep
forall k (a :: k). TypeRep a -> SomeTypeRep
SomeTypeRep (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @t))]
instance (HasSelectors a, HasSelectors b) => HasSelectors (a :*: b) where
selectors :: [(String, SomeTypeRep)]
selectors = forall {k} (rep :: k). HasSelectors rep => [(String, SomeTypeRep)]
forall (rep :: k -> *). HasSelectors rep => [(String, SomeTypeRep)]
selectors @a [(String, SomeTypeRep)]
-> [(String, SomeTypeRep)] -> [(String, SomeTypeRep)]
forall a. [a] -> [a] -> [a]
++ forall {k} (rep :: k). HasSelectors rep => [(String, SomeTypeRep)]
forall (rep :: k -> *). HasSelectors rep => [(String, SomeTypeRep)]
selectors @b
instance HasSelectors U1 where
selectors :: [(String, SomeTypeRep)]
selectors = []