git.iko.soy/squeal
on dev help sign in
Merge pull request #75 from morphismtech/dev-commons-schemas
33d1550Eitan Chatav
squeal-postgresql/exe/Example.hs+10−6
compare with dev
unifiedsplit
@@ -41,7 +41,11 @@ type Schema =
41 ])
41 ])
42 ]
42 ]
43
43
44+type Schemas = Public Schema
45+
46+type DB = DBof Schemas
47+
44−setup :: Definition '[] Schema
48+setup :: Definition (Public '[]) Schemas
45setup =
49setup =
46 createTable #users
50 createTable #users
47 ( serial `as` #id :*
51 ( serial `as` #id :*
@@ -57,23 +61,23 @@ setup =
57 foreignKey #user_id #users #id
61 foreignKey #user_id #users #id
58 OnDeleteCascade OnUpdateCascade `as` #fk_user_id )
62 OnDeleteCascade OnUpdateCascade `as` #fk_user_id )
59
63
60−teardown :: Definition Schema '[]
64+teardown :: Definition Schemas (Public '[])
61teardown = dropTable #emails >>> dropTable #users
65teardown = dropTable #emails >>> dropTable #users
62
66
63−insertUser :: Manipulation Schema '[ 'NotNull 'PGtext, 'NotNull ('PGvararray ('Null 'PGint2))]
67+insertUser :: Manipulation DB '[ 'NotNull 'PGtext, 'NotNull ('PGvararray ('Null 'PGint2))]
64 '[ "fromOnly" ::: 'NotNull 'PGint4 ]
68 '[ "fromOnly" ::: 'NotNull 'PGint4 ]
65insertUser = insertRows #users
69insertUser = insertRows #users
66 (Default `as` #id :* Set (param @1) `as` #name :* Set (param @2) `as` #vec) []
70 (Default `as` #id :* Set (param @1) `as` #name :* Set (param @2) `as` #vec) []
67 OnConflictDoNothing (Returning (#id `as` #fromOnly))
71 OnConflictDoNothing (Returning (#id `as` #fromOnly))
68
72
69−insertEmail :: Manipulation Schema '[ 'NotNull 'PGint4, 'Null 'PGtext] '[]
73+insertEmail :: Manipulation DB '[ 'NotNull 'PGint4, 'Null 'PGtext] '[]
70insertEmail = insertRows #emails
74insertEmail = insertRows #emails
71 ( Default `as` #id :*
75 ( Default `as` #id :*
72 Set (param @1) `as` #user_id :*
76 Set (param @1) `as` #user_id :*
73 Set (param @2) `as` #email ) []
77 Set (param @2) `as` #email ) []
74 OnConflictDoNothing (Returning Nil)
78 OnConflictDoNothing (Returning Nil)
75
79
76−getUsers :: Query Schema '[]
80+getUsers :: Query DB '[]
77 '[ "userName" ::: 'NotNull 'PGtext
81 '[ "userName" ::: 'NotNull 'PGtext
78 , "userEmail" ::: 'Null 'PGtext
82 , "userEmail" ::: 'Null 'PGtext
79 , "userVec" ::: 'NotNull ('PGvararray ('Null 'PGint2))]
83 , "userVec" ::: 'NotNull ('PGvararray ('Null 'PGint2))]
@@ -95,7 +99,7 @@ users =
95 , User "Carole" (Just "carole@hotmail.com") [Just 3]
99 , User "Carole" (Just "carole@hotmail.com") [Just 3]
96 ]
100 ]
97
101
98−session :: (MonadBase IO pq, MonadPQ Schema pq) => pq ()
102+session :: (MonadBase IO pq, MonadPQ Schemas pq) => pq ()
99session = do
103session = do
100 liftBase $ Char8.putStrLn "manipulating"
104 liftBase $ Char8.putStrLn "manipulating"
101 idResults <- traversePrepared insertUser ([(userName user, userVec user) | user <- users])
105 idResults <- traversePrepared insertUser ([(userName user, userVec user) | user <- users])
squeal-postgresql/squeal-postgresql.cabal+1−1
@@ -1,5 +1,5 @@
1name: squeal-postgresql
1name: squeal-postgresql
2−version: 0.4.0.0
2+version: 0.4.9.0
3synopsis: Squeal PostgreSQL Library
3synopsis: Squeal PostgreSQL Library
4description: Squeal is a type-safe embedding of PostgreSQL in Haskell
4description: Squeal is a type-safe embedding of PostgreSQL in Haskell
5homepage: https://github.com/morphismtech/squeal
5homepage: https://github.com/morphismtech/squeal
squeal-postgresql/src/Squeal/PostgreSQL.hs+23−22
@@ -32,26 +32,27 @@ The first step is to define the schema of our database. This is where
32we use @DataKinds@ and @TypeOperators@.
32we use @DataKinds@ and @TypeOperators@.
33
33
34>>> :{
34>>> :{
35+type UsersColumns =
36+ '[ "id" ::: 'Def :=> 'NotNull 'PGint4
37+ , "name" ::: 'NoDef :=> 'NotNull 'PGtext ]
38+type UsersConstraints = '[ "pk_users" ::: 'PrimaryKey '["id"] ]
39+type EmailsColumns =
40+ '[ "id" ::: 'Def :=> 'NotNull 'PGint4
41+ , "user_id" ::: 'NoDef :=> 'NotNull 'PGint4
42+ , "email" ::: 'NoDef :=> 'Null 'PGtext ]
43+type EmailsConstraints =
44+ '[ "pk_emails" ::: 'PrimaryKey '["id"]
45+ , "fk_user_id" ::: 'ForeignKey '["user_id"] "users" '["id"] ]
35type Schema =
46type Schema =
36− '[ "users" ::: 'Table (
47+ '[ "users" ::: 'Table (UsersConstraints :=> UsersColumns)
37− '[ "pk_users" ::: 'PrimaryKey '["id"] ] :=>
38− '[ "id" ::: 'Def :=> 'NotNull 'PGint4
39− , "name" ::: 'NoDef :=> 'NotNull 'PGtext
40− ])
41− , "emails" ::: 'Table (
48+ , "emails" ::: 'Table (EmailsConstraints :=> EmailsColumns) ]
42− '[ "pk_emails" ::: 'PrimaryKey '["id"]
49+type Schemas = Public Schema
43− , "fk_user_id" ::: 'ForeignKey '["user_id"] "users" '["id"]
50+type DB = DBof Schemas
44− ] :=>
45− '[ "id" ::: 'Def :=> 'NotNull 'PGint4
46− , "user_id" ::: 'NoDef :=> 'NotNull 'PGint4
47− , "email" ::: 'NoDef :=> 'Null 'PGtext
48− ])
49− ]
50:}
51:}
51
52
52Notice the use of type operators.
53Notice the use of type operators.
53
54
54−`:::` is used to pair an alias `GHC.TypeLits.Symbol` with a `SchemumType`,
55+`:::` is used to pair an alias `GHC.TypeLits.Symbol` with a `SchemasType`, a `SchemumType`,
55a `TableConstraint` or a `ColumnType`. It is intended to connote Haskell's @::@
56a `TableConstraint` or a `ColumnType`. It is intended to connote Haskell's @::@
56operator.
57operator.
57
58
@@ -68,7 +69,7 @@ labels to refer to named tables and columns in our schema.
68
69
69>>> :{
70>>> :{
70let
71let
71− setup :: Definition '[] Schema
72+ setup :: Definition (Public '[]) Schemas
72 setup =
73 setup =
73 createTable #users
74 createTable #users
74 ( serial `as` #id :*
75 ( serial `as` #id :*
@@ -89,14 +90,14 @@ We can easily see the generated SQL is unsurprising looking.
89CREATE TABLE "users" ("id" serial, "name" text NOT NULL, CONSTRAINT "pk_users" PRIMARY KEY ("id"));
90CREATE TABLE "users" ("id" serial, "name" text NOT NULL, CONSTRAINT "pk_users" PRIMARY KEY ("id"));
90CREATE TABLE "emails" ("id" serial, "user_id" int NOT NULL, "email" text NULL, CONSTRAINT "pk_emails" PRIMARY KEY ("id"), CONSTRAINT "fk_user_id" FOREIGN KEY ("user_id") REFERENCES "users" ("id") ON DELETE CASCADE ON UPDATE CASCADE);
91CREATE TABLE "emails" ("id" serial, "user_id" int NOT NULL, "email" text NULL, CONSTRAINT "pk_emails" PRIMARY KEY ("id"), CONSTRAINT "fk_user_id" FOREIGN KEY ("user_id") REFERENCES "users" ("id") ON DELETE CASCADE ON UPDATE CASCADE);
91
92
92−Notice that @setup@ starts with an empty schema @'[]@ and produces @Schema@.
93+Notice that @setup@ starts with an empty public schema @(Public '[])@ and produces @Schemas@.
93In our `createTable` commands we included `TableConstraint`s to define
94In our `createTable` commands we included `TableConstraint`s to define
94primary and foreign keys, making them somewhat complex. Our @teardown@
95primary and foreign keys, making them somewhat complex. Our @teardown@
95`Definition` is simpler.
96`Definition` is simpler.
96
97
97>>> :{
98>>> :{
98let
99let
99− teardown :: Definition Schema '[]
100+ teardown :: Definition Schemas (Public '[])
100 teardown = dropTable #emails >>> dropTable #users
101 teardown = dropTable #emails >>> dropTable #users
101:}
102:}
102
103
@@ -117,7 +118,7 @@ of our inserts.
117
118
118>>> :{
119>>> :{
119let
120let
120− insertUser :: Manipulation Schema '[ 'NotNull 'PGtext ] '[ "fromOnly" ::: 'NotNull 'PGint4 ]
121+ insertUser :: Manipulation DB '[ 'NotNull 'PGtext ] '[ "fromOnly" ::: 'NotNull 'PGint4 ]
121 insertUser = insertRow #users
122 insertUser = insertRow #users
122 (Default `as` #id :* Set (param @1) `as` #name)
123 (Default `as` #id :* Set (param @1) `as` #name)
123 OnConflictDoNothing (Returning (#id `as` #fromOnly))
124 OnConflictDoNothing (Returning (#id `as` #fromOnly))
@@ -125,7 +126,7 @@ let
125
126
126>>> :{
127>>> :{
127let
128let
128− insertEmail :: Manipulation Schema '[ 'NotNull 'PGint4, 'Null 'PGtext] '[]
129+ insertEmail :: Manipulation DB '[ 'NotNull 'PGint4, 'Null 'PGtext] '[]
129 insertEmail = insertRow #emails
130 insertEmail = insertRow #emails
130 ( Default `as` #id :*
131 ( Default `as` #id :*
131 Set (param @1) `as` #user_id :*
132 Set (param @1) `as` #user_id :*
@@ -145,7 +146,7 @@ need to use an inner join to get the right result. A `Query` is like a
145
146
146>>> :{
147>>> :{
147let
148let
148− getUsers :: Query Schema '[]
149+ getUsers :: Query DB '[]
149 '[ "userName" ::: 'NotNull 'PGtext
150 '[ "userName" ::: 'NotNull 'PGtext
150 , "userEmail" ::: 'Null 'PGtext ]
151 , "userEmail" ::: 'Null 'PGtext ]
151 getUsers = select
152 getUsers = select
@@ -190,7 +191,7 @@ transformer and when the schema doesn't change we can use `Monad` and
190
191
191>>> :{
192>>> :{
192let
193let
193− session :: PQ Schema Schema IO ()
194+ session :: PQ Schemas Schemas IO ()
194 session = do
195 session = do
195 idResults <- traversePrepared insertUser (Only . userName <$> users)
196 idResults <- traversePrepared insertUser (Only . userName <$> users)
196 ids <- traverse (fmap fromOnly . getRow 0) idResults
197 ids <- traverse (fmap fromOnly . getRow 0) idResults
squeal-postgresql/src/Squeal/PostgreSQL/Binary.hs+5−5
@@ -27,7 +27,7 @@ round trip query.
27>>> instance HasDatatypeInfo Row
27>>> instance HasDatatypeInfo Row
28>>> :{
28>>> :{
29let
29let
30− roundTrip :: Query '[] (TuplePG Row) (RowPG Row)
30+ roundTrip :: Query (DBof (Public '[])) (TuplePG Row) (RowPG Row)
31 roundTrip = values_ $
31 roundTrip = values_ $
32 parameter @1 int2 `as` #col1 :*
32 parameter @1 int2 `as` #col1 :*
33 parameter @2 text `as` #col2 :*
33 parameter @2 text `as` #col2 :*
@@ -68,7 +68,7 @@ Once again, we define a simple round trip query.
68
68
69>>> :{
69>>> :{
70let
70let
71− roundTrip :: Query '[] (TuplePG Row) (RowPG Row)
71+ roundTrip :: Query (DBof (Public '[])) (TuplePG Row) (RowPG Row)
72 roundTrip = values_ $
72 roundTrip = values_ $
73 parameter @1 (int2 & vararray) `as` #col1 :*
73 parameter @1 (int2 & vararray) `as` #col1 :*
74 parameter @2 (int2 & fixarray @2) `as` #col2 :*
74 parameter @2 (int2 & fixarray @2) `as` #col2 :*
@@ -114,7 +114,7 @@ type Schema =
114
114
115>>> :{
115>>> :{
116let
116let
117− setup :: Definition '[] Schema
117+ setup :: Definition (Public '[]) (Public Schema)
118 setup =
118 setup =
119 createTypeEnumFrom @Schwarma #schwarma >>>
119 createTypeEnumFrom @Schwarma #schwarma >>>
120 createTypeCompositeFrom @Person #person
120 createTypeCompositeFrom @Person #person
@@ -146,7 +146,7 @@ Once again, define a round trip query.
146
146
147>>> :{
147>>> :{
148let
148let
149− roundTrip :: Query Schema (TuplePG Row) (RowPG Row)
149+ roundTrip :: Query (DBof (Public Schema)) (TuplePG Row) (RowPG Row)
150 roundTrip = values_ $
150 roundTrip = values_ $
151 parameter @1 (typedef #schwarma) `as` #schwarma :*
151 parameter @1 (typedef #schwarma) `as` #schwarma :*
152 parameter @2 (typedef #person) `as` #person1 :*
152 parameter @2 (typedef #person) `as` #person1 :*
@@ -157,7 +157,7 @@ Finally, we can drop our type definitions.
157
157
158>>> :{
158>>> :{
159let
159let
160− teardown :: Definition Schema '[]
160+ teardown :: Definition (Public Schema) (Public '[])
161 teardown = dropType #schwarma >>> dropType #person
161 teardown = dropType #schwarma >>> dropType #person
162:}
162:}
163
163
squeal-postgresql/src/Squeal/PostgreSQL/Definition.hs+220−171
@@ -33,6 +33,8 @@ module Squeal.PostgreSQL.Definition
33 , (>>>)
33 , (>>>)
34 -- * Tables
34 -- * Tables
35 -- ** Create
35 -- ** Create
36+ , createSchema
37+ , createSchemaIfNotExists
36 , createTable
38 , createTable
37 , createTableIfNotExists
39 , createTableIfNotExists
38 , TableConstraintExpression (..)
40 , TableConstraintExpression (..)
@@ -104,16 +106,16 @@ import Squeal.PostgreSQL.Schema
104statements
106statements
105-----------------------------------------}
107-----------------------------------------}
106
108
107−-- | A `Definition` is a statement that changes the schema of the
109+-- | A `Definition` is a statement that changes the schemas of the
108-- database, like a `createTable`, `dropTable`, or `alterTable` command.
110-- database, like a `createTable`, `dropTable`, or `alterTable` command.
109-- `Definition`s may be composed using the `>>>` operator.
111-- `Definition`s may be composed using the `>>>` operator.
110newtype Definition
112newtype Definition
111− (schema0 :: SchemaType)
113+ (schemas0 :: SchemasType)
112− (schema1 :: SchemaType)
114+ (schemas1 :: SchemasType)
113 = UnsafeDefinition { renderDefinition :: ByteString }
115 = UnsafeDefinition { renderDefinition :: ByteString }
114 deriving (GHC.Generic,Show,Eq,Ord,NFData)
116 deriving (GHC.Generic,Show,Eq,Ord,NFData)
115
117
116−instance RenderSQL (Definition schema0 schema1) where
118+instance RenderSQL (Definition schemas0 schemas1) where
117 renderSQL = renderDefinition
119 renderSQL = renderDefinition
118
120
119instance Category Definition where
121instance Category Definition where
@@ -125,6 +127,21 @@ instance Category Definition where
125CREATE statements
127CREATE statements
126-----------------------------------------}
128-----------------------------------------}
127
129
130+createSchema
131+ :: KnownSymbol sch
132+ => Alias sch
133+ -> Definition schemas (Create sch '[] schemas)
134+createSchema sch = UnsafeDefinition $
135+ "CREATE" <+> "SCHEMA" <+> renderAlias sch <> ";"
136+
137+createSchemaIfNotExists
138+ :: (KnownSymbol sch, Has sch schemas schema)
139+ => Alias sch
140+ -> Definition schemas schemas
141+createSchemaIfNotExists sch = UnsafeDefinition $
142+ "CREATE" <+> "SCHEMA" <+> "IF" <+> "NOT" <+> "EXISTS"
143+ <+> renderAlias sch <> ";"
144+
128{- | `createTable` adds a table to the schema.
145{- | `createTable` adds a table to the schema.
129
146
130>>> :set -XOverloadedLabels
147>>> :set -XOverloadedLabels
@@ -136,7 +153,7 @@ type Table = '[] :=>
136
153
137>>> :{
154>>> :{
138let
155let
139− setup :: Definition '[] '["tab" ::: 'Table Table]
156+ setup :: Definition (Public '[]) (Public '["tab" ::: 'Table Table])
140 setup = createTable #tab
157 setup = createTable #tab
141 (nullable int `as` #a :* nullable real `as` #b) Nil
158 (nullable int `as` #a :* nullable real `as` #b) Nil
142in printSQL setup
159in printSQL setup
@@ -144,17 +161,19 @@ in printSQL setup
144CREATE TABLE "tab" ("a" int NULL, "b" real NULL);
161CREATE TABLE "tab" ("a" int NULL, "b" real NULL);
145-}
162-}
146createTable
163createTable
147− :: ( KnownSymbol table
164+ :: ( KnownSymbol sch
165+ , KnownSymbol tab
148 , columns ~ (col ': cols)
166 , columns ~ (col ': cols)
149 , SOP.SListI columns
167 , SOP.SListI columns
150 , SOP.SListI constraints
168 , SOP.SListI constraints
169+ , Has sch schemas0 schema0
151− , schema1 ~ Create table ('Table (constraints :=> columns)) schema0 )
170+ , schemas1 ~ Alter sch (Create tab ('Table (constraints :=> columns)) schema0) schemas0 )
152− => Alias table -- ^ the name of the table to add
171+ => QualifiedAlias sch tab -- ^ the name of the table to add
153− -> NP (Aliased (ColumnTypeExpression schema0)) columns
172+ -> NP (Aliased (ColumnTypeExpression schemas0)) columns
154 -- ^ the names and datatype of each column
173 -- ^ the names and datatype of each column
155− -> NP (Aliased (TableConstraintExpression schema1 table)) constraints
174+ -> NP (Aliased (TableConstraintExpression sch tab schemas1)) constraints
156 -- ^ constraints that must hold for the table
175 -- ^ constraints that must hold for the table
157− -> Definition schema0 schema1
176+ -> Definition schemas0 schemas1
158createTable tab columns constraints = UnsafeDefinition $
177createTable tab columns constraints = UnsafeDefinition $
159 "CREATE TABLE" <+> renderCreation tab columns constraints
178 "CREATE TABLE" <+> renderCreation tab columns constraints
160
179
@@ -170,11 +189,11 @@ type Table = '[] :=>
170 , "b" ::: 'NoDef :=> 'Null 'PGfloat4 ]
189 , "b" ::: 'NoDef :=> 'Null 'PGfloat4 ]
171:}
190:}
172
191
173−>>> type Schema = '["tab" ::: 'Table Table]
192+>>> type Schemas = Public '["tab" ::: 'Table Table]
174
193
175>>> :{
194>>> :{
176let
195let
177− setup :: Definition Schema Schema
196+ setup :: Definition Schemas Schemas
178 setup = createTableIfNotExists #tab
197 setup = createTableIfNotExists #tab
179 (nullable int `as` #a :* nullable real `as` #b) Nil
198 (nullable int `as` #a :* nullable real `as` #b) Nil
180in printSQL setup
199in printSQL setup
@@ -182,31 +201,33 @@ in printSQL setup
182CREATE TABLE IF NOT EXISTS "tab" ("a" int NULL, "b" real NULL);
201CREATE TABLE IF NOT EXISTS "tab" ("a" int NULL, "b" real NULL);
183-}
202-}
184createTableIfNotExists
203createTableIfNotExists
204+ :: ( Has sch schemas schema
185− :: ( Has table schema ('Table (constraints :=> columns))
205+ , Has tab schema ('Table (constraints :=> columns))
186 , SOP.SListI columns
206 , SOP.SListI columns
187 , SOP.SListI constraints )
207 , SOP.SListI constraints )
188− => Alias table -- ^ the name of the table to add
208+ => QualifiedAlias sch tab -- ^ the name of the table to add
189− -> NP (Aliased (ColumnTypeExpression schema)) columns
209+ -> NP (Aliased (ColumnTypeExpression schemas)) columns
190 -- ^ the names and datatype of each column
210 -- ^ the names and datatype of each column
191− -> NP (Aliased (TableConstraintExpression schema table)) constraints
211+ -> NP (Aliased (TableConstraintExpression sch tab schemas)) constraints
192 -- ^ constraints that must hold for the table
212 -- ^ constraints that must hold for the table
193− -> Definition schema schema
213+ -> Definition schemas schemas
194createTableIfNotExists tab columns constraints = UnsafeDefinition $
214createTableIfNotExists tab columns constraints = UnsafeDefinition $
195 "CREATE TABLE IF NOT EXISTS"
215 "CREATE TABLE IF NOT EXISTS"
196 <+> renderCreation tab columns constraints
216 <+> renderCreation tab columns constraints
197
217
198-- helper function for `createTable` and `createTableIfNotExists`
218-- helper function for `createTable` and `createTableIfNotExists`
199renderCreation
219renderCreation
200− :: ( KnownSymbol table
220+ :: ( KnownSymbol sch
221+ , KnownSymbol tab
201 , SOP.SListI columns
222 , SOP.SListI columns
202 , SOP.SListI constraints )
223 , SOP.SListI constraints )
203− => Alias table -- ^ the name of the table to add
224+ => QualifiedAlias sch tab -- ^ the name of the table to add
204− -> NP (Aliased (ColumnTypeExpression schema0)) columns
225+ -> NP (Aliased (ColumnTypeExpression schemas0)) columns
205 -- ^ the names and datatype of each column
226 -- ^ the names and datatype of each column
206− -> NP (Aliased (TableConstraintExpression schema1 table)) constraints
227+ -> NP (Aliased (TableConstraintExpression sch tab schemas1)) constraints
207 -- ^ constraints that must hold for the table
228 -- ^ constraints that must hold for the table
208 -> ByteString
229 -> ByteString
209−renderCreation tab columns constraints = renderAlias tab
230+renderCreation tab columns constraints = renderQualifiedAlias tab
210 <+> parenthesized
231 <+> parenthesized
211 ( renderCommaSeparated renderColumnDef columns
232 ( renderCommaSeparated renderColumnDef columns
212 <> ( case constraints of
233 <> ( case constraints of
@@ -215,11 +236,11 @@ renderCreation tab columns constraints = renderAlias tab
215 renderCommaSeparated renderConstraint constraints ) )
236 renderCommaSeparated renderConstraint constraints ) )
216 <> ";"
237 <> ";"
217 where
238 where
218− renderColumnDef :: Aliased (ColumnTypeExpression schema) x -> ByteString
239+ renderColumnDef :: Aliased (ColumnTypeExpression schemas) x -> ByteString
219 renderColumnDef (ty `As` column) =
240 renderColumnDef (ty `As` column) =
220 renderAlias column <+> renderColumnTypeExpression ty
241 renderAlias column <+> renderColumnTypeExpression ty
221 renderConstraint
242 renderConstraint
222− :: Aliased (TableConstraintExpression schema columns) constraint
243+ :: Aliased (TableConstraintExpression sch tab schemas) constraint
223 -> ByteString
244 -> ByteString
224 renderConstraint (constraint `As` alias) =
245 renderConstraint (constraint `As` alias) =
225 "CONSTRAINT" <+> renderAlias alias <+> renderTableConstraintExpression constraint
246 "CONSTRAINT" <+> renderAlias alias <+> renderTableConstraintExpression constraint
@@ -237,9 +258,10 @@ renderCreation tab columns constraints = renderAlias tab
237-- violate a constraint, an error is raised. This applies
258-- violate a constraint, an error is raised. This applies
238-- even if the value came from the default value definition.
259-- even if the value came from the default value definition.
239newtype TableConstraintExpression
260newtype TableConstraintExpression
240− (schema :: SchemaType)
261+ (sch :: Symbol)
241− (table :: Symbol)
262+ (tab :: Symbol)
263+ (schemas :: SchemasType)
242− (tableConstraint :: TableConstraint)
264+ (constraint :: TableConstraint)
243 = UnsafeTableConstraintExpression
265 = UnsafeTableConstraintExpression
244 { renderTableConstraintExpression :: ByteString }
266 { renderTableConstraintExpression :: ByteString }
245 deriving (GHC.Generic,Show,Eq,Ord,NFData)
267 deriving (GHC.Generic,Show,Eq,Ord,NFData)
@@ -258,7 +280,7 @@ type Schema = '[
258
280
259>>> :{
281>>> :{
260let
282let
261− definition :: Definition '[] Schema
283+ definition :: Definition (Public '[]) (Public Schema)
262 definition = createTable #tab
284 definition = createTable #tab
263 ( (int & notNullable) `as` #a :*
285 ( (int & notNullable) `as` #a :*
264 (int & notNullable) `as` #b )
286 (int & notNullable) `as` #b )
@@ -269,13 +291,14 @@ let
269CREATE TABLE "tab" ("a" int NOT NULL, "b" int NOT NULL, CONSTRAINT "inequality" CHECK (("a" > "b")));
291CREATE TABLE "tab" ("a" int NOT NULL, "b" int NOT NULL, CONSTRAINT "inequality" CHECK (("a" > "b")));
270-}
292-}
271check
293check
294+ :: ( Has sch schemas schema
272− :: ( Has alias schema ('Table table)
295+ , Has tab schema ('Table table)
273 , HasAll aliases (TableToRow table) subcolumns )
296 , HasAll aliases (TableToRow table) subcolumns )
274 => NP Alias aliases
297 => NP Alias aliases
275 -- ^ specify the subcolumns which are getting checked
298 -- ^ specify the subcolumns which are getting checked
276− -> (forall tab. Condition schema '[tab ::: subcolumns] 'Ungrouped '[])
299+ -> (forall t. Condition ('[] :=> schemas) '[t ::: subcolumns] 'Ungrouped '[])
277 -- ^ a closed `Condition` on those subcolumns
300 -- ^ a closed `Condition` on those subcolumns
278− -> TableConstraintExpression schema alias ('Check aliases)
301+ -> TableConstraintExpression sch tab schemas ('Check aliases)
279check _cols condition = UnsafeTableConstraintExpression $
302check _cols condition = UnsafeTableConstraintExpression $
280 "CHECK" <+> parenthesized (renderExpression condition)
303 "CHECK" <+> parenthesized (renderExpression condition)
281
304
@@ -292,7 +315,7 @@ type Schema = '[
292
315
293>>> :{
316>>> :{
294let
317let
295− definition :: Definition '[] Schema
318+ definition :: Definition (Public '[]) (Public Schema)
296 definition = createTable #tab
319 definition = createTable #tab
297 ( (int & nullable) `as` #a :*
320 ( (int & nullable) `as` #a :*
298 (int & nullable) `as` #b )
321 (int & nullable) `as` #b )
@@ -303,11 +326,12 @@ let
303CREATE TABLE "tab" ("a" int NULL, "b" int NULL, CONSTRAINT "uq_a_b" UNIQUE ("a", "b"));
326CREATE TABLE "tab" ("a" int NULL, "b" int NULL, CONSTRAINT "uq_a_b" UNIQUE ("a", "b"));
304-}
327-}
305unique
328unique
329+ :: ( Has sch schemas schema
306− :: ( Has alias schema ('Table table)
330+ , Has tab schema('Table table)
307 , HasAll aliases (TableToRow table) subcolumns )
331 , HasAll aliases (TableToRow table) subcolumns )
308 => NP Alias aliases
332 => NP Alias aliases
309 -- ^ specify subcolumns which together are unique for each row
333 -- ^ specify subcolumns which together are unique for each row
310− -> TableConstraintExpression schema alias ('Unique aliases)
334+ -> TableConstraintExpression sch tab schemas ('Unique aliases)
311unique columns = UnsafeTableConstraintExpression $
335unique columns = UnsafeTableConstraintExpression $
312 "UNIQUE" <+> parenthesized (commaSeparated (renderAliases columns))
336 "UNIQUE" <+> parenthesized (commaSeparated (renderAliases columns))
313
337
@@ -325,7 +349,7 @@ type Schema = '[
325
349
326>>> :{
350>>> :{
327let
351let
328− definition :: Definition '[] Schema
352+ definition :: Definition (Public '[]) (Public Schema)
329 definition = createTable #tab
353 definition = createTable #tab
330 ( serial `as` #id :*
354 ( serial `as` #id :*
331 (text & notNullable) `as` #name )
355 (text & notNullable) `as` #name )
@@ -336,12 +360,13 @@ let
336CREATE TABLE "tab" ("id" serial, "name" text NOT NULL, CONSTRAINT "pk_id" PRIMARY KEY ("id"));
360CREATE TABLE "tab" ("id" serial, "name" text NOT NULL, CONSTRAINT "pk_id" PRIMARY KEY ("id"));
337-}
361-}
338primaryKey
362primaryKey
363+ :: ( Has sch schemas schema
339− :: ( Has alias schema ('Table table)
364+ , Has tab schema ('Table table)
340 , HasAll aliases (TableToColumns table) subcolumns
365 , HasAll aliases (TableToColumns table) subcolumns
341 , AllNotNull subcolumns )
366 , AllNotNull subcolumns )
342 => NP Alias aliases
367 => NP Alias aliases
343 -- ^ specify the subcolumns which together form a primary key.
368 -- ^ specify the subcolumns which together form a primary key.
344− -> TableConstraintExpression schema alias ('PrimaryKey aliases)
369+ -> TableConstraintExpression sch tab schemas ('PrimaryKey aliases)
345primaryKey columns = UnsafeTableConstraintExpression $
370primaryKey columns = UnsafeTableConstraintExpression $
346 "PRIMARY KEY" <+> parenthesized (commaSeparated (renderAliases columns))
371 "PRIMARY KEY" <+> parenthesized (commaSeparated (renderAliases columns))
347
372
@@ -370,7 +395,7 @@ type Schema =
370
395
371>>> :{
396>>> :{
372let
397let
373− setup :: Definition '[] Schema
398+ setup :: Definition (Public '[]) (Public Schema)
374 setup =
399 setup =
375 createTable #users
400 createTable #users
376 ( serial `as` #id :*
401 ( serial `as` #id :*
@@ -405,7 +430,7 @@ type Schema =
405
430
406>>> :{
431>>> :{
407let
432let
408− setup :: Definition '[] Schema
433+ setup :: Definition (Public '[]) (Public Schema)
409 setup =
434 setup =
410 createTable #employees
435 createTable #employees
411 ( serial `as` #id :*
436 ( serial `as` #id :*
@@ -419,7 +444,7 @@ in printSQL setup
419CREATE TABLE "employees" ("id" serial, "name" text NOT NULL, "employer_id" integer NULL, CONSTRAINT "employees_pk" PRIMARY KEY ("id"), CONSTRAINT "employees_employer_fk" FOREIGN KEY ("employer_id") REFERENCES "employees" ("id") ON DELETE CASCADE ON UPDATE CASCADE);
444CREATE TABLE "employees" ("id" serial, "name" text NOT NULL, "employer_id" integer NULL, CONSTRAINT "employees_pk" PRIMARY KEY ("id"), CONSTRAINT "employees_employer_fk" FOREIGN KEY ("employer_id") REFERENCES "employees" ("id") ON DELETE CASCADE ON UPDATE CASCADE);
420-}
445-}
421foreignKey
446foreignKey
422− :: (ForeignKeyed schema child parent
447+ :: (ForeignKeyed schemas sch schema child parent
423 table reftable
448 table reftable
424 columns refcolumns
449 columns refcolumns
425 constraints cols
450 constraints cols
@@ -434,7 +459,7 @@ foreignKey
434 -- ^ what to do when reference is deleted
459 -- ^ what to do when reference is deleted
435 -> OnUpdateClause
460 -> OnUpdateClause
436 -- ^ what to do when reference is updated
461 -- ^ what to do when reference is updated
437− -> TableConstraintExpression schema child
462+ -> TableConstraintExpression sch child schemas
438 ('ForeignKey columns parent refcolumns)
463 ('ForeignKey columns parent refcolumns)
439foreignKey keys parent refs ondel onupd = UnsafeTableConstraintExpression $
464foreignKey keys parent refs ondel onupd = UnsafeTableConstraintExpression $
440 "FOREIGN KEY" <+> parenthesized (commaSeparated (renderAliases keys))
465 "FOREIGN KEY" <+> parenthesized (commaSeparated (renderAliases keys))
@@ -444,13 +469,16 @@ foreignKey keys parent refs ondel onupd = UnsafeTableConstraintExpression $
444 <+> renderOnUpdateClause onupd
469 <+> renderOnUpdateClause onupd
445
470
446-- | A constraint synonym between types involved in a foreign key constraint.
471-- | A constraint synonym between types involved in a foreign key constraint.
447−type ForeignKeyed schema
472+type ForeignKeyed schemas
473+ sch
474+ schema
448 child parent
475 child parent
449 table reftable
476 table reftable
450 columns refcolumns
477 columns refcolumns
451 constraints cols
478 constraints cols
452 reftys tys =
479 reftys tys =
480+ ( Has sch schemas schema
453− ( Has child schema ('Table table)
481+ , Has child schema ('Table table)
454 , Has parent schema ('Table reftable)
482 , Has parent schema ('Table reftable)
455 , HasAll columns (TableToColumns table) tys
483 , HasAll columns (TableToColumns table) tys
456 , reftable ~ (constraints :=> cols)
484 , reftable ~ (constraints :=> cols)
@@ -505,17 +533,18 @@ DROP statements
505--
533--
506-- >>> :{
534-- >>> :{
507-- let
535-- let
508−-- definition :: Definition '["muh_table" ::: 'Table t] '[]
536+-- definition :: Definition '["public" ::: '["muh_table" ::: 'Table t]] (Public '[])
509-- definition = dropTable #muh_table
537-- definition = dropTable #muh_table
510-- :}
538-- :}
511--
539--
512-- >>> printSQL definition
540-- >>> printSQL definition
513-- DROP TABLE "muh_table";
541-- DROP TABLE "muh_table";
514dropTable
542dropTable
543+ :: ( Has sch schemas schema
515− :: Has table schema ('Table t)
544+ , Has tab schema ('Table table))
516− => Alias table -- ^ table to remove
545+ => QualifiedAlias sch tab -- ^ table to remove
517− -> Definition schema (Drop table schema)
546+ -> Definition schemas (Alter sch (Drop tab schema) schemas)
518−dropTable tab = UnsafeDefinition $ "DROP TABLE" <+> renderAlias tab <> ";"
547+dropTable tab = UnsafeDefinition $ "DROP TABLE" <+> renderQualifiedAlias tab <> ";"
519
548
520{-----------------------------------------
549{-----------------------------------------
521ALTER statements
550ALTER statements
@@ -523,13 +552,13 @@ ALTER statements
523
552
524-- | `alterTable` changes the definition of a table from the schema.
553-- | `alterTable` changes the definition of a table from the schema.
525alterTable
554alterTable
526− :: KnownSymbol alias
555+ :: (Has sch schemas schema, Has tab schema ('Table table0))
527− => Alias alias -- ^ table to alter
556+ => QualifiedAlias sch tab -- ^ table to alter
528− -> AlterTable alias table schema -- ^ alteration to perform
557+ -> AlterTable sch tab schemas table1 -- ^ alteration to perform
529− -> Definition schema (Alter alias ('Table table) schema)
558+ -> Definition schemas (Alter sch (Alter tab ('Table table1) schema) schemas)
530alterTable tab alteration = UnsafeDefinition $
559alterTable tab alteration = UnsafeDefinition $
531 "ALTER TABLE"
560 "ALTER TABLE"
532− <+> renderAlias tab
561+ <+> renderQualifiedAlias tab
533 <+> renderAlterTable alteration
562 <+> renderAlterTable alteration
534 <> ";"
563 <> ";"
535
564
@@ -549,9 +578,10 @@ alterTableRename table0 table1 = UnsafeDefinition $
549-- | An `AlterTable` describes the alteration to perform on the columns
578-- | An `AlterTable` describes the alteration to perform on the columns
550-- of a table.
579-- of a table.
551newtype AlterTable
580newtype AlterTable
581+ (sch :: Symbol)
552− (alias :: Symbol)
582+ (tab :: Symbol)
583+ (schemas :: SchemasType)
553− (table :: TableType)
584+ (table :: TableType) =
554− (schema :: SchemaType) =
555 UnsafeAlterTable {renderAlterTable :: ByteString}
585 UnsafeAlterTable {renderAlterTable :: ByteString}
556 deriving (GHC.Generic,Show,Eq,Ord,NFData)
586 deriving (GHC.Generic,Show,Eq,Ord,NFData)
557
587
@@ -560,21 +590,22 @@ newtype AlterTable
560-- >>> :{
590-- >>> :{
561-- let
591-- let
562-- definition :: Definition
592-- definition :: Definition
563−-- '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'NotNull 'PGint4])]
593+-- '["public" ::: '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'NotNull 'PGint4])]]
564−-- '["tab" ::: 'Table ('["positive" ::: Check '["col"]] :=> '["col" ::: 'NoDef :=> 'NotNull 'PGint4])]
594+-- '["public" ::: '["tab" ::: 'Table ('["positive" ::: 'Check '["col"]] :=> '["col" ::: 'NoDef :=> 'NotNull 'PGint4])]]
565-- definition = alterTable #tab (addConstraint #positive (check #col (#col .> 0)))
595-- definition = alterTable #tab (addConstraint #positive (check #col (#col .> 0)))
566-- in printSQL definition
596-- in printSQL definition
567-- :}
597-- :}
568-- ALTER TABLE "tab" ADD CONSTRAINT "positive" CHECK (("col" > 0));
598-- ALTER TABLE "tab" ADD CONSTRAINT "positive" CHECK (("col" > 0));
569addConstraint
599addConstraint
570 :: ( KnownSymbol alias
600 :: ( KnownSymbol alias
601+ , Has sch schemas schema
571 , Has tab schema ('Table table0)
602 , Has tab schema ('Table table0)
572 , table0 ~ (constraints :=> columns)
603 , table0 ~ (constraints :=> columns)
573 , table1 ~ (Create alias constraint constraints :=> columns) )
604 , table1 ~ (Create alias constraint constraints :=> columns) )
574 => Alias alias
605 => Alias alias
575− -> TableConstraintExpression schema tab constraint
606+ -> TableConstraintExpression sch tab schemas constraint
576 -- ^ constraint to add
607 -- ^ constraint to add
577− -> AlterTable tab table1 schema
608+ -> AlterTable sch tab schemas table1
578addConstraint alias constraint = UnsafeAlterTable $
609addConstraint alias constraint = UnsafeAlterTable $
579 "ADD" <+> "CONSTRAINT" <+> renderAlias alias
610 "ADD" <+> "CONSTRAINT" <+> renderAlias alias
580 <+> renderTableConstraintExpression constraint
611 <+> renderTableConstraintExpression constraint
@@ -584,20 +615,21 @@ addConstraint alias constraint = UnsafeAlterTable $
584-- >>> :{
615-- >>> :{
585-- let
616-- let
586-- definition :: Definition
617-- definition :: Definition
587−-- '["tab" ::: 'Table ('["positive" ::: Check '["col"]] :=> '["col" ::: 'NoDef :=> 'NotNull 'PGint4])]
618+-- '["public" ::: '["tab" ::: 'Table ('["positive" ::: Check '["col"]] :=> '["col" ::: 'NoDef :=> 'NotNull 'PGint4])]]
588−-- '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'NotNull 'PGint4])]
619+-- '["public" ::: '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'NotNull 'PGint4])]]
589-- definition = alterTable #tab (dropConstraint #positive)
620-- definition = alterTable #tab (dropConstraint #positive)
590-- in printSQL definition
621-- in printSQL definition
591-- :}
622-- :}
592-- ALTER TABLE "tab" DROP CONSTRAINT "positive";
623-- ALTER TABLE "tab" DROP CONSTRAINT "positive";
593dropConstraint
624dropConstraint
594 :: ( KnownSymbol constraint
625 :: ( KnownSymbol constraint
626+ , Has sch schemas schema
595 , Has tab schema ('Table table0)
627 , Has tab schema ('Table table0)
596 , table0 ~ (constraints :=> columns)
628 , table0 ~ (constraints :=> columns)
597 , table1 ~ (Drop constraint constraints :=> columns) )
629 , table1 ~ (Drop constraint constraints :=> columns) )
598 => Alias constraint
630 => Alias constraint
599 -- ^ constraint to drop
631 -- ^ constraint to drop
600− -> AlterTable tab table1 schema
632+ -> AlterTable sch tab schemas table1
601dropConstraint constraint = UnsafeAlterTable $
633dropConstraint constraint = UnsafeAlterTable $
602 "DROP" <+> "CONSTRAINT" <+> renderAlias constraint
634 "DROP" <+> "CONSTRAINT" <+> renderAlias constraint
603
635
@@ -609,10 +641,10 @@ class AddColumn ty where
609 -- >>> :{
641 -- >>> :{
610 -- let
642 -- let
611 -- definition :: Definition
643 -- definition :: Definition
612− -- '["tab" ::: 'Table ('[] :=> '["col1" ::: 'NoDef :=> 'Null 'PGint4])]
644+ -- '["public" ::: '["tab" ::: 'Table ('[] :=> '["col1" ::: 'NoDef :=> 'Null 'PGint4])]]
613− -- '["tab" ::: 'Table ('[] :=>
645+ -- '["public" ::: '["tab" ::: 'Table ('[] :=>
614 -- '[ "col1" ::: 'NoDef :=> 'Null 'PGint4
646 -- '[ "col1" ::: 'NoDef :=> 'Null 'PGint4
615− -- , "col2" ::: 'Def :=> 'Null 'PGtext ])]
647+ -- , "col2" ::: 'Def :=> 'Null 'PGtext ])]]
616 -- definition = alterTable #tab (addColumn #col2 (text & nullable & default_ "foo"))
648 -- definition = alterTable #tab (addColumn #col2 (text & nullable & default_ "foo"))
617 -- in printSQL definition
649 -- in printSQL definition
618 -- :}
650 -- :}
@@ -621,22 +653,22 @@ class AddColumn ty where
621 -- >>> :{
653 -- >>> :{
622 -- let
654 -- let
623 -- definition :: Definition
655 -- definition :: Definition
624− -- '["tab" ::: 'Table ('[] :=> '["col1" ::: 'NoDef :=> 'Null 'PGint4])]
656+ -- '["public" ::: '["tab" ::: 'Table ('[] :=> '["col1" ::: 'NoDef :=> 'Null 'PGint4])]]
625− -- '["tab" ::: 'Table ('[] :=>
657+ -- '["public" ::: '["tab" ::: 'Table ('[] :=>
626 -- '[ "col1" ::: 'NoDef :=> 'Null 'PGint4
658 -- '[ "col1" ::: 'NoDef :=> 'Null 'PGint4
627− -- , "col2" ::: 'NoDef :=> 'Null 'PGtext ])]
659+ -- , "col2" ::: 'NoDef :=> 'Null 'PGtext ])]]
628 -- definition = alterTable #tab (addColumn #col2 (text & nullable))
660 -- definition = alterTable #tab (addColumn #col2 (text & nullable))
629 -- in printSQL definition
661 -- in printSQL definition
630 -- :}
662 -- :}
631 -- ALTER TABLE "tab" ADD COLUMN "col2" text NULL;
663 -- ALTER TABLE "tab" ADD COLUMN "col2" text NULL;
632 addColumn
664 addColumn
633 :: ( KnownSymbol column
665 :: ( KnownSymbol column
666+ , Has sch schemas schema
634 , Has tab schema ('Table table0)
667 , Has tab schema ('Table table0)
635− , table0 ~ (constraints :=> columns)
668+ , table0 ~ (constraints :=> columns) )
636− , table1 ~ (constraints :=> Create column ty columns) )
637 => Alias column -- ^ column to add
669 => Alias column -- ^ column to add
638− -> ColumnTypeExpression schema ty -- ^ type of the new column
670+ -> ColumnTypeExpression schemas ty -- ^ type of the new column
639− -> AlterTable tab table1 schema
671+ -> AlterTable sch tab schemas (constraints :=> Create column ty columns)
640 addColumn column ty = UnsafeAlterTable $
672 addColumn column ty = UnsafeAlterTable $
641 "ADD COLUMN" <+> renderAlias column <+> renderColumnTypeExpression ty
673 "ADD COLUMN" <+> renderAlias column <+> renderColumnTypeExpression ty
642instance {-# OVERLAPPING #-} AddColumn ('Def :=> ty)
674instance {-# OVERLAPPING #-} AddColumn ('Def :=> ty)
@@ -650,21 +682,22 @@ instance {-# OVERLAPPABLE #-} AddColumn ('NoDef :=> 'Null ty)
650-- >>> :{
682-- >>> :{
651-- let
683-- let
652-- definition :: Definition
684-- definition :: Definition
653−-- '["tab" ::: 'Table ('[] :=>
685+-- '["public" ::: '["tab" ::: 'Table ('[] :=>
654-- '[ "col1" ::: 'NoDef :=> 'Null 'PGint4
686-- '[ "col1" ::: 'NoDef :=> 'Null 'PGint4
655−-- , "col2" ::: 'NoDef :=> 'Null 'PGtext ])]
687+-- , "col2" ::: 'NoDef :=> 'Null 'PGtext ])]]
656−-- '["tab" ::: 'Table ('[] :=> '["col1" ::: 'NoDef :=> 'Null 'PGint4])]
688+-- '["public" ::: '["tab" ::: 'Table ('[] :=> '["col1" ::: 'NoDef :=> 'Null 'PGint4])]]
657-- definition = alterTable #tab (dropColumn #col2)
689-- definition = alterTable #tab (dropColumn #col2)
658-- in printSQL definition
690-- in printSQL definition
659-- :}
691-- :}
660-- ALTER TABLE "tab" DROP COLUMN "col2";
692-- ALTER TABLE "tab" DROP COLUMN "col2";
661dropColumn
693dropColumn
662 :: ( KnownSymbol column
694 :: ( KnownSymbol column
695+ , Has sch schemas schema
663 , Has tab schema ('Table table0)
696 , Has tab schema ('Table table0)
664 , table0 ~ (constraints :=> columns)
697 , table0 ~ (constraints :=> columns)
665 , table1 ~ (constraints :=> Drop column columns) )
698 , table1 ~ (constraints :=> Drop column columns) )
666 => Alias column -- ^ column to remove
699 => Alias column -- ^ column to remove
667− -> AlterTable tab table1 schema
700+ -> AlterTable sch tab schemas table1
668dropColumn column = UnsafeAlterTable $
701dropColumn column = UnsafeAlterTable $
669 "DROP COLUMN" <+> renderAlias column
702 "DROP COLUMN" <+> renderAlias column
670
703
@@ -673,8 +706,8 @@ dropColumn column = UnsafeAlterTable $
673-- >>> :{
706-- >>> :{
674-- let
707-- let
675-- definition :: Definition
708-- definition :: Definition
676−-- '["tab" ::: 'Table ('[] :=> '["foo" ::: 'NoDef :=> 'Null 'PGint4])]
709+-- '["public" ::: '["tab" ::: 'Table ('[] :=> '["foo" ::: 'NoDef :=> 'Null 'PGint4])]]
677−-- '["tab" ::: 'Table ('[] :=> '["bar" ::: 'NoDef :=> 'Null 'PGint4])]
710+-- '["public" ::: '["tab" ::: 'Table ('[] :=> '["bar" ::: 'NoDef :=> 'Null 'PGint4])]]
678-- definition = alterTable #tab (renameColumn #foo #bar)
711-- definition = alterTable #tab (renameColumn #foo #bar)
679-- in printSQL definition
712-- in printSQL definition
680-- :}
713-- :}
@@ -682,30 +715,32 @@ dropColumn column = UnsafeAlterTable $
682renameColumn
715renameColumn
683 :: ( KnownSymbol column0
716 :: ( KnownSymbol column0
684 , KnownSymbol column1
717 , KnownSymbol column1
718+ , Has sch schemas schema
685 , Has tab schema ('Table table0)
719 , Has tab schema ('Table table0)
686 , table0 ~ (constraints :=> columns)
720 , table0 ~ (constraints :=> columns)
687 , table1 ~ (constraints :=> Rename column0 column1 columns) )
721 , table1 ~ (constraints :=> Rename column0 column1 columns) )
688 => Alias column0 -- ^ column to rename
722 => Alias column0 -- ^ column to rename
689 -> Alias column1 -- ^ what to rename the column
723 -> Alias column1 -- ^ what to rename the column
690− -> AlterTable tab table1 schema
724+ -> AlterTable sch tab schemas table1
691renameColumn column0 column1 = UnsafeAlterTable $
725renameColumn column0 column1 = UnsafeAlterTable $
692 "RENAME COLUMN" <+> renderAlias column0 <+> "TO" <+> renderAlias column1
726 "RENAME COLUMN" <+> renderAlias column0 <+> "TO" <+> renderAlias column1
693
727
694-- | An `alterColumn` alters a single column.
728-- | An `alterColumn` alters a single column.
695alterColumn
729alterColumn
696 :: ( KnownSymbol column
730 :: ( KnownSymbol column
731+ , Has sch schemas schema
697 , Has tab schema ('Table table0)
732 , Has tab schema ('Table table0)
698 , table0 ~ (constraints :=> columns)
733 , table0 ~ (constraints :=> columns)
699 , Has column columns ty0
734 , Has column columns ty0
700 , tables1 ~ (constraints :=> Alter column ty1 columns))
735 , tables1 ~ (constraints :=> Alter column ty1 columns))
701 => Alias column -- ^ column to alter
736 => Alias column -- ^ column to alter
702− -> AlterColumn schema ty0 ty1 -- ^ alteration to perform
737+ -> AlterColumn schemas ty0 ty1 -- ^ alteration to perform
703− -> AlterTable tab table1 schema
738+ -> AlterTable sch tab schemas table1
704alterColumn column alteration = UnsafeAlterTable $
739alterColumn column alteration = UnsafeAlterTable $
705 "ALTER COLUMN" <+> renderAlias column <+> renderAlterColumn alteration
740 "ALTER COLUMN" <+> renderAlias column <+> renderAlterColumn alteration
706
741
707-- | An `AlterColumn` describes the alteration to perform on a single column.
742-- | An `AlterColumn` describes the alteration to perform on a single column.
708−newtype AlterColumn (schema :: SchemaType) (ty0 :: ColumnType) (ty1 :: ColumnType) =
743+newtype AlterColumn (schemas :: SchemasType) (ty0 :: ColumnType) (ty1 :: ColumnType) =
709 UnsafeAlterColumn {renderAlterColumn :: ByteString}
744 UnsafeAlterColumn {renderAlterColumn :: ByteString}
710 deriving (GHC.Generic,Show,Eq,Ord,NFData)
745 deriving (GHC.Generic,Show,Eq,Ord,NFData)
711
746
@@ -716,15 +751,15 @@ newtype AlterColumn (schema :: SchemaType) (ty0 :: ColumnType) (ty1 :: ColumnTyp
716-- >>> :{
751-- >>> :{
717-- let
752-- let
718-- definition :: Definition
753-- definition :: Definition
719−-- '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'Null 'PGint4])]
754+-- '["public" ::: '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'Null 'PGint4])]]
720−-- '["tab" ::: 'Table ('[] :=> '["col" ::: 'Def :=> 'Null 'PGint4])]
755+-- '["public" ::: '["tab" ::: 'Table ('[] :=> '["col" ::: 'Def :=> 'Null 'PGint4])]]
721-- definition = alterTable #tab (alterColumn #col (setDefault 5))
756-- definition = alterTable #tab (alterColumn #col (setDefault 5))
722-- in printSQL definition
757-- in printSQL definition
723-- :}
758-- :}
724-- ALTER TABLE "tab" ALTER COLUMN "col" SET DEFAULT 5;
759-- ALTER TABLE "tab" ALTER COLUMN "col" SET DEFAULT 5;
725setDefault
760setDefault
726− :: Expression schema '[] 'Ungrouped '[] ty -- ^ default value to set
761+ :: Expression ('[] :=> schemas) '[] 'Ungrouped '[] ty -- ^ default value to set
727− -> AlterColumn schema (constraint :=> ty) ('Def :=> ty)
762+ -> AlterColumn schemas (constraint :=> ty) ('Def :=> ty)
728setDefault expression = UnsafeAlterColumn $
763setDefault expression = UnsafeAlterColumn $
729 "SET DEFAULT" <+> renderExpression expression
764 "SET DEFAULT" <+> renderExpression expression
730
765
@@ -733,13 +768,13 @@ setDefault expression = UnsafeAlterColumn $
733-- >>> :{
768-- >>> :{
734-- let
769-- let
735-- definition :: Definition
770-- definition :: Definition
736−-- '["tab" ::: 'Table ('[] :=> '["col" ::: 'Def :=> 'Null 'PGint4])]
771+-- '["public" ::: '["tab" ::: 'Table ('[] :=> '["col" ::: 'Def :=> 'Null 'PGint4])]]
737−-- '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'Null 'PGint4])]
772+-- '["public" ::: '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'Null 'PGint4])]]
738-- definition = alterTable #tab (alterColumn #col dropDefault)
773-- definition = alterTable #tab (alterColumn #col dropDefault)
739-- in printSQL definition
774-- in printSQL definition
740-- :}
775-- :}
741-- ALTER TABLE "tab" ALTER COLUMN "col" DROP DEFAULT;
776-- ALTER TABLE "tab" ALTER COLUMN "col" DROP DEFAULT;
742−dropDefault :: AlterColumn schema ('Def :=> ty) ('NoDef :=> ty)
777+dropDefault :: AlterColumn schemas ('Def :=> ty) ('NoDef :=> ty)
743dropDefault = UnsafeAlterColumn $ "DROP DEFAULT"
778dropDefault = UnsafeAlterColumn $ "DROP DEFAULT"
744
779
745-- | A `setNotNull` adds a @NOT NULL@ constraint to a column.
780-- | A `setNotNull` adds a @NOT NULL@ constraint to a column.
@@ -749,14 +784,14 @@ dropDefault = UnsafeAlterColumn $ "DROP DEFAULT"
749-- >>> :{
784-- >>> :{
750-- let
785-- let
751-- definition :: Definition
786-- definition :: Definition
752−-- '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'Null 'PGint4])]
787+-- '["public" ::: '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'Null 'PGint4])]]
753−-- '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'NotNull 'PGint4])]
788+-- '["public" ::: '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'NotNull 'PGint4])]]
754-- definition = alterTable #tab (alterColumn #col setNotNull)
789-- definition = alterTable #tab (alterColumn #col setNotNull)
755-- in printSQL definition
790-- in printSQL definition
756-- :}
791-- :}
757-- ALTER TABLE "tab" ALTER COLUMN "col" SET NOT NULL;
792-- ALTER TABLE "tab" ALTER COLUMN "col" SET NOT NULL;
758setNotNull
793setNotNull
759− :: AlterColumn schema (constraint :=> 'Null ty) (constraint :=> 'NotNull ty)
794+ :: AlterColumn schemas (constraint :=> 'Null ty) (constraint :=> 'NotNull ty)
760setNotNull = UnsafeAlterColumn $ "SET NOT NULL"
795setNotNull = UnsafeAlterColumn $ "SET NOT NULL"
761
796
762-- | A `dropNotNull` drops a @NOT NULL@ constraint from a column.
797-- | A `dropNotNull` drops a @NOT NULL@ constraint from a column.
@@ -764,14 +799,14 @@ setNotNull = UnsafeAlterColumn $ "SET NOT NULL"
764-- >>> :{
799-- >>> :{
765-- let
800-- let
766-- definition :: Definition
801-- definition :: Definition
767−-- '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'NotNull 'PGint4])]
802+-- '["public" ::: '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'NotNull 'PGint4])]]
768−-- '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'Null 'PGint4])]
803+-- '["public" ::: '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'Null 'PGint4])]]
769-- definition = alterTable #tab (alterColumn #col dropNotNull)
804-- definition = alterTable #tab (alterColumn #col dropNotNull)
770-- in printSQL definition
805-- in printSQL definition
771-- :}
806-- :}
772-- ALTER TABLE "tab" ALTER COLUMN "col" DROP NOT NULL;
807-- ALTER TABLE "tab" ALTER COLUMN "col" DROP NOT NULL;
773dropNotNull
808dropNotNull
774− :: AlterColumn schema (constraint :=> 'NotNull ty) (constraint :=> 'Null ty)
809+ :: AlterColumn schemas (constraint :=> 'NotNull ty) (constraint :=> 'Null ty)
775dropNotNull = UnsafeAlterColumn $ "DROP NOT NULL"
810dropNotNull = UnsafeAlterColumn $ "DROP NOT NULL"
776
811
777-- | An `alterType` converts a column to a different data type.
812-- | An `alterType` converts a column to a different data type.
@@ -781,37 +816,37 @@ dropNotNull = UnsafeAlterColumn $ "DROP NOT NULL"
781-- >>> :{
816-- >>> :{
782-- let
817-- let
783-- definition :: Definition
818-- definition :: Definition
784−-- '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'NotNull 'PGint4])]
819+-- '["public" ::: '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'NotNull 'PGint4])]]
785−-- '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'NotNull 'PGnumeric])]
820+-- '["public" ::: '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'NotNull 'PGnumeric])]]
786-- definition =
821-- definition =
787-- alterTable #tab (alterColumn #col (alterType (numeric & notNullable)))
822-- alterTable #tab (alterColumn #col (alterType (numeric & notNullable)))
788-- in printSQL definition
823-- in printSQL definition
789-- :}
824-- :}
790-- ALTER TABLE "tab" ALTER COLUMN "col" TYPE numeric NOT NULL;
825-- ALTER TABLE "tab" ALTER COLUMN "col" TYPE numeric NOT NULL;
791−alterType :: ColumnTypeExpression schema ty -> AlterColumn schema ty0 ty
826+alterType :: ColumnTypeExpression schemas ty -> AlterColumn schemas ty0 ty
792alterType ty = UnsafeAlterColumn $ "TYPE" <+> renderColumnTypeExpression ty
827alterType ty = UnsafeAlterColumn $ "TYPE" <+> renderColumnTypeExpression ty
793
828
794−-- | Create a view.
829+{- | Create a view.
795−--
830+>>> type ABC = '["a" ::: 'NoDef :=> 'Null 'PGint4, "b" ::: 'NoDef :=> 'Null 'PGint4, "c" ::: 'NoDef :=> 'Null 'PGint4]
831+>>> type BC = '["b" ::: 'Null 'PGint4, "c" ::: 'Null 'PGint4]
796−-- >>> :{
832+>>> :{
797−-- let
833+let
798−-- definition :: Definition
834+ definition :: Definition
799−-- '[ "abc" ::: 'Table ('[] :=> '["a" ::: 'NoDef :=> 'Null 'PGint4, "b" ::: 'NoDef :=> 'Null 'PGint4, "c" ::: 'NoDef :=> 'Null 'PGint4])]
835+ '[ "public" ::: '["abc" ::: 'Table ('[] :=> ABC)]]
800−-- '[ "abc" ::: 'Table ('[] :=> '["a" ::: 'NoDef :=> 'Null 'PGint4, "b" ::: 'NoDef :=> 'Null 'PGint4, "c" ::: 'NoDef :=> 'Null 'PGint4])
836+ '[ "public" ::: '["abc" ::: 'Table ('[] :=> ABC), "bc" ::: 'View BC]]
801−-- , "bc" ::: 'View ('["b" ::: 'Null 'PGint4, "c" ::: 'Null 'PGint4])]
802−-- definition =
837+ definition =
803−-- createView #bc (select (#b :* #c) (from (table #abc)))
838+ createView #bc (select (#b :* #c) (from (table #abc)))
804−-- in printSQL definition
839+in printSQL definition
805−-- :}
840+:}
806−-- CREATE VIEW "bc" AS SELECT "b" AS "b", "c" AS "c" FROM "abc" AS "abc";
841+CREATE VIEW "bc" AS SELECT "b" AS "b", "c" AS "c" FROM "abc" AS "abc";
842+-}
807createView
843createView
808− :: KnownSymbol view
844+ :: (KnownSymbol sch, KnownSymbol vw, Has sch schemas schema)
809− => Alias view -- ^ the name of the view to add
845+ => QualifiedAlias sch vw -- ^ the name of the view to add
810− -> Query schema '[] row
846+ -> Query ('[] :=> schemas) '[] view -- ^ query
811− -- ^ query
812− -> Definition schema (Create view ('View row) schema)
847+ -> Definition schemas (Alter sch (Create vw ('View view) schema) schemas)
813createView alias query = UnsafeDefinition $
848createView alias query = UnsafeDefinition $
814− "CREATE" <+> "VIEW" <+> renderAlias alias <+> "AS"
849+ "CREATE" <+> "VIEW" <+> renderQualifiedAlias alias <+> "AS"
815 <+> renderQuery query <> ";"
850 <+> renderQuery query <> ";"
816
851
817-- | Drop a view.
852-- | Drop a view.
@@ -819,32 +854,32 @@ createView alias query = UnsafeDefinition $
819-- >>> :{
854-- >>> :{
820-- let
855-- let
821-- definition :: Definition
856-- definition :: Definition
822−-- '[ "abc" ::: 'Table ('[] :=> '["a" ::: 'NoDef :=> 'Null 'PGint4, "b" ::: 'NoDef :=> 'Null 'PGint4, "c" ::: 'NoDef :=> 'Null 'PGint4])
857+-- '[ "public" ::: '["abc" ::: 'Table ('[] :=> '["a" ::: 'NoDef :=> 'Null 'PGint4, "b" ::: 'NoDef :=> 'Null 'PGint4, "c" ::: 'NoDef :=> 'Null 'PGint4])
823−-- , "bc" ::: 'View ('["b" ::: 'Null 'PGint4, "c" ::: 'Null 'PGint4])]
858+-- , "bc" ::: 'View ('["b" ::: 'Null 'PGint4, "c" ::: 'Null 'PGint4])]]
824−-- '[ "abc" ::: 'Table ('[] :=> '["a" ::: 'NoDef :=> 'Null 'PGint4, "b" ::: 'NoDef :=> 'Null 'PGint4, "c" ::: 'NoDef :=> 'Null 'PGint4])]
859+-- '[ "public" ::: '["abc" ::: 'Table ('[] :=> '["a" ::: 'NoDef :=> 'Null 'PGint4, "b" ::: 'NoDef :=> 'Null 'PGint4, "c" ::: 'NoDef :=> 'Null 'PGint4])]]
825-- definition = dropView #bc
860-- definition = dropView #bc
826-- in printSQL definition
861-- in printSQL definition
827-- :}
862-- :}
828-- DROP VIEW "bc";
863-- DROP VIEW "bc";
829dropView
864dropView
830− :: Has view schema ('View v)
865+ :: (Has sch schemas schema, Has vw schema ('View view))
831− => Alias view -- ^ view to remove
866+ => QualifiedAlias sch vw -- ^ view to remove
832− -> Definition schema (Drop view schema)
867+ -> Definition schemas (Alter sch (Drop vw schema) schemas)
833−dropView v = UnsafeDefinition $ "DROP VIEW" <+> renderAlias v <> ";"
868+dropView vw = UnsafeDefinition $ "DROP VIEW" <+> renderQualifiedAlias vw <> ";"
834
869
835-- | Enumerated types are created using the `createTypeEnum` command, for example
870-- | Enumerated types are created using the `createTypeEnum` command, for example
836--
871--
837−-- >>> printSQL $ createTypeEnum #mood (label @"sad" :* label @"ok" :* label @"happy")
872+-- >>> printSQL $ (createTypeEnum #mood (label @"sad" :* label @"ok" :* label @"happy") :: Definition (Public '[]) '["public" ::: '["mood" ::: 'Typedef ('PGenum '["sad","ok","happy"])]])
838-- CREATE TYPE "mood" AS ENUM ('sad', 'ok', 'happy');
873-- CREATE TYPE "mood" AS ENUM ('sad', 'ok', 'happy');
839createTypeEnum
874createTypeEnum
840− :: (KnownSymbol enum, SOP.All KnownSymbol labels)
875+ :: (KnownSymbol enum, Has sch schemas schema, SOP.All KnownSymbol labels)
841− => Alias enum
876+ => QualifiedAlias sch enum
842 -- ^ name of the user defined enumerated type
877 -- ^ name of the user defined enumerated type
843 -> NP PGlabel labels
878 -> NP PGlabel labels
844 -- ^ labels of the enumerated type
879 -- ^ labels of the enumerated type
845− -> Definition schema (Create enum ('Typedef ('PGenum labels)) schema)
880+ -> Definition schemas (Alter sch (Create enum ('Typedef ('PGenum labels)) schema) schemas)
846createTypeEnum enum labels = UnsafeDefinition $
881createTypeEnum enum labels = UnsafeDefinition $
847− "CREATE" <+> "TYPE" <+> renderAlias enum <+> "AS" <+> "ENUM" <+>
882+ "CREATE" <+> "TYPE" <+> renderQualifiedAlias enum <+> "AS" <+> "ENUM" <+>
848 parenthesized (commaSeparated (renderLabels labels)) <> ";"
883 parenthesized (commaSeparated (renderLabels labels)) <> ";"
849
884
850-- | Enumerated types can also be generated from a Haskell type, for example
885-- | Enumerated types can also be generated from a Haskell type, for example
@@ -852,17 +887,23 @@ createTypeEnum enum labels = UnsafeDefinition $
852-- >>> data Schwarma = Beef | Lamb | Chicken deriving GHC.Generic
887-- >>> data Schwarma = Beef | Lamb | Chicken deriving GHC.Generic
853-- >>> instance SOP.Generic Schwarma
888-- >>> instance SOP.Generic Schwarma
854-- >>> instance SOP.HasDatatypeInfo Schwarma
889-- >>> instance SOP.HasDatatypeInfo Schwarma
890+-- >>> :{
891+-- let
892+-- createSchwarma :: Definition (Public '[]) '["public" ::: '["schwarma" ::: 'Typedef (PG (Enumerated Schwarma))]]
855−-- >>> printSQL $ createTypeEnumFrom @Schwarma #schwarma
893+-- createSchwarma = createTypeEnumFrom @Schwarma #schwarma
894+-- in
895+-- printSQL createSchwarma
896+-- :}
856-- CREATE TYPE "schwarma" AS ENUM ('Beef', 'Lamb', 'Chicken');
897-- CREATE TYPE "schwarma" AS ENUM ('Beef', 'Lamb', 'Chicken');
857createTypeEnumFrom
898createTypeEnumFrom
858− :: forall hask enum schema.
899+ :: forall hask sch enum schemas schema.
859 ( SOP.Generic hask
900 ( SOP.Generic hask
860 , SOP.All KnownSymbol (LabelsPG hask)
901 , SOP.All KnownSymbol (LabelsPG hask)
861 , KnownSymbol enum
902 , KnownSymbol enum
862− )
903+ , Has sch schemas schema )
863− => Alias enum
904+ => QualifiedAlias sch enum
864 -- ^ name of the user defined enumerated type
905 -- ^ name of the user defined enumerated type
865− -> Definition schema (Create enum ('Typedef (PG (Enumerated hask))) schema)
906+ -> Definition schemas (Alter sch (Create enum ('Typedef (PG (Enumerated hask))) schema) schemas)
866createTypeEnumFrom enum = createTypeEnum enum
907createTypeEnumFrom enum = createTypeEnum enum
867 (SOP.hpure label :: NP PGlabel (LabelsPG hask))
908 (SOP.hpure label :: NP PGlabel (LabelsPG hask))
868
909
@@ -877,7 +918,7 @@ type PGcomplex = 'PGcomposite
877
918
878>>> :{
919>>> :{
879let
920let
880− setup :: Definition '[] '["complex" ::: 'Typedef PGcomplex]
921+ setup :: Definition (Public '[]) '["public" ::: '["complex" ::: 'Typedef PGcomplex]]
881 setup = createTypeComposite #complex
922 setup = createTypeComposite #complex
882 (float8 `as` #real :* float8 `as` #imaginary)
923 (float8 `as` #real :* float8 `as` #imaginary)
883in printSQL setup
924in printSQL setup
@@ -885,17 +926,17 @@ in printSQL setup
885CREATE TYPE "complex" AS ("real" float8, "imaginary" float8);
926CREATE TYPE "complex" AS ("real" float8, "imaginary" float8);
886-}
927-}
887createTypeComposite
928createTypeComposite
888− :: (KnownSymbol ty, SOP.SListI fields)
929+ :: (KnownSymbol ty, Has sch schemas schema, SOP.SListI fields)
889− => Alias ty
930+ => QualifiedAlias sch ty
890 -- ^ name of the user defined composite type
931 -- ^ name of the user defined composite type
891− -> NP (Aliased (TypeExpression schema)) fields
932+ -> NP (Aliased (TypeExpression schemas)) fields
892 -- ^ list of attribute names and data types
933 -- ^ list of attribute names and data types
893− -> Definition schema (Create ty ('Typedef ('PGcomposite fields)) schema)
934+ -> Definition schemas (Alter sch (Create ty ('Typedef ('PGcomposite fields)) schema) schemas)
894createTypeComposite ty fields = UnsafeDefinition $
935createTypeComposite ty fields = UnsafeDefinition $
895− "CREATE" <+> "TYPE" <+> renderAlias ty <+> "AS" <+> parenthesized
936+ "CREATE" <+> "TYPE" <+> renderQualifiedAlias ty <+> "AS" <+> parenthesized
896 (renderCommaSeparated renderField fields) <> ";"
937 (renderCommaSeparated renderField fields) <> ";"
897 where
938 where
898− renderField :: Aliased (TypeExpression schema) x -> ByteString
939+ renderField :: Aliased (TypeExpression schemas) x -> ByteString
899 renderField (typ `As` alias) =
940 renderField (typ `As` alias) =
900 renderAlias alias <+> renderTypeExpression typ
941 renderAlias alias <+> renderTypeExpression typ
901
942
@@ -904,23 +945,31 @@ createTypeComposite ty fields = UnsafeDefinition $
904-- >>> data Complex = Complex {real :: Double, imaginary :: Double} deriving GHC.Generic
945-- >>> data Complex = Complex {real :: Double, imaginary :: Double} deriving GHC.Generic
905-- >>> instance SOP.Generic Complex
946-- >>> instance SOP.Generic Complex
906-- >>> instance SOP.HasDatatypeInfo Complex
947-- >>> instance SOP.HasDatatypeInfo Complex
948+-- >>> type Schema = '["complex" ::: 'Typedef (PG (Composite Complex))]
949+-- >>> :{
950+-- let
951+-- createComplex :: Definition (Public '[]) (Public Schema)
907−-- >>> printSQL $ createTypeCompositeFrom @Complex #complex
952+-- createComplex = createTypeCompositeFrom @Complex #complex
953+-- in
954+-- printSQL createComplex
955+-- :}
908-- CREATE TYPE "complex" AS ("real" float8, "imaginary" float8);
956-- CREATE TYPE "complex" AS ("real" float8, "imaginary" float8);
909createTypeCompositeFrom
957createTypeCompositeFrom
910− :: forall hask ty schema.
958+ :: forall hask sch ty schemas schema.
911− ( SOP.All (FieldTyped schema) (RowPG hask)
959+ ( SOP.All (FieldTyped schemas) (RowPG hask)
912− , KnownSymbol ty )
960+ , KnownSymbol ty
913− => Alias ty
961+ , Has sch schemas schema )
962+ => QualifiedAlias sch ty
914 -- ^ name of the user defined composite type
963 -- ^ name of the user defined composite type
915− -> Definition schema (Create ty ( 'Typedef (PG (Composite hask))) schema)
964+ -> Definition schemas (Alter sch (Create ty ( 'Typedef (PG (Composite hask))) schema) schemas)
916createTypeCompositeFrom ty = createTypeComposite ty
965createTypeCompositeFrom ty = createTypeComposite ty
917− (SOP.hcpure (SOP.Proxy :: SOP.Proxy (FieldTyped schema)) fieldtype
966+ (SOP.hcpure (SOP.Proxy :: SOP.Proxy (FieldTyped schemas)) fieldtype
918− :: NP (Aliased (TypeExpression schema)) (RowPG hask))
967+ :: NP (Aliased (TypeExpression schemas)) (RowPG hask))
919
968
920−class FieldTyped schema ty where
969+class FieldTyped schemas ty where
921− fieldtype :: Aliased (TypeExpression schema) ty
970+ fieldtype :: Aliased (TypeExpression schemas) ty
922−instance (KnownSymbol alias, PGTyped schema ty)
971+instance (KnownSymbol alias, PGTyped schemas ty)
923− => FieldTyped schema (alias ::: ty) where
972+ => FieldTyped schemas (alias ::: ty) where
924 fieldtype = pgtype `As` Alias
973 fieldtype = pgtype `As` Alias
925
974
926-- | Drop a type.
975-- | Drop a type.
@@ -928,57 +977,57 @@ instance (KnownSymbol alias, PGTyped schema ty)
928-- >>> data Schwarma = Beef | Lamb | Chicken deriving GHC.Generic
977-- >>> data Schwarma = Beef | Lamb | Chicken deriving GHC.Generic
929-- >>> instance SOP.Generic Schwarma
978-- >>> instance SOP.Generic Schwarma
930-- >>> instance SOP.HasDatatypeInfo Schwarma
979-- >>> instance SOP.HasDatatypeInfo Schwarma
931−-- >>> printSQL (dropType #schwarma :: Definition '["schwarma" ::: 'Typedef (PG (Enumerated Schwarma))] '[])
980+-- >>> printSQL (dropType #schwarma :: Definition '["public" ::: '["schwarma" ::: 'Typedef (PG (Enumerated Schwarma))]] (Public '[]))
932-- DROP TYPE "schwarma";
981-- DROP TYPE "schwarma";
933dropType
982dropType
934− :: Has tydef schema ('Typedef ty)
983+ :: (Has sch schemas schema, Has td schema ('Typedef ty))
935− => Alias tydef
984+ => QualifiedAlias sch td
936 -- ^ name of the user defined type
985 -- ^ name of the user defined type
937− -> Definition schema (Drop tydef schema)
986+ -> Definition schemas (Alter sch (Drop td schema) schemas)
938−dropType tydef = UnsafeDefinition $ "DROP" <+> "TYPE" <+> renderAlias tydef <> ";"
987+dropType tydef = UnsafeDefinition $ "DROP" <+> "TYPE" <+> renderQualifiedAlias tydef <> ";"
939
988
940-- | `ColumnTypeExpression`s are used in `createTable` commands.
989-- | `ColumnTypeExpression`s are used in `createTable` commands.
941−newtype ColumnTypeExpression (schema :: SchemaType) (ty :: ColumnType)
990+newtype ColumnTypeExpression (schemas :: SchemasType) (ty :: ColumnType)
942 = UnsafeColumnTypeExpression { renderColumnTypeExpression :: ByteString }
991 = UnsafeColumnTypeExpression { renderColumnTypeExpression :: ByteString }
943 deriving (GHC.Generic,Show,Eq,Ord,NFData)
992 deriving (GHC.Generic,Show,Eq,Ord,NFData)
944
993
945-- | used in `createTable` commands as a column constraint to note that
994-- | used in `createTable` commands as a column constraint to note that
946-- @NULL@ may be present in a column
995-- @NULL@ may be present in a column
947nullable
996nullable
948− :: TypeExpression schema (nullity ty)
997+ :: TypeExpression schemas (nullity ty)
949− -> ColumnTypeExpression schema ('NoDef :=> 'Null ty)
998+ -> ColumnTypeExpression schemas ('NoDef :=> 'Null ty)
950nullable ty = UnsafeColumnTypeExpression $ renderTypeExpression ty <+> "NULL"
999nullable ty = UnsafeColumnTypeExpression $ renderTypeExpression ty <+> "NULL"
951
1000
952-- | used in `createTable` commands as a column constraint to ensure
1001-- | used in `createTable` commands as a column constraint to ensure
953-- @NULL@ is not present in a column
1002-- @NULL@ is not present in a column
954notNullable
1003notNullable
955− :: TypeExpression schema (nullity ty)
1004+ :: TypeExpression schemas (nullity ty)
956− -> ColumnTypeExpression schema ('NoDef :=> 'NotNull ty)
1005+ -> ColumnTypeExpression schemas ('NoDef :=> 'NotNull ty)
957notNullable ty = UnsafeColumnTypeExpression $ renderTypeExpression ty <+> "NOT NULL"
1006notNullable ty = UnsafeColumnTypeExpression $ renderTypeExpression ty <+> "NOT NULL"
958
1007
959-- | used in `createTable` commands as a column constraint to give a default
1008-- | used in `createTable` commands as a column constraint to give a default
960default_
1009default_
961− :: Expression schema '[] 'Ungrouped '[] ty
1010+ :: Expression ('[] :=> schemas) '[] 'Ungrouped '[] ty
962− -> ColumnTypeExpression schema ('NoDef :=> ty)
1011+ -> ColumnTypeExpression schemas ('NoDef :=> ty)
963− -> ColumnTypeExpression schema ('Def :=> ty)
1012+ -> ColumnTypeExpression schemas ('Def :=> ty)
964default_ x ty = UnsafeColumnTypeExpression $
1013default_ x ty = UnsafeColumnTypeExpression $
965 renderColumnTypeExpression ty <+> "DEFAULT" <+> renderExpression x
1014 renderColumnTypeExpression ty <+> "DEFAULT" <+> renderExpression x
966
1015
967-- | not a true type, but merely a notational convenience for creating
1016-- | not a true type, but merely a notational convenience for creating
968-- unique identifier columns with type `PGint2`
1017-- unique identifier columns with type `PGint2`
969serial2, smallserial
1018serial2, smallserial
970− :: ColumnTypeExpression schema ('Def :=> 'NotNull 'PGint2)
1019+ :: ColumnTypeExpression schemas ('Def :=> 'NotNull 'PGint2)
971serial2 = UnsafeColumnTypeExpression "serial2"
1020serial2 = UnsafeColumnTypeExpression "serial2"
972smallserial = UnsafeColumnTypeExpression "smallserial"
1021smallserial = UnsafeColumnTypeExpression "smallserial"
973-- | not a true type, but merely a notational convenience for creating
1022-- | not a true type, but merely a notational convenience for creating
974-- unique identifier columns with type `PGint4`
1023-- unique identifier columns with type `PGint4`
975serial4, serial
1024serial4, serial
976− :: ColumnTypeExpression schema ('Def :=> 'NotNull 'PGint4)
1025+ :: ColumnTypeExpression schemas ('Def :=> 'NotNull 'PGint4)
977serial4 = UnsafeColumnTypeExpression "serial4"
1026serial4 = UnsafeColumnTypeExpression "serial4"
978serial = UnsafeColumnTypeExpression "serial"
1027serial = UnsafeColumnTypeExpression "serial"
979-- | not a true type, but merely a notational convenience for creating
1028-- | not a true type, but merely a notational convenience for creating
980-- unique identifier columns with type `PGint8`
1029-- unique identifier columns with type `PGint8`
981serial8, bigserial
1030serial8, bigserial
982− :: ColumnTypeExpression schema ('Def :=> 'NotNull 'PGint8)
1031+ :: ColumnTypeExpression schemas ('Def :=> 'NotNull 'PGint8)
983serial8 = UnsafeColumnTypeExpression "serial8"
1032serial8 = UnsafeColumnTypeExpression "serial8"
984bigserial = UnsafeColumnTypeExpression "bigserial"
1033bigserial = UnsafeColumnTypeExpression "bigserial"
squeal-postgresql/src/Squeal/PostgreSQL/Expression.hs+386−383
@@ -218,7 +218,7 @@ values from primitive expression using arithmetic, logical,
218and other operations.
218and other operations.
219-}
219-}
220newtype Expression
220newtype Expression
221− (schema :: SchemaType)
221+ (db :: DBType)
222 (from :: FromType)
222 (from :: FromType)
223 (grouping :: Grouping)
223 (grouping :: Grouping)
224 (params :: [NullityType])
224 (params :: [NullityType])
@@ -226,7 +226,7 @@ newtype Expression
226 = UnsafeExpression { renderExpression :: ByteString }
226 = UnsafeExpression { renderExpression :: ByteString }
227 deriving (GHC.Generic,Show,Eq,Ord,NFData)
227 deriving (GHC.Generic,Show,Eq,Ord,NFData)
228
228
229−instance RenderSQL (Expression schema from grouping params ty) where
229+instance RenderSQL (Expression db from grouping params ty) where
230 renderSQL = renderExpression
230 renderSQL = renderExpression
231
231
232{- | A `HasParameter` constraint is used to indicate a value that is
232{- | A `HasParameter` constraint is used to indicate a value that is
@@ -239,60 +239,59 @@ refer to the out-of-line data values.
239-}
239-}
240class KnownNat n => HasParameter
240class KnownNat n => HasParameter
241 (n :: Nat)
241 (n :: Nat)
242− (schema :: SchemaType)
243 (params :: [NullityType])
242 (params :: [NullityType])
244 (ty :: NullityType)
243 (ty :: NullityType)
245 | n params -> ty where
244 | n params -> ty where
246 -- | `parameter` takes a `Nat` using type application and a `TypeExpression`.
245 -- | `parameter` takes a `Nat` using type application and a `TypeExpression`.
247 --
246 --
248− -- >>> let expr = parameter @1 int4 :: Expression sch rels grp '[ 'Null 'PGint4] ('Null 'PGint4)
247+ -- >>> let expr = parameter @1 int4 :: Expression (DBof schemas) from grp '[ 'Null 'PGint4] ('Null 'PGint4)
249 -- >>> printSQL expr
248 -- >>> printSQL expr
250 -- ($1 :: int4)
249 -- ($1 :: int4)
251 parameter
250 parameter
252− :: TypeExpression schema ty
251+ :: TypeExpression schemas ty
253− -> Expression schema from grouping params ty
252+ -> Expression (commons :=> schemas) from grouping params ty
254 parameter ty = UnsafeExpression $ parenthesized $
253 parameter ty = UnsafeExpression $ parenthesized $
255 "$" <> renderNat @n <+> "::"
254 "$" <> renderNat @n <+> "::"
256 <+> renderTypeExpression ty
255 <+> renderTypeExpression ty
257−instance {-# OVERLAPPING #-} HasParameter 1 schema (ty1:tys) ty1
256+instance {-# OVERLAPPING #-} HasParameter 1 (ty1:tys) ty1
258−instance {-# OVERLAPPABLE #-} (KnownNat n, HasParameter (n-1) schema params ty)
257+instance {-# OVERLAPPABLE #-} (KnownNat n, HasParameter (n-1) params ty)
259− => HasParameter n schema (ty' : params) ty
258+ => HasParameter n (ty' : params) ty
260
259
261-- | `param` takes a `Nat` using type application and for basic types,
260-- | `param` takes a `Nat` using type application and for basic types,
262-- infers a `TypeExpression`.
261-- infers a `TypeExpression`.
263--
262--
264−-- >>> let expr = param @1 :: Expression sch rels grp '[ 'Null 'PGint4] ('Null 'PGint4)
263+-- >>> let expr = param @1 :: Expression (commons :=> schemas) from grp '[ 'Null 'PGint4] ('Null 'PGint4)
265-- >>> printSQL expr
264-- >>> printSQL expr
266-- ($1 :: int4)
265-- ($1 :: int4)
267param
266param
268− :: forall n schema params from grouping ty
267+ :: forall n db commons schemas params from grouping ty
269− . (PGTyped schema ty, HasParameter n schema params ty)
268+ . (db ~ (commons :=> schemas), PGTyped schemas ty, HasParameter n params ty)
270− => Expression schema from grouping params ty -- ^ param
269+ => Expression db from grouping params ty -- ^ param
271−param = parameter @n pgtype
270+param = parameter @n (pgtype @schemas)
272
271
273instance (HasUnique table from columns, Has column columns ty)
272instance (HasUnique table from columns, Has column columns ty)
274− => IsLabel column (Expression schema from 'Ungrouped params ty) where
273+ => IsLabel column (Expression db from 'Ungrouped params ty) where
275 fromLabel = UnsafeExpression $ renderAlias (Alias @column)
274 fromLabel = UnsafeExpression $ renderAlias (Alias @column)
276instance (HasUnique table from columns, Has column columns ty)
275instance (HasUnique table from columns, Has column columns ty)
277 => IsLabel column
276 => IsLabel column
278− (Aliased (Expression schema from 'Ungrouped params) (column ::: ty)) where
277+ (Aliased (Expression db from 'Ungrouped params) (column ::: ty)) where
279 fromLabel = fromLabel @column `As` Alias @column
278 fromLabel = fromLabel @column `As` Alias @column
280instance (HasUnique table from columns, Has column columns ty)
279instance (HasUnique table from columns, Has column columns ty)
281 => IsLabel column
280 => IsLabel column
282− (NP (Aliased (Expression schema from 'Ungrouped params)) '[column ::: ty]) where
281+ (NP (Aliased (Expression db from 'Ungrouped params)) '[column ::: ty]) where
283 fromLabel = fromLabel @column :* Nil
282 fromLabel = fromLabel @column :* Nil
284
283
285instance (Has table from columns, Has column columns ty)
284instance (Has table from columns, Has column columns ty)
286− => IsQualified table column (Expression schema from 'Ungrouped params ty) where
285+ => IsQualified table column (Expression db from 'Ungrouped params ty) where
287 table ! column = UnsafeExpression $
286 table ! column = UnsafeExpression $
288 renderAlias table <> "." <> renderAlias column
287 renderAlias table <> "." <> renderAlias column
289instance (Has table from columns, Has column columns ty)
288instance (Has table from columns, Has column columns ty)
290 => IsQualified table column
289 => IsQualified table column
291− (Aliased (Expression schema from 'Ungrouped params) (column ::: ty)) where
290+ (Aliased (Expression db from 'Ungrouped params) (column ::: ty)) where
292 table ! column = table ! column `As` column
291 table ! column = table ! column `As` column
293instance (Has table from columns, Has column columns ty)
292instance (Has table from columns, Has column columns ty)
294 => IsQualified table column
293 => IsQualified table column
295− (NP (Aliased (Expression schema from 'Ungrouped params)) '[column ::: ty]) where
294+ (NP (Aliased (Expression db from 'Ungrouped params)) '[column ::: ty]) where
296 table ! column = table ! column :* Nil
295 table ! column = table ! column :* Nil
297
296
298instance
297instance
@@ -300,14 +299,14 @@ instance
300 , Has column columns ty
299 , Has column columns ty
301 , GroupedBy table column bys
300 , GroupedBy table column bys
302 ) => IsLabel column
301 ) => IsLabel column
303− (Expression schema from ('Grouped bys) params ty) where
302+ (Expression db from ('Grouped bys) params ty) where
304 fromLabel = UnsafeExpression $ renderAlias (Alias @column)
303 fromLabel = UnsafeExpression $ renderAlias (Alias @column)
305instance
304instance
306 ( HasUnique table from columns
305 ( HasUnique table from columns
307 , Has column columns ty
306 , Has column columns ty
308 , GroupedBy table column bys
307 , GroupedBy table column bys
309 ) => IsLabel column
308 ) => IsLabel column
310− ( Aliased (Expression schema from ('Grouped bys) params)
309+ ( Aliased (Expression db from ('Grouped bys) params)
311 (column ::: ty) ) where
310 (column ::: ty) ) where
312 fromLabel = fromLabel @column `As` Alias @column
311 fromLabel = fromLabel @column `As` Alias @column
313instance
312instance
@@ -315,7 +314,7 @@ instance
315 , Has column columns ty
314 , Has column columns ty
316 , GroupedBy table column bys
315 , GroupedBy table column bys
317 ) => IsLabel column
316 ) => IsLabel column
318− ( NP (Aliased (Expression schema from ('Grouped bys) params))
317+ ( NP (Aliased (Expression db from ('Grouped bys) params))
319 '[column ::: ty] ) where
318 '[column ::: ty] ) where
320 fromLabel = fromLabel @column :* Nil
319 fromLabel = fromLabel @column :* Nil
321
320
@@ -324,7 +323,7 @@ instance
324 , Has column columns ty
323 , Has column columns ty
325 , GroupedBy table column bys
324 , GroupedBy table column bys
326 ) => IsQualified table column
325 ) => IsQualified table column
327− (Expression schema from ('Grouped bys) params ty) where
326+ (Expression db from ('Grouped bys) params ty) where
328 table ! column = UnsafeExpression $
327 table ! column = UnsafeExpression $
329 renderAlias table <> "." <> renderAlias column
328 renderAlias table <> "." <> renderAlias column
330instance
329instance
@@ -332,7 +331,7 @@ instance
332 , Has column columns ty
331 , Has column columns ty
333 , GroupedBy table column bys
332 , GroupedBy table column bys
334 ) => IsQualified table column
333 ) => IsQualified table column
335− (Aliased (Expression schema from ('Grouped bys) params)
334+ (Aliased (Expression db from ('Grouped bys) params)
336 (column ::: ty)) where
335 (column ::: ty)) where
337 table ! column = table ! column `As` column
336 table ! column = table ! column `As` column
338instance
337instance
@@ -340,7 +339,7 @@ instance
340 , Has column columns ty
339 , Has column columns ty
341 , GroupedBy table column bys
340 , GroupedBy table column bys
342 ) => IsQualified table column
341 ) => IsQualified table column
343− ( NP (Aliased (Expression schema from ('Grouped bys) params))
342+ ( NP (Aliased (Expression db from ('Grouped bys) params))
344 '[column ::: ty]) where
343 '[column ::: ty]) where
345 table ! column = table ! column :* Nil
344 table ! column = table ! column :* Nil
346
345
@@ -348,7 +347,7 @@ instance
348--
347--
349-- >>> printSQL null_
348-- >>> printSQL null_
350-- NULL
349-- NULL
351−null_ :: Expression schema rels grouping params ('Null ty)
350+null_ :: Expression db rels grouping params ('Null ty)
352null_ = UnsafeExpression "NULL"
351null_ = UnsafeExpression "NULL"
353
352
354-- | analagous to `Just`
353-- | analagous to `Just`
@@ -356,8 +355,8 @@ null_ = UnsafeExpression "NULL"
356-- >>> printSQL $ notNull true
355-- >>> printSQL $ notNull true
357-- TRUE
356-- TRUE
358notNull
357notNull
359− :: Expression schema rels grouping params ('NotNull ty)
358+ :: Expression db rels grouping params ('NotNull ty)
360− -> Expression schema rels grouping params ('Null ty)
359+ -> Expression db rels grouping params ('Null ty)
361notNull = UnsafeExpression . renderExpression
360notNull = UnsafeExpression . renderExpression
362
361
363-- | return the leftmost value which is not NULL
362-- | return the leftmost value which is not NULL
@@ -365,11 +364,11 @@ notNull = UnsafeExpression . renderExpression
365-- >>> printSQL $ coalesce [null_, true] false
364-- >>> printSQL $ coalesce [null_, true] false
366-- COALESCE(NULL, TRUE, FALSE)
365-- COALESCE(NULL, TRUE, FALSE)
367coalesce
366coalesce
368− :: [Expression schema from grouping params ('Null ty)]
367+ :: [Expression db from grouping params ('Null ty)]
369 -- ^ @NULL@s may be present
368 -- ^ @NULL@s may be present
370− -> Expression schema from grouping params ('NotNull ty)
369+ -> Expression db from grouping params ('NotNull ty)
371 -- ^ @NULL@ is absent
370 -- ^ @NULL@ is absent
372− -> Expression schema from grouping params ('NotNull ty)
371+ -> Expression db from grouping params ('NotNull ty)
373coalesce nullxs notNullx = UnsafeExpression $
372coalesce nullxs notNullx = UnsafeExpression $
374 "COALESCE" <> parenthesized (commaSeparated
373 "COALESCE" <> parenthesized (commaSeparated
375 ((renderExpression <$> nullxs) <> [renderExpression notNullx]))
374 ((renderExpression <$> nullxs) <> [renderExpression notNullx]))
@@ -379,26 +378,26 @@ coalesce nullxs notNullx = UnsafeExpression $
379-- >>> printSQL $ fromNull true null_
378-- >>> printSQL $ fromNull true null_
380-- COALESCE(NULL, TRUE)
379-- COALESCE(NULL, TRUE)
381fromNull
380fromNull
382− :: Expression schema from grouping params ('NotNull ty)
381+ :: Expression db from grouping params ('NotNull ty)
383 -- ^ what to convert @NULL@ to
382 -- ^ what to convert @NULL@ to
384− -> Expression schema from grouping params ('Null ty)
383+ -> Expression db from grouping params ('Null ty)
385− -> Expression schema from grouping params ('NotNull ty)
384+ -> Expression db from grouping params ('NotNull ty)
386fromNull notNullx nullx = coalesce [nullx] notNullx
385fromNull notNullx nullx = coalesce [nullx] notNullx
387
386
388-- | >>> printSQL $ null_ & isNull
387-- | >>> printSQL $ null_ & isNull
389-- NULL IS NULL
388-- NULL IS NULL
390isNull
389isNull
391− :: Expression schema from grouping params ('Null ty)
390+ :: Expression db from grouping params ('Null ty)
392 -- ^ possibly @NULL@
391 -- ^ possibly @NULL@
393− -> Condition schema from grouping params
392+ -> Condition db from grouping params
394isNull x = UnsafeExpression $ renderExpression x <+> "IS NULL"
393isNull x = UnsafeExpression $ renderExpression x <+> "IS NULL"
395
394
396-- | >>> printSQL $ null_ & isNotNull
395-- | >>> printSQL $ null_ & isNotNull
397-- NULL IS NOT NULL
396-- NULL IS NOT NULL
398isNotNull
397isNotNull
399− :: Expression schema from grouping params ('Null ty)
398+ :: Expression db from grouping params ('Null ty)
400 -- ^ possibly @NULL@
399 -- ^ possibly @NULL@
401− -> Condition schema from grouping params
400+ -> Condition db from grouping params
402isNotNull x = UnsafeExpression $ renderExpression x <+> "IS NOT NULL"
401isNotNull x = UnsafeExpression $ renderExpression x <+> "IS NOT NULL"
403
402
404-- | analagous to `maybe` using @IS NULL@
403-- | analagous to `maybe` using @IS NULL@
@@ -406,13 +405,13 @@ isNotNull x = UnsafeExpression $ renderExpression x <+> "IS NOT NULL"
406-- >>> printSQL $ matchNull true not_ null_
405-- >>> printSQL $ matchNull true not_ null_
407-- CASE WHEN NULL IS NULL THEN TRUE ELSE (NOT NULL) END
406-- CASE WHEN NULL IS NULL THEN TRUE ELSE (NOT NULL) END
408matchNull
407matchNull
409− :: Expression schema from grouping params (nullty)
408+ :: Expression db from grouping params (nullty)
410 -- ^ what to convert @NULL@ to
409 -- ^ what to convert @NULL@ to
411− -> ( Expression schema from grouping params ('NotNull ty)
410+ -> ( Expression db from grouping params ('NotNull ty)
412− -> Expression schema from grouping params (nullty) )
411+ -> Expression db from grouping params (nullty) )
413 -- ^ function to perform when @NULL@ is absent
412 -- ^ function to perform when @NULL@ is absent
414− -> Expression schema from grouping params ('Null ty)
413+ -> Expression db from grouping params ('Null ty)
415− -> Expression schema from grouping params (nullty)
414+ -> Expression db from grouping params (nullty)
416matchNull y f x = ifThenElse (isNull x) y
415matchNull y f x = ifThenElse (isNull x) y
417 (f (UnsafeExpression (renderExpression x)))
416 (f (UnsafeExpression (renderExpression x)))
418
417
@@ -420,25 +419,25 @@ matchNull y f x = ifThenElse (isNull x) y
420`nullIf` gives @NULL@.
419`nullIf` gives @NULL@.
421
420
422>>> :set -XTypeApplications -XDataKinds
421>>> :set -XTypeApplications -XDataKinds
423−>>> let expr = nullIf false (param @1) :: Expression schema rels grp '[ 'NotNull 'PGbool] ('Null 'PGbool)
422+>>> let expr = nullIf false (param @1) :: Expression (commons :=> schema) from grp '[ 'NotNull 'PGbool] ('Null 'PGbool)
424>>> printSQL expr
423>>> printSQL expr
425NULL IF (FALSE, ($1 :: bool))
424NULL IF (FALSE, ($1 :: bool))
426-}
425-}
427nullIf
426nullIf
428− :: Expression schema from grouping params ('NotNull ty)
427+ :: Expression db from grouping params ('NotNull ty)
429 -- ^ @NULL@ is absent
428 -- ^ @NULL@ is absent
430− -> Expression schema from grouping params ('NotNull ty)
429+ -> Expression db from grouping params ('NotNull ty)
431 -- ^ @NULL@ is absent
430 -- ^ @NULL@ is absent
432− -> Expression schema from grouping params ('Null ty)
431+ -> Expression db from grouping params ('Null ty)
433nullIf x y = UnsafeExpression $ "NULL IF" <+> parenthesized
432nullIf x y = UnsafeExpression $ "NULL IF" <+> parenthesized
434 (renderExpression x <> ", " <> renderExpression y)
433 (renderExpression x <> ", " <> renderExpression y)
435
434
436-- | >>> printSQL $ array [null_, false, true]
435-- | >>> printSQL $ array [null_, false, true]
437-- ARRAY[NULL, FALSE, TRUE]
436-- ARRAY[NULL, FALSE, TRUE]
438array
437array
439− :: [Expression schema from grouping params ty]
438+ :: [Expression db from grouping params ty]
440 -- ^ array elements
439 -- ^ array elements
441− -> Expression schema from grouping params (nullity ('PGvararray ty))
440+ -> Expression db from grouping params (nullity ('PGvararray ty))
442array xs = UnsafeExpression $
441array xs = UnsafeExpression $
443 "ARRAY[" <> commaSeparated (renderExpression <$> xs) <> "]"
442 "ARRAY[" <> commaSeparated (renderExpression <$> xs) <> "]"
444
443
@@ -446,13 +445,13 @@ array xs = UnsafeExpression $
446-- (ARRAY[NULL, FALSE, TRUE])[2]
445-- (ARRAY[NULL, FALSE, TRUE])[2]
447index
446index
448 :: Word64 -- ^ index
447 :: Word64 -- ^ index
449− -> Expression schema from grouping params (nullity ('PGvararray ty)) -- ^ array
448+ -> Expression db from grouping params (nullity ('PGvararray ty)) -- ^ array
450− -> Expression schema from grouping params (NullifyType ty)
449+ -> Expression db from grouping params (NullifyType ty)
451index n expr = UnsafeExpression $
450index n expr = UnsafeExpression $
452 parenthesized (renderExpression expr) <> "[" <> fromString (show n) <> "]"
451 parenthesized (renderExpression expr) <> "[" <> fromString (show n) <> "]"
453
452
454instance (KnownSymbol label, label `In` labels) => IsPGlabel label
453instance (KnownSymbol label, label `In` labels) => IsPGlabel label
455− (Expression schema from grouping params (nullity ('PGenum labels))) where
454+ (Expression db from grouping params (nullity ('PGenum labels))) where
456 label = UnsafeExpression $ renderLabel (PGlabel @label)
455 label = UnsafeExpression $ renderLabel (PGlabel @label)
457
456
458-- | A row constructor is an expression that builds a row value
457-- | A row constructor is an expression that builds a row value
@@ -464,14 +463,14 @@ instance (KnownSymbol label, label `In` labels) => IsPGlabel label
464-- , "imaginary" ::: 'NotNull 'PGfloat8 ]
463-- , "imaginary" ::: 'NotNull 'PGfloat8 ]
465-- :}
464-- :}
466--
465--
467−-- >>> let i = row (0 `as` #real :* 1 `as` #imaginary) :: Expression '[] '[] 'Ungrouped '[] ('NotNull Complex)
466+-- >>> let i = row (0 `as` #real :* 1 `as` #imaginary) :: Expression db from grp params ('NotNull Complex)
468-- >>> printSQL i
467-- >>> printSQL i
469-- ROW(0, 1)
468-- ROW(0, 1)
470row
469row
471 :: SListI row
470 :: SListI row
472− => NP (Aliased (Expression schema from grouping params)) row
471+ => NP (Aliased (Expression db from grouping params)) row
473 -- ^ zero or more expressions for the row field values
472 -- ^ zero or more expressions for the row field values
474− -> Expression schema from grouping params (nullity ('PGcomposite row))
473+ -> Expression db from grouping params (nullity ('PGcomposite row))
475row exprs = UnsafeExpression $ "ROW" <> parenthesized
474row exprs = UnsafeExpression $ "ROW" <> parenthesized
476 (renderCommaSeparated (\ (expr `As` _) -> renderExpression expr) exprs)
475 (renderCommaSeparated (\ (expr `As` _) -> renderExpression expr) exprs)
477
476
@@ -479,50 +478,54 @@ row exprs = UnsafeExpression $ "ROW" <> parenthesized
479-- type Complex = 'PGcomposite
478-- type Complex = 'PGcomposite
480-- '[ "real" ::: 'NotNull 'PGfloat8
479-- '[ "real" ::: 'NotNull 'PGfloat8
481-- , "imaginary" ::: 'NotNull 'PGfloat8 ]
480-- , "imaginary" ::: 'NotNull 'PGfloat8 ]
481+-- type Schema = '["complex" ::: 'Typedef Complex]
482+-- type DB = DBof (Public Schema)
482-- :}
483-- :}
483--
484--
484−-- >>> let i = row (0 `as` #real :* 1 `as` #imaginary) :: Expression '["complex" ::: 'Typedef Complex] '[] 'Ungrouped '[] ('NotNull Complex)
485+-- >>> let i = row (0 `as` #real :* 1 `as` #imaginary) :: Expression DB from grp params ('NotNull Complex)
485-- >>> printSQL $ i & field #complex #imaginary
486-- >>> printSQL $ i & field #complex #imaginary
486-- (ROW(0, 1)::"complex")."imaginary"
487-- (ROW(0, 1)::"complex")."imaginary"
487field
488field
489+ :: ( Has sch schemas schema
488− :: (Has tydef schema ('Typedef ('PGcomposite row)), Has field row ty)
490+ , Has tydef schema ('Typedef ('PGcomposite row))
491+ , Has field row ty)
489− => Alias tydef -- ^ row type
492+ => QualifiedAlias sch tydef -- ^ row type
490 -> Alias field -- ^ field name
493 -> Alias field -- ^ field name
491− -> Expression schema from grouping params ('NotNull ('PGcomposite row))
494+ -> Expression (commons :=> schemas) from grouping params ('NotNull ('PGcomposite row))
492− -> Expression schema from grouping params ty
495+ -> Expression (commons :=> schemas) from grouping params ty
493field td fld expr = UnsafeExpression $
496field td fld expr = UnsafeExpression $
494− parenthesized (renderExpression expr <> "::" <> renderAlias td)
497+ parenthesized (renderExpression expr <> "::" <> renderQualifiedAlias td)
495 <> "." <> renderAlias fld
498 <> "." <> renderAlias fld
496
499
497instance Semigroup
500instance Semigroup
498− (Expression schema from grouping params (nullity ('PGvararray ty))) where
501+ (Expression db from grouping params (nullity ('PGvararray ty))) where
499 (<>) = unsafeBinaryOp "||"
502 (<>) = unsafeBinaryOp "||"
500
503
501instance Monoid
504instance Monoid
502− (Expression schema from grouping params (nullity ('PGvararray ty))) where
505+ (Expression db from grouping params (nullity ('PGvararray ty))) where
503 mempty = array []
506 mempty = array []
504 mappend = (<>)
507 mappend = (<>)
505
508
506−-- | >>> let expr = greatest currentTimestamp [param @1] :: Expression sch rels grp '[ 'NotNull 'PGtimestamptz] ('NotNull 'PGtimestamptz)
509+-- | >>> let expr = greatest currentTimestamp [param @1] :: Expression (commons :=> schemas) rels grp '[ 'NotNull 'PGtimestamptz] ('NotNull 'PGtimestamptz)
507-- >>> printSQL expr
510-- >>> printSQL expr
508-- GREATEST(CURRENT_TIMESTAMP, ($1 :: timestamp with time zone))
511-- GREATEST(CURRENT_TIMESTAMP, ($1 :: timestamp with time zone))
509greatest
512greatest
510− :: Expression schema from grouping params (nullty)
513+ :: Expression db from grouping params (nullty)
511 -- ^ needs at least 1 argument
514 -- ^ needs at least 1 argument
512− -> [Expression schema from grouping params (nullty)]
515+ -> [Expression db from grouping params (nullty)]
513 -- ^ or more
516 -- ^ or more
514− -> Expression schema from grouping params (nullty)
517+ -> Expression db from grouping params (nullty)
515greatest x xs = UnsafeExpression $ "GREATEST("
518greatest x xs = UnsafeExpression $ "GREATEST("
516 <> commaSeparated (renderExpression <$> (x:xs)) <> ")"
519 <> commaSeparated (renderExpression <$> (x:xs)) <> ")"
517
520
518-- | >>> printSQL $ least currentTimestamp [null_]
521-- | >>> printSQL $ least currentTimestamp [null_]
519-- LEAST(CURRENT_TIMESTAMP, NULL)
522-- LEAST(CURRENT_TIMESTAMP, NULL)
520least
523least
521− :: Expression schema from grouping params (nullty)
524+ :: Expression db from grouping params (nullty)
522 -- ^ needs at least 1 argument
525 -- ^ needs at least 1 argument
523− -> [Expression schema from grouping params (nullty)]
526+ -> [Expression db from grouping params (nullty)]
524 -- ^ or more
527 -- ^ or more
525− -> Expression schema from grouping params (nullty)
528+ -> Expression db from grouping params (nullty)
526least x xs = UnsafeExpression $ "LEAST("
529least x xs = UnsafeExpression $ "LEAST("
527 <> commaSeparated (renderExpression <$> (x:xs)) <> ")"
530 <> commaSeparated (renderExpression <$> (x:xs)) <> ")"
528
531
@@ -531,9 +534,9 @@ least x xs = UnsafeExpression $ "LEAST("
531unsafeBinaryOp
534unsafeBinaryOp
532 :: ByteString
535 :: ByteString
533 -- ^ operator
536 -- ^ operator
534− -> Expression schema from grouping params (ty0)
537+ -> Expression db from grouping params (ty0)
535− -> Expression schema from grouping params (ty1)
538+ -> Expression db from grouping params (ty1)
536− -> Expression schema from grouping params (ty2)
539+ -> Expression db from grouping params (ty2)
537unsafeBinaryOp op x y = UnsafeExpression $ parenthesized $
540unsafeBinaryOp op x y = UnsafeExpression $ parenthesized $
538 renderExpression x <+> op <+> renderExpression y
541 renderExpression x <+> op <+> renderExpression y
539
542
@@ -542,8 +545,8 @@ unsafeBinaryOp op x y = UnsafeExpression $ parenthesized $
542unsafeUnaryOp
545unsafeUnaryOp
543 :: ByteString
546 :: ByteString
544 -- ^ operator
547 -- ^ operator
545− -> Expression schema from grouping params (ty0)
548+ -> Expression db from grouping params (ty0)
546− -> Expression schema from grouping params (ty1)
549+ -> Expression db from grouping params (ty1)
547unsafeUnaryOp op x = UnsafeExpression $ parenthesized $
550unsafeUnaryOp op x = UnsafeExpression $ parenthesized $
548 op <+> renderExpression x
551 op <+> renderExpression x
549
552
@@ -552,8 +555,8 @@ unsafeUnaryOp op x = UnsafeExpression $ parenthesized $
552unsafeFunction
555unsafeFunction
553 :: ByteString
556 :: ByteString
554 -- ^ function
557 -- ^ function
555− -> Expression schema from grouping params (xty)
558+ -> Expression db from grouping params (xty)
556− -> Expression schema from grouping params (yty)
559+ -> Expression db from grouping params (yty)
557unsafeFunction fun x = UnsafeExpression $
560unsafeFunction fun x = UnsafeExpression $
558 fun <> parenthesized (renderExpression x)
561 fun <> parenthesized (renderExpression x)
559
562
@@ -562,13 +565,13 @@ unsafeVariadicFunction
562 :: SListI elems
565 :: SListI elems
563 => ByteString
566 => ByteString
564 -- ^ function
567 -- ^ function
565− -> NP (Expression schema from grouping params) elems
568+ -> NP (Expression db from grouping params) elems
566− -> Expression schema from grouping params ret
569+ -> Expression db from grouping params ret
567unsafeVariadicFunction fun x = UnsafeExpression $
570unsafeVariadicFunction fun x = UnsafeExpression $
568 fun <> parenthesized (commaSeparated (hcollapse (hmap (K . renderExpression) x)))
571 fun <> parenthesized (commaSeparated (hcollapse (hmap (K . renderExpression) x)))
569
572
570instance ty `In` PGNum
573instance ty `In` PGNum
571− => Num (Expression schema from grouping params (nullity ty)) where
574+ => Num (Expression db from grouping params (nullity ty)) where
572 (+) = unsafeBinaryOp "+"
575 (+) = unsafeBinaryOp "+"
573 (-) = unsafeBinaryOp "-"
576 (-) = unsafeBinaryOp "-"
574 (*) = unsafeBinaryOp "*"
577 (*) = unsafeBinaryOp "*"
@@ -580,12 +583,12 @@ instance ty `In` PGNum
580 . show
583 . show
581
584
582instance (ty `In` PGNum, ty `In` PGFloating) => Fractional
585instance (ty `In` PGNum, ty `In` PGFloating) => Fractional
583− (Expression schema from grouping params (nullity ty)) where
586+ (Expression db from grouping params (nullity ty)) where
584 (/) = unsafeBinaryOp "/"
587 (/) = unsafeBinaryOp "/"
585 fromRational x = fromInteger (numerator x) / fromInteger (denominator x)
588 fromRational x = fromInteger (numerator x) / fromInteger (denominator x)
586
589
587instance (ty `In` PGNum, ty `In` PGFloating) => Floating
590instance (ty `In` PGNum, ty `In` PGFloating) => Floating
588− (Expression schema from grouping params (nullity ty)) where
591+ (Expression db from grouping params (nullity ty)) where
589 pi = UnsafeExpression "pi()"
592 pi = UnsafeExpression "pi()"
590 exp = unsafeFunction "exp"
593 exp = unsafeFunction "exp"
591 log = unsafeFunction "ln"
594 log = unsafeFunction "ln"
@@ -608,18 +611,18 @@ instance (ty `In` PGNum, ty `In` PGFloating) => Floating
608
611
609-- | >>> :{
612-- | >>> :{
610-- let
613-- let
611−-- expression :: Expression schema from grouping params (nullity 'PGfloat4)
614+-- expression :: Expression db from grouping params (nullity 'PGfloat4)
612-- expression = atan2_ pi 2
615-- expression = atan2_ pi 2
613-- in printSQL expression
616-- in printSQL expression
614-- :}
617-- :}
615-- atan2(pi(), 2)
618-- atan2(pi(), 2)
616atan2_
619atan2_
617 :: float `In` PGFloating
620 :: float `In` PGFloating
618− => Expression schema from grouping params (nullity float)
621+ => Expression db from grouping params (nullity float)
619 -- ^ numerator
622 -- ^ numerator
620− -> Expression schema from grouping params (nullity float)
623+ -> Expression db from grouping params (nullity float)
621 -- ^ denominator
624 -- ^ denominator
622− -> Expression schema from grouping params (nullity float)
625+ -> Expression db from grouping params (nullity float)
623atan2_ y x = UnsafeExpression $
626atan2_ y x = UnsafeExpression $
624 "atan2(" <> renderExpression y <> ", " <> renderExpression x <> ")"
627 "atan2(" <> renderExpression y <> ", " <> renderExpression x <> ")"
625
628
@@ -630,11 +633,11 @@ atan2_ y x = UnsafeExpression $
630-- | >>> printSQL $ true & cast int4
633-- | >>> printSQL $ true & cast int4
631-- (TRUE :: int4)
634-- (TRUE :: int4)
632cast
635cast
633− :: TypeExpression schema ty1
636+ :: TypeExpression schemas ty1
634 -- ^ type to cast as
637 -- ^ type to cast as
635− -> Expression schema from grouping params ty0
638+ -> Expression (commons :=> schemas) from grouping params ty0
636 -- ^ value to convert
639 -- ^ value to convert
637− -> Expression schema from grouping params ty1
640+ -> Expression (commons :=> schemas) from grouping params ty1
638cast ty x = UnsafeExpression $ parenthesized $
641cast ty x = UnsafeExpression $ parenthesized $
639 renderExpression x <+> "::" <+> renderTypeExpression ty
642 renderExpression x <+> "::" <+> renderTypeExpression ty
640
643
@@ -642,136 +645,136 @@ cast ty x = UnsafeExpression $ parenthesized $
642--
645--
643-- >>> :{
646-- >>> :{
644-- let
647-- let
645−-- expression :: Expression schema from grouping params (nullity 'PGint2)
648+-- expression :: Expression db from grouping params (nullity 'PGint2)
646-- expression = 5 `quot_` 2
649-- expression = 5 `quot_` 2
647-- in printSQL expression
650-- in printSQL expression
648-- :}
651-- :}
649-- (5 / 2)
652-- (5 / 2)
650quot_
653quot_
651 :: int `In` PGIntegral
654 :: int `In` PGIntegral
652− => Expression schema from grouping params (nullity int)
655+ => Expression db from grouping params (nullity int)
653 -- ^ numerator
656 -- ^ numerator
654− -> Expression schema from grouping params (nullity int)
657+ -> Expression db from grouping params (nullity int)
655 -- ^ denominator
658 -- ^ denominator
656− -> Expression schema from grouping params (nullity int)
659+ -> Expression db from grouping params (nullity int)
657quot_ = unsafeBinaryOp "/"
660quot_ = unsafeBinaryOp "/"
658
661
659-- | remainder upon integer division
662-- | remainder upon integer division
660--
663--
661-- >>> :{
664-- >>> :{
662-- let
665-- let
663−-- expression :: Expression schema from grouping params (nullity 'PGint2)
666+-- expression :: Expression db from grouping params (nullity 'PGint2)
664-- expression = 5 `rem_` 2
667-- expression = 5 `rem_` 2
665-- in printSQL expression
668-- in printSQL expression
666-- :}
669-- :}
667-- (5 % 2)
670-- (5 % 2)
668rem_
671rem_
669 :: int `In` PGIntegral
672 :: int `In` PGIntegral
670− => Expression schema from grouping params (nullity int)
673+ => Expression db from grouping params (nullity int)
671 -- ^ numerator
674 -- ^ numerator
672− -> Expression schema from grouping params (nullity int)
675+ -> Expression db from grouping params (nullity int)
673 -- ^ denominator
676 -- ^ denominator
674− -> Expression schema from grouping params (nullity int)
677+ -> Expression db from grouping params (nullity int)
675rem_ = unsafeBinaryOp "%"
678rem_ = unsafeBinaryOp "%"
676
679
677-- | >>> :{
680-- | >>> :{
678-- let
681-- let
679−-- expression :: Expression schema from grouping params (nullity 'PGfloat4)
682+-- expression :: Expression db from grouping params (nullity 'PGfloat4)
680-- expression = trunc pi
683-- expression = trunc pi
681-- in printSQL expression
684-- in printSQL expression
682-- :}
685-- :}
683-- trunc(pi())
686-- trunc(pi())
684trunc
687trunc
685 :: frac `In` PGFloating
688 :: frac `In` PGFloating
686− => Expression schema from grouping params (nullity frac)
689+ => Expression db from grouping params (nullity frac)
687 -- ^ fractional number
690 -- ^ fractional number
688− -> Expression schema from grouping params (nullity frac)
691+ -> Expression db from grouping params (nullity frac)
689trunc = unsafeFunction "trunc"
692trunc = unsafeFunction "trunc"
690
693
691-- | >>> :{
694-- | >>> :{
692-- let
695-- let
693−-- expression :: Expression schema from grouping params (nullity 'PGfloat4)
696+-- expression :: Expression db from grouping params (nullity 'PGfloat4)
694-- expression = round_ pi
697-- expression = round_ pi
695-- in printSQL expression
698-- in printSQL expression
696-- :}
699-- :}
697-- round(pi())
700-- round(pi())
698round_
701round_
699 :: frac `In` PGFloating
702 :: frac `In` PGFloating
700− => Expression schema from grouping params (nullity frac)
703+ => Expression db from grouping params (nullity frac)
701 -- ^ fractional number
704 -- ^ fractional number
702− -> Expression schema from grouping params (nullity frac)
705+ -> Expression db from grouping params (nullity frac)
703round_ = unsafeFunction "round"
706round_ = unsafeFunction "round"
704
707
705-- | >>> :{
708-- | >>> :{
706-- let
709-- let
707−-- expression :: Expression schema from grouping params (nullity 'PGfloat4)
710+-- expression :: Expression db from grouping params (nullity 'PGfloat4)
708-- expression = ceiling_ pi
711-- expression = ceiling_ pi
709-- in printSQL expression
712-- in printSQL expression
710-- :}
713-- :}
711-- ceiling(pi())
714-- ceiling(pi())
712ceiling_
715ceiling_
713 :: frac `In` PGFloating
716 :: frac `In` PGFloating
714− => Expression schema from grouping params (nullity frac)
717+ => Expression db from grouping params (nullity frac)
715 -- ^ fractional number
718 -- ^ fractional number
716− -> Expression schema from grouping params (nullity frac)
719+ -> Expression db from grouping params (nullity frac)
717ceiling_ = unsafeFunction "ceiling"
720ceiling_ = unsafeFunction "ceiling"
718
721
719-- | A `Condition` is an `Expression`, which can evaluate
722-- | A `Condition` is an `Expression`, which can evaluate
720-- to `true`, `false` or `null_`. This is because SQL uses
723-- to `true`, `false` or `null_`. This is because SQL uses
721-- a three valued logic.
724-- a three valued logic.
722−type Condition schema from grouping params =
725+type Condition db from grouping params =
723− Expression schema from grouping params ('Null 'PGbool)
726+ Expression db from grouping params ('Null 'PGbool)
724
727
725-- | >>> printSQL true
728-- | >>> printSQL true
726-- TRUE
729-- TRUE
727−true :: Expression schema from grouping params (nullity 'PGbool)
730+true :: Expression db from grouping params (nullity 'PGbool)
728true = UnsafeExpression "TRUE"
731true = UnsafeExpression "TRUE"
729
732
730-- | >>> printSQL false
733-- | >>> printSQL false
731-- FALSE
734-- FALSE
732−false :: Expression schema from grouping params (nullity 'PGbool)
735+false :: Expression db from grouping params (nullity 'PGbool)
733false = UnsafeExpression "FALSE"
736false = UnsafeExpression "FALSE"
734
737
735-- | >>> printSQL $ not_ true
738-- | >>> printSQL $ not_ true
736-- (NOT TRUE)
739-- (NOT TRUE)
737not_
740not_
738− :: Expression schema from grouping params (nullity 'PGbool)
741+ :: Expression db from grouping params (nullity 'PGbool)
739− -> Expression schema from grouping params (nullity 'PGbool)
742+ -> Expression db from grouping params (nullity 'PGbool)
740not_ = unsafeUnaryOp "NOT"
743not_ = unsafeUnaryOp "NOT"
741
744
742-- | >>> printSQL $ true .&& false
745-- | >>> printSQL $ true .&& false
743-- (TRUE AND FALSE)
746-- (TRUE AND FALSE)
744(.&&)
747(.&&)
745− :: Expression schema from grouping params (nullity 'PGbool)
748+ :: Expression db from grouping params (nullity 'PGbool)
746− -> Expression schema from grouping params (nullity 'PGbool)
749+ -> Expression db from grouping params (nullity 'PGbool)
747− -> Expression schema from grouping params (nullity 'PGbool)
750+ -> Expression db from grouping params (nullity 'PGbool)
748infixr 3 .&&
751infixr 3 .&&
749(.&&) = unsafeBinaryOp "AND"
752(.&&) = unsafeBinaryOp "AND"
750
753
751-- | >>> printSQL $ true .|| false
754-- | >>> printSQL $ true .|| false
752-- (TRUE OR FALSE)
755-- (TRUE OR FALSE)
753(.||)
756(.||)
754− :: Expression schema from grouping params (nullity 'PGbool)
757+ :: Expression db from grouping params (nullity 'PGbool)
755− -> Expression schema from grouping params (nullity 'PGbool)
758+ -> Expression db from grouping params (nullity 'PGbool)
756− -> Expression schema from grouping params (nullity 'PGbool)
759+ -> Expression db from grouping params (nullity 'PGbool)
757infixr 2 .||
760infixr 2 .||
758(.||) = unsafeBinaryOp "OR"
761(.||) = unsafeBinaryOp "OR"
759
762
760-- | >>> :{
763-- | >>> :{
761-- let
764-- let
762−-- expression :: Expression schema from grouping params (nullity 'PGint2)
765+-- expression :: Expression db from grouping params (nullity 'PGint2)
763-- expression = caseWhenThenElse [(true, 1), (false, 2)] 3
766-- expression = caseWhenThenElse [(true, 1), (false, 2)] 3
764-- in printSQL expression
767-- in printSQL expression
765-- :}
768-- :}
766-- CASE WHEN TRUE THEN 1 WHEN FALSE THEN 2 ELSE 3 END
769-- CASE WHEN TRUE THEN 1 WHEN FALSE THEN 2 ELSE 3 END
767caseWhenThenElse
770caseWhenThenElse
768− :: [ ( Condition schema from grouping params
771+ :: [ ( Condition db from grouping params
769− , Expression schema from grouping params ty
772+ , Expression db from grouping params ty
770 ) ]
773 ) ]
771 -- ^ whens and thens
774 -- ^ whens and thens
772− -> Expression schema from grouping params ty
775+ -> Expression db from grouping params ty
773 -- ^ else
776 -- ^ else
774− -> Expression schema from grouping params ty
777+ -> Expression db from grouping params ty
775caseWhenThenElse whenThens else_ = UnsafeExpression $ mconcat
778caseWhenThenElse whenThens else_ = UnsafeExpression $ mconcat
776 [ "CASE"
779 [ "CASE"
777 , mconcat
780 , mconcat
@@ -787,16 +790,16 @@ caseWhenThenElse whenThens else_ = UnsafeExpression $ mconcat
787
790
788-- | >>> :{
791-- | >>> :{
789-- let
792-- let
790−-- expression :: Expression schema from grouping params (nullity 'PGint2)
793+-- expression :: Expression db from grouping params (nullity 'PGint2)
791-- expression = ifThenElse true 1 0
794-- expression = ifThenElse true 1 0
792-- in printSQL expression
795-- in printSQL expression
793-- :}
796-- :}
794-- CASE WHEN TRUE THEN 1 ELSE 0 END
797-- CASE WHEN TRUE THEN 1 ELSE 0 END
795ifThenElse
798ifThenElse
796− :: Condition schema from grouping params
799+ :: Condition db from grouping params
797− -> Expression schema from grouping params ty -- ^ then
800+ -> Expression db from grouping params ty -- ^ then
798− -> Expression schema from grouping params ty -- ^ else
801+ -> Expression db from grouping params ty -- ^ else
799− -> Expression schema from grouping params ty
802+ -> Expression db from grouping params ty
800ifThenElse if_ then_ else_ = caseWhenThenElse [(if_,then_)] else_
803ifThenElse if_ then_ else_ = caseWhenThenElse [(if_,then_)] else_
801
804
802-- | Comparison operations like `.==`, `./=`, `.>`, `.>=`, `.<` and `.<=`
805-- | Comparison operations like `.==`, `./=`, `.>`, `.>=`, `.<` and `.<=`
@@ -805,85 +808,85 @@ ifThenElse if_ then_ else_ = caseWhenThenElse [(if_,then_)] else_
805-- >>> printSQL $ true .== null_
808-- >>> printSQL $ true .== null_
806-- (TRUE = NULL)
809-- (TRUE = NULL)
807(.==)
810(.==)
808− :: Expression schema from grouping params (nullity0 ty) -- ^ lhs
811+ :: Expression db from grouping params (nullity0 ty) -- ^ lhs
809− -> Expression schema from grouping params (nullity1 ty) -- ^ rhs
812+ -> Expression db from grouping params (nullity1 ty) -- ^ rhs
810− -> Condition schema from grouping params
813+ -> Condition db from grouping params
811(.==) = unsafeBinaryOp "="
814(.==) = unsafeBinaryOp "="
812infix 4 .==
815infix 4 .==
813
816
814-- | >>> printSQL $ true ./= null_
817-- | >>> printSQL $ true ./= null_
815-- (TRUE <> NULL)
818-- (TRUE <> NULL)
816(./=)
819(./=)
817− :: Expression schema from grouping params (nullity0 ty) -- ^ lhs
820+ :: Expression db from grouping params (nullity0 ty) -- ^ lhs
818− -> Expression schema from grouping params (nullity1 ty) -- ^ rhs
821+ -> Expression db from grouping params (nullity1 ty) -- ^ rhs
819− -> Condition schema from grouping params
822+ -> Condition db from grouping params
820(./=) = unsafeBinaryOp "<>"
823(./=) = unsafeBinaryOp "<>"
821infix 4 ./=
824infix 4 ./=
822
825
823-- | >>> printSQL $ true .>= null_
826-- | >>> printSQL $ true .>= null_
824-- (TRUE >= NULL)
827-- (TRUE >= NULL)
825(.>=)
828(.>=)
826− :: Expression schema from grouping params (nullity0 ty) -- ^ lhs
829+ :: Expression db from grouping params (nullity0 ty) -- ^ lhs
827− -> Expression schema from grouping params (nullity1 ty) -- ^ rhs
830+ -> Expression db from grouping params (nullity1 ty) -- ^ rhs
828− -> Condition schema from grouping params
831+ -> Condition db from grouping params
829(.>=) = unsafeBinaryOp ">="
832(.>=) = unsafeBinaryOp ">="
830infix 4 .>=
833infix 4 .>=
831
834
832-- | >>> printSQL $ true .< null_
835-- | >>> printSQL $ true .< null_
833-- (TRUE < NULL)
836-- (TRUE < NULL)
834(.<)
837(.<)
835− :: Expression schema from grouping params (nullity0 ty) -- ^ lhs
838+ :: Expression db from grouping params (nullity0 ty) -- ^ lhs
836− -> Expression schema from grouping params (nullity1 ty) -- ^ rhs
839+ -> Expression db from grouping params (nullity1 ty) -- ^ rhs
837− -> Condition schema from grouping params
840+ -> Condition db from grouping params
838(.<) = unsafeBinaryOp "<"
841(.<) = unsafeBinaryOp "<"
839infix 4 .<
842infix 4 .<
840
843
841-- | >>> printSQL $ true .<= null_
844-- | >>> printSQL $ true .<= null_
842-- (TRUE <= NULL)
845-- (TRUE <= NULL)
843(.<=)
846(.<=)
844− :: Expression schema from grouping params (nullity0 ty) -- ^ lhs
847+ :: Expression db from grouping params (nullity0 ty) -- ^ lhs
845− -> Expression schema from grouping params (nullity1 ty) -- ^ rhs
848+ -> Expression db from grouping params (nullity1 ty) -- ^ rhs
846− -> Condition schema from grouping params
849+ -> Condition db from grouping params
847(.<=) = unsafeBinaryOp "<="
850(.<=) = unsafeBinaryOp "<="
848infix 4 .<=
851infix 4 .<=
849
852
850-- | >>> printSQL $ true .> null_
853-- | >>> printSQL $ true .> null_
851-- (TRUE > NULL)
854-- (TRUE > NULL)
852(.>)
855(.>)
853− :: Expression schema from grouping params (nullity0 ty) -- ^ lhs
856+ :: Expression db from grouping params (nullity0 ty) -- ^ lhs
854− -> Expression schema from grouping params (nullity1 ty) -- ^ rhs
857+ -> Expression db from grouping params (nullity1 ty) -- ^ rhs
855− -> Condition schema from grouping params
858+ -> Condition db from grouping params
856(.>) = unsafeBinaryOp ">"
859(.>) = unsafeBinaryOp ">"
857infix 4 .>
860infix 4 .>
858
861
859-- | >>> printSQL currentDate
862-- | >>> printSQL currentDate
860-- CURRENT_DATE
863-- CURRENT_DATE
861currentDate
864currentDate
862− :: Expression schema from grouping params (nullity 'PGdate)
865+ :: Expression db from grouping params (nullity 'PGdate)
863currentDate = UnsafeExpression "CURRENT_DATE"
866currentDate = UnsafeExpression "CURRENT_DATE"
864
867
865-- | >>> printSQL currentTime
868-- | >>> printSQL currentTime
866-- CURRENT_TIME
869-- CURRENT_TIME
867currentTime
870currentTime
868− :: Expression schema from grouping params (nullity 'PGtimetz)
871+ :: Expression db from grouping params (nullity 'PGtimetz)
869currentTime = UnsafeExpression "CURRENT_TIME"
872currentTime = UnsafeExpression "CURRENT_TIME"
870
873
871-- | >>> printSQL currentTimestamp
874-- | >>> printSQL currentTimestamp
872-- CURRENT_TIMESTAMP
875-- CURRENT_TIMESTAMP
873currentTimestamp
876currentTimestamp
874− :: Expression schema from grouping params (nullity 'PGtimestamptz)
877+ :: Expression db from grouping params (nullity 'PGtimestamptz)
875currentTimestamp = UnsafeExpression "CURRENT_TIMESTAMP"
878currentTimestamp = UnsafeExpression "CURRENT_TIMESTAMP"
876
879
877-- | >>> printSQL localTime
880-- | >>> printSQL localTime
878-- LOCALTIME
881-- LOCALTIME
879localTime
882localTime
880− :: Expression schema from grouping params (nullity 'PGtime)
883+ :: Expression db from grouping params (nullity 'PGtime)
881localTime = UnsafeExpression "LOCALTIME"
884localTime = UnsafeExpression "LOCALTIME"
882
885
883-- | >>> printSQL localTimestamp
886-- | >>> printSQL localTimestamp
884-- LOCALTIMESTAMP
887-- LOCALTIMESTAMP
885localTimestamp
888localTimestamp
886− :: Expression schema from grouping params (nullity 'PGtimestamp)
889+ :: Expression db from grouping params (nullity 'PGtimestamp)
887localTimestamp = UnsafeExpression "LOCALTIMESTAMP"
890localTimestamp = UnsafeExpression "LOCALTIMESTAMP"
888
891
889{-----------------------------------------
892{-----------------------------------------
@@ -891,7 +894,7 @@ text
891-----------------------------------------}
894-----------------------------------------}
892
895
893instance IsString
896instance IsString
894− (Expression schema from grouping params (nullity 'PGtext)) where
897+ (Expression db from grouping params (nullity 'PGtext)) where
895 fromString str = UnsafeExpression $
898 fromString str = UnsafeExpression $
896 "E\'" <> fromString (escape =<< str) <> "\'"
899 "E\'" <> fromString (escape =<< str) <> "\'"
897 where
900 where
@@ -907,36 +910,36 @@ instance IsString
907 c -> [c]
910 c -> [c]
908
911
909instance Semigroup
912instance Semigroup
910− (Expression schema from grouping params (nullity 'PGtext)) where
913+ (Expression db from grouping params (nullity 'PGtext)) where
911 (<>) = unsafeBinaryOp "||"
914 (<>) = unsafeBinaryOp "||"
912
915
913instance Monoid
916instance Monoid
914− (Expression schema from grouping params (nullity 'PGtext)) where
917+ (Expression db from grouping params (nullity 'PGtext)) where
915 mempty = fromString ""
918 mempty = fromString ""
916 mappend = (<>)
919 mappend = (<>)
917
920
918-- | >>> printSQL $ lower "ARRRGGG"
921-- | >>> printSQL $ lower "ARRRGGG"
919-- lower(E'ARRRGGG')
922-- lower(E'ARRRGGG')
920lower
923lower
921− :: Expression schema from grouping params (nullity 'PGtext)
924+ :: Expression db from grouping params (nullity 'PGtext)
922 -- ^ string to lower case
925 -- ^ string to lower case
923− -> Expression schema from grouping params (nullity 'PGtext)
926+ -> Expression db from grouping params (nullity 'PGtext)
924lower = unsafeFunction "lower"
927lower = unsafeFunction "lower"
925
928
926-- | >>> printSQL $ upper "eeee"
929-- | >>> printSQL $ upper "eeee"
927-- upper(E'eeee')
930-- upper(E'eeee')
928upper
931upper
929− :: Expression schema from grouping params (nullity 'PGtext)
932+ :: Expression db from grouping params (nullity 'PGtext)
930 -- ^ string to upper case
933 -- ^ string to upper case
931− -> Expression schema from grouping params (nullity 'PGtext)
934+ -> Expression db from grouping params (nullity 'PGtext)
932upper = unsafeFunction "upper"
935upper = unsafeFunction "upper"
933
936
934-- | >>> printSQL $ charLength "four"
937-- | >>> printSQL $ charLength "four"
935-- char_length(E'four')
938-- char_length(E'four')
936charLength
939charLength
937− :: Expression schema from grouping params (nullity 'PGtext)
940+ :: Expression db from grouping params (nullity 'PGtext)
938 -- ^ string to measure
941 -- ^ string to measure
939− -> Expression schema from grouping params (nullity 'PGint4)
942+ -> Expression db from grouping params (nullity 'PGint4)
940charLength = unsafeFunction "char_length"
943charLength = unsafeFunction "char_length"
941
944
942-- | The `like` expression returns true if the @string@ matches
945-- | The `like` expression returns true if the @string@ matches
@@ -949,11 +952,11 @@ charLength = unsafeFunction "char_length"
949-- >>> printSQL $ "abc" `like` "a%"
952-- >>> printSQL $ "abc" `like` "a%"
950-- (E'abc' LIKE E'a%')
953-- (E'abc' LIKE E'a%')
951like
954like
952− :: Expression schema from grouping params (nullity 'PGtext)
955+ :: Expression db from grouping params (nullity 'PGtext)
953 -- ^ string
956 -- ^ string
954− -> Expression schema from grouping params (nullity 'PGtext)
957+ -> Expression db from grouping params (nullity 'PGtext)
955 -- ^ pattern
958 -- ^ pattern
956− -> Expression schema from grouping params (nullity 'PGbool)
959+ -> Expression db from grouping params (nullity 'PGbool)
957like = unsafeBinaryOp "LIKE"
960like = unsafeBinaryOp "LIKE"
958
961
959-- | The key word ILIKE can be used instead of LIKE to make the
962-- | The key word ILIKE can be used instead of LIKE to make the
@@ -981,36 +984,36 @@ Table 9.44: json and jsonb operators
981-- | Get JSON value (object field or array element) at a key.
984-- | Get JSON value (object field or array element) at a key.
982(.->)
985(.->)
983 :: (json `In` PGJsonType, key `In` PGJsonKey)
986 :: (json `In` PGJsonType, key `In` PGJsonKey)
984− => Expression schema from grouping params (nullity json)
987+ => Expression db from grouping params (nullity json)
985− -> Expression schema from grouping params (nullity key)
988+ -> Expression db from grouping params (nullity key)
986− -> Expression schema from grouping params ('Null json)
989+ -> Expression db from grouping params ('Null json)
987infixl 8 .->
990infixl 8 .->
988(.->) = unsafeBinaryOp "->"
991(.->) = unsafeBinaryOp "->"
989
992
990-- | Get JSON value (object field or array element) at a key, as text.
993-- | Get JSON value (object field or array element) at a key, as text.
991(.->>)
994(.->>)
992 :: (json `In` PGJsonType, key `In` PGJsonKey)
995 :: (json `In` PGJsonType, key `In` PGJsonKey)
993− => Expression schema from grouping params (nullity json)
996+ => Expression db from grouping params (nullity json)
994− -> Expression schema from grouping params (nullity key)
997+ -> Expression db from grouping params (nullity key)
995− -> Expression schema from grouping params ('Null 'PGtext)
998+ -> Expression db from grouping params ('Null 'PGtext)
996infixl 8 .->>
999infixl 8 .->>
997(.->>) = unsafeBinaryOp "->>"
1000(.->>) = unsafeBinaryOp "->>"
998
1001
999-- | Get JSON value at a specified path.
1002-- | Get JSON value at a specified path.
1000(.#>)
1003(.#>)
1001 :: (json `In` PGJsonType, PGTextArray "(.#>)" path)
1004 :: (json `In` PGJsonType, PGTextArray "(.#>)" path)
1002− => Expression schema from grouping params (nullity json)
1005+ => Expression db from grouping params (nullity json)
1003− -> Expression schema from grouping params (nullity path)
1006+ -> Expression db from grouping params (nullity path)
1004− -> Expression schema from grouping params ('Null json)
1007+ -> Expression db from grouping params ('Null json)
1005infixl 8 .#>
1008infixl 8 .#>
1006(.#>) = unsafeBinaryOp "#>"
1009(.#>) = unsafeBinaryOp "#>"
1007
1010
1008-- | Get JSON value at a specified path as text.
1011-- | Get JSON value at a specified path as text.
1009(.#>>)
1012(.#>>)
1010 :: (json `In` PGJsonType, PGTextArray "(.#>>)" path)
1013 :: (json `In` PGJsonType, PGTextArray "(.#>>)" path)
1011− => Expression schema from grouping params (nullity json)
1014+ => Expression db from grouping params (nullity json)
1012− -> Expression schema from grouping params (nullity path)
1015+ -> Expression db from grouping params (nullity path)
1013− -> Expression schema from grouping params ('Null 'PGtext)
1016+ -> Expression db from grouping params ('Null 'PGtext)
1014infixl 8 .#>>
1017infixl 8 .#>>
1015(.#>>) = unsafeBinaryOp "#>>"
1018(.#>>) = unsafeBinaryOp "#>>"
1016
1019
@@ -1019,48 +1022,48 @@ infixl 8 .#>>
1019-- | Does the left JSON value contain the right JSON path/value entries at the
1022-- | Does the left JSON value contain the right JSON path/value entries at the
1020-- top level?
1023-- top level?
1021(.@>)
1024(.@>)
1022− :: Expression schema from grouping params (nullity 'PGjsonb)
1025+ :: Expression db from grouping params (nullity 'PGjsonb)
1023− -> Expression schema from grouping params (nullity 'PGjsonb)
1026+ -> Expression db from grouping params (nullity 'PGjsonb)
1024− -> Condition schema from grouping params
1027+ -> Condition db from grouping params
1025infixl 9 .@>
1028infixl 9 .@>
1026(.@>) = unsafeBinaryOp "@>"
1029(.@>) = unsafeBinaryOp "@>"
1027
1030
1028-- | Are the left JSON path/value entries contained at the top level within the
1031-- | Are the left JSON path/value entries contained at the top level within the
1029-- right JSON value?
1032-- right JSON value?
1030(.<@)
1033(.<@)
1031− :: Expression schema from grouping params (nullity 'PGjsonb)
1034+ :: Expression db from grouping params (nullity 'PGjsonb)
1032− -> Expression schema from grouping params (nullity 'PGjsonb)
1035+ -> Expression db from grouping params (nullity 'PGjsonb)
1033− -> Condition schema from grouping params
1036+ -> Condition db from grouping params
1034infixl 9 .<@
1037infixl 9 .<@
1035(.<@) = unsafeBinaryOp "<@"
1038(.<@) = unsafeBinaryOp "<@"
1036
1039
1037-- | Does the string exist as a top-level key within the JSON value?
1040-- | Does the string exist as a top-level key within the JSON value?
1038(.?)
1041(.?)
1039− :: Expression schema from grouping params (nullity 'PGjsonb)
1042+ :: Expression db from grouping params (nullity 'PGjsonb)
1040− -> Expression schema from grouping params (nullity 'PGtext)
1043+ -> Expression db from grouping params (nullity 'PGtext)
1041− -> Condition schema from grouping params
1044+ -> Condition db from grouping params
1042infixl 9 .?
1045infixl 9 .?
1043(.?) = unsafeBinaryOp "?"
1046(.?) = unsafeBinaryOp "?"
1044
1047
1045-- | Do any of these array strings exist as top-level keys?
1048-- | Do any of these array strings exist as top-level keys?
1046(.?|)
1049(.?|)
1047− :: Expression schema from grouping params (nullity 'PGjsonb)
1050+ :: Expression db from grouping params (nullity 'PGjsonb)
1048− -> Expression schema from grouping params (nullity ('PGvararray ('NotNull 'PGtext)))
1051+ -> Expression db from grouping params (nullity ('PGvararray ('NotNull 'PGtext)))
1049− -> Condition schema from grouping params
1052+ -> Condition db from grouping params
1050infixl 9 .?|
1053infixl 9 .?|
1051(.?|) = unsafeBinaryOp "?|"
1054(.?|) = unsafeBinaryOp "?|"
1052
1055
1053-- | Do all of these array strings exist as top-level keys?
1056-- | Do all of these array strings exist as top-level keys?
1054(.?&)
1057(.?&)
1055− :: Expression schema from grouping params (nullity 'PGjsonb)
1058+ :: Expression db from grouping params (nullity 'PGjsonb)
1056− -> Expression schema from grouping params (nullity ('PGvararray ('NotNull 'PGtext)))
1059+ -> Expression db from grouping params (nullity ('PGvararray ('NotNull 'PGtext)))
1057− -> Condition schema from grouping params
1060+ -> Condition db from grouping params
1058infixl 9 .?&
1061infixl 9 .?&
1059(.?&) = unsafeBinaryOp "?&"
1062(.?&) = unsafeBinaryOp "?&"
1060
1063
1061-- | Concatenate two jsonb values into a new jsonb value.
1064-- | Concatenate two jsonb values into a new jsonb value.
1062instance
1065instance
1063− Semigroup (Expression schema from grouping param (nullity 'PGjsonb)) where
1066+ Semigroup (Expression db from grouping param (nullity 'PGjsonb)) where
1064 (<>) = unsafeBinaryOp "||"
1067 (<>) = unsafeBinaryOp "||"
1065
1068
1066-- | Delete a key or keys from a JSON object, or remove an array element.
1069-- | Delete a key or keys from a JSON object, or remove an array element.
@@ -1077,9 +1080,9 @@ instance
1077-- count from the end). Throws an error if top level container is not an array.
1080-- count from the end). Throws an error if top level container is not an array.
1078(.-.)
1081(.-.)
1079 :: (key `In` '[ 'PGtext, 'PGvararray ('NotNull 'PGtext), 'PGint4, 'PGint2 ]) -- hlint error without parens here
1082 :: (key `In` '[ 'PGtext, 'PGvararray ('NotNull 'PGtext), 'PGint4, 'PGint2 ]) -- hlint error without parens here
1080− => Expression schema from grouping params (nullity 'PGjsonb)
1083+ => Expression db from grouping params (nullity 'PGjsonb)
1081− -> Expression schema from grouping params (nullity key)
1084+ -> Expression db from grouping params (nullity key)
1082− -> Expression schema from grouping params (nullity 'PGjsonb)
1085+ -> Expression db from grouping params (nullity 'PGjsonb)
1083infixl 6 .-.
1086infixl 6 .-.
1084(.-.) = unsafeBinaryOp "-"
1087(.-.) = unsafeBinaryOp "-"
1085
1088
@@ -1087,9 +1090,9 @@ infixl 6 .-.
1087-- integers count from the end)
1090-- integers count from the end)
1088(#-.)
1091(#-.)
1089 :: PGTextArray "(#-.)" arrayty
1092 :: PGTextArray "(#-.)" arrayty
1090− => Expression schema from grouping params (nullity 'PGjsonb)
1093+ => Expression db from grouping params (nullity 'PGjsonb)
1091− -> Expression schema from grouping params (nullity arrayty)
1094+ -> Expression db from grouping params (nullity arrayty)
1092− -> Expression schema from grouping params (nullity 'PGjsonb)
1095+ -> Expression db from grouping params (nullity 'PGjsonb)
1093infixl 6 #-.
1096infixl 6 #-.
1094(#-.) = unsafeBinaryOp "#-"
1097(#-.) = unsafeBinaryOp "#-"
1095
1098
@@ -1100,14 +1103,14 @@ Table 9.45: JSON creation functions
1100-- | Literal binary JSON
1103-- | Literal binary JSON
1101jsonbLit
1104jsonbLit
1102 :: JSON.ToJSON x
1105 :: JSON.ToJSON x
1103− => x -> Expression schema from grouping params (nullity 'PGjsonb)
1106+ => x -> Expression (commons :=> schemas) from grouping params (nullity 'PGjsonb)
1104jsonbLit = cast jsonb . UnsafeExpression
1107jsonbLit = cast jsonb . UnsafeExpression
1105 . singleQuotedUtf8 . toStrict . JSON.encode
1108 . singleQuotedUtf8 . toStrict . JSON.encode
1106
1109
1107-- | Literal JSON
1110-- | Literal JSON
1108jsonLit
1111jsonLit
1109 :: JSON.ToJSON x
1112 :: JSON.ToJSON x
1110− => x -> Expression schema from grouping params (nullity 'PGjson)
1113+ => x -> Expression (commons :=> schemas) from grouping params (nullity 'PGjson)
1111jsonLit = cast json . UnsafeExpression
1114jsonLit = cast json . UnsafeExpression
1112 . singleQuotedUtf8 . toStrict . JSON.encode
1115 . singleQuotedUtf8 . toStrict . JSON.encode
1113
1116
@@ -1118,8 +1121,8 @@ jsonLit = cast json . UnsafeExpression
1118-- number, a Boolean, or a null value, the text representation will be used, in
1121-- number, a Boolean, or a null value, the text representation will be used, in
1119-- such a fashion that it is a valid json value.
1122-- such a fashion that it is a valid json value.
1120toJson
1123toJson
1121− :: Expression schema from grouping params (nullity ty)
1124+ :: Expression db from grouping params (nullity ty)
1122− -> Expression schema from grouping params (nullity 'PGjson)
1125+ -> Expression db from grouping params (nullity 'PGjson)
1123toJson = unsafeFunction "to_json"
1126toJson = unsafeFunction "to_json"
1124
1127
1125-- | Returns the value as jsonb. Arrays and composites are converted
1128-- | Returns the value as jsonb. Arrays and composites are converted
@@ -1129,43 +1132,43 @@ toJson = unsafeFunction "to_json"
1129-- number, a Boolean, or a null value, the text representation will be used, in
1132-- number, a Boolean, or a null value, the text representation will be used, in
1130-- such a fashion that it is a valid jsonb value.
1133-- such a fashion that it is a valid jsonb value.
1131toJsonb
1134toJsonb
1132− :: Expression schema from grouping params (nullity ty)
1135+ :: Expression db from grouping params (nullity ty)
1133− -> Expression schema from grouping params (nullity 'PGjsonb)
1136+ -> Expression db from grouping params (nullity 'PGjsonb)
1134toJsonb = unsafeFunction "to_jsonb"
1137toJsonb = unsafeFunction "to_jsonb"
1135
1138
1136-- | Returns the array as a JSON array. A PostgreSQL multidimensional array
1139-- | Returns the array as a JSON array. A PostgreSQL multidimensional array
1137-- becomes a JSON array of arrays.
1140-- becomes a JSON array of arrays.
1138arrayToJson
1141arrayToJson
1139 :: PGArray "arrayToJson" arr
1142 :: PGArray "arrayToJson" arr
1140− => Expression schema from grouping params (nullity arr)
1143+ => Expression db from grouping params (nullity arr)
1141− -> Expression schema from grouping params (nullity 'PGjson)
1144+ -> Expression db from grouping params (nullity 'PGjson)
1142arrayToJson = unsafeFunction "array_to_json"
1145arrayToJson = unsafeFunction "array_to_json"
1143
1146
1144-- | Returns the row as a JSON object.
1147-- | Returns the row as a JSON object.
1145rowToJson
1148rowToJson
1146− :: Expression schema from grouping params (nullity ('PGcomposite ty))
1149+ :: Expression db from grouping params (nullity ('PGcomposite ty))
1147− -> Expression schema from grouping params (nullity 'PGjson)
1150+ -> Expression db from grouping params (nullity 'PGjson)
1148rowToJson = unsafeFunction "row_to_json"
1151rowToJson = unsafeFunction "row_to_json"
1149
1152
1150-- | Builds a possibly-heterogeneously-typed JSON array out of a variadic
1153-- | Builds a possibly-heterogeneously-typed JSON array out of a variadic
1151-- argument list.
1154-- argument list.
1152jsonBuildArray
1155jsonBuildArray
1153 :: SListI elems
1156 :: SListI elems
1154− => NP (Expression schema from grouping params) elems
1157+ => NP (Expression db from grouping params) elems
1155− -> Expression schema from grouping params (nullity 'PGjson)
1158+ -> Expression db from grouping params (nullity 'PGjson)
1156jsonBuildArray = unsafeVariadicFunction "json_build_array"
1159jsonBuildArray = unsafeVariadicFunction "json_build_array"
1157
1160
1158-- | Builds a possibly-heterogeneously-typed (binary) JSON array out of a
1161-- | Builds a possibly-heterogeneously-typed (binary) JSON array out of a
1159-- variadic argument list.
1162-- variadic argument list.
1160jsonbBuildArray
1163jsonbBuildArray
1161 :: SListI elems
1164 :: SListI elems
1162− => NP (Expression schema from grouping params) elems
1165+ => NP (Expression db from grouping params) elems
1163− -> Expression schema from grouping params (nullity 'PGjsonb)
1166+ -> Expression db from grouping params (nullity 'PGjsonb)
1164jsonbBuildArray = unsafeVariadicFunction "jsonb_build_array"
1167jsonbBuildArray = unsafeVariadicFunction "jsonb_build_array"
1165
1168
1166unsafeRowFunction
1169unsafeRowFunction
1167 :: All Top elems
1170 :: All Top elems
1168− => NP (Aliased (Expression schema from grouping params)) elems
1171+ => NP (Aliased (Expression db from grouping params)) elems
1169 -> [ByteString]
1172 -> [ByteString]
1170unsafeRowFunction =
1173unsafeRowFunction =
1171 (`appEndo` []) . hcfoldMap (Proxy :: Proxy Top)
1174 (`appEndo` []) . hcfoldMap (Proxy :: Proxy Top)
@@ -1177,8 +1180,8 @@ unsafeRowFunction =
1177-- and values.
1180-- and values.
1178jsonBuildObject
1181jsonBuildObject
1179 :: All Top elems
1182 :: All Top elems
1180− => NP (Aliased (Expression schema from grouping params)) elems
1183+ => NP (Aliased (Expression db from grouping params)) elems
1181− -> Expression schema from grouping params (nullity 'PGjson)
1184+ -> Expression db from grouping params (nullity 'PGjson)
1182jsonBuildObject
1185jsonBuildObject
1183 = unsafeFunction "json_build_object"
1186 = unsafeFunction "json_build_object"
1184 . UnsafeExpression
1187 . UnsafeExpression
@@ -1190,8 +1193,8 @@ jsonBuildObject
1190-- between text and values.
1193-- between text and values.
1191jsonbBuildObject
1194jsonbBuildObject
1192 :: All Top elems
1195 :: All Top elems
1193− => NP (Aliased (Expression schema from grouping params)) elems
1196+ => NP (Aliased (Expression db from grouping params)) elems
1194− -> Expression schema from grouping params (nullity 'PGjsonb)
1197+ -> Expression db from grouping params (nullity 'PGjsonb)
1195jsonbBuildObject
1198jsonbBuildObject
1196 = unsafeFunction "jsonb_build_object"
1199 = unsafeFunction "jsonb_build_object"
1197 . UnsafeExpression
1200 . UnsafeExpression
@@ -1204,8 +1207,8 @@ jsonbBuildObject
1204-- array has exactly two elements, which are taken as a key/value pair.
1207-- array has exactly two elements, which are taken as a key/value pair.
1205jsonObject
1208jsonObject
1206 :: PGArrayOf "jsonObject" arr ('NotNull 'PGtext)
1209 :: PGArrayOf "jsonObject" arr ('NotNull 'PGtext)
1207− => Expression schema from grouping params (nullity arr)
1210+ => Expression db from grouping params (nullity arr)
1208− -> Expression schema from grouping params (nullity 'PGjson)
1211+ -> Expression db from grouping params (nullity 'PGjson)
1209jsonObject = unsafeFunction "json_object"
1212jsonObject = unsafeFunction "json_object"
1210
1213
1211-- | Builds a binary JSON object out of a text array. The array must have either
1214-- | Builds a binary JSON object out of a text array. The array must have either
@@ -1214,8 +1217,8 @@ jsonObject = unsafeFunction "json_object"
1214-- array has exactly two elements, which are taken as a key/value pair.
1217-- array has exactly two elements, which are taken as a key/value pair.
1215jsonbObject
1218jsonbObject
1216 :: PGArrayOf "jsonbObject" arr ('NotNull 'PGtext)
1219 :: PGArrayOf "jsonbObject" arr ('NotNull 'PGtext)
1217− => Expression schema from grouping params (nullity arr)
1220+ => Expression db from grouping params (nullity arr)
1218− -> Expression schema from grouping params (nullity 'PGjsonb)
1221+ -> Expression db from grouping params (nullity 'PGjsonb)
1219jsonbObject = unsafeFunction "jsonb_object"
1222jsonbObject = unsafeFunction "jsonb_object"
1220
1223
1221-- | This is an alternate form of 'jsonObject' that takes two arrays; one for
1224-- | This is an alternate form of 'jsonObject' that takes two arrays; one for
@@ -1223,9 +1226,9 @@ jsonbObject = unsafeFunction "jsonb_object"
1223jsonZipObject
1226jsonZipObject
1224 :: ( PGArrayOf "jsonZipObject" keysArray ('NotNull 'PGtext)
1227 :: ( PGArrayOf "jsonZipObject" keysArray ('NotNull 'PGtext)
1225 , PGArrayOf "jsonZipObject" valuesArray ('NotNull 'PGtext))
1228 , PGArrayOf "jsonZipObject" valuesArray ('NotNull 'PGtext))
1226− => Expression schema from grouping params (nullity keysArray)
1229+ => Expression db from grouping params (nullity keysArray)
1227− -> Expression schema from grouping params (nullity valuesArray)
1230+ -> Expression db from grouping params (nullity valuesArray)
1228− -> Expression schema from grouping params (nullity 'PGjson)
1231+ -> Expression db from grouping params (nullity 'PGjson)
1229jsonZipObject ks vs =
1232jsonZipObject ks vs =
1230 unsafeVariadicFunction "json_object" (ks :* vs :* Nil)
1233 unsafeVariadicFunction "json_object" (ks :* vs :* Nil)
1231
1234
@@ -1235,9 +1238,9 @@ jsonZipObject ks vs =
1235jsonbZipObject
1238jsonbZipObject
1236 :: ( PGArrayOf "jsonbZipObject" keysArray ('NotNull 'PGtext)
1239 :: ( PGArrayOf "jsonbZipObject" keysArray ('NotNull 'PGtext)
1237 , PGArrayOf "jsonbZipObject" valuesArray ('NotNull 'PGtext))
1240 , PGArrayOf "jsonbZipObject" valuesArray ('NotNull 'PGtext))
1238− => Expression schema from grouping params (nullity keysArray)
1241+ => Expression db from grouping params (nullity keysArray)
1239− -> Expression schema from grouping params (nullity valuesArray)
1242+ -> Expression db from grouping params (nullity valuesArray)
1240− -> Expression schema from grouping params (nullity 'PGjsonb)
1243+ -> Expression db from grouping params (nullity 'PGjsonb)
1241jsonbZipObject ks vs =
1244jsonbZipObject ks vs =
1242 unsafeVariadicFunction "jsonb_object" (ks :* vs :* Nil)
1245 unsafeVariadicFunction "jsonb_object" (ks :* vs :* Nil)
1243
1246
@@ -1247,23 +1250,23 @@ Table 9.46: JSON processing functions
1247
1250
1248-- | Returns the number of elements in the outermost JSON array.
1251-- | Returns the number of elements in the outermost JSON array.
1249jsonArrayLength
1252jsonArrayLength
1250− :: Expression schema from grouping params (nullity 'PGjson)
1253+ :: Expression db from grouping params (nullity 'PGjson)
1251− -> Expression schema from grouping params (nullity 'PGint4)
1254+ -> Expression db from grouping params (nullity 'PGint4)
1252jsonArrayLength = unsafeFunction "json_array_length"
1255jsonArrayLength = unsafeFunction "json_array_length"
1253
1256
1254-- | Returns the number of elements in the outermost binary JSON array.
1257-- | Returns the number of elements in the outermost binary JSON array.
1255jsonbArrayLength
1258jsonbArrayLength
1256− :: Expression schema from grouping params (nullity 'PGjsonb)
1259+ :: Expression db from grouping params (nullity 'PGjsonb)
1257− -> Expression schema from grouping params (nullity 'PGint4)
1260+ -> Expression db from grouping params (nullity 'PGint4)
1258jsonbArrayLength = unsafeFunction "jsonb_array_length"
1261jsonbArrayLength = unsafeFunction "jsonb_array_length"
1259
1262
1260-- | Returns JSON value pointed to by the given path (equivalent to #>
1263-- | Returns JSON value pointed to by the given path (equivalent to #>
1261-- operator).
1264-- operator).
1262jsonExtractPath
1265jsonExtractPath
1263 :: SListI elems
1266 :: SListI elems
1264− => Expression schema from grouping params (nullity 'PGjson)
1267+ => Expression db from grouping params (nullity 'PGjson)
1265− -> NP (Expression schema from grouping params) elems
1268+ -> NP (Expression db from grouping params) elems
1266− -> Expression schema from grouping params (nullity 'PGjsonb)
1269+ -> Expression db from grouping params (nullity 'PGjsonb)
1267jsonExtractPath x xs =
1270jsonExtractPath x xs =
1268 unsafeVariadicFunction "json_extract_path" (x :* xs)
1271 unsafeVariadicFunction "json_extract_path" (x :* xs)
1269
1272
@@ -1271,9 +1274,9 @@ jsonExtractPath x xs =
1271-- operator).
1274-- operator).
1272jsonbExtractPath
1275jsonbExtractPath
1273 :: SListI elems
1276 :: SListI elems
1274− => Expression schema from grouping params (nullity 'PGjsonb)
1277+ => Expression db from grouping params (nullity 'PGjsonb)
1275− -> NP (Expression schema from grouping params) elems
1278+ -> NP (Expression db from grouping params) elems
1276− -> Expression schema from grouping params (nullity 'PGjsonb)
1279+ -> Expression db from grouping params (nullity 'PGjsonb)
1277jsonbExtractPath x xs =
1280jsonbExtractPath x xs =
1278 unsafeVariadicFunction "jsonb_extract_path" (x :* xs)
1281 unsafeVariadicFunction "jsonb_extract_path" (x :* xs)
1279
1282
@@ -1281,9 +1284,9 @@ jsonbExtractPath x xs =
1281-- operator), as text.
1284-- operator), as text.
1282jsonExtractPathAsText
1285jsonExtractPathAsText
1283 :: SListI elems
1286 :: SListI elems
1284− => Expression schema from grouping params (nullity 'PGjson)
1287+ => Expression db from grouping params (nullity 'PGjson)
1285− -> NP (Expression schema from grouping params) elems
1288+ -> NP (Expression db from grouping params) elems
1286− -> Expression schema from grouping params (nullity 'PGjson)
1289+ -> Expression db from grouping params (nullity 'PGjson)
1287jsonExtractPathAsText x xs =
1290jsonExtractPathAsText x xs =
1288 unsafeVariadicFunction "json_extract_path_text" (x :* xs)
1291 unsafeVariadicFunction "json_extract_path_text" (x :* xs)
1289
1292
@@ -1291,38 +1294,38 @@ jsonExtractPathAsText x xs =
1291-- operator), as text.
1294-- operator), as text.
1292jsonbExtractPathAsText
1295jsonbExtractPathAsText
1293 :: SListI elems
1296 :: SListI elems
1294− => Expression schema from grouping params (nullity 'PGjsonb)
1297+ => Expression db from grouping params (nullity 'PGjsonb)
1295− -> NP (Expression schema from grouping params) elems
1298+ -> NP (Expression db from grouping params) elems
1296− -> Expression schema from grouping params (nullity 'PGjsonb)
1299+ -> Expression db from grouping params (nullity 'PGjsonb)
1297jsonbExtractPathAsText x xs =
1300jsonbExtractPathAsText x xs =
1298 unsafeVariadicFunction "jsonb_extract_path_text" (x :* xs)
1301 unsafeVariadicFunction "jsonb_extract_path_text" (x :* xs)
1299
1302
1300-- | Returns the type of the outermost JSON value as a text string. Possible
1303-- | Returns the type of the outermost JSON value as a text string. Possible
1301-- types are object, array, string, number, boolean, and null.
1304-- types are object, array, string, number, boolean, and null.
1302jsonTypeof
1305jsonTypeof
1303− :: Expression schema from grouping params (nullity 'PGjson)
1306+ :: Expression db from grouping params (nullity 'PGjson)
1304− -> Expression schema from grouping params (nullity 'PGtext)
1307+ -> Expression db from grouping params (nullity 'PGtext)
1305jsonTypeof = unsafeFunction "json_typeof"
1308jsonTypeof = unsafeFunction "json_typeof"
1306
1309
1307-- | Returns the type of the outermost binary JSON value as a text string.
1310-- | Returns the type of the outermost binary JSON value as a text string.
1308-- Possible types are object, array, string, number, boolean, and null.
1311-- Possible types are object, array, string, number, boolean, and null.
1309jsonbTypeof
1312jsonbTypeof
1310− :: Expression schema from grouping params (nullity 'PGjsonb)
1313+ :: Expression db from grouping params (nullity 'PGjsonb)
1311− -> Expression schema from grouping params (nullity 'PGtext)
1314+ -> Expression db from grouping params (nullity 'PGtext)
1312jsonbTypeof = unsafeFunction "jsonb_typeof"
1315jsonbTypeof = unsafeFunction "jsonb_typeof"
1313
1316
1314-- | Returns its argument with all object fields that have null values omitted.
1317-- | Returns its argument with all object fields that have null values omitted.
1315-- Other null values are untouched.
1318-- Other null values are untouched.
1316jsonStripNulls
1319jsonStripNulls
1317− :: Expression schema from grouping params (nullity 'PGjson)
1320+ :: Expression db from grouping params (nullity 'PGjson)
1318− -> Expression schema from grouping params (nullity 'PGjson)
1321+ -> Expression db from grouping params (nullity 'PGjson)
1319jsonStripNulls = unsafeFunction "json_strip_nulls"
1322jsonStripNulls = unsafeFunction "json_strip_nulls"
1320
1323
1321-- | Returns its argument with all object fields that have null values omitted.
1324-- | Returns its argument with all object fields that have null values omitted.
1322-- Other null values are untouched.
1325-- Other null values are untouched.
1323jsonbStripNulls
1326jsonbStripNulls
1324− :: Expression schema from grouping params (nullity 'PGjsonb)
1327+ :: Expression db from grouping params (nullity 'PGjsonb)
1325− -> Expression schema from grouping params (nullity 'PGjsonb)
1328+ -> Expression db from grouping params (nullity 'PGjsonb)
1326jsonbStripNulls = unsafeFunction "jsonb_strip_nulls"
1329jsonbStripNulls = unsafeFunction "jsonb_strip_nulls"
1327
1330
1328-- | @ jsonbSet target path new_value create_missing @
1331-- | @ jsonbSet target path new_value create_missing @
@@ -1334,11 +1337,11 @@ jsonbStripNulls = unsafeFunction "jsonb_strip_nulls"
1334-- arrays.
1337-- arrays.
1335jsonbSet
1338jsonbSet
1336 :: PGTextArray "jsonbSet" arr
1339 :: PGTextArray "jsonbSet" arr
1337− => Expression schema from grouping params (nullity 'PGjsonb)
1340+ => Expression db from grouping params (nullity 'PGjsonb)
1338− -> Expression schema from grouping params (nullity arr)
1341+ -> Expression db from grouping params (nullity arr)
1339− -> Expression schema from grouping params (nullity 'PGjsonb)
1342+ -> Expression db from grouping params (nullity 'PGjsonb)
1340− -> Maybe (Expression schema from grouping params (nullity 'PGbool))
1343+ -> Maybe (Expression db from grouping params (nullity 'PGbool))
1341− -> Expression schema from grouping params (nullity 'PGjsonb)
1344+ -> Expression db from grouping params (nullity 'PGjsonb)
1342jsonbSet tgt path val createMissing = case createMissing of
1345jsonbSet tgt path val createMissing = case createMissing of
1343 Just m -> unsafeVariadicFunction "jsonb_set" (tgt :* path :* val :* m :* Nil)
1346 Just m -> unsafeVariadicFunction "jsonb_set" (tgt :* path :* val :* m :* Nil)
1344 Nothing -> unsafeVariadicFunction "jsonb_set" (tgt :* path :* val :* Nil)
1347 Nothing -> unsafeVariadicFunction "jsonb_set" (tgt :* path :* val :* Nil)
@@ -1353,19 +1356,19 @@ jsonbSet tgt path val createMissing = case createMissing of
1353-- in path count from the end of JSON arrays.
1356-- in path count from the end of JSON arrays.
1354jsonbInsert
1357jsonbInsert
1355 :: PGTextArray "jsonbInsert" arr
1358 :: PGTextArray "jsonbInsert" arr
1356− => Expression schema from grouping params (nullity 'PGjsonb)
1359+ => Expression db from grouping params (nullity 'PGjsonb)
1357− -> Expression schema from grouping params (nullity arr)
1360+ -> Expression db from grouping params (nullity arr)
1358− -> Expression schema from grouping params (nullity 'PGjsonb)
1361+ -> Expression db from grouping params (nullity 'PGjsonb)
1359− -> Maybe (Expression schema from grouping params (nullity 'PGbool))
1362+ -> Maybe (Expression db from grouping params (nullity 'PGbool))
1360− -> Expression schema from grouping params (nullity 'PGjsonb)
1363+ -> Expression db from grouping params (nullity 'PGjsonb)
1361jsonbInsert tgt path val insertAfter = case insertAfter of
1364jsonbInsert tgt path val insertAfter = case insertAfter of
1362 Just i -> unsafeVariadicFunction "jsonb_insert" (tgt :* path :* val :* i :* Nil)
1365 Just i -> unsafeVariadicFunction "jsonb_insert" (tgt :* path :* val :* i :* Nil)
1363 Nothing -> unsafeVariadicFunction "jsonb_insert" (tgt :* path :* val :* Nil)
1366 Nothing -> unsafeVariadicFunction "jsonb_insert" (tgt :* path :* val :* Nil)
1364
1367
1365-- | Returns its argument as indented JSON text.
1368-- | Returns its argument as indented JSON text.
1366jsonbPretty
1369jsonbPretty
1367− :: Expression schema from grouping params (nullity 'PGjsonb)
1370+ :: Expression db from grouping params (nullity 'PGjsonb)
1368− -> Expression schema from grouping params (nullity 'PGtext)
1371+ -> Expression db from grouping params (nullity 'PGtext)
1369jsonbPretty = unsafeFunction "jsonb_pretty"
1372jsonbPretty = unsafeFunction "jsonb_pretty"
1370
1373
1371{-----------------------------------------
1374{-----------------------------------------
@@ -1375,54 +1378,54 @@ aggregation
1375-- | escape hatch to define aggregate functions
1378-- | escape hatch to define aggregate functions
1376unsafeAggregate
1379unsafeAggregate
1377 :: ByteString -- ^ aggregate function
1380 :: ByteString -- ^ aggregate function
1378− -> Expression schema from 'Ungrouped params (xty)
1381+ -> Expression db from 'Ungrouped params (xty)
1379− -> Expression schema from ('Grouped bys) params (yty)
1382+ -> Expression db from ('Grouped bys) params (yty)
1380unsafeAggregate fun x = UnsafeExpression $ mconcat
1383unsafeAggregate fun x = UnsafeExpression $ mconcat
1381 [fun, "(", renderExpression x, ")"]
1384 [fun, "(", renderExpression x, ")"]
1382
1385
1383-- | escape hatch to define aggregate functions over distinct values
1386-- | escape hatch to define aggregate functions over distinct values
1384unsafeAggregateDistinct
1387unsafeAggregateDistinct
1385 :: ByteString -- ^ aggregate function
1388 :: ByteString -- ^ aggregate function
1386− -> Expression schema from 'Ungrouped params (xty)
1389+ -> Expression db from 'Ungrouped params (xty)
1387− -> Expression schema from ('Grouped bys) params (yty)
1390+ -> Expression db from ('Grouped bys) params (yty)
1388unsafeAggregateDistinct fun x = UnsafeExpression $ mconcat
1391unsafeAggregateDistinct fun x = UnsafeExpression $ mconcat
1389 [fun, "(DISTINCT ", renderExpression x, ")"]
1392 [fun, "(DISTINCT ", renderExpression x, ")"]
1390
1393
1391-- | >>> :{
1394-- | >>> :{
1392-- let
1395-- let
1393−-- expression :: Expression schema '[tab ::: '["col" ::: 'Null 'PGnumeric]] ('Grouped bys) params ('Null 'PGnumeric)
1396+-- expression :: Expression db '[tab ::: '["col" ::: 'Null 'PGnumeric]] ('Grouped bys) params ('Null 'PGnumeric)
1394-- expression = sum_ #col
1397-- expression = sum_ #col
1395-- in printSQL expression
1398-- in printSQL expression
1396-- :}
1399-- :}
1397-- sum("col")
1400-- sum("col")
1398sum_
1401sum_
1399 :: ty `In` PGNum
1402 :: ty `In` PGNum
1400− => Expression schema from 'Ungrouped params (nullity ty)
1403+ => Expression db from 'Ungrouped params (nullity ty)
1401 -- ^ what to sum
1404 -- ^ what to sum
1402− -> Expression schema from ('Grouped bys) params (nullity ty)
1405+ -> Expression db from ('Grouped bys) params (nullity ty)
1403sum_ = unsafeAggregate "sum"
1406sum_ = unsafeAggregate "sum"
1404
1407
1405-- | >>> :{
1408-- | >>> :{
1406-- let
1409-- let
1407−-- expression :: Expression schema '[tab ::: '["col" ::: nullity 'PGnumeric]] ('Grouped bys) params (nullity 'PGnumeric)
1410+-- expression :: Expression db '[tab ::: '["col" ::: nullity 'PGnumeric]] ('Grouped bys) params (nullity 'PGnumeric)
1408-- expression = sumDistinct #col
1411-- expression = sumDistinct #col
1409-- in printSQL expression
1412-- in printSQL expression
1410-- :}
1413-- :}
1411-- sum(DISTINCT "col")
1414-- sum(DISTINCT "col")
1412sumDistinct
1415sumDistinct
1413 :: ty `In` PGNum
1416 :: ty `In` PGNum
1414− => Expression schema from 'Ungrouped params (nullity ty)
1417+ => Expression db from 'Ungrouped params (nullity ty)
1415 -- ^ what to sum
1418 -- ^ what to sum
1416− -> Expression schema from ('Grouped bys) params (nullity ty)
1419+ -> Expression db from ('Grouped bys) params (nullity ty)
1417sumDistinct = unsafeAggregateDistinct "sum"
1420sumDistinct = unsafeAggregateDistinct "sum"
1418
1421
1419-- | A constraint for `PGType`s that you can take averages of and the resulting
1422-- | A constraint for `PGType`s that you can take averages of and the resulting
1420-- `PGType`.
1423-- `PGType`.
1421class PGAvg ty avg | ty -> avg where
1424class PGAvg ty avg | ty -> avg where
1422 avg, avgDistinct
1425 avg, avgDistinct
1423− :: Expression schema from 'Ungrouped params (nullity ty)
1426+ :: Expression db from 'Ungrouped params (nullity ty)
1424 -- ^ what to average
1427 -- ^ what to average
1425− -> Expression schema from ('Grouped bys) params (nullity avg)
1428+ -> Expression db from ('Grouped bys) params (nullity avg)
1426 avg = unsafeAggregate "avg"
1429 avg = unsafeAggregate "avg"
1427 avgDistinct = unsafeAggregateDistinct "avg"
1430 avgDistinct = unsafeAggregateDistinct "avg"
1428instance PGAvg 'PGint2 'PGnumeric
1431instance PGAvg 'PGint2 'PGnumeric
@@ -1435,110 +1438,110 @@ instance PGAvg 'PGinterval 'PGinterval
1435
1438
1436-- | >>> :{
1439-- | >>> :{
1437-- let
1440-- let
1438−-- expression :: Expression schema '[tab ::: '["col" ::: nullity 'PGint4]] (Grouped bys) params (nullity 'PGint4)
1441+-- expression :: Expression db '[tab ::: '["col" ::: nullity 'PGint4]] (Grouped bys) params (nullity 'PGint4)
1439-- expression = bitAnd #col
1442-- expression = bitAnd #col
1440-- in printSQL expression
1443-- in printSQL expression
1441-- :}
1444-- :}
1442-- bit_and("col")
1445-- bit_and("col")
1443bitAnd
1446bitAnd
1444 :: int `In` PGIntegral
1447 :: int `In` PGIntegral
1445− => Expression schema from 'Ungrouped params (nullity int)
1448+ => Expression db from 'Ungrouped params (nullity int)
1446 -- ^ what to aggregate
1449 -- ^ what to aggregate
1447− -> Expression schema from ('Grouped bys) params (nullity int)
1450+ -> Expression db from ('Grouped bys) params (nullity int)
1448bitAnd = unsafeAggregate "bit_and"
1451bitAnd = unsafeAggregate "bit_and"
1449
1452
1450-- | >>> :{
1453-- | >>> :{
1451-- let
1454-- let
1452−-- expression :: Expression schema '[tab ::: '["col" ::: nullity 'PGint4]] (Grouped bys) params (nullity 'PGint4)
1455+-- expression :: Expression db '[tab ::: '["col" ::: nullity 'PGint4]] (Grouped bys) params (nullity 'PGint4)
1453-- expression = bitOr #col
1456-- expression = bitOr #col
1454-- in printSQL expression
1457-- in printSQL expression
1455-- :}
1458-- :}
1456-- bit_or("col")
1459-- bit_or("col")
1457bitOr
1460bitOr
1458 :: int `In` PGIntegral
1461 :: int `In` PGIntegral
1459− => Expression schema from 'Ungrouped params (nullity int)
1462+ => Expression db from 'Ungrouped params (nullity int)
1460 -- ^ what to aggregate
1463 -- ^ what to aggregate
1461− -> Expression schema from ('Grouped bys) params (nullity int)
1464+ -> Expression db from ('Grouped bys) params (nullity int)
1462bitOr = unsafeAggregate "bit_or"
1465bitOr = unsafeAggregate "bit_or"
1463
1466
1464-- | >>> :{
1467-- | >>> :{
1465-- let
1468-- let
1466−-- expression :: Expression schema '[tab ::: '["col" ::: nullity 'PGint4]] (Grouped bys) params (nullity 'PGint4)
1469+-- expression :: Expression db '[tab ::: '["col" ::: nullity 'PGint4]] (Grouped bys) params (nullity 'PGint4)
1467-- expression = bitAndDistinct #col
1470-- expression = bitAndDistinct #col
1468-- in printSQL expression
1471-- in printSQL expression
1469-- :}
1472-- :}
1470-- bit_and(DISTINCT "col")
1473-- bit_and(DISTINCT "col")
1471bitAndDistinct
1474bitAndDistinct
1472 :: int `In` PGIntegral
1475 :: int `In` PGIntegral
1473− => Expression schema from 'Ungrouped params (nullity int)
1476+ => Expression db from 'Ungrouped params (nullity int)
1474 -- ^ what to aggregate
1477 -- ^ what to aggregate
1475− -> Expression schema from ('Grouped bys) params (nullity int)
1478+ -> Expression db from ('Grouped bys) params (nullity int)
1476bitAndDistinct = unsafeAggregateDistinct "bit_and"
1479bitAndDistinct = unsafeAggregateDistinct "bit_and"
1477
1480
1478-- | >>> :{
1481-- | >>> :{
1479-- let
1482-- let
1480−-- expression :: Expression schema '[tab ::: '["col" ::: nullity 'PGint4]] (Grouped bys) params (nullity 'PGint4)
1483+-- expression :: Expression db '[tab ::: '["col" ::: nullity 'PGint4]] (Grouped bys) params (nullity 'PGint4)
1481-- expression = bitOrDistinct #col
1484-- expression = bitOrDistinct #col
1482-- in printSQL expression
1485-- in printSQL expression
1483-- :}
1486-- :}
1484-- bit_or(DISTINCT "col")
1487-- bit_or(DISTINCT "col")
1485bitOrDistinct
1488bitOrDistinct
1486 :: int `In` PGIntegral
1489 :: int `In` PGIntegral
1487− => Expression schema from 'Ungrouped params (nullity int)
1490+ => Expression db from 'Ungrouped params (nullity int)
1488 -- ^ what to aggregate
1491 -- ^ what to aggregate
1489− -> Expression schema from ('Grouped bys) params (nullity int)
1492+ -> Expression db from ('Grouped bys) params (nullity int)
1490bitOrDistinct = unsafeAggregateDistinct "bit_or"
1493bitOrDistinct = unsafeAggregateDistinct "bit_or"
1491
1494
1492-- | >>> :{
1495-- | >>> :{
1493-- let
1496-- let
1494−-- expression :: Expression schema '[tab ::: '["col" ::: nullity 'PGbool]] (Grouped bys) params (nullity 'PGbool)
1497+-- expression :: Expression db '[tab ::: '["col" ::: nullity 'PGbool]] (Grouped bys) params (nullity 'PGbool)
1495-- expression = boolAnd #col
1498-- expression = boolAnd #col
1496-- in printSQL expression
1499-- in printSQL expression
1497-- :}
1500-- :}
1498-- bool_and("col")
1501-- bool_and("col")
1499boolAnd
1502boolAnd
1500− :: Expression schema from 'Ungrouped params (nullity 'PGbool)
1503+ :: Expression db from 'Ungrouped params (nullity 'PGbool)
1501 -- ^ what to aggregate
1504 -- ^ what to aggregate
1502− -> Expression schema from ('Grouped bys) params (nullity 'PGbool)
1505+ -> Expression db from ('Grouped bys) params (nullity 'PGbool)
1503boolAnd = unsafeAggregate "bool_and"
1506boolAnd = unsafeAggregate "bool_and"
1504
1507
1505-- | >>> :{
1508-- | >>> :{
1506-- let
1509-- let
1507−-- expression :: Expression schema '[tab ::: '["col" ::: nullity 'PGbool]] (Grouped bys) params (nullity 'PGbool)
1510+-- expression :: Expression db '[tab ::: '["col" ::: nullity 'PGbool]] (Grouped bys) params (nullity 'PGbool)
1508-- expression = boolOr #col
1511-- expression = boolOr #col
1509-- in printSQL expression
1512-- in printSQL expression
1510-- :}
1513-- :}
1511-- bool_or("col")
1514-- bool_or("col")
1512boolOr
1515boolOr
1513− :: Expression schema from 'Ungrouped params (nullity 'PGbool)
1516+ :: Expression db from 'Ungrouped params (nullity 'PGbool)
1514 -- ^ what to aggregate
1517 -- ^ what to aggregate
1515− -> Expression schema from ('Grouped bys) params (nullity 'PGbool)
1518+ -> Expression db from ('Grouped bys) params (nullity 'PGbool)
1516boolOr = unsafeAggregate "bool_or"
1519boolOr = unsafeAggregate "bool_or"
1517
1520
1518-- | >>> :{
1521-- | >>> :{
1519-- let
1522-- let
1520−-- expression :: Expression schema '[tab ::: '["col" ::: nullity 'PGbool]] (Grouped bys) params (nullity 'PGbool)
1523+-- expression :: Expression db '[tab ::: '["col" ::: nullity 'PGbool]] (Grouped bys) params (nullity 'PGbool)
1521-- expression = boolAndDistinct #col
1524-- expression = boolAndDistinct #col
1522-- in printSQL expression
1525-- in printSQL expression
1523-- :}
1526-- :}
1524-- bool_and(DISTINCT "col")
1527-- bool_and(DISTINCT "col")
1525boolAndDistinct
1528boolAndDistinct
1526− :: Expression schema from 'Ungrouped params (nullity 'PGbool)
1529+ :: Expression db from 'Ungrouped params (nullity 'PGbool)
1527 -- ^ what to aggregate
1530 -- ^ what to aggregate
1528− -> Expression schema from ('Grouped bys) params (nullity 'PGbool)
1531+ -> Expression db from ('Grouped bys) params (nullity 'PGbool)
1529boolAndDistinct = unsafeAggregateDistinct "bool_and"
1532boolAndDistinct = unsafeAggregateDistinct "bool_and"
1530
1533
1531-- | >>> :{
1534-- | >>> :{
1532-- let
1535-- let
1533−-- expression :: Expression schema '[tab ::: '["col" ::: nullity 'PGbool]] (Grouped bys) params (nullity 'PGbool)
1536+-- expression :: Expression db '[tab ::: '["col" ::: nullity 'PGbool]] (Grouped bys) params (nullity 'PGbool)
1534-- expression = boolOrDistinct #col
1537-- expression = boolOrDistinct #col
1535-- in printSQL expression
1538-- in printSQL expression
1536-- :}
1539-- :}
1537-- bool_or(DISTINCT "col")
1540-- bool_or(DISTINCT "col")
1538boolOrDistinct
1541boolOrDistinct
1539− :: Expression schema from 'Ungrouped params (nullity 'PGbool)
1542+ :: Expression db from 'Ungrouped params (nullity 'PGbool)
1540 -- ^ what to aggregate
1543 -- ^ what to aggregate
1541− -> Expression schema from ('Grouped bys) params (nullity 'PGbool)
1544+ -> Expression db from ('Grouped bys) params (nullity 'PGbool)
1542boolOrDistinct = unsafeAggregateDistinct "bool_or"
1545boolOrDistinct = unsafeAggregateDistinct "bool_or"
1543
1546
1544-- | A special aggregation that does not require an input
1547-- | A special aggregation that does not require an input
@@ -1546,70 +1549,70 @@ boolOrDistinct = unsafeAggregateDistinct "bool_or"
1546-- >>> printSQL countStar
1549-- >>> printSQL countStar
1547-- count(*)
1550-- count(*)
1548countStar
1551countStar
1549− :: Expression schema from ('Grouped bys) params ('NotNull 'PGint8)
1552+ :: Expression db from ('Grouped bys) params ('NotNull 'PGint8)
1550countStar = UnsafeExpression $ "count(*)"
1553countStar = UnsafeExpression $ "count(*)"
1551
1554
1552-- | >>> :{
1555-- | >>> :{
1553-- let
1556-- let
1554−-- expression :: Expression schema '[tab ::: '["col" ::: nullity ty]] (Grouped bys) params ('NotNull 'PGint8)
1557+-- expression :: Expression db '[tab ::: '["col" ::: nullity ty]] (Grouped bys) params ('NotNull 'PGint8)
1555-- expression = count #col
1558-- expression = count #col
1556-- in printSQL expression
1559-- in printSQL expression
1557-- :}
1560-- :}
1558-- count("col")
1561-- count("col")
1559count
1562count
1560− :: Expression schema from 'Ungrouped params ty
1563+ :: Expression db from 'Ungrouped params ty
1561 -- ^ what to count
1564 -- ^ what to count
1562− -> Expression schema from ('Grouped bys) params ('NotNull 'PGint8)
1565+ -> Expression db from ('Grouped bys) params ('NotNull 'PGint8)
1563count = unsafeAggregate "count"
1566count = unsafeAggregate "count"
1564
1567
1565-- | >>> :{
1568-- | >>> :{
1566-- let
1569-- let
1567−-- expression :: Expression schema '[tab ::: '["col" ::: nullity ty]] (Grouped bys) params ('NotNull 'PGint8)
1570+-- expression :: Expression db '[tab ::: '["col" ::: nullity ty]] (Grouped bys) params ('NotNull 'PGint8)
1568-- expression = countDistinct #col
1571-- expression = countDistinct #col
1569-- in printSQL expression
1572-- in printSQL expression
1570-- :}
1573-- :}
1571-- count(DISTINCT "col")
1574-- count(DISTINCT "col")
1572countDistinct
1575countDistinct
1573− :: Expression schema from 'Ungrouped params ty
1576+ :: Expression db from 'Ungrouped params ty
1574 -- ^ what to count
1577 -- ^ what to count
1575− -> Expression schema from ('Grouped bys) params ('NotNull 'PGint8)
1578+ -> Expression db from ('Grouped bys) params ('NotNull 'PGint8)
1576countDistinct = unsafeAggregateDistinct "count"
1579countDistinct = unsafeAggregateDistinct "count"
1577
1580
1578-- | synonym for `boolAnd`
1581-- | synonym for `boolAnd`
1579--
1582--
1580-- >>> :{
1583-- >>> :{
1581-- let
1584-- let
1582−-- expression :: Expression schema '[tab ::: '["col" ::: nullity 'PGbool]] (Grouped bys) params (nullity 'PGbool)
1585+-- expression :: Expression db '[tab ::: '["col" ::: nullity 'PGbool]] (Grouped bys) params (nullity 'PGbool)
1583-- expression = every #col
1586-- expression = every #col
1584-- in printSQL expression
1587-- in printSQL expression
1585-- :}
1588-- :}
1586-- every("col")
1589-- every("col")
1587every
1590every
1588− :: Expression schema from 'Ungrouped params (nullity 'PGbool)
1591+ :: Expression db from 'Ungrouped params (nullity 'PGbool)
1589 -- ^ what to aggregate
1592 -- ^ what to aggregate
1590− -> Expression schema from ('Grouped bys) params (nullity 'PGbool)
1593+ -> Expression db from ('Grouped bys) params (nullity 'PGbool)
1591every = unsafeAggregate "every"
1594every = unsafeAggregate "every"
1592
1595
1593-- | synonym for `boolAndDistinct`
1596-- | synonym for `boolAndDistinct`
1594--
1597--
1595-- >>> :{
1598-- >>> :{
1596-- let
1599-- let
1597−-- expression :: Expression schema '[tab ::: '["col" ::: nullity 'PGbool]] (Grouped bys) params (nullity 'PGbool)
1600+-- expression :: Expression db '[tab ::: '["col" ::: nullity 'PGbool]] (Grouped bys) params (nullity 'PGbool)
1598-- expression = everyDistinct #col
1601-- expression = everyDistinct #col
1599-- in printSQL expression
1602-- in printSQL expression
1600-- :}
1603-- :}
1601-- every(DISTINCT "col")
1604-- every(DISTINCT "col")
1602everyDistinct
1605everyDistinct
1603− :: Expression schema from 'Ungrouped params (nullity 'PGbool)
1606+ :: Expression db from 'Ungrouped params (nullity 'PGbool)
1604 -- ^ what to aggregate
1607 -- ^ what to aggregate
1605− -> Expression schema from ('Grouped bys) params (nullity 'PGbool)
1608+ -> Expression db from ('Grouped bys) params (nullity 'PGbool)
1606everyDistinct = unsafeAggregateDistinct "every"
1609everyDistinct = unsafeAggregateDistinct "every"
1607
1610
1608-- | minimum and maximum aggregation
1611-- | minimum and maximum aggregation
1609max_, min_, maxDistinct, minDistinct
1612max_, min_, maxDistinct, minDistinct
1610− :: Expression schema from 'Ungrouped params (nullity ty)
1613+ :: Expression db from 'Ungrouped params (nullity ty)
1611 -- ^ what to aggregate
1614 -- ^ what to aggregate
1612− -> Expression schema from ('Grouped bys) params (nullity ty)
1615+ -> Expression db from ('Grouped bys) params (nullity ty)
1613max_ = unsafeAggregate "max"
1616max_ = unsafeAggregate "max"
1614min_ = unsafeAggregate "min"
1617min_ = unsafeAggregate "min"
1615maxDistinct = unsafeAggregateDistinct "max"
1618maxDistinct = unsafeAggregateDistinct "max"
@@ -1620,153 +1623,153 @@ type expressions
1620-----------------------------------------}
1623-----------------------------------------}
1621
1624
1622-- | `TypeExpression`s are used in `cast`s and `createTable` commands.
1625-- | `TypeExpression`s are used in `cast`s and `createTable` commands.
1623−newtype TypeExpression (schema :: SchemaType) (ty :: NullityType)
1626+newtype TypeExpression (schemas :: SchemasType) (ty :: NullityType)
1624 = UnsafeTypeExpression { renderTypeExpression :: ByteString }
1627 = UnsafeTypeExpression { renderTypeExpression :: ByteString }
1625 deriving (GHC.Generic,Show,Eq,Ord,NFData)
1628 deriving (GHC.Generic,Show,Eq,Ord,NFData)
1626
1629
1627-- | The enum or composite type in a `Typedef` can be expressed by its alias.
1630-- | The enum or composite type in a `Typedef` can be expressed by its alias.
1628typedef
1631typedef
1629− :: Has alias schema ('Typedef ty)
1632+ :: (Has sch schemas schema, Has td schema ('Typedef ty))
1630− => Alias alias
1633+ => QualifiedAlias sch td
1631− -> TypeExpression schema (nullity ty)
1634+ -> TypeExpression schemas (nullity ty)
1632−typedef = UnsafeTypeExpression . renderAlias
1635+typedef = UnsafeTypeExpression . renderQualifiedAlias
1633
1636
1634-- | The composite type corresponding to a `Table` definition can be expressed
1637-- | The composite type corresponding to a `Table` definition can be expressed
1635-- by its alias.
1638-- by its alias.
1636typetable
1639typetable
1637− :: Has alias schema ('Table tab)
1640+ :: (Has sch schemas schema, Has tab schema ('Table table))
1638− => Alias alias
1641+ => QualifiedAlias sch tab
1639− -> TypeExpression schema (nullity ('PGcomposite (TableToRow tab)))
1642+ -> TypeExpression schemas (nullity ('PGcomposite (TableToRow table)))
1640−typetable = UnsafeTypeExpression . renderAlias
1643+typetable = UnsafeTypeExpression . renderQualifiedAlias
1641
1644
1642-- | The composite type corresponding to a `View` definition can be expressed
1645-- | The composite type corresponding to a `View` definition can be expressed
1643-- by its alias.
1646-- by its alias.
1644typeview
1647typeview
1645− :: Has alias schema ('View view)
1648+ :: (Has sch schemas schema, Has vw schema ('View view))
1646− => Alias alias
1649+ => QualifiedAlias sch vw
1647− -> TypeExpression schema (nullity ('PGcomposite view))
1650+ -> TypeExpression schemas (nullity ('PGcomposite view))
1648−typeview = UnsafeTypeExpression . renderAlias
1651+typeview = UnsafeTypeExpression . renderQualifiedAlias
1649
1652
1650-- | logical Boolean (true/false)
1653-- | logical Boolean (true/false)
1651−bool :: TypeExpression schema (nullity 'PGbool)
1654+bool :: TypeExpression schemas (nullity 'PGbool)
1652bool = UnsafeTypeExpression "bool"
1655bool = UnsafeTypeExpression "bool"
1653-- | signed two-byte integer
1656-- | signed two-byte integer
1654−int2, smallint :: TypeExpression schema (nullity 'PGint2)
1657+int2, smallint :: TypeExpression schemas (nullity 'PGint2)
1655int2 = UnsafeTypeExpression "int2"
1658int2 = UnsafeTypeExpression "int2"
1656smallint = UnsafeTypeExpression "smallint"
1659smallint = UnsafeTypeExpression "smallint"
1657-- | signed four-byte integer
1660-- | signed four-byte integer
1658−int4, int, integer :: TypeExpression schema (nullity 'PGint4)
1661+int4, int, integer :: TypeExpression schemas (nullity 'PGint4)
1659int4 = UnsafeTypeExpression "int4"
1662int4 = UnsafeTypeExpression "int4"
1660int = UnsafeTypeExpression "int"
1663int = UnsafeTypeExpression "int"
1661integer = UnsafeTypeExpression "integer"
1664integer = UnsafeTypeExpression "integer"
1662-- | signed eight-byte integer
1665-- | signed eight-byte integer
1663−int8, bigint :: TypeExpression schema (nullity 'PGint8)
1666+int8, bigint :: TypeExpression schemas (nullity 'PGint8)
1664int8 = UnsafeTypeExpression "int8"
1667int8 = UnsafeTypeExpression "int8"
1665bigint = UnsafeTypeExpression "bigint"
1668bigint = UnsafeTypeExpression "bigint"
1666-- | arbitrary precision numeric type
1669-- | arbitrary precision numeric type
1667−numeric :: TypeExpression schema (nullity 'PGnumeric)
1670+numeric :: TypeExpression schemas (nullity 'PGnumeric)
1668numeric = UnsafeTypeExpression "numeric"
1671numeric = UnsafeTypeExpression "numeric"
1669-- | single precision floating-point number (4 bytes)
1672-- | single precision floating-point number (4 bytes)
1670−float4, real :: TypeExpression schema (nullity 'PGfloat4)
1673+float4, real :: TypeExpression schemas (nullity 'PGfloat4)
1671float4 = UnsafeTypeExpression "float4"
1674float4 = UnsafeTypeExpression "float4"
1672real = UnsafeTypeExpression "real"
1675real = UnsafeTypeExpression "real"
1673-- | double precision floating-point number (8 bytes)
1676-- | double precision floating-point number (8 bytes)
1674−float8, doublePrecision :: TypeExpression schema (nullity 'PGfloat8)
1677+float8, doublePrecision :: TypeExpression schemas (nullity 'PGfloat8)
1675float8 = UnsafeTypeExpression "float8"
1678float8 = UnsafeTypeExpression "float8"
1676doublePrecision = UnsafeTypeExpression "double precision"
1679doublePrecision = UnsafeTypeExpression "double precision"
1677-- | variable-length character string
1680-- | variable-length character string
1678−text :: TypeExpression schema (nullity 'PGtext)
1681+text :: TypeExpression schemas (nullity 'PGtext)
1679text = UnsafeTypeExpression "text"
1682text = UnsafeTypeExpression "text"
1680-- | fixed-length character string
1683-- | fixed-length character string
1681char, character
1684char, character
1682− :: forall n schema nullity. (KnownNat n, 1 <= n)
1685+ :: forall n schemas nullity. (KnownNat n, 1 <= n)
1683− => TypeExpression schema (nullity ('PGchar n))
1686+ => TypeExpression schemas (nullity ('PGchar n))
1684char = UnsafeTypeExpression $ "char(" <> renderNat @n <> ")"
1687char = UnsafeTypeExpression $ "char(" <> renderNat @n <> ")"
1685character = UnsafeTypeExpression $ "character(" <> renderNat @n <> ")"
1688character = UnsafeTypeExpression $ "character(" <> renderNat @n <> ")"
1686-- | variable-length character string
1689-- | variable-length character string
1687varchar, characterVarying
1690varchar, characterVarying
1688− :: forall n schema nullity. (KnownNat n, 1 <= n)
1691+ :: forall n schemas nullity. (KnownNat n, 1 <= n)
1689− => TypeExpression schema (nullity ('PGvarchar n))
1692+ => TypeExpression schemas (nullity ('PGvarchar n))
1690varchar = UnsafeTypeExpression $ "varchar(" <> renderNat @n <> ")"
1693varchar = UnsafeTypeExpression $ "varchar(" <> renderNat @n <> ")"
1691characterVarying = UnsafeTypeExpression $
1694characterVarying = UnsafeTypeExpression $
1692 "character varying(" <> renderNat @n <> ")"
1695 "character varying(" <> renderNat @n <> ")"
1693-- | binary data ("byte array")
1696-- | binary data ("byte array")
1694−bytea :: TypeExpression schema (nullity 'PGbytea)
1697+bytea :: TypeExpression schemas (nullity 'PGbytea)
1695bytea = UnsafeTypeExpression "bytea"
1698bytea = UnsafeTypeExpression "bytea"
1696-- | date and time (no time zone)
1699-- | date and time (no time zone)
1697−timestamp :: TypeExpression schema (nullity 'PGtimestamp)
1700+timestamp :: TypeExpression schemas (nullity 'PGtimestamp)
1698timestamp = UnsafeTypeExpression "timestamp"
1701timestamp = UnsafeTypeExpression "timestamp"
1699-- | date and time, including time zone
1702-- | date and time, including time zone
1700−timestampWithTimeZone :: TypeExpression schema (nullity 'PGtimestamptz)
1703+timestampWithTimeZone :: TypeExpression schemas (nullity 'PGtimestamptz)
1701timestampWithTimeZone = UnsafeTypeExpression "timestamp with time zone"
1704timestampWithTimeZone = UnsafeTypeExpression "timestamp with time zone"
1702-- | calendar date (year, month, day)
1705-- | calendar date (year, month, day)
1703−date :: TypeExpression schema (nullity 'PGdate)
1706+date :: TypeExpression schemas (nullity 'PGdate)
1704date = UnsafeTypeExpression "date"
1707date = UnsafeTypeExpression "date"
1705-- | time of day (no time zone)
1708-- | time of day (no time zone)
1706−time :: TypeExpression schema (nullity 'PGtime)
1709+time :: TypeExpression schemas (nullity 'PGtime)
1707time = UnsafeTypeExpression "time"
1710time = UnsafeTypeExpression "time"
1708-- | time of day, including time zone
1711-- | time of day, including time zone
1709−timeWithTimeZone :: TypeExpression schema (nullity 'PGtimetz)
1712+timeWithTimeZone :: TypeExpression schemas (nullity 'PGtimetz)
1710timeWithTimeZone = UnsafeTypeExpression "time with time zone"
1713timeWithTimeZone = UnsafeTypeExpression "time with time zone"
1711-- | time span
1714-- | time span
1712−interval :: TypeExpression schema (nullity 'PGinterval)
1715+interval :: TypeExpression schemas (nullity 'PGinterval)
1713interval = UnsafeTypeExpression "interval"
1716interval = UnsafeTypeExpression "interval"
1714-- | universally unique identifier
1717-- | universally unique identifier
1715−uuid :: TypeExpression schema (nullity 'PGuuid)
1718+uuid :: TypeExpression schemas (nullity 'PGuuid)
1716uuid = UnsafeTypeExpression "uuid"
1719uuid = UnsafeTypeExpression "uuid"
1717-- | IPv4 or IPv6 host address
1720-- | IPv4 or IPv6 host address
1718−inet :: TypeExpression schema (nullity 'PGinet)
1721+inet :: TypeExpression schemas (nullity 'PGinet)
1719inet = UnsafeTypeExpression "inet"
1722inet = UnsafeTypeExpression "inet"
1720-- | textual JSON data
1723-- | textual JSON data
1721−json :: TypeExpression schema (nullity 'PGjson)
1724+json :: TypeExpression schemas (nullity 'PGjson)
1722json = UnsafeTypeExpression "json"
1725json = UnsafeTypeExpression "json"
1723-- | binary JSON data, decomposed
1726-- | binary JSON data, decomposed
1724−jsonb :: TypeExpression schema (nullity 'PGjsonb)
1727+jsonb :: TypeExpression schemas (nullity 'PGjsonb)
1725jsonb = UnsafeTypeExpression "jsonb"
1728jsonb = UnsafeTypeExpression "jsonb"
1726-- | variable length array
1729-- | variable length array
1727vararray
1730vararray
1728− :: TypeExpression schema pg
1731+ :: TypeExpression schemas pg
1729− -> TypeExpression schema (nullity ('PGvararray pg))
1732+ -> TypeExpression schemas (nullity ('PGvararray pg))
1730vararray ty = UnsafeTypeExpression $ renderTypeExpression ty <> "[]"
1733vararray ty = UnsafeTypeExpression $ renderTypeExpression ty <> "[]"
1731-- | fixed length array
1734-- | fixed length array
1732--
1735--
1733-- >>> renderTypeExpression (fixarray @2 json)
1736-- >>> renderTypeExpression (fixarray @2 json)
1734-- "json[2]"
1737-- "json[2]"
1735fixarray
1738fixarray
1736− :: forall n schema nullity pg. KnownNat n
1739+ :: forall n schemas nullity pg. KnownNat n
1737− => TypeExpression schema pg
1740+ => TypeExpression schemas pg
1738− -> TypeExpression schema (nullity ('PGfixarray n pg))
1741+ -> TypeExpression schemas (nullity ('PGfixarray n pg))
1739fixarray ty = UnsafeTypeExpression $
1742fixarray ty = UnsafeTypeExpression $
1740 renderTypeExpression ty <> "[" <> renderNat @n <> "]"
1743 renderTypeExpression ty <> "[" <> renderNat @n <> "]"
1741
1744
1742-- | `pgtype` is a demoted version of a `PGType`
1745-- | `pgtype` is a demoted version of a `PGType`
1743−class PGTyped schema (ty :: NullityType) where
1746+class PGTyped schemas (ty :: NullityType) where
1744− pgtype :: TypeExpression schema ty
1747+ pgtype :: TypeExpression schemas ty
1745−instance PGTyped schema (nullity 'PGbool) where pgtype = bool
1748+instance PGTyped schemas (nullity 'PGbool) where pgtype = bool
1746−instance PGTyped schema (nullity 'PGint2) where pgtype = int2
1749+instance PGTyped schemas (nullity 'PGint2) where pgtype = int2
1747−instance PGTyped schema (nullity 'PGint4) where pgtype = int4
1750+instance PGTyped schemas (nullity 'PGint4) where pgtype = int4
1748−instance PGTyped schema (nullity 'PGint8) where pgtype = int8
1751+instance PGTyped schemas (nullity 'PGint8) where pgtype = int8
1749−instance PGTyped schema (nullity 'PGnumeric) where pgtype = numeric
1752+instance PGTyped schemas (nullity 'PGnumeric) where pgtype = numeric
1750−instance PGTyped schema (nullity 'PGfloat4) where pgtype = float4
1753+instance PGTyped schemas (nullity 'PGfloat4) where pgtype = float4
1751−instance PGTyped schema (nullity 'PGfloat8) where pgtype = float8
1754+instance PGTyped schemas (nullity 'PGfloat8) where pgtype = float8
1752−instance PGTyped schema (nullity 'PGtext) where pgtype = text
1755+instance PGTyped schemas (nullity 'PGtext) where pgtype = text
1753instance (KnownNat n, 1 <= n)
1756instance (KnownNat n, 1 <= n)
1754− => PGTyped schema (nullity ('PGchar n)) where pgtype = char @n
1757+ => PGTyped schemas (nullity ('PGchar n)) where pgtype = char @n
1755instance (KnownNat n, 1 <= n)
1758instance (KnownNat n, 1 <= n)
1756− => PGTyped schema (nullity ('PGvarchar n)) where pgtype = varchar @n
1759+ => PGTyped schemas (nullity ('PGvarchar n)) where pgtype = varchar @n
1757−instance PGTyped schema (nullity 'PGbytea) where pgtype = bytea
1760+instance PGTyped schemas (nullity 'PGbytea) where pgtype = bytea
1758−instance PGTyped schema (nullity 'PGtimestamp) where pgtype = timestamp
1761+instance PGTyped schemas (nullity 'PGtimestamp) where pgtype = timestamp
1759−instance PGTyped schema (nullity 'PGtimestamptz) where pgtype = timestampWithTimeZone
1762+instance PGTyped schemas (nullity 'PGtimestamptz) where pgtype = timestampWithTimeZone
1760−instance PGTyped schema (nullity 'PGdate) where pgtype = date
1763+instance PGTyped schemas (nullity 'PGdate) where pgtype = date
1761−instance PGTyped schema (nullity 'PGtime) where pgtype = time
1764+instance PGTyped schemas (nullity 'PGtime) where pgtype = time
1762−instance PGTyped schema (nullity 'PGtimetz) where pgtype = timeWithTimeZone
1765+instance PGTyped schemas (nullity 'PGtimetz) where pgtype = timeWithTimeZone
1763−instance PGTyped schema (nullity 'PGinterval) where pgtype = interval
1766+instance PGTyped schemas (nullity 'PGinterval) where pgtype = interval
1764−instance PGTyped schema (nullity 'PGuuid) where pgtype = uuid
1767+instance PGTyped schemas (nullity 'PGuuid) where pgtype = uuid
1765−instance PGTyped schema (nullity 'PGjson) where pgtype = json
1768+instance PGTyped schemas (nullity 'PGjson) where pgtype = json
1766−instance PGTyped schema (nullity 'PGjsonb) where pgtype = jsonb
1769+instance PGTyped schemas (nullity 'PGjsonb) where pgtype = jsonb
1767−instance PGTyped schema ty
1770+instance PGTyped schemas ty
1768− => PGTyped schema (nullity ('PGvararray ty)) where
1771+ => PGTyped schemas (nullity ('PGvararray ty)) where
1769− pgtype = vararray (pgtype @schema @ty)
1772+ pgtype = vararray (pgtype @schemas @ty)
1770−instance (KnownNat n, PGTyped schema ty)
1773+instance (KnownNat n, PGTyped schemas ty)
1771− => PGTyped schema (nullity ('PGfixarray n ty)) where
1774+ => PGTyped schemas (nullity ('PGfixarray n ty)) where
1772− pgtype = fixarray @n (pgtype @schema @ty)
1775+ pgtype = fixarray @n (pgtype @schemas @ty)
squeal-postgresql/src/Squeal/PostgreSQL/Manipulation.hs+137−155
@@ -59,17 +59,16 @@ import Squeal.PostgreSQL.Schema
59
59
60{- |
60{- |
61A `Manipulation` is a statement which may modify data in the database,
61A `Manipulation` is a statement which may modify data in the database,
62−but does not alter the schema. Examples are inserts, updates and deletes.
62+but does not alter its schemas. Examples are inserts, updates and deletes.
63A `Query` is also considered a `Manipulation` even though it does not modify data.
63A `Query` is also considered a `Manipulation` even though it does not modify data.
64
64
65simple insert:
65simple insert:
66
66
67+>>> type Columns = '["col1" ::: 'NoDef :=> 'Null 'PGint4, "col2" ::: 'Def :=> 'NotNull 'PGint4]
68+>>> type Schema = '["tab" ::: 'Table ('[] :=> Columns)]
67>>> :{
69>>> :{
68let
70let
69− manipulation :: Manipulation
71+ manipulation :: Manipulation (DBof (Public Schema)) '[] '[]
70− '[ "tab" ::: 'Table ('[] :=>
71− '[ "col1" ::: 'NoDef :=> 'NotNull 'PGint4
72− , "col2" ::: 'Def :=> 'NotNull 'PGint4 ])] '[] '[]
73 manipulation =
72 manipulation =
74 insertRow_ #tab (Set 2 `as` #col1 :* Default `as` #col2)
73 insertRow_ #tab (Set 2 `as` #col1 :* Default `as` #col2)
75in printSQL manipulation
74in printSQL manipulation
@@ -78,13 +77,11 @@ INSERT INTO "tab" ("col1", "col2") VALUES (2, DEFAULT)
78
77
79parameterized insert:
78parameterized insert:
80
79
80+>>> type Columns = '["col1" ::: 'NoDef :=> 'NotNull 'PGint4, "col2" ::: 'NoDef :=> 'NotNull 'PGint4]
81+>>> type Schema = '["tab" ::: 'Table ('[] :=> Columns)]
81>>> :{
82>>> :{
82let
83let
83− manipulation :: Manipulation
84− '[ "tab" ::: 'Table ('[] :=>
85− '[ "col1" ::: 'NoDef :=> 'NotNull 'PGint4
86− , "col2" ::: 'NoDef :=> 'NotNull 'PGint4 ])]
87− '[ 'NotNull 'PGint4, 'NotNull 'PGint4 ] '[]
84+ manipulation :: Manipulation (DBof (Public Schema)) '[ 'NotNull 'PGint4, 'NotNull 'PGint4 ] '[]
88 manipulation =
85 manipulation =
89 insertRow_ #tab
86 insertRow_ #tab
90 (Set (param @1) `as` #col1 :* Set (param @2) `as` #col2)
87 (Set (param @1) `as` #col1 :* Set (param @2) `as` #col2)
@@ -96,27 +93,21 @@ returning insert:
96
93
97>>> :{
94>>> :{
98let
95let
99− manipulation :: Manipulation
96+ manipulation :: Manipulation (DBof (Public Schema)) '[] '["fromOnly" ::: 'NotNull 'PGint4]
100− '[ "tab" ::: 'Table ('[] :=>
101− '[ "col1" ::: 'NoDef :=> 'NotNull 'PGint4
102− , "col2" ::: 'Def :=> 'NotNull 'PGint4 ])] '[]
103− '["fromOnly" ::: 'NotNull 'PGint4]
104 manipulation =
97 manipulation =
105− insertRow #tab (Set 2 `as` #col1 :* Default `as` #col2)
98+ insertRow #tab (Set 2 `as` #col1 :* Set 3 `as` #col2)
106 OnConflictDoRaise (Returning (#col1 `as` #fromOnly))
99 OnConflictDoRaise (Returning (#col1 `as` #fromOnly))
107in printSQL manipulation
100in printSQL manipulation
108:}
101:}
109−INSERT INTO "tab" ("col1", "col2") VALUES (2, DEFAULT) RETURNING "col1" AS "fromOnly"
102+INSERT INTO "tab" ("col1", "col2") VALUES (2, 3) RETURNING "col1" AS "fromOnly"
110
103
111upsert:
104upsert:
112
105
106+>>> type Columns = '["col1" ::: 'NoDef :=> 'NotNull 'PGint4, "col2" ::: 'NoDef :=> 'NotNull 'PGint4]
107+>>> type Schema = '["tab" ::: 'Table ('[] :=> Columns)]
113>>> :{
108>>> :{
114let
109let
115− manipulation :: Manipulation
110+ manipulation :: Manipulation (DBof (Public Schema)) '[] '[ "sum" ::: 'NotNull 'PGint4]
116− '[ "tab" ::: 'Table ('[] :=>
117− '[ "col1" ::: 'NoDef :=> 'NotNull 'PGint4
118− , "col2" ::: 'NoDef :=> 'NotNull 'PGint4 ])]
119− '[] '[ "sum" ::: 'NotNull 'PGint4]
120 manipulation =
111 manipulation =
121 insertRows #tab
112 insertRows #tab
122 (Set 2 `as` #col1 :* Set 4 `as` #col2)
113 (Set 2 `as` #col1 :* Set 4 `as` #col2)
@@ -133,31 +124,17 @@ query insert:
133
124
134>>> :{
125>>> :{
135let
126let
136− manipulation :: Manipulation
127+ manipulation :: Manipulation (DBof (Public Schema)) '[] '[]
137− '[ "tab" ::: 'Table ('[] :=>
138− '[ "col1" ::: 'NoDef :=> 'NotNull 'PGint4
139− , "col2" ::: 'NoDef :=> 'NotNull 'PGint4
140− ])
141− , "other_tab" ::: 'Table ('[] :=>
142− '[ "col1" ::: 'NoDef :=> 'NotNull 'PGint4
143− , "col2" ::: 'NoDef :=> 'NotNull 'PGint4
144− ])
145− ] '[] '[]
146− manipulation =
147− insertQuery_ #tab
148− (selectStar (from (table (#other_tab `as` #t))))
128+ manipulation = insertQuery_ #tab (selectStar (from (table #tab)))
149in printSQL manipulation
129in printSQL manipulation
150:}
130:}
151−INSERT INTO "tab" SELECT * FROM "other_tab" AS "t"
131+INSERT INTO "tab" SELECT * FROM "tab" AS "tab"
152
132
153update:
133update:
154
134
155>>> :{
135>>> :{
156let
136let
157− manipulation :: Manipulation
137+ manipulation :: Manipulation (DBof (Public Schema)) '[] '[]
158− '[ "tab" ::: 'Table ('[] :=>
159− '[ "col1" ::: 'NoDef :=> 'NotNull 'PGint4
160− , "col2" ::: 'NoDef :=> 'NotNull 'PGint4 ])] '[] '[]
161 manipulation =
138 manipulation =
162 update_ #tab (Set 2 `as` #col1 :* Same `as` #col2)
139 update_ #tab (Set 2 `as` #col1 :* Same `as` #col2)
163 (#col1 ./= #col2)
140 (#col1 ./= #col2)
@@ -169,10 +146,7 @@ delete:
169
146
170>>> :{
147>>> :{
171let
148let
172− manipulation :: Manipulation
149+ manipulation :: Manipulation (DBof (Public Schema)) '[]
173− '[ "tab" ::: 'Table ('[] :=>
174− '[ "col1" ::: 'NoDef :=> 'NotNull 'PGint4
175− , "col2" ::: 'NoDef :=> 'NotNull 'PGint4 ])] '[]
176 '[ "col1" ::: 'NotNull 'PGint4
150 '[ "col1" ::: 'NotNull 'PGint4
177 , "col2" ::: 'NotNull 'PGint4 ]
151 , "col2" ::: 'NotNull 'PGint4 ]
178 manipulation = deleteFrom #tab NoUsing (#col1 .== #col2) ReturningStar
152 manipulation = deleteFrom #tab NoUsing (#col1 .== #col2) ReturningStar
@@ -182,56 +156,46 @@ DELETE FROM "tab" WHERE ("col1" = "col2") RETURNING *
182
156
183delete and using clause:
157delete and using clause:
184
158
159+>>> :{
160+type Schema3 =
161+ '[ "tab" ::: 'Table ('[] :=> Columns)
162+ , "other_tab" ::: 'Table ('[] :=> Columns)
163+ , "third_tab" ::: 'Table ('[] :=> Columns) ]
164+:}
165+
185>>> :{
166>>> :{
186let
167let
187− manipulation :: Manipulation
168+ manipulation :: Manipulation (DBof (Public Schema3)) '[] '[]
188− '[ "tab" ::: 'Table ('[] :=>
189− '[ "col1" ::: 'NoDef :=> 'NotNull 'PGint4
190− , "col2" ::: 'NoDef :=> 'NotNull 'PGint4
191− ])
192− , "other_tab" ::: 'Table ('[] :=>
193− '[ "col1" ::: 'NoDef :=> 'NotNull 'PGint4
194− , "col2" ::: 'NoDef :=> 'NotNull 'PGint4
195− ])
196− , "third_tab" ::: 'Table ('[] :=>
197− '[ "col1" ::: 'NoDef :=> 'NotNull 'PGint4
198− , "col2" ::: 'NoDef :=> 'NotNull 'PGint4
199− ])
200− ] '[] '[]
201 manipulation =
169 manipulation =
202− deleteFrom #tab (Using (table #other_tab & also (table #third_tab)))
170+ deleteFrom_ #tab (Using (table #other_tab & also (table #third_tab)))
203 ( (#tab ! #col2 .== #other_tab ! #col2)
171 ( (#tab ! #col2 .== #other_tab ! #col2)
204 .&& (#tab ! #col2 .== #third_tab ! #col2) )
172 .&& (#tab ! #col2 .== #third_tab ! #col2) )
205− (Returning Nil)
206in printSQL manipulation
173in printSQL manipulation
207:}
174:}
208DELETE FROM "tab" USING "other_tab" AS "other_tab", "third_tab" AS "third_tab" WHERE (("tab"."col2" = "other_tab"."col2") AND ("tab"."col2" = "third_tab"."col2"))
175DELETE FROM "tab" USING "other_tab" AS "other_tab", "third_tab" AS "third_tab" WHERE (("tab"."col2" = "other_tab"."col2") AND ("tab"."col2" = "third_tab"."col2"))
209
176
210with manipulation:
177with manipulation:
211
178
212−>>> type ProductsTable = '[] :=> '["product" ::: 'NoDef :=> 'NotNull 'PGtext, "date" ::: 'Def :=> 'NotNull 'PGdate]
179+>>> type ProductsColumns = '["product" ::: 'NoDef :=> 'NotNull 'PGtext, "date" ::: 'Def :=> 'NotNull 'PGdate]
213−
180+>>> type ProductsSchema = '["products" ::: 'Table ('[] :=> ProductsColumns), "products_deleted" ::: 'Table ('[] :=> ProductsColumns)]
214>>> :{
181>>> :{
215let
182let
216− manipulation :: Manipulation
183+ manipulation :: Manipulation (DBof (Public ProductsSchema)) '[ 'NotNull 'PGdate] '[]
217− '[ "products" ::: 'Table ProductsTable
218− , "products_deleted" ::: 'Table ProductsTable
219− ] '[ 'NotNull 'PGdate] '[]
220 manipulation = with
184 manipulation = with
221− (deleteFrom #products NoUsing (#date .< param @1) ReturningStar `as` #deleted_rows)
185+ (deleteFrom #products NoUsing (#date .< param @1) ReturningStar `as` #del)
222− (insertQuery_ #products_deleted (selectStar (from (view (#deleted_rows `as` #t)))))
186+ (insertQuery_ #products_deleted (selectStar (from (common (#del)))))
223in printSQL manipulation
187in printSQL manipulation
224:}
188:}
225−WITH "deleted_rows" AS (DELETE FROM "products" WHERE ("date" < ($1 :: date)) RETURNING *) INSERT INTO "products_deleted" SELECT * FROM "deleted_rows" AS "t"
189+WITH "del" AS (DELETE FROM "products" WHERE ("date" < ($1 :: date)) RETURNING *) INSERT INTO "products_deleted" SELECT * FROM "del" AS "del"
226-}
190-}
227
191
228newtype Manipulation
192newtype Manipulation
229− (schema :: SchemaType)
193+ (db :: DBType)
230 (params :: [NullityType])
194 (params :: [NullityType])
231 (columns :: RowType)
195 (columns :: RowType)
232 = UnsafeManipulation { renderManipulation :: ByteString }
196 = UnsafeManipulation { renderManipulation :: ByteString }
233 deriving (GHC.Generic,Show,Eq,Ord,NFData)
197 deriving (GHC.Generic,Show,Eq,Ord,NFData)
234−instance RenderSQL (Manipulation schema params columns) where
198+instance RenderSQL (Manipulation db params columns) where
235 renderSQL = renderManipulation
199 renderSQL = renderManipulation
236instance With Manipulation where
200instance With Manipulation where
237 with Done manip = manip
201 with Done manip = manip
@@ -241,8 +205,8 @@ instance With Manipulation where
241
205
242-- | Convert a `Query` into a `Manipulation`.
206-- | Convert a `Query` into a `Manipulation`.
243queryStatement
207queryStatement
244− :: Query schema params columns
208+ :: Query db params columns
245− -> Manipulation schema params columns
209+ -> Manipulation db params columns
246queryStatement q = UnsafeManipulation $ renderQuery q
210queryStatement q = UnsafeManipulation $ renderQuery q
247
211
248{-----------------------------------------
212{-----------------------------------------
@@ -259,18 +223,20 @@ INSERT statements
259insertRows
223insertRows
260 :: ( SOP.SListI columns
224 :: ( SOP.SListI columns
261 , SOP.SListI results
225 , SOP.SListI results
226+ , db ~ (commons :=> schemas)
227+ , Has sch schemas schema
262 , Has tab schema ('Table table)
228 , Has tab schema ('Table table)
263 , row ~ TableToRow table
229 , row ~ TableToRow table
264 , columns ~ TableToColumns table )
230 , columns ~ TableToColumns table )
265− => Alias tab -- ^ table to insert into
231+ => QualifiedAlias sch tab -- ^ table to insert into
266− -> NP (Aliased (ColumnValue schema '[] params)) columns -- ^ row to insert
232+ -> NP (Aliased (ColumnValue db '[] params)) columns -- ^ row to insert
267− -> [NP (Aliased (ColumnValue schema '[] params)) columns] -- ^ more rows to insert
233+ -> [NP (Aliased (ColumnValue db '[] params)) columns] -- ^ more rows to insert
268− -> ConflictClause schema table params
234+ -> ConflictClause db table params
269 -- ^ what to do in case of constraint conflict
235 -- ^ what to do in case of constraint conflict
270− -> ReturningClause schema params row results -- ^ results to return
236+ -> ReturningClause db params row results -- ^ results to return
271− -> Manipulation schema params results
237+ -> Manipulation db params results
272insertRows tab rw rws conflict returning = UnsafeManipulation $
238insertRows tab rw rws conflict returning = UnsafeManipulation $
273− "INSERT" <+> "INTO" <+> renderAlias tab
239+ "INSERT" <+> "INTO" <+> renderQualifiedAlias tab
274 <+> parenthesized (renderCommaSeparated renderAliasPart rw)
240 <+> parenthesized (renderCommaSeparated renderAliasPart rw)
275 <+> "VALUES"
241 <+> "VALUES"
276 <+> commaSeparated
242 <+> commaSeparated
@@ -280,7 +246,7 @@ insertRows tab rw rws conflict returning = UnsafeManipulation $
280 <> renderReturningClause returning
246 <> renderReturningClause returning
281 where
247 where
282 renderAliasPart, renderColumnValuePart
248 renderAliasPart, renderColumnValuePart
283− :: Aliased (ColumnValue schema '[] params) ty -> ByteString
249+ :: Aliased (ColumnValue db '[] params) ty -> ByteString
284 renderAliasPart (_ `As` name) = renderAlias name
250 renderAliasPart (_ `As` name) = renderAlias name
285 renderColumnValuePart (value `As` _) = case value of
251 renderColumnValuePart (value `As` _) = case value of
286 Default -> "DEFAULT"
252 Default -> "DEFAULT"
@@ -290,54 +256,62 @@ insertRows tab rw rws conflict returning = UnsafeManipulation $
290insertRow
256insertRow
291 :: ( SOP.SListI columns
257 :: ( SOP.SListI columns
292 , SOP.SListI results
258 , SOP.SListI results
259+ , db ~ (commons :=> schemas)
260+ , Has sch schemas schema
293 , Has tab schema ('Table table)
261 , Has tab schema ('Table table)
294 , row ~ TableToRow table
262 , row ~ TableToRow table
295 , columns ~ TableToColumns table )
263 , columns ~ TableToColumns table )
296− => Alias tab -- ^ table to insert into
264+ => QualifiedAlias sch tab -- ^ table to insert into
297− -> NP (Aliased (ColumnValue schema '[] params)) columns -- ^ row to insert
265+ -> NP (Aliased (ColumnValue db '[] params)) columns -- ^ row to insert
298− -> ConflictClause schema table params
266+ -> ConflictClause db table params
299 -- ^ what to do in case of constraint conflict
267 -- ^ what to do in case of constraint conflict
300− -> ReturningClause schema params row results -- ^ results to return
268+ -> ReturningClause db params row results -- ^ results to return
301− -> Manipulation schema params results
269+ -> Manipulation db params results
302insertRow tab rw = insertRows tab rw []
270insertRow tab rw = insertRows tab rw []
303
271
304-- | Insert multiple rows returning `Nil` and raising an error on conflicts.
272-- | Insert multiple rows returning `Nil` and raising an error on conflicts.
305insertRows_
273insertRows_
306 :: ( SOP.SListI columns
274 :: ( SOP.SListI columns
275+ , db ~ (commons :=> schemas)
276+ , Has sch schemas schema
307 , Has tab schema ('Table table)
277 , Has tab schema ('Table table)
308 , columns ~ TableToColumns table )
278 , columns ~ TableToColumns table )
309− => Alias tab -- ^ table to insert into
279+ => QualifiedAlias sch tab -- ^ table to insert into
310− -> NP (Aliased (ColumnValue schema '[] params)) columns -- ^ row to insert
280+ -> NP (Aliased (ColumnValue db '[] params)) columns -- ^ row to insert
311− -> [NP (Aliased (ColumnValue schema '[] params)) columns] -- ^ more rows to insert
281+ -> [NP (Aliased (ColumnValue db '[] params)) columns] -- ^ more rows to insert
312− -> Manipulation schema params '[]
282+ -> Manipulation db params '[]
313insertRows_ tab rw rws =
283insertRows_ tab rw rws =
314 insertRows tab rw rws OnConflictDoRaise (Returning Nil)
284 insertRows tab rw rws OnConflictDoRaise (Returning Nil)
315
285
316-- | Insert a single row returning `Nil` and raising an error on conflicts.
286-- | Insert a single row returning `Nil` and raising an error on conflicts.
317insertRow_
287insertRow_
318 :: ( SOP.SListI columns
288 :: ( SOP.SListI columns
289+ , db ~ (commons :=> schemas)
290+ , Has sch schemas schema
319 , Has tab schema ('Table table)
291 , Has tab schema ('Table table)
320 , columns ~ TableToColumns table )
292 , columns ~ TableToColumns table )
321− => Alias tab -- ^ table to insert into
293+ => QualifiedAlias sch tab -- ^ table to insert into
322− -> NP (Aliased (ColumnValue schema '[] params)) columns -- ^ row to insert
294+ -> NP (Aliased (ColumnValue db '[] params)) columns -- ^ row to insert
323− -> Manipulation schema params '[]
295+ -> Manipulation db params '[]
324insertRow_ tab rw = insertRow tab rw OnConflictDoRaise (Returning Nil)
296insertRow_ tab rw = insertRow tab rw OnConflictDoRaise (Returning Nil)
325
297
326-- | Insert a `Query`.
298-- | Insert a `Query`.
327insertQuery
299insertQuery
328 :: ( SOP.SListI columns
300 :: ( SOP.SListI columns
329 , SOP.SListI results
301 , SOP.SListI results
302+ , db ~ (commons :=> schemas)
303+ , Has sch schemas schema
330 , Has tab schema ('Table table)
304 , Has tab schema ('Table table)
331 , row ~ TableToRow table
305 , row ~ TableToRow table
332 , columns ~ TableToColumns table )
306 , columns ~ TableToColumns table )
333− => Alias tab -- ^ table to insert into
307+ => QualifiedAlias sch tab -- ^ table to insert into
334− -> Query schema params (TableToRow table)
308+ -> Query db params (TableToRow table)
335− -> ConflictClause schema table params
309+ -> ConflictClause db table params
336 -- ^ what to do in case of constraint conflict
310 -- ^ what to do in case of constraint conflict
337− -> ReturningClause schema params row results -- ^ results to return
311+ -> ReturningClause db params row results -- ^ results to return
338− -> Manipulation schema params results
312+ -> Manipulation db params results
339insertQuery tab query conflict returning = UnsafeManipulation $
313insertQuery tab query conflict returning = UnsafeManipulation $
340− "INSERT" <+> "INTO" <+> renderAlias tab
314+ "INSERT" <+> "INTO" <+> renderQualifiedAlias tab
341 <+> renderQuery query
315 <+> renderQuery query
342 <> renderConflictClause conflict
316 <> renderConflictClause conflict
343 <> renderReturningClause returning
317 <> renderReturningClause returning
@@ -345,11 +319,13 @@ insertQuery tab query conflict returning = UnsafeManipulation $
345-- | Insert a `Query` returning `Nil` and raising an error on conflicts.
319-- | Insert a `Query` returning `Nil` and raising an error on conflicts.
346insertQuery_
320insertQuery_
347 :: ( SOP.SListI columns
321 :: ( SOP.SListI columns
322+ , db ~ (commons :=> schemas)
323+ , Has sch schemas schema
348 , Has tab schema ('Table table)
324 , Has tab schema ('Table table)
349 , columns ~ TableToColumns table )
325 , columns ~ TableToColumns table )
350− => Alias tab -- ^ table to insert into
326+ => QualifiedAlias sch tab -- ^ table to insert into
351− -> Query schema params (TableToRow table)
327+ -> Query db params (TableToRow table)
352− -> Manipulation schema params '[]
328+ -> Manipulation db params '[]
353insertQuery_ tab query =
329insertQuery_ tab query =
354 insertQuery tab query OnConflictDoRaise (Returning Nil)
330 insertQuery tab query OnConflictDoRaise (Returning Nil)
355
331
@@ -359,16 +335,16 @@ insertQuery_ tab query =
359-- `Set` sets a value to be an `Expression`, which can refer to
335-- `Set` sets a value to be an `Expression`, which can refer to
360-- existing value in the row for an update.
336-- existing value in the row for an update.
361data ColumnValue
337data ColumnValue
362− (schema :: SchemaType)
338+ (db :: DBType)
363 (columns :: RowType)
339 (columns :: RowType)
364 (params :: [NullityType])
340 (params :: [NullityType])
365 (ty :: ColumnType)
341 (ty :: ColumnType)
366 where
342 where
367− Same :: ColumnValue schema (column ': columns) params ty
343+ Same :: ColumnValue db (column ': columns) params ty
368− Default :: ColumnValue schema columns params ('Def :=> ty)
344+ Default :: ColumnValue db columns params ('Def :=> ty)
369 Set
345 Set
370− :: (forall table. Expression schema '[table ::: columns] 'Ungrouped params ty)
346+ :: (forall table. Expression db '[table ::: columns] 'Ungrouped params ty)
371− -> ColumnValue schema columns params (constraint :=> ty)
347+ -> ColumnValue db columns params (constraint :=> ty)
372
348
373-- | A `ReturningClause` computes and return value(s) based
349-- | A `ReturningClause` computes and return value(s) based
374-- on each row actually inserted, updated or deleted. This is primarily
350-- on each row actually inserted, updated or deleted. This is primarily
@@ -381,21 +357,21 @@ data ColumnValue
381-- in the row. Use @Returning Nil@ in the common case where no return
357-- in the row. Use @Returning Nil@ in the common case where no return
382-- values are desired.
358-- values are desired.
383data ReturningClause
359data ReturningClause
384− (schema :: SchemaType)
360+ (db :: DBType)
385 (params :: [NullityType])
361 (params :: [NullityType])
386 (row0 :: RowType)
362 (row0 :: RowType)
387 (row1 :: RowType)
363 (row1 :: RowType)
388 where
364 where
389 ReturningStar
365 ReturningStar
390− :: ReturningClause schema params row row
366+ :: ReturningClause db params row row
391 Returning
367 Returning
392− :: NP (Aliased (Expression schema '[table ::: row0] 'Ungrouped params)) row1
368+ :: NP (Aliased (Expression db '[table ::: row0] 'Ungrouped params)) row1
393− -> ReturningClause schema params row0 row1
369+ -> ReturningClause db params row0 row1
394
370
395-- | Render a `ReturningClause`.
371-- | Render a `ReturningClause`.
396renderReturningClause
372renderReturningClause
397 :: SOP.SListI results
373 :: SOP.SListI results
398− => ReturningClause schema params columns results
374+ => ReturningClause db params columns results
399 -> ByteString
375 -> ByteString
400renderReturningClause = \case
376renderReturningClause = \case
401 ReturningStar -> " RETURNING *"
377 ReturningStar -> " RETURNING *"
@@ -409,21 +385,21 @@ renderReturningClause = \case
409-- `OnConflictDoUpdate` updates the existing row that conflicts with the row
385-- `OnConflictDoUpdate` updates the existing row that conflicts with the row
410-- proposed for insertion.
386-- proposed for insertion.
411data ConflictClause
387data ConflictClause
412− (schema :: SchemaType)
388+ (db :: DBType)
413 (table :: TableType)
389 (table :: TableType)
414 (params :: [NullityType]) where
390 (params :: [NullityType]) where
415− OnConflictDoRaise :: ConflictClause schema table params
391+ OnConflictDoRaise :: ConflictClause db table params
416− OnConflictDoNothing :: ConflictClause schema table params
392+ OnConflictDoNothing :: ConflictClause db table params
417 OnConflictDoUpdate
393 OnConflictDoUpdate
418 :: (row ~ TableToRow table, columns ~ TableToColumns table)
394 :: (row ~ TableToRow table, columns ~ TableToColumns table)
419− => NP (Aliased (ColumnValue schema row params)) columns
395+ => NP (Aliased (ColumnValue db row params)) columns
420− -> [Condition schema '[t ::: row] 'Ungrouped params]
396+ -> [Condition db '[t ::: row] 'Ungrouped params]
421− -> ConflictClause schema table params
397+ -> ConflictClause db table params
422
398
423-- | Render a `ConflictClause`.
399-- | Render a `ConflictClause`.
424renderConflictClause
400renderConflictClause
425 :: SOP.SListI (TableToColumns table)
401 :: SOP.SListI (TableToColumns table)
426− => ConflictClause schema table params
402+ => ConflictClause db table params
427 -> ByteString
403 -> ByteString
428renderConflictClause = \case
404renderConflictClause = \case
429 OnConflictDoRaise -> ""
405 OnConflictDoRaise -> ""
@@ -436,7 +412,7 @@ renderConflictClause = \case
436 wh:whs -> " WHERE" <+> renderExpression (foldr (.&&) wh whs)
412 wh:whs -> " WHERE" <+> renderExpression (foldr (.&&) wh whs)
437 where
413 where
438 renderUpdate
414 renderUpdate
439− :: Aliased (ColumnValue schema columns params) column
415+ :: Aliased (ColumnValue db columns params) column
440 -> Maybe ByteString
416 -> Maybe ByteString
441 renderUpdate = \case
417 renderUpdate = \case
442 Same `As` _ -> Nothing
418 Same `As` _ -> Nothing
@@ -454,26 +430,28 @@ UPDATE statements
454update
430update
455 :: ( SOP.SListI columns
431 :: ( SOP.SListI columns
456 , SOP.SListI results
432 , SOP.SListI results
433+ , db ~ (commons :=> schemas)
434+ , Has sch schemas schema
457 , Has tab schema ('Table table)
435 , Has tab schema ('Table table)
458 , row ~ TableToRow table
436 , row ~ TableToRow table
459 , columns ~ TableToColumns table )
437 , columns ~ TableToColumns table )
460− => Alias tab -- ^ table to update
438+ => QualifiedAlias sch tab -- ^ table to update
461− -> NP (Aliased (ColumnValue schema row params)) columns
439+ -> NP (Aliased (ColumnValue db row params)) columns
462 -- ^ modified values to replace old values
440 -- ^ modified values to replace old values
463− -> (forall t. Condition schema '[t ::: row] 'Ungrouped params)
441+ -> (forall t. Condition db '[t ::: row] 'Ungrouped params)
464 -- ^ condition under which to perform update on a row
442 -- ^ condition under which to perform update on a row
465− -> ReturningClause schema params row results -- ^ results to return
443+ -> ReturningClause db params row results -- ^ results to return
466− -> Manipulation schema params results
444+ -> Manipulation db params results
467update tab columns wh returning = UnsafeManipulation $
445update tab columns wh returning = UnsafeManipulation $
468 "UPDATE"
446 "UPDATE"
469− <+> renderAlias tab
447+ <+> renderQualifiedAlias tab
470 <+> "SET"
448 <+> "SET"
471 <+> renderCommaSeparatedMaybe renderUpdate columns
449 <+> renderCommaSeparatedMaybe renderUpdate columns
472 <+> "WHERE" <+> renderExpression wh
450 <+> "WHERE" <+> renderExpression wh
473 <> renderReturningClause returning
451 <> renderReturningClause returning
474 where
452 where
475 renderUpdate
453 renderUpdate
476− :: Aliased (ColumnValue schema columns params) column
454+ :: Aliased (ColumnValue db columns params) column
477 -> Maybe ByteString
455 -> Maybe ByteString
478 renderUpdate = \case
456 renderUpdate = \case
479 Same `As` _ -> Nothing
457 Same `As` _ -> Nothing
@@ -485,60 +463,64 @@ update tab columns wh returning = UnsafeManipulation $
485-- | Update a row returning `Nil`.
463-- | Update a row returning `Nil`.
486update_
464update_
487 :: ( SOP.SListI columns
465 :: ( SOP.SListI columns
466+ , db ~ (commons :=> schemas)
467+ , Has sch schemas schema
488 , Has tab schema ('Table table)
468 , Has tab schema ('Table table)
489 , row ~ TableToRow table
469 , row ~ TableToRow table
490 , columns ~ TableToColumns table )
470 , columns ~ TableToColumns table )
491− => Alias tab -- ^ table to update
471+ => QualifiedAlias sch tab -- ^ table to update
492− -> NP (Aliased (ColumnValue schema row params)) columns
472+ -> NP (Aliased (ColumnValue db row params)) columns
493 -- ^ modified values to replace old values
473 -- ^ modified values to replace old values
494− -> (forall t. Condition schema '[t ::: row] 'Ungrouped params)
474+ -> (forall t. Condition db '[t ::: row] 'Ungrouped params)
495 -- ^ condition under which to perform update on a row
475 -- ^ condition under which to perform update on a row
496− -> Manipulation schema params '[]
476+ -> Manipulation db params '[]
497update_ tab columns wh = update tab columns wh (Returning Nil)
477update_ tab columns wh = update tab columns wh (Returning Nil)
498
478
499{-----------------------------------------
479{-----------------------------------------
500DELETE statements
480DELETE statements
501-----------------------------------------}
481-----------------------------------------}
502
482
503−data UsingClause schema params from where
483+data UsingClause db params from where
504− NoUsing :: UsingClause schema params '[]
484+ NoUsing :: UsingClause db params '[]
505 Using
485 Using
506− :: FromClause schema params from
486+ :: FromClause db params from
507− -> UsingClause schema params from
487+ -> UsingClause db params from
508
488
509-- | Delete rows from a table.
489-- | Delete rows from a table.
510deleteFrom
490deleteFrom
511 :: ( SOP.SListI results
491 :: ( SOP.SListI results
492+ , db ~ (commons :=> schemas)
493+ , Has sch schemas schema
512 , Has tab schema ('Table table)
494 , Has tab schema ('Table table)
513 , row ~ TableToRow table
495 , row ~ TableToRow table
514 , columns ~ TableToColumns table )
496 , columns ~ TableToColumns table )
515− => Alias tab -- ^ table to delete from
497+ => QualifiedAlias sch tab -- ^ table to delete from
516− -> UsingClause schema params from
498+ -> UsingClause db params from
517− -- ^-- tables to add to the scope - more tables can be added through `also`.
518− -> Condition schema (tab ::: row ': from) 'Ungrouped params
499+ -> Condition db (tab ::: row ': from) 'Ungrouped params
519 -- ^ condition under which to delete a row
500 -- ^ condition under which to delete a row
520− -> ReturningClause schema params row results -- ^ results to return
501+ -> ReturningClause db params row results -- ^ results to return
521− -> Manipulation schema params results
502+ -> Manipulation db params results
522−deleteFrom tgt uses cond returning =
523− let renderUsing NoUsing = mempty
524− renderUsing (Using fc) = "USING" <+> renderFromClause fc <> " "
525− in UnsafeManipulation $
503+deleteFrom tab using wh returning = UnsafeManipulation $
526− "DELETE FROM" <+> renderAlias tgt
504+ "DELETE FROM"
527− <+> renderUsing uses
505+ <+> renderQualifiedAlias tab
506+ <> case using of
507+ NoUsing -> ""
508+ Using tables -> " USING" <+> renderFromClause tables
528− <> "WHERE" <+> renderExpression cond
509+ <+> "WHERE" <+> renderExpression wh
529− <> renderReturningClause returning
510+ <> renderReturningClause returning
530
511
531-- | Delete rows returning `Nil`.
512-- | Delete rows returning `Nil`.
532deleteFrom_
513deleteFrom_
514+ :: ( db ~ (commons :=> schemas)
515+ , Has sch schemas schema
533− :: ( Has tab schema ('Table table)
516+ , Has tab schema ('Table table)
534 , row ~ TableToRow table
517 , row ~ TableToRow table
535 , columns ~ TableToColumns table )
518 , columns ~ TableToColumns table )
536− => Alias tab -- ^ table to delete from
519+ => QualifiedAlias sch tab -- ^ table to delete from
537− -> UsingClause schema params from
520+ -> UsingClause db params from
538− -- ^-- tables to add to the scope - more tables can be added through `also`.
539− -> Condition schema (tab ::: row ': from) 'Ungrouped params
521+ -> Condition db (tab ::: row ': from) 'Ungrouped params
540 -- ^ condition under which to delete a row
522 -- ^ condition under which to delete a row
541− -> Manipulation schema params '[]
523+ -> Manipulation db params '[]
542deleteFrom_ tab uses wh = deleteFrom tab uses wh (Returning Nil)
524deleteFrom_ tab uses wh = deleteFrom tab uses wh (Returning Nil)
543
525
544-- | This has the behaviour of a cartesian product, taking all
526-- | This has the behaviour of a cartesian product, taking all
squeal-postgresql/src/Squeal/PostgreSQL/Migration.hs+48−45
@@ -31,7 +31,7 @@ type EmailsTable =
31
31
32>>> :{
32>>> :{
33let
33let
34− makeUsers :: Migration IO '[] '["users" ::: 'Table UsersTable]
34+ makeUsers :: Migration IO (Public '[]) '["public" ::: '["users" ::: 'Table UsersTable]]
35 makeUsers = Migration
35 makeUsers = Migration
36 { name = "make users table"
36 { name = "make users table"
37 , up = void . define $
37 , up = void . define $
@@ -45,8 +45,8 @@ let
45
45
46>>> :{
46>>> :{
47let
47let
48− makeEmails :: Migration IO '["users" ::: 'Table UsersTable]
48+ makeEmails :: Migration IO '["public" ::: '["users" ::: 'Table UsersTable]]
49− '["users" ::: 'Table UsersTable, "emails" ::: 'Table EmailsTable]
49+ '["public" ::: '["users" ::: 'Table UsersTable, "emails" ::: 'Table EmailsTable]]
50 makeEmails = Migration
50 makeEmails = Migration
51 { name = "make emails table"
51 { name = "make emails table"
52 , up = void . define $
52 , up = void . define $
@@ -68,10 +68,10 @@ Now that we have a couple migrations we can chain them together.
68>>> :{
68>>> :{
69let
69let
70 numMigrations
70 numMigrations
71− :: Has "schema_migrations" schema ('Table MigrationsTable)
71+ :: Has "migrations" schemas MigrationsSchema
72− => PQ schema schema IO ()
72+ => PQ schemas schemas IO ()
73 numMigrations = do
73 numMigrations = do
74− result <- runQuery (selectStar (from (table (#schema_migrations `as` #m))))
74+ result <- runQuery (selectStar (from (table (#migrations ! #schema_migrations `as` #m))))
75 num <- ntuples result
75 num <- ntuples result
76 liftBase $ print num
76 liftBase $ print num
77:}
77:}
@@ -124,11 +124,11 @@ import Squeal.PostgreSQL
124
124
125-- | A `Migration` should contain an inverse pair of
125-- | A `Migration` should contain an inverse pair of
126-- `up` and `down` instructions and a unique `name`.
126-- `up` and `down` instructions and a unique `name`.
127−data Migration io schema0 schema1 = Migration
127+data Migration io schemas0 schemas1 = Migration
128 { name :: Text -- ^ The `name` of a `Migration`.
128 { name :: Text -- ^ The `name` of a `Migration`.
129 -- Each `name` in a `Migration` should be unique.
129 -- Each `name` in a `Migration` should be unique.
130− , up :: PQ schema0 schema1 io () -- ^ The `up` instruction of a `Migration`.
130+ , up :: PQ schemas0 schemas1 io () -- ^ The `up` instruction of a `Migration`.
131− , down :: PQ schema1 schema0 io () -- ^ The `down` instruction of a `Migration`.
131+ , down :: PQ schemas1 schemas0 io () -- ^ The `down` instruction of a `Migration`.
132 }
132 }
133
133
134-- | Run `Migration`s by creating the `MigrationsTable`
134-- | Run `Migration`s by creating the `MigrationsTable`
@@ -137,10 +137,10 @@ data Migration io schema0 schema1 = Migration
137-- execute the `Migration` and insert its row in the `MigrationsTable`.
137-- execute the `Migration` and insert its row in the `MigrationsTable`.
138migrateUp
138migrateUp
139 :: MonadBaseControl IO io
139 :: MonadBaseControl IO io
140− => AlignedList (Migration io) schema0 schema1 -- ^ migrations to run
140+ => AlignedList (Migration io) schemas0 schemas1 -- ^ migrations to run
141 -> PQ
141 -> PQ
142− ("schema_migrations" ::: 'Table MigrationsTable ': schema0)
142+ ("migrations" ::: MigrationsSchema ': schemas0)
143− ("schema_migrations" ::: 'Table MigrationsTable ': schema1)
143+ ("migrations" ::: MigrationsSchema ': schemas1)
144 io ()
144 io ()
145migrateUp migration =
145migrateUp migration =
146 define createMigrations
146 define createMigrations
@@ -150,10 +150,10 @@ migrateUp migration =
150
150
151 upMigrations
151 upMigrations
152 :: MonadBaseControl IO io
152 :: MonadBaseControl IO io
153− => AlignedList (Migration io) schema0 schema1
153+ => AlignedList (Migration io) schemas0 schemas1
154 -> PQ
154 -> PQ
155− ("schema_migrations" ::: 'Table MigrationsTable ': schema0)
155+ ("migrations" ::: MigrationsSchema ': schemas0)
156− ("schema_migrations" ::: 'Table MigrationsTable ': schema1)
156+ ("migrations" ::: MigrationsSchema ': schemas1)
157 io ()
157 io ()
158 upMigrations = \case
158 upMigrations = \case
159 Done -> return ()
159 Done -> return ()
@@ -161,9 +161,9 @@ migrateUp migration =
161
161
162 upMigration
162 upMigration
163 :: MonadBase IO io
163 :: MonadBase IO io
164− => Migration io schema0 schema1 -> PQ
164+ => Migration io schemas0 schemas1 -> PQ
165− ("schema_migrations" ::: 'Table MigrationsTable ': schema0)
165+ ("migrations" ::: MigrationsSchema ': schemas0)
166− ("schema_migrations" ::: 'Table MigrationsTable ': schema1)
166+ ("migrations" ::: MigrationsSchema ': schemas1)
167 io ()
167 io ()
168 upMigration step =
168 upMigration step =
169 queryExecuted step
169 queryExecuted step
@@ -178,9 +178,9 @@ migrateUp migration =
178
178
179 queryExecuted
179 queryExecuted
180 :: MonadBase IO io
180 :: MonadBase IO io
181− => Migration io schema0 schema1 -> PQ
181+ => Migration io schemas0 schemas1 -> PQ
182− ("schema_migrations" ::: 'Table MigrationsTable ': schema0)
182+ ("migrations" ::: MigrationsSchema ': schemas0)
183− ("schema_migrations" ::: 'Table MigrationsTable ': schema0)
183+ ("migrations" ::: MigrationsSchema ': schemas0)
184 io Row
184 io Row
185 queryExecuted step = do
185 queryExecuted step = do
186 result <- runQueryParams selectMigration (Only (name step))
186 result <- runQueryParams selectMigration (Only (name step))
@@ -193,10 +193,10 @@ migrateUp migration =
193-- rewind the `Migration` and delete its row in the `MigrationsTable`.
193-- rewind the `Migration` and delete its row in the `MigrationsTable`.
194migrateDown
194migrateDown
195 :: MonadBaseControl IO io
195 :: MonadBaseControl IO io
196− => AlignedList (Migration io) schema0 schema1 -- ^ migrations to rewind
196+ => AlignedList (Migration io) schemas0 schemas1 -- ^ migrations to rewind
197 -> PQ
197 -> PQ
198− ("schema_migrations" ::: 'Table MigrationsTable ': schema1)
198+ ("migrations" ::: MigrationsSchema ': schemas1)
199− ("schema_migrations" ::: 'Table MigrationsTable ': schema0)
199+ ("migrations" ::: MigrationsSchema ': schemas0)
200 io ()
200 io ()
201migrateDown migrations =
201migrateDown migrations =
202 define createMigrations
202 define createMigrations
@@ -206,9 +206,9 @@ migrateDown migrations =
206
206
207 downMigrations
207 downMigrations
208 :: MonadBaseControl IO io
208 :: MonadBaseControl IO io
209− => AlignedList (Migration io) schema0 schema1 -> PQ
209+ => AlignedList (Migration io) schemas0 schemas1 -> PQ
210− ("schema_migrations" ::: 'Table MigrationsTable ': schema1)
210+ ("migrations" ::: MigrationsSchema ': schemas1)
211− ("schema_migrations" ::: 'Table MigrationsTable ': schema0)
211+ ("migrations" ::: MigrationsSchema ': schemas0)
212 io ()
212 io ()
213 downMigrations = \case
213 downMigrations = \case
214 Done -> return ()
214 Done -> return ()
@@ -216,9 +216,9 @@ migrateDown migrations =
216
216
217 downMigration
217 downMigration
218 :: MonadBase IO io
218 :: MonadBase IO io
219− => Migration io schema0 schema1 -> PQ
219+ => Migration io schemas0 schemas1 -> PQ
220− ("schema_migrations" ::: 'Table MigrationsTable ': schema1)
220+ ("migrations" ::: MigrationsSchema ': schemas1)
221− ("schema_migrations" ::: 'Table MigrationsTable ': schema0)
221+ ("migrations" ::: MigrationsSchema ': schemas0)
222 io ()
222 io ()
223 downMigration step =
223 downMigration step =
224 queryExecuted step
224 queryExecuted step
@@ -233,9 +233,9 @@ migrateDown migrations =
233
233
234 queryExecuted
234 queryExecuted
235 :: MonadBase IO io
235 :: MonadBase IO io
236− => Migration io schema0 schema1 -> PQ
236+ => Migration io schemas0 schemas1 -> PQ
237− ("schema_migrations" ::: 'Table MigrationsTable ': schema1)
237+ ("migrations" ::: MigrationsSchema ': schemas1)
238− ("schema_migrations" ::: 'Table MigrationsTable ': schema1)
238+ ("migrations" ::: MigrationsSchema ': schemas1)
239 io Row
239 io Row
240 queryExecuted step = do
240 queryExecuted step = do
241 result <- runQueryParams selectMigration (Only (name step))
241 result <- runQueryParams selectMigration (Only (name step))
@@ -258,12 +258,15 @@ type MigrationsTable =
258 , "executed_at" ::: 'Def :=> 'NotNull 'PGtimestamptz
258 , "executed_at" ::: 'Def :=> 'NotNull 'PGtimestamptz
259 ]
259 ]
260
260
261+type MigrationsSchema = '["schema_migrations" ::: 'Table MigrationsTable]
262+
261-- | Creates a `MigrationsTable` if it does not already exist.
263-- | Creates a `MigrationsTable` if it does not already exist.
262createMigrations
264createMigrations
263− :: Has "schema_migrations" schema ('Table MigrationsTable)
265+ :: Has "migrations" schemas MigrationsSchema
264− => Definition schema schema
266+ => Definition schemas schemas
265createMigrations =
267createMigrations =
268+ createSchemaIfNotExists #migrations >>>
266− createTableIfNotExists #schema_migrations
269+ createTableIfNotExists (#migrations ! #schema_migrations)
267 ( (text & notNullable) `as` #name :*
270 ( (text & notNullable) `as` #name :*
268 (timestampWithTimeZone & notNullable & default_ currentTimestamp)
271 (timestampWithTimeZone & notNullable & default_ currentTimestamp)
269 `as` #executed_at )
272 `as` #executed_at )
@@ -271,25 +274,25 @@ createMigrations =
271
274
272-- | Inserts a `Migration` into the `MigrationsTable`
275-- | Inserts a `Migration` into the `MigrationsTable`
273insertMigration
276insertMigration
274− :: Has "schema_migrations" schema ('Table MigrationsTable)
277+ :: Has "migrations" schemas MigrationsSchema
275− => Manipulation schema '[ 'NotNull 'PGtext] '[]
278+ => Manipulation ('[] :=> schemas) '[ 'NotNull 'PGtext] '[]
276−insertMigration = insertRow_ #schema_migrations
279+insertMigration = insertRow_ (#migrations ! #schema_migrations)
277 ( Set (param @1) `as` #name :*
280 ( Set (param @1) `as` #name :*
278 Default `as` #executed_at )
281 Default `as` #executed_at )
279
282
280-- | Deletes a `Migration` from the `MigrationsTable`
283-- | Deletes a `Migration` from the `MigrationsTable`
281deleteMigration
284deleteMigration
282− :: Has "schema_migrations" schema ('Table MigrationsTable)
285+ :: Has "migrations" schemas MigrationsSchema
283− => Manipulation schema '[ 'NotNull 'PGtext ] '[]
286+ => Manipulation ('[] :=> schemas) '[ 'NotNull 'PGtext ] '[]
284−deleteMigration = deleteFrom_ #schema_migrations NoUsing (#name .== param @1)
287+deleteMigration = deleteFrom_ (#migrations ! #schema_migrations) NoUsing (#name .== param @1)
285
288
286-- | Selects a `Migration` from the `MigrationsTable`, returning
289-- | Selects a `Migration` from the `MigrationsTable`, returning
287-- the time at which it was executed.
290-- the time at which it was executed.
288selectMigration
291selectMigration
289− :: Has "schema_migrations" schema ('Table MigrationsTable)
292+ :: Has "migrations" schemas MigrationsSchema
290− => Query schema '[ 'NotNull 'PGtext ]
293+ => Query ('[] :=> schemas) '[ 'NotNull 'PGtext ]
291 '[ "executed_at" ::: 'NotNull 'PGtimestamptz ]
294 '[ "executed_at" ::: 'NotNull 'PGtimestamptz ]
292selectMigration = select
295selectMigration = select
293 (#executed_at `as` #executed_at)
296 (#executed_at `as` #executed_at)
294− ( from (table (#schema_migrations `as` #m))
297+ ( from (table ((#migrations ! #schema_migrations) `as` #m))
295 & where_ (#name .== param @1))
298 & where_ (#name .== param @1))
squeal-postgresql/src/Squeal/PostgreSQL/PQ.hs+86−86
@@ -11,7 +11,7 @@ a `Definition` and `MonadPQ` for executing a `Manipulation` or `Query`,
11and a `PQ` type with instances for them.
11and a `PQ` type with instances for them.
12
12
13Using Squeal in your application will come down to defining
13Using Squeal in your application will come down to defining
14−the @schema@ of your database and including @PQ schema schema@ in your
14+the @schemas@ of your database and including @PQ schemas schemas@ in your
15application's monad transformer stack, giving it an instance of `MonadPQ`.
15application's monad transformer stack, giving it an instance of `MonadPQ`.
16
16
17This module also provides functions for retrieving rows from the `LibPQ.Result`
17This module also provides functions for retrieving rows from the `LibPQ.Result`
@@ -130,22 +130,22 @@ Note that, for now, squeal doesn't offer any protection from connecting
130with the wrong schema!
130with the wrong schema!
131-}
131-}
132connectdb
132connectdb
133− :: forall schema io
133+ :: forall schemas io
134 . MonadBase IO io
134 . MonadBase IO io
135 => ByteString -- ^ conninfo
135 => ByteString -- ^ conninfo
136− -> io (K LibPQ.Connection schema)
136+ -> io (K LibPQ.Connection schemas)
137connectdb = fmap K . liftBase . LibPQ.connectdb
137connectdb = fmap K . liftBase . LibPQ.connectdb
138
138
139-- | Closes the connection to the server.
139-- | Closes the connection to the server.
140−finish :: MonadBase IO io => K LibPQ.Connection schema -> io ()
140+finish :: MonadBase IO io => K LibPQ.Connection schemas -> io ()
141finish = liftBase . LibPQ.finish . unK
141finish = liftBase . LibPQ.finish . unK
142
142
143-- | Do `connectdb` and `finish` before and after a computation.
143-- | Do `connectdb` and `finish` before and after a computation.
144withConnection
144withConnection
145− :: forall schema0 schema1 io x
145+ :: forall schemas0 schemas1 io x
146 . MonadBaseControl IO io
146 . MonadBaseControl IO io
147 => ByteString
147 => ByteString
148− -> PQ schema0 schema1 io x
148+ -> PQ schemas0 schemas1 io x
149 -> io x
149 -> io x
150withConnection connString action = do
150withConnection connString action = do
151 K x <- bracket (connectdb connString) finish (unPQ action)
151 K x <- bracket (connectdb connString) finish (unPQ action)
@@ -153,20 +153,20 @@ withConnection connString action = do
153
153
154-- | Safely `lowerConnection` to a smaller schema.
154-- | Safely `lowerConnection` to a smaller schema.
155lowerConnection
155lowerConnection
156− :: K LibPQ.Connection (table ': schema)
156+ :: K LibPQ.Connection (schema ': schemas)
157− -> K LibPQ.Connection schema
157+ -> K LibPQ.Connection schemas
158lowerConnection (K conn) = K conn
158lowerConnection (K conn) = K conn
159
159
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 :: SchemaType)
163+ (schemas0 :: SchemasType)
164− (schema1 :: SchemaType)
164+ (schemas1 :: SchemasType)
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 schemas0 -> m (K x schemas1) }
168
168
169−instance Monad m => Functor (PQ schema0 schema1 m) where
169+instance Monad m => Functor (PQ schemas0 schemas1 m) where
170 fmap f (PQ pq) = PQ $ \ conn -> do
170 fmap f (PQ pq) = PQ $ \ conn -> do
171 K x <- pq conn
171 K x <- pq conn
172 return $ K (f x)
172 return $ K (f x)
@@ -174,9 +174,9 @@ instance Monad m => Functor (PQ schema0 schema1 m) where
174-- | Run a `PQ` and keep the result and the `Connection`.
174-- | Run a `PQ` and keep the result and the `Connection`.
175runPQ
175runPQ
176 :: Functor m
176 :: Functor m
177− => PQ schema0 schema1 m x
177+ => PQ schemas0 schemas1 m x
178− -> K LibPQ.Connection schema0
178+ -> K LibPQ.Connection schemas0
179− -> m (x, K LibPQ.Connection schema1)
179+ -> m (x, K LibPQ.Connection schemas1)
180runPQ (PQ pq) conn = (\ x -> (unK x, K (unK conn))) <$> pq conn
180runPQ (PQ pq) conn = (\ x -> (unK x, K (unK conn))) <$> pq conn
181 -- K x <- pq conn
181 -- K x <- pq conn
182 -- return (x, K (unK conn))
182 -- return (x, K (unK conn))
@@ -184,16 +184,16 @@ runPQ (PQ pq) conn = (\ x -> (unK x, K (unK conn))) <$> pq conn
184-- | Execute a `PQ` and discard the result but keep the `Connection`.
184-- | Execute a `PQ` and discard the result but keep the `Connection`.
185execPQ
185execPQ
186 :: Functor m
186 :: Functor m
187− => PQ schema0 schema1 m x
187+ => PQ schemas0 schemas1 m x
188− -> K LibPQ.Connection schema0
188+ -> K LibPQ.Connection schemas0
189− -> m (K LibPQ.Connection schema1)
189+ -> m (K LibPQ.Connection schemas1)
190execPQ (PQ pq) conn = mapKK (\ _ -> unK conn) <$> pq conn
190execPQ (PQ pq) conn = mapKK (\ _ -> unK conn) <$> pq conn
191
191
192-- | Evaluate a `PQ` and discard the `Connection` but keep the result.
192-- | Evaluate a `PQ` and discard the `Connection` but keep the result.
193evalPQ
193evalPQ
194 :: Functor m
194 :: Functor m
195− => PQ schema0 schema1 m x
195+ => PQ schemas0 schemas1 m x
196− -> K LibPQ.Connection schema0
196+ -> K LibPQ.Connection schemas0
197 -> m x
197 -> m x
198evalPQ (PQ pq) conn = unK <$> pq conn
198evalPQ (PQ pq) conn = unK <$> pq conn
199
199
@@ -208,53 +208,53 @@ class IndexedMonadTransPQ pq where
208 -- | indexed analog of `<*>`
208 -- | indexed analog of `<*>`
209 pqAp
209 pqAp
210 :: Monad m
210 :: Monad m
211− => pq schema0 schema1 m (x -> y)
211+ => pq schemas0 schemas1 m (x -> y)
212− -> pq schema1 schema2 m x
212+ -> pq schemas1 schemas2 m x
213− -> pq schema0 schema2 m y
213+ -> pq schemas0 schemas2 m y
214
214
215 -- | indexed analog of `join`
215 -- | indexed analog of `join`
216 pqJoin
216 pqJoin
217 :: Monad m
217 :: Monad m
218− => pq schema0 schema1 m (pq schema1 schema2 m y)
218+ => pq schemas0 schemas1 m (pq schemas1 schemas2 m y)
219− -> pq schema0 schema2 m y
219+ -> pq schemas0 schemas2 m y
220 pqJoin pq = pq & pqBind id
220 pqJoin pq = pq & pqBind id
221
221
222 -- | indexed analog of `=<<`
222 -- | indexed analog of `=<<`
223 pqBind
223 pqBind
224 :: Monad m
224 :: Monad m
225− => (x -> pq schema1 schema2 m y)
225+ => (x -> pq schemas1 schemas2 m y)
226− -> pq schema0 schema1 m x
226+ -> pq schemas0 schemas1 m x
227− -> pq schema0 schema2 m y
227+ -> pq schemas0 schemas2 m y
228
228
229 -- | indexed analog of flipped `>>`
229 -- | indexed analog of flipped `>>`
230 pqThen
230 pqThen
231 :: Monad m
231 :: Monad m
232− => pq schema1 schema2 m y
232+ => pq schemas1 schemas2 m y
233− -> pq schema0 schema1 m x
233+ -> pq schemas0 schemas1 m x
234− -> pq schema0 schema2 m y
234+ -> pq schemas0 schemas2 m y
235 pqThen pq2 pq1 = pq1 & pqBind (\ _ -> pq2)
235 pqThen pq2 pq1 = pq1 & pqBind (\ _ -> pq2)
236
236
237 -- | indexed analog of `<=<`
237 -- | indexed analog of `<=<`
238 pqAndThen
238 pqAndThen
239 :: Monad m
239 :: Monad m
240− => (y -> pq schema1 schema2 m z)
240+ => (y -> pq schemas1 schemas2 m z)
241− -> (x -> pq schema0 schema1 m y)
241+ -> (x -> pq schemas0 schemas1 m y)
242− -> x -> pq schema0 schema2 m z
242+ -> x -> pq schemas0 schemas2 m z
243 pqAndThen g f x = pqBind g (f x)
243 pqAndThen g f x = pqBind g (f x)
244
244
245 -- | Safely embed a computation in a larger schema.
245 -- | Safely embed a computation in a larger schema.
246 pqEmbed
246 pqEmbed
247 :: Monad m
247 :: Monad m
248− => pq schema0 schema1 m x
248+ => pq schemas0 schemas1 m x
249− -> pq (table ': schema0) (table : schema1) m x
249+ -> pq (schema ': schemas0) (schema : schemas1) m x
250
250
251 -- | Run a `Definition` with `LibPQ.exec`, we expect that libpq obeys the law
251 -- | Run a `Definition` with `LibPQ.exec`, we expect that libpq obeys the law
252 --
252 --
253 -- @define statement1 & pqThen (define statement2) = define (statement1 >>> statement2)@
253 -- @define statement1 & pqThen (define statement2) = define (statement1 >>> statement2)@
254 define
254 define
255 :: MonadBase IO io
255 :: MonadBase IO io
256− => Definition schema0 schema1
256+ => Definition schemas0 schemas1
257− -> pq schema0 schema1 io (K LibPQ.Result '[])
257+ -> pq schemas0 schemas1 io (K LibPQ.Result '[])
258
258
259instance IndexedMonadTransPQ PQ where
259instance IndexedMonadTransPQ PQ where
260
260
@@ -312,66 +312,66 @@ To define an instance, you can minimally define only `manipulateParams`,
312a default instance.
312a default instance.
313
313
314-}
314-}
315−class Monad pq => MonadPQ schema pq | pq -> schema where
315+class Monad pq => MonadPQ schemas pq | pq -> schemas where
316 manipulateParams
316 manipulateParams
317 :: ToParams x params
317 :: ToParams x params
318− => Manipulation schema params ys
318+ => Manipulation ('[] :=> schemas) params ys
319 -- ^ `insertRows`, `update` or `deleteFrom`
319 -- ^ `insertRows`, `update` or `deleteFrom`
320 -> x -> pq (K LibPQ.Result ys)
320 -> x -> pq (K LibPQ.Result ys)
321 default manipulateParams
321 default manipulateParams
322− :: (MonadTrans t, MonadPQ schema pq1, pq ~ t pq1)
322+ :: (MonadTrans t, MonadPQ schemas pq1, pq ~ t pq1)
323 => ToParams x params
323 => ToParams x params
324− => Manipulation schema params ys
324+ => Manipulation ('[] :=> schemas) params ys
325 -- ^ `insertRows`, `update` or `deleteFrom`
325 -- ^ `insertRows`, `update` or `deleteFrom`
326 -> x -> pq (K LibPQ.Result ys)
326 -> x -> pq (K LibPQ.Result ys)
327 manipulateParams manipulation params = lift $
327 manipulateParams manipulation params = lift $
328 manipulateParams manipulation params
328 manipulateParams manipulation params
329
329
330− manipulate :: Manipulation schema '[] ys -> pq (K LibPQ.Result ys)
330+ manipulate :: Manipulation ('[] :=> schemas) '[] ys -> pq (K LibPQ.Result ys)
331 manipulate statement = manipulateParams statement ()
331 manipulate statement = manipulateParams statement ()
332
332
333 runQueryParams
333 runQueryParams
334 :: ToParams x params
334 :: ToParams x params
335− => Query schema params ys
335+ => Query ('[] :=> schemas) params ys
336 -- ^ `select` and friends
336 -- ^ `select` and friends
337 -> x -> pq (K LibPQ.Result ys)
337 -> x -> pq (K LibPQ.Result ys)
338 runQueryParams = manipulateParams . queryStatement
338 runQueryParams = manipulateParams . queryStatement
339
339
340 runQuery
340 runQuery
341− :: Query schema '[] ys
341+ :: Query ('[] :=> schemas) '[] ys
342 -- ^ `select` and friends
342 -- ^ `select` and friends
343 -> pq (K LibPQ.Result ys)
343 -> pq (K LibPQ.Result ys)
344 runQuery q = runQueryParams q ()
344 runQuery q = runQueryParams q ()
345
345
346 traversePrepared
346 traversePrepared
347 :: (ToParams x params, Traversable list)
347 :: (ToParams x params, Traversable list)
348− => Manipulation schema params ys
348+ => Manipulation ('[] :=> schemas) params ys
349 -- ^ `insertRows`, `update`, or `deleteFrom`, and friends
349 -- ^ `insertRows`, `update`, or `deleteFrom`, and friends
350 -> list x -> pq (list (K LibPQ.Result ys))
350 -> list x -> pq (list (K LibPQ.Result ys))
351 default traversePrepared
351 default traversePrepared
352− :: (MonadTrans t, MonadPQ schema pq1, pq ~ t pq1)
352+ :: (MonadTrans t, MonadPQ schemas pq1, pq ~ t pq1)
353 => (ToParams x params, Traversable list)
353 => (ToParams x params, Traversable list)
354− => Manipulation schema params ys -> list x -> pq (list (K LibPQ.Result ys))
354+ => Manipulation ('[] :=> schemas) params ys -> list x -> pq (list (K LibPQ.Result ys))
355 traversePrepared manipulation params = lift $
355 traversePrepared manipulation params = lift $
356 traversePrepared manipulation params
356 traversePrepared manipulation params
357
357
358 forPrepared
358 forPrepared
359 :: (ToParams x params, Traversable list)
359 :: (ToParams x params, Traversable list)
360 => list x
360 => list x
361− -> Manipulation schema params ys
361+ -> Manipulation ('[] :=> schemas) params ys
362 -- ^ `insertRows`, `update` or `deleteFrom`
362 -- ^ `insertRows`, `update` or `deleteFrom`
363 -> pq (list (K LibPQ.Result ys))
363 -> pq (list (K LibPQ.Result ys))
364 forPrepared = flip traversePrepared
364 forPrepared = flip traversePrepared
365
365
366 traversePrepared_
366 traversePrepared_
367 :: (ToParams x params, Foldable list)
367 :: (ToParams x params, Foldable list)
368− => Manipulation schema params '[]
368+ => Manipulation ('[] :=> schemas) params '[]
369 -- ^ `insertRows`, `update` or `deleteFrom`
369 -- ^ `insertRows`, `update` or `deleteFrom`
370 -> list x -> pq ()
370 -> list x -> pq ()
371 default traversePrepared_
371 default traversePrepared_
372− :: (MonadTrans t, MonadPQ schema pq1, pq ~ t pq1)
372+ :: (MonadTrans t, MonadPQ schemas pq1, pq ~ t pq1)
373 => (ToParams x params, Foldable list)
373 => (ToParams x params, Foldable list)
374− => Manipulation schema params '[]
374+ => Manipulation ('[] :=> schemas) params '[]
375 -- ^ `insertRows`, `update` or `deleteFrom`
375 -- ^ `insertRows`, `update` or `deleteFrom`
376 -> list x -> pq ()
376 -> list x -> pq ()
377 traversePrepared_ manipulation params = lift $
377 traversePrepared_ manipulation params = lift $
@@ -380,22 +380,22 @@ class Monad pq => MonadPQ schema pq | pq -> schema where
380 forPrepared_
380 forPrepared_
381 :: (ToParams x params, Foldable list)
381 :: (ToParams x params, Foldable list)
382 => list x
382 => list x
383− -> Manipulation schema params '[]
383+ -> Manipulation ('[] :=> schemas) params '[]
384 -- ^ `insertRows`, `update` or `deleteFrom`
384 -- ^ `insertRows`, `update` or `deleteFrom`
385 -> pq ()
385 -> pq ()
386 forPrepared_ = flip traversePrepared_
386 forPrepared_ = flip traversePrepared_
387
387
388 liftPQ :: (LibPQ.Connection -> IO a) -> pq a
388 liftPQ :: (LibPQ.Connection -> IO a) -> pq a
389 default liftPQ
389 default liftPQ
390− :: (MonadTrans t, MonadPQ schema pq1, pq ~ t pq1)
390+ :: (MonadTrans t, MonadPQ schemas pq1, pq ~ t pq1)
391 => (LibPQ.Connection -> IO a) -> pq a
391 => (LibPQ.Connection -> IO a) -> pq a
392 liftPQ = lift . liftPQ
392 liftPQ = lift . liftPQ
393
393
394−instance (MonadBase IO io, schema0 ~ schema, schema1 ~ schema)
394+instance (MonadBase IO io, schemas0 ~ schemas, schemas1 ~ schemas)
395− => MonadPQ schema (PQ schema0 schema1 io) where
395+ => MonadPQ schemas (PQ schemas0 schemas1 io) where
396
396
397 manipulateParams
397 manipulateParams
398− (UnsafeManipulation q :: Manipulation schema ps ys) (params :: x) =
398+ (UnsafeManipulation q :: Manipulation ('[] :=> schemas) ps ys) (params :: x) =
399 PQ $ \ (K conn) -> do
399 PQ $ \ (K conn) -> do
400 let
400 let
401 toParam' encoding =
401 toParam' encoding =
@@ -411,7 +411,7 @@ instance (MonadBase IO io, schema0 ~ schema, schema1 ~ schema)
411 return $ K (K result)
411 return $ K (K result)
412
412
413 traversePrepared
413 traversePrepared
414− (UnsafeManipulation q :: Manipulation schema xs ys) (list :: list x) =
414+ (UnsafeManipulation q :: Manipulation ('[] :=> schemas) xs ys) (list :: list x) =
415 PQ $ \ (K conn) -> liftBase $ do
415 PQ $ \ (K conn) -> liftBase $ do
416 let temp = "temporary_statement"
416 let temp = "temporary_statement"
417 prepResultMaybe <- LibPQ.prepare conn temp q Nothing
417 prepResultMaybe <- LibPQ.prepare conn temp q Nothing
@@ -438,7 +438,7 @@ instance (MonadBase IO io, schema0 ~ schema, schema1 ~ schema)
438 return (K results)
438 return (K results)
439
439
440 traversePrepared_
440 traversePrepared_
441− (UnsafeManipulation q :: Manipulation schema xs '[]) (list :: list x) =
441+ (UnsafeManipulation q :: Manipulation ('[] :=> schemas) xs '[]) (list :: list x) =
442 PQ $ \ (K conn) -> liftBase $ do
442 PQ $ \ (K conn) -> liftBase $ do
443 let temp = "temporary_statement"
443 let temp = "temporary_statement"
444 prepResultMaybe <- LibPQ.prepare conn temp q Nothing
444 prepResultMaybe <- LibPQ.prepare conn temp q Nothing
@@ -466,56 +466,56 @@ instance (MonadBase IO io, schema0 ~ schema, schema1 ~ schema)
466 y <- liftBase $ pq conn
466 y <- liftBase $ pq conn
467 return (K y)
467 return (K y)
468
468
469−instance MonadPQ schema m => MonadPQ schema (IdentityT m)
469+instance MonadPQ schemas m => MonadPQ schemas (IdentityT m)
470−instance MonadPQ schema m => MonadPQ schema (ReaderT r m)
470+instance MonadPQ schemas m => MonadPQ schemas (ReaderT r m)
471−instance MonadPQ schema m => MonadPQ schema (Strict.StateT s m)
471+instance MonadPQ schemas m => MonadPQ schemas (Strict.StateT s m)
472−instance MonadPQ schema m => MonadPQ schema (Lazy.StateT s m)
472+instance MonadPQ schemas m => MonadPQ schemas (Lazy.StateT s m)
473−instance (Monoid w, MonadPQ schema m) => MonadPQ schema (Strict.WriterT w m)
473+instance (Monoid w, MonadPQ schemas m) => MonadPQ schemas (Strict.WriterT w m)
474−instance (Monoid w, MonadPQ schema m) => MonadPQ schema (Lazy.WriterT w m)
474+instance (Monoid w, MonadPQ schemas m) => MonadPQ schemas (Lazy.WriterT w m)
475−instance MonadPQ schema m => MonadPQ schema (MaybeT m)
475+instance MonadPQ schemas m => MonadPQ schemas (MaybeT m)
476−instance MonadPQ schema m => MonadPQ schema (ExceptT e m)
476+instance MonadPQ schemas m => MonadPQ schemas (ExceptT e m)
477−instance (Monoid w, MonadPQ schema m) => MonadPQ schema (Strict.RWST r w s m)
477+instance (Monoid w, MonadPQ schemas m) => MonadPQ schemas (Strict.RWST r w s m)
478−instance (Monoid w, MonadPQ schema m) => MonadPQ schema (Lazy.RWST r w s m)
478+instance (Monoid w, MonadPQ schemas m) => MonadPQ schemas (Lazy.RWST r w s m)
479−instance MonadPQ schema m => MonadPQ schema (ContT r m)
479+instance MonadPQ schemas m => MonadPQ schemas (ContT r m)
480−
480+
481−instance (Monad m, schema0 ~ schema1)
481+instance (Monad m, schemas0 ~ schemas1)
482− => Applicative (PQ schema0 schema1 m) where
482+ => Applicative (PQ schemas0 schemas1 m) where
483 pure x = PQ $ \ _conn -> pure (K x)
483 pure x = PQ $ \ _conn -> pure (K x)
484 (<*>) = pqAp
484 (<*>) = pqAp
485
485
486−instance (Monad m, schema0 ~ schema1)
486+instance (Monad m, schemas0 ~ schemas1)
487− => Monad (PQ schema0 schema1 m) where
487+ => Monad (PQ schemas0 schemas1 m) where
488 return = pure
488 return = pure
489 (>>=) = flip pqBind
489 (>>=) = flip pqBind
490
490
491−instance schema0 ~ schema1 => MFunctor (PQ schema0 schema1) where
491+instance schemas0 ~ schemas1 => MFunctor (PQ schemas0 schemas1) where
492 hoist f (PQ pq) = PQ (f . pq)
492 hoist f (PQ pq) = PQ (f . pq)
493
493
494−instance schema0 ~ schema1 => MonadTrans (PQ schema0 schema1) where
494+instance schemas0 ~ schemas1 => MonadTrans (PQ schemas0 schemas1) where
495 lift m = PQ $ \ _conn -> do
495 lift m = PQ $ \ _conn -> do
496 x <- m
496 x <- m
497 return (K x)
497 return (K x)
498
498
499−instance schema0 ~ schema1 => MMonad (PQ schema0 schema1) where
499+instance schemas0 ~ schemas1 => MMonad (PQ schemas0 schemas1) where
500 embed f (PQ pq) = PQ $ \ conn -> do
500 embed f (PQ pq) = PQ $ \ conn -> do
501 evalPQ (f (pq conn)) conn
501 evalPQ (f (pq conn)) conn
502
502
503−instance (MonadBase b m, schema0 ~ schema1)
503+instance (MonadBase b m, schemas0 ~ schemas1)
504− => MonadBase b (PQ schema0 schema1 m) where
504+ => MonadBase b (PQ schemas0 schemas1 m) where
505 liftBase = lift . liftBase
505 liftBase = lift . liftBase
506
506
507-- | A snapshot of the state of a `PQ` computation.
507-- | A snapshot of the state of a `PQ` computation.
508−type PQRun schema =
508+type PQRun schemas =
509− forall m x. Monad m => PQ schema schema m x -> m (K x schema)
509+ forall m x. Monad m => PQ schemas schemas m x -> m (K x schemas)
510
510
511-- | Helper function in defining `MonadBaseControl` instance for `PQ`.
511-- | Helper function in defining `MonadBaseControl` instance for `PQ`.
512−pqliftWith :: Functor m => (PQRun schema -> m a) -> PQ schema schema m a
512+pqliftWith :: Functor m => (PQRun schemas -> m a) -> PQ schemas schemas m a
513pqliftWith f = PQ $ \ conn ->
513pqliftWith f = PQ $ \ conn ->
514 fmap K (f $ \ pq -> unPQ pq conn)
514 fmap K (f $ \ pq -> unPQ pq conn)
515
515
516−instance (MonadBaseControl b m, schema0 ~ schema1)
516+instance (MonadBaseControl b m, schemas0 ~ schemas1)
517− => MonadBaseControl b (PQ schema0 schema1 m) where
517+ => MonadBaseControl b (PQ schemas0 schemas1 m) where
518− type StM (PQ schema0 schema1 m) x = StM m (K x schema0)
518+ type StM (PQ schemas0 schemas1 m) x = StM m (K x schemas0)
519 liftBaseWith f =
519 liftBaseWith f =
520 pqliftWith $ \ run -> liftBaseWith $ \ runInBase -> f $ runInBase . run
520 pqliftWith $ \ run -> liftBaseWith $ \ runInBase -> f $ runInBase . run
521 restoreM = PQ . const . restoreM
521 restoreM = PQ . const . restoreM
squeal-postgresql/src/Squeal/PostgreSQL/Pool.hs+18−18
@@ -41,7 +41,7 @@ import Generics.SOP (K(..))
41import Squeal.PostgreSQL.PQ
41import Squeal.PostgreSQL.PQ
42import Squeal.PostgreSQL.Schema
42import Squeal.PostgreSQL.Schema
43
43
44−{- | `PoolPQ` @schema@ should be a drop-in replacement for `PQ` @schema schema@.
44+{- | `PoolPQ` @schemas@ should be a drop-in replacement for `PQ` @schemas schemas@.
45
45
46Typical use case would be to create your pool using `createConnectionPool` and run anything that requires the pool connection with it.
46Typical use case would be to create your pool using `createConnectionPool` and run anything that requires the pool connection with it.
47
47
@@ -63,8 +63,8 @@ Here's a simplified example:
63> liftIO $ runPoolPQ (insertOne) pool
63> liftIO $ runPoolPQ (insertOne) pool
64
64
65-}
65-}
66−newtype PoolPQ (schema :: SchemaType) m x =
66+newtype PoolPQ (schemas :: SchemasType) m x =
67− PoolPQ { runPoolPQ :: Pool (K Connection schema) -> m x }
67+ PoolPQ { runPoolPQ :: Pool (K Connection schemas) -> m x }
68 deriving Functor
68 deriving Functor
69
69
70-- | Create a striped pool of connections.
70-- | Create a striped pool of connections.
@@ -86,12 +86,12 @@ createConnectionPool
86 -> Int
86 -> Int
87 -- ^ Maximum number of connections to keep open per stripe. The smallest acceptable value is 1.
87 -- ^ Maximum number of connections to keep open per stripe. The smallest acceptable value is 1.
88 -- Requests for connections will block if this limit is reached on a single stripe, even if other stripes have idle connections available.
88 -- Requests for connections will block if this limit is reached on a single stripe, even if other stripes have idle connections available.
89− -> io (Pool (K Connection schema))
89+ -> io (Pool (K Connection schemas))
90createConnectionPool conninfo stripes idle maxResrc = liftBase $
90createConnectionPool conninfo stripes idle maxResrc = liftBase $
91 createPool (connectdb conninfo) finish stripes idle maxResrc
91 createPool (connectdb conninfo) finish stripes idle maxResrc
92
92
93-- | `Applicative` instance for `PoolPQ`.
93-- | `Applicative` instance for `PoolPQ`.
94−instance Monad m => Applicative (PoolPQ schema m) where
94+instance Monad m => Applicative (PoolPQ schemas m) where
95 pure x = PoolPQ $ \ _ -> pure x
95 pure x = PoolPQ $ \ _ -> pure x
96 PoolPQ f <*> PoolPQ x = PoolPQ $ \ pool -> do
96 PoolPQ f <*> PoolPQ x = PoolPQ $ \ pool -> do
97 f' <- f pool
97 f' <- f pool
@@ -99,55 +99,55 @@ instance Monad m => Applicative (PoolPQ schema m) where
99 return $ f' x'
99 return $ f' x'
100
100
101-- | `Monad` instance for `PoolPQ`.
101-- | `Monad` instance for `PoolPQ`.
102−instance Monad m => Monad (PoolPQ schema m) where
102+instance Monad m => Monad (PoolPQ schemas m) where
103 return = pure
103 return = pure
104 PoolPQ x >>= f = PoolPQ $ \ pool -> do
104 PoolPQ x >>= f = PoolPQ $ \ pool -> do
105 x' <- x pool
105 x' <- x pool
106 runPoolPQ (f x') pool
106 runPoolPQ (f x') pool
107
107
108-- | `MonadTrans` instance for `PoolPQ`.
108-- | `MonadTrans` instance for `PoolPQ`.
109−instance MonadTrans (PoolPQ schema) where
109+instance MonadTrans (PoolPQ schemas) where
110 lift m = PoolPQ $ \ _pool -> m
110 lift m = PoolPQ $ \ _pool -> m
111
111
112-- | `MonadBase` instance for `PoolPQ`.
112-- | `MonadBase` instance for `PoolPQ`.
113−instance MonadBase b m => MonadBase b (PoolPQ schema m) where
113+instance MonadBase b m => MonadBase b (PoolPQ schemas m) where
114 liftBase = lift . liftBase
114 liftBase = lift . liftBase
115
115
116-- | `MonadPQ` instance for `PoolPQ`.
116-- | `MonadPQ` instance for `PoolPQ`.
117−instance MonadBaseControl IO io => MonadPQ schema (PoolPQ schema io) where
117+instance MonadBaseControl IO io => MonadPQ schemas (PoolPQ schemas io) where
118 manipulateParams manipulation params = PoolPQ $ \ pool -> do
118 manipulateParams manipulation params = PoolPQ $ \ pool -> do
119 withResource pool $ \ conn -> do
119 withResource pool $ \ conn -> do
120− (K result :: K (K Result ys) schema) <- flip unPQ conn $
120+ (K result :: K (K Result ys) schemas) <- flip unPQ conn $
121 manipulateParams manipulation params
121 manipulateParams manipulation params
122 return result
122 return result
123 traversePrepared manipulation params = PoolPQ $ \ pool ->
123 traversePrepared manipulation params = PoolPQ $ \ pool ->
124 withResource pool $ \ conn -> do
124 withResource pool $ \ conn -> do
125− (K result :: K (list (K Result ys)) schema) <- flip unPQ conn $
125+ (K result :: K (list (K Result ys)) schemas) <- flip unPQ conn $
126 traversePrepared manipulation params
126 traversePrepared manipulation params
127 return result
127 return result
128 traversePrepared_ manipulation params = PoolPQ $ \ pool -> do
128 traversePrepared_ manipulation params = PoolPQ $ \ pool -> do
129 withResource pool $ \ conn -> do
129 withResource pool $ \ conn -> do
130− (_ :: K () schema) <- flip unPQ conn $
130+ (_ :: K () schemas) <- flip unPQ conn $
131 traversePrepared_ manipulation params
131 traversePrepared_ manipulation params
132 return ()
132 return ()
133 liftPQ m = PoolPQ $ \ pool ->
133 liftPQ m = PoolPQ $ \ pool ->
134 withResource pool $ \ conn -> do
134 withResource pool $ \ conn -> do
135− (K result :: K result schema) <- flip unPQ conn $
135+ (K result :: K result schemas) <- flip unPQ conn $
136 liftPQ m
136 liftPQ m
137 return result
137 return result
138
138
139-- | A snapshot of the state of a `PoolPQ` computation.
139-- | A snapshot of the state of a `PoolPQ` computation.
140−type PoolPQRun schema =
140+type PoolPQRun schemas =
141− forall m x. Monad m => PoolPQ schema m x -> m x
141+ forall m x. Monad m => PoolPQ schemas m x -> m x
142
142
143-- | Helper function in defining `MonadBaseControl` instance for `PoolPQ`.
143-- | Helper function in defining `MonadBaseControl` instance for `PoolPQ`.
144−poolpqliftWith :: Functor m => (PoolPQRun schema -> m a) -> PoolPQ schema m a
144+poolpqliftWith :: Functor m => (PoolPQRun schemas -> m a) -> PoolPQ schemas m a
145poolpqliftWith f = PoolPQ $ \ pool ->
145poolpqliftWith f = PoolPQ $ \ pool ->
146 (f $ \ pq -> runPoolPQ pq pool)
146 (f $ \ pq -> runPoolPQ pq pool)
147
147
148-- | `MonadBaseControl` instance for `PoolPQ`.
148-- | `MonadBaseControl` instance for `PoolPQ`.
149−instance MonadBaseControl b m => MonadBaseControl b (PoolPQ schema m) where
149+instance MonadBaseControl b m => MonadBaseControl b (PoolPQ schemas m) where
150− type StM (PoolPQ schema m) x = StM m x
150+ type StM (PoolPQ schemas m) x = StM m x
151 liftBaseWith f =
151 liftBaseWith f =
152 poolpqliftWith $ \ run -> liftBaseWith $ \ runInBase -> f $ runInBase . run
152 poolpqliftWith $ \ run -> liftBaseWith $ \ runInBase -> f $ runInBase . run
153 restoreM = PoolPQ . const . restoreM
153 restoreM = PoolPQ . const . restoreM
squeal-postgresql/src/Squeal/PostgreSQL/Query.hs+352−378
@@ -81,6 +81,7 @@ module Squeal.PostgreSQL.Query
81 , table
81 , table
82 , subquery
82 , subquery
83 , view
83 , view
84+ , common
84 , crossJoin
85 , crossJoin
85 , innerJoin
86 , innerJoin
86 , leftOuterJoin
87 , leftOuterJoin
@@ -144,12 +145,11 @@ is called a `Query`. Let's see some examples of queries.
144
145
145simple query:
146simple query:
146
147
148+>>> type Columns = '["col1" ::: 'NoDef :=> 'NotNull 'PGint4, "col2" ::: 'NoDef :=> 'NotNull 'PGint4]
149+>>> type Schema = '["tab" ::: 'Table ('[] :=> Columns)]
147>>> :{
150>>> :{
148let
151let
149− query :: Query
152+ query :: Query (DBof (Public Schema)) '[] '["col1" ::: 'NotNull 'PGint4, "col2" ::: 'NotNull 'PGint4]
150− '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'Null 'PGint4])]
151− '[]
152− '["col" ::: 'Null 'PGint4]
153 query = selectStar (from (table #tab))
153 query = selectStar (from (table #tab))
154in printSQL query
154in printSQL query
155:}
155:}
@@ -159,16 +159,9 @@ restricted query:
159
159
160>>> :{
160>>> :{
161let
161let
162− query :: Query
163− '[ "tab" ::: 'Table ('[] :=>
164− '[ "col1" ::: 'NoDef :=> 'NotNull 'PGint4
165− , "col2" ::: 'NoDef :=> 'NotNull 'PGint4 ])]
166− '[]
167− '[ "sum" ::: 'NotNull 'PGint4
168− , "col1" ::: 'NotNull 'PGint4 ]
162+ query :: Query (DBof (Public Schema)) '[] '["sum" ::: 'NotNull 'PGint4, "col1" ::: 'NotNull 'PGint4]
169 query =
163 query =
170− select
171− ((#col1 + #col2) `as` #sum :* #col1)
164+ select ((#col1 + #col2) `as` #sum :* #col1)
172 ( from (table #tab)
165 ( from (table #tab)
173 & where_ (#col1 .> #col2)
166 & where_ (#col1 .> #col2)
174 & where_ (#col2 .> 0) )
167 & where_ (#col2 .> 0) )
@@ -180,13 +173,8 @@ subquery:
180
173
181>>> :{
174>>> :{
182let
175let
183− query :: Query
176+ query :: Query (DBof (Public Schema)) '[] '["col1" ::: 'NotNull 'PGint4, "col2" ::: 'NotNull 'PGint4]
184− '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'Null 'PGint4])]
185− '[]
186− '["col" ::: 'Null 'PGint4]
187− query =
188− selectStar
189− (from (subquery (selectStar (from (table #tab)) `as` #sub)))
177+ query = selectStar (from (subquery (selectStar (from (table #tab)) `as` #sub)))
190in printSQL query
178in printSQL query
191:}
179:}
192SELECT * FROM (SELECT * FROM "tab" AS "tab") AS "sub"
180SELECT * FROM (SELECT * FROM "tab" AS "tab") AS "sub"
@@ -195,12 +183,8 @@ limits and offsets:
195
183
196>>> :{
184>>> :{
197let
185let
198− query :: Query
186+ query :: Query (DBof (Public Schema)) '[] '["col1" ::: 'NotNull 'PGint4, "col2" ::: 'NotNull 'PGint4]
199− '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'Null 'PGint4])]
200− '[]
201− '["col" ::: 'Null 'PGint4]
202− query = selectStar
203− (from (table #tab) & limit 100 & offset 2 & limit 50 & offset 2)
187+ query = selectStar (from (table #tab) & limit 100 & offset 2 & limit 50 & offset 2)
204in printSQL query
188in printSQL query
205:}
189:}
206SELECT * FROM "tab" AS "tab" LIMIT 50 OFFSET 4
190SELECT * FROM "tab" AS "tab" LIMIT 50 OFFSET 4
@@ -209,27 +193,17 @@ parameterized query:
209
193
210>>> :{
194>>> :{
211let
195let
212− query :: Query
196+ query :: Query (DBof (Public Schema)) '[ 'NotNull 'PGint4] '["col1" ::: 'NotNull 'PGint4, "col2" ::: 'NotNull 'PGint4]
213− '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'NotNull 'PGfloat8])]
214− '[ 'NotNull 'PGfloat8]
215− '["col" ::: 'NotNull 'PGfloat8]
216− query = selectStar
217− (from (table #tab) & where_ (#col .> param @1))
197+ query = selectStar (from (table #tab) & where_ (#col1 .> param @1))
218in printSQL query
198in printSQL query
219:}
199:}
220−SELECT * FROM "tab" AS "tab" WHERE ("col" > ($1 :: float8))
200+SELECT * FROM "tab" AS "tab" WHERE ("col1" > ($1 :: int4))
221
201
222aggregation query:
202aggregation query:
223
203
224>>> :{
204>>> :{
225let
205let
226− query :: Query
227− '[ "tab" ::: 'Table ('[] :=>
228− '[ "col1" ::: 'NoDef :=> 'NotNull 'PGint4
229− , "col2" ::: 'NoDef :=> 'NotNull 'PGint4 ])]
230− '[]
231− '[ "sum" ::: 'NotNull 'PGint4
232− , "col1" ::: 'NotNull 'PGint4 ]
206+ query :: Query (DBof (Public Schema)) '[] '["sum" ::: 'NotNull 'PGint4, "col1" ::: 'NotNull 'PGint4 ]
233 query =
207 query =
234 select (sum_ #col2 `as` #sum :* #col1)
208 select (sum_ #col2 `as` #sum :* #col1)
235 ( from (table (#tab `as` #table1))
209 ( from (table (#tab `as` #table1))
@@ -243,42 +217,44 @@ sorted query:
243
217
244>>> :{
218>>> :{
245let
219let
246− query :: Query
220+ query :: Query (DBof (Public Schema)) '[] '["col1" ::: 'NotNull 'PGint4, "col2" ::: 'NotNull 'PGint4]
247− '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'Null 'PGint4])]
248− '[]
249− '["col" ::: 'Null 'PGint4]
250− query = selectStar
221+ query = selectStar (from (table #tab) & orderBy [#col1 & Asc])
251− (from (table #tab) & orderBy [#col & AscNullsFirst])
252in printSQL query
222in printSQL query
253:}
223:}
254−SELECT * FROM "tab" AS "tab" ORDER BY "col" ASC NULLS FIRST
224+SELECT * FROM "tab" AS "tab" ORDER BY "col1" ASC
255
225
256joins:
226joins:
257
227
258>>> :set -XFlexibleContexts
228>>> :set -XFlexibleContexts
229+>>> :{
230+type OrdersColumns =
231+ '[ "id" ::: 'NoDef :=> 'NotNull 'PGint4
232+ , "price" ::: 'NoDef :=> 'NotNull 'PGfloat4
233+ , "customer_id" ::: 'NoDef :=> 'NotNull 'PGint4
234+ , "shipper_id" ::: 'NoDef :=> 'NotNull 'PGint4
235+ ]
236+:}
237+
238+>>> :{
239+type OrdersConstraints =
240+ '["pk_orders" ::: PrimaryKey '["id"]
241+ ,"fk_customers" ::: ForeignKey '["customer_id"] "customers" '["id"]
242+ ,"fk_shippers" ::: ForeignKey '["shipper_id"] "shippers" '["id"] ]
243+:}
244+
245+>>> type NamesColumns = '["id" ::: 'NoDef :=> 'NotNull 'PGint4, "name" ::: 'NoDef :=> 'NotNull 'PGtext]
246+>>> type CustomersConstraints = '["pk_customers" ::: PrimaryKey '["id"]]
247+>>> type ShippersConstraints = '["pk_shippers" ::: PrimaryKey '["id"]]
248+>>> :{
249+type OrdersSchema =
250+ '[ "orders" ::: 'Table (OrdersConstraints :=> OrdersColumns)
251+ , "customers" ::: 'Table (CustomersConstraints :=> NamesColumns)
252+ , "shippers" ::: 'Table (ShippersConstraints :=> NamesColumns) ]
253+:}
254+
259>>> :{
255>>> :{
260let
256let
261− query :: Query
257+ query :: Query (DBof (Public OrdersSchema))
262− '[ "orders" ::: 'Table (
263− '["pk_orders" ::: PrimaryKey '["id"]
264− ,"fk_customers" ::: ForeignKey '["customer_id"] "customers" '["id"]
265− ,"fk_shippers" ::: ForeignKey '["shipper_id"] "shippers" '["id"]] :=>
266− '[ "id" ::: 'NoDef :=> 'NotNull 'PGint4
267− , "price" ::: 'NoDef :=> 'NotNull 'PGfloat4
268− , "customer_id" ::: 'NoDef :=> 'NotNull 'PGint4
269− , "shipper_id" ::: 'NoDef :=> 'NotNull 'PGint4
270− ])
271− , "customers" ::: 'Table (
272− '["pk_customers" ::: PrimaryKey '["id"]] :=>
273− '[ "id" ::: 'NoDef :=> 'NotNull 'PGint4
274− , "name" ::: 'NoDef :=> 'NotNull 'PGtext
275− ])
276− , "shippers" ::: 'Table (
277− '["pk_shippers" ::: PrimaryKey '["id"]] :=>
278− '[ "id" ::: 'NoDef :=> 'NotNull 'PGint4
279− , "name" ::: 'NoDef :=> 'NotNull 'PGtext
280− ])
281− ]
282 '[]
258 '[]
283 '[ "order_price" ::: 'NotNull 'PGfloat4
259 '[ "order_price" ::: 'NotNull 'PGfloat4
284 , "customer_name" ::: 'NotNull 'PGtext
260 , "customer_name" ::: 'NotNull 'PGtext
@@ -301,12 +277,8 @@ self-join:
301
277
302>>> :{
278>>> :{
303let
279let
304− query :: Query
280+ query :: Query (DBof (Public Schema)) '[] '["col1" ::: 'NotNull 'PGint4, "col2" ::: 'NotNull 'PGint4]
305− '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'Null 'PGint4])]
306− '[]
307− '["col" ::: 'Null 'PGint4]
308− query = selectDotStar #t1
309− (from (table (#tab `as` #t1) & crossJoin (table (#tab `as` #t2))))
281+ query = selectDotStar #t1 (from (table (#tab `as` #t1) & crossJoin (table (#tab `as` #t2))))
310in printSQL query
282in printSQL query
311:}
283:}
312SELECT "t1".* FROM "tab" AS "t1" CROSS JOIN "tab" AS "t2"
284SELECT "t1".* FROM "tab" AS "t1" CROSS JOIN "tab" AS "t2"
@@ -315,7 +287,7 @@ value queries:
315
287
316>>> :{
288>>> :{
317let
289let
318− query :: Query '[] '[] '["foo" ::: 'NotNull 'PGint2, "bar" ::: 'NotNull 'PGbool]
290+ query :: Query db '[] '["foo" ::: 'NotNull 'PGint2, "bar" ::: 'NotNull 'PGbool]
319 query = values (1 `as` #foo :* true `as` #bar) [2 `as` #foo :* false `as` #bar]
291 query = values (1 `as` #foo :* true `as` #bar) [2 `as` #foo :* false `as` #bar]
320in printSQL query
292in printSQL query
321:}
293:}
@@ -325,14 +297,8 @@ set operations:
325
297
326>>> :{
298>>> :{
327let
299let
328− query :: Query
300+ query :: Query (DBof (Public Schema)) '[] '["col1" ::: 'NotNull 'PGint4, "col2" ::: 'NotNull 'PGint4]
329− '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'Null 'PGint4])]
330− '[]
331− '["col" ::: 'Null 'PGint4]
332− query =
333− selectStar (from (table #tab))
301+ query = selectStar (from (table #tab)) `unionAll` selectStar (from (table #tab))
334− `unionAll`
335− selectStar (from (table #tab))
336in printSQL query
302in printSQL query
337:}
303:}
338(SELECT * FROM "tab" AS "tab") UNION ALL (SELECT * FROM "tab" AS "tab")
304(SELECT * FROM "tab" AS "tab") UNION ALL (SELECT * FROM "tab" AS "tab")
@@ -341,35 +307,29 @@ with queries:
341
307
342>>> :{
308>>> :{
343let
309let
344− query :: Query
310+ query :: Query (DBof (Public Schema)) '[] '["col1" ::: 'NotNull 'PGint4, "col2" ::: 'NotNull 'PGint4]
345− '[ "t1" ::: 'View
346− '[ "c1" ::: 'NotNull 'PGtext
347− , "c2" ::: 'NotNull 'PGtext] ]
348− '[]
349− '[ "c1" ::: 'NotNull 'PGtext
350− , "c2" ::: 'NotNull 'PGtext ]
351 query = with (
311 query = with (
352− selectStar (from (view #t1)) `as` #t2 :>>
312+ selectStar (from (table #tab)) `as` #cte1 :>>
353− selectStar (from (view #t2)) `as` #t3
313+ selectStar (from (common #cte1)) `as` #cte2
354− ) (selectStar (from (view #t3)))
314+ ) (selectStar (from (common #cte2)))
355in printSQL query
315in printSQL query
356:}
316:}
357−WITH "t2" AS (SELECT * FROM "t1" AS "t1"), "t3" AS (SELECT * FROM "t2" AS "t2") SELECT * FROM "t3" AS "t3"
317+WITH "cte1" AS (SELECT * FROM "tab" AS "tab"), "cte2" AS (SELECT * FROM "cte1" AS "cte1") SELECT * FROM "cte2" AS "cte2"
358-}
318-}
359newtype Query
319newtype Query
360− (schema :: SchemaType)
320+ (db :: DBType)
361 (params :: [NullityType])
321 (params :: [NullityType])
362 (columns :: RowType)
322 (columns :: RowType)
363 = UnsafeQuery { renderQuery :: ByteString }
323 = UnsafeQuery { renderQuery :: ByteString }
364 deriving (GHC.Generic,Show,Eq,Ord,NFData)
324 deriving (GHC.Generic,Show,Eq,Ord,NFData)
365−instance RenderSQL (Query schema params columns) where renderSQL = renderQuery
325+instance RenderSQL (Query db params columns) where renderSQL = renderQuery
366
326
367-- | The results of two queries can be combined using the set operation
327-- | The results of two queries can be combined using the set operation
368-- `union`. Duplicate rows are eliminated.
328-- `union`. Duplicate rows are eliminated.
369union
329union
370− :: Query schema params columns
330+ :: Query db params columns
371− -> Query schema params columns
331+ -> Query db params columns
372− -> Query schema params columns
332+ -> Query db params columns
373q1 `union` q2 = UnsafeQuery $
333q1 `union` q2 = UnsafeQuery $
374 parenthesized (renderQuery q1)
334 parenthesized (renderQuery q1)
375 <+> "UNION"
335 <+> "UNION"
@@ -378,9 +338,9 @@ q1 `union` q2 = UnsafeQuery $
378-- | The results of two queries can be combined using the set operation
338-- | The results of two queries can be combined using the set operation
379-- `unionAll`, the disjoint union. Duplicate rows are retained.
339-- `unionAll`, the disjoint union. Duplicate rows are retained.
380unionAll
340unionAll
381− :: Query schema params columns
341+ :: Query db params columns
382− -> Query schema params columns
342+ -> Query db params columns
383− -> Query schema params columns
343+ -> Query db params columns
384q1 `unionAll` q2 = UnsafeQuery $
344q1 `unionAll` q2 = UnsafeQuery $
385 parenthesized (renderQuery q1)
345 parenthesized (renderQuery q1)
386 <+> "UNION" <+> "ALL"
346 <+> "UNION" <+> "ALL"
@@ -389,9 +349,9 @@ q1 `unionAll` q2 = UnsafeQuery $
389-- | The results of two queries can be combined using the set operation
349-- | The results of two queries can be combined using the set operation
390-- `intersect`, the intersection. Duplicate rows are eliminated.
350-- `intersect`, the intersection. Duplicate rows are eliminated.
391intersect
351intersect
392− :: Query schema params columns
352+ :: Query db params columns
393− -> Query schema params columns
353+ -> Query db params columns
394− -> Query schema params columns
354+ -> Query db params columns
395q1 `intersect` q2 = UnsafeQuery $
355q1 `intersect` q2 = UnsafeQuery $
396 parenthesized (renderQuery q1)
356 parenthesized (renderQuery q1)
397 <+> "INTERSECT"
357 <+> "INTERSECT"
@@ -400,9 +360,9 @@ q1 `intersect` q2 = UnsafeQuery $
400-- | The results of two queries can be combined using the set operation
360-- | The results of two queries can be combined using the set operation
401-- `intersectAll`, the intersection. Duplicate rows are retained.
361-- `intersectAll`, the intersection. Duplicate rows are retained.
402intersectAll
362intersectAll
403− :: Query schema params columns
363+ :: Query db params columns
404− -> Query schema params columns
364+ -> Query db params columns
405− -> Query schema params columns
365+ -> Query db params columns
406q1 `intersectAll` q2 = UnsafeQuery $
366q1 `intersectAll` q2 = UnsafeQuery $
407 parenthesized (renderQuery q1)
367 parenthesized (renderQuery q1)
408 <+> "INTERSECT" <+> "ALL"
368 <+> "INTERSECT" <+> "ALL"
@@ -411,9 +371,9 @@ q1 `intersectAll` q2 = UnsafeQuery $
411-- | The results of two queries can be combined using the set operation
371-- | The results of two queries can be combined using the set operation
412-- `except`, the set difference. Duplicate rows are eliminated.
372-- `except`, the set difference. Duplicate rows are eliminated.
413except
373except
414− :: Query schema params columns
374+ :: Query db params columns
415− -> Query schema params columns
375+ -> Query db params columns
416− -> Query schema params columns
376+ -> Query db params columns
417q1 `except` q2 = UnsafeQuery $
377q1 `except` q2 = UnsafeQuery $
418 parenthesized (renderQuery q1)
378 parenthesized (renderQuery q1)
419 <+> "EXCEPT"
379 <+> "EXCEPT"
@@ -422,9 +382,9 @@ q1 `except` q2 = UnsafeQuery $
422-- | The results of two queries can be combined using the set operation
382-- | The results of two queries can be combined using the set operation
423-- `exceptAll`, the set difference. Duplicate rows are retained.
383-- `exceptAll`, the set difference. Duplicate rows are retained.
424exceptAll
384exceptAll
425− :: Query schema params columns
385+ :: Query db params columns
426− -> Query schema params columns
386+ -> Query db params columns
427− -> Query schema params columns
387+ -> Query db params columns
428q1 `exceptAll` q2 = UnsafeQuery $
388q1 `exceptAll` q2 = UnsafeQuery $
429 parenthesized (renderQuery q1)
389 parenthesized (renderQuery q1)
430 <+> "EXCEPT" <+> "ALL"
390 <+> "EXCEPT" <+> "ALL"
@@ -440,12 +400,12 @@ SELECT queries
440-- the select list. The select list determines which columns of
400-- the select list. The select list determines which columns of
441-- the intermediate table are actually output.
401-- the intermediate table are actually output.
442select
402select
443− :: SListI columns
403+ :: (SListI columns, columns ~ (col ': cols))
444− => NP (Aliased (Expression schema from grouping params)) (column ': columns)
404+ => NP (Aliased (Expression db from grouping params)) columns
445 -- ^ select list
405 -- ^ select list
446− -> TableExpression schema params from grouping
406+ -> TableExpression db params from grouping
447 -- ^ intermediate virtual table
407 -- ^ intermediate virtual table
448− -> Query schema params (column ': columns)
408+ -> Query db params columns
449select list rels = UnsafeQuery $
409select list rels = UnsafeQuery $
450 "SELECT"
410 "SELECT"
451 <+> renderCommaSeparated (renderAliasedAs renderExpression) list
411 <+> renderCommaSeparated (renderAliasedAs renderExpression) list
@@ -454,12 +414,12 @@ select list rels = UnsafeQuery $
454-- | After the select list has been processed, the result table can
414-- | After the select list has been processed, the result table can
455-- be subject to the elimination of duplicate rows using `selectDistinct`.
415-- be subject to the elimination of duplicate rows using `selectDistinct`.
456selectDistinct
416selectDistinct
457− :: SListI columns
417+ :: (SListI columns, columns ~ (col ': cols))
458− => NP (Aliased (Expression schema from 'Ungrouped params)) (column ': columns)
418+ => NP (Aliased (Expression db from 'Ungrouped params)) columns
459 -- ^ select list
419 -- ^ select list
460− -> TableExpression schema params from 'Ungrouped
420+ -> TableExpression db params from 'Ungrouped
461 -- ^ intermediate virtual table
421 -- ^ intermediate virtual table
462− -> Query schema params (column ': columns)
422+ -> Query db params columns
463selectDistinct list rels = UnsafeQuery $
423selectDistinct list rels = UnsafeQuery $
464 "SELECT DISTINCT"
424 "SELECT DISTINCT"
465 <+> renderCommaSeparated (renderAliasedAs renderExpression) list
425 <+> renderCommaSeparated (renderAliasedAs renderExpression) list
@@ -469,18 +429,18 @@ selectDistinct list rels = UnsafeQuery $
469-- that the table expression produces.
429-- that the table expression produces.
470selectStar
430selectStar
471 :: HasUnique table from columns
431 :: HasUnique table from columns
472− => TableExpression schema params from 'Ungrouped
432+ => TableExpression db params from 'Ungrouped
473 -- ^ intermediate virtual table
433 -- ^ intermediate virtual table
474− -> Query schema params columns
434+ -> Query db params columns
475selectStar rels = UnsafeQuery $ "SELECT" <+> "*" <+> renderTableExpression rels
435selectStar rels = UnsafeQuery $ "SELECT" <+> "*" <+> renderTableExpression rels
476
436
477-- | A `selectDistinctStar` emits all columns that the table expression
437-- | A `selectDistinctStar` emits all columns that the table expression
478-- produces and eliminates duplicate rows.
438-- produces and eliminates duplicate rows.
479selectDistinctStar
439selectDistinctStar
480 :: HasUnique table from columns
440 :: HasUnique table from columns
481− => TableExpression schema params from 'Ungrouped
441+ => TableExpression db params from 'Ungrouped
482 -- ^ intermediate virtual table
442 -- ^ intermediate virtual table
483− -> Query schema params columns
443+ -> Query db params columns
484selectDistinctStar rels = UnsafeQuery $
444selectDistinctStar rels = UnsafeQuery $
485 "SELECT DISTINCT" <+> "*" <+> renderTableExpression rels
445 "SELECT DISTINCT" <+> "*" <+> renderTableExpression rels
486
446
@@ -490,9 +450,9 @@ selectDotStar
490 :: Has table from columns
450 :: Has table from columns
491 => Alias table
451 => Alias table
492 -- ^ particular virtual subtable
452 -- ^ particular virtual subtable
493− -> TableExpression schema params from 'Ungrouped
453+ -> TableExpression db params from 'Ungrouped
494 -- ^ intermediate virtual table
454 -- ^ intermediate virtual table
495− -> Query schema params columns
455+ -> Query db params columns
496selectDotStar rel tab = UnsafeQuery $
456selectDotStar rel tab = UnsafeQuery $
497 "SELECT" <+> renderAlias rel <> ".*" <+> renderTableExpression tab
457 "SELECT" <+> renderAlias rel <> ".*" <+> renderTableExpression tab
498
458
@@ -502,9 +462,9 @@ selectDistinctDotStar
502 :: Has table from columns
462 :: Has table from columns
503 => Alias table
463 => Alias table
504 -- ^ particular virtual table
464 -- ^ particular virtual table
505− -> TableExpression schema params from 'Ungrouped
465+ -> TableExpression db params from 'Ungrouped
506 -- ^ intermediate virtual table
466 -- ^ intermediate virtual table
507− -> Query schema params columns
467+ -> Query db params columns
508selectDistinctDotStar rel tab = UnsafeQuery $
468selectDistinctDotStar rel tab = UnsafeQuery $
509 "SELECT DISTINCT" <+> renderAlias rel <> ".*"
469 "SELECT DISTINCT" <+> renderAlias rel <> ".*"
510 <+> renderTableExpression tab
470 <+> renderTableExpression tab
@@ -515,16 +475,16 @@ selectDistinctDotStar rel tab = UnsafeQuery $
515-- but it can be used on its own.
475-- but it can be used on its own.
516--
476--
517-- >>> type Row = '["a" ::: 'NotNull 'PGint4, "b" ::: 'NotNull 'PGtext]
477-- >>> type Row = '["a" ::: 'NotNull 'PGint4, "b" ::: 'NotNull 'PGtext]
518−-- >>> let query = values (1 `as` #a :* "one" `as` #b) [] :: Query '[] '[] Row
478+-- >>> let query = values (1 `as` #a :* "one" `as` #b) [] :: Query db '[] Row
519-- >>> printSQL query
479-- >>> printSQL query
520-- SELECT * FROM (VALUES (1, E'one')) AS t ("a", "b")
480-- SELECT * FROM (VALUES (1, E'one')) AS t ("a", "b")
521values
481values
522 :: SListI cols
482 :: SListI cols
523− => NP (Aliased (Expression schema '[] 'Ungrouped params)) cols
483+ => NP (Aliased (Expression db '[] 'Ungrouped params)) cols
524− -> [NP (Aliased (Expression schema '[] 'Ungrouped params)) cols]
484+ -> [NP (Aliased (Expression db '[] 'Ungrouped params)) cols]
525 -- ^ When more than one row is specified, all the rows must
485 -- ^ When more than one row is specified, all the rows must
526 -- must have the same number of elements
486 -- must have the same number of elements
527− -> Query schema params cols
487+ -> Query db params cols
528values rw rws = UnsafeQuery $ "SELECT * FROM"
488values rw rws = UnsafeQuery $ "SELECT * FROM"
529 <+> parenthesized (
489 <+> parenthesized (
530 "VALUES"
490 "VALUES"
@@ -535,7 +495,7 @@ values rw rws = UnsafeQuery $ "SELECT * FROM"
535 <+> parenthesized (renderCommaSeparated renderAliasPart rw)
495 <+> parenthesized (renderCommaSeparated renderAliasPart rw)
536 where
496 where
537 renderAliasPart, renderValuePart
497 renderAliasPart, renderValuePart
538− :: Aliased (Expression schema '[] 'Ungrouped params) ty -> ByteString
498+ :: Aliased (Expression db '[] 'Ungrouped params) ty -> ByteString
539 renderAliasPart (_ `As` name) = renderAlias name
499 renderAliasPart (_ `As` name) = renderAlias name
540 renderValuePart (value `As` _) = renderExpression value
500 renderValuePart (value `As` _) = renderExpression value
541
501
@@ -543,9 +503,9 @@ values rw rws = UnsafeQuery $ "SELECT * FROM"
543-- specified by value expressions.
503-- specified by value expressions.
544values_
504values_
545 :: SListI cols
505 :: SListI cols
546− => NP (Aliased (Expression schema '[] 'Ungrouped params)) cols
506+ => NP (Aliased (Expression db '[] 'Ungrouped params)) cols
547 -- ^ one row of values
507 -- ^ one row of values
548− -> Query schema params cols
508+ -> Query db params cols
549values_ rw = values rw []
509values_ rw = values rw []
550
510
551{-----------------------------------------
511{-----------------------------------------
@@ -559,15 +519,15 @@ Table Expressions
559-- to a table on disk, a so-called base table, but more complex expressions
519-- to a table on disk, a so-called base table, but more complex expressions
560-- can be used to modify or combine base tables in various ways.
520-- can be used to modify or combine base tables in various ways.
561data TableExpression
521data TableExpression
562− (schema :: SchemaType)
522+ (db :: DBType)
563 (params :: [NullityType])
523 (params :: [NullityType])
564 (from :: FromType)
524 (from :: FromType)
565 (grouping :: Grouping)
525 (grouping :: Grouping)
566 = TableExpression
526 = TableExpression
567− { fromClause :: FromClause schema params from
527+ { fromClause :: FromClause db params from
568 -- ^ A table reference that can be a table name, or a derived table such
528 -- ^ A table reference that can be a table name, or a derived table such
569 -- as a subquery, a @JOIN@ construct, or complex combinations of these.
529 -- as a subquery, a @JOIN@ construct, or complex combinations of these.
570− , whereClause :: [Condition schema from 'Ungrouped params]
530+ , whereClause :: [Condition db from 'Ungrouped params]
571 -- ^ optional search coditions, combined with `.&&`. After the processing
531 -- ^ optional search coditions, combined with `.&&`. After the processing
572 -- of the `fromClause` is done, each row of the derived virtual table
532 -- of the `fromClause` is done, each row of the derived virtual table
573 -- is checked against the search condition. If the result of the
533 -- is checked against the search condition. If the result of the
@@ -583,13 +543,13 @@ data TableExpression
583 -- set of rows having common values into one group row that represents all
543 -- set of rows having common values into one group row that represents all
584 -- rows in the group. This is done to eliminate redundancy in the output
544 -- rows in the group. This is done to eliminate redundancy in the output
585 -- and/or compute aggregates that apply to these groups.
545 -- and/or compute aggregates that apply to these groups.
586− , havingClause :: HavingClause schema from grouping params
546+ , havingClause :: HavingClause db from grouping params
587 -- ^ If a table has been grouped using `groupBy`, but only certain groups
547 -- ^ If a table has been grouped using `groupBy`, but only certain groups
588 -- are of interest, the `havingClause` can be used, much like a
548 -- are of interest, the `havingClause` can be used, much like a
589 -- `whereClause`, to eliminate groups from the result. Expressions in the
549 -- `whereClause`, to eliminate groups from the result. Expressions in the
590 -- `havingClause` can refer both to grouped expressions and to ungrouped
550 -- `havingClause` can refer both to grouped expressions and to ungrouped
591 -- expressions (which necessarily involve an aggregate function).
551 -- expressions (which necessarily involve an aggregate function).
592− , orderByClause :: [SortExpression schema from grouping params]
552+ , orderByClause :: [SortExpression db from grouping params]
593 -- ^ The `orderByClause` is for optional sorting. When more than one
553 -- ^ The `orderByClause` is for optional sorting. When more than one
594 -- `SortExpression` is specified, the later (right) values are used to sort
554 -- `SortExpression` is specified, the later (right) values are used to sort
595 -- rows that are equal according to the earlier (left) values.
555 -- rows that are equal according to the earlier (left) values.
@@ -607,7 +567,7 @@ data TableExpression
607
567
608-- | Render a `TableExpression`
568-- | Render a `TableExpression`
609renderTableExpression
569renderTableExpression
610− :: TableExpression schema params from grouping
570+ :: TableExpression db params from grouping
611 -> ByteString
571 -> ByteString
612renderTableExpression
572renderTableExpression
613 (TableExpression frm' whs' grps' hvs' srts' lims' offs') = mconcat
573 (TableExpression frm' whs' grps' hvs' srts' lims' offs') = mconcat
@@ -641,16 +601,16 @@ renderTableExpression
641-- `group`, `having`, `orderBy`, `limit` and `offset`, using the `&` operator
601-- `group`, `having`, `orderBy`, `limit` and `offset`, using the `&` operator
642-- to match the left-to-right sequencing of their placement in SQL.
602-- to match the left-to-right sequencing of their placement in SQL.
643from
603from
644− :: FromClause schema params from -- ^ table reference
604+ :: FromClause db params from -- ^ table reference
645− -> TableExpression schema params from 'Ungrouped
605+ -> TableExpression db params from 'Ungrouped
646from rels = TableExpression rels [] NoGroups NoHaving [] [] []
606from rels = TableExpression rels [] NoGroups NoHaving [] [] []
647
607
648-- | A `where_` is an endomorphism of `TableExpression`s which adds a
608-- | A `where_` is an endomorphism of `TableExpression`s which adds a
649-- search condition to the `whereClause`.
609-- search condition to the `whereClause`.
650where_
610where_
651− :: Condition schema from 'Ungrouped params -- ^ filtering condition
611+ :: Condition db from 'Ungrouped params -- ^ filtering condition
652− -> TableExpression schema params from grouping
612+ -> TableExpression db params from grouping
653− -> TableExpression schema params from grouping
613+ -> TableExpression db params from grouping
654where_ wh rels = rels {whereClause = wh : whereClause rels}
614where_ wh rels = rels {whereClause = wh : whereClause rels}
655
615
656-- | A `groupBy` is a transformation of `TableExpression`s which switches
616-- | A `groupBy` is a transformation of `TableExpression`s which switches
@@ -659,8 +619,8 @@ where_ wh rels = rels {whereClause = wh : whereClause rels}
659groupBy
619groupBy
660 :: SListI bys
620 :: SListI bys
661 => NP (By from) bys -- ^ grouped columns
621 => NP (By from) bys -- ^ grouped columns
662− -> TableExpression schema params from 'Ungrouped
622+ -> TableExpression db params from 'Ungrouped
663− -> TableExpression schema params from ('Grouped bys)
623+ -> TableExpression db params from ('Grouped bys)
664groupBy bys rels = TableExpression
624groupBy bys rels = TableExpression
665 { fromClause = fromClause rels
625 { fromClause = fromClause rels
666 , whereClause = whereClause rels
626 , whereClause = whereClause rels
@@ -674,34 +634,34 @@ groupBy bys rels = TableExpression
674-- | A `having` is an endomorphism of `TableExpression`s which adds a
634-- | A `having` is an endomorphism of `TableExpression`s which adds a
675-- search condition to the `havingClause`.
635-- search condition to the `havingClause`.
676having
636having
677− :: Condition schema from ('Grouped bys) params -- ^ having condition
637+ :: Condition db from ('Grouped bys) params -- ^ having condition
678− -> TableExpression schema params from ('Grouped bys)
638+ -> TableExpression db params from ('Grouped bys)
679− -> TableExpression schema params from ('Grouped bys)
639+ -> TableExpression db params from ('Grouped bys)
680having hv rels = rels
640having hv rels = rels
681 { havingClause = case havingClause rels of Having hvs -> Having (hv:hvs) }
641 { havingClause = case havingClause rels of Having hvs -> Having (hv:hvs) }
682
642
683-- | An `orderBy` is an endomorphism of `TableExpression`s which appends an
643-- | An `orderBy` is an endomorphism of `TableExpression`s which appends an
684-- ordering to the right of the `orderByClause`.
644-- ordering to the right of the `orderByClause`.
685orderBy
645orderBy
686− :: [SortExpression schema from grouping params] -- ^ sort expressions
646+ :: [SortExpression db from grouping params] -- ^ sort expressions
687− -> TableExpression schema params from grouping
647+ -> TableExpression db params from grouping
688− -> TableExpression schema params from grouping
648+ -> TableExpression db params from grouping
689orderBy srts rels = rels {orderByClause = orderByClause rels ++ srts}
649orderBy srts rels = rels {orderByClause = orderByClause rels ++ srts}
690
650
691-- | A `limit` is an endomorphism of `TableExpression`s which adds to the
651-- | A `limit` is an endomorphism of `TableExpression`s which adds to the
692-- `limitClause`.
652-- `limitClause`.
693limit
653limit
694 :: Word64 -- ^ limit parameter
654 :: Word64 -- ^ limit parameter
695− -> TableExpression schema params from grouping
655+ -> TableExpression db params from grouping
696− -> TableExpression schema params from grouping
656+ -> TableExpression db params from grouping
697limit lim rels = rels {limitClause = lim : limitClause rels}
657limit lim rels = rels {limitClause = lim : limitClause rels}
698
658
699-- | An `offset` is an endomorphism of `TableExpression`s which adds to the
659-- | An `offset` is an endomorphism of `TableExpression`s which adds to the
700-- `offsetClause`.
660-- `offsetClause`.
701offset
661offset
702 :: Word64 -- ^ offset parameter
662 :: Word64 -- ^ offset parameter
703− -> TableExpression schema params from grouping
663+ -> TableExpression db params from grouping
704− -> TableExpression schema params from grouping
664+ -> TableExpression db params from grouping
705offset off rels = rels {offsetClause = off : offsetClause rels}
665offset off rels = rels {offsetClause = off : offsetClause rels}
706
666
707{-----------------------------------------
667{-----------------------------------------
@@ -710,56 +670,56 @@ JSON stuff
710
670
711unsafeSetOfFunction
671unsafeSetOfFunction
712 :: ByteString
672 :: ByteString
713− -> Expression schema '[] 'Ungrouped params ty
673+ -> Expression db '[] 'Ungrouped params ty
714− -> Query schema params row
674+ -> Query db params row
715unsafeSetOfFunction fun expr = UnsafeQuery $
675unsafeSetOfFunction fun expr = UnsafeQuery $
716 "SELECT * FROM " <> fun <> "(" <> renderExpression expr <> ")"
676 "SELECT * FROM " <> fun <> "(" <> renderExpression expr <> ")"
717
677
718-- | Expands the outermost JSON object into a set of key/value pairs.
678-- | Expands the outermost JSON object into a set of key/value pairs.
719jsonEach
679jsonEach
720− :: Expression schema '[] 'Ungrouped params (nullity 'PGjson) -- ^ json object
680+ :: Expression db '[] 'Ungrouped params (nullity 'PGjson) -- ^ json object
721− -> Query schema params
681+ -> Query db params
722 '["key" ::: 'NotNull 'PGtext, "value" ::: 'NotNull 'PGjson]
682 '["key" ::: 'NotNull 'PGtext, "value" ::: 'NotNull 'PGjson]
723jsonEach = unsafeSetOfFunction "json_each"
683jsonEach = unsafeSetOfFunction "json_each"
724
684
725-- | Expands the outermost binary JSON object into a set of key/value pairs.
685-- | Expands the outermost binary JSON object into a set of key/value pairs.
726jsonbEach
686jsonbEach
727− :: Expression schema '[] 'Ungrouped params (nullity 'PGjsonb) -- ^ jsonb object
687+ :: Expression db '[] 'Ungrouped params (nullity 'PGjsonb) -- ^ jsonb object
728− -> Query schema params
688+ -> Query db params
729 '["key" ::: 'NotNull 'PGtext, "value" ::: 'NotNull 'PGjsonb]
689 '["key" ::: 'NotNull 'PGtext, "value" ::: 'NotNull 'PGjsonb]
730jsonbEach = unsafeSetOfFunction "jsonb_each"
690jsonbEach = unsafeSetOfFunction "jsonb_each"
731
691
732-- | Expands the outermost JSON object into a set of key/value pairs.
692-- | Expands the outermost JSON object into a set of key/value pairs.
733jsonEachAsText
693jsonEachAsText
734− :: Expression schema '[] 'Ungrouped params (nullity 'PGjson) -- ^ json object
694+ :: Expression db '[] 'Ungrouped params (nullity 'PGjson) -- ^ json object
735− -> Query schema params
695+ -> Query db params
736 '["key" ::: 'NotNull 'PGtext, "value" ::: 'NotNull 'PGtext]
696 '["key" ::: 'NotNull 'PGtext, "value" ::: 'NotNull 'PGtext]
737jsonEachAsText = unsafeSetOfFunction "json_each_text"
697jsonEachAsText = unsafeSetOfFunction "json_each_text"
738
698
739-- | Expands the outermost binary JSON object into a set of key/value pairs.
699-- | Expands the outermost binary JSON object into a set of key/value pairs.
740jsonbEachAsText
700jsonbEachAsText
741− :: Expression schema '[] 'Ungrouped params (nullity 'PGjsonb) -- ^ jsonb object
701+ :: Expression db '[] 'Ungrouped params (nullity 'PGjsonb) -- ^ jsonb object
742− -> Query schema params
702+ -> Query db params
743 '["key" ::: 'NotNull 'PGtext, "value" ::: 'NotNull 'PGtext]
703 '["key" ::: 'NotNull 'PGtext, "value" ::: 'NotNull 'PGtext]
744jsonbEachAsText = unsafeSetOfFunction "jsonb_each_text"
704jsonbEachAsText = unsafeSetOfFunction "jsonb_each_text"
745
705
746-- | Returns set of keys in the outermost JSON object.
706-- | Returns set of keys in the outermost JSON object.
747jsonObjectKeys
707jsonObjectKeys
748− :: Expression schema '[] 'Ungrouped params (nullity 'PGjson) -- ^ json object
708+ :: Expression db '[] 'Ungrouped params (nullity 'PGjson) -- ^ json object
749− -> Query schema params '["json_object_keys" ::: 'NotNull 'PGtext]
709+ -> Query db params '["json_object_keys" ::: 'NotNull 'PGtext]
750jsonObjectKeys = unsafeSetOfFunction "json_object_keys"
710jsonObjectKeys = unsafeSetOfFunction "json_object_keys"
751
711
752-- | Returns set of keys in the outermost JSON object.
712-- | Returns set of keys in the outermost JSON object.
753jsonbObjectKeys
713jsonbObjectKeys
754− :: Expression schema '[] 'Ungrouped params (nullity 'PGjsonb) -- ^ jsonb object
714+ :: Expression db '[] 'Ungrouped params (nullity 'PGjsonb) -- ^ jsonb object
755− -> Query schema params '["jsonb_object_keys" ::: 'NotNull 'PGtext]
715+ -> Query db params '["jsonb_object_keys" ::: 'NotNull 'PGtext]
756jsonbObjectKeys = unsafeSetOfFunction "jsonb_object_keys"
716jsonbObjectKeys = unsafeSetOfFunction "jsonb_object_keys"
757
717
758unsafePopulateFunction
718unsafePopulateFunction
759 :: ByteString
719 :: ByteString
760− -> TypeExpression schema (nullity ('PGcomposite row))
720+ -> TypeExpression schemas (nullity ('PGcomposite row))
761− -> Expression schema '[] 'Ungrouped params ty
721+ -> Expression (commons :=> schemas) '[] 'Ungrouped params ty
762− -> Query schema params row
722+ -> Query (commons :=> schemas) params row
763unsafePopulateFunction fun ty expr = UnsafeQuery $
723unsafePopulateFunction fun ty expr = UnsafeQuery $
764 "SELECT * FROM " <> fun <> "("
724 "SELECT * FROM " <> fun <> "("
765 <> "null::" <> renderTypeExpression ty <> ", "
725 <> "null::" <> renderTypeExpression ty <> ", "
@@ -768,81 +728,81 @@ unsafePopulateFunction fun ty expr = UnsafeQuery $
768-- | Expands the JSON expression to a row whose columns match the record
728-- | Expands the JSON expression to a row whose columns match the record
769-- type defined by the given table.
729-- type defined by the given table.
770jsonPopulateRecord
730jsonPopulateRecord
771− :: TypeExpression schema (nullity ('PGcomposite row)) -- ^ row type
731+ :: TypeExpression schemas (nullity ('PGcomposite row)) -- ^ row type
772− -> Expression schema '[] 'Ungrouped params (nullity 'PGjson) -- ^ json object
732+ -> Expression (commons :=> schemas) '[] 'Ungrouped params (nullity 'PGjson) -- ^ json object
773− -> Query schema params row
733+ -> Query (commons :=> schemas) params row
774jsonPopulateRecord = unsafePopulateFunction "json_populate_record"
734jsonPopulateRecord = unsafePopulateFunction "json_populate_record"
775
735
776-- | Expands the binary JSON expression to a row whose columns match the record
736-- | Expands the binary JSON expression to a row whose columns match the record
777-- type defined by the given table.
737-- type defined by the given table.
778jsonbPopulateRecord
738jsonbPopulateRecord
779− :: TypeExpression schema (nullity ('PGcomposite row)) -- ^ row type
739+ :: TypeExpression schemas (nullity ('PGcomposite row)) -- ^ row type
780− -> Expression schema '[] 'Ungrouped params (nullity 'PGjsonb) -- ^ jsonb object
740+ -> Expression (commons :=> schemas) '[] 'Ungrouped params (nullity 'PGjsonb) -- ^ jsonb object
781− -> Query schema params row
741+ -> Query (commons :=> schemas) params row
782jsonbPopulateRecord = unsafePopulateFunction "jsonb_populate_record"
742jsonbPopulateRecord = unsafePopulateFunction "jsonb_populate_record"
783
743
784-- | Expands the outermost array of objects in the given JSON expression to a
744-- | Expands the outermost array of objects in the given JSON expression to a
785-- set of rows whose columns match the record type defined by the given table.
745-- set of rows whose columns match the record type defined by the given table.
786jsonPopulateRecordSet
746jsonPopulateRecordSet
787− :: TypeExpression schema (nullity ('PGcomposite row)) -- ^ row type
747+ :: TypeExpression schemas (nullity ('PGcomposite row)) -- ^ row type
788− -> Expression schema '[] 'Ungrouped params (nullity 'PGjson) -- ^ json array
748+ -> Expression (commons :=> schemas) '[] 'Ungrouped params (nullity 'PGjson) -- ^ json array
789− -> Query schema params row
749+ -> Query (commons :=> schemas) params row
790jsonPopulateRecordSet = unsafePopulateFunction "json_populate_record_set"
750jsonPopulateRecordSet = unsafePopulateFunction "json_populate_record_set"
791
751
792-- | Expands the outermost array of objects in the given binary JSON expression
752-- | Expands the outermost array of objects in the given binary JSON expression
793-- to a set of rows whose columns match the record type defined by the given
753-- to a set of rows whose columns match the record type defined by the given
794-- table.
754-- table.
795jsonbPopulateRecordSet
755jsonbPopulateRecordSet
796− :: TypeExpression schema (nullity ('PGcomposite row)) -- ^ row type
756+ :: TypeExpression schemas (nullity ('PGcomposite row)) -- ^ row type
797− -> Expression schema '[] 'Ungrouped params (nullity 'PGjsonb) -- ^ jsonb array
757+ -> Expression (commons :=> schemas) '[] 'Ungrouped params (nullity 'PGjsonb) -- ^ jsonb array
798− -> Query schema params row
758+ -> Query (commons :=> schemas) params row
799jsonbPopulateRecordSet = unsafePopulateFunction "jsonb_populate_record_set"
759jsonbPopulateRecordSet = unsafePopulateFunction "jsonb_populate_record_set"
800
760
801unsafeRecordFunction
761unsafeRecordFunction
802 :: (SListI record, json `In` PGJsonType)
762 :: (SListI record, json `In` PGJsonType)
803 => ByteString
763 => ByteString
804− -> Expression schema '[] 'Ungrouped params (nullity json)
764+ -> Expression (commons :=> schemas) '[] 'Ungrouped params (nullity json)
805− -> NP (Aliased (TypeExpression schema)) record
765+ -> NP (Aliased (TypeExpression schemas)) record
806− -> Query schema params record
766+ -> Query (commons :=> schemas) params record
807unsafeRecordFunction fun expr types = UnsafeQuery $
767unsafeRecordFunction fun expr types = UnsafeQuery $
808 "SELECT * FROM " <> fun <> "("
768 "SELECT * FROM " <> fun <> "("
809 <> renderExpression expr <> ")"
769 <> renderExpression expr <> ")"
810 <+> "AS" <+> "x" <> parenthesized (renderCommaSeparated renderTy types)
770 <+> "AS" <+> "x" <> parenthesized (renderCommaSeparated renderTy types)
811 where
771 where
812− renderTy :: Aliased (TypeExpression schema) ty -> ByteString
772+ renderTy :: Aliased (TypeExpression db) ty -> ByteString
813 renderTy (ty `As` alias) =
773 renderTy (ty `As` alias) =
814 renderAlias alias <+> renderTypeExpression ty
774 renderAlias alias <+> renderTypeExpression ty
815
775
816-- | Builds an arbitrary record from a JSON object.
776-- | Builds an arbitrary record from a JSON object.
817jsonToRecord
777jsonToRecord
818 :: SListI record
778 :: SListI record
819− => Expression schema '[] 'Ungrouped params (nullity 'PGjson) -- ^ json object
779+ => Expression (commons :=> schemas) '[] 'Ungrouped params (nullity 'PGjson) -- ^ json object
820− -> NP (Aliased (TypeExpression schema)) record -- ^ record types
780+ -> NP (Aliased (TypeExpression schemas)) record -- ^ record types
821− -> Query schema params record
781+ -> Query (commons :=> schemas) params record
822jsonToRecord = unsafeRecordFunction "json_to_record"
782jsonToRecord = unsafeRecordFunction "json_to_record"
823
783
824-- | Builds an arbitrary record from a binary JSON object.
784-- | Builds an arbitrary record from a binary JSON object.
825jsonbToRecord
785jsonbToRecord
826 :: SListI record
786 :: SListI record
827− => Expression schema '[] 'Ungrouped params (nullity 'PGjsonb) -- ^ jsonb object
787+ => Expression (commons :=> schemas) '[] 'Ungrouped params (nullity 'PGjsonb) -- ^ jsonb object
828− -> NP (Aliased (TypeExpression schema)) record -- ^ record types
788+ -> NP (Aliased (TypeExpression schemas)) record -- ^ record types
829− -> Query schema params record
789+ -> Query (commons :=> schemas) params record
830jsonbToRecord = unsafeRecordFunction "jsonb_to_record"
790jsonbToRecord = unsafeRecordFunction "jsonb_to_record"
831
791
832-- | Builds an arbitrary set of records from a JSON array of objects.
792-- | Builds an arbitrary set of records from a JSON array of objects.
833jsonToRecordSet
793jsonToRecordSet
834 :: SListI record
794 :: SListI record
835− => Expression schema '[] 'Ungrouped params (nullity 'PGjson) -- ^ json array
795+ => Expression (commons :=> schemas) '[] 'Ungrouped params (nullity 'PGjson) -- ^ json array
836− -> NP (Aliased (TypeExpression schema)) record -- ^ record types
796+ -> NP (Aliased (TypeExpression schemas)) record -- ^ record types
837− -> Query schema params record
797+ -> Query (commons :=> schemas) params record
838jsonToRecordSet = unsafeRecordFunction "json_to_record_set"
798jsonToRecordSet = unsafeRecordFunction "json_to_record_set"
839
799
840-- | Builds an arbitrary set of records from a binary JSON array of objects.
800-- | Builds an arbitrary set of records from a binary JSON array of objects.
841jsonbToRecordSet
801jsonbToRecordSet
842 :: SListI record
802 :: SListI record
843− => Expression schema '[] 'Ungrouped params (nullity 'PGjsonb) -- ^ jsonb array
803+ => Expression (commons :=> schemas) '[] 'Ungrouped params (nullity 'PGjsonb) -- ^ jsonb array
844− -> NP (Aliased (TypeExpression schema)) record -- ^ record types
804+ -> NP (Aliased (TypeExpression schemas)) record -- ^ record types
845− -> Query schema params record
805+ -> Query (commons :=> schemas) params record
846jsonbToRecordSet = unsafeRecordFunction "jsonb_to_record_set"
806jsonbToRecordSet = unsafeRecordFunction "jsonb_to_record_set"
847
807
848{-----------------------------------------
808{-----------------------------------------
@@ -853,31 +813,38 @@ FROM clauses
853A `FromClause` can be a table name, or a derived table such
813A `FromClause` can be a table name, or a derived table such
854as a subquery, a @JOIN@ construct, or complex combinations of these.
814as a subquery, a @JOIN@ construct, or complex combinations of these.
855-}
815-}
856−newtype FromClause schema params from
816+newtype FromClause db params from
857 = UnsafeFromClause { renderFromClause :: ByteString }
817 = UnsafeFromClause { renderFromClause :: ByteString }
858 deriving (GHC.Generic,Show,Eq,Ord,NFData)
818 deriving (GHC.Generic,Show,Eq,Ord,NFData)
859
819
860−-- | A real `table` is a table from the schema.
820+-- | A real `table` is a table from the database.
861table
821table
862− :: Has tab schema ('Table table)
822+ :: (Has sch schemas schema, Has tab schema ('Table table))
863− => Aliased Alias (alias ::: tab)
823+ => Aliased (QualifiedAlias sch) (alias ::: tab)
864− -> FromClause schema params '[alias ::: TableToRow table]
824+ -> FromClause (commons :=> schemas) params '[alias ::: TableToRow table]
865table (tab `As` alias) = UnsafeFromClause $
825table (tab `As` alias) = UnsafeFromClause $
866− renderAlias tab <+> "AS" <+> renderAlias alias
826+ renderQualifiedAlias tab <+> "AS" <+> renderAlias alias
867
827
868-- | `subquery` derives a table from a `Query`.
828-- | `subquery` derives a table from a `Query`.
869subquery
829subquery
870− :: Aliased (Query schema params) rel
830+ :: Aliased (Query db params) query
871− -> FromClause schema params '[rel]
831+ -> FromClause db params '[query]
872subquery = UnsafeFromClause . renderAliasedAs (parenthesized . renderQuery)
832subquery = UnsafeFromClause . renderAliasedAs (parenthesized . renderQuery)
873
833
874-- | `view` derives a table from a `View`.
834-- | `view` derives a table from a `View`.
875view
835view
876− :: Has view schema ('View row)
836+ :: (Has sch schemas schema, Has vw schema ('View view))
877− => Aliased Alias (alias ::: view)
837+ => Aliased (QualifiedAlias sch) (alias ::: vw)
878− -> FromClause schema params '[alias ::: row]
838+ -> FromClause (commons :=> schemas) params '[alias ::: view]
879view (vw `As` alias) = UnsafeFromClause $
839view (vw `As` alias) = UnsafeFromClause $
880− renderAlias vw <+> "AS" <+> renderAlias alias
840+ renderQualifiedAlias vw <+> "AS" <+> renderAlias alias
841+
842+common
843+ :: Has cte commons common
844+ => Aliased Alias (alias ::: cte)
845+ -> FromClause (commons :=> schemas) params '[alias ::: common]
846+common (cte `As` alias) = UnsafeFromClause $
847+ renderAlias cte <+> "AS" <+> renderAlias alias
881
848
882{- | @left & crossJoin right@. For every possible combination of rows from
849{- | @left & crossJoin right@. For every possible combination of rows from
883 @left@ and @right@ (i.e., a Cartesian product), the joined table will contain
850 @left@ and @right@ (i.e., a Cartesian product), the joined table will contain
@@ -886,11 +853,11 @@ view (vw `As` alias) = UnsafeFromClause $
886 have @n * m@ rows.
853 have @n * m@ rows.
887-}
854-}
888crossJoin
855crossJoin
889− :: FromClause schema params right
856+ :: FromClause db params right
890 -- ^ right
857 -- ^ right
891− -> FromClause schema params left
858+ -> FromClause db params left
892 -- ^ left
859 -- ^ left
893− -> FromClause schema params (Join left right)
860+ -> FromClause db params (Join left right)
894crossJoin right left = UnsafeFromClause $
861crossJoin right left = UnsafeFromClause $
895 renderFromClause left <+> "CROSS JOIN" <+> renderFromClause right
862 renderFromClause left <+> "CROSS JOIN" <+> renderFromClause right
896
863
@@ -898,13 +865,13 @@ crossJoin right left = UnsafeFromClause $
898the @on@ condition.
865the @on@ condition.
899-}
866-}
900innerJoin
867innerJoin
901− :: FromClause schema params right
868+ :: FromClause db params right
902 -- ^ right
869 -- ^ right
903− -> Condition schema (Join left right) 'Ungrouped params
870+ -> Condition db (Join left right) 'Ungrouped params
904 -- ^ @on@ condition
871 -- ^ @on@ condition
905− -> FromClause schema params left
872+ -> FromClause db params left
906 -- ^ left
873 -- ^ left
907− -> FromClause schema params (Join left right)
874+ -> FromClause db params (Join left right)
908innerJoin right on left = UnsafeFromClause $
875innerJoin right on left = UnsafeFromClause $
909 renderFromClause left <+> "INNER JOIN" <+> renderFromClause right
876 renderFromClause left <+> "INNER JOIN" <+> renderFromClause right
910 <+> "ON" <+> renderExpression on
877 <+> "ON" <+> renderExpression on
@@ -915,13 +882,13 @@ innerJoin right on left = UnsafeFromClause $
915 Thus, the joined table always has at least one row for each row in @left@.
882 Thus, the joined table always has at least one row for each row in @left@.
916-}
883-}
917leftOuterJoin
884leftOuterJoin
918− :: FromClause schema params right
885+ :: FromClause db params right
919 -- ^ right
886 -- ^ right
920− -> Condition schema (Join left right) 'Ungrouped params
887+ -> Condition db (Join left right) 'Ungrouped params
921 -- ^ @on@ condition
888 -- ^ @on@ condition
922− -> FromClause schema params left
889+ -> FromClause db params left
923 -- ^ left
890 -- ^ left
924− -> FromClause schema params (Join left (NullifyFrom right))
891+ -> FromClause db params (Join left (NullifyFrom right))
925leftOuterJoin right on left = UnsafeFromClause $
892leftOuterJoin right on left = UnsafeFromClause $
926 renderFromClause left <+> "LEFT OUTER JOIN" <+> renderFromClause right
893 renderFromClause left <+> "LEFT OUTER JOIN" <+> renderFromClause right
927 <+> "ON" <+> renderExpression on
894 <+> "ON" <+> renderExpression on
@@ -933,13 +900,13 @@ leftOuterJoin right on left = UnsafeFromClause $
933 have a row for each row in @right@.
900 have a row for each row in @right@.
934-}
901-}
935rightOuterJoin
902rightOuterJoin
936− :: FromClause schema params right
903+ :: FromClause db params right
937 -- ^ right
904 -- ^ right
938− -> Condition schema (Join left right) 'Ungrouped params
905+ -> Condition db (Join left right) 'Ungrouped params
939 -- ^ @on@ condition
906 -- ^ @on@ condition
940− -> FromClause schema params left
907+ -> FromClause db params left
941 -- ^ left
908 -- ^ left
942− -> FromClause schema params (Join (NullifyFrom left) right)
909+ -> FromClause db params (Join (NullifyFrom left) right)
943rightOuterJoin right on left = UnsafeFromClause $
910rightOuterJoin right on left = UnsafeFromClause $
944 renderFromClause left <+> "RIGHT OUTER JOIN" <+> renderFromClause right
911 renderFromClause left <+> "RIGHT OUTER JOIN" <+> renderFromClause right
945 <+> "ON" <+> renderExpression on
912 <+> "ON" <+> renderExpression on
@@ -952,13 +919,13 @@ rightOuterJoin right on left = UnsafeFromClause $
952 is added.
919 is added.
953-}
920-}
954fullOuterJoin
921fullOuterJoin
955− :: FromClause schema params right
922+ :: FromClause db params right
956 -- ^ right
923 -- ^ right
957− -> Condition schema (Join left right) 'Ungrouped params
924+ -> Condition db (Join left right) 'Ungrouped params
958 -- ^ @on@ condition
925 -- ^ @on@ condition
959− -> FromClause schema params left
926+ -> FromClause db params left
960 -- ^ left
927 -- ^ left
961− -> FromClause schema params
928+ -> FromClause db params
962 (Join (NullifyFrom left) (NullifyFrom right))
929 (Join (NullifyFrom left) (NullifyFrom right))
963fullOuterJoin right on left = UnsafeFromClause $
930fullOuterJoin right on left = UnsafeFromClause $
964 renderFromClause left <+> "FULL OUTER JOIN" <+> renderFromClause right
931 renderFromClause left <+> "FULL OUTER JOIN" <+> renderFromClause right
@@ -1029,17 +996,17 @@ renderGroupByClause = \case
1029-- An `Ungrouped` `TableExpression` may only use `NoHaving` while a `Grouped`
996-- An `Ungrouped` `TableExpression` may only use `NoHaving` while a `Grouped`
1030-- `TableExpression` must use `Having` whose conditions are combined with
997-- `TableExpression` must use `Having` whose conditions are combined with
1031-- `.&&`.
998-- `.&&`.
1032−data HavingClause schema from grouping params where
999+data HavingClause db from grouping params where
1033− NoHaving :: HavingClause schema from 'Ungrouped params
1000+ NoHaving :: HavingClause db from 'Ungrouped params
1034 Having
1001 Having
1035− :: [Condition schema from ('Grouped bys) params]
1002+ :: [Condition db from ('Grouped bys) params]
1036− -> HavingClause schema from ('Grouped bys) params
1003+ -> HavingClause db from ('Grouped bys) params
1037−deriving instance Show (HavingClause schema from grouping params)
1004+deriving instance Show (HavingClause db from grouping params)
1038−deriving instance Eq (HavingClause schema from grouping params)
1005+deriving instance Eq (HavingClause db from grouping params)
1039−deriving instance Ord (HavingClause schema from grouping params)
1006+deriving instance Ord (HavingClause db from grouping params)
1040
1007
1041-- | Render a `HavingClause`.
1008-- | Render a `HavingClause`.
1042−renderHavingClause :: HavingClause schema from grouping params -> ByteString
1009+renderHavingClause :: HavingClause db from grouping params -> ByteString
1043renderHavingClause = \case
1010renderHavingClause = \case
1044 NoHaving -> ""
1011 NoHaving -> ""
1045 Having [] -> ""
1012 Having [] -> ""
@@ -1058,29 +1025,29 @@ Sorting
1058-- `AscNullsLast`, `DescNullsFirst` and `DescNullsLast` options are used to
1025-- `AscNullsLast`, `DescNullsFirst` and `DescNullsLast` options are used to
1059-- determine whether nulls appear before or after non-null values in the sort
1026-- determine whether nulls appear before or after non-null values in the sort
1060-- ordering of a `Null` result column.
1027-- ordering of a `Null` result column.
1061−data SortExpression schema from grouping params where
1028+data SortExpression db from grouping params where
1062 Asc
1029 Asc
1063− :: Expression schema from grouping params ('NotNull ty)
1030+ :: Expression db from grouping params ('NotNull ty)
1064− -> SortExpression schema from grouping params
1031+ -> SortExpression db from grouping params
1065 Desc
1032 Desc
1066− :: Expression schema from grouping params ('NotNull ty)
1033+ :: Expression db from grouping params ('NotNull ty)
1067− -> SortExpression schema from grouping params
1034+ -> SortExpression db from grouping params
1068 AscNullsFirst
1035 AscNullsFirst
1069− :: Expression schema from grouping params ('Null ty)
1036+ :: Expression db from grouping params ('Null ty)
1070− -> SortExpression schema from grouping params
1037+ -> SortExpression db from grouping params
1071 AscNullsLast
1038 AscNullsLast
1072− :: Expression schema from grouping params ('Null ty)
1039+ :: Expression db from grouping params ('Null ty)
1073− -> SortExpression schema from grouping params
1040+ -> SortExpression db from grouping params
1074 DescNullsFirst
1041 DescNullsFirst
1075− :: Expression schema from grouping params ('Null ty)
1042+ :: Expression db from grouping params ('Null ty)
1076− -> SortExpression schema from grouping params
1043+ -> SortExpression db from grouping params
1077 DescNullsLast
1044 DescNullsLast
1078− :: Expression schema from grouping params ('Null ty)
1045+ :: Expression db from grouping params ('Null ty)
1079− -> SortExpression schema from grouping params
1046+ -> SortExpression db from grouping params
1080−deriving instance Show (SortExpression schema from grouping params)
1047+deriving instance Show (SortExpression db from grouping params)
1081
1048
1082-- | Render a `SortExpression`.
1049-- | Render a `SortExpression`.
1083−renderSortExpression :: SortExpression schema from grouping params -> ByteString
1050+renderSortExpression :: SortExpression db from grouping params -> ByteString
1084renderSortExpression = \case
1051renderSortExpression = \case
1085 Asc expression -> renderExpression expression <+> "ASC"
1052 Asc expression -> renderExpression expression <+> "ASC"
1086 Desc expression -> renderExpression expression <+> "DESC"
1053 Desc expression -> renderExpression expression <+> "DESC"
@@ -1093,18 +1060,18 @@ renderSortExpression = \case
1093
1060
1094unsafeSubqueryExpression
1061unsafeSubqueryExpression
1095 :: ByteString
1062 :: ByteString
1096− -> Expression schema from grp params ty
1063+ -> Expression db from grp params ty
1097− -> Query schema params '[alias ::: ty]
1064+ -> Query db params '[alias ::: ty]
1098− -> Expression schema from grp params (nullity 'PGbool)
1065+ -> Expression db from grp params (nullity 'PGbool)
1099unsafeSubqueryExpression op x q = UnsafeExpression $
1066unsafeSubqueryExpression op x q = UnsafeExpression $
1100 renderExpression x <+> op <+> parenthesized (renderQuery q)
1067 renderExpression x <+> op <+> parenthesized (renderQuery q)
1101
1068
1102unsafeRowSubqueryExpression
1069unsafeRowSubqueryExpression
1103 :: SListI row
1070 :: SListI row
1104 => ByteString
1071 => ByteString
1105− -> NP (Aliased (Expression schema from grp params)) row
1072+ -> NP (Aliased (Expression db from grp params)) row
1106− -> Query schema params row
1073+ -> Query db params row
1107− -> Expression schema from grp params (nullity 'PGbool)
1074+ -> Expression db from grp params (nullity 'PGbool)
1108unsafeRowSubqueryExpression op xs q = UnsafeExpression $
1075unsafeRowSubqueryExpression op xs q = UnsafeExpression $
1109 renderExpression (row xs) <+> op <+> parenthesized (renderQuery q)
1076 renderExpression (row xs) <+> op <+> parenthesized (renderQuery q)
1110
1077
@@ -1117,9 +1084,9 @@ unsafeRowSubqueryExpression op xs q = UnsafeExpression $
1117-- >>> printSQL $ true `in_` values_ (true `as` #foo)
1084-- >>> printSQL $ true `in_` values_ (true `as` #foo)
1118-- TRUE IN (SELECT * FROM (VALUES (TRUE)) AS t ("foo"))
1085-- TRUE IN (SELECT * FROM (VALUES (TRUE)) AS t ("foo"))
1119in_
1086in_
1120− :: Expression schema from grp params ty -- ^ expression
1087+ :: Expression db from grp params ty -- ^ expression
1121− -> Query schema params '[alias ::: ty] -- ^ subquery
1088+ -> Query db params '[alias ::: ty] -- ^ subquery
1122− -> Expression schema from grp params (nullity 'PGbool)
1089+ -> Expression db from grp params (nullity 'PGbool)
1123in_ = unsafeSubqueryExpression "IN"
1090in_ = unsafeSubqueryExpression "IN"
1124
1091
1125{- | The left-hand side of this form of `rowIn` is a row constructor.
1092{- | The left-hand side of this form of `rowIn` is a row constructor.
@@ -1132,265 +1099,272 @@ is `true` if any equal subquery row is found.
1132The result is `false` if no equal row is found
1099The result is `false` if no equal row is found
1133(including the case where the subquery returns no rows).
1100(including the case where the subquery returns no rows).
1134
1101
1135−>>> let myRow = 1 `as` #foo :* false `as` #bar :: NP (Aliased (Expression '[] '[] 'Ungrouped '[])) '["foo" ::: 'NotNull 'PGint2, "bar" ::: 'NotNull 'PGbool]
1102+>>> let myRow = 1 `as` #foo :* false `as` #bar :: NP (Aliased (Expression db from grp params)) '["foo" ::: 'NotNull 'PGint2, "bar" ::: 'NotNull 'PGbool]
1136>>> printSQL $ myRow `rowIn` values_ myRow
1103>>> printSQL $ myRow `rowIn` values_ myRow
1137ROW(1, FALSE) IN (SELECT * FROM (VALUES (1, FALSE)) AS t ("foo", "bar"))
1104ROW(1, FALSE) IN (SELECT * FROM (VALUES (1, FALSE)) AS t ("foo", "bar"))
1138-}
1105-}
1139rowIn
1106rowIn
1140 :: SListI row
1107 :: SListI row
1141− => NP (Aliased (Expression schema from grp params)) row -- ^ row constructor
1108+ => NP (Aliased (Expression db from grp params)) row -- ^ row constructor
1142− -> Query schema params row -- ^ subquery
1109+ -> Query db params row -- ^ subquery
1143− -> Expression schema from grp params (nullity 'PGbool)
1110+ -> Expression db from grp params (nullity 'PGbool)
1144rowIn = unsafeRowSubqueryExpression "IN"
1111rowIn = unsafeRowSubqueryExpression "IN"
1145
1112
1146-- | >>> printSQL $ true `eqAll` values_ (true `as` #foo)
1113-- | >>> printSQL $ true `eqAll` values_ (true `as` #foo)
1147-- TRUE = ALL (SELECT * FROM (VALUES (TRUE)) AS t ("foo"))
1114-- TRUE = ALL (SELECT * FROM (VALUES (TRUE)) AS t ("foo"))
1148eqAll
1115eqAll
1149− :: Expression schema from grp params ty -- ^ expression
1116+ :: Expression db from grp params ty -- ^ expression
1150− -> Query schema params '[alias ::: ty] -- ^ subquery
1117+ -> Query db params '[alias ::: ty] -- ^ subquery
1151− -> Expression schema from grp params (nullity 'PGbool)
1118+ -> Expression db from grp params (nullity 'PGbool)
1152eqAll = unsafeSubqueryExpression "= ALL"
1119eqAll = unsafeSubqueryExpression "= ALL"
1153
1120
1154−-- | >>> let myRow = 1 `as` #foo :* false `as` #bar :: NP (Aliased (Expression '[] '[] 'Ungrouped '[])) '["foo" ::: 'NotNull 'PGint2, "bar" ::: 'NotNull 'PGbool]
1121+-- | >>> let myRow = 1 `as` #foo :* false `as` #bar :: NP (Aliased (Expression db from grp params)) '["foo" ::: 'NotNull 'PGint2, "bar" ::: 'NotNull 'PGbool]
1155-- >>> printSQL $ myRow `rowEqAll` values_ myRow
1122-- >>> printSQL $ myRow `rowEqAll` values_ myRow
1156-- ROW(1, FALSE) = ALL (SELECT * FROM (VALUES (1, FALSE)) AS t ("foo", "bar"))
1123-- ROW(1, FALSE) = ALL (SELECT * FROM (VALUES (1, FALSE)) AS t ("foo", "bar"))
1157rowEqAll
1124rowEqAll
1158 :: SListI row
1125 :: SListI row
1159− => NP (Aliased (Expression schema from grp params)) row -- ^ row constructor
1126+ => NP (Aliased (Expression db from grp params)) row -- ^ row constructor
1160− -> Query schema params row -- ^ subquery
1127+ -> Query db params row -- ^ subquery
1161− -> Expression schema from grp params (nullity 'PGbool)
1128+ -> Expression db from grp params (nullity 'PGbool)
1162rowEqAll = unsafeRowSubqueryExpression "= ALL"
1129rowEqAll = unsafeRowSubqueryExpression "= ALL"
1163
1130
1164-- | >>> printSQL $ true `eqAny` values_ (true `as` #foo)
1131-- | >>> printSQL $ true `eqAny` values_ (true `as` #foo)
1165-- TRUE = ANY (SELECT * FROM (VALUES (TRUE)) AS t ("foo"))
1132-- TRUE = ANY (SELECT * FROM (VALUES (TRUE)) AS t ("foo"))
1166eqAny
1133eqAny
1167− :: Expression schema from grp params ty -- ^ expression
1134+ :: Expression db from grp params ty -- ^ expression
1168− -> Query schema params '[alias ::: ty] -- ^ subquery
1135+ -> Query db params '[alias ::: ty] -- ^ subquery
1169− -> Expression schema from grp params (nullity 'PGbool)
1136+ -> Expression db from grp params (nullity 'PGbool)
1170eqAny = unsafeSubqueryExpression "= ANY"
1137eqAny = unsafeSubqueryExpression "= ANY"
1171
1138
1172−-- | >>> let myRow = 1 `as` #foo :* false `as` #bar :: NP (Aliased (Expression '[] '[] 'Ungrouped '[])) '["foo" ::: 'NotNull 'PGint2, "bar" ::: 'NotNull 'PGbool]
1139+-- | >>> let myRow = 1 `as` #foo :* false `as` #bar :: NP (Aliased (Expression db from grp params)) '["foo" ::: 'NotNull 'PGint2, "bar" ::: 'NotNull 'PGbool]
1173-- >>> printSQL $ myRow `rowEqAny` values_ myRow
1140-- >>> printSQL $ myRow `rowEqAny` values_ myRow
1174-- ROW(1, FALSE) = ANY (SELECT * FROM (VALUES (1, FALSE)) AS t ("foo", "bar"))
1141-- ROW(1, FALSE) = ANY (SELECT * FROM (VALUES (1, FALSE)) AS t ("foo", "bar"))
1175rowEqAny
1142rowEqAny
1176 :: SListI row
1143 :: SListI row
1177− => NP (Aliased (Expression schema from grp params)) row -- ^ row constructor
1144+ => NP (Aliased (Expression db from grp params)) row -- ^ row constructor
1178− -> Query schema params row -- ^ subquery
1145+ -> Query db params row -- ^ subquery
1179− -> Expression schema from grp params (nullity 'PGbool)
1146+ -> Expression db from grp params (nullity 'PGbool)
1180rowEqAny = unsafeRowSubqueryExpression "= ANY"
1147rowEqAny = unsafeRowSubqueryExpression "= ANY"
1181
1148
1182-- | >>> printSQL $ true `neqAll` values_ (true `as` #foo)
1149-- | >>> printSQL $ true `neqAll` values_ (true `as` #foo)
1183-- TRUE <> ALL (SELECT * FROM (VALUES (TRUE)) AS t ("foo"))
1150-- TRUE <> ALL (SELECT * FROM (VALUES (TRUE)) AS t ("foo"))
1184neqAll
1151neqAll
1185− :: Expression schema from grp params ty -- ^ expression
1152+ :: Expression db from grp params ty -- ^ expression
1186− -> Query schema params '[alias ::: ty] -- ^ subquery
1153+ -> Query db params '[alias ::: ty] -- ^ subquery
1187− -> Expression schema from grp params (nullity 'PGbool)
1154+ -> Expression db from grp params (nullity 'PGbool)
1188neqAll = unsafeSubqueryExpression "<> ALL"
1155neqAll = unsafeSubqueryExpression "<> ALL"
1189
1156
1190−-- | >>> let myRow = 1 `as` #foo :* false `as` #bar :: NP (Aliased (Expression '[] '[] 'Ungrouped '[])) '["foo" ::: 'NotNull 'PGint2, "bar" ::: 'NotNull 'PGbool]
1157+-- | >>> let myRow = 1 `as` #foo :* false `as` #bar :: NP (Aliased (Expression db from grp params)) '["foo" ::: 'NotNull 'PGint2, "bar" ::: 'NotNull 'PGbool]
1191-- >>> printSQL $ myRow `rowNeqAll` values_ myRow
1158-- >>> printSQL $ myRow `rowNeqAll` values_ myRow
1192-- ROW(1, FALSE) <> ALL (SELECT * FROM (VALUES (1, FALSE)) AS t ("foo", "bar"))
1159-- ROW(1, FALSE) <> ALL (SELECT * FROM (VALUES (1, FALSE)) AS t ("foo", "bar"))
1193rowNeqAll
1160rowNeqAll
1194 :: SListI row
1161 :: SListI row
1195− => NP (Aliased (Expression schema from grp params)) row -- ^ row constructor
1162+ => NP (Aliased (Expression db from grp params)) row -- ^ row constructor
1196− -> Query schema params row -- ^ subquery
1163+ -> Query db params row -- ^ subquery
1197− -> Expression schema from grp params (nullity 'PGbool)
1164+ -> Expression db from grp params (nullity 'PGbool)
1198rowNeqAll = unsafeRowSubqueryExpression "<> ALL"
1165rowNeqAll = unsafeRowSubqueryExpression "<> ALL"
1199
1166
1200-- | >>> printSQL $ true `neqAny` values_ (true `as` #foo)
1167-- | >>> printSQL $ true `neqAny` values_ (true `as` #foo)
1201-- TRUE <> ANY (SELECT * FROM (VALUES (TRUE)) AS t ("foo"))
1168-- TRUE <> ANY (SELECT * FROM (VALUES (TRUE)) AS t ("foo"))
1202neqAny
1169neqAny
1203− :: Expression schema from grp params ty -- ^ expression
1170+ :: Expression db from grp params ty -- ^ expression
1204− -> Query schema params '[alias ::: ty] -- ^ subquery
1171+ -> Query db params '[alias ::: ty] -- ^ subquery
1205− -> Expression schema from grp params (nullity 'PGbool)
1172+ -> Expression db from grp params (nullity 'PGbool)
1206neqAny = unsafeSubqueryExpression "<> ANY"
1173neqAny = unsafeSubqueryExpression "<> ANY"
1207
1174
1208−-- | >>> let myRow = 1 `as` #foo :* false `as` #bar :: NP (Aliased (Expression '[] '[] 'Ungrouped '[])) '["foo" ::: 'NotNull 'PGint2, "bar" ::: 'NotNull 'PGbool]
1175+-- | >>> let myRow = 1 `as` #foo :* false `as` #bar :: NP (Aliased (Expression db from grp params)) '["foo" ::: 'NotNull 'PGint2, "bar" ::: 'NotNull 'PGbool]
1209-- >>> printSQL $ myRow `rowNeqAny` values_ myRow
1176-- >>> printSQL $ myRow `rowNeqAny` values_ myRow
1210-- ROW(1, FALSE) <> ANY (SELECT * FROM (VALUES (1, FALSE)) AS t ("foo", "bar"))
1177-- ROW(1, FALSE) <> ANY (SELECT * FROM (VALUES (1, FALSE)) AS t ("foo", "bar"))
1211rowNeqAny
1178rowNeqAny
1212 :: SListI row
1179 :: SListI row
1213− => NP (Aliased (Expression schema from grp params)) row -- ^ row constructor
1180+ => NP (Aliased (Expression db from grp params)) row -- ^ row constructor
1214− -> Query schema params row -- ^ subquery
1181+ -> Query db params row -- ^ subquery
1215− -> Expression schema from grp params (nullity 'PGbool)
1182+ -> Expression db from grp params (nullity 'PGbool)
1216rowNeqAny = unsafeRowSubqueryExpression "<> ANY"
1183rowNeqAny = unsafeRowSubqueryExpression "<> ANY"
1217
1184
1218-- | >>> printSQL $ true `allLt` values_ (true `as` #foo)
1185-- | >>> printSQL $ true `allLt` values_ (true `as` #foo)
1219-- TRUE ALL < (SELECT * FROM (VALUES (TRUE)) AS t ("foo"))
1186-- TRUE ALL < (SELECT * FROM (VALUES (TRUE)) AS t ("foo"))
1220allLt
1187allLt
1221− :: Expression schema from grp params ty -- ^ expression
1188+ :: Expression db from grp params ty -- ^ expression
1222− -> Query schema params '[alias ::: ty] -- ^ subquery
1189+ -> Query db params '[alias ::: ty] -- ^ subquery
1223− -> Expression schema from grp params (nullity 'PGbool)
1190+ -> Expression db from grp params (nullity 'PGbool)
1224allLt = unsafeSubqueryExpression "ALL <"
1191allLt = unsafeSubqueryExpression "ALL <"
1225
1192
1226−-- | >>> let myRow = 1 `as` #foo :* false `as` #bar :: NP (Aliased (Expression '[] '[] 'Ungrouped '[])) '["foo" ::: 'NotNull 'PGint2, "bar" ::: 'NotNull 'PGbool]
1193+-- | >>> let myRow = 1 `as` #foo :* false `as` #bar :: NP (Aliased (Expression db from grp params)) '["foo" ::: 'NotNull 'PGint2, "bar" ::: 'NotNull 'PGbool]
1227-- >>> printSQL $ myRow `rowLtAll` values_ myRow
1194-- >>> printSQL $ myRow `rowLtAll` values_ myRow
1228-- ROW(1, FALSE) ALL < (SELECT * FROM (VALUES (1, FALSE)) AS t ("foo", "bar"))
1195-- ROW(1, FALSE) ALL < (SELECT * FROM (VALUES (1, FALSE)) AS t ("foo", "bar"))
1229rowLtAll
1196rowLtAll
1230 :: SListI row
1197 :: SListI row
1231− => NP (Aliased (Expression schema from grp params)) row -- ^ row constructor
1198+ => NP (Aliased (Expression db from grp params)) row -- ^ row constructor
1232− -> Query schema params row -- ^ subquery
1199+ -> Query db params row -- ^ subquery
1233− -> Expression schema from grp params (nullity 'PGbool)
1200+ -> Expression db from grp params (nullity 'PGbool)
1234rowLtAll = unsafeRowSubqueryExpression "ALL <"
1201rowLtAll = unsafeRowSubqueryExpression "ALL <"
1235
1202
1236-- | >>> printSQL $ true `ltAny` values_ (true `as` #foo)
1203-- | >>> printSQL $ true `ltAny` values_ (true `as` #foo)
1237-- TRUE ANY < (SELECT * FROM (VALUES (TRUE)) AS t ("foo"))
1204-- TRUE ANY < (SELECT * FROM (VALUES (TRUE)) AS t ("foo"))
1238ltAny
1205ltAny
1239− :: Expression schema from grp params ty -- ^ expression
1206+ :: Expression db from grp params ty -- ^ expression
1240− -> Query schema params '[alias ::: ty] -- ^ subquery
1207+ -> Query db params '[alias ::: ty] -- ^ subquery
1241− -> Expression schema from grp params (nullity 'PGbool)
1208+ -> Expression db from grp params (nullity 'PGbool)
1242ltAny = unsafeSubqueryExpression "ANY <"
1209ltAny = unsafeSubqueryExpression "ANY <"
1243
1210
1244−-- | >>> let myRow = 1 `as` #foo :* false `as` #bar :: NP (Aliased (Expression '[] '[] 'Ungrouped '[])) '["foo" ::: 'NotNull 'PGint2, "bar" ::: 'NotNull 'PGbool]
1211+-- | >>> let myRow = 1 `as` #foo :* false `as` #bar :: NP (Aliased (Expression db from grp params)) '["foo" ::: 'NotNull 'PGint2, "bar" ::: 'NotNull 'PGbool]
1245-- >>> printSQL $ myRow `rowLtAll` values_ myRow
1212-- >>> printSQL $ myRow `rowLtAll` values_ myRow
1246-- ROW(1, FALSE) ALL < (SELECT * FROM (VALUES (1, FALSE)) AS t ("foo", "bar"))
1213-- ROW(1, FALSE) ALL < (SELECT * FROM (VALUES (1, FALSE)) AS t ("foo", "bar"))
1247rowLtAny
1214rowLtAny
1248 :: SListI row
1215 :: SListI row
1249− => NP (Aliased (Expression schema from grp params)) row -- ^ row constructor
1216+ => NP (Aliased (Expression db from grp params)) row -- ^ row constructor
1250− -> Query schema params row -- ^ subquery
1217+ -> Query db params row -- ^ subquery
1251− -> Expression schema from grp params (nullity 'PGbool)
1218+ -> Expression db from grp params (nullity 'PGbool)
1252rowLtAny = unsafeRowSubqueryExpression "ANY <"
1219rowLtAny = unsafeRowSubqueryExpression "ANY <"
1253
1220
1254-- | >>> printSQL $ true `lteAll` values_ (true `as` #foo)
1221-- | >>> printSQL $ true `lteAll` values_ (true `as` #foo)
1255-- TRUE <= ALL (SELECT * FROM (VALUES (TRUE)) AS t ("foo"))
1222-- TRUE <= ALL (SELECT * FROM (VALUES (TRUE)) AS t ("foo"))
1256lteAll
1223lteAll
1257− :: Expression schema from grp params ty -- ^ expression
1224+ :: Expression db from grp params ty -- ^ expression
1258− -> Query schema params '[alias ::: ty] -- ^ subquery
1225+ -> Query db params '[alias ::: ty] -- ^ subquery
1259− -> Expression schema from grp params (nullity 'PGbool)
1226+ -> Expression db from grp params (nullity 'PGbool)
1260lteAll = unsafeSubqueryExpression "<= ALL"
1227lteAll = unsafeSubqueryExpression "<= ALL"
1261
1228
1262−-- | >>> let myRow = 1 `as` #foo :* false `as` #bar :: NP (Aliased (Expression '[] '[] 'Ungrouped '[])) '["foo" ::: 'NotNull 'PGint2, "bar" ::: 'NotNull 'PGbool]
1229+-- | >>> let myRow = 1 `as` #foo :* false `as` #bar :: NP (Aliased (Expression db from grp params)) '["foo" ::: 'NotNull 'PGint2, "bar" ::: 'NotNull 'PGbool]
1263-- >>> printSQL $ myRow `rowLteAll` values_ myRow
1230-- >>> printSQL $ myRow `rowLteAll` values_ myRow
1264-- ROW(1, FALSE) <= ALL (SELECT * FROM (VALUES (1, FALSE)) AS t ("foo", "bar"))
1231-- ROW(1, FALSE) <= ALL (SELECT * FROM (VALUES (1, FALSE)) AS t ("foo", "bar"))
1265rowLteAll
1232rowLteAll
1266 :: SListI row
1233 :: SListI row
1267− => NP (Aliased (Expression schema from grp params)) row -- ^ row constructor
1234+ => NP (Aliased (Expression db from grp params)) row -- ^ row constructor
1268− -> Query schema params row -- ^ subquery
1235+ -> Query db params row -- ^ subquery
1269− -> Expression schema from grp params (nullity 'PGbool)
1236+ -> Expression db from grp params (nullity 'PGbool)
1270rowLteAll = unsafeRowSubqueryExpression "<= ALL"
1237rowLteAll = unsafeRowSubqueryExpression "<= ALL"
1271
1238
1272-- | >>> printSQL $ true `lteAny` values_ (true `as` #foo)
1239-- | >>> printSQL $ true `lteAny` values_ (true `as` #foo)
1273-- TRUE <= ANY (SELECT * FROM (VALUES (TRUE)) AS t ("foo"))
1240-- TRUE <= ANY (SELECT * FROM (VALUES (TRUE)) AS t ("foo"))
1274lteAny
1241lteAny
1275− :: Expression schema from grp params ty -- ^ expression
1242+ :: Expression db from grp params ty -- ^ expression
1276− -> Query schema params '[alias ::: ty] -- ^ subquery
1243+ -> Query db params '[alias ::: ty] -- ^ subquery
1277− -> Expression schema from grp params (nullity 'PGbool)
1244+ -> Expression db from grp params (nullity 'PGbool)
1278lteAny = unsafeSubqueryExpression "<= ANY"
1245lteAny = unsafeSubqueryExpression "<= ANY"
1279
1246
1280−-- | >>> let myRow = 1 `as` #foo :* false `as` #bar :: NP (Aliased (Expression '[] '[] 'Ungrouped '[])) '["foo" ::: 'NotNull 'PGint2, "bar" ::: 'NotNull 'PGbool]
1247+-- | >>> let myRow = 1 `as` #foo :* false `as` #bar :: NP (Aliased (Expression db from grp params)) '["foo" ::: 'NotNull 'PGint2, "bar" ::: 'NotNull 'PGbool]
1281-- >>> printSQL $ myRow `rowLteAny` values_ myRow
1248-- >>> printSQL $ myRow `rowLteAny` values_ myRow
1282-- ROW(1, FALSE) <= ANY (SELECT * FROM (VALUES (1, FALSE)) AS t ("foo", "bar"))
1249-- ROW(1, FALSE) <= ANY (SELECT * FROM (VALUES (1, FALSE)) AS t ("foo", "bar"))
1283rowLteAny
1250rowLteAny
1284 :: SListI row
1251 :: SListI row
1285− => NP (Aliased (Expression schema from grp params)) row -- ^ row constructor
1252+ => NP (Aliased (Expression db from grp params)) row -- ^ row constructor
1286− -> Query schema params row -- ^ subquery
1253+ -> Query db params row -- ^ subquery
1287− -> Expression schema from grp params (nullity 'PGbool)
1254+ -> Expression db from grp params (nullity 'PGbool)
1288rowLteAny = unsafeRowSubqueryExpression "<= ANY"
1255rowLteAny = unsafeRowSubqueryExpression "<= ANY"
1289
1256
1290-- | >>> printSQL $ true `gtAll` values_ (true `as` #foo)
1257-- | >>> printSQL $ true `gtAll` values_ (true `as` #foo)
1291-- TRUE > ALL (SELECT * FROM (VALUES (TRUE)) AS t ("foo"))
1258-- TRUE > ALL (SELECT * FROM (VALUES (TRUE)) AS t ("foo"))
1292gtAll
1259gtAll
1293− :: Expression schema from grp params ty -- ^ expression
1260+ :: Expression db from grp params ty -- ^ expression
1294− -> Query schema params '[alias ::: ty] -- ^ subquery
1261+ -> Query db params '[alias ::: ty] -- ^ subquery
1295− -> Expression schema from grp params (nullity 'PGbool)
1262+ -> Expression db from grp params (nullity 'PGbool)
1296gtAll = unsafeSubqueryExpression "> ALL"
1263gtAll = unsafeSubqueryExpression "> ALL"
1297
1264
1298−-- | >>> let myRow = 1 `as` #foo :* false `as` #bar :: NP (Aliased (Expression '[] '[] 'Ungrouped '[])) '["foo" ::: 'NotNull 'PGint2, "bar" ::: 'NotNull 'PGbool]
1265+-- | >>> let myRow = 1 `as` #foo :* false `as` #bar :: NP (Aliased (Expression db from grp params)) '["foo" ::: 'NotNull 'PGint2, "bar" ::: 'NotNull 'PGbool]
1299-- >>> printSQL $ myRow `rowGtAll` values_ myRow
1266-- >>> printSQL $ myRow `rowGtAll` values_ myRow
1300-- ROW(1, FALSE) > ALL (SELECT * FROM (VALUES (1, FALSE)) AS t ("foo", "bar"))
1267-- ROW(1, FALSE) > ALL (SELECT * FROM (VALUES (1, FALSE)) AS t ("foo", "bar"))
1301rowGtAll
1268rowGtAll
1302 :: SListI row
1269 :: SListI row
1303− => NP (Aliased (Expression schema from grp params)) row -- ^ row constructor
1270+ => NP (Aliased (Expression db from grp params)) row -- ^ row constructor
1304− -> Query schema params row -- ^ subquery
1271+ -> Query db params row -- ^ subquery
1305− -> Expression schema from grp params (nullity 'PGbool)
1272+ -> Expression db from grp params (nullity 'PGbool)
1306rowGtAll = unsafeRowSubqueryExpression "> ALL"
1273rowGtAll = unsafeRowSubqueryExpression "> ALL"
1307
1274
1308-- | >>> printSQL $ true `gtAny` values_ (true `as` #foo)
1275-- | >>> printSQL $ true `gtAny` values_ (true `as` #foo)
1309-- TRUE > ANY (SELECT * FROM (VALUES (TRUE)) AS t ("foo"))
1276-- TRUE > ANY (SELECT * FROM (VALUES (TRUE)) AS t ("foo"))
1310gtAny
1277gtAny
1311− :: Expression schema from grp params ty -- ^ expression
1278+ :: Expression db from grp params ty -- ^ expression
1312− -> Query schema params '[alias ::: ty] -- ^ subquery
1279+ -> Query db params '[alias ::: ty] -- ^ subquery
1313− -> Expression schema from grp params (nullity 'PGbool)
1280+ -> Expression db from grp params (nullity 'PGbool)
1314gtAny = unsafeSubqueryExpression "> ANY"
1281gtAny = unsafeSubqueryExpression "> ANY"
1315
1282
1316−-- | >>> let myRow = 1 `as` #foo :* false `as` #bar :: NP (Aliased (Expression '[] '[] 'Ungrouped '[])) '["foo" ::: 'NotNull 'PGint2, "bar" ::: 'NotNull 'PGbool]
1283+-- | >>> let myRow = 1 `as` #foo :* false `as` #bar :: NP (Aliased (Expression db from grp params)) '["foo" ::: 'NotNull 'PGint2, "bar" ::: 'NotNull 'PGbool]
1317-- >>> printSQL $ myRow `rowGtAny` values_ myRow
1284-- >>> printSQL $ myRow `rowGtAny` values_ myRow
1318-- ROW(1, FALSE) > ANY (SELECT * FROM (VALUES (1, FALSE)) AS t ("foo", "bar"))
1285-- ROW(1, FALSE) > ANY (SELECT * FROM (VALUES (1, FALSE)) AS t ("foo", "bar"))
1319rowGtAny
1286rowGtAny
1320 :: SListI row
1287 :: SListI row
1321− => NP (Aliased (Expression schema from grp params)) row -- ^ row constructor
1288+ => NP (Aliased (Expression db from grp params)) row -- ^ row constructor
1322− -> Query schema params row -- ^ subquery
1289+ -> Query db params row -- ^ subquery
1323− -> Expression schema from grp params (nullity 'PGbool)
1290+ -> Expression db from grp params (nullity 'PGbool)
1324rowGtAny = unsafeRowSubqueryExpression "> ANY"
1291rowGtAny = unsafeRowSubqueryExpression "> ANY"
1325
1292
1326-- | >>> printSQL $ true `gteAll` values_ (true `as` #foo)
1293-- | >>> printSQL $ true `gteAll` values_ (true `as` #foo)
1327-- TRUE >= ALL (SELECT * FROM (VALUES (TRUE)) AS t ("foo"))
1294-- TRUE >= ALL (SELECT * FROM (VALUES (TRUE)) AS t ("foo"))
1328gteAll
1295gteAll
1329− :: Expression schema from grp params ty -- ^ expression
1296+ :: Expression db from grp params ty -- ^ expression
1330− -> Query schema params '[alias ::: ty] -- ^ subquery
1297+ -> Query db params '[alias ::: ty] -- ^ subquery
1331− -> Expression schema from grp params (nullity 'PGbool)
1298+ -> Expression db from grp params (nullity 'PGbool)
1332gteAll = unsafeSubqueryExpression ">= ALL"
1299gteAll = unsafeSubqueryExpression ">= ALL"
1333
1300
1334−-- | >>> let myRow = 1 `as` #foo :* false `as` #bar :: NP (Aliased (Expression '[] '[] 'Ungrouped '[])) '["foo" ::: 'NotNull 'PGint2, "bar" ::: 'NotNull 'PGbool]
1301+-- | >>> let myRow = 1 `as` #foo :* false `as` #bar :: NP (Aliased (Expression db from grp params)) '["foo" ::: 'NotNull 'PGint2, "bar" ::: 'NotNull 'PGbool]
1335-- >>> printSQL $ myRow `rowGteAll` values_ myRow
1302-- >>> printSQL $ myRow `rowGteAll` values_ myRow
1336-- ROW(1, FALSE) >= ALL (SELECT * FROM (VALUES (1, FALSE)) AS t ("foo", "bar"))
1303-- ROW(1, FALSE) >= ALL (SELECT * FROM (VALUES (1, FALSE)) AS t ("foo", "bar"))
1337rowGteAll
1304rowGteAll
1338 :: SListI row
1305 :: SListI row
1339− => NP (Aliased (Expression schema from grp params)) row -- ^ row constructor
1306+ => NP (Aliased (Expression db from grp params)) row -- ^ row constructor
1340− -> Query schema params row -- ^ subquery
1307+ -> Query db params row -- ^ subquery
1341− -> Expression schema from grp params (nullity 'PGbool)
1308+ -> Expression db from grp params (nullity 'PGbool)
1342rowGteAll = unsafeRowSubqueryExpression ">= ALL"
1309rowGteAll = unsafeRowSubqueryExpression ">= ALL"
1343
1310
1344-- | >>> printSQL $ true `gteAny` values_ (true `as` #foo)
1311-- | >>> printSQL $ true `gteAny` values_ (true `as` #foo)
1345-- TRUE >= ANY (SELECT * FROM (VALUES (TRUE)) AS t ("foo"))
1312-- TRUE >= ANY (SELECT * FROM (VALUES (TRUE)) AS t ("foo"))
1346gteAny
1313gteAny
1347− :: Expression schema from grp params ty -- ^ expression
1314+ :: Expression db from grp params ty -- ^ expression
1348− -> Query schema params '[alias ::: ty] -- ^ subquery
1315+ -> Query db params '[alias ::: ty] -- ^ subquery
1349− -> Expression schema from grp params (nullity 'PGbool)
1316+ -> Expression db from grp params (nullity 'PGbool)
1350gteAny = unsafeSubqueryExpression ">= ANY"
1317gteAny = unsafeSubqueryExpression ">= ANY"
1351
1318
1352−-- | >>> let myRow = 1 `as` #foo :* false `as` #bar :: NP (Aliased (Expression '[] '[] 'Ungrouped '[])) '["foo" ::: 'NotNull 'PGint2, "bar" ::: 'NotNull 'PGbool]
1319+-- | >>> let myRow = 1 `as` #foo :* false `as` #bar :: NP (Aliased (Expression db from grp params)) '["foo" ::: 'NotNull 'PGint2, "bar" ::: 'NotNull 'PGbool]
1353-- >>> printSQL $ myRow `rowGteAny` values_ myRow
1320-- >>> printSQL $ myRow `rowGteAny` values_ myRow
1354-- ROW(1, FALSE) >= ANY (SELECT * FROM (VALUES (1, FALSE)) AS t ("foo", "bar"))
1321-- ROW(1, FALSE) >= ANY (SELECT * FROM (VALUES (1, FALSE)) AS t ("foo", "bar"))
1355rowGteAny
1322rowGteAny
1356 :: SListI row
1323 :: SListI row
1357− => NP (Aliased (Expression schema from grp params)) row -- ^ row constructor
1324+ => NP (Aliased (Expression db from grp params)) row -- ^ row constructor
1358− -> Query schema params row -- ^ subquery
1325+ -> Query db params row -- ^ subquery
1359− -> Expression schema from grp params (nullity 'PGbool)
1326+ -> Expression db from grp params (nullity 'PGbool)
1360rowGteAny = unsafeRowSubqueryExpression ">= ANY"
1327rowGteAny = unsafeRowSubqueryExpression ">= ANY"
1361
1328
1362-- | A `CommonTableExpression` is an auxiliary statement in a `with` clause.
1329-- | A `CommonTableExpression` is an auxiliary statement in a `with` clause.
1363data CommonTableExpression statement
1330data CommonTableExpression statement
1364 (params :: [NullityType])
1331 (params :: [NullityType])
1365− (schema0 :: SchemaType)
1332+ (db0 :: DBType)
1366− (schema1 :: SchemaType) where
1333+ (db1 :: DBType) where
1367 CommonTableExpression
1334 CommonTableExpression
1368− :: Aliased (statement schema params) (alias ::: cte)
1335+ :: Aliased (statement (commons :=> schemas) params) (cte ::: common)
1369− -> CommonTableExpression
1336+ -> CommonTableExpression statement params
1370− statement params schema (alias ::: 'View cte ': schema)
1337+ (commons :=> schemas) ((cte ::: common ': commons) :=> schemas)
1371−instance (KnownSymbol alias, schema1 ~ (alias ::: 'View cte ': schema))
1338+instance
1339+ ( KnownSymbol cte
1340+ , db0 ~ (commons :=> schemas)
1341+ , db1 ~ ((cte ::: common ': commons) :=> schemas)
1372− => Aliasable alias
1342+ ) => Aliasable cte
1373− (statement schema params cte)
1343+ (statement db0 params common)
1374− (CommonTableExpression statement params schema schema1) where
1344+ (CommonTableExpression statement params db0 db1) where
1375− statement `as` alias = CommonTableExpression (statement `as` alias)
1345+ statement `as` cte = CommonTableExpression (statement `as` cte)
1376−instance (KnownSymbol alias, schema1 ~ (alias ::: 'View cte ': schema))
1346+instance
1347+ ( KnownSymbol cte
1348+ , db0 ~ (commons :=> schemas)
1349+ , db1 ~ ((cte ::: common ': commons) :=> schemas)
1350+ ) => Aliasable cte
1377− => Aliasable alias (statement schema params cte)
1351+ (statement db0 params common)
1378− (AlignedList (CommonTableExpression statement params) schema schema1) where
1352+ (AlignedList (CommonTableExpression statement params) db0 db1) where
1379− statement `as` alias = single (statement `as` alias)
1353+ statement `as` cte = single (statement `as` cte)
1380
1354
1381-- | render a `CommonTableExpression`.
1355-- | render a `CommonTableExpression`.
1382renderCommonTableExpression
1356renderCommonTableExpression
1383− :: (forall sch ps row. statement ps sch row -> ByteString) -- ^ render statement
1357+ :: (forall db ps row. statement db ps row -> ByteString) -- ^ render statement
1384− -> CommonTableExpression statement params schema0 schema1 -> ByteString
1358+ -> CommonTableExpression statement params db0 db1 -> ByteString
1385renderCommonTableExpression renderStatement
1359renderCommonTableExpression renderStatement
1386 (CommonTableExpression (statement `As` alias)) =
1360 (CommonTableExpression (statement `As` alias)) =
1387 renderAlias alias <+> "AS" <+> parenthesized (renderStatement statement)
1361 renderAlias alias <+> "AS" <+> parenthesized (renderStatement statement)
1388
1362
1389-- | render a non-empty `AlignedList` of `CommonTableExpression`s.
1363-- | render a non-empty `AlignedList` of `CommonTableExpression`s.
1390renderCommonTableExpressions
1364renderCommonTableExpressions
1391− :: (forall sch ps row. statement ps sch row -> ByteString) -- ^ render statement
1365+ :: (forall db ps row. statement db ps row -> ByteString) -- ^ render statement
1392− -> CommonTableExpression statement params schema0 schema1
1366+ -> CommonTableExpression statement params db0 db1
1393− -> AlignedList (CommonTableExpression statement params) schema1 schema2
1367+ -> AlignedList (CommonTableExpression statement params) db1 db2
1394 -> ByteString
1368 -> ByteString
1395renderCommonTableExpressions renderStatement cte ctes =
1369renderCommonTableExpressions renderStatement cte ctes =
1396 renderCommonTableExpression renderStatement cte <> case ctes of
1370 renderCommonTableExpression renderStatement cte <> case ctes of
@@ -1403,11 +1377,11 @@ renderCommonTableExpressions renderStatement cte ctes =
1403-- defining temporary tables that exist just for one query.
1377-- defining temporary tables that exist just for one query.
1404class With statement where
1378class With statement where
1405 with
1379 with
1406− :: AlignedList (CommonTableExpression statement params) schema0 schema1
1380+ :: AlignedList (CommonTableExpression statement params) db0 db1
1407 -- ^ common table expressions
1381 -- ^ common table expressions
1408− -> statement schema1 params row
1382+ -> statement db1 params row
1409 -- ^ larger query
1383 -- ^ larger query
1410− -> statement schema0 params row
1384+ -> statement db0 params row
1411instance With Query where
1385instance With Query where
1412 with Done query = query
1386 with Done query = query
1413 with (cte :>> ctes) query = UnsafeQuery $
1387 with (cte :>> ctes) query = UnsafeQuery $
squeal-postgresql/src/Squeal/PostgreSQL/Schema.hs+41−3
@@ -54,6 +54,10 @@ module Squeal.PostgreSQL.Schema
54 , TableType
54 , TableType
55 , SchemumType (..)
55 , SchemumType (..)
56 , SchemaType
56 , SchemaType
57+ , SchemasType
58+ , Public
59+ , DBType
60+ , DBof
57 -- * Constraints
61 -- * Constraints
58 , (:=>)
62 , (:=>)
59 , ColumnConstraint (..)
63 , ColumnConstraint (..)
@@ -62,8 +66,10 @@ module Squeal.PostgreSQL.Schema
62 , Uniquely
66 , Uniquely
63 -- * Aliases
67 -- * Aliases
64 , (:::)
68 , (:::)
65− , Alias (Alias)
69+ , Alias (..)
70+ , IsLabel (..)
66 , renderAlias
71 , renderAlias
72+ , renderAliasString
67 , renderAliases
73 , renderAliases
68 , Aliased (As)
74 , Aliased (As)
69 , Aliasable (as)
75 , Aliasable (as)
@@ -71,9 +77,9 @@ module Squeal.PostgreSQL.Schema
71 , Has
77 , Has
72 , HasUnique
78 , HasUnique
73 , HasAll
79 , HasAll
74− , IsLabel (..)
80+ , QualifiedAlias (..)
75 , IsQualified (..)
81 , IsQualified (..)
76− , renderAliasString
82+ , renderQualifiedAlias
77 -- * Enumerated Labels
83 -- * Enumerated Labels
78 , IsPGlabel (..)
84 , IsPGlabel (..)
79 , PGlabel (..)
85 , PGlabel (..)
@@ -471,6 +477,29 @@ class IsQualified table column expression where
471 infixl 9 !
477 infixl 9 !
472instance IsQualified table column (Alias table, Alias column) where (!) = (,)
478instance IsQualified table column (Alias table, Alias column) where (!) = (,)
473
479
480+data QualifiedAlias (qualifier :: Symbol) (alias :: Symbol) = QualifiedAlias
481+ deriving (Eq,GHC.Generic,Ord,Show,NFData)
482+instance (q ~ q', a ~ a') => IsQualified q a (QualifiedAlias q' a') where
483+ _!_ = QualifiedAlias
484+instance (q' ~ "public", a ~ a') => IsLabel a (QualifiedAlias q' a') where
485+ fromLabel = QualifiedAlias
486+instance (q0 ~ q1, a0 ~ a1, a1 ~ a2, KnownSymbol a2) =>
487+ IsQualified q0 a0 (Aliased (QualifiedAlias q1) (a1 ::: a2)) where
488+ _!_ = QualifiedAlias `As` Alias
489+instance (q ~ "public", a0 ~ a1, a1 ~ a2, KnownSymbol a2) =>
490+ IsLabel a0 (Aliased (QualifiedAlias q) (a1 ::: a2)) where
491+ fromLabel = QualifiedAlias `As` Alias
492+
493+renderQualifiedAlias
494+ :: forall q a. (KnownSymbol q, KnownSymbol a)
495+ => QualifiedAlias q a -> ByteString
496+renderQualifiedAlias _ =
497+ let
498+ qualifier = renderAlias (Alias @q)
499+ alias = renderAlias (Alias @a)
500+ in
501+ if qualifier == "\"public\"" then alias else qualifier <> "." <> alias
502+
474-- | @Elem@ is a promoted `Data.List.elem`.
503-- | @Elem@ is a promoted `Data.List.elem`.
475type family Elem x xs where
504type family Elem x xs where
476 Elem x '[] = 'False
505 Elem x '[] = 'False
@@ -657,6 +686,15 @@ type family Schema :: SchemaType where
657-}
686-}
658type SchemaType = [(Symbol,SchemumType)]
687type SchemaType = [(Symbol,SchemumType)]
659
688
689+type SchemasType = [(Symbol,SchemaType)]
690+
691+type family Public (schema :: SchemaType) :: SchemasType
692+ where Public schema = '["public" ::: schema]
693+
694+type DBType = (FromType,SchemasType)
695+
696+type family DBof :: SchemasType -> DBType where DBof = '(,) '[]
697+
660-- | `IsPGlabel` looks very much like the `IsLabel` class. Whereas
698-- | `IsPGlabel` looks very much like the `IsLabel` class. Whereas
661-- the overloaded label, `fromLabel` is used for column references,
699-- the overloaded label, `fromLabel` is used for column references,
662-- `label`s are used for enum terms. A `label` is called with
700-- `label`s are used for enum terms. A `label` is called with
squeal-postgresql/src/Squeal/PostgreSQL/Transaction.hs+9−9
@@ -52,7 +52,7 @@ import Squeal.PostgreSQL.Schema
52
52
53-- | Run a schema invariant computation `transactionally`.
53-- | Run a schema invariant computation `transactionally`.
54transactionally
54transactionally
55− :: (MonadBaseControl IO tx, MonadPQ schema tx)
55+ :: (MonadBaseControl IO tx, MonadPQ schemas tx)
56 => TransactionMode
56 => TransactionMode
57 -> tx x -- ^ run inside a transaction
57 -> tx x -- ^ run inside a transaction
58 -> tx x
58 -> tx x
@@ -64,30 +64,30 @@ transactionally mode tx = mask $ \restore -> do
64
64
65-- | Run a schema invariant computation `transactionally_` in `defaultMode`.
65-- | Run a schema invariant computation `transactionally_` in `defaultMode`.
66transactionally_
66transactionally_
67− :: (MonadBaseControl IO tx, MonadPQ schema tx)
67+ :: (MonadBaseControl IO tx, MonadPQ schemas tx)
68 => tx x -- ^ run inside a transaction
68 => tx x -- ^ run inside a transaction
69 -> tx x
69 -> tx x
70transactionally_ = transactionally defaultMode
70transactionally_ = transactionally defaultMode
71
71
72-- | @BEGIN@ a transaction.
72-- | @BEGIN@ a transaction.
73−begin :: MonadPQ schema tx => TransactionMode -> tx (K Result ('[] :: RowType))
73+begin :: MonadPQ schemas tx => TransactionMode -> tx (K Result ('[] :: RowType))
74begin mode = manipulate . UnsafeManipulation $
74begin mode = manipulate . UnsafeManipulation $
75 "BEGIN" <+> renderTransactionMode mode <> ";"
75 "BEGIN" <+> renderTransactionMode mode <> ";"
76
76
77-- | @COMMIT@ a schema invariant transaction.
77-- | @COMMIT@ a schema invariant transaction.
78−commit :: MonadPQ schema tx => tx (K Result ('[] :: RowType))
78+commit :: MonadPQ schemas tx => tx (K Result ('[] :: RowType))
79commit = manipulate $ UnsafeManipulation "COMMIT;"
79commit = manipulate $ UnsafeManipulation "COMMIT;"
80
80
81-- | @ROLLBACK@ a schema invariant transaction.
81-- | @ROLLBACK@ a schema invariant transaction.
82−rollback :: MonadPQ schema tx => tx (K Result ('[] :: RowType))
82+rollback :: MonadPQ schemas tx => tx (K Result ('[] :: RowType))
83rollback = manipulate $ UnsafeManipulation "ROLLBACK;"
83rollback = manipulate $ UnsafeManipulation "ROLLBACK;"
84
84
85-- | Run a schema changing computation `transactionallySchema`.
85-- | Run a schema changing computation `transactionallySchema`.
86transactionallySchema
86transactionallySchema
87 :: MonadBaseControl IO io
87 :: MonadBaseControl IO io
88 => TransactionMode
88 => TransactionMode
89− -> PQ schema0 schema1 io x
89+ -> PQ schemas0 schemas1 io x
90− -> PQ schema0 schema1 io x
90+ -> PQ schemas0 schemas1 io x
91transactionallySchema mode u = PQ $ \ conn -> mask $ \ restore -> do
91transactionallySchema mode u = PQ $ \ conn -> mask $ \ restore -> do
92 _ <- liftBase . LibPQ.exec (unK conn) $
92 _ <- liftBase . LibPQ.exec (unK conn) $
93 "BEGIN" <+> renderTransactionMode mode <> ";"
93 "BEGIN" <+> renderTransactionMode mode <> ";"
@@ -99,8 +99,8 @@ transactionallySchema mode u = PQ $ \ conn -> mask $ \ restore -> do
99-- | Run a schema changing computation `transactionallySchema_` in `DefaultMode`.
99-- | Run a schema changing computation `transactionallySchema_` in `DefaultMode`.
100transactionallySchema_
100transactionallySchema_
101 :: MonadBaseControl IO io
101 :: MonadBaseControl IO io
102− => PQ schema0 schema1 io x
102+ => PQ schemas0 schemas1 io x
103− -> PQ schema0 schema1 io x
103+ -> PQ schemas0 schemas1 io x
104transactionallySchema_ = transactionallySchema defaultMode
104transactionallySchema_ = transactionallySchema defaultMode
105
105
106-- | The available transaction characteristics are the transaction `IsolationLevel`,
106-- | The available transaction characteristics are the transaction `IsolationLevel`,
squeal-postgresql/test/Specs/ExceptionHandling.hs+11−6
@@ -7,6 +7,7 @@
7{-# LANGUAGE OverloadedStrings #-}
7{-# LANGUAGE OverloadedStrings #-}
8{-# LANGUAGE TypeApplications #-}
8{-# LANGUAGE TypeApplications #-}
9{-# LANGUAGE TypeFamilies #-}
9{-# LANGUAGE TypeFamilies #-}
10+{-# LANGUAGE TypeInType #-}
10{-# LANGUAGE TypeOperators #-}
11{-# LANGUAGE TypeOperators #-}
11module ExceptionHandling
12module ExceptionHandling
12 ( specs
13 ( specs
@@ -45,6 +46,10 @@ type Schema =
45 ])
46 ])
46 ]
47 ]
47
48
49+type Schemas = Public Schema
50+
51+type DB = DBof Schemas
52+
48data User =
53data User =
49 User { userName :: Text
54 User { userName :: Text
50 , userEmail :: Maybe Text
55 , userEmail :: Maybe Text
@@ -53,13 +58,13 @@ data User =
53instance SOP.Generic User
58instance SOP.Generic User
54instance SOP.HasDatatypeInfo User
59instance SOP.HasDatatypeInfo User
55
60
56−insertUser :: Manipulation Schema '[ 'NotNull 'PGtext, 'NotNull ('PGvararray ('Null 'PGint2))]
61+insertUser :: Manipulation DB '[ 'NotNull 'PGtext, 'NotNull ('PGvararray ('Null 'PGint2))]
57 '[ "fromOnly" ::: 'NotNull 'PGint4 ]
62 '[ "fromOnly" ::: 'NotNull 'PGint4 ]
58insertUser = insertRows #users
63insertUser = insertRows #users
59 (Default `as` #id :* Set (param @1) `as` #name :* Set (param @2) `as` #vec) []
64 (Default `as` #id :* Set (param @1) `as` #name :* Set (param @2) `as` #vec) []
60 OnConflictDoRaise (Returning (#id `as` #fromOnly))
65 OnConflictDoRaise (Returning (#id `as` #fromOnly))
61
66
62−setup :: Definition '[] Schema
67+setup :: Definition (Public '[]) Schemas
63setup =
68setup =
64 createTable #users
69 createTable #users
65 ( serial `as` #id :*
70 ( serial `as` #id :*
@@ -76,10 +81,10 @@ setup =
76 foreignKey #user_id #users #id
81 foreignKey #user_id #users #id
77 OnDeleteCascade OnUpdateCascade `as` #fk_user_id )
82 OnDeleteCascade OnUpdateCascade `as` #fk_user_id )
78
83
79−teardown :: Definition Schema '[]
84+teardown :: Definition Schemas (Public '[])
80teardown = dropTable #emails >>> dropTable #users
85teardown = dropTable #emails >>> dropTable #users
81
86
82−migration :: Migration IO '[] Schema
87+migration :: Migration IO (Public '[]) Schemas
83migration = Migration { name = "test"
88migration = Migration { name = "test"
84 , up = void $ define setup
89 , up = void $ define setup
85 , down = void $ define teardown }
90 , down = void $ define teardown }
@@ -98,10 +103,10 @@ connectionString = "host=localhost port=5432 dbname=exampledb"
98testUser :: User
103testUser :: User
99testUser = User "TestUser" Nothing []
104testUser = User "TestUser" Nothing []
100
105
101−newUser :: (MonadBase IO m, MonadPQ Schema m) => User -> m ()
106+newUser :: (MonadBase IO m, MonadPQ Schemas m) => User -> m ()
102newUser u = void $ manipulateParams insertUser (userName u, userVec u)
107newUser u = void $ manipulateParams insertUser (userName u, userVec u)
103
108
104−insertUserTwice :: (MonadBase IO m, MonadPQ Schema m) => m ()
109+insertUserTwice :: (MonadBase IO m, MonadPQ Schemas m) => m ()
105insertUserTwice = newUser testUser >> newUser testUser
110insertUserTwice = newUser testUser >> newUser testUser
106
111
107specs :: SpecWith ()
112specs :: SpecWith ()