687faef · squeal · git.iko.soy

git.iko.soy/squeal

on dev help sign in

rejigger constraints a bit

687faefEitan Chatav9 years ago

squeal-postgresql/exe/Example.hs+13−12

compare with dev

unifiedsplit

@@ -24,15 +24,16 @@ import qualified Generics.SOP as SOP

24import qualified GHC.Generics as GHC

26type Schema =

27− '[ "users" ::: '[] :=>

27+ '[ "users" :::

28+ '[] :=>

28− '[ "id" ::: AsSet '[ 'Default, 'Unique] :=> 'NotNull 'PGint4

29+ '[ "id" ::: 'Def :=> 'NotNull 'PGint4

29− , "name" ::: '[] :=> 'NotNull 'PGtext

30+ , "name" ::: 'NoDef :=> 'NotNull 'PGtext

30 ]

31 ]

31− , "emails" ::: AsSet

32+ , "emails" :::

32− '[ 'ForeignKey '["user_id"] "users" '["id"] ] :=>

33+ '[ "fk_user_id" ::: 'ForeignKey '["user_id"] "users" '["id"] ] :=>

33− '[ "id" ::: AsSet '[ 'Default, 'Unique] :=> 'NotNull 'PGint4

34+ '[ "id" ::: 'Def :=> 'NotNull 'PGint4

34− , "user_id" ::: '[] :=> 'NotNull 'PGint4

35+ , "user_id" ::: 'NoDef :=> 'NotNull 'PGint4

35− , "email" ::: '[] :=> 'Null 'PGtext

36+ , "email" ::: 'NoDef :=> 'Null 'PGtext

36 ]

37 ]

38 ]

@@ -46,8 +47,8 @@ setup =

46 ( serial `As` #id :*

47 ( serial `As` #id :*

47 (int & notNull) `As` #user_id :*

48 (int & notNull) `As` #user_id :*

48 text `As` #email :* Nil )

49 text `As` #email :* Nil )

49− ( foreignKey (Column #user_id :* Nil) #users (Column #id :* Nil)

50+ ( (foreignKey (Column #user_id :* Nil) #users (Column #id :* Nil)

50− OnDeleteCascade OnUpdateCascade :* Nil )

51+ OnDeleteCascade OnUpdateCascade) `As` #fk_user_id :* Nil)

52teardown :: Definition Schema '[]

53teardown :: Definition Schema '[]

53teardown = dropTable #emails >>> dropTable #users

54teardown = dropTable #emails >>> dropTable #users

@@ -55,12 +56,12 @@ teardown = dropTable #emails >>> dropTable #users

55insertUser :: Manipulation Schema '[ 'NotNull 'PGtext]

56insertUser :: Manipulation Schema '[ 'NotNull 'PGtext]

56 '[ "fromOnly" ::: 'NotNull 'PGint4 ]

57 '[ "fromOnly" ::: 'NotNull 'PGint4 ]

57insertUser = insertRows #users

58insertUser = insertRows #users

58− (Def `As` #id :* Set (param @1) `As` #name :* Nil) []

59+ (Default `As` #id :* Set (param @1) `As` #name :* Nil) []

59 OnConflictDoNothing (Returning (#id `As` #fromOnly :* Nil))

60 OnConflictDoNothing (Returning (#id `As` #fromOnly :* Nil))

61insertEmail :: Manipulation Schema '[ 'NotNull 'PGint4, 'Null 'PGtext] '[]

62insertEmail :: Manipulation Schema '[ 'NotNull 'PGint4, 'Null 'PGtext] '[]

62insertEmail = insertRows #emails

63insertEmail = insertRows #emails

63− ( Def `As` #id :*

64+ ( Default `As` #id :*

64 Set (param @1) `As` #user_id :*

65 Set (param @1) `As` #user_id :*

65 Set (param @2) `As` #email :* Nil ) []

66 Set (param @2) `As` #email :* Nil ) []

66 OnConflictDoNothing (Returning Nil)

67 OnConflictDoNothing (Returning Nil)

squeal-postgresql/squeal-postgresql.cabal+1

@@ -49,6 +49,7 @@ library

49 , time >= 1.8.0.2 && < 2

50 , transformers >= 0.5.2.0 && < 1

51 , transformers-base >= 0.4.4 && < 1

52+ , type-level-sets >= 0.8.5.0 && < 1

52 , uuid >= 1.3.13 && < 2

53 , uuid >= 1.3.13 && < 2

54test-suite squeal-postgresql-spec

55test-suite squeal-postgresql-spec

squeal-postgresql/src/Squeal/PostgreSQL/Definition.hs+32−22

@@ -32,8 +32,8 @@ module Squeal.PostgreSQL.Definition

32 , createTable

33 , TableConstraintExpression (..)

34 , check

35− , uniques

35+ , unique

36− , primaryKeys

36+ , primaryKey

37 , foreignKey

38 , OnDeleteClause (OnDeleteNoAction, OnDeleteRestrict, OnDeleteCascade)

39 , renderOnDeleteClause

@@ -64,7 +64,6 @@ import Control.Category

64import Control.DeepSeq

65import Data.ByteString

66import Data.Monoid

67−import Data.Type.Set

68import GHC.TypeLits

67import GHC.TypeLits

69import Prelude hiding ((.), id)

68import Prelude hiding ((.), id)

@@ -114,7 +113,7 @@ createTable

114 => Alias tab -- ^ the name of the table to add

113 => Alias tab -- ^ the name of the table to add

115 -> NP (Aliased TypeExpression) columns

114 -> NP (Aliased TypeExpression) columns

116 -- ^ the names and datatype of each column

115 -- ^ the names and datatype of each column

117− -> NP (TableConstraintExpression schema (UnconstrainColumns columns))

116+ -> NP (Aliased (TableConstraintExpression schema (UnconstrainColumns columns)))

118 constraints

117 constraints

119 -- ^ constraints that must hold for the table

118 -- ^ constraints that must hold for the table

120 -> Definition schema (Create tab table schema)

119 -> Definition schema (Create tab table schema)

@@ -122,12 +121,17 @@ createTable table columns constraints = UnsafeDefinition $

122 "CREATE TABLE" <+> renderAlias table

121 "CREATE TABLE" <+> renderAlias table

123 <+> parenthesized

122 <+> parenthesized

124 ( renderCommaSeparated renderColumnDef columns

123 ( renderCommaSeparated renderColumnDef columns

125− <> renderCommaSeparated renderTableConstraintExpression constraints )

124+ <> renderCommaSeparated renderConstraint constraints )

126 <> ";"

125 <> ";"

127 where

126 where

128 renderColumnDef :: Aliased TypeExpression x -> ByteString

127 renderColumnDef :: Aliased TypeExpression x -> ByteString

129 renderColumnDef (ty `As` column) =

128 renderColumnDef (ty `As` column) =

130 renderAlias column <+> renderTypeExpression ty

129 renderAlias column <+> renderTypeExpression ty

130+ renderConstraint

131+ :: Aliased (TableConstraintExpression schema columns) constraint

132+ -> ByteString

133+ renderConstraint (constraint `As` alias) =

134+ "CONSTRAINT" <+> renderAlias alias <+> renderTableConstraintExpression constraint

131

135

132-- | Data types are a way to limit the kind of data that can be stored in a

136-- | Data types are a way to limit the kind of data that can be stored in a

133-- table. For many applications, however, the constraint they provide is

137-- table. For many applications, however, the constraint they provide is

@@ -179,12 +183,12 @@ check condition = UnsafeTableConstraintExpression $

179-- [ unique (Column #a :* Column #b :* Nil) ]

183-- [ unique (Column #a :* Column #b :* Nil) ]

180-- :}

184-- :}

181-- "CREATE TABLE tab (a int, b int, UNIQUE (a, b));"

185-- "CREATE TABLE tab (a int, b int, UNIQUE (a, b));"

182−uniques

186+unique

183 :: SOP.SListI subcolumns

187 :: SOP.SListI subcolumns

184 => NP (Column columns) subcolumns

188 => NP (Column columns) subcolumns

185 -- ^ unique column or group of columns

189 -- ^ unique column or group of columns

186 -> TableConstraintExpression schema columns ( 'Uniques (Aliases subcolumns))

190 -> TableConstraintExpression schema columns ( 'Uniques (Aliases subcolumns))

187−uniques columns = UnsafeTableConstraintExpression $

191+unique columns = UnsafeTableConstraintExpression $

188 "UNIQUE" <+> parenthesized (renderCommaSeparated renderColumn columns)

192 "UNIQUE" <+> parenthesized (renderCommaSeparated renderColumn columns)

189

193

190-- | A `primaryKey` constraint indicates that a column, or group of columns,

194-- | A `primaryKey` constraint indicates that a column, or group of columns,

@@ -199,12 +203,12 @@ uniques columns = UnsafeTableConstraintExpression $

199-- [ primaryKey (Column #id :* Nil) ]

203-- [ primaryKey (Column #id :* Nil) ]

200-- :}

204-- :}

201-- "CREATE TABLE tab (id serial, name text NOT NULL, PRIMARY KEY (id));"

205-- "CREATE TABLE tab (id serial, name text NOT NULL, PRIMARY KEY (id));"

202−primaryKeys

206+primaryKey

203 :: (SOP.SListI subcolumns, AllNotNull subcolumns)

207 :: (SOP.SListI subcolumns, AllNotNull subcolumns)

204 => NP (Column columns) subcolumns

208 => NP (Column columns) subcolumns

205 -- ^ identifying column or group of columns

209 -- ^ identifying column or group of columns

206− -> TableConstraintExpression schema columns ('Uniques (Aliases subcolumns))

210+ -> TableConstraintExpression schema columns ('PrimaryKey (Aliases subcolumns))

207−primaryKeys columns = UnsafeTableConstraintExpression $

211+primaryKey columns = UnsafeTableConstraintExpression $

208 "PRIMARY KEY" <+> parenthesized (renderCommaSeparated renderColumn columns)

212 "PRIMARY KEY" <+> parenthesized (renderCommaSeparated renderColumn columns)

209

213

210-- | A `foreignKey` specifies that the values in a column

214-- | A `foreignKey` specifies that the values in a column

@@ -369,11 +373,17 @@ alterTableRename table0 table1 = UnsafeDefinition $

369-- <+> "ADD" <+> renderTableConstraintExpression constraint <> ";"

373-- <+> "ADD" <+> renderTableConstraintExpression constraint <> ";"

370

374

371addConstraint

375addConstraint

372− :: (tab ::: table) `In` schema

376+ :: Aliased (TableConstraintExpression schema (UnconstrainColumns columns)) constraint

373− => Alias tab

377+ -> AlterTable schema (constraints :=> columns)

374− -> TableConstraintExpression schema columns constraint

378+ ((constraint ': constraints) :=> columns)

375− -> AlterTable schema table (AddConstraint constraint table)

376−addConstraint = undefined

379+addConstraint constraint = UnsafeAlterTable $

380+ "ADD" <+> "CONSTRAINT" <+> renderConstraint constraint

381+ where

382+ renderConstraint

383+ :: Aliased (TableConstraintExpression schema columns) constraint

384+ -> ByteString

385+ renderConstraint (constraint' `As` alias) =

386+ "CONSTRAINT" <+> renderAlias alias <+> renderTableConstraintExpression constraint'

377

387

378-- | An `AlterTable` describes the alteration to perform on the columns

388-- | An `AlterTable` describes the alteration to perform on the columns

379-- of a table.

389-- of a table.

@@ -400,10 +410,10 @@ newtype AlterTable

400-- :}

410-- :}

401-- "ALTER TABLE tab ADD COLUMN col2 text DEFAULT E'foo';"

411-- "ALTER TABLE tab ADD COLUMN col2 text DEFAULT E'foo';"

402addColumnDefault

412addColumnDefault

403− :: (KnownSymbol column, 'Default `In` constraints)

413+ :: KnownSymbol column

404 => Alias column -- ^ column to add

414 => Alias column -- ^ column to add

405− -> TypeExpression (constraints :=> ty) -- ^ type of the new column

415+ -> TypeExpression ('Def :=> ty) -- ^ type of the new column

406− -> AlterTable schema table (Add column (constraints :=> ty) table)

416+ -> AlterTable schema table (Add column ('Def :=> ty) table)

407addColumnDefault column ty = UnsafeAlterTable $

417addColumnDefault column ty = UnsafeAlterTable $

408 "ADD COLUMN" <+> renderAlias column <+> renderTypeExpression ty

418 "ADD COLUMN" <+> renderAlias column <+> renderTypeExpression ty

409

419

@@ -424,8 +434,8 @@ addColumnDefault column ty = UnsafeAlterTable $

424addColumnNull

434addColumnNull

425 :: KnownSymbol column

435 :: KnownSymbol column

426 => Alias column -- ^ column to add

436 => Alias column -- ^ column to add

427− -> TypeExpression ( '[] :=> 'Null ty) -- ^ type of the new column

437+ -> TypeExpression ('NoDef :=> 'Null ty) -- ^ type of the new column

428− -> AlterTable schema table (Add column ( '[] :=> 'Null ty) table)

438+ -> AlterTable schema table (Add column ('NoDef :=> 'Null ty) table)

429addColumnNull column ty = UnsafeAlterTable $

439addColumnNull column ty = UnsafeAlterTable $

430 "ADD COLUMN" <+> renderAlias column <+> renderTypeExpression ty

440 "ADD COLUMN" <+> renderAlias column <+> renderTypeExpression ty

431

441

@@ -522,7 +532,7 @@ newtype AlterColumn (ty0 :: ColumnType) (ty1 :: ColumnType) =

522-- "ALTER TABLE tab ALTER COLUMN col SET DEFAULT 5;"

532-- "ALTER TABLE tab ALTER COLUMN col SET DEFAULT 5;"

523setDefault

533setDefault

524 :: Expression '[] 'Ungrouped '[] ty -- ^ default value to set

534 :: Expression '[] 'Ungrouped '[] ty -- ^ default value to set

525− -> AlterColumn (constraints :=> ty) (AsSet ('Default ': constraints) :=> ty)

535+ -> AlterColumn (constraints :=> ty) ('Def :=> ty)

526setDefault expression = UnsafeAlterColumn $

536setDefault expression = UnsafeAlterColumn $

527 "SET DEFAULT" <+> renderExpression expression

537 "SET DEFAULT" <+> renderExpression expression

528

538

@@ -537,7 +547,7 @@ setDefault expression = UnsafeAlterColumn $

537-- in renderDefinition definition

547-- in renderDefinition definition

538-- :}

548-- :}

539-- "ALTER TABLE tab ALTER COLUMN col DROP DEFAULT;"

549-- "ALTER TABLE tab ALTER COLUMN col DROP DEFAULT;"

540−dropDefault :: AlterColumn ty (DropConstraint 'Default ty)

550+dropDefault :: AlterColumn ('Def :=> ty) ('NoDef :=> ty)

541dropDefault = UnsafeAlterColumn $ "DROP DEFAULT"

551dropDefault = UnsafeAlterColumn $ "DROP DEFAULT"

542

552

543-- | A `setNotNull` adds a @NOT NULL@ constraint to a column.

553-- | A `setNotNull` adds a @NOT NULL@ constraint to a column.

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

@@ -496,7 +496,7 @@ atan2_ y x = UnsafeExpression $

496-- | >>> renderExpression $ true & cast int4

497-- "(TRUE :: int4)"

498cast

499− :: TypeExpression ('[] :=> 'Null ty1)

499+ :: TypeExpression ('NoDef :=> 'Null ty1)

500 -- ^ type to cast as

501 -> Expression tables grouping params (nullity ty0)

502 -- ^ value to convert

@@ -997,100 +997,100 @@ newtype TypeExpression (ty :: ColumnType)

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

998

999-- | logical Boolean (true/false)

1000−bool :: TypeExpression ('[] :=> 'Null 'PGbool)

1000+bool :: TypeExpression ('NoDef :=> 'Null 'PGbool)

1001bool = UnsafeTypeExpression "bool"

1002-- | signed two-byte integer

1003−int2, smallint :: TypeExpression ('[] :=> 'Null 'PGint2)

1003+int2, smallint :: TypeExpression ('NoDef :=> 'Null 'PGint2)

1004int2 = UnsafeTypeExpression "int2"

1005smallint = UnsafeTypeExpression "smallint"

1006-- | signed four-byte integer

1007−int4, int, integer :: TypeExpression ('[] :=> 'Null 'PGint4)

1007+int4, int, integer :: TypeExpression ('NoDef :=> 'Null 'PGint4)

1008int4 = UnsafeTypeExpression "int4"

1009int = UnsafeTypeExpression "int"

1010integer = UnsafeTypeExpression "integer"

1011-- | signed eight-byte integer

1012−int8, bigint :: TypeExpression ('[] :=> 'Null 'PGint8)

1012+int8, bigint :: TypeExpression ('NoDef :=> 'Null 'PGint8)

1013int8 = UnsafeTypeExpression "int8"

1014bigint = UnsafeTypeExpression "bigint"

1015-- | arbitrary precision numeric type

1016−numeric :: TypeExpression ('[] :=> 'Null 'PGnumeric)

1016+numeric :: TypeExpression ('NoDef :=> 'Null 'PGnumeric)

1017numeric = UnsafeTypeExpression "numeric"

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

1019−float4, real :: TypeExpression ('[] :=> 'Null 'PGfloat4)

1019+float4, real :: TypeExpression ('NoDef :=> 'Null 'PGfloat4)

1020float4 = UnsafeTypeExpression "float4"

1021real = UnsafeTypeExpression "real"

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

1023−float8, doublePrecision :: TypeExpression ('[] :=> 'Null 'PGfloat8)

1023+float8, doublePrecision :: TypeExpression ('NoDef :=> 'Null 'PGfloat8)

1024float8 = UnsafeTypeExpression "float8"

1025doublePrecision = UnsafeTypeExpression "double precision"

1026-- | not a true type, but merely a notational convenience for creating

1027-- unique identifier columns with type `'PGint2`

1028serial2, smallserial

1029− :: TypeExpression ( AsSet '[ 'Default, 'Unique] :=> 'NotNull 'PGint2)

1029+ :: TypeExpression ('Def :=> 'NotNull 'PGint2)

1030serial2 = UnsafeTypeExpression "serial2"

1031smallserial = UnsafeTypeExpression "smallserial"

1032-- | not a true type, but merely a notational convenience for creating

1033-- unique identifier columns with type `'PGint4`

1034serial4, serial

1035− :: TypeExpression ( AsSet '[ 'Default, 'Unique] :=> 'NotNull 'PGint4)

1035+ :: TypeExpression ('Def :=> 'NotNull 'PGint4)

1036serial4 = UnsafeTypeExpression "serial4"

1037serial = UnsafeTypeExpression "serial"

1038-- | not a true type, but merely a notational convenience for creating

1039-- unique identifier columns with type `'PGint8`

1040serial8, bigserial

1041− :: TypeExpression ( AsSet '[ 'Default, 'Unique] :=> 'NotNull 'PGint8)

1041+ :: TypeExpression ('Def :=> 'NotNull 'PGint8)

1042serial8 = UnsafeTypeExpression "serial8"

1043bigserial = UnsafeTypeExpression "bigserial"

1044-- | variable-length character string

1045−text :: TypeExpression ('[] :=> 'Null 'PGtext)

1045+text :: TypeExpression ('NoDef :=> 'Null 'PGtext)

1046text = UnsafeTypeExpression "text"

1047-- | fixed-length character string

1048char, character

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

1050 => proxy n

1051− -> TypeExpression ('[] :=> 'Null ('PGchar n))

1051+ -> TypeExpression ('NoDef :=> 'Null ('PGchar n))

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

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

1054-- | variable-length character string

1055varchar, characterVarying

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

1057 => proxy n

1058− -> TypeExpression ('[] :=> 'Null ('PGvarchar n))

1058+ -> TypeExpression ('NoDef :=> 'Null ('PGvarchar n))

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

1060characterVarying p = UnsafeTypeExpression $

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

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

1063−bytea :: TypeExpression ('[] :=> 'Null 'PGbytea)

1063+bytea :: TypeExpression ('NoDef :=> 'Null 'PGbytea)

1064bytea = UnsafeTypeExpression "bytea"

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

1066−timestamp :: TypeExpression ('[] :=> 'Null 'PGtimestamp)

1066+timestamp :: TypeExpression ('NoDef :=> 'Null 'PGtimestamp)

1067timestamp = UnsafeTypeExpression "timestamp"

1068-- | date and time, including time zone

1069−timestampWithTimeZone :: TypeExpression ('[] :=> 'Null 'PGtimestamptz)

1069+timestampWithTimeZone :: TypeExpression ('NoDef :=> 'Null 'PGtimestamptz)

1070timestampWithTimeZone = UnsafeTypeExpression "timestamp with time zone"

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

1072−date :: TypeExpression ('[] :=> 'Null 'PGdate)

1072+date :: TypeExpression ('NoDef :=> 'Null 'PGdate)

1073date = UnsafeTypeExpression "date"

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

1075−time :: TypeExpression ('[] :=> 'Null 'PGtime)

1075+time :: TypeExpression ('NoDef :=> 'Null 'PGtime)

1076time = UnsafeTypeExpression "time"

1077-- | time of day, including time zone

1078−timeWithTimeZone :: TypeExpression ('[] :=> 'Null 'PGtimetz)

1078+timeWithTimeZone :: TypeExpression ('NoDef :=> 'Null 'PGtimetz)

1079timeWithTimeZone = UnsafeTypeExpression "time with time zone"

1080-- | time span

1081−interval :: TypeExpression ('[] :=> 'Null 'PGinterval)

1081+interval :: TypeExpression ('NoDef :=> 'Null 'PGinterval)

1082interval = UnsafeTypeExpression "interval"

1083-- | universally unique identifier

1084−uuid :: TypeExpression ('[] :=> 'Null 'PGuuid)

1084+uuid :: TypeExpression ('NoDef :=> 'Null 'PGuuid)

1085uuid = UnsafeTypeExpression "uuid"

1086-- | IPv4 or IPv6 host address

1087−inet :: TypeExpression ('[] :=> 'Null 'PGinet)

1087+inet :: TypeExpression ('NoDef :=> 'Null 'PGinet)

1088inet = UnsafeTypeExpression "inet"

1089-- | textual JSON data

1090−json :: TypeExpression ('[] :=> 'Null 'PGjson)

1090+json :: TypeExpression ('NoDef :=> 'Null 'PGjson)

1091json = UnsafeTypeExpression "json"

1092-- | binary JSON data, decomposed

1093−jsonb :: TypeExpression ('[] :=> 'Null 'PGjsonb)

1093+jsonb :: TypeExpression ('NoDef :=> 'Null 'PGjsonb)

1094jsonb = UnsafeTypeExpression "jsonb"

1095

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

@@ -1103,14 +1103,14 @@ notNull ty = UnsafeTypeExpression $ renderTypeExpression ty <+> "NOT NULL"

1103-- | used in `createTable` commands as a column constraint to give a default

1104default_

1105 :: Expression '[] 'Ungrouped '[] ty

1106− -> TypeExpression (constraints :=> ty)

1106+ -> TypeExpression ('NoDef :=> ty)

1107− -> TypeExpression (AsSet ('Default ': constraints) :=> ty)

1107+ -> TypeExpression ('Def :=> ty)

1108default_ x ty = UnsafeTypeExpression $

1109 renderTypeExpression ty <+> "DEFAULT" <+> renderExpression x

1110

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

1112class PGTyped (ty :: PGType) where

1113− pgtype :: TypeExpression ('[] :=> 'Null ty)

1113+ pgtype :: TypeExpression ('NoDef :=> 'Null ty)

1114instance PGTyped 'PGbool where pgtype = bool

1115instance PGTyped 'PGint2 where pgtype = int2

1116instance PGTyped 'PGint4 where pgtype = int4

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

@@ -201,7 +201,7 @@ insertRows tab row rows conflict returning = UnsafeManipulation $

201 :: Aliased (ColumnValue '[] params) ty -> ByteString

202 renderAliasPart (_ `As` name) = renderAlias name

203 renderColumnValuePart (value `As` _) = case value of

204− Def -> "DEFAULT"

204+ Default -> "DEFAULT"

205 Set expression -> renderExpression expression

206

207insertQuery

@@ -227,12 +227,10 @@ data ColumnValue

227 (ty :: ColumnType)

228 where

229 Same :: ColumnValue (column ': columns) params ty

230− Def

231− :: 'Default `In` constraints

232− => ColumnValue columns params (constraints :=> ty)

230+ Default :: ColumnValue columns params ('Def :=> ty)

233 Set

231 Set

234 :: (forall table. Expression '[table ::: columns] 'Ungrouped params ty)

232 :: (forall table. Expression '[table ::: columns] 'Ungrouped params ty)

235− -> ColumnValue columns params (constraints :=> ty)

233+ -> ColumnValue columns params (constraint :=> ty)

236

234

237-- | A `ReturningClause` computes and return value(s) based

235-- | A `ReturningClause` computes and return value(s) based

238-- on each row actually inserted, updated or deleted. This is primarily

236-- on each row actually inserted, updated or deleted. This is primarily

@@ -301,7 +299,7 @@ renderConflictClause = \case

301 -> Maybe ByteString

299 -> Maybe ByteString

302 renderUpdate = \case

300 renderUpdate = \case

303 Same `As` _ -> Nothing

301 Same `As` _ -> Nothing

304− Def `As` column -> Just $

302+ Default `As` column -> Just $

305 renderAlias column <+> "=" <+> "DEFAULT"

303 renderAlias column <+> "=" <+> "DEFAULT"

306 Set expression `As` column -> Just $

304 Set expression `As` column -> Just $

307 renderAlias column <+> "=" <+> renderExpression expression

305 renderAlias column <+> "=" <+> renderExpression expression

@@ -350,7 +348,7 @@ update table columns wh returning = UnsafeManipulation $

350 -> Maybe ByteString

348 -> Maybe ByteString

351 renderUpdate = \case

349 renderUpdate = \case

352 Same `As` _ -> Nothing

350 Same `As` _ -> Nothing

353− Def `As` column -> Just $

351+ Default `As` column -> Just $

354 renderAlias column <+> "=" <+> "DEFAULT"

352 renderAlias column <+> "=" <+> "DEFAULT"

355 Set expression `As` column -> Just $

353 Set expression `As` column -> Just $

356 renderAlias column <+> "=" <+> renderExpression expression

354 renderAlias column <+> "=" <+> renderExpression expression

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

@@ -83,10 +83,10 @@ module Squeal.PostgreSQL.Schema

83 , ColumnConstraint (..)

84 -- , DropDefault

85 -- , DropDefaultList

86− , AddConstraint

86+ -- , AddConstraint

87− , DropConstraint

87+ -- , DropConstraint

88 , TableConstraint (..)

89− , AsSet

89+ -- , AsSet

90 , Aliases

91 , Has

92 ) where

@@ -95,9 +95,9 @@ import Control.DeepSeq

95import Data.ByteString

96import Data.Monoid

97import Data.String

98−import Data.Type.Bool

98+-- import Data.Type.Bool

99−import Data.Type.Equality

99+-- import Data.Type.Equality

100−import Data.Type.Set

100+-- import Data.Type.Set

101import Generics.SOP (AllZip)

102import GHC.Generics (Generic)

103import GHC.Exts

@@ -142,7 +142,7 @@ data NullityType

142-- is to use `Squeal.PostgreSQL.Expression.def`,

143-- `Squeal.PostgreSQL.Expression.unDef` or

144-- `Squeal.PostgreSQL.Expression.param`.

145−type ColumnType = ([ColumnConstraint],NullityType)

145+type ColumnType = (ColumnConstraint,NullityType)

146

147-- | `ColumnsType` is a kind synonym for a row of `ColumnType`s.

148type ColumnsType = [(Symbol,ColumnType)]

@@ -150,11 +150,11 @@ type ColumnsType = [(Symbol,ColumnType)]

150type RelationType = [(Symbol,NullityType)]

151type RelationsType = [(Symbol,RelationType)]

152

153−type TableType = ([TableConstraint],ColumnsType)

153+type TableType = (TableConstraints,ColumnsType)

154type SchemaType = [(Symbol,TableType)]

155

156type family UnconstrainColumn (ty :: ColumnType) :: NullityType where

157− UnconstrainColumn (constraints :=> ty) = ty

157+ UnconstrainColumn (constraint :=> ty) = ty

158

159type family UnconstrainColumns (columns :: ColumnsType) :: RelationType where

160 UnconstrainColumns '[] = '[]

@@ -332,18 +332,18 @@ type family Alter alias xs x where

332 Alter alias ((alias ::: x0) ': xs) x1 = (alias ::: x1) ': xs

333 Alter alias (x0 ': xs) x1 = x0 ': Alter alias xs x1

334

335−type family AddConstraint constraint ty where

335+-- type family AddConstraint constraint ty where

336− AddConstraint constraint (constraints :=> ty)

336+-- AddConstraint constraint (constraints :=> ty)

337− = AsSet (constraint ': constraints) :=> ty

337+-- = AsSet (constraint ': constraints) :=> ty

338

339−type family DeleteFromList (e :: elem) (list :: [elem]) where

339+-- type family DeleteFromList (e :: elem) (list :: [elem]) where

340− DeleteFromList elem '[] = '[]

340+-- DeleteFromList elem '[] = '[]

341− DeleteFromList elem (x ': xs) =

341+-- DeleteFromList elem (x ': xs) =

342− If (Cmp elem x == 'EQ) xs (x ': DeleteFromList elem xs)

342+-- If (Cmp elem x == 'EQ) xs (x ': DeleteFromList elem xs)

343

344−type family DropConstraint constraint ty where

344+-- type family DropConstraint constraint ty where

345− DropConstraint constraint (constraints :=> ty)

345+-- DropConstraint constraint (constraints :=> ty)

346− = (AsSet (DeleteFromList constraint constraints)) :=> ty

346+-- = (AsSet (DeleteFromList constraint constraints)) :=> ty

347

348-- | @Rename alias0 alias1 xs@ replaces the alias @alias0@ by @alias1@ in @xs@

349-- and is used in `Squeal.PostgreSQL.Definition.alterTableRename` and

@@ -373,30 +373,21 @@ type family SameFields

373 columns

374 = AllZip SameField fields columns

375

376−type (:=>) (constraints :: [constraint]) ty = '(constraints,ty)

376+type (:=>) (constraints :: constraint) ty = '(constraints,ty)

377infixr 7 :=>

378

379data ColumnConstraint

380− = Default

380+ = Def

381− | Unique

381+ | NoDef

382− | References Symbol Symbol

383−

384−type instance Cmp 'Default 'Default = 'EQ

385−type instance Cmp 'Unique 'Unique = 'EQ

386−type instance Cmp ('References tab0 col0) ('References tab1 col1) =

387− If (Cmp tab0 tab1 == 'EQ) (Cmp col0 col1) (Cmp tab0 tab1)

388−type instance Cmp 'Default 'Unique = 'LT

389−type instance Cmp 'Unique 'Default = 'GT

390−type instance Cmp 'Default ('References tab col) = 'LT

391−type instance Cmp ('References tab col) 'Default = 'GT

392−type instance Cmp 'Unique ('References tab col) = 'LT

393−type instance Cmp ('References tab col) 'Unique = 'GT

394

382

395data TableConstraint

383data TableConstraint

396 = Check

384 = Check

397 | Uniques [Symbol]

385 | Uniques [Symbol]

386+ | PrimaryKey [Symbol]

398 | ForeignKey [Symbol] Symbol [Symbol]

387 | ForeignKey [Symbol] Symbol [Symbol]

399

388

389+type TableConstraints = [(Symbol,TableConstraint)]

390+

400type family Aliases xs where

391type family Aliases xs where

401 Aliases '[] = '[]

392 Aliases '[] = '[]

402 Aliases ((alias ::: x) ': xs) = alias ': Aliases xs

393 Aliases ((alias ::: x) ': xs) = alias ': Aliases xs

stack.yaml+2

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

1resolver: nightly-2017-08-25

2packages:

3- squeal-postgresql

4+extra-deps:

5+- type-level-sets-0.8.5.0