b4ef11e · squeal · git.iko.soy

git.iko.soy/squeal

keep trying buddy

commitb4ef11e9d6b3c9c783d18309316a5d2b3f0acd5f authorEitan Chatav <eitan.chatav@gmail.com> dateThu 7 Dec 2017, 16:58 (9 years ago) parent56e20e9

6 files changed+105−81

compare with dev

unifiedsplit

squeal-postgresql/src/Squeal/PostgreSQL/Definition.hs+58−45 squeal-postgresql/src/Squeal/PostgreSQL/Expression.hs+3−3 squeal-postgresql/src/Squeal/PostgreSQL/Manipulation.hs+2−2 squeal-postgresql/src/Squeal/PostgreSQL/PQ.hs+4−4 squeal-postgresql/src/Squeal/PostgreSQL/Query.hs+4−4 squeal-postgresql/src/Squeal/PostgreSQL/Schema.hs+34−23

squeal-postgresql/src/Squeal/PostgreSQL/Definition.hs+58−45

@@ -44,7 +44,7 @@ module Squeal.PostgreSQL.Definition

4444 , alterTable

4545 , alterTableRename

4646 , alterTableAddConstraint

47− , AlterColumns (UnsafeAlterColumns, renderAlterColumns)

47+ , AlterTable (UnsafeAlterTable, renderAlterTable)

4848 , addColumnDefault

4949 , addColumnNull

5050 , dropColumn

@@ -82,8 +82,8 @@ statements

8282-- database, like a `createTable`, `dropTable`, or `alterTable` command.

8383-- `Definition`s may be composed using the `>>>` operator.

8484newtype Definition

85− (schema0 :: TablesType)

86− (schema1 :: TablesType)

85+ (schema0 :: SchemaType)

86+ (schema1 :: SchemaType)

8787 = UnsafeDefinition { renderDefinition :: ByteString }

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

8989

@@ -105,13 +105,15 @@ CREATE statements

105105-- :}

106106-- "CREATE TABLE tab (a int, b real);"

107107createTable

108− :: (KnownSymbol table, SOP.SListI columns)

109− => Alias table -- ^ the name of the table to add

108+ :: ( KnownSymbol tab

109+ , SOP.SListI columns

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

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

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

111113 -- ^ the names and datatype of each column

112− -> [TableConstraint schema (column ': columns)]

114+ -> NP (TableConstraint schema (column ': columns)) constraints

113115 -- ^ constraints that must hold for the table

114− -> Definition schema (Create table (column ': columns) schema)

116+ -> Definition schema (Create tab table schema)

115117createTable table columns constraints = UnsafeDefinition $

116118 "CREATE TABLE" <+> renderAlias table

117119 <+> parenthesized

@@ -140,8 +142,9 @@ createTable table columns constraints = UnsafeDefinition $

140142-- violate a constraint, an error is raised. This applies

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

142144newtype TableConstraint

143− (schema :: TablesType)

145+ (schema :: SchemaType)

144146 (columns :: ColumnsType)

147+ (tableConstraint :: TableConstraint')

145148 = UnsafeTableConstraint { renderTableConstraint :: ByteString }

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

147150

@@ -160,7 +163,7 @@ newtype TableConstraint

160163check

161164 :: Condition '[table ::: columns] 'Ungrouped '[]

162165 -- ^ condition to check

163− -> TableConstraint schema columns

166+ -> TableConstraint schema columns 'Check

164167check condition = UnsafeTableConstraint $

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

166169

@@ -179,7 +182,7 @@ unique

179182 :: SOP.SListI subcolumns

180183 => NP (Column columns) subcolumns

181184 -- ^ unique column or group of columns

182− -> TableConstraint schema columns

185+ -> TableConstraint schema columns ( 'Uniques subcolumns)

183186unique columns = UnsafeTableConstraint $

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

185188

@@ -199,7 +202,7 @@ primaryKey

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

200203 => NP (Column columns) subcolumns

201204 -- ^ identifying column or group of columns

202− -> TableConstraint schema columns

205+ -> TableConstraint schema columns ('Uniques subcolumns)

203206primaryKey columns = UnsafeTableConstraint $

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

205208

@@ -237,8 +240,8 @@ primaryKey columns = UnsafeTableConstraint $

237240-- :}

238241-- "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);"

239242foreignKey

240− :: ( HasTable reftable schema refcolumns

241− , SameTypes subcolumns refsubcolumns

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

244+ , -}SameTypes subcolumns refsubcolumns

242245 , AllNotNull subcolumns

243246 , SOP.SListI subcolumns

244247 , SOP.SListI refsubcolumns)

@@ -253,6 +256,7 @@ foreignKey

253256 -> OnUpdateClause

254257 -- ^ what to do when reference is updated

255258 -> TableConstraint schema columns

259+ ('ForeignKey subcolumns reftable refsubcolumns)

256260foreignKey columns reftable refcolumns onDelete onUpdate =

257261 UnsafeTableConstraint $

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

@@ -320,14 +324,14 @@ ALTER statements

320324

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

322326alterTable

323− :: HasTable table schema columns0

324− => Alias table -- ^ table to alter

325− -> AlterColumns columns0 columns1 -- ^ alteration to perform

326− -> Definition schema (Alter table schema columns1)

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

328+ => Alias tab -- ^ table to alter

329+ -> AlterTable schema table0 table1 -- ^ alteration to perform

330+ -> Definition schema (Alter tab schema table1)

327331alterTable table alteration = UnsafeDefinition $

328332 "ALTER TABLE"

329333 <+> renderAlias table

330− <+> renderAlterColumns alteration

334+ <+> renderAlterTable alteration

331335 <> ";"

332336

333337-- | `alterTableRename` changes the name of a table from the schema.

@@ -354,21 +358,30 @@ alterTableRename table0 table1 = UnsafeDefinition $

354358-- in renderDefinition definition

355359-- :}

356360-- "ALTER TABLE tab ADD CHECK ((col > 0));"

357−alterTableAddConstraint

358− :: HasTable table schema columns

359− => Alias table -- ^ table to constrain

360− -> TableConstraint schema columns -- ^ what constraint to add

361− -> Definition schema schema

362−alterTableAddConstraint table constraint = UnsafeDefinition $

363− "ALTER TABLE" <+> renderAlias table

364− <+> "ADD" <+> renderTableConstraint constraint <> ";"

365−

366−-- | An `AlterColumns` describes the alteration to perform on the columns

361+-- alterTableAddConstraint

362+-- :: (HasTable table schema columns, (table ::: table0) `In` schema)

363+-- => Alias table -- ^ table to constrain

364+-- -> TableConstraint schema columns constraint -- ^ what constraint to add

365+-- -> Definition schema (Alter table schema (AddConstraint constraint table0))

366+-- alterTableAddConstraint table constraint = UnsafeDefinition $

367+-- "ALTER TABLE" <+> renderAlias table

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

369+

370+addConstraint

371+ :: ( table `In` schema

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

373+ => Alias tab

374+ -> TableConstraint schema columns constraint

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

376+addConstraint = undefined

377+

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

367379-- of a table.

368−newtype AlterColumns

369− (columns0 :: ColumnsType)

370− (columns1 :: ColumnsType) =

371− UnsafeAlterColumns {renderAlterColumns :: ByteString}

380+newtype AlterTable

381+ (schema :: SchemaType)

382+ (table0 :: TableType)

383+ (table1 :: TableType) =

384+ UnsafeAlterTable {renderAlterTable :: ByteString}

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

373386

374387-- | An `addColumnDefault` adds a new `Optional` column. The new column is

@@ -390,8 +403,8 @@ addColumnDefault

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

391404 => Alias column -- ^ column to add

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

393− -> AlterColumns columns (Create column '(constraints, ty) columns)

394−addColumnDefault column ty = UnsafeAlterColumns $

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

407+addColumnDefault column ty = UnsafeAlterTable $

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

396409

397410-- | An `addColumnNull` adds a new `Null` column. The new column is initially

@@ -412,8 +425,8 @@ addColumnNull

412425 :: KnownSymbol column

413426 => Alias column -- ^ column to add

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

415− -> AlterColumns columns (Create column '( '[], ('Null ty)) columns)

416−addColumnNull column ty = UnsafeAlterColumns $

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

429+addColumnNull column ty = UnsafeAlterTable $

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

418431

419432-- | A `dropColumn` removes a column. Whatever data was in the column

@@ -435,8 +448,8 @@ addColumnNull column ty = UnsafeAlterColumns $

435448dropColumn

436449 :: KnownSymbol column

437450 => Alias column -- ^ column to remove

438− -> AlterColumns columns (Drop column columns)

439−dropColumn column = UnsafeAlterColumns $

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

452+dropColumn column = UnsafeAlterTable $

440453 "DROP COLUMN" <+> renderAlias column

441454

442455-- | Like `dropColumn` but authorizes dropping everything that depends

@@ -456,8 +469,8 @@ dropColumn column = UnsafeAlterColumns $

456469dropColumnCascade

457470 :: KnownSymbol column

458471 => Alias column -- ^ column to remove

459− -> AlterColumns columns (Drop column columns)

460−dropColumnCascade column = UnsafeAlterColumns $

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

473+dropColumnCascade column = UnsafeAlterTable $

461474 "DROP COLUMN" <+> renderAlias column <+> "CASCADE"

462475

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

@@ -475,8 +488,8 @@ renameColumn

475488 :: (KnownSymbol column0, KnownSymbol column1)

476489 => Alias column0

477490 -> Alias column1

478− -> AlterColumns columns (Rename column0 column1 columns)

479−renameColumn column0 column1 = UnsafeAlterColumns $

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

492+renameColumn column0 column1 = UnsafeAlterTable $

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

481494

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

@@ -484,8 +497,8 @@ alterColumn

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

485498 => Alias column -- ^ column to alter

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

487− -> AlterColumns columns (Alter column columns ty1)

488−alterColumn column alteration = UnsafeAlterColumns $

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

501+alterColumn column alteration = UnsafeAlterTable $

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

490503

491504-- | An `AlterColumn` describes the alteration to perform on a single column.

@@ -523,7 +536,7 @@ setDefault expression = UnsafeAlterColumn $

523536-- in renderDefinition definition

524537-- :}

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

526−dropDefault :: AlterColumn '(constraints, ty) '(DropDefault constraints, ty)

539+dropDefault :: AlterColumn ty (DropConstraint 'Default ty)

527540dropDefault = UnsafeAlterColumn $ "DROP DEFAULT"

528541

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

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

@@ -181,7 +181,7 @@ values from primitive expression using arithmetic, logical,

181181and other operations.

182182-}

183183newtype Expression

184− (tables :: TablesType)

184+ (tables :: RelationType)

185185 (grouping :: Grouping)

186186 (params :: [ColumnType])

187187 (ty :: ColumnType)

@@ -978,7 +978,7 @@ tables

978978-- | A `Table` from a schema without its alias with an `IsLabel` instance

979979-- to call a table reference by its alias.

980980newtype Table

981− (schema :: TablesType)

981+ (schema :: RelationType)

982982 (columns :: ColumnsType)

983983 = UnsafeTable { renderTable :: ByteString }

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

@@ -1043,7 +1043,7 @@ smallserial = UnsafeTypeExpression "smallserial"

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

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

10451045serial4, serial

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

1046+ :: TypeExpression ( '[ 'Default, 'Unique] :=> 'NotNull 'PGint4)

10471047serial4 = UnsafeTypeExpression "serial4"

10481048serial = UnsafeTypeExpression "serial"

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

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

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

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

6060-- it does not modify data.

6161newtype Manipulation

62− (schema :: TablesType)

62+ (schema :: RelationType)

6363 (params :: [ColumnType])

6464 (columns :: ColumnsType)

6565 = UnsafeManipulation { renderManipulation :: ByteString }

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

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

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

195195data ValuesClause

196− (schema :: TablesType)

196+ (schema :: RelationType)

197197 (params :: [ColumnType])

198198 (columns :: ColumnsType)

199199 = Values

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 `TablesType`

104−newtype Connection (schema :: TablesType) =

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

104+newtype Connection (schema :: RelationType) =

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 :: TablesType)

157− (schema1 :: TablesType)

156+ (schema0 :: RelationType)

157+ (schema1 :: RelationType)

158158 (m :: Type -> Type)

159159 (x :: Type) =

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

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

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

257257-}

258258

259259newtype Query

260− (schema :: TablesType)

260+ (schema :: RelationType)

261261 (params :: [ColumnType])

262262 (columns :: ColumnsType)

263263 = UnsafeQuery { renderQuery :: ByteString }

@@ -419,9 +419,9 @@ 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 :: TablesType)

422+ (schema :: RelationType)

423423 (params :: [ColumnType])

424− (tables :: TablesType)

424+ (tables :: RelationType)

425425 (grouping :: Grouping)

426426 = TableExpression

427427 { fromClause :: FromClause schema params tables

@@ -669,7 +669,7 @@ Grouping

669669-- column @col@; otherwise @By2 (\#tab \! \#col)@ will reference a table

670670-- qualified column @tab.col@.

671671data By

672− (tables :: TablesType)

672+ (tables :: RelationType)

673673 (by :: (Symbol,Symbol)) where

674674 By

675675 :: (HasUnique table tables columns, HasColumn column columns ty)

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

@@ -28,6 +28,7 @@ Embedding of PostgreSQL type and alias system

2828 , TypeFamilies

2929 , TypeInType

3030 , TypeOperators

31+ , UndecidableInstances

3132#-}

3233

3334module Squeal.PostgreSQL.Schema

@@ -36,8 +37,9 @@ module Squeal.PostgreSQL.Schema

3637 , NullityType (..)

3738 , ColumnType

3839 , ColumnsType

40+ , RelationType

3941 , TableType

40− , TablesType

42+ , SchemaType

4143 , Grouping (..)

4244 -- * Constraints

4345 , PGNum

@@ -71,11 +73,12 @@ module Squeal.PostgreSQL.Schema

7173 , SameFields

7274 -- * PostgreSQL Constraints

7375 , (:=>)

74− , (::=>)

7576 , Unconstrain

7677 , ColumnConstraint (..)

77− , DropDefault

78− , DropDefaultList

78+ -- , DropDefault

79+ -- , DropDefaultList

80+ , AddConstraint

81+ , DropConstraint

7982 , TableConstraint' (..)

8083 ) where

8184

@@ -133,13 +136,17 @@ type ColumnType = ([ColumnConstraint],NullityType)

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

134137type ColumnsType = [(Symbol,ColumnType)]

135138

136−type TableType = ([TableConstraint'],ColumnsType)

137−

138−-- | `TablesType` is a kind synonym for a row of `ColumnsType`s.

139+-- | `RelationType` is a kind synonym for a row of `ColumnsType`s.

139140-- It is used as a kind for both a schema, a disjoint union of tables,

140141-- and a joined table `Squeal.PostgreSQL.Query.FromClause`,

141142-- a product of tables.

142−type TablesType = [(Symbol,ColumnsType)]

143+type RelationType = [(Symbol,ColumnsType)]

144+

145+type TableType = ([TableConstraint'],ColumnsType)

146+type SchemaType = [(Symbol,TableType)]

147+

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

149+ Unconstrain '(constraints,ty) = ty

143150

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

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

@@ -270,10 +277,10 @@ type family NullifyColumns (columns :: ColumnsType) :: ColumnsType where

270277type family NullifyTable (table :: TableType) :: TableType where

271278 NullifyTable '( '[], columns) = '( '[], NullifyColumns columns)

272279

273−-- | `NullifyTables` is an idempotent that nullifies a `TablesType`

280+-- | `NullifyTables` is an idempotent that nullifies a `RelationType`

274281-- used to nullify the left or right hand side of an outer join

275282-- in a `Squeal.PostgreSQL.Query.FromClause`.

276−type family NullifyTables (tables :: TablesType) :: TablesType where

283+type family NullifyTables (tables :: RelationType) :: RelationType where

277284 NullifyTables '[] = '[]

278285 NullifyTables ((tab ::: columns) ': tables) =

279286 (tab ::: NullifyColumns columns) ': NullifyTables tables

@@ -335,25 +342,29 @@ type family SameFields

335342 = AllZip SameField fields columns

336343

337344type (:=>) constraints ty = '(constraints,ty)

338−type (::=>) constraints ty = '(AsSet constraints,ty)

339−

340−type family Unconstrain constrained where

341− Unconstrain '(constraints, ty) = '( '[], ty)

342345

343346data ColumnConstraint

344347 = Default

345348 | Unique

346349 | References Symbol Symbol

347350

348−type DropDefault constraints = AsSet (DropDefaultList constraints)

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+

359+-- type DropDefault constraints = AsSet (DropDefaultList constraints)

349360

350−type family DropDefaultList constraints where

351− DropDefaultList '[] = '[]

352− DropDefaultList ( 'Default ': constraints) = constraints

353− DropDefaultList (constraint ': constraints) =

354− constraint ': DropDefaultList constraints

361+-- type family DropDefaultList constraints where

362+-- DropDefaultList '[] = '[]

363+-- DropDefaultList ( 'Default ': constraints) = constraints

364+-- DropDefaultList (constraint ': constraints) =

365+-- constraint ': DropDefaultList constraints

355366

356367data TableConstraint'

357− = Check [Symbol]

358− | Uniques [Symbol]

359− | ForeignKey [Symbol] Symbol [Symbol]

368+ = Check

369+ | Uniques [(Symbol, ColumnType)]

370+ | ForeignKey ColumnsType Symbol ColumnsType