8bf3c62 · squeal · git.iko.soy

git.iko.soy/squeal

table constraints worked thru!

commit8bf3c623cd72a4ccc50cbdd3121a7334715f2737 authorEitan Chatav <eitan.chatav@gmail.com> dateFri 8 Dec 2017, 11:24 (9 years ago) parentb4ef11e

5 files changed+65−49

compare with dev

unifiedsplit

squeal-postgresql/src/Squeal/PostgreSQL/Definition.hs+26−28 squeal-postgresql/src/Squeal/PostgreSQL/Manipulation.hs+6−5 squeal-postgresql/src/Squeal/PostgreSQL/PQ.hs+4−4 squeal-postgresql/src/Squeal/PostgreSQL/Query.hs+3−3 squeal-postgresql/src/Squeal/PostgreSQL/Schema.hs+26−9

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

@@ -12,6 +12,7 @@ Squeal data definition language.

1212 DataKinds

1313 , DeriveDataTypeable

1414 , DeriveGeneric

15+ , FlexibleContexts

1516 , GADTs

1617 , GeneralizedNewtypeDeriving

1718 , KindSignatures

@@ -43,12 +44,12 @@ module Squeal.PostgreSQL.Definition

4344 -- * Alter

4445 , alterTable

4546 , alterTableRename

46− , alterTableAddConstraint

47+ , addConstraint

4748 , AlterTable (UnsafeAlterTable, renderAlterTable)

4849 , addColumnDefault

4950 , addColumnNull

5051 , dropColumn

51− , dropColumnCascade

52+ -- , dropColumnCascade

5253 , renameColumn

5354 , alterColumn

5455 , AlterColumn (UnsafeAlterColumn, renderAlterColumn)

@@ -107,6 +108,7 @@ CREATE statements

107108createTable

108109 :: ( KnownSymbol tab

109110 , SOP.SListI columns

111+ , SOP.SListI constraints

110112 , table ~ (constraints :=> (column ': columns)))

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

112114 -> NP (Aliased TypeExpression) (column ': columns)

@@ -118,16 +120,12 @@ createTable table columns constraints = UnsafeDefinition $

118120 "CREATE TABLE" <+> renderAlias table

119121 <+> parenthesized

120122 ( renderCommaSeparated renderColumnDef columns

121− <> renderConstraints constraints )

123+ <> renderCommaSeparated renderTableConstraint constraints )

122124 <> ";"

123125 where

124126 renderColumnDef :: Aliased TypeExpression x -> ByteString

125127 renderColumnDef (ty `As` column) =

126128 renderAlias column <+> renderTypeExpression ty

127− renderConstraints :: [TableConstraint schema columns] -> ByteString

128− renderConstraints = \case

129− [] -> ""

130− _ -> ", " <> commaSeparated (renderTableConstraint <$> constraints)

131129

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

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

@@ -240,14 +238,14 @@ primaryKey columns = UnsafeTableConstraint $

240238-- :}

241239-- "CREATE TABLE users (id serial, username text NOT NULL, PRIMARY KEY (id)); CREATE TABLE emails (id serial, userid integer NOT NULL, email text NOT NULL, PRIMARY KEY (id), FOREIGN KEY (userid) REFERENCES users (id) ON DELETE CASCADE ON UPDATE RESTRICT);"

242240foreignKey

243− :: ( {-(reftable ::: refcolumns) `In` schema

244− , -}SameTypes subcolumns refsubcolumns

241+ :: ( HasTable tab (UnconstrainOver schema) refcolumns

242+ , SameTypes subcolumns refsubcolumns

245243 , AllNotNull subcolumns

246244 , SOP.SListI subcolumns

247245 , SOP.SListI refsubcolumns)

248246 => NP (Column columns) subcolumns

249247 -- ^ column or columns in the table

250− -> Alias reftable

248+ -> Alias tab

251249 -- ^ reference table

252250 -> NP (Column refcolumns) refsubcolumns

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

@@ -256,7 +254,7 @@ foreignKey

256254 -> OnUpdateClause

257255 -- ^ what to do when reference is updated

258256 -> TableConstraint schema columns

259− ('ForeignKey subcolumns reftable refsubcolumns)

257+ ('ForeignKey subcolumns tab refsubcolumns)

260258foreignKey columns reftable refcolumns onDelete onUpdate =

261259 UnsafeTableConstraint $

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

@@ -324,7 +322,7 @@ ALTER statements

324322

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

326324alterTable

327− :: (tab ::: table0) `In` schema

325+ :: (KnownSymbol tab, (tab ::: table0) `In` schema)

328326 => Alias tab -- ^ table to alter

329327 -> AlterTable schema table0 table1 -- ^ alteration to perform

330328 -> Definition schema (Alter tab schema table1)

@@ -368,11 +366,10 @@ alterTableRename table0 table1 = UnsafeDefinition $

368366-- <+> "ADD" <+> renderTableConstraint constraint <> ";"

369367

370368addConstraint

371− :: ( table `In` schema

372− , table ~ (tab ::: (constraints :=> columns)))

369+ :: (tab ::: table) `In` schema

373370 => Alias tab

374371 -> TableConstraint schema columns constraint

375− -> AlterTable table (tab ::: AddConstraint constraint constraints columns)

372+ -> AlterTable schema table (AddConstraint constraint table)

376373addConstraint = undefined

377374

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

@@ -402,8 +399,8 @@ newtype AlterTable

402399addColumnDefault

403400 :: (KnownSymbol column, 'Default `In` constraints)

404401 => Alias column -- ^ column to add

405− -> TypeExpression '(constraints, ty) -- ^ type of the new column

406− -> AlterTable schema columns (Create column '(constraints, ty) columns)

402+ -> TypeExpression (constraints :=> ty) -- ^ type of the new column

403+ -> AlterTable schema table (Add column (constraints :=> ty) table)

407404addColumnDefault column ty = UnsafeAlterTable $

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

409406

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

424421addColumnNull

425422 :: KnownSymbol column

426423 => Alias column -- ^ column to add

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

428− -> AlterTable schema columns (Create column '( '[], ('Null ty)) columns)

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

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

429426addColumnNull column ty = UnsafeAlterTable $

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

431428

@@ -448,7 +445,7 @@ addColumnNull column ty = UnsafeAlterTable $

448445dropColumn

449446 :: KnownSymbol column

450447 => Alias column -- ^ column to remove

451− -> AlterTable schema columns (Drop column columns)

448+ -> AlterTable schema ('[] :=> columns) ('[] :=> Drop column columns)

452449dropColumn column = UnsafeAlterTable $

453450 "DROP COLUMN" <+> renderAlias column

454451

@@ -466,12 +463,12 @@ dropColumn column = UnsafeAlterTable $

466463-- in renderDefinition definition

467464-- :}

468465-- "ALTER TABLE tab DROP COLUMN col2 CASCADE;"

469−dropColumnCascade

470− :: KnownSymbol column

471− => Alias column -- ^ column to remove

472− -> AlterTable schema columns (Drop column columns)

473−dropColumnCascade column = UnsafeAlterTable $

474− "DROP COLUMN" <+> renderAlias column <+> "CASCADE"

466+-- dropColumnCascade

467+-- :: KnownSymbol column

468+-- => Alias column -- ^ column to remove

469+-- -> AlterTable schema columns (Drop column columns)

470+-- dropColumnCascade column = UnsafeAlterTable $

471+-- "DROP COLUMN" <+> renderAlias column <+> "CASCADE"

475472

476473-- | A `renameColumn` renames a column.

477474--

@@ -488,7 +485,8 @@ renameColumn

488485 :: (KnownSymbol column0, KnownSymbol column1)

489486 => Alias column0

490487 -> Alias column1

491− -> AlterTable schema columns (Rename column0 column1 columns)

488+ -> AlterTable schema ('[] :=> columns)

489+ ('[] :=> Rename column0 column1 columns)

492490renameColumn column0 column1 = UnsafeAlterTable $

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

494492

@@ -497,7 +495,7 @@ alterColumn

497495 :: (KnownSymbol column, HasColumn column columns ty0)

498496 => Alias column -- ^ column to alter

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

500− -> AlterTable schema columns (Alter column columns ty1)

498+ -> AlterTable schema ('[] :=> columns) ('[] :=> Alter column columns ty1)

501499alterColumn column alteration = UnsafeAlterTable $

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

503501

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

@@ -12,6 +12,7 @@ Squeal data manipulation language.

1212 DataKinds

1313 , DeriveDataTypeable

1414 , DeriveGeneric

15+ , FlexibleContexts

1516 , GADTs

1617 , GeneralizedNewtypeDeriving

1718 , KindSignatures

@@ -59,7 +60,7 @@ import Squeal.PostgreSQL.Schema

5960-- `deleteFrom`. A `Query` is also considered a `Manipulation` even though

6061-- it does not modify data.

6162newtype Manipulation

62− (schema :: RelationType)

63+ (schema :: SchemaType)

6364 (params :: [ColumnType])

6465 (columns :: ColumnsType)

6566 = UnsafeManipulation { renderManipulation :: ByteString }

@@ -177,7 +178,7 @@ in renderManipulation manipulation

177178"INSERT INTO tab (col1, col2) VALUES (2, 4), (6, 8) ON CONFLICT DO UPDATE SET col1 = 2 WHERE (col1 = col2) RETURNING (col1 + col2) AS sum;"

178179-}

179180insertInto

180− :: (SOP.SListI columns, SOP.SListI results, HasTable table schema columns)

181+ :: (SOP.SListI columns, SOP.SListI results, HasTable table (UnconstrainOver schema) columns)

181182 => Alias table -- ^ table to insert into

182183 -> ValuesClause schema params columns -- ^ values to insert

183184 -> ConflictClause columns params

@@ -193,7 +194,7 @@ insertInto table insert conflict returning = UnsafeManipulation $

193194-- | A `ValuesClause` lets you insert either values, free `Expression`s,

194195-- or the result of a `Query`.

195196data ValuesClause

196− (schema :: RelationType)

197+ (schema :: SchemaType)

197198 (params :: [ColumnType])

198199 (columns :: ColumnsType)

199200 = Values

@@ -301,7 +302,7 @@ UPDATE statements

301302-- :}

302303-- "UPDATE tab SET col1 = 2 WHERE (col1 <> col2);"

303304update

304− :: (HasTable table schema columns, SOP.SListI columns, SOP.SListI results)

305+ :: (HasTable table (UnconstrainOver schema) columns, SOP.SListI columns, SOP.SListI results)

305306 => Alias table -- ^ table to update

306307 -> NP (Aliased (UpdateExpression columns params)) columns

307308 -- ^ modified values to replace old values

@@ -356,7 +357,7 @@ DELETE statements

356357-- :}

357358-- "DELETE FROM tab WHERE (col1 = col2) RETURNING *;"

358359deleteFrom

359− :: (SOP.SListI results, HasTable table schema columns)

360+ :: (SOP.SListI results, HasTable table (UnconstrainOver schema) columns)

360361 => Alias table -- ^ table to delete from

361362 -> Condition '[table ::: columns] 'Ungrouped params

362363 -- ^ condition under which to delete a row

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

@@ -100,8 +100,8 @@ import qualified Control.Monad.Trans.RWS.Lazy as Lazy

100100import qualified Control.Monad.Trans.RWS.Strict as Strict

101101

102102-- | A `Connection` consists of a `Database.PostgreSQL.LibPQ`

103−-- `Database.PastgreSQL.LibPQ.Connection` and a phantom `RelationType`

104−newtype Connection (schema :: RelationType) =

103+-- `Database.PastgreSQL.LibPQ.Connection` and a phantom `SchemaType`

104+newtype Connection (schema :: SchemaType) =

105105 Connection { unConnection :: LibPQ.Connection }

106106

107107{- | Makes a new connection to the database server.

@@ -153,8 +153,8 @@ withConnection connString action = do

153153-- | We keep track of the schema via an Atkey indexed state monad transformer,

154154-- `PQ`.

155155newtype PQ

156− (schema0 :: RelationType)

157− (schema1 :: RelationType)

156+ (schema0 :: SchemaType)

157+ (schema1 :: SchemaType)

158158 (m :: Type -> Type)

159159 (x :: Type) =

160160 PQ { runPQ :: Connection schema0 -> m (x, Connection schema1) }

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

@@ -257,7 +257,7 @@ in renderQuery query

257257-}

258258

259259newtype Query

260− (schema :: RelationType)

260+ (schema :: SchemaType)

261261 (params :: [ColumnType])

262262 (columns :: ColumnsType)

263263 = UnsafeQuery { renderQuery :: ByteString }

@@ -419,7 +419,7 @@ Table Expressions

419419-- to a table on disk, a so-called base table, but more complex expressions

420420-- can be used to modify or combine base tables in various ways.

421421data TableExpression

422− (schema :: RelationType)

422+ (schema :: SchemaType)

423423 (params :: [ColumnType])

424424 (tables :: RelationType)

425425 (grouping :: Grouping)

@@ -612,7 +612,7 @@ their placement in SQL.

612612-}

613613data FromClause schema params tables where

614614 Table

615− :: Aliased (Table schema) table

615+ :: Aliased (Table (UnconstrainOver schema)) table

616616 -> FromClause schema params '[table]

617617 Subquery

618618 :: Aliased (Query schema params) table

squeal-postgresql/src/Squeal/PostgreSQL/Schema.hs+26−9

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

6565 , NullifyTables

6666 , Join

6767 , Create

68+ , Add

6869 , Drop

6970 , Alter

7071 , Rename

@@ -74,6 +75,7 @@ module Squeal.PostgreSQL.Schema

7475 -- * PostgreSQL Constraints

7576 , (:=>)

7677 , Unconstrain

78+ , UnconstrainOver

7779 , ColumnConstraint (..)

7880 -- , DropDefault

7981 -- , DropDefaultList

@@ -86,6 +88,8 @@ import Control.DeepSeq

8688import Data.ByteString

8789import Data.Monoid

8890import Data.String

91+import Data.Type.Bool

92+import Data.Type.Equality

8993import Data.Type.Set

9094import Generics.SOP (AllZip)

9195import GHC.Generics (Generic)

@@ -148,6 +152,11 @@ type SchemaType = [(Symbol,TableType)]

148152type family Unconstrain (ty :: ([constraint],kind)) :: kind where

149153 Unconstrain '(constraints,ty) = ty

150154

155+type family UnconstrainOver (tys :: SchemaType) :: RelationType where

156+ UnconstrainOver '[] = '[]

157+ UnconstrainOver ((alias ::: x) ': xs) =

158+ (alias ::: Unconstrain x) ': UnconstrainOver xs

159+

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

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

153162-- for typesafe aggregation

@@ -299,6 +308,9 @@ type family Create alias x xs where

299308 Create alias x '[] = '[alias ::: x]

300309 Create alias y (x ': xs) = x ': Create alias y xs

301310

311+type family Add alias x y where

312+ Add alias x (constraints :=> xs) = constraints :=> Create alias x xs

313+

302314-- | @Drop alias xs@ removes the type associated with @alias@ in @xs@

303315-- and is used in `Squeal.PostgreSQL.Definition.dropTable` statements

304316-- and in @ALTER TABLE@ `Squeal.PostgreSQL.Definition.dropColumn` statements.

@@ -313,6 +325,19 @@ type family Alter alias xs x where

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

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

315327

328+type family AddConstraint constraint ty where

329+ AddConstraint constraint (constraints :=> ty)

330+ = AsSet (constraint ': constraints) :=> ty

331+

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

333+ DeleteFromList elem '[] = '[]

334+ DeleteFromList elem (x ': xs) =

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

336+

337+type family DropConstraint constraint ty where

338+ DropConstraint constraint (constraints :=> ty)

339+ = (AsSet (DeleteFromList constraint constraints)) :=> ty

340+

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

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

318343-- `Squeal.PostgreSQL.Definition.renameColumn`.

@@ -341,21 +366,13 @@ type family SameFields

341366 columns

342367 = AllZip SameField fields columns

343368

344−type (:=>) constraints ty = '(constraints,ty)

369+type (:=>) (constraints :: [constraint]) ty = '(constraints,ty)

345370

346371data ColumnConstraint

347372 = Default

348373 | Unique

349374 | References Symbol Symbol

350375

351−type family AddConstraint constraint constraints ty where

352− AddConstraint constraint constraints ty

353− = '(AsSet (constraint ': constraints),ty)

354−

355−type family DropConstraint constraint ty where

356− DropConstraint constraint '(constraints,ty)

357− = '(Delete constraint constraints,ty)

358−

359376-- type DropDefault constraints = AsSet (DropDefaultList constraints)

360377

361378-- type family DropDefaultList constraints where