module Database.GP.TypeInfo
( TypeInfo,
typeConstructor,
fieldNames,
fieldTypes,
typeName,
typeInfo,
typeInfoFromContext,
)
where
import Data.Data
data TypeInfo a = TypeInfo
{ forall {k} (a :: k). TypeInfo a -> Constr
typeConstructor :: Constr,
forall {k} (a :: k). TypeInfo a -> [String]
fieldNames :: [String],
forall {k} (a :: k). TypeInfo a -> [TypeRep]
fieldTypes :: [TypeRep]
}
deriving (Int -> TypeInfo a -> ShowS
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
showList :: [TypeInfo a] -> ShowS
$cshowList :: forall k (a :: k). [TypeInfo a] -> ShowS
show :: TypeInfo a -> String
$cshow :: forall k (a :: k). TypeInfo a -> String
showsPrec :: Int -> TypeInfo a -> ShowS
$cshowsPrec :: forall k (a :: k). Int -> TypeInfo a -> ShowS
Show)
typeInfo :: Data a => a -> TypeInfo a
typeInfo :: forall a. Data a => a -> TypeInfo a
typeInfo a
x =
TypeInfo
{ typeConstructor :: Constr
typeConstructor = DataType -> Constr
ensureSingleConstructor (forall a. Data a => a -> DataType
dataTypeOf a
x),
fieldNames :: [String]
fieldNames = forall a. Data a => a -> [String]
fieldNamesOf a
x,
fieldTypes :: [TypeRep]
fieldTypes = forall a u. Data a => (forall d. Data d => d -> u) -> a -> [u]
gmapQ forall a. Typeable a => a -> TypeRep
typeOf a
x
}
ensureSingleConstructor :: DataType -> Constr
ensureSingleConstructor :: DataType -> Constr
ensureSingleConstructor DataType
dt =
case DataType -> [Constr]
dataTypeConstrs DataType
dt of
[Constr
cnstr] -> Constr
cnstr
[Constr]
_ -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"ensureSingleConstructor: Only types with one constructor are supported (" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show DataType
dt forall a. [a] -> [a] -> [a]
++ String
")"
typeInfoFromContext :: forall a. Data a => TypeInfo a
typeInfoFromContext :: forall a. Data a => TypeInfo a
typeInfoFromContext =
let dt :: DataType
dt = forall a. Data a => a -> DataType
dataTypeOf (forall a. HasCallStack => a
undefined :: a)
constr :: Constr
constr = DataType -> Constr
ensureSingleConstructor DataType
dt
evidence :: a
evidence = forall a. Data a => Constr -> a
fromConstr Constr
constr :: a
in forall a. Data a => a -> TypeInfo a
typeInfo a
evidence
typeName :: TypeInfo a -> String
typeName :: forall k (a :: k). TypeInfo a -> String
typeName = DataType -> String
dataTypeName forall b c a. (b -> c) -> (a -> b) -> a -> c
. Constr -> DataType
constrType forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (a :: k). TypeInfo a -> Constr
typeConstructor
fieldNamesOf :: (Data a) => a -> [String]
fieldNamesOf :: forall a. Data a => a -> [String]
fieldNamesOf a
x = [String]
names
where
constructor :: Constr
constructor = forall a. Data a => a -> Constr
toConstr a
x
candidates :: [String]
candidates = Constr -> [String]
constrFields Constr
constructor
constrs :: [Constr]
constrs = forall a u. Data a => (forall d. Data d => d -> u) -> a -> [u]
gmapQ forall a. Data a => a -> Constr
toConstr a
x
names :: [String]
names =
if forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
candidates forall a. Eq a => a -> a -> Bool
== forall (t :: * -> *) a. Foldable t => t a -> Int
length [Constr]
constrs
then [String]
candidates
else forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"fieldNamesOf: Type " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall a. Typeable a => a -> TypeRep
typeOf a
x) forall a. [a] -> [a] -> [a]
++ String
" does not have named fields"