7ce2cb7 · squeal · git.iko.soy

git.iko.soy/squeal

on dev help sign in

didn't quite make it

7ce2cb7Eitan Chatav8 years ago

squeal-postgresql/squeal-postgresql.cabal+1

compare with dev

unifiedsplit

@@ -51,6 +51,7 @@ library

51 , postgresql-binary >= 0.12.1

52 , postgresql-libpq >= 0.9.4.1

53 , profunctors >= 5.2.2

54+ , records-sop >= 0.1.0.0

54 , resource-pool >= 0.2.3.2

55 , resource-pool >= 0.2.3.2

55 , scientific >= 0.3.5.3

56 , scientific >= 0.3.5.3

56 , text >= 1.2.3.0

57 , text >= 1.2.3.0

squeal-postgresql/src/Squeal/PostgreSQL/Binary.hs+4−8

@@ -171,6 +171,7 @@ import Data.UUID.Types

171import Data.Vector (Vector)

172import Data.Word

173import Generics.SOP

174+import Generics.SOP.Record

174import GHC.TypeLits

175import GHC.TypeLits

175import Network.IP.Addr

176import Network.IP.Addr

176

177

@@ -262,10 +263,8 @@ instance

262 . from

263 . from

263instance

264instance

264 ( SListI fields

265 ( SListI fields

265− , MapMaybes xs

266+ , IsRecord x xs

266− , IsProductType x (Maybes xs)

267 , AllZip ToAliasedParam xs fields

268− , FieldNamesFrom x ~ AliasesOf fields

269 , All HasAliasedOid fields

268 , All HasAliasedOid fields

270 ) => ToParam x ('PGcomposite fields) where

269 ) => ToParam x ('PGcomposite fields) where

271 toParam =

270 toParam =

@@ -435,10 +434,8 @@ instance

435

434

436instance

435instance

437 ( SListI fields

436 ( SListI fields

438− , MapMaybes ys

437+ , IsRecord y ys

439− , IsProductType y (Maybes ys)

440 , AllZip FromAliasedValue fields ys

438 , AllZip FromAliasedValue fields ys

441− , FieldNamesFrom y ~ AliasesOf fields

442 ) => FromValue ('PGcomposite fields) y where

439 ) => FromValue ('PGcomposite fields) y where

443 fromValue =

440 fromValue =

444 let

441 let

@@ -529,9 +526,8 @@ class SListI results => FromRow (results :: RelationType) y where

529 fromRow :: NP (K (Maybe Strict.ByteString)) results -> y

526 fromRow :: NP (K (Maybe Strict.ByteString)) results -> y

530instance

527instance

531 ( SListI results

528 ( SListI results

532− , IsProductType y ys

529+ , IsRecord y ys

533 , AllZip FromColumnValue results ys

530 , AllZip FromColumnValue results ys

534− , FieldNamesFrom y ~ AliasesOf results

535 ) => FromRow results y where

531 ) => FromRow results y where

536 fromRow

532 fromRow

537 = to . SOP . Z . htrans (Proxy @FromColumnValue) (I . fromColumnValue)

533 = to . SOP . Z . htrans (Proxy @FromColumnValue) (I . fromColumnValue)

squeal-postgresql/src/Squeal/PostgreSQL/Definition.hs+13−8

@@ -904,17 +904,22 @@ createTypeComposite ty fields = UnsafeDefinition $

904-- CREATE TYPE "complex" AS ("real" float8, "imaginary" float8);

905createTypeCompositeFrom

906 :: forall hask ty schema.

907− ( ZipAliased (FieldNamesFrom hask) (FieldTypesFrom hask)

908− , SOP.All (PGTyped schema) (FieldTypesFrom hask)

907+ ( SOP.All (BaseTyped schema) (PGFieldsFrom hask)

909 , KnownSymbol ty

908 , KnownSymbol ty

910 )

909 )

911 => Alias ty

910 => Alias ty

912 -- ^ name of the user defined composite type

911 -- ^ name of the user defined composite type

913 -> Definition schema (Create ty ( 'Typedef (CompositeFrom hask)) schema)

912 -> Definition schema (Create ty ( 'Typedef (CompositeFrom hask)) schema)

914−createTypeCompositeFrom ty = createTypeComposite ty $ zipAs

913+createTypeCompositeFrom ty = createTypeComposite ty

915− (SOP.hpure Alias :: NP Alias (FieldNamesFrom hask))

916− (SOP.hcpure (SOP.Proxy :: SOP.Proxy (PGTyped schema)) pgtype

914+ (SOP.hcpure (SOP.Proxy :: SOP.Proxy (BaseTyped schema)) basetype

917− :: NP (TypeExpression schema) (FieldTypesFrom hask))

915+ :: NP (Aliased (TypeExpression schema)) (PGFieldsFrom hask))

916+

917+

918+class BaseTyped (schema :: SchemaType) (ty :: (Symbol,NullityType)) where

919+ basetype :: Aliased (TypeExpression schema) ty

920+instance (KnownSymbol alias, PGTyped schema ty)

921+ => BaseTyped schema (alias ::: nullity ty) where

922+ basetype = pgtype @schema @ty `As` Alias @alias

918

923

919-- | Drop a type.

924-- | Drop a type.

920--

925--

@@ -938,14 +943,14 @@ newtype ColumnTypeExpression (schema :: SchemaType) (ty :: ColumnType)

938-- | used in `createTable` commands as a column constraint to note that

943-- | used in `createTable` commands as a column constraint to note that

939-- @NULL@ may be present in a column

944-- @NULL@ may be present in a column

940nullable

945nullable

941− :: TypeExpression schema ty

946+ :: (forall nullity. TypeExpression schema (nullity ty))

942 -> ColumnTypeExpression schema ('NoDef :=> 'Null ty)

947 -> ColumnTypeExpression schema ('NoDef :=> 'Null ty)

943nullable ty = UnsafeColumnTypeExpression $ renderTypeExpression ty <+> "NULL"

948nullable ty = UnsafeColumnTypeExpression $ renderTypeExpression ty <+> "NULL"

944

949

945-- | used in `createTable` commands as a column constraint to ensure

950-- | used in `createTable` commands as a column constraint to ensure

946-- @NULL@ is not present in a column

951-- @NULL@ is not present in a column

947notNullable

952notNullable

948− :: TypeExpression schema ty

953+ :: (forall nullity. TypeExpression schema (nullity ty))

949 -> ColumnTypeExpression schema (def :=> 'NotNull ty)

954 -> ColumnTypeExpression schema (def :=> 'NotNull ty)

950notNullable ty = UnsafeColumnTypeExpression $ renderTypeExpression ty <+> "NOT NULL"

955notNullable ty = UnsafeColumnTypeExpression $ renderTypeExpression ty <+> "NOT NULL"

951

956

squeal-postgresql/src/Squeal/PostgreSQL/Expression.hs+34−34

@@ -195,7 +195,7 @@ class KnownNat n => HasParameter

195 -- >>> printSQL expr

196 -- ($1 :: int4)

197 parameter

198− :: TypeExpression schema (PGTypeOf ty)

198+ :: TypeExpression schema ty

199 -> Expression schema relations grouping params ty

200 parameter ty = UnsafeExpression $ parenthesized $

201 "$" <> renderNat (Proxy @n) <+> "::"

@@ -211,9 +211,9 @@ instance {-# OVERLAPPABLE #-} (KnownNat n, HasParameter (n-1) schema params ty)

211-- >>> printSQL expr

212-- ($1 :: int4)

213param

214− :: forall n schema params relations grouping ty

214+ :: forall n schema params relations grouping nullity ty

215− . (PGTyped schema (PGTypeOf ty), HasParameter n schema params ty)

215+ . (PGTyped schema ty, HasParameter n schema params (nullity ty))

216− => Expression schema relations grouping params ty -- ^ param

216+ => Expression schema relations grouping params (nullity ty) -- ^ param

217param = parameter @n pgtype

218

219instance (HasUnique relation relations columns, Has column columns ty)

@@ -400,16 +400,16 @@ instance (KnownSymbol label, label `In` labels) => IsPGlabel label

400-- >>> printSQL i

401-- ROW(0, 1)

402row

403− :: SListI (Nulls fields)

403+ :: SListI fields

404− => NP (Aliased (Expression schema relations grouping params)) (Nulls fields)

404+ => NP (Aliased (Expression schema relations grouping params)) fields

405 -- ^ zero or more expressions for the row field values

406 -> Expression schema relations grouping params (nullity ('PGcomposite fields))

407row exprs = UnsafeExpression $ "ROW" <> parenthesized

408 (renderCommaSeparated (\ (expr `As` _) -> renderExpression expr) exprs)

409

410instance Has field fields ty => IsLabel field

411− ( Expression schema relation grouping params (nullity ('PGcomposite fields))

411+ ( Expression schema relation grouping params ('NotNull ('PGcomposite fields))

412− -> Expression schema relation grouping params ('Null ty) ) where

412+ -> Expression schema relation grouping params ty ) where

413 fromLabel expr = UnsafeExpression $

414 parenthesized (renderExpression expr) <> "." <>

415 fromString (symbolVal (Proxy @field))

@@ -1117,96 +1117,96 @@ type expressions

1117-----------------------------------------}

1118

1119-- | `TypeExpression`s are used in `cast`s and `createTable` commands.

1120−newtype TypeExpression (schema :: SchemaType) (ty :: PGType)

1120+newtype TypeExpression (schema :: SchemaType) (ty :: NullityType)

1121 = UnsafeTypeExpression { renderTypeExpression :: ByteString }

1122 deriving (GHC.Generic,Show,Eq,Ord,NFData)

1123

1124instance (Has alias schema ('Typedef ty))

1125− => IsLabel alias (TypeExpression schema ty) where

1125+ => IsLabel alias (TypeExpression schema (nullity ty)) where

1126 fromLabel = UnsafeTypeExpression (renderAlias (fromLabel @alias))

1127

1128-- | logical Boolean (true/false)

1129−bool :: TypeExpression schema 'PGbool

1129+bool :: TypeExpression schema (nullity 'PGbool)

1130bool = UnsafeTypeExpression "bool"

1131-- | signed two-byte integer

1132−int2, smallint :: TypeExpression schema 'PGint2

1132+int2, smallint :: TypeExpression schema (nullity 'PGint2)

1133int2 = UnsafeTypeExpression "int2"

1134smallint = UnsafeTypeExpression "smallint"

1135-- | signed four-byte integer

1136−int4, int, integer :: TypeExpression schema 'PGint4

1136+int4, int, integer :: TypeExpression schema (nullity 'PGint4)

1137int4 = UnsafeTypeExpression "int4"

1138int = UnsafeTypeExpression "int"

1139integer = UnsafeTypeExpression "integer"

1140-- | signed eight-byte integer

1141−int8, bigint :: TypeExpression schema 'PGint8

1141+int8, bigint :: TypeExpression schema (nullity 'PGint8)

1142int8 = UnsafeTypeExpression "int8"

1143bigint = UnsafeTypeExpression "bigint"

1144-- | arbitrary precision numeric type

1145−numeric :: TypeExpression schema 'PGnumeric

1145+numeric :: TypeExpression schema (nullity 'PGnumeric)

1146numeric = UnsafeTypeExpression "numeric"

1147-- | single precision floating-point number (4 bytes)

1148−float4, real :: TypeExpression schema 'PGfloat4

1148+float4, real :: TypeExpression schema (nullity 'PGfloat4)

1149float4 = UnsafeTypeExpression "float4"

1150real = UnsafeTypeExpression "real"

1151-- | double precision floating-point number (8 bytes)

1152−float8, doublePrecision :: TypeExpression schema 'PGfloat8

1152+float8, doublePrecision :: TypeExpression schema (nullity 'PGfloat8)

1153float8 = UnsafeTypeExpression "float8"

1154doublePrecision = UnsafeTypeExpression "double precision"

1155-- | variable-length character string

1156−text :: TypeExpression schema 'PGtext

1156+text :: TypeExpression schema (nullity 'PGtext)

1157text = UnsafeTypeExpression "text"

1158-- | fixed-length character string

1159char, character

1160 :: (KnownNat n, 1 <= n)

1161 => proxy n

1162− -> TypeExpression schema ('PGchar n)

1162+ -> TypeExpression schema (nullity ('PGchar n))

1163char p = UnsafeTypeExpression $ "char(" <> renderNat p <> ")"

1164character p = UnsafeTypeExpression $ "character(" <> renderNat p <> ")"

1165-- | variable-length character string

1166varchar, characterVarying

1167 :: (KnownNat n, 1 <= n)

1168 => proxy n

1169− -> TypeExpression schema ('PGvarchar n)

1169+ -> TypeExpression schema (nullity ('PGvarchar n))

1170varchar p = UnsafeTypeExpression $ "varchar(" <> renderNat p <> ")"

1171characterVarying p = UnsafeTypeExpression $

1172 "character varying(" <> renderNat p <> ")"

1173-- | binary data ("byte array")

1174−bytea :: TypeExpression schema 'PGbytea

1174+bytea :: TypeExpression schema (nullity 'PGbytea)

1175bytea = UnsafeTypeExpression "bytea"

1176-- | date and time (no time zone)

1177−timestamp :: TypeExpression schema 'PGtimestamp

1177+timestamp :: TypeExpression schema (nullity 'PGtimestamp)

1178timestamp = UnsafeTypeExpression "timestamp"

1179-- | date and time, including time zone

1180−timestampWithTimeZone :: TypeExpression schema 'PGtimestamptz

1180+timestampWithTimeZone :: TypeExpression schema (nullity 'PGtimestamptz)

1181timestampWithTimeZone = UnsafeTypeExpression "timestamp with time zone"

1182-- | calendar date (year, month, day)

1183−date :: TypeExpression schema 'PGdate

1183+date :: TypeExpression schema (nullity 'PGdate)

1184date = UnsafeTypeExpression "date"

1185-- | time of day (no time zone)

1186−time :: TypeExpression schema 'PGtime

1186+time :: TypeExpression schema (nullity 'PGtime)

1187time = UnsafeTypeExpression "time"

1188-- | time of day, including time zone

1189−timeWithTimeZone :: TypeExpression schema 'PGtimetz

1189+timeWithTimeZone :: TypeExpression schema (nullity 'PGtimetz)

1190timeWithTimeZone = UnsafeTypeExpression "time with time zone"

1191-- | time span

1192−interval :: TypeExpression schema 'PGinterval

1192+interval :: TypeExpression schema (nullity 'PGinterval)

1193interval = UnsafeTypeExpression "interval"

1194-- | universally unique identifier

1195−uuid :: TypeExpression schema 'PGuuid

1195+uuid :: TypeExpression schema (nullity 'PGuuid)

1196uuid = UnsafeTypeExpression "uuid"

1197-- | IPv4 or IPv6 host address

1198−inet :: TypeExpression schema 'PGinet

1198+inet :: TypeExpression schema (nullity 'PGinet)

1199inet = UnsafeTypeExpression "inet"

1200-- | textual JSON data

1201−json :: TypeExpression schema 'PGjson

1201+json :: TypeExpression schema (nullity 'PGjson)

1202json = UnsafeTypeExpression "json"

1203-- | binary JSON data, decomposed

1204−jsonb :: TypeExpression schema 'PGjsonb

1204+jsonb :: TypeExpression schema (nullity 'PGjsonb)

1205jsonb = UnsafeTypeExpression "jsonb"

1206-- | variable length array

1207vararray

1208 :: TypeExpression schema pg

1209− -> TypeExpression schema ('PGvararray (nullity pg))

1209+ -> TypeExpression schema (nullity ('PGvararray pg))

1210vararray ty = UnsafeTypeExpression $ renderTypeExpression ty <> "[]"

1211-- | fixed length array

1212--

@@ -1215,12 +1215,12 @@ vararray ty = UnsafeTypeExpression $ renderTypeExpression ty <> "[]"

1215fixarray

1216 :: forall n schema nullity pg. KnownNat n

1217 => TypeExpression schema pg

1218− -> TypeExpression schema ('PGfixarray n (nullity pg))

1218+ -> TypeExpression schema (nullity ('PGfixarray n pg))

1219fixarray ty = UnsafeTypeExpression $

1220 renderTypeExpression ty <> "[" <> renderNat (Proxy @n) <> "]"

1221

1222-- | `pgtype` is a demoted version of a `PGType`

1223−class PGTyped schema (ty :: PGType) where pgtype :: TypeExpression schema ty

1223+class PGTyped schema (ty :: PGType) where pgtype :: TypeExpression schema (nullity ty)

1224instance PGTyped schema 'PGbool where pgtype = bool

1225instance PGTyped schema 'PGint2 where pgtype = int2

1226instance PGTyped schema 'PGint4 where pgtype = int4

squeal-postgresql/src/Squeal/PostgreSQL/Schema.hs+18−96

@@ -63,7 +63,6 @@ module Squeal.PostgreSQL.Schema

63 , Aliasable (as)

64 , renderAliasedAs

65 , AliasesOf

66− , ZipAliased (..)

67 , Has

66 , Has

68 , HasUnique

67 , HasUnique

69 , HasAll

68 , HasAll

@@ -107,17 +106,12 @@ module Squeal.PostgreSQL.Schema

107 , EnumFrom

106 , EnumFrom

108 , LabelsFrom

107 , LabelsFrom

109 , CompositeFrom

108 , CompositeFrom

110− , FieldNamesFrom

109+ , PGFieldsFrom

111− , FieldTypesFrom

110+ , PGFieldsOf

111+ , PGFieldOf

112 , ConstructorsOf

113 , ConstructorNameOf

114 , ConstructorNamesOf

115− , FieldsOf

116− , FieldNameOf

117− , FieldNamesOf

118− , FieldTypeOf

119− , FieldTypesOf

120− , RecordCodeOf

121 , MapMaybes (..)

115 , MapMaybes (..)

122 , Nulls

116 , Nulls

123 ) where

117 ) where

@@ -136,6 +130,7 @@ import Data.Word (Word16, Word32, Word64)

136import Data.Type.Bool

130import Data.Type.Bool

137import Data.UUID.Types (UUID)

131import Data.UUID.Types (UUID)

138import Generics.SOP

132import Generics.SOP

133+import Generics.SOP.Record

139import GHC.OverloadedLabels

134import GHC.OverloadedLabels

140import GHC.TypeLits

135import GHC.TypeLits

141import Network.IP.Addr

136import Network.IP.Addr

@@ -177,7 +172,7 @@ data PGType

177 | PGvararray NullityType -- ^ variable length array

172 | PGvararray NullityType -- ^ variable length array

178 | PGfixarray Nat NullityType -- ^ fixed length array

173 | PGfixarray Nat NullityType -- ^ fixed length array

179 | PGenum [Symbol] -- ^ enumerated (enum) types are data types that comprise a static, ordered set of values.

174 | PGenum [Symbol] -- ^ enumerated (enum) types are data types that comprise a static, ordered set of values.

180− | PGcomposite [(Symbol, PGType)] -- ^ a composite type represents the structure of a row or record; it is essentially just a list of field names and their data types.

175+ | PGcomposite [(Symbol, NullityType)] -- ^ a composite type represents the structure of a row or record; it is essentially just a list of field names and their data types.

181 | UnsafePGType Symbol -- ^ an escape hatch for unsupported PostgreSQL types

176 | UnsafePGType Symbol -- ^ an escape hatch for unsupported PostgreSQL types

182

177

183-- | The object identifier of a `PGType`.

178-- | The object identifier of a `PGType`.

@@ -432,36 +427,6 @@ type family AliasesOf aliaseds where

432 AliasesOf '[] = '[]

427 AliasesOf '[] = '[]

433 AliasesOf (alias ::: ty ': tys) = alias ': AliasesOf tys

428 AliasesOf (alias ::: ty ': tys) = alias ': AliasesOf tys

434

429

435−-- | The `ZipAliased` class provides a type family for zipping

436−-- `Symbol` lists together with arbitrary lists of the same size,

437−-- with an associated type family `ZipAs`, together with

438−-- a method `zipAs` for zipping heterogeneous lists of `Alias`es

439−-- together with a heterogeneous list of expressions into

440−-- a heterogeneous list of `Aliased` expressions.

441−class

442− ( SListI (ZipAs ns xs)

443− , All KnownSymbol ns

444− ) => ZipAliased ns xs where

445−

446− type family ZipAs

447− (ns :: [Symbol]) (xs :: [k]) = (zs :: [(Symbol,k)]) | zs -> ns xs

448−

449− zipAs

450− :: NP Alias ns

451− -> NP expr xs

452− -> NP (Aliased expr) (ZipAs ns xs)

453−

454−instance ZipAliased '[] '[] where

455− type ZipAs '[] '[] = '[]

456− zipAs Nil Nil = Nil

457−

458−instance

459− ( KnownSymbol n

460− , ZipAliased ns xs

461− ) => ZipAliased (n ': ns) (x ': xs) where

462− type ZipAs (n ': ns) (x ': xs) = '(n,x) ': ZipAs ns xs

463− zipAs (n :* ns) (x :* xs) = x `As` n :* zipAs ns xs

464−

465-- | @HasUnique alias fields field@ is a constraint that proves that

430-- | @HasUnique alias fields field@ is a constraint that proves that

466-- @fields@ is a singleton of @alias ::: field@.

431-- @fields@ is a singleton of @alias ::: field@.

467type HasUnique alias fields field = fields ~ '[alias ::: field]

432type HasUnique alias fields field = fields ~ '[alias ::: field]

@@ -772,26 +737,21 @@ type family LabelsFrom (hask :: Type) :: [Type.ConstructorName] where

772-- CompositeFrom Row :: PGType

737-- CompositeFrom Row :: PGType

773-- = 'PGcomposite '['("a", 'PGint2), '("b", 'PGtimestamp)]

738-- = 'PGcomposite '['("a", 'PGint2), '("b", 'PGtimestamp)]

774type family CompositeFrom (hask :: Type) :: PGType where

739type family CompositeFrom (hask :: Type) :: PGType where

775− CompositeFrom hask =

740+ CompositeFrom hask = 'PGcomposite (PGFieldsFrom hask)

776− 'PGcomposite (ZipAs (FieldNamesFrom hask) (FieldTypesFrom hask))

777

741

778−-- | >>> data Row = Row { a :: Maybe Int16, b :: Maybe LocalTime } deriving GHC.Generic

779−-- >>> instance Generic Row

780−-- >>> instance HasDatatypeInfo Row

781−-- >>> :kind! FieldNamesFrom Row

782−-- FieldNamesFrom Row :: [Type.FieldName]

783−-- = '["a", "b"]

784−type family FieldNamesFrom (hask :: Type) :: [Type.FieldName] where

742+type family PGFieldsFrom (hask :: Type) :: RelationType where

785− FieldNamesFrom hask = FieldNamesOf (FieldsOf (DatatypeInfoOf hask))

743+ PGFieldsFrom hask = PGFieldsOf (RecordCodeOf hask)

786

744

787−-- | >>> data Row = Row { a :: Maybe Int16, b :: Maybe LocalTime } deriving GHC.Generic

745+type family PGFieldsOf (fields :: [(Symbol, Type)]) :: RelationType where

788−-- >>> instance Generic Row

746+ PGFieldsOf '[] = '[]

789−-- >>> instance HasDatatypeInfo Row

747+ PGFieldsOf (field ': fields) = PGFieldOf field ': PGFieldsOf fields

790−-- >>> :kind! FieldTypesFrom Row

748+

791−-- FieldTypesFrom Row :: [PGType]

749+type family PGFieldOf (field :: (Symbol, Type)) :: (Symbol, NullityType) where

792−-- = '['PGint2, 'PGtimestamp]

750+ PGFieldOf (field ::: hask) = field ::: NullityTypeOf hask

751+

793−type family FieldTypesFrom (hask :: Type) :: [PGType] where

752+type family NullityTypeOf (hask :: Type) :: NullityType where

794− FieldTypesFrom hask = FieldTypesOf (RecordCodeOf hask (Code hask))

753+ NullityTypeOf (Maybe hask) = 'Null (PG hask)

754+ NullityTypeOf hask = 'NotNull (PG hask)

795

755

796-- | Calculates constructors of a datatype.

756-- | Calculates constructors of a datatype.

797type family ConstructorsOf (datatype :: Type.DatatypeInfo)

757type family ConstructorsOf (datatype :: Type.DatatypeInfo)

@@ -819,41 +779,3 @@ type family ConstructorNamesOf (constructors :: [Type.ConstructorInfo])

819 ConstructorNamesOf '[] = '[]

779 ConstructorNamesOf '[] = '[]

820 ConstructorNamesOf (constructor ': constructors) =

780 ConstructorNamesOf (constructor ': constructors) =

821 ConstructorNameOf constructor ': ConstructorNamesOf constructors

781 ConstructorNameOf constructor ': ConstructorNamesOf constructors

822−

823−-- | Calculate the fields of a datatype.

824−type family FieldsOf (datatype :: Type.DatatypeInfo)

825− :: [Type.FieldInfo] where

826− FieldsOf ('Type.ADT _module _datatype '[ 'Type.Record _name fields]) =

827− fields

828− FieldsOf ('Type.Newtype _module _datatype ('Type.Record _name fields)) =

829− fields

830−

831−-- | Calculate the name of a field.

832−type family FieldNameOf (field :: Type.FieldInfo) :: Type.FieldName where

833− FieldNameOf ('Type.FieldInfo name) = name

834−

835−-- | Calculate the names of fields.

836−type family FieldNamesOf (fields :: [Type.FieldInfo])

837− :: [Type.FieldName] where

838− FieldNamesOf '[] = '[]

839− FieldNamesOf (field ': fields) = FieldNameOf field ': FieldNamesOf fields

840−

841−-- | >>> :kind! FieldTypeOf (Maybe Int16)

842−-- FieldTypeOf (Maybe Int16) :: PGType

843−-- = 'PGint2

844−type family FieldTypeOf (maybe :: Type) where

845− FieldTypeOf (Maybe hask) = PG hask

846− FieldTypeOf ty = TypeError

847− ('Text "FieldTypeOf error: non-Maybe type " ':<>: 'ShowType ty)

848−

849−-- | Calculate the types of fields.

850−type family FieldTypesOf (fields :: [Type]) where

851− FieldTypesOf '[] = '[]

852− FieldTypesOf (field ': fields) = FieldTypeOf field ': FieldTypesOf fields

853−

854−-- | Inspect the code of an algebraic datatype and ensure it's a product,

855−-- otherwise generate a type error

856−type family RecordCodeOf (hask :: Type) (code ::[[Type]]) :: [Type] where

857− RecordCodeOf _hask '[tys] = tys

858− RecordCodeOf hask _tys = TypeError

859− ('Text "RecordCodeOf error: non-Record type " ':<>: 'ShowType hask)

stack.yaml+2

@@ -1,3 +1,5 @@

1resolver: lts-11.15

2packages:

3- squeal-postgresql

4+extra-deps:

5+- records-sop-0.1.0.0