git.iko.soy/squeal
on dev help sign in
views
db940a0Eitan Chatav
squeal-postgresql/src/Squeal/PostgreSQL/Definition.hs+18−18
compare with dev
unifiedsplit
@@ -88,8 +88,8 @@ statements
88-- database, like a `createTable`, `dropTable`, or `alterTable` command.
88-- database, like a `createTable`, `dropTable`, or `alterTable` command.
89-- `Definition`s may be composed using the `>>>` operator.
89-- `Definition`s may be composed using the `>>>` operator.
90newtype Definition
90newtype Definition
91− (schema0 :: TablesType)
91+ (schema0 :: SchemaType)
92− (schema1 :: TablesType)
92+ (schema1 :: SchemaType)
93 = UnsafeDefinition { renderDefinition :: ByteString }
93 = UnsafeDefinition { renderDefinition :: ByteString }
94 deriving (GHC.Generic,Show,Eq,Ord,NFData)
94 deriving (GHC.Generic,Show,Eq,Ord,NFData)
95
95
@@ -115,7 +115,7 @@ createTable
115 , columns ~ (col ': cols)
115 , columns ~ (col ': cols)
116 , SOP.SListI columns
116 , SOP.SListI columns
117 , SOP.SListI constraints
117 , SOP.SListI constraints
118− , schema1 ~ Create table (constraints :=> columns) schema0 )
118+ , schema1 ~ Create table ('Table (constraints :=> columns)) schema0 )
119 => Alias table -- ^ the name of the table to add
119 => Alias table -- ^ the name of the table to add
120 -> NP (Aliased TypeExpression) columns
120 -> NP (Aliased TypeExpression) columns
121 -- ^ the names and datatype of each column
121 -- ^ the names and datatype of each column
@@ -138,7 +138,7 @@ createTable table columns constraints = UnsafeDefinition $
138-- :}
138-- :}
139-- "CREATE TABLE IF NOT EXISTS \"tab\" (\"a\" int, \"b\" real);"
139-- "CREATE TABLE IF NOT EXISTS \"tab\" (\"a\" int, \"b\" real);"
140createTableIfNotExists
140createTableIfNotExists
141− :: ( Has table schema (constraints :=> columns)
141+ :: ( Has table (TablesOf schema) (constraints :=> columns)
142 , SOP.SListI columns
142 , SOP.SListI columns
143 , SOP.SListI constraints )
143 , SOP.SListI constraints )
144 => Alias table -- ^ the name of the table to add
144 => Alias table -- ^ the name of the table to add
@@ -193,7 +193,7 @@ renderCreation table columns constraints = renderAlias table
193-- violate a constraint, an error is raised. This applies
193-- violate a constraint, an error is raised. This applies
194-- even if the value came from the default value definition.
194-- even if the value came from the default value definition.
195newtype TableConstraintExpression
195newtype TableConstraintExpression
196− (schema :: TablesType)
196+ (schema :: SchemaType)
197 (table :: Symbol)
197 (table :: Symbol)
198 (tableConstraint :: TableConstraint)
198 (tableConstraint :: TableConstraint)
199 = UnsafeTableConstraintExpression
199 = UnsafeTableConstraintExpression
@@ -224,7 +224,7 @@ newtype TableConstraintExpression
224-- >>> renderDefinition definition
224-- >>> renderDefinition definition
225-- "CREATE TABLE \"tab\" (\"a\" int NOT NULL, \"b\" int NOT NULL, CONSTRAINT \"inequality\" CHECK ((\"a\" > \"b\")));"
225-- "CREATE TABLE \"tab\" (\"a\" int NOT NULL, \"b\" int NOT NULL, CONSTRAINT \"inequality\" CHECK ((\"a\" > \"b\")));"
226check
226check
227− :: ( Has alias schema table
227+ :: ( Has alias (TablesOf schema) table
228 , HasAll aliases (TableToColumns table) subcolumns )
228 , HasAll aliases (TableToColumns table) subcolumns )
229 => NP Alias aliases
229 => NP Alias aliases
230 -> (forall tab. Condition '[tab ::: ColumnsToRelation subcolumns] 'Ungrouped '[])
230 -> (forall tab. Condition '[tab ::: ColumnsToRelation subcolumns] 'Ungrouped '[])
@@ -255,7 +255,7 @@ check _cols condition = UnsafeTableConstraintExpression $
255-- >>> renderDefinition definition
255-- >>> renderDefinition definition
256-- "CREATE TABLE \"tab\" (\"a\" int, \"b\" int, CONSTRAINT \"uq_a_b\" UNIQUE (\"a\", \"b\"));"
256-- "CREATE TABLE \"tab\" (\"a\" int, \"b\" int, CONSTRAINT \"uq_a_b\" UNIQUE (\"a\", \"b\"));"
257unique
257unique
258− :: ( Has alias schema table
258+ :: ( Has alias (TablesOf schema) table
259 , HasAll aliases (TableToColumns table) subcolumns )
259 , HasAll aliases (TableToColumns table) subcolumns )
260 => NP Alias aliases
260 => NP Alias aliases
261 -> TableConstraintExpression schema alias ('Unique aliases)
261 -> TableConstraintExpression schema alias ('Unique aliases)
@@ -286,7 +286,7 @@ unique columns = UnsafeTableConstraintExpression $
286-- >>> renderDefinition definition
286-- >>> renderDefinition definition
287-- "CREATE TABLE \"tab\" (\"id\" serial, \"name\" text NOT NULL, CONSTRAINT \"pk_id\" PRIMARY KEY (\"id\"));"
287-- "CREATE TABLE \"tab\" (\"id\" serial, \"name\" text NOT NULL, CONSTRAINT \"pk_id\" PRIMARY KEY (\"id\"));"
288primaryKey
288primaryKey
289− :: ( Has alias schema table
289+ :: ( Has alias (TablesOf schema) table
290 , HasAll aliases (TableToColumns table) subcolumns
290 , HasAll aliases (TableToColumns table) subcolumns
291 , AllNotNull subcolumns )
291 , AllNotNull subcolumns )
292 => NP Alias aliases
292 => NP Alias aliases
@@ -397,8 +397,8 @@ type ForeignKeyed schema
397 columns refcolumns
397 columns refcolumns
398 constraints cols
398 constraints cols
399 reftys tys =
399 reftys tys =
400− ( Has child schema table
400+ ( Has child (TablesOf schema) table
401− , Has parent schema reftable
401+ , Has parent (TablesOf schema) reftable
402 , HasAll columns (TableToColumns table) tys
402 , HasAll columns (TableToColumns table) tys
403 , reftable ~ (constraints :=> cols)
403 , reftable ~ (constraints :=> cols)
404 , HasAll refcolumns cols reftys
404 , HasAll refcolumns cols reftys
@@ -467,7 +467,7 @@ alterTable
467 :: KnownSymbol alias
467 :: KnownSymbol alias
468 => Alias alias -- ^ table to alter
468 => Alias alias -- ^ table to alter
469 -> AlterTable alias table schema -- ^ alteration to perform
469 -> AlterTable alias table schema -- ^ alteration to perform
470− -> Definition schema (Alter alias table schema)
470+ -> Definition schema (Alter alias ('Table table) schema)
471alterTable table alteration = UnsafeDefinition $
471alterTable table alteration = UnsafeDefinition $
472 "ALTER TABLE"
472 "ALTER TABLE"
473 <+> renderAlias table
473 <+> renderAlias table
@@ -492,7 +492,7 @@ alterTableRename table0 table1 = UnsafeDefinition $
492newtype AlterTable
492newtype AlterTable
493 (alias :: Symbol)
493 (alias :: Symbol)
494 (table :: TableType)
494 (table :: TableType)
495− (schema :: TablesType) =
495+ (schema :: SchemaType) =
496 UnsafeAlterTable {renderAlterTable :: ByteString}
496 UnsafeAlterTable {renderAlterTable :: ByteString}
497 deriving (GHC.Generic,Show,Eq,Ord,NFData)
497 deriving (GHC.Generic,Show,Eq,Ord,NFData)
498
498
@@ -509,7 +509,7 @@ newtype AlterTable
509-- "ALTER TABLE \"tab\" ADD CONSTRAINT \"positive\" CHECK ((\"col\" > 0));"
509-- "ALTER TABLE \"tab\" ADD CONSTRAINT \"positive\" CHECK ((\"col\" > 0));"
510addConstraint
510addConstraint
511 :: ( KnownSymbol alias
511 :: ( KnownSymbol alias
512− , Has tab schema table0
512+ , Has tab (TablesOf schema) table0
513 , table0 ~ (constraints :=> columns)
513 , table0 ~ (constraints :=> columns)
514 , table1 ~ (Create alias constraint constraints :=> columns) )
514 , table1 ~ (Create alias constraint constraints :=> columns) )
515 => Alias alias
515 => Alias alias
@@ -533,7 +533,7 @@ addConstraint alias constraint = UnsafeAlterTable $
533-- "ALTER TABLE \"tab\" DROP CONSTRAINT \"positive\";"
533-- "ALTER TABLE \"tab\" DROP CONSTRAINT \"positive\";"
534dropConstraint
534dropConstraint
535 :: ( KnownSymbol constraint
535 :: ( KnownSymbol constraint
536− , Has tab schema table0
536+ , Has tab (TablesOf schema) table0
537 , table0 ~ (constraints :=> columns)
537 , table0 ~ (constraints :=> columns)
538 , table1 ~ (Drop constraint constraints :=> columns) )
538 , table1 ~ (Drop constraint constraints :=> columns) )
539 => Alias constraint
539 => Alias constraint
@@ -572,7 +572,7 @@ class AddColumn ty where
572 -- "ALTER TABLE \"tab\" ADD COLUMN \"col2\" text;"
572 -- "ALTER TABLE \"tab\" ADD COLUMN \"col2\" text;"
573 addColumn
573 addColumn
574 :: ( KnownSymbol column
574 :: ( KnownSymbol column
575− , Has tab schema table0
575+ , Has tab (TablesOf schema) table0
576 , table0 ~ (constraints :=> columns)
576 , table0 ~ (constraints :=> columns)
577 , table1 ~ (constraints :=> Create column ty columns) )
577 , table1 ~ (constraints :=> Create column ty columns) )
578 => Alias column -- ^ column to add
578 => Alias column -- ^ column to add
@@ -601,7 +601,7 @@ instance {-# OVERLAPPABLE #-} AddColumn ('NoDef :=> 'Null ty)
601-- "ALTER TABLE \"tab\" DROP COLUMN \"col2\";"
601-- "ALTER TABLE \"tab\" DROP COLUMN \"col2\";"
602dropColumn
602dropColumn
603 :: ( KnownSymbol column
603 :: ( KnownSymbol column
604− , Has tab schema table0
604+ , Has tab (TablesOf schema) table0
605 , table0 ~ (constraints :=> columns)
605 , table0 ~ (constraints :=> columns)
606 , table1 ~ (constraints :=> Drop column columns) )
606 , table1 ~ (constraints :=> Drop column columns) )
607 => Alias column -- ^ column to remove
607 => Alias column -- ^ column to remove
@@ -623,7 +623,7 @@ dropColumn column = UnsafeAlterTable $
623renameColumn
623renameColumn
624 :: ( KnownSymbol column0
624 :: ( KnownSymbol column0
625 , KnownSymbol column1
625 , KnownSymbol column1
626− , Has tab schema table0
626+ , Has tab (TablesOf schema) table0
627 , table0 ~ (constraints :=> columns)
627 , table0 ~ (constraints :=> columns)
628 , table1 ~ (constraints :=> Rename column0 column1 columns) )
628 , table1 ~ (constraints :=> Rename column0 column1 columns) )
629 => Alias column0 -- ^ column to rename
629 => Alias column0 -- ^ column to rename
@@ -635,7 +635,7 @@ renameColumn column0 column1 = UnsafeAlterTable $
635-- | An `alterColumn` alters a single column.
635-- | An `alterColumn` alters a single column.
636alterColumn
636alterColumn
637 :: ( KnownSymbol column
637 :: ( KnownSymbol column
638− , Has tab schema table0
638+ , Has tab (TablesOf schema) table0
639 , table0 ~ (constraints :=> columns)
639 , table0 ~ (constraints :=> columns)
640 , Has column columns ty0
640 , Has column columns ty0
641 , tables1 ~ (constraints :=> Alter column ty1 columns))
641 , tables1 ~ (constraints :=> Alter column ty1 columns))
squeal-postgresql/src/Squeal/PostgreSQL/Expression.hs+2−2
@@ -1026,12 +1026,12 @@ tables
1026-- | A `Table` from a table expression is a way
1026-- | A `Table` from a table expression is a way
1027-- to call a table reference by its alias.
1027-- to call a table reference by its alias.
1028newtype Table
1028newtype Table
1029− (schema :: TablesType)
1029+ (schema :: SchemaType)
1030 (columns :: RelationType)
1030 (columns :: RelationType)
1031 = UnsafeTable { renderTable :: ByteString }
1031 = UnsafeTable { renderTable :: ByteString }
1032 deriving (GHC.Generic,Show,Eq,Ord,NFData)
1032 deriving (GHC.Generic,Show,Eq,Ord,NFData)
1033instance
1033instance
1034− ( Has alias schema table
1034+ ( Has alias (TablesOf schema) table
1035 , relation ~ ColumnsToRelation (TableToColumns table)
1035 , relation ~ ColumnsToRelation (TableToColumns table)
1036 ) => IsLabel alias (Table schema relation) where
1036 ) => IsLabel alias (Table schema relation) where
1037 fromLabel = UnsafeTable $ renderAlias (Alias @alias)
1037 fromLabel = UnsafeTable $ renderAlias (Alias @alias)
squeal-postgresql/src/Squeal/PostgreSQL/Manipulation.hs+12−12
@@ -187,7 +187,7 @@ in renderManipulation manipulation
187"DELETE FROM \"tab\" WHERE (\"col1\" = \"col2\") RETURNING *;"
187"DELETE FROM \"tab\" WHERE (\"col1\" = \"col2\") RETURNING *;"
188-}
188-}
189newtype Manipulation
189newtype Manipulation
190− (schema :: TablesType)
190+ (schema :: SchemaType)
191 (params :: [NullityType])
191 (params :: [NullityType])
192 (columns :: RelationType)
192 (columns :: RelationType)
193 = UnsafeManipulation { renderManipulation :: ByteString }
193 = UnsafeManipulation { renderManipulation :: ByteString }
@@ -213,7 +213,7 @@ INSERT statements
213insertRows
213insertRows
214 :: ( SOP.SListI columns
214 :: ( SOP.SListI columns
215 , SOP.SListI results
215 , SOP.SListI results
216− , Has tab schema table
216+ , Has tab (TablesOf schema) table
217 , columns ~ TableToColumns table )
217 , columns ~ TableToColumns table )
218 => Alias tab -- ^ table to insert into
218 => Alias tab -- ^ table to insert into
219 -> NP (Aliased (ColumnValue '[] params)) columns -- ^ row to insert
219 -> NP (Aliased (ColumnValue '[] params)) columns -- ^ row to insert
@@ -243,7 +243,7 @@ insertRows tab row rows conflict returning = UnsafeManipulation $
243insertRow
243insertRow
244 :: ( SOP.SListI columns
244 :: ( SOP.SListI columns
245 , SOP.SListI results
245 , SOP.SListI results
246− , Has tab schema table
246+ , Has tab (TablesOf schema) table
247 , columns ~ TableToColumns table )
247 , columns ~ TableToColumns table )
248 => Alias tab -- ^ table to insert into
248 => Alias tab -- ^ table to insert into
249 -> NP (Aliased (ColumnValue '[] params)) columns -- ^ row to insert
249 -> NP (Aliased (ColumnValue '[] params)) columns -- ^ row to insert
@@ -256,7 +256,7 @@ insertRow tab row = insertRows tab row []
256-- | Insert multiple rows returning `Nil` and raising an error on conflicts.
256-- | Insert multiple rows returning `Nil` and raising an error on conflicts.
257insertRows_
257insertRows_
258 :: ( SOP.SListI columns
258 :: ( SOP.SListI columns
259− , Has tab schema table
259+ , Has tab (TablesOf schema) table
260 , columns ~ TableToColumns table )
260 , columns ~ TableToColumns table )
261 => Alias tab -- ^ table to insert into
261 => Alias tab -- ^ table to insert into
262 -> NP (Aliased (ColumnValue '[] params)) columns -- ^ row to insert
262 -> NP (Aliased (ColumnValue '[] params)) columns -- ^ row to insert
@@ -268,7 +268,7 @@ insertRows_ tab row rows =
268-- | Insert a single row returning `Nil` and raising an error on conflicts.
268-- | Insert a single row returning `Nil` and raising an error on conflicts.
269insertRow_
269insertRow_
270 :: ( SOP.SListI columns
270 :: ( SOP.SListI columns
271− , Has tab schema table
271+ , Has tab (TablesOf schema) table
272 , columns ~ TableToColumns table )
272 , columns ~ TableToColumns table )
273 => Alias tab -- ^ table to insert into
273 => Alias tab -- ^ table to insert into
274 -> NP (Aliased (ColumnValue '[] params)) columns -- ^ row to insert
274 -> NP (Aliased (ColumnValue '[] params)) columns -- ^ row to insert
@@ -279,7 +279,7 @@ insertRow_ tab row = insertRow tab row OnConflictDoRaise (Returning Nil)
279insertQuery
279insertQuery
280 :: ( SOP.SListI columns
280 :: ( SOP.SListI columns
281 , SOP.SListI results
281 , SOP.SListI results
282− , Has tab schema table
282+ , Has tab (TablesOf schema) table
283 , columns ~ TableToColumns table )
283 , columns ~ TableToColumns table )
284 => Alias tab -- ^ table to insert into
284 => Alias tab -- ^ table to insert into
285 -> Query schema params (ColumnsToRelation columns)
285 -> Query schema params (ColumnsToRelation columns)
@@ -296,7 +296,7 @@ insertQuery tab query conflict returning = UnsafeManipulation $
296-- | Insert a `Query` returning `Nil` and raising an error on conflicts.
296-- | Insert a `Query` returning `Nil` and raising an error on conflicts.
297insertQuery_
297insertQuery_
298 :: ( SOP.SListI columns
298 :: ( SOP.SListI columns
299− , Has tab schema table
299+ , Has tab (TablesOf schema) table
300 , columns ~ TableToColumns table )
300 , columns ~ TableToColumns table )
301 => Alias tab -- ^ table to insert into
301 => Alias tab -- ^ table to insert into
302 -> Query schema params (ColumnsToRelation columns)
302 -> Query schema params (ColumnsToRelation columns)
@@ -401,7 +401,7 @@ UPDATE statements
401update
401update
402 :: ( SOP.SListI columns
402 :: ( SOP.SListI columns
403 , SOP.SListI results
403 , SOP.SListI results
404− , Has tab schema table
404+ , Has tab (TablesOf schema) table
405 , columns ~ TableToColumns table )
405 , columns ~ TableToColumns table )
406 => Alias tab -- ^ table to update
406 => Alias tab -- ^ table to update
407 -> NP (Aliased (ColumnValue (ColumnsToRelation columns) params)) columns
407 -> NP (Aliased (ColumnValue (ColumnsToRelation columns) params)) columns
@@ -431,7 +431,7 @@ update tab columns wh returning = UnsafeManipulation $
431-- | Update a row returning `Nil`.
431-- | Update a row returning `Nil`.
432update_
432update_
433 :: ( SOP.SListI columns
433 :: ( SOP.SListI columns
434− , Has tab schema table
434+ , Has tab (TablesOf schema) table
435 , columns ~ TableToColumns table )
435 , columns ~ TableToColumns table )
436 => Alias tab -- ^ table to update
436 => Alias tab -- ^ table to update
437 -> NP (Aliased (ColumnValue (ColumnsToRelation columns) params)) columns
437 -> NP (Aliased (ColumnValue (ColumnsToRelation columns) params)) columns
@@ -448,7 +448,7 @@ DELETE statements
448-- | Delete rows of a table.
448-- | Delete rows of a table.
449deleteFrom
449deleteFrom
450 :: ( SOP.SListI results
450 :: ( SOP.SListI results
451− , Has tab schema table
451+ , Has tab (TablesOf schema) table
452 , columns ~ TableToColumns table )
452 , columns ~ TableToColumns table )
453 => Alias tab -- ^ table to delete from
453 => Alias tab -- ^ table to delete from
454 -> Condition '[tab ::: ColumnsToRelation columns] 'Ungrouped params
454 -> Condition '[tab ::: ColumnsToRelation columns] 'Ungrouped params
@@ -462,7 +462,7 @@ deleteFrom tab wh returning = UnsafeManipulation $
462
462
463-- | Delete rows returning `Nil`.
463-- | Delete rows returning `Nil`.
464deleteFrom_
464deleteFrom_
465− :: ( Has tab schema table
465+ :: ( Has tab (TablesOf schema) table
466 , columns ~ TableToColumns table )
466 , columns ~ TableToColumns table )
467 => Alias tab -- ^ table to delete from
467 => Alias tab -- ^ table to delete from
468 -> Condition '[tab ::: ColumnsToRelation columns] 'Ungrouped params
468 -> Condition '[tab ::: ColumnsToRelation columns] 'Ungrouped params
@@ -493,7 +493,7 @@ with
493 :: SOP.SListI commons
493 :: SOP.SListI commons
494 => NP (Aliased (Manipulation schema params)) commons
494 => NP (Aliased (Manipulation schema params)) commons
495 -- ^ common table expressions
495 -- ^ common table expressions
496− -> Manipulation (Join (RelationsToTables commons) schema) params results
496+ -> Manipulation (With commons schema) params results
497 -> Manipulation schema params results
497 -> Manipulation schema params results
498with commons manipulation = UnsafeManipulation $
498with commons manipulation = UnsafeManipulation $
499 "WITH" <+> renderCommaSeparated renderCommon commons
499 "WITH" <+> renderCommaSeparated renderCommon commons
squeal-postgresql/src/Squeal/PostgreSQL/Migration.hs+7−7
@@ -162,8 +162,8 @@ migrateUp
162 :: MonadBaseControl IO io
162 :: MonadBaseControl IO io
163 => AlignedList (Migration io) schema0 schema1 -- ^ migrations to run
163 => AlignedList (Migration io) schema0 schema1 -- ^ migrations to run
164 -> PQ
164 -> PQ
165− ("schema_migrations" ::: MigrationsTable ': schema0)
165+ ("schema_migrations" ::: 'Table MigrationsTable ': schema0)
166− ("schema_migrations" ::: MigrationsTable ': schema1)
166+ ("schema_migrations" ::: 'Table MigrationsTable ': schema1)
167 io ()
167 io ()
168migrateUp migration =
168migrateUp migration =
169 define createMigrations
169 define createMigrations
@@ -218,8 +218,8 @@ migrateDown
218 :: MonadBaseControl IO io
218 :: MonadBaseControl IO io
219 => AlignedList (Migration io) schema0 schema1 -- ^ migrations to rewind
219 => AlignedList (Migration io) schema0 schema1 -- ^ migrations to rewind
220 -> PQ
220 -> PQ
221− ("schema_migrations" ::: MigrationsTable ': schema1)
221+ ("schema_migrations" ::: 'Table MigrationsTable ': schema1)
222− ("schema_migrations" ::: MigrationsTable ': schema0)
222+ ("schema_migrations" ::: 'Table MigrationsTable ': schema0)
223 io ()
223 io ()
224migrateDown migrations =
224migrateDown migrations =
225 define createMigrations
225 define createMigrations
@@ -283,7 +283,7 @@ type MigrationsTable =
283
283
284-- | Creates a `MigrationsTable` if it does not already exist.
284-- | Creates a `MigrationsTable` if it does not already exist.
285createMigrations
285createMigrations
286− :: Has "schema_migrations" schema MigrationsTable
286+ :: Has "schema_migrations" (TablesOf schema) MigrationsTable
287 => Definition schema schema
287 => Definition schema schema
288createMigrations =
288createMigrations =
289 createTableIfNotExists #schema_migrations
289 createTableIfNotExists #schema_migrations
@@ -294,7 +294,7 @@ createMigrations =
294
294
295-- | Inserts a `Migration` into the `MigrationsTable`
295-- | Inserts a `Migration` into the `MigrationsTable`
296insertMigration
296insertMigration
297− :: Has "schema_migrations" schema MigrationsTable
297+ :: Has "schema_migrations" (TablesOf schema) MigrationsTable
298 => Manipulation schema '[ 'NotNull 'PGtext] '[]
298 => Manipulation schema '[ 'NotNull 'PGtext] '[]
299insertMigration = insertRow_ #schema_migrations
299insertMigration = insertRow_ #schema_migrations
300 ( Set (param @1) `As` #name :*
300 ( Set (param @1) `As` #name :*
@@ -302,7 +302,7 @@ insertMigration = insertRow_ #schema_migrations
302
302
303-- | Deletes a `Migration` from the `MigrationsTable`
303-- | Deletes a `Migration` from the `MigrationsTable`
304deleteMigration
304deleteMigration
305− :: Has "schema_migrations" schema MigrationsTable
305+ :: Has "schema_migrations" (TablesOf schema) MigrationsTable
306 => Manipulation schema '[ 'NotNull 'PGtext ] '[]
306 => Manipulation schema '[ 'NotNull 'PGtext ] '[]
307deleteMigration = deleteFrom_ #schema_migrations (#name .== param @1)
307deleteMigration = deleteFrom_ #schema_migrations (#name .== param @1)
308
308
squeal-postgresql/src/Squeal/PostgreSQL/PQ.hs+2−2
@@ -160,8 +160,8 @@ lowerConnection (K conn) = K conn
160-- | We keep track of the schema via an Atkey indexed state monad transformer,
160-- | We keep track of the schema via an Atkey indexed state monad transformer,
161-- `PQ`.
161-- `PQ`.
162newtype PQ
162newtype PQ
163− (schema0 :: TablesType)
163+ (schema0 :: SchemaType)
164− (schema1 :: TablesType)
164+ (schema1 :: SchemaType)
165 (m :: Type -> Type)
165 (m :: Type -> Type)
166 (x :: Type) =
166 (x :: Type) =
167 PQ { unPQ :: K LibPQ.Connection schema0 -> m (K x schema1) }
167 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
43import Squeal.PostgreSQL.Schema
43import Squeal.PostgreSQL.Schema
44
44
45-- | `PoolPQ` @schema@ should be a drop-in replacement for `PQ` @schema schema@.
45-- | `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 =
47 PoolPQ { runPoolPQ :: Pool (K Connection schema) -> m x }
47 PoolPQ { runPoolPQ :: Pool (K Connection schema) -> m x }
48 deriving Functor
48 deriving Functor
49
49
squeal-postgresql/src/Squeal/PostgreSQL/Query.hs+2−2
@@ -281,7 +281,7 @@ in renderQuery query
281"(SELECT * FROM \"tab\" AS \"t\") UNION ALL (SELECT * FROM \"tab\" AS \"t\")"
281"(SELECT * FROM \"tab\" AS \"t\") UNION ALL (SELECT * FROM \"tab\" AS \"t\")"
282-}
282-}
283newtype Query
283newtype Query
284− (schema :: TablesType)
284+ (schema :: SchemaType)
285 (params :: [NullityType])
285 (params :: [NullityType])
286 (columns :: RelationType)
286 (columns :: RelationType)
287 = UnsafeQuery { renderQuery :: ByteString }
287 = UnsafeQuery { renderQuery :: ByteString }
@@ -443,7 +443,7 @@ Table Expressions
443-- to a table on disk, a so-called base table, but more complex expressions
443-- to a table on disk, a so-called base table, but more complex expressions
444-- can be used to modify or combine base tables in various ways.
444-- can be used to modify or combine base tables in various ways.
445data TableExpression
445data TableExpression
446− (schema :: TablesType)
446+ (schema :: SchemaType)
447 (params :: [NullityType])
447 (params :: [NullityType])
448 (relations :: RelationsType)
448 (relations :: RelationsType)
449 (grouping :: Grouping)
449 (grouping :: Grouping)
squeal-postgresql/src/Squeal/PostgreSQL/Schema.hs+32
@@ -99,6 +99,12 @@ module Squeal.PostgreSQL.Schema
99 -- * Generics
99 -- * Generics
100 , SameField
100 , SameField
101 , SameFields
101 , SameFields
102+ -- * Schema
103+ , SchemumType (..)
104+ , SchemaType
105+ , TablesOf
106+ , ViewsOf
107+ , With
102 ) where
108 ) where
103
109
104import Control.DeepSeq
110import Control.DeepSeq
@@ -611,3 +617,29 @@ type family DropIfConstraintsInvolve column constraints where
611 = If (ConstraintInvolves column constraint)
617 = If (ConstraintInvolves column constraint)
612 (DropIfConstraintsInvolve column constraints)
618 (DropIfConstraintsInvolve column constraints)
613 (alias ::: constraint ': DropIfConstraintsInvolve column constraints)
619 (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