0f0e616 · squeal · git.iko.soy

git.iko.soy/squeal

Merge pull request #17 from echatav/query3

Query3

commit0f0e6167547e72db793aae42481e2214dd66a09c authorEitan Chatav <eitan.chatav@gmail.com> dateFri 9 Jun 2017, 11:48 (9 years ago) parent8d84822 8eb6478

4 files changed+205−175

compare with dev

unifiedsplit

squeel-postgresql/squeel-postgresql.cabal−1 squeel-postgresql/src/Squeel/PostgreSQL/PQ.hs+1−1 squeel-postgresql/src/Squeel/PostgreSQL/Query.hs+124−93 squeel-postgresql/test/Squeel/PostgreSQL/QuerySpec.hs+80−80

squeel-postgresql/squeel-postgresql.cabal−1

@@ -48,7 +48,6 @@ test-suite squeel-postgresql-test

4848 build-depends:

4949 base

5050 , Boolean

51− , bytestring

5251 , hspec

5352 , squeel-postgresql

5453 , vinyl

squeel-postgresql/src/Squeel/PostgreSQL/PQ.hs+1−1

@@ -77,7 +77,7 @@ class MonadPQ pq where

7777 :: (MonadBase IO io, ToOids ps)

7878 => ByteString

7979 -> Query ps db0 db1 xs

80− -> pq db0 db1 io (Maybe (Result []), PreparedQuery db0 db1 ps xs)

80+ -> pq db0 db1 io (Maybe (Result []), PreparedQuery ps db0 db1 xs)

8181

8282 pqExecPrepared

8383 :: (MonadBase IO io, ToValues xs ps)

squeel-postgresql/src/Squeel/PostgreSQL/Query.hs+124−93

@@ -6,8 +6,6 @@

66 , LambdaCase

77 , MagicHash

88 , OverloadedStrings

9− , PolyKinds

10− , ScopedTypeVariables

119 , TypeFamilies

1210 , TypeOperators

1311 , UndecidableInstances

@@ -62,8 +60,8 @@ instance {-# OVERLAPPING #-} KnownSymbol column

6260instance {-# OVERLAPPABLE #-} (KnownSymbol column, HasColumn column table ty)

6361 => HasColumn column (ty' ': table) ty

6462

65−instance HasColumn column columns ty

66− => IsLabel column (Expression params '[table ::: columns] ty) where

63+instance (HasColumn column columns ty, tables ~ '[table ::: columns])

64+ => IsLabel column (Expression params tables ty) where

6765 fromLabel = getColumn

6866

6967(.&.)

@@ -129,13 +127,25 @@ instance Boolean (Expression params tables 'PGBool) where

129127type instance BooleanOf (Expression params tables ty) =

130128 Expression params tables 'PGBool

131129

132−instance IfB (Expression params tables ty) where

133− ifB if_ then_ else_ = UnsafeExpression $ mconcat

134− [ "CASE WHEN ",renderExpression if_

135− , " THEN ",renderExpression then_

136− , " ELSE ",renderExpression else_

137− , " END"

130+caseWhenThenElse

131+ :: [(Expression params tables 'PGBool, Expression params tables ty)]

132+ -> Expression params tables ty

133+ -> Expression params tables ty

134+caseWhenThenElse whenThens else_ = UnsafeExpression $ mconcat

135+ [ "CASE"

136+ , mconcat

137+ [ mconcat

138+ [ " WHEN ", renderExpression when_

139+ , " THEN ", renderExpression then_

140+ ]

141+ | (when_,then_) <- whenThens

138142 ]

143+ , " ELSE ", renderExpression else_

144+ , " END"

145+ ]

146+

147+instance IfB (Expression params tables ty) where

148+ ifB if_ then_ else_ = caseWhenThenElse [(if_,then_)] else_

139149

140150instance EqB (Expression params tables ty) where

141151 (==*) = unsafeBinaryOp "="

@@ -167,120 +177,144 @@ crossJoin

167177 :: TableRef params schema '[table]

168178 -> TableRef params schema tables

169179 -> TableRef params schema (table ': tables)

170−crossJoin table tables = UnsafeTableRef $

171− renderTableRef tables <> " CROSS JOIN " <> renderTableRef table

180+crossJoin tab tabs = UnsafeTableRef $

181+ renderTableRef tabs <> " CROSS JOIN " <> renderTableRef tab

172182

173183innerJoin

174184 :: TableRef params schema '[table]

175185 -> Expression params (table ': tables) 'PGBool

176186 -> TableRef params schema tables

177187 -> TableRef params schema (table ': tables)

178−innerJoin table on tables = UnsafeTableRef $

179− renderTableRef tables

188+innerJoin tab on tabs = UnsafeTableRef $

189+ renderTableRef tabs

180190 <> " INNER JOIN " <>

181− renderTableRef table

191+ renderTableRef tab

182192 <> " ON " <>

183193 renderExpression on

184194

185−newtype Projection

186− (params :: [PGType])

187− (tables :: [(Symbol,[(Symbol,PGType)])])

188− (columns :: [(Symbol,PGType)]) =

189− UnsafeProjection { renderProjection :: ByteString }

190−

191−star :: Projection params '[table ::: columns] columns

192−star = UnsafeProjection "*"

193−

194−tableStar

195− :: HasTable table tables columns

196− => Alias table -> Projection params tables columns

197−tableStar (Alias table) = UnsafeProjection $

198− fromString (symbolVal' table) <> ".*"

195+data Clauses params tables = Clauses

196+ { whereClause :: Maybe (Expression params tables 'PGBool)

197+ , limitClause :: Maybe (Expression params '[] 'PGInt8)

198+ , offsetClause :: Maybe (Expression params '[] 'PGInt8)

199+ }

199200

200−project

201− :: Rec (Aliased (Expression params tables)) columns

202− -> Projection params tables columns

203−project

204− = UnsafeProjection

205− . ByteString.intercalate ", "

206− . recordToList

207− . rmap (Const . renderAliased renderExpression)

208−

209−data Tabulation

201+instance Monoid (Clauses params tables) where

202+ mempty = Clauses Nothing Nothing Nothing

203+ Clauses wh1 lim1 off1 `mappend` Clauses wh2 lim2 off2 = Clauses

204+ { whereClause = case (wh1,wh2) of

205+ (Nothing,Nothing) -> Nothing

206+ (Just w1,Nothing) -> Just w1

207+ (Nothing,Just w2) -> Just w2

208+ (Just w1,Just w2) -> Just (w1 &&* w2)

209+ , limitClause = case (lim1,lim2) of

210+ (Nothing,Nothing) -> Nothing

211+ (Just l1,Nothing) -> Just l1

212+ (Nothing,Just l2) -> Just l2

213+ (Just l1,Just l2) -> Just (l1 `minB` l2)

214+ , offsetClause = case (off1,off2) of

215+ (Nothing,Nothing) -> Nothing

216+ (Just o1,Nothing) -> Just o1

217+ (Nothing,Just o2) -> Just o2

218+ (Just o1,Just o2) -> Just (o1 + o2)

219+ }

220+

221+data TableExpression

210222 (params :: [PGType])

211223 (schema :: [(Symbol,[(Symbol,PGType)])])

212224 (tables :: [(Symbol,[(Symbol,PGType)])])

213− = Tabulation

214− { fromClause :: TableRef params schema tables

215− , whereClause :: Maybe (Expression params tables 'PGBool)

216− , limitClause :: Maybe (Expression params '[] 'PGInt8)

217− , offsetClause :: Maybe (Expression params '[] 'PGInt8)

225+ = TableExpression

226+ { tableRef :: TableRef params schema tables

227+ , clauses :: Clauses params tables

218228 }

219229

220−tabulation :: TableRef params schema tables -> Tabulation params schema tables

221−tabulation tab = Tabulation tab Nothing Nothing Nothing

230+tables

231+ :: TableRef params schema tables

232+ -> TableExpression params schema tables

233+tables tref = TableExpression tref mempty

222234

223−renderTabulation :: Tabulation params schema tables -> ByteString

224−renderTabulation (Tabulation fr wh lim off)= mconcat

225− [ renderTableRef fr

235+renderTabulation :: TableExpression params schema tables -> ByteString

236+renderTabulation (TableExpression tref (Clauses wh lim off))= mconcat

237+ [ renderTableRef tref

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

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

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

229241 ]

230242

231−instance HasTable table schema columns

232− => IsLabel table (TableRef params schema '[table ::: columns]) where

243+instance (HasTable table schema columns, table ~ table')

244+ => IsLabel table (TableRef params schema '[table' ::: columns]) where

233245 fromLabel = getTable

234246

235−instance HasTable table schema columns

236− => IsLabel table (Tabulation params schema '[table ::: columns]) where

237− fromLabel p = Tabulation (getTable p) Nothing Nothing Nothing

247+instance (HasTable table schema columns, table ~ table')

248+ => IsLabel table (TableExpression params schema '[table' ::: columns]) where

249+ fromLabel p = TableExpression (getTable p) mempty

238250

239251where_

240252 :: Expression params tables 'PGBool

241− -> Tabulation params schema tables

242− -> Tabulation params schema tables

243−where_ condition tables = tables

244− { whereClause = case whereClause tables of

245− Nothing -> Just condition

246− Just conditions -> Just (conditions &&* condition)

247− }

253+ -> TableExpression params schema tables

254+ -> TableExpression params schema tables

255+where_ wh (TableExpression tabs clauses1) = TableExpression tabs

256+ (clauses1 <> Clauses (Just wh) Nothing Nothing)

248257

249258limit

250259 :: Expression params '[] 'PGInt8

251− -> Tabulation params schema tables

252− -> Tabulation params schema tables

253−limit n tables = tables

254− { limitClause = case limitClause tables of

255− Nothing -> Just n

256− Just n' -> Just (n' `minB` n)

257− }

260+ -> TableExpression params schema tables

261+ -> TableExpression params schema tables

262+limit lim (TableExpression tabs clauses1) = TableExpression tabs

263+ (clauses1 <> Clauses Nothing (Just lim) Nothing)

258264

259265offset

260266 :: Expression params '[] 'PGInt8

261− -> Tabulation params schema tables

262− -> Tabulation params schema tables

263−offset n tables = tables

264− { offsetClause = case offsetClause tables of

265− Nothing -> Just n

266− Just n' -> Just (n' + n)

267− }

267+ -> TableExpression params schema tables

268+ -> TableExpression params schema tables

269+offset off (TableExpression tabs clauses1) = TableExpression tabs

270+ (clauses1 <> Clauses Nothing Nothing (Just off))

271+

272+newtype Selection

273+ (params :: [PGType])

274+ (schema :: [(Symbol,[(Symbol,PGType)])])

275+ (columns :: [(Symbol,PGType)])

276+ = UnsafeSelection

277+ { renderSelection :: ByteString }

268278

269−newtype Selection params schema columns = UnsafeSelection

270− { renderSelection :: ByteString }

279+starFrom

280+ :: tables ~ '[table ::: columns]

281+ => TableExpression params schema tables

282+ -> Selection params schema columns

283+starFrom tabs = UnsafeSelection $ "* FROM " <> renderTabulation tabs

284+

285+tableStarFrom

286+ :: HasTable table tables columns

287+ => Alias table

288+ -> TableExpression params schema tables

289+ -> Selection params schema columns

290+Alias tab `tableStarFrom` tabs = UnsafeSelection $

291+ fromString (symbolVal' tab) <> ".* FROM" <> renderTabulation tabs

271292

272293from

273− :: Projection params tables columns

274− -> Tabulation params schema tables

294+ :: Rec (Aliased (Expression params tables)) columns

295+ -> TableExpression params schema tables

275296 -> Selection params schema columns

276−from projection tables = UnsafeSelection $

277− renderProjection projection <> " FROM " <> renderTabulation tables

297+list `from` tabs = UnsafeSelection $

298+ renderList list <> " FROM " <> renderTabulation tabs

299+ where

300+ renderList

301+ = ByteString.intercalate ", "

302+ . recordToList

303+ . rmap (Const . renderAliased renderExpression)

278304

279−newtype Query params schema0 schema1 columns = UnsafeQuery

280− { renderQuery :: ByteString }

305+newtype Query

306+ (params :: [PGType])

307+ (schema0 :: [(Symbol,[(Symbol,PGType)])])

308+ (schema1 :: [(Symbol,[(Symbol,PGType)])])

309+ (columns :: [(Symbol,PGType)])

310+ = UnsafeQuery { renderQuery :: ByteString }

281311

282−newtype PreparedQuery params schema0 schema1 columns = UnsafePreparedQuery

283− { renderPreparedQuery :: ByteString }

312+newtype PreparedQuery

313+ (params :: [PGType])

314+ (schema0 :: [(Symbol,[(Symbol,PGType)])])

315+ (schema1 :: [(Symbol,[(Symbol,PGType)])])

316+ (columns :: [(Symbol,PGType)])

317+ = UnsafePreparedQuery { renderPreparedQuery :: ByteString }

284318

285319select

286320 :: Selection params schema columns

@@ -289,18 +323,15 @@ select = UnsafeQuery . ("SELECT " <>) . (<> ";") . renderSelection

289323

290324subselect

291325 :: Aliased (Selection params schema) table

292− -> Tabulation params schema '[table]

293−subselect selection = Tabulation

294− { fromClause = UnsafeTableRef . ("SELECT " <>) $

326+ -> TableExpression params schema '[table]

327+subselect selection = TableExpression

328+ { tableRef = UnsafeTableRef . ("SELECT " <>) $

295329 renderAliased renderSelection selection

296− , whereClause = Nothing

297− , limitClause = Nothing

298− , offsetClause = Nothing

330+ , clauses = mempty

299331 }

300332

301333insertInto

302− :: forall schema columns table params

303− . HasTable table schema columns

334+ :: HasTable table schema columns

304335 => Alias table

305336 -> Rec (Aliased (Expression params '[])) columns

306337 -> Query params schema schema '[]

squeel-postgresql/test/Squeel/PostgreSQL/QuerySpec.hs+80−80

@@ -3,14 +3,12 @@

33 , OverloadedLabels

44 , OverloadedStrings

55 , PolyKinds

6− , TypeApplications

76 , TypeOperators

87#-}

109module Squeel.PostgreSQL.QuerySpec where

1110

1211import Data.Boolean

13−import Data.ByteString

1412import Data.Function

1513import Data.Vinyl

1614import Test.Hspec

@@ -20,53 +18,82 @@ import Squeel.PostgreSQL.Schema

2018

2119spec :: Spec

2220spec = do

21+ let

22+ query `shouldRenderAs` str = renderQuery query `shouldBe` str

2323 it "correctly renders a simple SELECT query" $ do

24− select (sumAndCol1 `from` (table1 & where_ true))

25− `shouldRenderAs`

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

24+ let

25+ statement :: Query '[] Tables Tables SumAndCol1

26+ statement = select $

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

28+ `from` (#table1 & where_ true)

29+ statement `shouldRenderAs`

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

2731 it "combines WHEREs using AND" $ do

28− select (sumAndCol1 `from` (table1 & where_ true & where_ false))

29− `shouldRenderAs`

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

32+ let

33+ statement :: Query '[] Tables Tables SumAndCol1

34+ statement = select $

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

36+ `from` (#table1 & where_ true & where_ false)

37+ statement `shouldRenderAs`

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

3139 it "performs sub SELECTs" $ do

32− select (star `from` subselect ((sumAndCol1 `from` table1) `As` (#sub :: Alias "sub")))

33− `shouldRenderAs`

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

40+ let

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

42+ statement :: Query '[] Tables Tables SumAndCol1

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

44+ statement `shouldRenderAs`

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

3546 it "does LIMIT clauses" $ do

36− select (star `from` (table1 & limit 1))

37− `shouldRenderAs`

38− "SELECT * FROM table1 LIMIT 1;"

47+ let

48+ statement :: Query '[] Tables Tables Columns

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

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

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

40− select (star `from` (table1 & limit 1 & limit 2))

41− `shouldRenderAs`

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

52+ let

53+ statement :: Query '[] Tables Tables Columns

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

55+ statement `shouldRenderAs`

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

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

44− select (star `from` (parameterizedTable1 & limit param1))

45− `shouldRenderAs`

46− "SELECT * FROM table1 LIMIT $1;"

58+ let

59+ statement :: Query '[ 'PGInt8] Tables Tables Columns

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

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

4762 it "does OFFSET clauses" $ do

48− select (star `from` (table1 & offset 1))

49− `shouldRenderAs`

50− "SELECT * FROM table1 OFFSET 1;"

63+ let

64+ statement :: Query '[] Tables Tables Columns

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

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

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

52− select (star `from` (table1 & offset 1 & offset 2))

53− `shouldRenderAs`

54− "SELECT * FROM table1 OFFSET (1 + 2);"

68+ let

69+ statement :: Query '[] Tables Tables Columns

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

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

5572 it "correctly render simple INSERTs" $ do

56− insertInto @Tables @Columns

57− (#table1 :: Alias "table1")

58− (2 `As` #col1 :& 4 `As` #col2 :& RNil)

59− `shouldRenderAs`

60− "INSERT INTO table1 (col1, col2) VALUES (2, 4);"

73+ let

74+ statement :: Query '[] Tables Tables '[]

75+ statement = insertInto #table1 $ 2 `As` #col1 :& 4 `As` #col2 :& RNil

76+ statement `shouldRenderAs`

77+ "INSERT INTO table1 (col1, col2) VALUES (2, 4);"

6178 it "should be safe against SQL injection in literal text" $ do

62− insertInto @StudentsTable @StudentsColumns

63− (#students :: Alias "students")

64− ("Robert'); DROP TABLE students;" `As` #name :& RNil)

65− `shouldRenderAs`

66− "INSERT INTO students (name) VALUES (E'Robert''); DROP TABLE students;');"

79+ let

80+ statement :: Query '[] StudentsTable StudentsTable '[]

81+ statement = insertInto #students $

82+ "Robert'); DROP TABLE students;" `As` #name :& RNil

83+ statement `shouldRenderAs`

84+ "INSERT INTO students (name) VALUES (E'Robert''); DROP TABLE students;');"

6785 describe "JOINs" $ do

86+ let

87+ vals =

88+ #orders .&. #orderVal `As` #orderVal

89+ :& #customers .&. #customerVal `As` #customerVal

90+ :& #shippers .&. #shipperVal `As` #shipperVal :& RNil

6891 it "should render CROSS JOINs" $ do

69− select (vals `from` crossJoins) `shouldRenderAs`

92+ let

93+ statement :: Query '[] JoinTables JoinTables ValueColumns

94+ statement = select $ vals `from`

95+ (tables (#orders & crossJoin #customers & crossJoin #shippers))

96+ statement `shouldRenderAs`

7097 "SELECT\

7198 \ orders.orderVal AS orderVal,\

7299 \ customers.customerVal AS customerVal,\

@@ -75,7 +102,17 @@ spec = do

75102 \ CROSS JOIN customers\

76103 \ CROSS JOIN shippers;"

77104 it "should render INNER JOINs" $ do

78− select (vals `from` innerJoins) `shouldRenderAs`

105+ let

106+ innerJoins :: TableExpression '[] JoinTables JoinTables

107+ innerJoins = tables $

108+ #orders

109+ & innerJoin #customers

110+ (#orders .&. #customerID ==* #customers .&. #customerID)

111+ & innerJoin #shippers

112+ (#orders .&. #shipperID ==* #shippers .&. #shipperID)

113+ selection :: Query '[] JoinTables JoinTables ValueColumns

114+ selection = select $ vals `from` innerJoins

115+ selection `shouldRenderAs`

79116 "SELECT\

80117 \ orders.orderVal AS orderVal,\

81118 \ customers.customerVal AS customerVal,\

@@ -88,31 +125,9 @@ spec = do

88125

89126type Columns = '[ "col1" ::: 'PGInt4, "col2" ::: 'PGInt4]

90127type Tables = '[ "table1" ::: Columns ]

91−

92−sumAndCol1 :: Projection '[] Tables

93− '["sum" ::: 'PGInt4, "col1" ::: 'PGInt4]

94−sumAndCol1 = project $

95− (#col1 + #col2) `As` #sum

96− :& #col1 :& RNil

97−

98−literalText :: Projection '[] Tables '["literal" ::: 'PGText]

99−literalText = project $ "\';DROP TABLE table1;" `As` #literal :& RNil

100−

101−table1 :: Tabulation '[] Tables Tables

102−table1 = #table1

103−

104−parameterizedTable1 :: Tabulation '[ 'PGInt8] Tables Tables

105−parameterizedTable1 = #table1

106−

107−shouldRenderAs

108− :: Query params schema1 schema2 columns

109− -> ByteString

110− -> Expectation

111−shouldRenderAs query str = renderQuery query `shouldBe` str

112−

128+type SumAndCol1 = '[ "sum" ::: 'PGInt4, "col1" ::: 'PGInt4]

113129type StudentsColumns = '["name" ::: 'PGText]

114130type StudentsTable = '["students" ::: StudentsColumns]

115−

116131type OrderColumns =

117132 [ "orderID" ::: 'PGInt4

118133 , "orderVal" ::: 'PGText

@@ -124,27 +139,12 @@ type CustomerColumns =

124139type ShipperColumns =

125140 [ "shipperID" ::: 'PGInt4, "shipperVal" ::: 'PGBool ]

126141type JoinTables =

127− [ "shippers" ::: ShipperColumns

142+ [ "shippers" ::: ShipperColumns

128143 , "customers" ::: CustomerColumns

129− , "orders" ::: OrderColumns

144+ , "orders" ::: OrderColumns

130145 ]

131146type ValueColumns =

132− [ "orderVal" ::: 'PGText

147+ [ "orderVal" ::: 'PGText

133148 , "customerVal" ::: 'PGFloat4

134− , "shipperVal" ::: 'PGBool

149+ , "shipperVal" ::: 'PGBool

135150 ]

136−vals :: Projection '[] JoinTables ValueColumns

137−vals = project $

138− #orders .&. #orderVal `As` #orderVal

139− :& #customers .&. #customerVal `As` #customerVal

140− :& #shippers .&. #shipperVal `As` #shipperVal :& RNil

141−crossJoins :: Tabulation '[] JoinTables JoinTables

142−crossJoins = tabulation $

143− #orders & crossJoin #customers & crossJoin #shippers

144−innerJoins :: Tabulation '[] JoinTables JoinTables

145−innerJoins = tabulation $

146− #orders

147− & innerJoin #customers

148− (#orders .&. #customerID ==* #customers .&. #customerID)

149− & innerJoin #shippers

150− (#orders .&. #shipperID ==* #shippers .&. #shipperID)