6fa1d5f · squeal · git.iko.soy

git.iko.soy/squeal

on dev help sign in

get embedding and some cleanup

6fa1d5fEitan Chatav8 years ago

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

compare with dev

unifiedsplit

@@ -121,7 +121,7 @@ instance (HasOid pg, ToParam x pg)

121instance

122 ( IsEnumType x

123 , HasDatatypeInfo x

124− , SameLabels (DatatypeInfoOf x) labels

124+ , LabelsWith x ~ labels

125 ) => ToParam x ('PGenum labels) where

126 toParam =

127 let

@@ -141,7 +141,7 @@ instance

141 , MapMaybes xs

142 , IsProductType x (Maybes xs)

143 , AllZip ToAliasedParam xs fields

144− , SameFields (DatatypeInfoOf x) fields

144+ , FieldNamesWith x ~ AliasesOf fields

145 , All HasAliasedOid fields

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

147 toParam =

@@ -277,7 +277,7 @@ instance FromValue pg y => FromValue ('PGfixarray n pg) (Vector (Maybe y)) where

277instance

278 ( IsEnumType y

279 , HasDatatypeInfo y

280− , SameLabels (DatatypeInfoOf y) labels

280+ , LabelsWith y ~ labels

281 ) => FromValue ('PGenum labels) y where

282 fromValue _ =

283 let

@@ -302,7 +302,7 @@ instance

302 , MapMaybes ys

303 , IsProductType y (Maybes ys)

304 , AllZip FromAliasedValue fields ys

305− , SameFields (DatatypeInfoOf y) fields

305+ , FieldNamesWith y ~ AliasesOf fields

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

307 fromValue =

308 let

@@ -395,7 +395,7 @@ instance

395 ( SListI results

396 , IsProductType y ys

397 , AllZip FromColumnValue results ys

398− , SameFields (DatatypeInfoOf y) results

398+ , FieldNamesWith y ~ AliasesOf results

399 ) => FromRow results y where

400 fromRow

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

squeal-postgresql/src/Squeal/PostgreSQL/Definition.hs+27−20

@@ -66,9 +66,10 @@ module Squeal.PostgreSQL.Definition

66 , createView

67 , dropView

68 -- * Types

69− , createType

69+ , createTypeComposite

70 , createTypeEnum

71− , createTypeEnumWith

71+ , HasPGcomposite (..)

72+ , HasPGenum (..)

72 , dropType

73 , dropType

73 , ColumnTypeExpression (..)

74 , ColumnTypeExpression (..)

74 , hasNull

75 , hasNull

@@ -242,9 +243,9 @@ newtype TableConstraintExpression

242-- "CREATE TABLE \"tab\" (\"a\" int NOT NULL, \"b\" int NOT NULL, CONSTRAINT \"inequality\" CHECK ((\"a\" > \"b\")));"

243-- "CREATE TABLE \"tab\" (\"a\" int NOT NULL, \"b\" int NOT NULL, CONSTRAINT \"inequality\" CHECK ((\"a\" > \"b\")));"

243check

244check

244 :: ( Has alias schema ('Table table)

245 :: ( Has alias schema ('Table table)

245− , HasAll aliases (TableToColumns table) subcolumns )

246+ , HasAll aliases (TableToRelation table) subcolumns )

246 => NP Alias aliases

247 => NP Alias aliases

247− -> (forall tab. Condition '[tab ::: ColumnsToRelation subcolumns] 'Ungrouped '[])

248+ -> (forall tab. Condition '[tab ::: subcolumns] 'Ungrouped '[])

248 -> TableConstraintExpression schema alias ('Check aliases)

249 -> TableConstraintExpression schema alias ('Check aliases)

249check _cols condition = UnsafeTableConstraintExpression $

250check _cols condition = UnsafeTableConstraintExpression $

250 "CHECK" <+> parenthesized (renderExpression condition)

251 "CHECK" <+> parenthesized (renderExpression condition)

@@ -273,7 +274,7 @@ check _cols condition = UnsafeTableConstraintExpression $

273-- "CREATE TABLE \"tab\" (\"a\" int NULL, \"b\" int NULL, CONSTRAINT \"uq_a_b\" UNIQUE (\"a\", \"b\"));"

274-- "CREATE TABLE \"tab\" (\"a\" int NULL, \"b\" int NULL, CONSTRAINT \"uq_a_b\" UNIQUE (\"a\", \"b\"));"

274unique

275unique

275 :: ( Has alias schema ('Table table)

276 :: ( Has alias schema ('Table table)

276− , HasAll aliases (TableToColumns table) subcolumns )

277+ , HasAll aliases (TableToRelation table) subcolumns )

277 => NP Alias aliases

278 => NP Alias aliases

278 -> TableConstraintExpression schema alias ('Unique aliases)

279 -> TableConstraintExpression schema alias ('Unique aliases)

279unique columns = UnsafeTableConstraintExpression $

280unique columns = UnsafeTableConstraintExpression $

@@ -794,30 +795,36 @@ createTypeEnum enum labels = UnsafeDefinition $

794

795

795class

796class

796 ( SOP.IsEnumType hask

797 ( SOP.IsEnumType hask

797− , SOP.All KnownSymbol (PGenumWith hask)

798+ , SOP.All KnownSymbol (LabelsWith hask)

798 ) => HasPGenum hask where

799 ) => HasPGenum hask where

799 createTypeEnumWith

800 createTypeEnumWith

800 :: KnownSymbol enum

801 :: KnownSymbol enum

801 => Alias enum

802 => Alias enum

802− -> Definition schema (Create enum ('Typedef ('PGenum (PGenumWith hask))) schema)

803+ -> Definition schema (Create enum ('Typedef (EnumWith hask)) schema)

803 createTypeEnumWith enum = createTypeEnum enum

804 createTypeEnumWith enum = createTypeEnum enum

804− (SOP.hpure label :: NP PGlabel (PGenumWith hask))

805+ (SOP.hpure label :: NP PGlabel (LabelsWith hask))

805

806

806−createType

807+createTypeComposite

807− :: (KnownSymbol comp, SOP.SListI fields)

808+ :: (KnownSymbol ty, SOP.SListI fields)

808− => Alias comp

809+ => Alias ty

809 -> NP (Aliased TypeExpression) fields

810 -> NP (Aliased TypeExpression) fields

810− -> Definition schema (Create comp ('Typedef ('PGcomposite fields)) schema)

811+ -> Definition schema (Create ty ('Typedef ('PGcomposite fields)) schema)

811−createType comp fields = UnsafeDefinition $

812+createTypeComposite ty fields = UnsafeDefinition $

812− "CREATE" <+> "TYPE" <+> renderAlias comp <+> "AS" <+> parenthesized

813+ "CREATE" <+> "TYPE" <+> renderAlias ty <+> "AS" <+> parenthesized

813 (renderCommaSeparated (renderAliasedAs renderTypeExpression) fields) <> ";"

814 (renderCommaSeparated (renderAliasedAs renderTypeExpression) fields) <> ";"

814

815

816+class

817+ ( ZipAliased (FieldNamesWith hask) (FieldTypesWith hask)

818+ , SOP.All PGTyped (FieldTypesWith hask)

815−-- class HasPGcomposite hask where

819+ ) => HasPGcomposite hask where

816−-- createTypeCompositeWith

820+ createTypeCompositeWith

821+ :: KnownSymbol ty

817−-- :: Alias composite

822+ => Alias ty

818−-- -> Definition schema

823+ -> Definition schema (Create ty ( 'Typedef (CompositeWith hask)) schema)

819−-- (Create composite ('Typedef ('PGcompositeWith hask)) schema)

820−-- createTypeCompositeWith

824+ createTypeCompositeWith ty = createTypeComposite ty $ zipAs

825+ (SOP.hpure Alias :: NP Alias (FieldNamesWith hask))

826+ (SOP.hcpure (SOP.Proxy :: SOP.Proxy PGTyped) pgtype

827+ :: NP TypeExpression (FieldTypesWith hask))

821

828

822dropType

829dropType

823 :: Has tydef schema ('Typedef ty)

830 :: Has tydef schema ('Typedef ty)

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

@@ -1045,7 +1045,7 @@ newtype Table

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

1046instance

1047 ( Has alias schema ('Table table)

1048− , relation ~ ColumnsToRelation (TableToColumns table)

1048+ , relation ~ TableToRelation table

1049 ) => IsLabel alias (Table schema relation) where

1050 fromLabel = UnsafeTable $ renderAlias (Alias @alias)

1051

squeal-postgresql/src/Squeal/PostgreSQL/Schema.hs+86−95

@@ -40,6 +40,9 @@ module Squeal.PostgreSQL.Schema

40 , NilRelation

41 , RelationsType

42 , TableType

43+ -- * Schema

44+ , SchemumType (..)

45+ , SchemaType

43 -- * Grouping

46 -- * Grouping

44 , Grouping (..)

47 , Grouping (..)

45 , GroupedBy

48 , GroupedBy

@@ -66,6 +69,7 @@ module Squeal.PostgreSQL.Schema

66 , IsQualified (..)

69 , IsQualified (..)

67 -- * Type Families

70 -- * Type Families

68 , Join

71 , Join

72+ , With

69 , Create

73 , Create

70 , Drop

74 , Drop

71 , Alter

75 , Alter

@@ -84,32 +88,27 @@ module Squeal.PostgreSQL.Schema

84 , NullifyRelation

88 , NullifyRelation

85 , NullifyRelations

89 , NullifyRelations

86 , ColumnsToRelation

90 , ColumnsToRelation

87− , RelationToColumns

88 , TableToColumns

91 , TableToColumns

92+ , TableToRelation

89 , ConstraintInvolves

93 , ConstraintInvolves

90 , DropIfConstraintsInvolve

94 , DropIfConstraintsInvolve

91 -- * Generics

95 -- * Generics

92− , SameField

93− , SameFields

94− , SameLabel

95− , SameLabels

96 , MapMaybes (..)

97 , Nulls

98+ -- * Enum Labels

98 , IsPGlabel (..)

99 , IsPGlabel (..)

99 , PGlabel (..)

100 , PGlabel (..)

100 , renderLabel

101 , renderLabel

101 , renderLabels

102 , renderLabels

102 , LabelOf

103 , LabelOf

103 , LabelsOf

104 , LabelsOf

104− , DatatypeLabels

105+ -- * Embedding

105− -- * Schema

106− , SchemumType (..)

107− , SchemaType

108− , With

109− -- * STUFF

110 , PG

106 , PG

111− , PGenumWith

107+ , EnumWith

112− , PGcompositeWith

108+ , LabelsWith

109+ , CompositeWith

110+ , FieldNamesWith

111+ , FieldTypesWith

113 , ConstructorsOf

112 , ConstructorsOf

114 , ConstructorNameOf

113 , ConstructorNameOf

115 , ConstructorNamesOf

114 , ConstructorNamesOf

@@ -118,28 +117,30 @@ module Squeal.PostgreSQL.Schema

118 , FieldNamesOf

117 , FieldNamesOf

119 , FieldTypeOf

118 , FieldTypeOf

120 , FieldTypesOf

119 , FieldTypesOf

121− , RecordFieldTypesOf

120+ , RecordCodeOf

122 ) where

121 ) where

123

122

124import Control.DeepSeq

123import Control.DeepSeq

125import Data.Aeson (Value)

124import Data.Aeson (Value)

126import Data.ByteString (ByteString)

125import Data.ByteString (ByteString)

127−import Data.Int

126+import Data.Int (Int16, Int32, Int64)

128import Data.Kind

127import Data.Kind

129import Data.Monoid hiding (All)

128import Data.Monoid hiding (All)

130−import Data.Scientific

129+import Data.Scientific (Scientific)

131import Data.String

130import Data.String

132import Data.Text (Text)

131import Data.Text (Text)

133import Data.Time

132import Data.Time

134−import Data.Word

133+import Data.Word (Word16, Word32, Word64)

135import Data.Type.Bool

134import Data.Type.Bool

136import Data.UUID.Types (UUID)

135import Data.UUID.Types (UUID)

136+import Generics.SOP

137import GHC.OverloadedLabels

138import GHC.TypeLits

139import Network.IP.Addr

140

141+import qualified Data.ByteString.Lazy as Lazy

142+import qualified Data.Text.Lazy as Lazy

141import qualified GHC.Generics as GHC

143import qualified GHC.Generics as GHC

142−import qualified Generics.SOP as SOP

143import qualified Generics.SOP.Type.Metadata as Type

144import qualified Generics.SOP.Type.Metadata as Type

144

145

145import Squeal.PostgreSQL.Render

146import Squeal.PostgreSQL.Render

@@ -323,16 +324,13 @@ type family ColumnsToRelation (columns :: ColumnsType) :: RelationType where

323 ColumnsToRelation (column ::: constraint :=> ty ': columns) =

324 ColumnsToRelation (column ::: constraint :=> ty ': columns) =

324 column ::: ty ': ColumnsToRelation columns

325 column ::: ty ': ColumnsToRelation columns

325

326

326−-- | `RelationToColumns` adds `'NoDef` column constraints.

327−type family RelationToColumns (relation :: RelationType) :: ColumnsType where

328− RelationToColumns '[] = '[]

329− RelationToColumns (column ::: ty ': columns) =

330− column ::: 'NoDef :=> ty ': RelationToColumns columns

331−

332-- | `TableToColumns` removes table constraints.

327-- | `TableToColumns` removes table constraints.

333type family TableToColumns (table :: TableType) :: ColumnsType where

328type family TableToColumns (table :: TableType) :: ColumnsType where

334 TableToColumns (constraints :=> columns) = columns

329 TableToColumns (constraints :=> columns) = columns

335

330

331+type family TableToRelation (table :: TableType) :: RelationType where

332+ TableToRelation tab = ColumnsToRelation (TableToColumns tab)

333+

336-- | `Grouping` is an auxiliary namespace, created by

334-- | `Grouping` is an auxiliary namespace, created by

337-- @GROUP BY@ clauses (`Squeal.PostgreSQL.Query.group`), and used

335-- @GROUP BY@ clauses (`Squeal.PostgreSQL.Query.group`), and used

338-- for typesafe aggregation

336-- for typesafe aggregation

@@ -364,8 +362,8 @@ data Alias (alias :: Symbol) = Alias

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

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

365instance alias1 ~ alias2 => IsLabel alias1 (Alias alias2) where

363instance alias1 ~ alias2 => IsLabel alias1 (Alias alias2) where

366 fromLabel = Alias

364 fromLabel = Alias

367−instance aliases ~ '[alias] => IsLabel alias (SOP.NP Alias aliases) where

365+instance aliases ~ '[alias] => IsLabel alias (NP Alias aliases) where

368− fromLabel = fromLabel SOP.:* SOP.Nil

366+ fromLabel = fromLabel :* Nil

369

367

370-- | >>> renderAlias #jimbob

368-- | >>> renderAlias #jimbob

371-- "\"jimbob\""

369-- "\"jimbob\""

@@ -376,9 +374,9 @@ renderAlias = doubleQuoted . fromString . symbolVal

376-- >>> renderAliases (#jimbob :* #kandi :* Nil)

374-- >>> renderAliases (#jimbob :* #kandi :* Nil)

377-- ["\"jimbob\"","\"kandi\""]

375-- ["\"jimbob\"","\"kandi\""]

378renderAliases

376renderAliases

379− :: SOP.All KnownSymbol aliases => SOP.NP Alias aliases -> [ByteString]

377+ :: All KnownSymbol aliases => NP Alias aliases -> [ByteString]

380−renderAliases = SOP.hcollapse

378+renderAliases = hcollapse

381− . SOP.hcmap (SOP.Proxy @KnownSymbol) (SOP.K . renderAlias)

379+ . hcmap (Proxy @KnownSymbol) (K . renderAlias)

382

380

383-- | The `As` operator is used to name an expression. `As` is like a demoted

381-- | The `As` operator is used to name an expression. `As` is like a demoted

384-- version of `:::`.

382-- version of `:::`.

@@ -413,26 +411,29 @@ type family AliasesOf aliaseds where

413 AliasesOf '[] = '[]

411 AliasesOf '[] = '[]

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

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

415

413

414+class

415+ ( SListI (ZipAs ns xs)

416+ , All KnownSymbol ns

416−class SOP.All KnownSymbol ns => ZipAliased ns xs where

417+ ) => ZipAliased ns xs where

417

418

418 type family ZipAs

419 type family ZipAs

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

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

420

421

421− zipAliases

422+ zipAs

422− :: SOP.NP Alias ns

423+ :: NP Alias ns

423− -> SOP.NP expr xs

424+ -> NP expr xs

424− -> SOP.NP (Aliased expr) (ZipAs ns xs)

425+ -> NP (Aliased expr) (ZipAs ns xs)

425

426

426instance ZipAliased '[] '[] where

427instance ZipAliased '[] '[] where

427 type ZipAs '[] '[] = '[]

428 type ZipAs '[] '[] = '[]

428− zipAliases SOP.Nil SOP.Nil = SOP.Nil

429+ zipAs Nil Nil = Nil

429

430

430instance

431instance

431 ( KnownSymbol n

432 ( KnownSymbol n

432 , ZipAliased ns xs

433 , ZipAliased ns xs

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

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

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

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

435− zipAliases (n SOP.:* ns) (x SOP.:* xs) = x `As` n SOP.:* zipAliases ns xs

436+ zipAs (n :* ns) (x :* xs) = x `As` n :* zipAs ns xs

436

437

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

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

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

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

@@ -449,7 +450,7 @@ instance {-# OVERLAPPABLE #-} (KnownSymbol alias, Has alias fields field)

449 => Has alias (field' ': fields) field

450 => Has alias (field' ': fields) field

450

451

451class

452class

452− ( SOP.All KnownSymbol aliases

453+ ( All KnownSymbol aliases

453 ) => HasAll

454 ) => HasAll

454 (aliases :: [Symbol])

455 (aliases :: [Symbol])

455 (fields :: [(Symbol,kind)])

456 (fields :: [(Symbol,kind)])

@@ -592,50 +593,18 @@ type family Rename alias0 alias1 xs where

592 Rename alias0 alias1 ((alias0 ::: x0) ': xs) = (alias1 ::: x0) ': xs

593 Rename alias0 alias1 ((alias0 ::: x0) ': xs) = (alias1 ::: x0) ': xs

593 Rename alias0 alias1 (x ': xs) = x ': Rename alias0 alias1 xs

594 Rename alias0 alias1 (x ': xs) = x ': Rename alias0 alias1 xs

594

595

595−-- | A `SameField` constraint is an equality constraint on a

596−-- `Generics.SOP.Type.Metadata.FieldInfo` and the column alias in a `:::` pair.

597−class SameField

598− (fieldInfo :: Type.FieldInfo) (fieldty :: (Symbol,NullityType)) where

599−instance field ~ column => SameField ('Type.FieldInfo field) (column ::: ty)

600−

601−-- | A `SameFields` constraint proves that a

602−-- `Generics.SOP.Type.Metadata.DatatypeInfo` of a record type has the same

603−-- field names as the column AliasesOf of a `ColumnsType`.

604−type family SameFields

605− (datatypeInfo :: Type.DatatypeInfo) (columns :: [(Symbol,ty)])

606− :: Constraint where

607− SameFields

608− ('Type.ADT _module _datatype '[ 'Type.Record _constructor fields])

609− columns

610− = SOP.AllZip SameField fields columns

611− SameFields

612− ('Type.Newtype _module _datatype ('Type.Record _constructor fields))

613− columns

614− = SOP.AllZip SameField fields columns

615−

616−class SameLabel

617− (constrInfo :: Type.ConstructorInfo) (label :: Symbol) where

618−instance name ~ label => SameLabel ('Type.Constructor name) label

619−

620−type family SameLabels

621− (datatypeInfo :: Type.DatatypeInfo) (labels :: [Symbol])

622− :: Constraint where

623− SameLabels

624− ('Type.ADT _module _datatype constructors) labels

625− = SOP.AllZip SameLabel constructors labels

626−

627class MapMaybes xs where

596class MapMaybes xs where

628 type family Maybes (xs :: [Type]) = (mxs :: [Type]) | mxs -> xs

597 type family Maybes (xs :: [Type]) = (mxs :: [Type]) | mxs -> xs

629− maybes :: SOP.NP Maybe xs -> SOP.NP SOP.I (Maybes xs)

598+ maybes :: NP Maybe xs -> NP I (Maybes xs)

630− unMaybes :: SOP.NP SOP.I (Maybes xs) -> SOP.NP Maybe xs

599+ unMaybes :: NP I (Maybes xs) -> NP Maybe xs

631instance MapMaybes '[] where

600instance MapMaybes '[] where

632 type Maybes '[] = '[]

601 type Maybes '[] = '[]

633− maybes SOP.Nil = SOP.Nil

602+ maybes Nil = Nil

634− unMaybes SOP.Nil = SOP.Nil

603+ unMaybes Nil = Nil

635instance MapMaybes xs => MapMaybes (x ': xs) where

604instance MapMaybes xs => MapMaybes (x ': xs) where

636 type Maybes (x ': xs) = Maybe x ': Maybes xs

605 type Maybes (x ': xs) = Maybe x ': Maybes xs

637− maybes (x SOP.:* xs) = SOP.I x SOP.:* maybes xs

606+ maybes (x :* xs) = I x :* maybes xs

638− unMaybes (SOP.I mx SOP.:* xs) = mx SOP.:* unMaybes xs

607+ unMaybes (I mx :* xs) = mx :* unMaybes xs

639

608

640type family Nulls tys where

609type family Nulls tys where

641 Nulls '[] = '[]

610 Nulls '[] = '[]

@@ -679,12 +648,12 @@ data PGlabel (label :: Symbol) = PGlabel

679

648

680renderLabel :: KnownSymbol label => proxy label -> ByteString

649renderLabel :: KnownSymbol label => proxy label -> ByteString

681renderLabel (_ :: proxy label) =

650renderLabel (_ :: proxy label) =

682− "\'" <> fromString (symbolVal (SOP.Proxy @label)) <> "\'"

651+ "\'" <> fromString (symbolVal (Proxy @label)) <> "\'"

683

652

684renderLabels

653renderLabels

685− :: SOP.All KnownSymbol labels => SOP.NP PGlabel labels -> [ByteString]

654+ :: All KnownSymbol labels => NP PGlabel labels -> [ByteString]

686−renderLabels = SOP.hcollapse

655+renderLabels = hcollapse

687− . SOP.hcmap (SOP.Proxy @KnownSymbol) (SOP.K . renderLabel)

656+ . hcmap (Proxy @KnownSymbol) (K . renderLabel)

688

657

689type family LabelOf (cons :: Type.ConstructorInfo) :: Symbol where

658type family LabelOf (cons :: Type.ConstructorInfo) :: Symbol where

690 LabelOf ('Type.Constructor name) = name

659 LabelOf ('Type.Constructor name) = name

@@ -693,19 +662,22 @@ type family LabelsOf (conss :: [Type.ConstructorInfo]) :: [Symbol] where

693 LabelsOf '[] = '[]

662 LabelsOf '[] = '[]

694 LabelsOf (cons ': conss) = LabelOf cons ': LabelsOf conss

663 LabelsOf (cons ': conss) = LabelOf cons ': LabelsOf conss

695

664

696−type family DatatypeLabels (info :: Type.DatatypeInfo) :: [Symbol] where

697− DatatypeLabels ('Type.ADT _module _datatype constructors) = LabelsOf constructors

698−

699−type family PG (hask :: Type) = (pg :: PGType) | pg -> hask where

665+type family PG (hask :: Type) :: PGType where

700 PG Bool = 'PGbool

666 PG Bool = 'PGbool

701 PG Int16 = 'PGint2

667 PG Int16 = 'PGint2

702 PG Int32 = 'PGint4

668 PG Int32 = 'PGint4

703 PG Int64 = 'PGint8

669 PG Int64 = 'PGint8

670+ PG Word16 = 'PGint2

671+ PG Word32 = 'PGint4

672+ PG Word64 = 'PGint8

704 PG Scientific = 'PGnumeric

673 PG Scientific = 'PGnumeric

705 PG Float = 'PGfloat4

674 PG Float = 'PGfloat4

706 PG Double = 'PGfloat8

675 PG Double = 'PGfloat8

676+ PG Char = 'PGchar 1

707 PG Text = 'PGtext

677 PG Text = 'PGtext

678+ PG Lazy.Text = 'PGtext

708 PG ByteString = 'PGbytea

679 PG ByteString = 'PGbytea

680+ PG Lazy.ByteString = 'PGbytea

709 PG LocalTime = 'PGtimestamp

681 PG LocalTime = 'PGtimestamp

710 PG UTCTime = 'PGtimestamptz

682 PG UTCTime = 'PGtimestamptz

711 PG Day = 'PGdate

683 PG Day = 'PGdate

@@ -715,16 +687,25 @@ type family PG (hask :: Type) = (pg :: PGType) | pg -> hask where

715 PG UUID = 'PGuuid

687 PG UUID = 'PGuuid

716 PG (NetAddr IP) = 'PGinet

688 PG (NetAddr IP) = 'PGinet

717 PG Value = 'PGjson

689 PG Value = 'PGjson

690+ PG ty = TypeError

691+ ('Text "There is no basic Postgres type for " ':<>: 'ShowType ty)

718

692

719−type family PGenumWith (hask :: Type) :: [Type.ConstructorName] where

693+type family EnumWith (hask :: Type) :: PGType where

720− PGenumWith hask =

694+ EnumWith hask = 'PGenum (LabelsWith hask)

721− ConstructorNamesOf (ConstructorsOf (SOP.DatatypeInfoOf hask))

722

695

723−type family PGcompositeWith (hask :: Type) :: PGType where

696+type family LabelsWith (hask :: Type) :: [Type.ConstructorName] where

724− PGcompositeWith hask =

697+ LabelsWith hask =

698+ ConstructorNamesOf (ConstructorsOf (DatatypeInfoOf hask))

699+

700+type family CompositeWith (hask :: Type) :: PGType where

701+ CompositeWith hask =

725− 'PGcomposite (ZipAs

702+ 'PGcomposite (ZipAs (FieldNamesWith hask) (FieldTypesWith hask))

703+

704+type family FieldNamesWith (hask :: Type) :: [Type.FieldName] where

726− (FieldNamesOf (FieldsOf (SOP.DatatypeInfoOf hask)))

705+ FieldNamesWith hask = FieldNamesOf (FieldsOf (DatatypeInfoOf hask))

727− (RecordFieldTypesOf (SOP.Code hask)))

706+

707+type family FieldTypesWith (hask :: Type) :: [PGType] where

708+ FieldTypesWith hask = FieldTypesOf (RecordCodeOf hask (Code hask))

728

709

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

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

730 :: [Type.ConstructorInfo] where

711 :: [Type.ConstructorInfo] where

@@ -736,8 +717,12 @@ type family ConstructorsOf (datatype :: Type.DatatypeInfo)

736type family ConstructorNameOf (constructors :: Type.ConstructorInfo)

717type family ConstructorNameOf (constructors :: Type.ConstructorInfo)

737 :: Type.ConstructorName where

718 :: Type.ConstructorName where

738 ConstructorNameOf ('Type.Constructor name) = name

719 ConstructorNameOf ('Type.Constructor name) = name

739− ConstructorNameOf ('Type.Infix name _assoc _fix) = name

720+ ConstructorNameOf ('Type.Infix name _assoc _fix) = TypeError

721+ ('Text "ConstructorNameOf error: non-nullary constructor "

722+ ':<>: 'Text name)

740− ConstructorNameOf ('Type.Record name _fields) = name

723+ ConstructorNameOf ('Type.Record name _fields) = TypeError

724+ ('Text "ConstructorNameOf error: non-nullary constructor "

725+ ':<>: 'Text name)

741

726

742type family ConstructorNamesOf (constructors :: [Type.ConstructorInfo])

727type family ConstructorNamesOf (constructors :: [Type.ConstructorInfo])

743 :: [Type.ConstructorName] where

728 :: [Type.ConstructorName] where

@@ -749,6 +734,8 @@ type family FieldsOf (constructor :: Type.DatatypeInfo)

749 :: [Type.FieldInfo] where

734 :: [Type.FieldInfo] where

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

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

751 fields

736 fields

737+ FieldsOf ('Type.Newtype _module _datatype ('Type.Record _name fields)) =

738+ fields

752

739

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

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

754 FieldNameOf ('Type.FieldInfo name) = name

741 FieldNameOf ('Type.FieldInfo name) = name

@@ -760,10 +747,14 @@ type family FieldNamesOf (fields :: [Type.FieldInfo])

760

747

761type family FieldTypeOf (maybe :: Type) where

748type family FieldTypeOf (maybe :: Type) where

762 FieldTypeOf (Maybe hask) = PG hask

749 FieldTypeOf (Maybe hask) = PG hask

750+ FieldTypeOf ty = TypeError

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

763

752

764type family FieldTypesOf (fields :: [Type]) where

753type family FieldTypesOf (fields :: [Type]) where

765 FieldTypesOf '[] = '[]

754 FieldTypesOf '[] = '[]

766 FieldTypesOf (field ': fields) = FieldTypeOf field ': FieldTypesOf fields

755 FieldTypesOf (field ': fields) = FieldTypeOf field ': FieldTypesOf fields

767

756

768−type family RecordFieldTypesOf (code :: [[Type]]) where

757+type family RecordCodeOf (hask :: Type) (code ::[[Type]]) :: [Type] where

769− RecordFieldTypesOf '[fields] = FieldTypesOf fields

758+ RecordCodeOf _hask '[tys] = tys

759+ RecordCodeOf hask _tys = TypeError

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