git.iko.soy/squeal
on dev help sign in
self joins and table aliases and join expressions
commite86b699862dbab6999745926e4f972a756a2f2a4 authorEitan Chatav <eitan.chatav@gmail.com> dateTue 13 Jun 2017, 12:11 (9 years ago) parent93bb6a5
2 files changed+125−95
compare with dev
unifiedsplit
squeel-postgresql/src/Squeel/PostgreSQL/Statement.hs+97−78 squeel-postgresql/test/Squeel/PostgreSQL/StatementSpec.hs+28−17
squeel-postgresql/src/Squeel/PostgreSQL/Statement.hs+97−78
@@ -3,6 +3,7 @@
33 DataKinds
44 , FlexibleInstances
55 , FunctionalDependencies
6+ , GADTs
67 , LambdaCase
78 , MagicHash
89 , OverloadedStrings
@@ -158,77 +159,101 @@ instance OrdB (Expression params tables ty) where
158159 (<*) = unsafeBinaryOp "<"
159160 (<=*) = unsafeBinaryOp "<="
160161
161−newtype JoinExpression
162+newtype TableExpression
162163 (params :: [NullityType])
163164 (schema :: [(Symbol,[(Symbol,NullityType)])])
164− (tables :: [(Symbol,[(Symbol,NullityType)])])
165− = UnsafeJoinExpression { renderJoinExpression :: ByteString }
165+ (columns :: [(Symbol,NullityType)])
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+ ]
166201
167202class KnownSymbol table => HasTable table tables columns
168203 | table tables -> columns where
169− getTable :: Proxy# table -> JoinExpression params tables '[table ::: columns]
170− getTable table = UnsafeJoinExpression $ fromString $ symbolVal' table
204+ getTable :: Proxy# table -> TableExpression params tables columns
205+ getTable table = UnsafeTableExpression $ fromString $ symbolVal' table
171206instance {-# OVERLAPPING #-} KnownSymbol table
172207 => HasTable table ((table ::: columns) ': tables) columns
173208instance {-# OVERLAPPABLE #-}
174209 (KnownSymbol table, HasTable table schema columns)
175210 => HasTable table (table' ': schema) columns
176211
177−cross
178− :: JoinExpression params schema '[table]
179− -> JoinExpression params schema tables
180− -> JoinExpression params schema (table ': tables)
181−cross tab tabs = UnsafeJoinExpression $
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
188− -> JoinExpression params schema (table ': tables)
189−inner tab on tabs = UnsafeJoinExpression $
190− renderJoinExpression tabs
191− <> " INNER JOIN " <>
192− renderJoinExpression tab
193− <> " ON " <>
194− renderExpression on
195−
196−leftOuter
197− :: JoinExpression params schema '[right]
198− -> Expression params (right ': left : tables) ('NotNull 'PGBool)
199− -> JoinExpression params schema (tables)
200− -> JoinExpression params schema (NullifyTable right ': left ': tables)
201−leftOuter tab on tabs = UnsafeJoinExpression $
202− renderJoinExpression tabs
203− <> " LEFT OUTER JOIN " <>
204− renderJoinExpression tab
205− <> " ON " <>
206− renderExpression on
207−
208−rightOuter
209− :: JoinExpression params schema '[right]
210− -> Expression params (right ': tables) ('NotNull 'PGBool)
211− -> JoinExpression params schema (left : tables)
212− -> JoinExpression params schema (right ': NullifyTable left ': tables)
213−rightOuter tab on tabs = UnsafeJoinExpression $
214− renderJoinExpression tabs
215− <> " RIGHT OUTER JOIN " <>
216− renderJoinExpression tab
217− <> " ON " <>
218− renderExpression on
219−
220−fullOuter
221− :: JoinExpression params schema '[right]
222− -> Expression params (right ': left ': tables) ('NotNull 'PGBool)
223− -> JoinExpression params schema (left : tables)
224− -> JoinExpression params schema
225− (NullifyTable right ': NullifyTable left ': tables)
226−fullOuter tab on tabs = UnsafeJoinExpression $
227− renderJoinExpression tabs
228− <> " FULL OUTER JOIN " <>
229− renderJoinExpression tab
230− <> " ON " <>
231− renderExpression on
212+instance HasTable table schema columns
213+ => IsLabel table (TableExpression params schema columns) where
214+ fromLabel = getTable
215+
216+instance HasTable table schema columns
217+ => IsLabel table (JoinExpression params schema '[table ::: columns]) where
218+ fromLabel p = Table $ fromLabel p
219+
220+
221+-- leftOuter
222+-- :: JoinExpression params schema '[right]
223+-- -> Expression params (right ': left : tables) ('NotNull 'PGBool)
224+-- -> JoinExpression params schema (tables)
225+-- -> JoinExpression params schema (NullifyTable right ': left ': tables)
226+-- leftOuter tab on tabs = UnsafeJoinExpression $
227+-- renderJoinExpression tabs
228+-- <> " LEFT OUTER JOIN " <>
229+-- renderJoinExpression tab
230+-- <> " ON " <>
231+-- renderExpression on
232+--
233+-- rightOuter
234+-- :: JoinExpression params schema '[right]
235+-- -> Expression params (right ': tables) ('NotNull 'PGBool)
236+-- -> JoinExpression params schema (left : tables)
237+-- -> JoinExpression params schema (right ': NullifyTable left ': tables)
238+-- rightOuter tab on tabs = UnsafeJoinExpression $
239+-- renderJoinExpression tabs
240+-- <> " RIGHT OUTER JOIN " <>
241+-- renderJoinExpression tab
242+-- <> " ON " <>
243+-- renderExpression on
244+--
245+-- fullOuter
246+-- :: JoinExpression params schema '[right]
247+-- -> Expression params (right ': left ': tables) ('NotNull 'PGBool)
248+-- -> JoinExpression params schema (left : tables)
249+-- -> JoinExpression params schema
250+-- (NullifyTable right ': NullifyTable left ': tables)
251+-- fullOuter tab on tabs = UnsafeJoinExpression $
252+-- renderJoinExpression tabs
253+-- <> " FULL OUTER JOIN " <>
254+-- renderJoinExpression tab
255+-- <> " ON " <>
256+-- renderExpression on
232257
233258data Clauses params tables = Clauses
234259 { whereClause :: Maybe (Expression params tables ('NotNull 'PGBool))
@@ -260,31 +285,27 @@ data FromExpression
260285 (params :: [NullityType])
261286 (schema :: [(Symbol,[(Symbol,NullityType)])])
262287 (tables :: [(Symbol,[(Symbol,NullityType)])])
263− = FromExpression
264− { joinExpression :: JoinExpression params schema tables
265− , clauses :: Clauses params tables
266− }
288+ = FromExpression
289+ { joinExpression :: JoinExpression params schema tables
290+ , clauses :: Clauses params tables
291+ }
267292
268293join
269294 :: JoinExpression params schema tables
270295 -> FromExpression params schema tables
271296join tref = FromExpression tref mempty
272297
273−renderTabulation :: FromExpression params schema tables -> ByteString
274−renderTabulation (FromExpression tref (Clauses wh lim off))= mconcat
298+renderFromExpression :: FromExpression params schema tables -> ByteString
299+renderFromExpression (FromExpression tref (Clauses wh lim off))= mconcat
275300 [ renderJoinExpression tref
276301 , maybe "" ((" WHERE " <>) . renderExpression) wh
277302 , maybe "" ((" LIMIT " <>) . renderExpression) lim
278303 , maybe "" ((" OFFSET " <>) . renderExpression) off
279304 ]
280305
281−instance (HasTable table schema columns, table ~ table')
282− => IsLabel table (JoinExpression params schema '[table' ::: columns]) where
283− fromLabel = getTable
284−
285306instance (HasTable table schema columns, table ~ table')
286307 => IsLabel table (FromExpression params schema '[table' ::: columns]) where
287− fromLabel p = FromExpression (getTable p) mempty
308+ fromLabel p = FromExpression (fromLabel p) mempty
288309
289310where_
290311 :: Expression params tables ('NotNull 'PGBool)
@@ -311,14 +332,13 @@ newtype Selection
311332 (params :: [NullityType])
312333 (schema :: [(Symbol,[(Symbol,NullityType)])])
313334 (columns :: [(Symbol,NullityType)])
314− = UnsafeSelection
315− { renderSelection :: ByteString }
335+ = UnsafeSelection { renderSelection :: ByteString }
316336
317337starFrom
318338 :: tables ~ '[table ::: columns]
319339 => FromExpression params schema tables
320340 -> Selection params schema columns
321−starFrom tabs = UnsafeSelection $ "* FROM " <> renderTabulation tabs
341+starFrom tabs = UnsafeSelection $ "* FROM " <> renderFromExpression tabs
322342
323343dotStarFrom
324344 :: HasTable table tables columns
@@ -326,14 +346,14 @@ dotStarFrom
326346 -> FromExpression params schema tables
327347 -> Selection params schema columns
328348Alias tab `dotStarFrom` tabs = UnsafeSelection $
329− fromString (symbolVal' tab) <> ".* FROM" <> renderTabulation tabs
349+ fromString (symbolVal' tab) <> ".* FROM " <> renderFromExpression tabs
330350
331351from
332352 :: Rec (Aliased (Expression params tables)) columns
333353 -> FromExpression params schema tables
334354 -> Selection params schema columns
335355list `from` tabs = UnsafeSelection $
336− renderList list <> " FROM " <> renderTabulation tabs
356+ renderList list <> " FROM " <> renderFromExpression tabs
337357 where
338358 renderList
339359 = ByteString.intercalate ", "
@@ -363,8 +383,7 @@ subselect
363383 :: Aliased (Selection params schema) table
364384 -> FromExpression params schema '[table]
365385subselect selection = FromExpression
366− { joinExpression = UnsafeJoinExpression . ("SELECT " <>) $
367− renderAliased renderSelection selection
386+ { joinExpression = Subselect selection
368387 , clauses = mempty
369388 }
370389
squeel-postgresql/test/Squeel/PostgreSQL/StatementSpec.hs+28−17
@@ -28,7 +28,7 @@ spec = do
2828 ((#col1 + #col2) `As` #sum :& #col1 :& RNil)
2929 `from` (#table1 & where_ true)
3030 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;"
3232 it "combines WHEREs using AND" $ do
3333 let
3434 statement :: Statement '[] Tables Tables SumAndCol1
@@ -36,40 +36,40 @@ spec = do
3636 ((#col1 + #col2) `As` #sum :& #col1 :& RNil)
3737 `from` (#table1 & where_ true & where_ false)
3838 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);"
4040 it "performs sub SELECTs" $ do
4141 let
4242 selection = ((#col1 + #col2) `As` #sum :& #col1 :& RNil) `from` #table1
4343 statement :: Statement '[] Tables Tables SumAndCol1
4444 statement = select $ starFrom (subselect (selection `As` #sub))
4545 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;"
4747 it "does LIMIT clauses" $ do
4848 let
4949 statement :: Statement '[] Tables Tables Columns
5050 statement = select $ starFrom (#table1 & limit 1)
51− statement `shouldRenderAs` "SELECT * FROM table1 LIMIT 1;"
51+ statement `shouldRenderAs` "SELECT * FROM table1 AS table1 LIMIT 1;"
5252 it "should use the minimum of given LIMITs" $ do
5353 let
5454 statement :: Statement '[] Tables Tables Columns
5555 statement = select $ starFrom (#table1 & limit 1 & limit 2)
5656 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;"
5858 it "should render parameters using $ signs" $ do
5959 let
6060 statement :: Statement '[ 'NotNull 'PGInt8] Tables Tables Columns
6161 statement = select $ starFrom (#table1 & limit param1)
62− statement `shouldRenderAs` "SELECT * FROM table1 LIMIT $1;"
62+ statement `shouldRenderAs` "SELECT * FROM table1 AS table1 LIMIT $1;"
6363 it "does OFFSET clauses" $ do
6464 let
6565 statement :: Statement '[] Tables Tables Columns
6666 statement = select $ starFrom (#table1 & offset 1)
67− statement `shouldRenderAs` "SELECT * FROM table1 OFFSET 1;"
67+ statement `shouldRenderAs` "SELECT * FROM table1 AS table1 OFFSET 1;"
6868 it "should use the sum of given OFFSETs" $ do
6969 let
7070 statement :: Statement '[] Tables Tables Columns
7171 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);"
7373 it "correctly render simple INSERTs" $ do
7474 let
7575 statement :: Statement '[] Tables Tables '[]
@@ -93,23 +93,23 @@ spec = do
9393 let
9494 statement :: Statement '[] JoinTables JoinTables ValueColumns
9595 statement = select $ vals `from`
96− (join (#orders & cross #customers & cross #shippers))
96+ (join (#orders & Cross #customers & Cross #shippers))
9797 statement `shouldRenderAs`
9898 "SELECT\
9999 \ orders.orderVal AS orderVal,\
100100 \ customers.customerVal AS customerVal,\
101101 \ shippers.shipperVal AS shipperVal\
102− \ FROM orders\
103− \ CROSS JOIN customers\
104− \ CROSS JOIN shippers;"
102+ \ FROM orders AS orders\
103+ \ CROSS JOIN customers AS customers\
104+ \ CROSS JOIN shippers AS shippers;"
105105 it "should render INNER JOINs" $ do
106106 let
107107 innerJoins :: FromExpression '[] JoinTables JoinTables
108108 innerJoins = join $
109109 #orders
110− & inner #customers
110+ & Inner #customers
111111 (#orders .&. #customerID ==* #customers .&. #customerID)
112− & inner #shippers
112+ & Inner #shippers
113113 (#orders .&. #shipperID ==* #shippers .&. #shipperID)
114114 selection :: Statement '[] JoinTables JoinTables ValueColumns
115115 selection = select $ vals `from` innerJoins
@@ -118,11 +118,22 @@ spec = do
118118 \ orders.orderVal AS orderVal,\
119119 \ customers.customerVal AS customerVal,\
120120 \ shippers.shipperVal AS shipperVal\
121− \ FROM orders\
122− \ INNER JOIN customers\
121+ \ FROM orders AS orders\
122+ \ INNER JOIN customers AS customers\
123123 \ ON (orders.customerID = customers.customerID)\
124− \ INNER JOIN shippers\
124+ \ INNER JOIN shippers AS shippers\
125125 \ 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;"
126137 it "should render simple CREATE TABLE statements" $ do
127138 let
128139 statement :: Statement '[] '[] Tables '[]