{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ExplicitNamespaces #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE TypeFamilies #-}
module Data.Record.Generic (
Generic(..)
, Rep(..)
, Metadata(..)
, FieldStrictness(..)
, recordFieldNames
, FieldMetadata(..)
, FieldName
, FieldType
, IsField
, module SOP
, Proxy(..)
) where
import Data.Kind
import Data.Proxy
import GHC.TypeLits
import Data.SOP.BasicFunctors as SOP
import Data.SOP.Classes as SOP (type (-.->)(..))
import Data.SOP.Dict as SOP (Dict(..))
import Data.Record.Generic.Rep.Internal (Rep(..))
import qualified Data.Record.Generic.Rep.Internal as Rep
class Generic a where
type Constraints a :: (Type -> Constraint) -> Constraint
type MetadataOf a :: [(Symbol, Type)]
from :: a -> Rep I a
to :: Rep I a -> a
dict :: Constraints a c => Proxy c -> Rep (Dict c) a
metadata :: proxy a -> Metadata a
data Metadata a = Metadata {
Metadata a -> String
recordName :: String
, Metadata a -> String
recordConstructor :: String
, Metadata a -> Int
recordSize :: Int
, Metadata a -> Rep FieldMetadata a
recordFieldMetadata :: Rep FieldMetadata a
}
data FieldStrictness = FieldStrict | FieldLazy
data FieldMetadata x where
FieldMetadata ::
KnownSymbol name
=> Proxy name
-> FieldStrictness
-> FieldMetadata x
recordFieldNames :: Metadata a -> Rep (K String) a
recordFieldNames :: Metadata a -> Rep (K String) a
recordFieldNames = (forall x. FieldMetadata x -> K String x)
-> Rep FieldMetadata a -> Rep (K String) a
forall (f :: Type -> Type) (g :: Type -> Type) a.
(forall x. f x -> g x) -> Rep f a -> Rep g a
Rep.map' forall x. FieldMetadata x -> K String x
aux (Rep FieldMetadata a -> Rep (K String) a)
-> (Metadata a -> Rep FieldMetadata a)
-> Metadata a
-> Rep (K String) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Metadata a -> Rep FieldMetadata a
forall a. Metadata a -> Rep FieldMetadata a
recordFieldMetadata
where
aux :: FieldMetadata x -> K String x
aux :: FieldMetadata x -> K String x
aux (FieldMetadata Proxy name
p FieldStrictness
_) = String -> K String x
forall k a (b :: k). a -> K a b
K (String -> K String x) -> String -> K String x
forall a b. (a -> b) -> a -> b
$ Proxy name -> String
forall (n :: Symbol) (proxy :: Symbol -> Type).
KnownSymbol n =>
proxy n -> String
symbolVal Proxy name
p
type family FieldName (field :: (Symbol, Type)) :: Symbol where
FieldName '(name, _typ) = name
type family FieldType (field :: (Symbol, Type)) :: Type where
FieldType '(_name, typ) = typ
class (field ~ '(FieldName field, FieldType field)) => IsField field
instance (field ~ '(FieldName field, FieldType field)) => IsField field