e86b699 · squeal · git.iko.soy

git.iko.soy/squeal

on dev help sign in

self joins and table aliases and join expressions

e86b699Eitan Chatav9 years ago

squeel-postgresql/src/Squeel/PostgreSQL/Statement.hs+97−78

compare with dev

unifiedsplit

@@ -3,6 +3,7 @@

3 DataKinds

4 , FlexibleInstances

5 , FunctionalDependencies

6+ , GADTs

6 , LambdaCase

7 , LambdaCase

7 , MagicHash

8 , MagicHash

8 , OverloadedStrings

9 , OverloadedStrings

@@ -158,77 +159,101 @@ instance OrdB (Expression params tables ty) where

158 (<*) = unsafeBinaryOp "<"

159 (<*) = unsafeBinaryOp "<"

159 (<=*) = unsafeBinaryOp "<="

160 (<=*) = unsafeBinaryOp "<="

160

161

161−newtype JoinExpression

162+newtype TableExpression

162 (params :: [NullityType])

163 (params :: [NullityType])

163 (schema :: [(Symbol,[(Symbol,NullityType)])])

164 (schema :: [(Symbol,[(Symbol,NullityType)])])

164− (tables :: [(Symbol,[(Symbol,NullityType)])])

165+ (columns :: [(Symbol,NullityType)])

165− = UnsafeJoinExpression { renderJoinExpression :: ByteString }

166+ = UnsafeTableExpression { renderTableExpression :: ByteString }

167+

168+data JoinExpression params schema tables where

169+ Table

170+ :: Aliased (TableExpression params schema) table

171+ -> JoinExpression params schema '[table]

172+ Subselect

173+ :: Aliased (Selection params schema) table

174+ -> JoinExpression params schema '[table]

175+ Cross

176+ :: Aliased (TableExpression params schema) table

177+ -> JoinExpression params schema tables

178+ -> JoinExpression params schema (table ': tables)

179+ Inner

180+ :: Aliased (TableExpression params schema) table

181+ -> Expression params (table ': tables) ('NotNull 'PGBool)

182+ -> JoinExpression params schema tables

183+ -> JoinExpression params schema (table ': tables)

184+

185+renderJoinExpression :: JoinExpression params schema tables -> ByteString

186+renderJoinExpression = \case

187+ Table table -> renderAliased renderTableExpression table

188+ Subselect selection -> "SELECT " <> renderAliased renderSelection selection

189+ Cross table tables -> mconcat

190+ [ renderJoinExpression tables

191+ , " CROSS JOIN "

192+ , renderAliased renderTableExpression table

193+ ]

194+ Inner table on tables -> mconcat

195+ [ renderJoinExpression tables

196+ , " INNER JOIN "

197+ , renderAliased renderTableExpression table

198+ , " ON "

199+ , renderExpression on

200+ ]

166

201

167class KnownSymbol table => HasTable table tables columns

202class KnownSymbol table => HasTable table tables columns

168 | table tables -> columns where

203 | table tables -> columns where

169− getTable :: Proxy# table -> JoinExpression params tables '[table ::: columns]

204+ getTable :: Proxy# table -> TableExpression params tables columns

170− getTable table = UnsafeJoinExpression $ fromString $ symbolVal' table

205+ getTable table = UnsafeTableExpression $ fromString $ symbolVal' table

171instance {-# OVERLAPPING #-} KnownSymbol table

206instance {-# OVERLAPPING #-} KnownSymbol table

172 => HasTable table ((table ::: columns) ': tables) columns

207 => HasTable table ((table ::: columns) ': tables) columns

173instance {-# OVERLAPPABLE #-}

208instance {-# OVERLAPPABLE #-}

174 (KnownSymbol table, HasTable table schema columns)

209 (KnownSymbol table, HasTable table schema columns)

175 => HasTable table (table' ': schema) columns

210 => HasTable table (table' ': schema) columns

176

211

177−cross

212+instance HasTable table schema columns

178− :: JoinExpression params schema '[table]

213+ => IsLabel table (TableExpression params schema columns) where

179− -> JoinExpression params schema tables

214+ fromLabel = getTable

180− -> JoinExpression params schema (table ': tables)

215+

181−cross tab tabs = UnsafeJoinExpression $

216+instance HasTable table schema columns

182− renderJoinExpression tabs <> " CROSS JOIN " <> renderJoinExpression tab

183−

184−inner

185− :: JoinExpression params schema '[table]

186− -> Expression params (table ': tables) ('NotNull 'PGBool)

187− -> JoinExpression params schema tables

217+ => IsLabel table (JoinExpression params schema '[table ::: columns]) where

188− -> JoinExpression params schema (table ': tables)

218+ fromLabel p = Table $ fromLabel p

189−inner tab on tabs = UnsafeJoinExpression $

219+

190− renderJoinExpression tabs

220+

191− <> " INNER JOIN " <>

192− renderJoinExpression tab

193− <> " ON " <>

194− renderExpression on

195−

196−leftOuter

221+-- leftOuter

197− :: JoinExpression params schema '[right]

222+-- :: JoinExpression params schema '[right]

198− -> Expression params (right ': left : tables) ('NotNull 'PGBool)

223+-- -> Expression params (right ': left : tables) ('NotNull 'PGBool)

199− -> JoinExpression params schema (tables)

224+-- -> JoinExpression params schema (tables)

200− -> JoinExpression params schema (NullifyTable right ': left ': tables)

225+-- -> JoinExpression params schema (NullifyTable right ': left ': tables)

201−leftOuter tab on tabs = UnsafeJoinExpression $

226+-- leftOuter tab on tabs = UnsafeJoinExpression $

202− renderJoinExpression tabs

227+-- renderJoinExpression tabs

203− <> " LEFT OUTER JOIN " <>

228+-- <> " LEFT OUTER JOIN " <>

204− renderJoinExpression tab

229+-- renderJoinExpression tab

205− <> " ON " <>

230+-- <> " ON " <>

206− renderExpression on

231+-- renderExpression on

207−

232+--

208−rightOuter

233+-- rightOuter

209− :: JoinExpression params schema '[right]

234+-- :: JoinExpression params schema '[right]

210− -> Expression params (right ': tables) ('NotNull 'PGBool)

235+-- -> Expression params (right ': tables) ('NotNull 'PGBool)

211− -> JoinExpression params schema (left : tables)

236+-- -> JoinExpression params schema (left : tables)

212− -> JoinExpression params schema (right ': NullifyTable left ': tables)

237+-- -> JoinExpression params schema (right ': NullifyTable left ': tables)

213−rightOuter tab on tabs = UnsafeJoinExpression $

238+-- rightOuter tab on tabs = UnsafeJoinExpression $

214− renderJoinExpression tabs

239+-- renderJoinExpression tabs

215− <> " RIGHT OUTER JOIN " <>

240+-- <> " RIGHT OUTER JOIN " <>

216− renderJoinExpression tab

241+-- renderJoinExpression tab

217− <> " ON " <>

242+-- <> " ON " <>

218− renderExpression on

243+-- renderExpression on

219−

244+--

220−fullOuter

245+-- fullOuter

221− :: JoinExpression params schema '[right]

246+-- :: JoinExpression params schema '[right]

222− -> Expression params (right ': left ': tables) ('NotNull 'PGBool)

247+-- -> Expression params (right ': left ': tables) ('NotNull 'PGBool)

223− -> JoinExpression params schema (left : tables)

248+-- -> JoinExpression params schema (left : tables)

224− -> JoinExpression params schema

249+-- -> JoinExpression params schema

225− (NullifyTable right ': NullifyTable left ': tables)

250+-- (NullifyTable right ': NullifyTable left ': tables)

226−fullOuter tab on tabs = UnsafeJoinExpression $

251+-- fullOuter tab on tabs = UnsafeJoinExpression $

227− renderJoinExpression tabs

252+-- renderJoinExpression tabs

228− <> " FULL OUTER JOIN " <>

253+-- <> " FULL OUTER JOIN " <>

229− renderJoinExpression tab

254+-- renderJoinExpression tab

230− <> " ON " <>

255+-- <> " ON " <>

231− renderExpression on

256+-- renderExpression on

232

257

233data Clauses params tables = Clauses

258data Clauses params tables = Clauses

234 { whereClause :: Maybe (Expression params tables ('NotNull 'PGBool))

259 { whereClause :: Maybe (Expression params tables ('NotNull 'PGBool))

@@ -260,31 +285,27 @@ data FromExpression

260 (params :: [NullityType])

285 (params :: [NullityType])

261 (schema :: [(Symbol,[(Symbol,NullityType)])])

286 (schema :: [(Symbol,[(Symbol,NullityType)])])

262 (tables :: [(Symbol,[(Symbol,NullityType)])])

287 (tables :: [(Symbol,[(Symbol,NullityType)])])

263− = FromExpression

288+ = FromExpression

264− { joinExpression :: JoinExpression params schema tables

289+ { joinExpression :: JoinExpression params schema tables

265− , clauses :: Clauses params tables

290+ , clauses :: Clauses params tables

266− }

291+ }

267

292

268join

293join

269 :: JoinExpression params schema tables

294 :: JoinExpression params schema tables

270 -> FromExpression params schema tables

295 -> FromExpression params schema tables

271join tref = FromExpression tref mempty

296join tref = FromExpression tref mempty

272

297

273−renderTabulation :: FromExpression params schema tables -> ByteString

298+renderFromExpression :: FromExpression params schema tables -> ByteString

274−renderTabulation (FromExpression tref (Clauses wh lim off))= mconcat

299+renderFromExpression (FromExpression tref (Clauses wh lim off))= mconcat

275 [ renderJoinExpression tref

300 [ renderJoinExpression tref

276 , maybe "" ((" WHERE " <>) . renderExpression) wh

301 , maybe "" ((" WHERE " <>) . renderExpression) wh

277 , maybe "" ((" LIMIT " <>) . renderExpression) lim

302 , maybe "" ((" LIMIT " <>) . renderExpression) lim

278 , maybe "" ((" OFFSET " <>) . renderExpression) off

303 , maybe "" ((" OFFSET " <>) . renderExpression) off

279 ]

304 ]

280

305

281−instance (HasTable table schema columns, table ~ table')

282− => IsLabel table (JoinExpression params schema '[table' ::: columns]) where

283− fromLabel = getTable

284−

285instance (HasTable table schema columns, table ~ table')

306instance (HasTable table schema columns, table ~ table')

286 => IsLabel table (FromExpression params schema '[table' ::: columns]) where

307 => IsLabel table (FromExpression params schema '[table' ::: columns]) where

287− fromLabel p = FromExpression (getTable p) mempty

308+ fromLabel p = FromExpression (fromLabel p) mempty

288

309

289where_

310where_

290 :: Expression params tables ('NotNull 'PGBool)

311 :: Expression params tables ('NotNull 'PGBool)

@@ -311,14 +332,13 @@ newtype Selection

311 (params :: [NullityType])

332 (params :: [NullityType])

312 (schema :: [(Symbol,[(Symbol,NullityType)])])

333 (schema :: [(Symbol,[(Symbol,NullityType)])])

313 (columns :: [(Symbol,NullityType)])

334 (columns :: [(Symbol,NullityType)])

314− = UnsafeSelection

315− { renderSelection :: ByteString }

335+ = UnsafeSelection { renderSelection :: ByteString }

316

336

317starFrom

337starFrom

318 :: tables ~ '[table ::: columns]

338 :: tables ~ '[table ::: columns]

319 => FromExpression params schema tables

339 => FromExpression params schema tables

320 -> Selection params schema columns

340 -> Selection params schema columns

321−starFrom tabs = UnsafeSelection $ "* FROM " <> renderTabulation tabs

341+starFrom tabs = UnsafeSelection $ "* FROM " <> renderFromExpression tabs

322

342

323dotStarFrom

343dotStarFrom

324 :: HasTable table tables columns

344 :: HasTable table tables columns

@@ -326,14 +346,14 @@ dotStarFrom

326 -> FromExpression params schema tables

346 -> FromExpression params schema tables

327 -> Selection params schema columns

347 -> Selection params schema columns

328Alias tab `dotStarFrom` tabs = UnsafeSelection $

348Alias tab `dotStarFrom` tabs = UnsafeSelection $

329− fromString (symbolVal' tab) <> ".* FROM" <> renderTabulation tabs

349+ fromString (symbolVal' tab) <> ".* FROM " <> renderFromExpression tabs

330

350

331from

351from

332 :: Rec (Aliased (Expression params tables)) columns

352 :: Rec (Aliased (Expression params tables)) columns

333 -> FromExpression params schema tables

353 -> FromExpression params schema tables

334 -> Selection params schema columns

354 -> Selection params schema columns

335list `from` tabs = UnsafeSelection $

355list `from` tabs = UnsafeSelection $

336− renderList list <> " FROM " <> renderTabulation tabs

356+ renderList list <> " FROM " <> renderFromExpression tabs

337 where

357 where

338 renderList

358 renderList

339 = ByteString.intercalate ", "

359 = ByteString.intercalate ", "

@@ -363,8 +383,7 @@ subselect

363 :: Aliased (Selection params schema) table

383 :: Aliased (Selection params schema) table

364 -> FromExpression params schema '[table]

384 -> FromExpression params schema '[table]

365subselect selection = FromExpression

385subselect selection = FromExpression

366− { joinExpression = UnsafeJoinExpression . ("SELECT " <>) $

386+ { joinExpression = Subselect selection

367− renderAliased renderSelection selection

368 , clauses = mempty

387 , clauses = mempty

369 }

388 }

370

389

squeel-postgresql/test/Squeel/PostgreSQL/StatementSpec.hs+28−17

@@ -28,7 +28,7 @@ spec = do

28 ((#col1 + #col2) `As` #sum :& #col1 :& RNil)

29 `from` (#table1 & where_ true)

30 statement `shouldRenderAs`

31− "SELECT (col1 + col2) AS sum, col1 AS col1 FROM table1 WHERE TRUE;"

31+ "SELECT (col1 + col2) AS sum, col1 AS col1 FROM table1 AS table1 WHERE TRUE;"

32 it "combines WHEREs using AND" $ do

33 let

34 statement :: Statement '[] Tables Tables SumAndCol1

@@ -36,40 +36,40 @@ spec = do

36 ((#col1 + #col2) `As` #sum :& #col1 :& RNil)

37 `from` (#table1 & where_ true & where_ false)

38 statement `shouldRenderAs`

39− "SELECT (col1 + col2) AS sum, col1 AS col1 FROM table1 WHERE (TRUE AND FALSE);"

39+ "SELECT (col1 + col2) AS sum, col1 AS col1 FROM table1 AS table1 WHERE (TRUE AND FALSE);"

40 it "performs sub SELECTs" $ do

41 let

42 selection = ((#col1 + #col2) `As` #sum :& #col1 :& RNil) `from` #table1

43 statement :: Statement '[] Tables Tables SumAndCol1

44 statement = select $ starFrom (subselect (selection `As` #sub))

45 statement `shouldRenderAs`

46− "SELECT * FROM SELECT (col1 + col2) AS sum, col1 AS col1 FROM table1 AS sub;"

46+ "SELECT * FROM SELECT (col1 + col2) AS sum, col1 AS col1 FROM table1 AS table1 AS sub;"

47 it "does LIMIT clauses" $ do

48 let

49 statement :: Statement '[] Tables Tables Columns

50 statement = select $ starFrom (#table1 & limit 1)

51− statement `shouldRenderAs` "SELECT * FROM table1 LIMIT 1;"

51+ statement `shouldRenderAs` "SELECT * FROM table1 AS table1 LIMIT 1;"

52 it "should use the minimum of given LIMITs" $ do

53 let

54 statement :: Statement '[] Tables Tables Columns

55 statement = select $ starFrom (#table1 & limit 1 & limit 2)

56 statement `shouldRenderAs`

57− "SELECT * FROM table1 LIMIT CASE WHEN (1 <= 2) THEN 1 ELSE 2 END;"

57+ "SELECT * FROM table1 AS table1 LIMIT CASE WHEN (1 <= 2) THEN 1 ELSE 2 END;"

58 it "should render parameters using $ signs" $ do

59 let

60 statement :: Statement '[ 'NotNull 'PGInt8] Tables Tables Columns

61 statement = select $ starFrom (#table1 & limit param1)

62− statement `shouldRenderAs` "SELECT * FROM table1 LIMIT $1;"

62+ statement `shouldRenderAs` "SELECT * FROM table1 AS table1 LIMIT $1;"

63 it "does OFFSET clauses" $ do

64 let

65 statement :: Statement '[] Tables Tables Columns

66 statement = select $ starFrom (#table1 & offset 1)

67− statement `shouldRenderAs` "SELECT * FROM table1 OFFSET 1;"

67+ statement `shouldRenderAs` "SELECT * FROM table1 AS table1 OFFSET 1;"

68 it "should use the sum of given OFFSETs" $ do

69 let

70 statement :: Statement '[] Tables Tables Columns

71 statement = select $ starFrom (#table1 & offset 1 & offset 2)

72− statement `shouldRenderAs` "SELECT * FROM table1 OFFSET (1 + 2);"

72+ statement `shouldRenderAs` "SELECT * FROM table1 AS table1 OFFSET (1 + 2);"

73 it "correctly render simple INSERTs" $ do

74 let

75 statement :: Statement '[] Tables Tables '[]

@@ -93,23 +93,23 @@ spec = do

93 let

94 statement :: Statement '[] JoinTables JoinTables ValueColumns

95 statement = select $ vals `from`

96− (join (#orders & cross #customers & cross #shippers))

96+ (join (#orders & Cross #customers & Cross #shippers))

97 statement `shouldRenderAs`

98 "SELECT\

99 \ orders.orderVal AS orderVal,\

100 \ customers.customerVal AS customerVal,\

101 \ shippers.shipperVal AS shipperVal\

102− \ FROM orders\

102+ \ FROM orders AS orders\

103− \ CROSS JOIN customers\

103+ \ CROSS JOIN customers AS customers\

104− \ CROSS JOIN shippers;"

104+ \ CROSS JOIN shippers AS shippers;"

105 it "should render INNER JOINs" $ do

106 let

107 innerJoins :: FromExpression '[] JoinTables JoinTables

108 innerJoins = join $

109 #orders

110− & inner #customers

110+ & Inner #customers

111 (#orders .&. #customerID ==* #customers .&. #customerID)

112− & inner #shippers

112+ & Inner #shippers

113 (#orders .&. #shipperID ==* #shippers .&. #shipperID)

114 selection :: Statement '[] JoinTables JoinTables ValueColumns

115 selection = select $ vals `from` innerJoins

@@ -118,11 +118,22 @@ spec = do

118 \ orders.orderVal AS orderVal,\

119 \ customers.customerVal AS customerVal,\

120 \ shippers.shipperVal AS shipperVal\

121− \ FROM orders\

121+ \ FROM orders AS orders\

122− \ INNER JOIN customers\

122+ \ INNER JOIN customers AS customers\

123 \ ON (orders.customerID = customers.customerID)\

124− \ INNER JOIN shippers\

124+ \ INNER JOIN shippers AS shippers\

125 \ ON (orders.shipperID = shippers.shipperID);"

126+ it "should render self JOINs" $ do

127+ let

128+ statement :: Statement '[] JoinTables JoinTables OrderColumns

129+ statement = select $ #orders1 `dotStarFrom`

130+ (join

131+ ( Table (#orders `As` #orders1)

132+ & Cross (#orders `As` #orders2)))

133+ statement `shouldRenderAs`

134+ "SELECT orders1.*\

135+ \ FROM orders AS orders1\

136+ \ CROSS JOIN orders AS orders2;"

126 it "should render simple CREATE TABLE statements" $ do

137 it "should render simple CREATE TABLE statements" $ do

127 let

138 let

128 statement :: Statement '[] '[] Tables '[]

139 statement :: Statement '[] '[] Tables '[]