db940a0 · squeal · git.iko.soy

git.iko.soy/squeal

views

commitdb940a037d5b92277d2584e3f9883d69210a3407 authorEitan Chatav <eitan.chatav@gmail.com> dateMon 9 Apr 2018, 11:08 (9 years ago) parent0120fc6

8 files changed+76−44

compare with dev

unifiedsplit

squeal-postgresql/src/Squeal/PostgreSQL/Definition.hs+18−18 squeal-postgresql/src/Squeal/PostgreSQL/Expression.hs+2−2 squeal-postgresql/src/Squeal/PostgreSQL/Manipulation.hs+12−12 squeal-postgresql/src/Squeal/PostgreSQL/Migration.hs+7−7 squeal-postgresql/src/Squeal/PostgreSQL/PQ.hs+2−2 squeal-postgresql/src/Squeal/PostgreSQL/Pool.hs+1−1 squeal-postgresql/src/Squeal/PostgreSQL/Query.hs+2−2 squeal-postgresql/src/Squeal/PostgreSQL/Schema.hs+32

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

@@ -88,8 +88,8 @@ statements

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

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

9090newtype Definition

91− (schema0 :: TablesType)

92− (schema1 :: TablesType)

91+ (schema0 :: SchemaType)

92+ (schema1 :: SchemaType)

9393 = UnsafeDefinition { renderDefinition :: ByteString }

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

9595

@@ -115,7 +115,7 @@ createTable

115115 , columns ~ (col ': cols)

116116 , SOP.SListI columns

117117 , SOP.SListI constraints

118− , schema1 ~ Create table (constraints :=> columns) schema0 )

118+ , schema1 ~ Create table ('Table (constraints :=> columns)) schema0 )

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

120120 -> NP (Aliased TypeExpression) columns

121121 -- ^ the names and datatype of each column

@@ -138,7 +138,7 @@ createTable table columns constraints = UnsafeDefinition $

138138-- :}

139139-- "CREATE TABLE IF NOT EXISTS \"tab\" (\"a\" int, \"b\" real);"

140140createTableIfNotExists

141− :: ( Has table schema (constraints :=> columns)

141+ :: ( Has table (TablesOf schema) (constraints :=> columns)

142142 , SOP.SListI columns

143143 , SOP.SListI constraints )

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

@@ -193,7 +193,7 @@ renderCreation table columns constraints = renderAlias table

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

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

195195newtype TableConstraintExpression

196− (schema :: TablesType)

196+ (schema :: SchemaType)

197197 (table :: Symbol)

198198 (tableConstraint :: TableConstraint)

199199 = UnsafeTableConstraintExpression

@@ -224,7 +224,7 @@ newtype TableConstraintExpression

224224-- >>> renderDefinition definition

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

226226check

227− :: ( Has alias schema table

227+ :: ( Has alias (TablesOf schema) table

228228 , HasAll aliases (TableToColumns table) subcolumns )

229229 => NP Alias aliases

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

@@ -255,7 +255,7 @@ check _cols condition = UnsafeTableConstraintExpression $

255255-- >>> renderDefinition definition

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

257257unique

258− :: ( Has alias schema table

258+ :: ( Has alias (TablesOf schema) table

259259 , HasAll aliases (TableToColumns table) subcolumns )

260260 => NP Alias aliases

261261 -> TableConstraintExpression schema alias ('Unique aliases)

@@ -286,7 +286,7 @@ unique columns = UnsafeTableConstraintExpression $

286286-- >>> renderDefinition definition

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

288288primaryKey

289− :: ( Has alias schema table

289+ :: ( Has alias (TablesOf schema) table

290290 , HasAll aliases (TableToColumns table) subcolumns

291291 , AllNotNull subcolumns )

292292 => NP Alias aliases

@@ -397,8 +397,8 @@ type ForeignKeyed schema

397397 columns refcolumns

398398 constraints cols

399399 reftys tys =

400− ( Has child schema table

401− , Has parent schema reftable

400+ ( Has child (TablesOf schema) table

401+ , Has parent (TablesOf schema) reftable

402402 , HasAll columns (TableToColumns table) tys

403403 , reftable ~ (constraints :=> cols)

404404 , HasAll refcolumns cols reftys

@@ -467,7 +467,7 @@ alterTable

467467 :: KnownSymbol alias

468468 => Alias alias -- ^ table to alter

469469 -> AlterTable alias table schema -- ^ alteration to perform

470− -> Definition schema (Alter alias table schema)

470+ -> Definition schema (Alter alias ('Table table) schema)

471471alterTable table alteration = UnsafeDefinition $

472472 "ALTER TABLE"

473473 <+> renderAlias table

@@ -492,7 +492,7 @@ alterTableRename table0 table1 = UnsafeDefinition $

492492newtype AlterTable

493493 (alias :: Symbol)

494494 (table :: TableType)

495− (schema :: TablesType) =

495+ (schema :: SchemaType) =

496496 UnsafeAlterTable {renderAlterTable :: ByteString}

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

498498

@@ -509,7 +509,7 @@ newtype AlterTable

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

510510addConstraint

511511 :: ( KnownSymbol alias

512− , Has tab schema table0

512+ , Has tab (TablesOf schema) table0

513513 , table0 ~ (constraints :=> columns)

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

515515 => Alias alias

@@ -533,7 +533,7 @@ addConstraint alias constraint = UnsafeAlterTable $

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

534534dropConstraint

535535 :: ( KnownSymbol constraint

536− , Has tab schema table0

536+ , Has tab (TablesOf schema) table0

537537 , table0 ~ (constraints :=> columns)

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

539539 => Alias constraint

@@ -572,7 +572,7 @@ class AddColumn ty where

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

573573 addColumn

574574 :: ( KnownSymbol column

575− , Has tab schema table0

575+ , Has tab (TablesOf schema) table0

576576 , table0 ~ (constraints :=> columns)

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

578578 => Alias column -- ^ column to add

@@ -601,7 +601,7 @@ instance {-# OVERLAPPABLE #-} AddColumn ('NoDef :=> 'Null ty)

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

602602dropColumn

603603 :: ( KnownSymbol column

604− , Has tab schema table0

604+ , Has tab (TablesOf schema) table0

605605 , table0 ~ (constraints :=> columns)

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

607607 => Alias column -- ^ column to remove

@@ -623,7 +623,7 @@ dropColumn column = UnsafeAlterTable $

623623renameColumn

624624 :: ( KnownSymbol column0

625625 , KnownSymbol column1

626− , Has tab schema table0

626+ , Has tab (TablesOf schema) table0

627627 , table0 ~ (constraints :=> columns)

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

629629 => Alias column0 -- ^ column to rename

@@ -635,7 +635,7 @@ renameColumn column0 column1 = UnsafeAlterTable $

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

636636alterColumn

637637 :: ( KnownSymbol column

638− , Has tab schema table0

638+ , Has tab (TablesOf schema) table0

639639 , table0 ~ (constraints :=> columns)

640640 , Has column columns ty0

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

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

@@ -1026,12 +1026,12 @@ tables

10261026-- | A `Table` from a table expression is a way

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

10281028newtype Table

1029− (schema :: TablesType)

1029+ (schema :: SchemaType)

10301030 (columns :: RelationType)

10311031 = UnsafeTable { renderTable :: ByteString }

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

10331033instance

1034− ( Has alias schema table

1034+ ( Has alias (TablesOf schema) table

10351035 , relation ~ ColumnsToRelation (TableToColumns table)

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

10371037 fromLabel = UnsafeTable $ renderAlias (Alias @alias)

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

@@ -187,7 +187,7 @@ in renderManipulation manipulation

187187"DELETE FROM \"tab\" WHERE (\"col1\" = \"col2\") RETURNING *;"

188188-}

189189newtype Manipulation

190− (schema :: TablesType)

190+ (schema :: SchemaType)

191191 (params :: [NullityType])

192192 (columns :: RelationType)

193193 = UnsafeManipulation { renderManipulation :: ByteString }

@@ -213,7 +213,7 @@ INSERT statements

213213insertRows

214214 :: ( SOP.SListI columns

215215 , SOP.SListI results

216− , Has tab schema table

216+ , Has tab (TablesOf schema) table

217217 , columns ~ TableToColumns table )

218218 => Alias tab -- ^ table to insert into

219219 -> NP (Aliased (ColumnValue '[] params)) columns -- ^ row to insert

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

243243insertRow

244244 :: ( SOP.SListI columns

245245 , SOP.SListI results

246− , Has tab schema table

246+ , Has tab (TablesOf schema) table

247247 , columns ~ TableToColumns table )

248248 => Alias tab -- ^ table to insert into

249249 -> NP (Aliased (ColumnValue '[] params)) columns -- ^ row to insert

@@ -256,7 +256,7 @@ insertRow tab row = insertRows tab row []

256256-- | Insert multiple rows returning `Nil` and raising an error on conflicts.

257257insertRows_

258258 :: ( SOP.SListI columns

259− , Has tab schema table

259+ , Has tab (TablesOf schema) table

260260 , columns ~ TableToColumns table )

261261 => Alias tab -- ^ table to insert into

262262 -> NP (Aliased (ColumnValue '[] params)) columns -- ^ row to insert

@@ -268,7 +268,7 @@ insertRows_ tab row rows =

268268-- | Insert a single row returning `Nil` and raising an error on conflicts.

269269insertRow_

270270 :: ( SOP.SListI columns

271− , Has tab schema table

271+ , Has tab (TablesOf schema) table

272272 , columns ~ TableToColumns table )

273273 => Alias tab -- ^ table to insert into

274274 -> NP (Aliased (ColumnValue '[] params)) columns -- ^ row to insert

@@ -279,7 +279,7 @@ insertRow_ tab row = insertRow tab row OnConflictDoRaise (Returning Nil)

279279insertQuery

280280 :: ( SOP.SListI columns

281281 , SOP.SListI results

282− , Has tab schema table

282+ , Has tab (TablesOf schema) table

283283 , columns ~ TableToColumns table )

284284 => Alias tab -- ^ table to insert into

285285 -> Query schema params (ColumnsToRelation columns)

@@ -296,7 +296,7 @@ insertQuery tab query conflict returning = UnsafeManipulation $

296296-- | Insert a `Query` returning `Nil` and raising an error on conflicts.

297297insertQuery_

298298 :: ( SOP.SListI columns

299− , Has tab schema table

299+ , Has tab (TablesOf schema) table

300300 , columns ~ TableToColumns table )

301301 => Alias tab -- ^ table to insert into

302302 -> Query schema params (ColumnsToRelation columns)

@@ -401,7 +401,7 @@ UPDATE statements

401401update

402402 :: ( SOP.SListI columns

403403 , SOP.SListI results

404− , Has tab schema table

404+ , Has tab (TablesOf schema) table

405405 , columns ~ TableToColumns table )

406406 => Alias tab -- ^ table to update

407407 -> NP (Aliased (ColumnValue (ColumnsToRelation columns) params)) columns

@@ -431,7 +431,7 @@ update tab columns wh returning = UnsafeManipulation $

431431-- | Update a row returning `Nil`.

432432update_

433433 :: ( SOP.SListI columns

434− , Has tab schema table

434+ , Has tab (TablesOf schema) table

435435 , columns ~ TableToColumns table )

436436 => Alias tab -- ^ table to update

437437 -> NP (Aliased (ColumnValue (ColumnsToRelation columns) params)) columns

@@ -448,7 +448,7 @@ DELETE statements

448448-- | Delete rows of a table.

449449deleteFrom

450450 :: ( SOP.SListI results

451− , Has tab schema table

451+ , Has tab (TablesOf schema) table

452452 , columns ~ TableToColumns table )

453453 => Alias tab -- ^ table to delete from

454454 -> Condition '[tab ::: ColumnsToRelation columns] 'Ungrouped params

@@ -462,7 +462,7 @@ deleteFrom tab wh returning = UnsafeManipulation $

462462

463463-- | Delete rows returning `Nil`.

464464deleteFrom_

465− :: ( Has tab schema table

465+ :: ( Has tab (TablesOf schema) table

466466 , columns ~ TableToColumns table )

467467 => Alias tab -- ^ table to delete from

468468 -> Condition '[tab ::: ColumnsToRelation columns] 'Ungrouped params

@@ -493,7 +493,7 @@ with

493493 :: SOP.SListI commons

494494 => NP (Aliased (Manipulation schema params)) commons

495495 -- ^ common table expressions

496− -> Manipulation (Join (RelationsToTables commons) schema) params results

496+ -> Manipulation (With commons schema) params results

497497 -> Manipulation schema params results

498498with commons manipulation = UnsafeManipulation $

499499 "WITH" <+> renderCommaSeparated renderCommon commons

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

@@ -162,8 +162,8 @@ migrateUp

162162 :: MonadBaseControl IO io

163163 => AlignedList (Migration io) schema0 schema1 -- ^ migrations to run

164164 -> PQ

165− ("schema_migrations" ::: MigrationsTable ': schema0)

166− ("schema_migrations" ::: MigrationsTable ': schema1)

165+ ("schema_migrations" ::: 'Table MigrationsTable ': schema0)

166+ ("schema_migrations" ::: 'Table MigrationsTable ': schema1)

167167 io ()

168168migrateUp migration =

169169 define createMigrations

@@ -218,8 +218,8 @@ migrateDown

218218 :: MonadBaseControl IO io

219219 => AlignedList (Migration io) schema0 schema1 -- ^ migrations to rewind

220220 -> PQ

221− ("schema_migrations" ::: MigrationsTable ': schema1)

222− ("schema_migrations" ::: MigrationsTable ': schema0)

221+ ("schema_migrations" ::: 'Table MigrationsTable ': schema1)

222+ ("schema_migrations" ::: 'Table MigrationsTable ': schema0)

223223 io ()

224224migrateDown migrations =

225225 define createMigrations

@@ -283,7 +283,7 @@ type MigrationsTable =

283283

284284-- | Creates a `MigrationsTable` if it does not already exist.

285285createMigrations

286− :: Has "schema_migrations" schema MigrationsTable

286+ :: Has "schema_migrations" (TablesOf schema) MigrationsTable

287287 => Definition schema schema

288288createMigrations =

289289 createTableIfNotExists #schema_migrations

@@ -294,7 +294,7 @@ createMigrations =

294294

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

296296insertMigration

297− :: Has "schema_migrations" schema MigrationsTable

297+ :: Has "schema_migrations" (TablesOf schema) MigrationsTable

298298 => Manipulation schema '[ 'NotNull 'PGtext] '[]

299299insertMigration = insertRow_ #schema_migrations

300300 ( Set (param @1) `As` #name :*

@@ -302,7 +302,7 @@ insertMigration = insertRow_ #schema_migrations

302302

303303-- | Deletes a `Migration` from the `MigrationsTable`

304304deleteMigration

305− :: Has "schema_migrations" schema MigrationsTable

305+ :: Has "schema_migrations" (TablesOf schema) MigrationsTable

306306 => Manipulation schema '[ 'NotNull 'PGtext ] '[]

307307deleteMigration = deleteFrom_ #schema_migrations (#name .== param @1)

308308

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

@@ -160,8 +160,8 @@ lowerConnection (K conn) = K conn

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

161161-- `PQ`.

162162newtype PQ

163− (schema0 :: TablesType)

164− (schema1 :: TablesType)

163+ (schema0 :: SchemaType)

164+ (schema1 :: SchemaType)

165165 (m :: Type -> Type)

166166 (x :: Type) =

167167 PQ { unPQ :: K LibPQ.Connection schema0 -> m (K x schema1) }

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

@@ -43,7 +43,7 @@ import Squeal.PostgreSQL.PQ

4343import Squeal.PostgreSQL.Schema

4444

4545-- | `PoolPQ` @schema@ should be a drop-in replacement for `PQ` @schema schema@.

46−newtype PoolPQ (schema :: TablesType) m x =

46+newtype PoolPQ (schema :: SchemaType) m x =

4747 PoolPQ { runPoolPQ :: Pool (K Connection schema) -> m x }

4848 deriving Functor

4949

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

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

281281"(SELECT * FROM \"tab\" AS \"t\") UNION ALL (SELECT * FROM \"tab\" AS \"t\")"

282282-}

283283newtype Query

284− (schema :: TablesType)

284+ (schema :: SchemaType)

285285 (params :: [NullityType])

286286 (columns :: RelationType)

287287 = UnsafeQuery { renderQuery :: ByteString }

@@ -443,7 +443,7 @@ Table Expressions

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

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

445445data TableExpression

446− (schema :: TablesType)

446+ (schema :: SchemaType)

447447 (params :: [NullityType])

448448 (relations :: RelationsType)

449449 (grouping :: Grouping)

squeal-postgresql/src/Squeal/PostgreSQL/Schema.hs+32

@@ -99,6 +99,12 @@ module Squeal.PostgreSQL.Schema

9999 -- * Generics

100100 , SameField

101101 , SameFields

102+ -- * Schema

103+ , SchemumType (..)

104+ , SchemaType

105+ , TablesOf

106+ , ViewsOf

107+ , With

102108 ) where

103109

104110import Control.DeepSeq

@@ -611,3 +617,29 @@ type family DropIfConstraintsInvolve column constraints where

611617 = If (ConstraintInvolves column constraint)

612618 (DropIfConstraintsInvolve column constraints)

613619 (alias ::: constraint ': DropIfConstraintsInvolve column constraints)

620+

621+data SchemumType

622+ = Table TableType

623+ | View RelationType

624+

625+type SchemaType = [(Symbol,SchemumType)]

626+

627+type family TablesOf (schema :: SchemaType) :: TablesType where

628+ TablesOf '[] = '[]

629+ TablesOf (alias ::: 'Table table ': schema) =

630+ alias ::: table ': TablesOf schema

631+ TablesOf (_ ': schema) = TablesOf schema

632+

633+type family ViewsOf (schema :: SchemaType) :: RelationsType where

634+ ViewsOf '[] = '[]

635+ ViewsOf (alias ::: 'View view ': schema) =

636+ alias ::: view ': ViewsOf schema

637+ ViewsOf (_ ': schema) = ViewsOf schema

638+

639+type family With

640+ (relations :: RelationsType)

641+ (schema :: SchemaType)

642+ :: SchemaType where

643+ With '[] schema = schema

644+ With (alias ::: rel ': rels) schema =

645+ alias ::: 'Table ('[] :=> RelationToColumns rel) ': With rels schema