b17b787 · squeal · git.iko.soy

git.iko.soy/squeal

on dev help sign in

docs & finalize FromClause

b17b787Eitan Chatav9 years ago

squeal-postgresql/exe/Example.hs+2−2

compare with dev

unifiedsplit

@@ -79,8 +79,8 @@ getUsers :: Query Schema '[]

79 , "userVec" ::: 'NotNull ('PGarray 'PGint2)]

80getUsers = select

81 (#u ! #name `As` #userName :* #e ! #email `As` #userEmail :* #u ! #vec `As` #userVec :* Nil)

82− ( from (Table (#users `As` #u)

82+ ( from (table (#users `As` #u)

83− & InnerJoin (Table (#emails `As` #e))

83+ & innerJoin (table (#emails `As` #e))

84 (#u ! #id .== #e ! #user_id)) )

86data User = User { userName :: Text, userEmail :: Maybe Text, userVec :: Vector (Maybe Int16) }

squeal-postgresql/squeal-postgresql.cabal+1

@@ -76,3 +76,4 @@ executable squeal-postgresql-example

76 , text >= 1.2.2.2 && < 2

77 , transformers >= 0.5.2.0 && < 1

78 , transformers-base >= 0.4.4 && < 1

79+ , vector

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

@@ -160,18 +160,6 @@ newtype TableConstraintExpression

160 { renderTableConstraintExpression :: ByteString }

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

162

163−data Column

164− (columns :: ColumnsType)

165− (column :: (Symbol,ColumnType))

166− where

167− Column

168− :: Has column columns ty

169− => Alias column

170− -> Column columns (column ::: ty)

171−

172−renderColumn :: Column columns column -> ByteString

173−renderColumn (Column column) = renderAlias column

174−

175-- | A `check` constraint is the most generic `TableConstraint` type.

163-- | A `check` constraint is the most generic `TableConstraint` type.

176-- It allows you to specify that the value in a certain column must satisfy

164-- It allows you to specify that the value in a certain column must satisfy

177-- a Boolean (truth-value) expression.

165-- a Boolean (truth-value) expression.

@@ -191,6 +179,20 @@ check

191check condition = UnsafeTableConstraintExpression $

179check condition = UnsafeTableConstraintExpression $

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

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

193

181

182+-- | @Column columns column@ is a witness that `column` is in `columns`.

183+data Column

184+ (columns :: ColumnsType)

185+ (column :: (Symbol,ColumnType))

186+ where

187+ Column

188+ :: Has column columns ty

189+ => Alias column

190+ -> Column columns (column ::: ty)

191+

192+-- | Render a `Column`.

193+renderColumn :: Column columns column -> ByteString

194+renderColumn (Column column) = renderAlias column

195+

194-- | A `unique` constraint ensure that the data contained in a column,

196-- | A `unique` constraint ensure that the data contained in a column,

195-- or a group of columns, is unique among all the rows in the table.

197-- or a group of columns, is unique among all the rows in the table.

196--

198--

@@ -400,6 +402,17 @@ addConstraint constraintName constraint = UnsafeAlterTable $

400 "ADD" <+> "CONSTRAINT" <+> renderAlias constraintName

402 "ADD" <+> "CONSTRAINT" <+> renderAlias constraintName

401 <+> renderTableConstraintExpression constraint

403 <+> renderTableConstraintExpression constraint

402

404

405+-- | A `dropConstraint` drops a table constraint.

406+--

407+-- >>> :{

408+-- let

409+-- definition :: Definition

410+-- '["tab" ::: '["positive" ::: Check ] :=> '["col" ::: 'NoDef :=> 'NotNull 'PGint4]]

411+-- '["tab" ::: '[] :=> '["col" ::: 'NoDef :=> 'NotNull 'PGint4]]

412+-- definition = alterTable #tab (dropConstraint #positive)

413+-- in renderDefinition definition

414+-- :}

415+-- "ALTER TABLE tab DROP CONSTRAINT positive;"

403dropConstraint

416dropConstraint

404 :: KnownSymbol constraintName

417 :: KnownSymbol constraintName

405 => Alias constraintName

418 => Alias constraintName

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

@@ -344,8 +344,11 @@ nullIf

344nullIf x y = UnsafeExpression $ "NULL IF" <+> parenthesized

345 (renderExpression x <> ", " <> renderExpression y)

346

347+-- | >>> renderExpression $ array [null_, unNull false, unNull true]

348+-- "ARRAY[NULL, FALSE, TRUE]"

347array

349array

348 :: [Expression tables grouping params ('Null ty)]

350 :: [Expression tables grouping params ('Null ty)]

351+ -- ^ array elements

349 -> Expression tables grouping params (nullity ('PGarray ty))

352 -> Expression tables grouping params (nullity ('PGarray ty))

350array xs = UnsafeExpression $

353array xs = UnsafeExpression $

351 "ARRAY[" <> commaSeparated (renderExpression <$> xs) <> "]"

354 "ARRAY[" <> commaSeparated (renderExpression <$> xs) <> "]"

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

@@ -133,27 +133,6 @@ in renderManipulation manipulation

133:}

134"INSERT INTO tab (col1, col2) VALUES (2, DEFAULT) RETURNING col1 AS fromOnly;"

135

136−query insert:

137−

138−>>> :{

139−let

140− manipulation :: Manipulation

141− '[ "tab" ::: '[] :=>

142− '[ "col1" ::: 'NoDef :=> 'NotNull 'PGint4

143− , "col2" ::: 'NoDef :=> 'NotNull 'PGint4

144− ]

145− , "other_tab" ::: '[] :=>

146− '[ "col1" ::: 'NoDef :=> 'NotNull 'PGint4

147− , "col2" ::: 'NoDef :=> 'NotNull 'PGint4

148− ]

149− ] '[] '[]

150− manipulation =

151− insertQuery_ #tab

152− (selectStar (from (Table (#other_tab `As` #t))))

153−in renderManipulation manipulation

154−:}

155−"INSERT INTO tab SELECT * FROM other_tab AS t;"

156−

157upsert:

136upsert:

158

137

159>>> :{

138>>> :{

@@ -204,6 +183,7 @@ insertRows tab row rows conflict returning = UnsafeManipulation $

204 Default -> "DEFAULT"

183 Default -> "DEFAULT"

205 Set expression -> renderExpression expression

184 Set expression -> renderExpression expression

206

185

186+-- | Insert a single row.

207insertRow

187insertRow

208 :: ( SOP.SListI columns

188 :: ( SOP.SListI columns

209 , SOP.SListI results

189 , SOP.SListI results

@@ -217,6 +197,7 @@ insertRow

217 -> Manipulation schema params results

197 -> Manipulation schema params results

218insertRow tab row = insertRows tab row []

198insertRow tab row = insertRows tab row []

219

199

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

220insertRows_

201insertRows_

221 :: ( SOP.SListI columns

202 :: ( SOP.SListI columns

222 , Has tab schema table

203 , Has tab schema table

@@ -228,6 +209,7 @@ insertRows_

228insertRows_ tab row rows =

209insertRows_ tab row rows =

229 insertRows tab row rows OnConflictDoRaise (Returning Nil)

210 insertRows tab row rows OnConflictDoRaise (Returning Nil)

230

211

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

231insertRow_

213insertRow_

232 :: ( SOP.SListI columns

214 :: ( SOP.SListI columns

233 , Has tab schema table

215 , Has tab schema table

@@ -237,6 +219,27 @@ insertRow_

237 -> Manipulation schema params '[]

219 -> Manipulation schema params '[]

238insertRow_ tab row = insertRow tab row OnConflictDoRaise (Returning Nil)

220insertRow_ tab row = insertRow tab row OnConflictDoRaise (Returning Nil)

239

221

222+{- | Insert a query.

223+

224+>>> :{

225+let

226+ manipulation :: Manipulation

227+ '[ "tab" ::: '[] :=>

228+ '[ "col1" ::: 'NoDef :=> 'NotNull 'PGint4

229+ , "col2" ::: 'NoDef :=> 'NotNull 'PGint4

230+ ]

231+ , "other_tab" ::: '[] :=>

232+ '[ "col1" ::: 'NoDef :=> 'NotNull 'PGint4

233+ , "col2" ::: 'NoDef :=> 'NotNull 'PGint4

234+ ]

235+ ] '[] '[]

236+ manipulation =

237+ insertQuery_ #tab

238+ (selectStar (from (table (#other_tab `As` #t))))

239+in renderManipulation manipulation

240+:}

241+"INSERT INTO tab SELECT * FROM other_tab AS t;"

242+-}

240insertQuery

243insertQuery

241 :: ( SOP.SListI columns

244 :: ( SOP.SListI columns

242 , SOP.SListI results

245 , SOP.SListI results

@@ -254,6 +257,7 @@ insertQuery tab query conflict returning = UnsafeManipulation $

254 <> renderConflictClause conflict

257 <> renderConflictClause conflict

255 <> renderReturningClause returning

258 <> renderReturningClause returning

256

259

260+-- | Insert a query returning `Nil` and raising an error on conflicts.

257insertQuery_

261insertQuery_

258 :: ( SOP.SListI columns

262 :: ( SOP.SListI columns

259 , Has tab schema table

263 , Has tab schema table

@@ -264,6 +268,11 @@ insertQuery_

264insertQuery_ tab query =

268insertQuery_ tab query =

265 insertQuery tab query OnConflictDoRaise (Returning Nil)

269 insertQuery tab query OnConflictDoRaise (Returning Nil)

266

270

271+-- | `ColumnValue`s are values to insert or update in a row

272+-- `Same` updates with the same value.

273+-- `Default` inserts or updates with the @DEFAULT@ value

274+-- `Set` a value to be an `Expression`, relative to the given

275+-- row for an update, and closed for an insert.

267data ColumnValue

276data ColumnValue

268 (columns :: RelationType)

277 (columns :: RelationType)

269 (params :: [NullityType])

278 (params :: [NullityType])

@@ -351,6 +360,9 @@ renderConflictClause = \case

351UPDATE statements

360UPDATE statements

352-----------------------------------------}

361-----------------------------------------}

353

362

363+-- | An `update` command changes the values of the specified columns

364+-- in all rows that satisfy the condition.

365+--

354update

366update

355 :: ( SOP.SListI columns

367 :: ( SOP.SListI columns

356 , SOP.SListI results

368 , SOP.SListI results

@@ -363,9 +375,9 @@ update

363 -- ^ condition under which to perform update on a row

375 -- ^ condition under which to perform update on a row

364 -> ReturningClause columns params results -- ^ results to return

376 -> ReturningClause columns params results -- ^ results to return

365 -> Manipulation schema params results

377 -> Manipulation schema params results

366−update table columns wh returning = UnsafeManipulation $

378+update tab columns wh returning = UnsafeManipulation $

367 "UPDATE"

379 "UPDATE"

368− <+> renderAlias table

380+ <+> renderAlias tab

369 <+> "SET"

381 <+> "SET"

370 <+> renderCommaSeparatedMaybe renderUpdate columns

382 <+> renderCommaSeparatedMaybe renderUpdate columns

371 <+> "WHERE" <+> renderExpression wh

383 <+> "WHERE" <+> renderExpression wh

@@ -381,9 +393,7 @@ update table columns wh returning = UnsafeManipulation $

381 Set expression `As` column -> Just $

393 Set expression `As` column -> Just $

382 renderAlias column <+> "=" <+> renderExpression expression

394 renderAlias column <+> "=" <+> renderExpression expression

383

395

384−-- | An `update` command changes the values of the specified columns

396+-- | Update a row returning `Nil`.

385−-- in all rows that satisfy the condition.

386−--

387-- >>> :{

397-- >>> :{

388-- let

398-- let

389-- manipulation :: Manipulation

399-- manipulation :: Manipulation

@@ -406,7 +416,7 @@ update_

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

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

407 -- ^ condition under which to perform update on a row

417 -- ^ condition under which to perform update on a row

408 -> Manipulation schema params '[]

418 -> Manipulation schema params '[]

409−update_ table columns wh = update table columns wh (Returning Nil)

419+update_ tab columns wh = update tab columns wh (Returning Nil)

410

420

411{-----------------------------------------

421{-----------------------------------------

412DELETE statements

422DELETE statements

@@ -435,11 +445,12 @@ deleteFrom

435 -- ^ condition under which to delete a row

445 -- ^ condition under which to delete a row

436 -> ReturningClause columns params results -- ^ results to return

446 -> ReturningClause columns params results -- ^ results to return

437 -> Manipulation schema params results

447 -> Manipulation schema params results

438−deleteFrom table wh returning = UnsafeManipulation $

448+deleteFrom tab wh returning = UnsafeManipulation $

439− "DELETE FROM" <+> renderAlias table

449+ "DELETE FROM" <+> renderAlias tab

440 <+> "WHERE" <+> renderExpression wh

450 <+> "WHERE" <+> renderExpression wh

441 <> renderReturningClause returning

451 <> renderReturningClause returning

442

452

453+-- | Delete rows returning `Nil`.

443deleteFrom_

454deleteFrom_

444 :: ( Has tab schema table

455 :: ( Has tab schema table

445 , columns ~ TableToColumns table )

456 , columns ~ TableToColumns table )

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

@@ -56,7 +56,13 @@ module Squeal.PostgreSQL.Query

56 , offset

57 -- * From

58 , FromClause (..)

59− , renderFromClause

59+ , table

60+ , subquery

61+ , crossJoin

62+ , innerJoin

63+ , leftOuterJoin

64+ , rightOuterJoin

65+ , fullOuterJoin

60 -- * Grouping

66 -- * Grouping

61 , By (By, By2)

67 , By (By, By2)

62 , renderBy

68 , renderBy

@@ -97,7 +103,7 @@ let

97 '["tab" ::: '[] :=> '["col" ::: 'NoDef :=> 'Null 'PGint4]]

103 '["tab" ::: '[] :=> '["col" ::: 'NoDef :=> 'Null 'PGint4]]

98 '[]

104 '[]

99 '["col" ::: 'Null 'PGint4]

105 '["col" ::: 'Null 'PGint4]

100− query = selectStar (from (Table (#tab `As` #t)))

106+ query = selectStar (from (table (#tab `As` #t)))

101in renderQuery query

107in renderQuery query

102:}

108:}

103"SELECT * FROM tab AS t"

109"SELECT * FROM tab AS t"

@@ -116,7 +122,7 @@ let

116 query =

122 query =

117 select

123 select

118 ((#col1 + #col2) `As` #sum :* #col1 `As` #col1 :* Nil)

124 ((#col1 + #col2) `As` #sum :* #col1 `As` #col1 :* Nil)

119− ( from (Table (#tab `As` #t))

125+ ( from (table (#tab `As` #t))

120 & where_ (#col1 .> #col2)

126 & where_ (#col1 .> #col2)

121 & where_ (#col2 .> 0) )

127 & where_ (#col2 .> 0) )

122in renderQuery query

128in renderQuery query

@@ -133,7 +139,7 @@ let

133 '["col" ::: 'Null 'PGint4]

139 '["col" ::: 'Null 'PGint4]

134 query =

140 query =

135 selectStar

141 selectStar

136− (from (Subquery (selectStar (from (Table (#tab `As` #t))) `As` #sub)))

142+ (from (subquery (selectStar (from (table (#tab `As` #t))) `As` #sub)))

137in renderQuery query

143in renderQuery query

138:}

144:}

139"SELECT * FROM (SELECT * FROM tab AS t) AS sub"

145"SELECT * FROM (SELECT * FROM tab AS t) AS sub"

@@ -147,7 +153,7 @@ let

147 '[]

153 '[]

148 '["col" ::: 'Null 'PGint4]

154 '["col" ::: 'Null 'PGint4]

149 query = selectStar

155 query = selectStar

150− (from (Table (#tab `As` #t)) & limit 100 & offset 2 & limit 50 & offset 2)

156+ (from (table (#tab `As` #t)) & limit 100 & offset 2 & limit 50 & offset 2)

151in renderQuery query

157in renderQuery query

152:}

158:}

153"SELECT * FROM tab AS t LIMIT 50 OFFSET 4"

159"SELECT * FROM tab AS t LIMIT 50 OFFSET 4"

@@ -161,7 +167,7 @@ let

161 '[ 'NotNull 'PGfloat8]

167 '[ 'NotNull 'PGfloat8]

162 '["col" ::: 'NotNull 'PGfloat8]

168 '["col" ::: 'NotNull 'PGfloat8]

163 query = selectStar

169 query = selectStar

164− (from (Table (#tab `As` #t)) & where_ (#col .> param @1))

170+ (from (table (#tab `As` #t)) & where_ (#col .> param @1))

165in renderQuery query

171in renderQuery query

166:}

172:}

167"SELECT * FROM tab AS t WHERE (col > ($1 :: float8))"

173"SELECT * FROM tab AS t WHERE (col > ($1 :: float8))"

@@ -179,7 +185,7 @@ let

179 , "col1" ::: 'NotNull 'PGint4 ]

185 , "col1" ::: 'NotNull 'PGint4 ]

180 query =

186 query =

181 select (sum_ #col2 `As` #sum :* #col1 `As` #col1 :* Nil)

187 select (sum_ #col2 `As` #sum :* #col1 `As` #col1 :* Nil)

182− ( from (Table (#tab `As` #table1))

188+ ( from (table (#tab `As` #table1))

183 & group (By #col1 :* Nil)

189 & group (By #col1 :* Nil)

184 & having (#col1 + sum_ #col2 .> 1) )

190 & having (#col1 + sum_ #col2 .> 1) )

185in renderQuery query

191in renderQuery query

@@ -195,7 +201,7 @@ let

195 '[]

201 '[]

196 '["col" ::: 'Null 'PGint4]

202 '["col" ::: 'Null 'PGint4]

197 query = selectStar

203 query = selectStar

198− (from (Table (#tab `As` #t)) & orderBy [#col & AscNullsFirst])

204+ (from (table (#tab `As` #t)) & orderBy [#col & AscNullsFirst])

199in renderQuery query

205in renderQuery query

200:}

206:}

201"SELECT * FROM tab AS t ORDER BY col ASC NULLS FIRST"

207"SELECT * FROM tab AS t ORDER BY col ASC NULLS FIRST"

@@ -235,10 +241,10 @@ let

235 ( #o ! #price `As` #order_price :*

241 ( #o ! #price `As` #order_price :*

236 #c ! #name `As` #customer_name :*

242 #c ! #name `As` #customer_name :*

237 #s ! #name `As` #shipper_name :* Nil )

243 #s ! #name `As` #shipper_name :* Nil )

238− ( from (Table (#orders `As` #o)

244+ ( from (table (#orders `As` #o)

239− & InnerJoin (Table (#customers `As` #c))

245+ & innerJoin (table (#customers `As` #c))

240 (#o ! #customer_id .== #c ! #id)

246 (#o ! #customer_id .== #c ! #id)

241− & InnerJoin (Table (#shippers `As` #s))

247+ & innerJoin (table (#shippers `As` #s))

242 (#o ! #shipper_id .== #s ! #id)) )

248 (#o ! #shipper_id .== #s ! #id)) )

243in renderQuery query

249in renderQuery query

244:}

250:}

@@ -253,7 +259,7 @@ let

253 '[]

259 '[]

254 '["col" ::: 'Null 'PGint4]

260 '["col" ::: 'Null 'PGint4]

255 query = selectDotStar #t1

261 query = selectDotStar #t1

256− (from (Table (#tab `As` #t1) & CrossJoin (Table (#tab `As` #t2))))

262+ (from (table (#tab `As` #t1) & crossJoin (table (#tab `As` #t2))))

257in renderQuery query

263in renderQuery query

258:}

264:}

259"SELECT t1.* FROM tab AS t1 CROSS JOIN tab AS t2"

265"SELECT t1.* FROM tab AS t1 CROSS JOIN tab AS t2"

@@ -267,14 +273,13 @@ let

267 '[]

273 '[]

268 '["col" ::: 'Null 'PGint4]

274 '["col" ::: 'Null 'PGint4]

269 query =

275 query =

270− selectStar (from (Table (#tab `As` #t)))

276+ selectStar (from (table (#tab `As` #t)))

271 `unionAll`

277 `unionAll`

272− selectStar (from (Table (#tab `As` #t)))

278+ selectStar (from (table (#tab `As` #t)))

273in renderQuery query

279in renderQuery query

274:}

280:}

275"(SELECT * FROM tab AS t) UNION ALL (SELECT * FROM tab AS t)"

281"(SELECT * FROM tab AS t) UNION ALL (SELECT * FROM tab AS t)"

276-}

282-}

277−

278newtype Query

283newtype Query

279 (schema :: TablesType)

284 (schema :: TablesType)

280 (params :: [NullityType])

285 (params :: [NullityType])

@@ -411,8 +416,8 @@ selectDotStar

411 -> TableExpression schema params tables 'Ungrouped

416 -> TableExpression schema params tables 'Ungrouped

412 -- ^ intermediate virtual table

417 -- ^ intermediate virtual table

413 -> Query schema params columns

418 -> Query schema params columns

414−selectDotStar table tables = UnsafeQuery $

419+selectDotStar tab tables = UnsafeQuery $

415− "SELECT" <+> renderAlias table <> ".*" <+> renderTableExpression tables

420+ "SELECT" <+> renderAlias tab <> ".*" <+> renderTableExpression tables

416

421

417-- | A `selectDistinctDotStar` asks for all the columns of a particular table,

422-- | A `selectDistinctDotStar` asks for all the columns of a particular table,

418-- and eliminates duplicate rows.

423-- and eliminates duplicate rows.

@@ -423,8 +428,8 @@ selectDistinctDotStar

423 -> TableExpression schema params tables 'Ungrouped

428 -> TableExpression schema params tables 'Ungrouped

424 -- ^ intermediate virtual table

429 -- ^ intermediate virtual table

425 -> Query schema params columns

430 -> Query schema params columns

426−selectDistinctDotStar table tables = UnsafeQuery $

431+selectDistinctDotStar tab tables = UnsafeQuery $

427− "SELECT DISTINCT" <+> renderAlias table <> ".*"

432+ "SELECT DISTINCT" <+> renderAlias tab <> ".*"

428 <+> renderTableExpression tables

433 <+> renderTableExpression tables

429

434

430{-----------------------------------------

435{-----------------------------------------

@@ -590,93 +595,108 @@ FROM clauses

590{- |

595{- |

591A `FromClause` can be a table name, or a derived table such

596A `FromClause` can be a table name, or a derived table such

592as a subquery, a @JOIN@ construct, or complex combinations of these.

597as a subquery, a @JOIN@ construct, or complex combinations of these.

593−

598+-}

594−* A real `Table` is a table from the schema.

599+newtype FromClause schema params tables

595−

600+ = UnsafeFromClause { renderFromClause :: ByteString }

601+ deriving (GHC.Generic,Show,Eq,Ord,NFData)

602+

603+-- | A real `table` is a table from the schema.

604+table

605+ :: Aliased (Table schema) table

606+ -> FromClause schema params '[table]

607+table = UnsafeFromClause . renderAliasedAs renderTable

608+

596−* `Subquery` derives a table from a `Query`.

609+-- | `subquery` derives a table from a `Query`.

597−

610+subquery

598−* A joined table is a table derived from two other (real or derived) tables

611+ :: Aliased (Query schema params) table

599−according to the rules of the particular join type. `CrossJoin`, `InnerJoin`,

612+ -> FromClause schema params '[table]

600−`LeftOuterJoin`, `RightOuterJoin` and `FullOuterJoin` are available and can

613+subquery = UnsafeFromClause . renderAliasedAs (parenthesized . renderQuery)

601−be nested using the `&` operator to match the left-to-right sequencing of

614+

602−their placement in SQL.

603−

604− * @t1 & CrossJoin t2@. For every possible combination of rows from

615+{- | @t1 & crossJoin t2@. For every possible combination of rows from

605 @t1@ and @t2@ (i.e., a Cartesian product), the joined table will contain

616 @t1@ and @t2@ (i.e., a Cartesian product), the joined table will contain

606 a row consisting of all columns in @t1@ followed by all columns in @t2@.

617 a row consisting of all columns in @t1@ followed by all columns in @t2@.

607 If the tables have @n@ and @m@ rows respectively, the joined table will

618 If the tables have @n@ and @m@ rows respectively, the joined table will

608 have @n * m@ rows.

619 have @n * m@ rows.

609−

620+-}

621+crossJoin

622+ :: FromClause schema params right

623+ -- ^ right

624+ -> FromClause schema params left

625+ -- ^ left

626+ -> FromClause schema params (Join left right)

627+crossJoin right left = UnsafeFromClause $

628+ renderFromClause left <+> "CROSS JOIN" <+> renderFromClause right

629+

610− * @t1 & InnerJoin t2 on@. For each row @r1@ of @t1@, the joined

630+{- | @t1 & InnerJoin t2 on@. For each row @r1@ of @t1@, the joined

611 table has a row for each row in @t2@ that satisfies the @on@ condition

631 table has a row for each row in @t2@ that satisfies the @on@ condition

612 with @r1@

632 with @r1@

613−

633+-}

634+innerJoin

635+ :: FromClause schema params right

636+ -- ^ right

637+ -> Condition (Join left right) 'Ungrouped params

638+ -- ^ @ON@ condition

639+ -> FromClause schema params left

640+ -- ^ left

641+ -> FromClause schema params (Join left right)

642+innerJoin right on left = UnsafeFromClause $

643+ renderFromClause left <+> "INNER JOIN" <+> renderFromClause right

644+ <+> "ON" <+> renderExpression on

645+

614− * @t1 & LeftOuterJoin t2 on@. First, an inner join is performed.

646+{- | @t1 & LeftOuterJoin t2 on@. First, an inner join is performed.

615 Then, for each row in @t1@ that does not satisfy the @on@ condition with

647 Then, for each row in @t1@ that does not satisfy the @on@ condition with

616 any row in @t2@, a joined row is added with null values in columns of @t2@.

648 any row in @t2@, a joined row is added with null values in columns of @t2@.

617 Thus, the joined table always has at least one row for each row in @t1@.

649 Thus, the joined table always has at least one row for each row in @t1@.

618−

650+-}

651+leftOuterJoin

652+ :: FromClause schema params right

653+ -- ^ right

654+ -> Condition (Join left right) 'Ungrouped params

655+ -- ^ @ON@ condition

656+ -> FromClause schema params left

657+ -- ^ left

658+ -> FromClause schema params (Join left (NullifyTables right))

659+leftOuterJoin right on left = UnsafeFromClause $

660+ renderFromClause left <+> "LEFT OUTER JOIN" <+> renderFromClause right

661+ <+> "ON" <+> renderExpression on

662+

619− * @t1 & RightOuterJoin t2 on@. First, an inner join is performed.

663+{- | @t1 & RightOuterJoin t2 on@. First, an inner join is performed.

620 Then, for each row in @t2@ that does not satisfy the @on@ condition with

664 Then, for each row in @t2@ that does not satisfy the @on@ condition with

621 any row in @t1@, a joined row is added with null values in columns of @t1@.

665 any row in @t1@, a joined row is added with null values in columns of @t1@.

622 This is the converse of a left join: the result table will always

666 This is the converse of a left join: the result table will always

623 have a row for each row in @t2@.

667 have a row for each row in @t2@.

624−

668+-}

669+rightOuterJoin

670+ :: FromClause schema params right

671+ -- ^ right

672+ -> Condition (Join left right) 'Ungrouped params

673+ -- ^ @ON@ condition

674+ -> FromClause schema params left

675+ -- ^ left

676+ -> FromClause schema params (Join (NullifyTables left) right)

677+rightOuterJoin right on left = UnsafeFromClause $

678+ renderFromClause left <+> "RIGHT OUTER JOIN" <+> renderFromClause right

679+ <+> "ON" <+> renderExpression on

680+

625− * @t1 & FullOuterJoin t2 on@. First, an inner join is performed.

681+{- | @t1 & FullOuterJoin t2 on@. First, an inner join is performed.

626 Then, for each row in @t1@ that does not satisfy the @on@ condition with

682 Then, for each row in @t1@ that does not satisfy the @on@ condition with

627 any row in @t2@, a joined row is added with null values in columns of @t2@.

683 any row in @t2@, a joined row is added with null values in columns of @t2@.

628 Also, for each row of @t2@ that does not satisfy the join condition

684 Also, for each row of @t2@ that does not satisfy the join condition

629 with any row in @t1@, a joined row with null values in the columns of @t1@

685 with any row in @t1@, a joined row with null values in the columns of @t1@

630 is added.

686 is added.

631-}

687-}

632−data FromClause schema params tables where

688+fullOuterJoin

633− Table

634− :: Aliased (Table schema) table

635− -> FromClause schema params '[table]

689+ :: FromClause schema params right

636− Subquery

690+ -- ^ right

637− :: Aliased (Query schema params) table

638− -> FromClause schema params '[table]

639− CrossJoin

640− :: FromClause schema params right

641− -> FromClause schema params left

642− -> FromClause schema params (Join left right)

643− InnerJoin

644− :: FromClause schema params right

645− -> Condition (Join left right) 'Ungrouped params

691+ -> Condition (Join left right) 'Ungrouped params

646− -> FromClause schema params left

692+ -- ^ @ON@ condition

647− -> FromClause schema params (Join left right)

648− LeftOuterJoin

649− :: FromClause schema params right

650− -> Condition (Join left right) 'Ungrouped params

651− -> FromClause schema params left

652− -> FromClause schema params (Join left (NullifyTables right))

693+ -> FromClause schema params left

653− RightOuterJoin

694+ -- ^ left

654− :: FromClause schema params right

655− -> Condition (Join left right) 'Ungrouped params

656− -> FromClause schema params left

657− -> FromClause schema params (Join (NullifyTables left) right)

658− FullOuterJoin

659− :: FromClause schema params right

660− -> Condition (Join left right) 'Ungrouped params

661− -> FromClause schema params left

695+ -> FromClause schema params

662− -> FromClause schema params

663− (Join (NullifyTables left) (NullifyTables right))

696+ (Join (NullifyTables left) (NullifyTables right))

664−

697+fullOuterJoin right on left = UnsafeFromClause $

665−-- | Renders a `FromClause`.

666−renderFromClause :: FromClause schema params tables -> ByteString

667−renderFromClause = \case

668− Table table -> renderAliasedAs renderTable table

669− Subquery selection -> renderAliasedAs (parenthesized . renderQuery) selection

670− CrossJoin right left ->

671− renderFromClause left <+> "CROSS JOIN" <+> renderFromClause right

672− InnerJoin right on left -> renderJoin "INNER JOIN" right on left

673− LeftOuterJoin right on left -> renderJoin "LEFT OUTER JOIN" right on left

674− RightOuterJoin right on left -> renderJoin "RIGHT OUTER JOIN" right on left

675− FullOuterJoin right on left -> renderJoin "FULL OUTER JOIN" right on left

676− where

677− renderJoin op right on left =

678− renderFromClause left <+> op <+> renderFromClause right

698+ renderFromClause left <+> "FULL OUTER JOIN" <+> renderFromClause right

679− <+> "ON" <+> renderExpression on

699+ <+> "ON" <+> renderExpression on

680

700

681{-----------------------------------------

701{-----------------------------------------

682Grouping

702Grouping

@@ -706,7 +726,7 @@ deriving instance Ord (By tables by)

706renderBy :: By tables tabcolty -> ByteString

726renderBy :: By tables tabcolty -> ByteString

707renderBy = \case

727renderBy = \case

708 By column -> renderAlias column

728 By column -> renderAlias column

709− By2 (table, column) -> renderAlias table <> "." <> renderAlias column

729+ By2 (tab, column) -> renderAlias tab <> "." <> renderAlias column

710

730

711-- | A `GroupByClause` indicates the `Grouping` of a `TableExpression`.

731-- | A `GroupByClause` indicates the `Grouping` of a `TableExpression`.

712-- A `NoGroups` indicates `Ungrouped` while a `Group` indicates `Grouped`.

732-- A `NoGroups` indicates `Ungrouped` while a `Group` indicates `Grouped`.

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

@@ -126,6 +126,7 @@ data PGType

126 | PGarrayN Nat PGType -- ^ fixed length array

127 | UnsafePGType Symbol -- ^ an escape hatch for unsupported PostgreSQL types

128

129+-- | The object identifier of a `PGType`.

129class Oid (ty :: PGType) where oid :: proxy ty -> Word32

130class Oid (ty :: PGType) where oid :: proxy ty -> Word32

130instance Oid 'PGbool where oid _ = 16

131instance Oid 'PGbool where oid _ = 16

131instance Oid 'PGint2 where oid _ = 21

132instance Oid 'PGint2 where oid _ = 21

@@ -372,9 +373,13 @@ type family Create alias x xs where

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

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

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

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

374

375

376+-- | Add a column to a `TableType` with

377+-- `Squeal.PostgreSQL.Definition.addColumn`.

375type family AddColumn alias x y where

378type family AddColumn alias x y where

376 AddColumn alias x (constraints :=> xs) = constraints :=> Create alias x xs

379 AddColumn alias x (constraints :=> xs) = constraints :=> Create alias x xs

377

380

381+-- | Add a constraint to a `TableType` with

382+-- `Squeal.PostgreSQL.Definition.addConstraint`.

378type family AddConstraint alias x y where

383type family AddConstraint alias x y where

379 AddConstraint alias x (constraints :=> xs) = Create alias x constraints :=> xs

384 AddConstraint alias x (constraints :=> xs) = Create alias x constraints :=> xs

380

385