8ca416a · squeal · git.iko.soy

git.iko.soy/squeal

on dev help sign in

resolve #27

8ca416aEitan Chatav9 years ago

README.md+3−3

compare with dev

unifiedsplit

@@ -128,13 +128,13 @@ let

128 createTable #users

129 ( serial `As` #id :*

130 (text & notNull) `As` #name :* Nil )

131− ( primaryKey (Column #id :* Nil) `As` #pk_users :* Nil ) >>>

131+ ( primaryKey (#id :* Nil) `As` #pk_users :* Nil ) >>>

132 createTable #emails

133 ( serial `As` #id :*

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

135 text `As` #email :* Nil )

136− ( primaryKey (Column #id :* Nil) `As` #pk_emails :*

136+ ( primaryKey (#id :* Nil) `As` #pk_emails :*

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

137+ foreignKey (#user_id :* Nil) #users (#id :* Nil)

138 OnDeleteCascade OnUpdateCascade `As` #fk_user_id :* Nil )

139:}

140```

squeal-postgresql/exe/Example.hs+3−3

@@ -47,14 +47,14 @@ setup =

47 ( serial `As` #id :*

48 (text & notNull) `As` #name :*

49 (vararray int2 & notNull) `As` #vec :* Nil )

50− ( primaryKey (Column #id :* Nil) `As` #pk_users :* Nil )

50+ ( primaryKey (#id :* Nil) `As` #pk_users :* Nil )

51 >>>

52 createTable #emails

53 ( serial `As` #id :*

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

55 text `As` #email :* Nil )

56− ( primaryKey (Column #id :* Nil) `As` #pk_emails :*

56+ ( primaryKey (#id :* Nil) `As` #pk_emails :*

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

57+ foreignKey (#user_id :* Nil) #users (#id :* Nil)

58 OnDeleteCascade OnUpdateCascade `As` #fk_user_id :* Nil )

60teardown :: Definition Schema '[]

squeal-postgresql/src/Squeal/PostgreSQL.hs+3−3

@@ -67,13 +67,13 @@

67-- createTable #users

68-- ( serial `As` #id :*

69-- (text & notNull) `As` #name :* Nil )

70−-- ( primaryKey (Column #id :* Nil) `As` #pk_users :* Nil ) >>>

70+-- ( primaryKey (#id :* Nil) `As` #pk_users :* Nil ) >>>

71-- createTable #emails

72-- ( serial `As` #id :*

73-- (int & notNull) `As` #user_id :*

74-- text `As` #email :* Nil )

75−-- ( primaryKey (Column #id :* Nil) `As` #pk_emails :*

75+-- ( primaryKey (#id :* Nil) `As` #pk_emails :*

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

76+-- foreignKey (#user_id :* Nil) #users (#id :* Nil)

77-- OnDeleteCascade OnUpdateCascade `As` #fk_user_id :* Nil )

78-- :}

79--

squeal-postgresql/src/Squeal/PostgreSQL/Definition.hs+124−98

@@ -37,12 +37,10 @@ module Squeal.PostgreSQL.Definition

37 , createTable

38 , createTableIfNotExists

39 , TableConstraintExpression (..)

40− , Column (..)

41 , check

40 , check

42 , unique

41 , unique

43 , primaryKey

42 , primaryKey

44 , foreignKey

43 , foreignKey

45− , ForeignKeyed

46 , OnDeleteClause (OnDeleteNoAction, OnDeleteRestrict, OnDeleteCascade)

44 , OnDeleteClause (OnDeleteNoAction, OnDeleteRestrict, OnDeleteCascade)

47 , renderOnDeleteClause

45 , renderOnDeleteClause

48 , OnUpdateClause (OnUpdateNoAction, OnUpdateRestrict, OnUpdateCascade)

46 , OnUpdateClause (OnUpdateNoAction, OnUpdateRestrict, OnUpdateCascade)

@@ -115,13 +113,14 @@ createTable

115 :: ( KnownSymbol table

113 :: ( KnownSymbol table

116 , columns ~ (col ': cols)

114 , columns ~ (col ': cols)

117 , SOP.SListI columns

115 , SOP.SListI columns

118− , SOP.SListI constraints )

116+ , SOP.SListI constraints

117+ , schema1 ~ Create table (constraints :=> columns) schema0 )

119 => Alias table -- ^ the name of the table to add

118 => Alias table -- ^ the name of the table to add

120 -> NP (Aliased TypeExpression) columns

119 -> NP (Aliased TypeExpression) columns

121 -- ^ the names and datatype of each column

120 -- ^ the names and datatype of each column

122− -> NP (Aliased (TableConstraintExpression schema columns)) constraints

121+ -> NP (Aliased (TableConstraintExpression schema1 table)) constraints

123 -- ^ constraints that must hold for the table

122 -- ^ constraints that must hold for the table

124− -> Definition schema (Create table (constraints :=> columns) schema)

123+ -> Definition schema0 schema1

125createTable table columns constraints = UnsafeDefinition $

124createTable table columns constraints = UnsafeDefinition $

126 "CREATE TABLE" <+> renderCreation table columns constraints

125 "CREATE TABLE" <+> renderCreation table columns constraints

127

126

@@ -144,7 +143,7 @@ createTableIfNotExists

144 => Alias table -- ^ the name of the table to add

143 => Alias table -- ^ the name of the table to add

145 -> NP (Aliased TypeExpression) columns

144 -> NP (Aliased TypeExpression) columns

146 -- ^ the names and datatype of each column

145 -- ^ the names and datatype of each column

147− -> NP (Aliased (TableConstraintExpression schema columns)) constraints

146+ -> NP (Aliased (TableConstraintExpression schema table)) constraints

148 -- ^ constraints that must hold for the table

147 -- ^ constraints that must hold for the table

149 -> Definition schema schema

148 -> Definition schema schema

150createTableIfNotExists table columns constraints = UnsafeDefinition $

149createTableIfNotExists table columns constraints = UnsafeDefinition $

@@ -159,7 +158,7 @@ renderCreation

159 => Alias table -- ^ the name of the table to add

158 => Alias table -- ^ the name of the table to add

160 -> NP (Aliased TypeExpression) columns

159 -> NP (Aliased TypeExpression) columns

161 -- ^ the names and datatype of each column

160 -- ^ the names and datatype of each column

162− -> NP (Aliased (TableConstraintExpression schema columns)) constraints

161+ -> NP (Aliased (TableConstraintExpression schema table)) constraints

163 -- ^ constraints that must hold for the table

162 -- ^ constraints that must hold for the table

164 -> ByteString

163 -> ByteString

165renderCreation table columns constraints = renderAlias table

164renderCreation table columns constraints = renderAlias table

@@ -194,43 +193,41 @@ renderCreation table columns constraints = renderAlias table

194-- even if the value came from the default value definition.

193-- even if the value came from the default value definition.

195newtype TableConstraintExpression

194newtype TableConstraintExpression

196 (schema :: TablesType)

195 (schema :: TablesType)

197− (columns :: ColumnsType)

196+ (table :: Symbol)

198 (tableConstraint :: TableConstraint)

197 (tableConstraint :: TableConstraint)

199 = UnsafeTableConstraintExpression

198 = UnsafeTableConstraintExpression

200 { renderTableConstraintExpression :: ByteString }

199 { renderTableConstraintExpression :: ByteString }

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

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

202

201

203−-- | @Column columns column@ is a witness that `column` is in `columns`.

204−data Column

205− (columns :: ColumnsType)

206− (column :: (Symbol,ColumnType))

207− where

208− Column

209− :: Has column columns ty

210− => Alias column

211− -> Column columns (column ::: ty)

212−

213−-- | Render a `Column`.

214−renderColumn :: Column columns column -> ByteString

215−renderColumn (Column column) = renderAlias column

216−

217-- | A `check` constraint is the most generic `TableConstraint` type.

202-- | A `check` constraint is the most generic `TableConstraint` type.

218-- It allows you to specify that the value in a certain column must satisfy

203-- It allows you to specify that the value in a certain column must satisfy

219-- a Boolean (truth-value) expression.

204-- a Boolean (truth-value) expression.

220--

205--

221-- >>> :{

206-- >>> :{

222−-- renderDefinition $

207+-- type Schema = '[

208+-- "tab" ::: '[ "inequality" ::: 'Check '["a","b"]] :=> '[

209+-- "a" ::: 'NoDef :=> 'NotNull 'PGint4,

210+-- "b" ::: 'NoDef :=> 'NotNull 'PGint4

211+-- ]]

212+-- :}

213+--

214+-- >>> :{

215+-- let

216+-- definition :: Definition '[] Schema

223−-- createTable #tab

217+-- definition = createTable #tab

224-- ( (int & notNull) `As` #a :*

218-- ( (int & notNull) `As` #a :*

225-- (int & notNull) `As` #b :* Nil )

219-- (int & notNull) `As` #b :* Nil )

226−-- ( check (Column #a :* Column #b :* Nil) (#a .> #b) `As` #inequality :* Nil )

220+-- ( check (#a :* #b :* Nil) (#a .> #b) `As` #inequality :* Nil )

227-- :}

221-- :}

222+--

223+-- >>> renderDefinition definition

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

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

229check

225check

230− :: NP (Column columns) subcolumns

226+ :: ( Has alias schema table

227+ , HasAll aliases (TableToColumns table) subcolumns )

228+ => NP Alias aliases

231− -> Condition '[table ::: ColumnsToRelation subcolumns] 'Ungrouped '[]

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

232− -- ^ condition to check

233− -> TableConstraintExpression schema columns ('Check (AliasesOf subcolumns))

230+ -> TableConstraintExpression schema alias ('Check aliases)

234check _cols condition = UnsafeTableConstraintExpression $

231check _cols condition = UnsafeTableConstraintExpression $

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

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

236

233

@@ -238,40 +235,62 @@ check _cols condition = UnsafeTableConstraintExpression $

238-- or a group of columns, is unique among all the rows in the table.

235-- or a group of columns, is unique among all the rows in the table.

239--

236--

240-- >>> :{

237-- >>> :{

241−-- renderDefinition $

238+-- type Schema = '[

239+-- "tab" ::: '[ "uq_a_b" ::: 'Unique '["a","b"]] :=> '[

240+-- "a" ::: 'NoDef :=> 'Null 'PGint4,

241+-- "b" ::: 'NoDef :=> 'Null 'PGint4

242+-- ]]

243+-- :}

244+--

245+-- >>> :{

246+-- let

247+-- definition :: Definition '[] Schema

242−-- createTable #tab

248+-- definition = createTable #tab

243-- ( int `As` #a :*

249-- ( int `As` #a :*

244-- int `As` #b :* Nil )

250-- int `As` #b :* Nil )

245−-- ( unique (Column #a :* Column #b :* Nil) `As` #uq_a_b :* Nil )

251+-- ( unique (#a :* #b :* Nil) `As` #uq_a_b :* Nil )

246-- :}

252-- :}

253+--

254+-- >>> renderDefinition definition

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

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

248unique

256unique

249− :: SOP.SListI subcolumns

257+ :: ( Has alias schema table

250− => NP (Column columns) subcolumns

258+ , HasAll aliases (TableToColumns table) subcolumns )

251− -- ^ unique column or group of columns

259+ => NP Alias aliases

252− -> TableConstraintExpression schema columns ('Unique (AliasesOf subcolumns))

260+ -> TableConstraintExpression schema alias ('Unique aliases)

253unique columns = UnsafeTableConstraintExpression $

261unique columns = UnsafeTableConstraintExpression $

254− "UNIQUE" <+> parenthesized (renderCommaSeparated renderColumn columns)

262+ "UNIQUE" <+> parenthesized (commaSeparated (renderAliases columns))

255

263

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

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

257-- can be used as a unique identifier for rows in the table.

265-- can be used as a unique identifier for rows in the table.

258-- This requires that the values be both unique and not null.

266-- This requires that the values be both unique and not null.

259--

267--

260-- >>> :{

268-- >>> :{

261−-- renderDefinition $

269+-- type Schema = '[

270+-- "tab" ::: '[ "pk_id" ::: 'PrimaryKey '["id"]] :=> '[

271+-- "id" ::: 'Def :=> 'NotNull 'PGint4,

272+-- "name" ::: 'NoDef :=> 'NotNull 'PGtext

273+-- ]]

274+-- :}

275+--

276+-- >>> :{

277+-- let

278+-- definition :: Definition '[] Schema

262−-- createTable #tab

279+-- definition = createTable #tab

263-- ( serial `As` #id :*

280-- ( serial `As` #id :*

264-- (text & notNull) `As` #name :* Nil )

281-- (text & notNull) `As` #name :* Nil )

265−-- ( primaryKey (Column #id :* Nil) `As` #pk_id :* Nil )

282+-- ( primaryKey (#id :* Nil) `As` #pk_id :* Nil )

266-- :}

283-- :}

284+--

285+-- >>> renderDefinition definition

267-- "CREATE TABLE \"tab\" (\"id\" serial, \"name\" text NOT NULL, CONSTRAINT \"pk_id\" PRIMARY KEY (\"id\"));"

286-- "CREATE TABLE \"tab\" (\"id\" serial, \"name\" text NOT NULL, CONSTRAINT \"pk_id\" PRIMARY KEY (\"id\"));"

268primaryKey

287primaryKey

269− :: (SOP.SListI subcolumns, AllNotNull subcolumns)

288+ :: ( Has alias schema table

270− => NP (Column columns) subcolumns

289+ , HasAll aliases (TableToColumns table) subcolumns )

271− -- ^ identifying column or group of columns

290+ => NP Alias aliases

272− -> TableConstraintExpression schema columns ('PrimaryKey (AliasesOf subcolumns))

291+ -> TableConstraintExpression schema alias ('PrimaryKey aliases)

273primaryKey columns = UnsafeTableConstraintExpression $

292primaryKey columns = UnsafeTableConstraintExpression $

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

293+ "PRIMARY KEY" <+> parenthesized (commaSeparated (renderAliases columns))

275

294

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

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

277-- (or a group of columns) must match the values appearing in some row of

296-- (or a group of columns) must match the values appearing in some row of

@@ -303,46 +322,41 @@ primaryKey columns = UnsafeTableConstraintExpression $

303-- createTable #users

322-- createTable #users

304-- ( serial `As` #id :*

323-- ( serial `As` #id :*

305-- (text & notNull) `As` #name :* Nil )

324-- (text & notNull) `As` #name :* Nil )

306−-- ( primaryKey (Column #id :* Nil) `As` #pk_users :* Nil ) >>>

325+-- ( primaryKey (#id :* Nil) `As` #pk_users :* Nil ) >>>

307-- createTable #emails

326-- createTable #emails

308-- ( serial `As` #id :*

327-- ( serial `As` #id :*

309-- (int & notNull) `As` #user_id :*

328-- (int & notNull) `As` #user_id :*

310-- text `As` #email :* Nil )

329-- text `As` #email :* Nil )

311−-- ( primaryKey (Column #id :* Nil) `As` #pk_emails :*

330+-- ( primaryKey (#id :* Nil) `As` #pk_emails :*

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

331+-- foreignKey (#user_id :* Nil) #users (#id :* Nil)

313-- OnDeleteCascade OnUpdateCascade `As` #fk_user_id :* Nil )

332-- OnDeleteCascade OnUpdateCascade `As` #fk_user_id :* Nil )

314-- in renderDefinition setup

333-- in renderDefinition setup

315-- :}

334-- :}

316-- "CREATE TABLE \"users\" (\"id\" serial, \"name\" text NOT NULL, CONSTRAINT \"pk_users\" PRIMARY KEY (\"id\")); CREATE TABLE \"emails\" (\"id\" serial, \"user_id\" int NOT NULL, \"email\" text, CONSTRAINT \"pk_emails\" PRIMARY KEY (\"id\"), CONSTRAINT \"fk_user_id\" FOREIGN KEY (\"user_id\") REFERENCES \"users\" (\"id\") ON DELETE CASCADE ON UPDATE CASCADE);"

335-- "CREATE TABLE \"users\" (\"id\" serial, \"name\" text NOT NULL, CONSTRAINT \"pk_users\" PRIMARY KEY (\"id\")); CREATE TABLE \"emails\" (\"id\" serial, \"user_id\" int NOT NULL, \"email\" text, CONSTRAINT \"pk_emails\" PRIMARY KEY (\"id\"), CONSTRAINT \"fk_user_id\" FOREIGN KEY (\"user_id\") REFERENCES \"users\" (\"id\") ON DELETE CASCADE ON UPDATE CASCADE);"

317foreignKey

336foreignKey

318− :: ForeignKeyed schema table reftable subcolumns refsubcolumns

337+ :: ( Has child schema table

338+ , Has parent schema reftable

339+ , HasAll columns (TableToColumns table) tys

340+ , HasAll refcolumns (TableToColumns reftable) reftys

341+ , SOP.AllZip SamePGType tys reftys )

319− => NP (Column columns) subcolumns

342+ => NP Alias columns

320 -- ^ column or columns in the table

343 -- ^ column or columns in the table

321− -> Alias table

344+ -> Alias parent

322 -- ^ reference table

345 -- ^ reference table

323− -> NP (Column (TableToColumns reftable)) refsubcolumns

346+ -> NP Alias refcolumns

324 -- ^ reference column or columns in the reference table

347 -- ^ reference column or columns in the reference table

325 -> OnDeleteClause

348 -> OnDeleteClause

326 -- ^ what to do when reference is deleted

349 -- ^ what to do when reference is deleted

327 -> OnUpdateClause

350 -> OnUpdateClause

328 -- ^ what to do when reference is updated

351 -- ^ what to do when reference is updated

329− -> TableConstraintExpression schema columns

352+ -> TableConstraintExpression schema child

330− ('ForeignKey (AliasesOf subcolumns) table (AliasesOf refsubcolumns))

353+ ('ForeignKey columns parent refcolumns)

331−foreignKey columns reftable refcolumns onDelete onUpdate =

332− UnsafeTableConstraintExpression $

354+foreignKey keys parent refs ondel onupd = UnsafeTableConstraintExpression $

333− "FOREIGN KEY" <+> parenthesized (renderCommaSeparated renderColumn columns)

355+ "FOREIGN KEY" <+> parenthesized (commaSeparated (renderAliases keys))

334− <+> "REFERENCES" <+> renderAlias reftable

356+ <+> "REFERENCES" <+> renderAlias parent

335− <+> parenthesized (renderCommaSeparated renderColumn refcolumns)

357+ <+> parenthesized (commaSeparated (renderAliases refs))

336− <+> renderOnDeleteClause onDelete

358+ <+> renderOnDeleteClause ondel

337− <+> renderOnUpdateClause onUpdate

359+ <+> renderOnUpdateClause onupd

338−

339−-- | A type synonym for constraints on a table with a foreign key.

340−type ForeignKeyed schema table reftable subcolumns refsubcolumns

341− = ( Has table schema reftable

342− , SameTypes subcolumns refsubcolumns

343− , AllNotNull subcolumns

344− , SOP.SListI subcolumns

345− , SOP.SListI refsubcolumns )

346

360

347-- | `OnDeleteClause` indicates what to do with rows that reference a deleted row.

361-- | `OnDeleteClause` indicates what to do with rows that reference a deleted row.

348data OnDeleteClause

362data OnDeleteClause

@@ -403,10 +417,10 @@ ALTER statements

403

417

404-- | `alterTable` changes the definition of a table from the schema.

418-- | `alterTable` changes the definition of a table from the schema.

405alterTable

419alterTable

406− :: Has tab schema table0

420+ :: KnownSymbol alias

407− => Alias tab -- ^ table to alter

421+ => Alias alias -- ^ table to alter

408− -> AlterTable schema table0 table1 -- ^ alteration to perform

422+ -> AlterTable alias table schema -- ^ alteration to perform

409− -> Definition schema (Alter tab schema table1)

423+ -> Definition schema (Alter alias table schema)

410alterTable table alteration = UnsafeDefinition $

424alterTable table alteration = UnsafeDefinition $

411 "ALTER TABLE"

425 "ALTER TABLE"

412 <+> renderAlias table

426 <+> renderAlias table

@@ -429,9 +443,9 @@ alterTableRename table0 table1 = UnsafeDefinition $

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

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

430-- of a table.

444-- of a table.

431newtype AlterTable

445newtype AlterTable

446+ (alias :: Symbol)

447+ (table :: TableType)

432− (schema :: TablesType)

448+ (schema :: TablesType) =

433− (table0 :: TableType)

434− (table1 :: TableType) =

435 UnsafeAlterTable {renderAlterTable :: ByteString}

449 UnsafeAlterTable {renderAlterTable :: ByteString}

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

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

437

451

@@ -442,17 +456,19 @@ newtype AlterTable

442-- definition :: Definition

456-- definition :: Definition

443-- '["tab" ::: '[] :=> '["col" ::: 'NoDef :=> 'NotNull 'PGint4]]

457-- '["tab" ::: '[] :=> '["col" ::: 'NoDef :=> 'NotNull 'PGint4]]

444-- '["tab" ::: '["positive" ::: Check '["col"]] :=> '["col" ::: 'NoDef :=> 'NotNull 'PGint4]]

458-- '["tab" ::: '["positive" ::: Check '["col"]] :=> '["col" ::: 'NoDef :=> 'NotNull 'PGint4]]

445−-- definition = alterTable #tab (addConstraint #positive (check (Column #col :* Nil) (#col .> 0)))

459+-- definition = alterTable #tab (addConstraint #positive (check (#col :* Nil) (#col .> 0)))

446-- in renderDefinition definition

460-- in renderDefinition definition

447-- :}

461-- :}

448-- "ALTER TABLE \"tab\" ADD CONSTRAINT \"positive\" CHECK ((\"col\" > 0));"

462-- "ALTER TABLE \"tab\" ADD CONSTRAINT \"positive\" CHECK ((\"col\" > 0));"

449addConstraint

463addConstraint

450− :: KnownSymbol alias

464+ :: ( KnownSymbol alias

465+ , Has tab schema table0

466+ , table0 ~ (constraints :=> columns)

467+ , table1 ~ (Create alias constraint constraints :=> columns) )

451 => Alias alias

468 => Alias alias

452− -> TableConstraintExpression schema columns constraint

469+ -> TableConstraintExpression schema tab constraint

453 -- ^ constraint to add

470 -- ^ constraint to add

454− -> AlterTable schema (constraints :=> columns)

471+ -> AlterTable tab table1 schema

455− (Create alias constraint constraints :=> columns)

456addConstraint alias constraint = UnsafeAlterTable $

472addConstraint alias constraint = UnsafeAlterTable $

457 "ADD" <+> "CONSTRAINT" <+> renderAlias alias

473 "ADD" <+> "CONSTRAINT" <+> renderAlias alias

458 <+> renderTableConstraintExpression constraint

474 <+> renderTableConstraintExpression constraint

@@ -469,12 +485,13 @@ addConstraint alias constraint = UnsafeAlterTable $

469-- :}

485-- :}

470-- "ALTER TABLE \"tab\" DROP CONSTRAINT \"positive\";"

486-- "ALTER TABLE \"tab\" DROP CONSTRAINT \"positive\";"

471dropConstraint

487dropConstraint

472− :: KnownSymbol constraint

488+ :: ( KnownSymbol constraint

489+ , Has tab schema table0

490+ , table0 ~ (constraints :=> columns)

491+ , table1 ~ (Drop constraint constraints :=> columns) )

473 => Alias constraint

492 => Alias constraint

474 -- ^ constraint to drop

493 -- ^ constraint to drop

475− -> AlterTable schema

494+ -> AlterTable tab table1 schema

476− (constraints :=> columns)

477− (Drop constraint constraints :=> columns)

478dropConstraint constraint = UnsafeAlterTable $

495dropConstraint constraint = UnsafeAlterTable $

479 "DROP" <+> "CONSTRAINT" <+> renderAlias constraint

496 "DROP" <+> "CONSTRAINT" <+> renderAlias constraint

480

497

@@ -507,11 +524,13 @@ class AddColumn ty where

507 -- :}

524 -- :}

508 -- "ALTER TABLE \"tab\" ADD COLUMN \"col2\" text;"

525 -- "ALTER TABLE \"tab\" ADD COLUMN \"col2\" text;"

509 addColumn

526 addColumn

510− :: KnownSymbol column

527+ :: ( KnownSymbol column

528+ , Has tab schema table0

529+ , table0 ~ (constraints :=> columns)

530+ , table1 ~ (constraints :=> Create column ty columns) )

511 => Alias column -- ^ column to add

531 => Alias column -- ^ column to add

512 -> TypeExpression ty -- ^ type of the new column

532 -> TypeExpression ty -- ^ type of the new column

513− -> AlterTable schema (constraints :=> columns)

533+ -> AlterTable tab table1 schema

514− (constraints :=> Create column ty columns)

515 addColumn column ty = UnsafeAlterTable $

534 addColumn column ty = UnsafeAlterTable $

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

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

517instance {-# OVERLAPPING #-} AddColumn ('Def :=> ty)

536instance {-# OVERLAPPING #-} AddColumn ('Def :=> ty)

@@ -534,11 +553,12 @@ instance {-# OVERLAPPABLE #-} AddColumn ('NoDef :=> 'Null ty)

534-- :}

553-- :}

535-- "ALTER TABLE \"tab\" DROP COLUMN \"col2\";"

554-- "ALTER TABLE \"tab\" DROP COLUMN \"col2\";"

536dropColumn

555dropColumn

537− :: KnownSymbol column

556+ :: ( KnownSymbol column

557+ , Has tab schema table0

558+ , table0 ~ (constraints :=> columns)

559+ , table1 ~ (constraints :=> Drop column columns) )

538 => Alias column -- ^ column to remove

560 => Alias column -- ^ column to remove

539− -> AlterTable schema

561+ -> AlterTable tab table1 schema

540− (constraints :=> columns)

541− (DropIfConstraintsInvolve column constraints :=> Drop column columns)

542dropColumn column = UnsafeAlterTable $

562dropColumn column = UnsafeAlterTable $

543 "DROP COLUMN" <+> renderAlias column

563 "DROP COLUMN" <+> renderAlias column

544

564

@@ -554,21 +574,27 @@ dropColumn column = UnsafeAlterTable $

554-- :}

574-- :}

555-- "ALTER TABLE \"tab\" RENAME COLUMN \"foo\" TO \"bar\";"

575-- "ALTER TABLE \"tab\" RENAME COLUMN \"foo\" TO \"bar\";"

556renameColumn

576renameColumn

557− :: (KnownSymbol column0, KnownSymbol column1)

577+ :: ( KnownSymbol column0

578+ , KnownSymbol column1

579+ , Has tab schema table0

580+ , table0 ~ (constraints :=> columns)

581+ , table1 ~ (constraints :=> Rename column0 column1 columns) )

558 => Alias column0 -- ^ column to rename

582 => Alias column0 -- ^ column to rename

559 -> Alias column1 -- ^ what to rename the column

583 -> Alias column1 -- ^ what to rename the column

560− -> AlterTable schema (constraints :=> columns)

584+ -> AlterTable tab table1 schema

561− (constraints :=> Rename column0 column1 columns)

562renameColumn column0 column1 = UnsafeAlterTable $

585renameColumn column0 column1 = UnsafeAlterTable $

563 "RENAME COLUMN" <+> renderAlias column0 <+> "TO" <+> renderAlias column1

586 "RENAME COLUMN" <+> renderAlias column0 <+> "TO" <+> renderAlias column1

564

587

565-- | An `alterColumn` alters a single column.

588-- | An `alterColumn` alters a single column.

566alterColumn

589alterColumn

590+ :: ( KnownSymbol column

591+ , Has tab schema table0

592+ , table0 ~ (constraints :=> columns)

567− :: (KnownSymbol column, Has column columns ty0)

593+ , Has column columns ty0

594+ , tables1 ~ (constraints :=> Alter column ty1 columns))

568 => Alias column -- ^ column to alter

595 => Alias column -- ^ column to alter

569 -> AlterColumn ty0 ty1 -- ^ alteration to perform

596 -> AlterColumn ty0 ty1 -- ^ alteration to perform

570− -> AlterTable schema (constraints :=> columns)

597+ -> AlterTable tab table1 schema

571− (constraints :=> Alter column columns ty1)

572alterColumn column alteration = UnsafeAlterTable $

598alterColumn column alteration = UnsafeAlterTable $

573 "ALTER COLUMN" <+> renderAlias column <+> renderAlterColumn alteration

599 "ALTER COLUMN" <+> renderAlias column <+> renderAlterColumn alteration

574

600

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

@@ -38,7 +38,7 @@ let

38 createTable #users

39 ( serial `As` #id :*

40 (text & notNull) `As` #name :* Nil )

41− ( primaryKey (Column #id :* Nil) `As` #pk_users :* Nil )

41+ ( primaryKey (#id :* Nil) `As` #pk_users :* Nil )

42 , down = void . define $ dropTable #users

43 }

44:}

@@ -54,8 +54,8 @@ let

54 ( serial `As` #id :*

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

56 text `As` #email :* Nil )

57− ( primaryKey (Column #id :* Nil) `As` #pk_emails :*

57+ ( primaryKey (#id :* Nil) `As` #pk_emails :*

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

58+ foreignKey (#user_id :* Nil) #users (#id :* Nil)

59 OnDeleteCascade OnUpdateCascade `As` #fk_user_id :* Nil )

60 , down = void . define $ dropTable #emails

61 }

@@ -290,7 +290,7 @@ createMigrations =

290 ( (text & notNull) `As` #name :*

291 (timestampWithTimeZone & notNull & default_ currentTimestamp)

292 `As` #executed_at :* Nil )

293− ( unique (Column #name :* Nil) `As` #migrations_unique_name :* Nil )

293+ ( unique (#name :* Nil) `As` #migrations_unique_name :* Nil )

294

295-- | Inserts a `Migration` into the `MigrationsTable`

296insertMigration

squeal-postgresql/src/Squeal/PostgreSQL/Schema.hs+40−10

@@ -31,6 +31,7 @@ A type-level DSL for kinds of PostgreSQL types, constraints, and aliases.

31 , TypeInType

32 , TypeOperators

33 , UndecidableInstances

34+ , UndecidableSuperClasses

34#-}

35#-}

36module Squeal.PostgreSQL.Schema

37module Squeal.PostgreSQL.Schema

@@ -59,11 +60,13 @@ module Squeal.PostgreSQL.Schema

59 , (:::)

60 , (:::)

60 , Alias (Alias)

61 , Alias (Alias)

61 , renderAlias

62 , renderAlias

63+ , renderAliases

62 , Aliased (As)

64 , Aliased (As)

63 , renderAliasedAs

65 , renderAliasedAs

64 , AliasesOf

66 , AliasesOf

65 , Has

67 , Has

66 , HasUnique

68 , HasUnique

69+ , HasAll

67 , IsLabel (..)

70 , IsLabel (..)

68 , IsQualified (..)

71 , IsQualified (..)

69 -- * Type Families

72 -- * Type Families

@@ -79,6 +82,7 @@ module Squeal.PostgreSQL.Schema

79 , PGFloating

82 , PGFloating

80 , PGTypeOf

83 , PGTypeOf

81 , SameTypes

84 , SameTypes

85+ , SamePGType

82 , AllNotNull

86 , AllNotNull

83 , NotAllNull

87 , NotAllNull

84 , NullifyType

88 , NullifyType

@@ -98,16 +102,16 @@ module Squeal.PostgreSQL.Schema

102

99import Control.DeepSeq

103import Control.DeepSeq

100import Data.ByteString

104import Data.ByteString

101−import Data.Monoid

105+import Data.Monoid hiding (All)

102import Data.String

106import Data.String

103import Data.Word

107import Data.Word

104import Data.Type.Bool

108import Data.Type.Bool

105−import Generics.SOP (AllZip)

106−import GHC.Generics (Generic)

107import GHC.Exts

109import GHC.Exts

108import GHC.OverloadedLabels

110import GHC.OverloadedLabels

109import GHC.TypeLits

111import GHC.TypeLits

110

112

113+import qualified GHC.Generics as GHC

114+import qualified Generics.SOP as SOP

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

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

112

116

113import Squeal.PostgreSQL.Render

117import Squeal.PostgreSQL.Render

@@ -355,7 +359,7 @@ instance {-# OVERLAPPABLE #-}

355-- >>> #foobar :: Alias "foobar"

359-- >>> #foobar :: Alias "foobar"

356-- Alias

360-- Alias

357data Alias (alias :: Symbol) = Alias

361data Alias (alias :: Symbol) = Alias

358− deriving (Eq,Generic,Ord,Show,NFData)

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

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

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

360 fromLabel = Alias

364 fromLabel = Alias

361

365

@@ -364,6 +368,14 @@ instance alias1 ~ alias2 => IsLabel alias1 (Alias alias2) where

364renderAlias :: KnownSymbol alias => Alias alias -> ByteString

368renderAlias :: KnownSymbol alias => Alias alias -> ByteString

365renderAlias = doubleQuoted . fromString . symbolVal

369renderAlias = doubleQuoted . fromString . symbolVal

366

370

371+-- | >>> import Generics.SOP (NP(..))

372+-- >>> renderAliases (#jimbob :* #kandi :* Nil)

373+-- ["\"jimbob\"","\"kandi\""]

374+renderAliases

375+ :: SOP.All KnownSymbol aliases => SOP.NP Alias aliases -> [ByteString]

376+renderAliases = SOP.hcollapse

377+ . SOP.hcmap (SOP.Proxy @KnownSymbol) (SOP.K . renderAlias)

378+

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

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

368-- version of `:::`.

380-- version of `:::`.

369--

381--

@@ -411,6 +423,18 @@ instance {-# OVERLAPPING #-} KnownSymbol alias

411instance {-# OVERLAPPABLE #-} (KnownSymbol alias, Has alias fields field)

423instance {-# OVERLAPPABLE #-} (KnownSymbol alias, Has alias fields field)

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

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

413

425

426+class

427+ ( SOP.All KnownSymbol aliases

428+ ) => HasAll

429+ (aliases :: [Symbol])

430+ (fields :: [(Symbol,kind)])

431+ (subfields :: [(Symbol,kind)])

432+ | aliases fields -> subfields where

433+instance {-# OVERLAPPING #-} HasAll '[] fields '[]

434+instance {-# OVERLAPPABLE #-}

435+ (Has alias fields field, HasAll aliases fields subfields)

436+ => HasAll (alias ': aliases) fields (alias ::: field ': subfields)

437+

414-- | Analagous to `IsLabel`, the constraint

438-- | Analagous to `IsLabel`, the constraint

415-- `IsQualified` defines `!` for a column alias qualified

439-- `IsQualified` defines `!` for a column alias qualified

416-- by a table alias.

440-- by a table alias.

@@ -456,6 +480,12 @@ type family SameTypes (columns0 :: ColumnsType) (columns1 :: ColumnsType)

456 SameTypes (column0 ::: def0 :=> ty0 ': columns0) (column1 ::: def1 :=> ty1 ': columns1)

480 SameTypes (column0 ::: def0 :=> ty0 ': columns0) (column1 ::: def1 :=> ty1 ': columns1)

457 = (ty0 ~ ty1, SameTypes columns0 columns1)

481 = (ty0 ~ ty1, SameTypes columns0 columns1)

458

482

483+class SamePGType

484+ (ty0 :: (Symbol,ColumnType)) (ty1 :: (Symbol,ColumnType)) where

485+instance ty0 ~ ty1 => SamePGType

486+ (alias0 ::: def0 :=> nullity0 ty0)

487+ (alias1 ::: def1 :=> nullity1 ty1)

488+

459-- | `AllNotNull` is a constraint that proves a `ColumnsType` has no @NULL@s.

489-- | `AllNotNull` is a constraint that proves a `ColumnsType` has no @NULL@s.

460type family AllNotNull (columns :: ColumnsType) :: Constraint where

490type family AllNotNull (columns :: ColumnsType) :: Constraint where

461 AllNotNull '[] = ()

491 AllNotNull '[] = ()

@@ -506,12 +536,12 @@ type family Drop alias xs where

506 Drop alias ((alias ::: x) ': xs) = xs

536 Drop alias ((alias ::: x) ': xs) = xs

507 Drop alias (x ': xs) = x ': Drop alias xs

537 Drop alias (x ': xs) = x ': Drop alias xs

508

538

509−-- | @Alter alias xs x@ replaces the type associated with an @alias@ in @xs@

539+-- | @Alter alias x xs@ replaces the type associated with an @alias@ in @xs@

510-- with the type `x` and is used in `Squeal.PostgreSQL.Definition.alterTable`

540-- with the type `x` and is used in `Squeal.PostgreSQL.Definition.alterTable`

511-- and `Squeal.PostgreSQL.Definition.alterColumn`.

541-- and `Squeal.PostgreSQL.Definition.alterColumn`.

512−type family Alter alias xs x where

542+type family Alter alias x xs where

513− Alter alias ((alias ::: x0) ': xs) x1 = (alias ::: x1) ': xs

543+ Alter alias x1 (alias ::: x0 ': xs) = alias ::: x1 ': xs

514− Alter alias (x0 ': xs) x1 = x0 ': Alter alias xs x1

544+ Alter alias x1 (x0 ': xs) = x0 ': Alter alias x1 xs

515

545

516-- type family AddConstraint constraint ty where

546-- type family AddConstraint constraint ty where

517-- AddConstraint constraint (constraints :=> ty)

547-- AddConstraint constraint (constraints :=> ty)

@@ -548,11 +578,11 @@ type family SameFields

548 SameFields

578 SameFields

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

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

550 columns

580 columns

551− = AllZip SameField fields columns

581+ = SOP.AllZip SameField fields columns

552 SameFields

582 SameFields

553 ('Type.Newtype _module _datatype ('Type.Record _constructor fields))

583 ('Type.Newtype _module _datatype ('Type.Record _constructor fields))

554 columns

584 columns

555− = AllZip SameField fields columns

585+ = SOP.AllZip SameField fields columns

556

586

557-- | Check if a `TableConstraint` involves a column

587-- | Check if a `TableConstraint` involves a column

558type family ConstraintInvolves column constraint where

588type family ConstraintInvolves column constraint where