d7e5675 · squeal · git.iko.soy

git.iko.soy/squeal

better inference

and clauses

commitd7e5675ed2d76d336ed7e3a59d4afc4dac3fb1a5 authorEitan Chatav <eitan.chatav@gmail.com> dateSun 4 Jun 2017, 14:49 (9 years ago) parent3420aab

4 files changed+169−146

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+88−64 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+88−64

@@ -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(.&.)

@@ -167,18 +165,18 @@ crossJoin

167165 :: TableRef params schema '[table]

168166 -> TableRef params schema tables

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

170−crossJoin table tables = UnsafeTableRef $

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

168+crossJoin tab tabs = UnsafeTableRef $

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

172170

173171innerJoin

174172 :: TableRef params schema '[table]

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

176174 -> TableRef params schema tables

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

178−innerJoin table on tables = UnsafeTableRef $

179− renderTableRef tables

176+innerJoin tab on tabs = UnsafeTableRef $

177+ renderTableRef tabs

180178 <> " INNER JOIN " <>

181− renderTableRef table

179+ renderTableRef tab

182180 <> " ON " <>

183181 renderExpression on

184182

@@ -206,81 +204,110 @@ project

206204 . recordToList

207205 . rmap (Const . renderAliased renderExpression)

208206

209−data Tabulation

207+data Clauses params tables = Clauses

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

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

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

211+ }

212+

213+instance Monoid (Clauses params tables) where

214+ mempty = Clauses Nothing Nothing Nothing

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

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

217+ (Nothing,Nothing) -> Nothing

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

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

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

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

222+ (Nothing,Nothing) -> Nothing

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

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

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

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

227+ (Nothing,Nothing) -> Nothing

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

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

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

231+ }

232+

233+data TableExpression

210234 (params :: [PGType])

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

212236 (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)

237+ = TableExpression

238+ { tableRef :: TableRef params schema tables

239+ , clauses :: Clauses params tables

218240 }

219241

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

221−tabulation tab = Tabulation tab Nothing Nothing Nothing

242+tables

243+ :: TableRef params schema tables

244+ -> TableExpression params schema tables

245+tables tref = TableExpression tref mempty

222246

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

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

225− [ renderTableRef fr

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

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

249+ [ renderTableRef tref

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

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

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

229253 ]

230254

231−instance HasTable table schema columns

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

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

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

233257 fromLabel = getTable

234258

235−instance HasTable table schema columns

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

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

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

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

261+ fromLabel p = TableExpression (getTable p) mempty

238262

239263where_

240264 :: 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− }

265+ -> TableExpression params schema tables

266+ -> TableExpression params schema tables

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

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

248269

249270limit

250271 :: 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− }

272+ -> TableExpression params schema tables

273+ -> TableExpression params schema tables

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

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

258276

259277offset

260278 :: 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− }

279+ -> TableExpression params schema tables

280+ -> TableExpression params schema tables

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

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

268283

269−newtype Selection params schema columns = UnsafeSelection

270− { renderSelection :: ByteString }

284+newtype Selection

285+ (params :: [PGType])

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

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

288+ = UnsafeSelection

289+ { renderSelection :: ByteString }

271290

272291from

273− :: Projection params tables columns

274− -> Tabulation params schema tables

292+ :: TableExpression params schema tables

293+ -> Projection params tables columns

275294 -> Selection params schema columns

276−from projection tables = UnsafeSelection $

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

295+from tabs projection = UnsafeSelection $

296+ renderProjection projection <> " FROM " <> renderTabulation tabs

278297

279−newtype Query params schema0 schema1 columns = UnsafeQuery

280− { renderQuery :: ByteString }

298+newtype Query

299+ (params :: [PGType])

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

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

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

303+ = UnsafeQuery { renderQuery :: ByteString }

281304

282−newtype PreparedQuery params schema0 schema1 columns = UnsafePreparedQuery

283− { renderPreparedQuery :: ByteString }

305+newtype PreparedQuery

306+ (params :: [PGType])

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

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

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

310+ = UnsafePreparedQuery { renderPreparedQuery :: ByteString }

284311

285312select

286313 :: Selection params schema columns

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

289316

290317subselect

291318 :: Aliased (Selection params schema) table

292− -> Tabulation params schema '[table]

293−subselect selection = Tabulation

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

319+ -> TableExpression params schema '[table]

320+subselect selection = TableExpression

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

295322 renderAliased renderSelection selection

296− , whereClause = Nothing

297− , limitClause = Nothing

298− , offsetClause = Nothing

323+ , clauses = mempty

299324 }

300325

301326insertInto

302− :: forall schema columns table params

303− . HasTable table schema columns

327+ :: HasTable table schema columns

304328 => Alias table

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

306330 -> 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+ project ((#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+ project ((#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 = project ((#col1 + #col2) `As` #sum :& #col1 :& RNil) & from #table1

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

43+ statement = select $ star & from (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 $ star & from (#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 $ star & from (#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 $ star & from (#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 $ star & from (#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 $ star & from (#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 = project $

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)