{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ExplicitNamespaces #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
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 {
forall a. Metadata a -> String
recordName :: String
, forall a. Metadata a -> String
recordConstructor :: String
, forall a. Metadata a -> Int
recordSize :: Int
, forall a. 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 :: forall a. Metadata a -> Rep (K String) a
recordFieldNames = forall (f :: * -> *) (g :: * -> *) a.
(forall x. f x -> g x) -> Rep f a -> Rep g a
Rep.map' forall x. FieldMetadata x -> K String x
aux forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Metadata a -> Rep FieldMetadata a
recordFieldMetadata
where
aux :: FieldMetadata x -> K String x
aux :: forall x. FieldMetadata x -> K String x
aux (FieldMetadata Proxy name
p FieldStrictness
_) = forall k a (b :: k). a -> K a b
K forall a b. (a -> b) -> a -> b
$ forall (n :: Symbol) (proxy :: Symbol -> *).
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)
, KnownSymbol (FieldName field)
) => IsField field
instance ( field ~ '(FieldName field, FieldType field)
, KnownSymbol (FieldName field)
) => IsField field