git.iko.soy/squeal
on dev help sign in
Merge pull request #19 from echatav/self-join
871b2a2Eitan Chatav
squeel-postgresql/src/Squeel/PostgreSQL/PQ.hs+2−2
compare with dev
unifiedsplit
@@ -35,8 +35,8 @@ import Squeel.PostgreSQL.Schema
35newtype Connection db = Connection { unConnection :: LibPQ.Connection }
35newtype Connection db = Connection { unConnection :: LibPQ.Connection }
36
36
37newtype PQ
37newtype PQ
38− (db0 :: [(Symbol,[(Symbol,PGType)])])
38+ (db0 :: [(Symbol,[(Symbol,NullityType)])])
39− (db1 :: [(Symbol,[(Symbol,PGType)])])
39+ (db1 :: [(Symbol,[(Symbol,NullityType)])])
40 (m :: * -> *)
40 (m :: * -> *)
41 (x :: *) =
41 (x :: *) =
42 PQ { runPQ :: Connection db0 -> m (x, Connection db1) }
42 PQ { runPQ :: Connection db0 -> m (x, Connection db1) }
squeel-postgresql/src/Squeel/PostgreSQL/Schema.hs+44−4
@@ -9,6 +9,7 @@
9 , PolyKinds
9 , PolyKinds
10 , RankNTypes
10 , RankNTypes
11 , ScopedTypeVariables
11 , ScopedTypeVariables
12+ , TypeFamilies
12 , TypeOperators
13 , TypeOperators
13#-}
14#-}
14
15
@@ -23,6 +24,10 @@ module Squeel.PostgreSQL.Schema
23 , KnownPGType (..)
24 , KnownPGType (..)
24 , KnownColumns (..)
25 , KnownColumns (..)
25 , renderAliased
26 , renderAliased
27+ , NullityType (..)
28+ , NullifyType
29+ , NullifyColumns
30+ , NullifyTable
26 , module GHC.OverloadedLabels
31 , module GHC.OverloadedLabels
27 , module GHC.TypeLits
32 , module GHC.TypeLits
28 ) where
33 ) where
@@ -134,24 +139,59 @@ instance KnownPGType 'PGUuid where renderPGType _ = "uuid"
134instance KnownPGType 'PGJson where renderPGType _ = "json"
139instance KnownPGType 'PGJson where renderPGType _ = "json"
135instance KnownPGType 'PGJsonb where renderPGType _ = "jsonb"
140instance KnownPGType 'PGJsonb where renderPGType _ = "jsonb"
136
141
137−class KnownColumns (columns :: [(Symbol,PGType)]) where
142+class KnownColumns (columns :: [(Symbol,NullityType)]) where
138 renderColumns :: Proxy# columns -> ByteString
143 renderColumns :: Proxy# columns -> ByteString
139instance
144instance
140 ( KnownSymbol column
145 ( KnownSymbol column
141 , KnownPGType ty
146 , KnownPGType ty
142− ) => KnownColumns '[column ::: ty] where
147+ ) => KnownColumns '[column ::: 'NotNull ty] where
143 renderColumns _ =
148 renderColumns _ =
144 fromString (symbolVal' (proxy# :: Proxy# column))
149 fromString (symbolVal' (proxy# :: Proxy# column))
145 <> " "
150 <> " "
146 <> renderPGType (proxy# :: Proxy# ty)
151 <> renderPGType (proxy# :: Proxy# ty)
152+ <> " NOT NULL"
153+instance
154+ ( KnownSymbol column
155+ , KnownPGType ty
156+ ) => KnownColumns '[column ::: 'Null ty] where
157+ renderColumns _ =
158+ fromString (symbolVal' (proxy# :: Proxy# column))
159+ <> " "
160+ <> renderPGType (proxy# :: Proxy# ty)
161+ <> " NULL"
162+instance
163+ ( KnownSymbol column
164+ , KnownPGType ty
165+ , KnownColumns (columnsHead ': columnsTail)
166+ ) => KnownColumns ((column ::: 'NotNull ty) ': columnsHead ': columnsTail) where
167+ renderColumns _ =
168+ fromString (symbolVal' (proxy# :: Proxy# column))
169+ <> " "
170+ <> renderPGType (proxy# :: Proxy# ty)
171+ <> " NOT NULL, "
172+ <> renderColumns (proxy# :: Proxy# (columnsHead ': columnsTail))
147instance
173instance
148 ( KnownSymbol column
174 ( KnownSymbol column
149 , KnownPGType ty
175 , KnownPGType ty
150 , KnownColumns (columnsHead ': columnsTail)
176 , KnownColumns (columnsHead ': columnsTail)
151− ) => KnownColumns ((column ::: ty) ': columnsHead ': columnsTail) where
177+ ) => KnownColumns ((column ::: 'Null ty) ': columnsHead ': columnsTail) where
152 renderColumns _ =
178 renderColumns _ =
153 fromString (symbolVal' (proxy# :: Proxy# column))
179 fromString (symbolVal' (proxy# :: Proxy# column))
154 <> " "
180 <> " "
155 <> renderPGType (proxy# :: Proxy# ty)
181 <> renderPGType (proxy# :: Proxy# ty)
156− <> ", "
182+ <> " NULL, "
157 <> renderColumns (proxy# :: Proxy# (columnsHead ': columnsTail))
183 <> renderColumns (proxy# :: Proxy# (columnsHead ': columnsTail))
184+
185+data NullityType = Null PGType | NotNull PGType
186+
187+type family NullifyType nullty where
188+ NullifyType ('Null ty) = 'Null ty
189+ NullifyType ('NotNull ty) = 'Null ty
190+
191+type family NullifyColumns columns where
192+ NullifyColumns '[] = '[]
193+ NullifyColumns ((column ::: ty) ': columns) =
194+ (column ::: (NullifyType ty)) ': (NullifyColumns columns)
195+
196+type family NullifyTable table where
197+ NullifyTable (table ::: columns) = table ::: NullifyColumns columns
squeel-postgresql/src/Squeel/PostgreSQL/Statement.hs+199−94
@@ -3,6 +3,7 @@
3 DataKinds
3 DataKinds
4 , FlexibleInstances
4 , FlexibleInstances
5 , FunctionalDependencies
5 , FunctionalDependencies
6+ , GADTs
6 , LambdaCase
7 , LambdaCase
7 , MagicHash
8 , MagicHash
8 , OverloadedStrings
9 , OverloadedStrings
@@ -15,6 +16,7 @@ module Squeel.PostgreSQL.Statement where
15
16
16import Data.Boolean
17import Data.Boolean
17import Data.ByteString (ByteString)
18import Data.ByteString (ByteString)
19+import Data.Maybe
18import Data.Monoid
20import Data.Monoid
19import Data.String
21import Data.String
20import Data.Vinyl
22import Data.Vinyl
@@ -28,9 +30,9 @@ import qualified Data.ByteString as ByteString
28import Squeel.PostgreSQL.Schema
30import Squeel.PostgreSQL.Schema
29
31
30newtype Expression
32newtype Expression
31− (params :: [PGType])
33+ (params :: [NullityType])
32− (tables :: [(Symbol,[(Symbol,PGType)])])
34+ (tables :: [(Symbol,[(Symbol,NullityType)])])
33− (ty :: PGType)
35+ (ty :: NullityType)
34 = UnsafeExpression { renderExpression :: ByteString }
36 = UnsafeExpression { renderExpression :: ByteString }
35
37
36class KnownNat n => HasParameter (n :: Nat) params ty | n params -> ty where
38class KnownNat n => HasParameter (n :: Nat) params ty | n params -> ty where
@@ -94,7 +96,7 @@ unsafeFunction
94unsafeFunction fn x = UnsafeExpression $ mconcat
96unsafeFunction fn x = UnsafeExpression $ mconcat
95 [fn, "(", renderExpression x, ")"]
97 [fn, "(", renderExpression x, ")"]
96
98
97−instance PGNum ty => Num (Expression params tables ty) where
99+instance PGNum ty => Num (Expression params tables (nullity ty)) where
98 (+) = unsafeBinaryOp "+"
100 (+) = unsafeBinaryOp "+"
99 (-) = unsafeBinaryOp "-"
101 (-) = unsafeBinaryOp "-"
100 (*) = unsafeBinaryOp "*"
102 (*) = unsafeBinaryOp "*"
@@ -102,7 +104,7 @@ instance PGNum ty => Num (Expression params tables ty) where
102 signum = unsafeFunction "sign"
104 signum = unsafeFunction "sign"
103 fromInteger = UnsafeExpression . fromString . show
105 fromInteger = UnsafeExpression . fromString . show
104
106
105−instance IsString (Expression params tables 'PGText) where
107+instance IsString (Expression params tables (nullity 'PGText)) where
106 fromString str = UnsafeExpression $
108 fromString str = UnsafeExpression $
107 "E\'" <> fromString (escape =<< str) <> "\'"
109 "E\'" <> fromString (escape =<< str) <> "\'"
108 where
110 where
@@ -117,7 +119,7 @@ instance IsString (Expression params tables 'PGText) where
117 '\\' -> "\\\\"
119 '\\' -> "\\\\"
118 c -> [c]
120 c -> [c]
119
121
120−instance Boolean (Expression params tables 'PGBool) where
122+instance Boolean (Expression params tables ('NotNull 'PGBool)) where
121 true = UnsafeExpression "TRUE"
123 true = UnsafeExpression "TRUE"
122 false = UnsafeExpression "FALSE"
124 false = UnsafeExpression "FALSE"
123 notB = unsafeUnaryOp "NOT"
125 notB = unsafeUnaryOp "NOT"
@@ -125,10 +127,21 @@ instance Boolean (Expression params tables 'PGBool) where
125 (||*) = unsafeBinaryOp "OR"
127 (||*) = unsafeBinaryOp "OR"
126
128
127type instance BooleanOf (Expression params tables ty) =
129type instance BooleanOf (Expression params tables ty) =
128− Expression params tables 'PGBool
130+ Expression params tables ('NotNull 'PGBool)
131+
132+coalesce
133+ :: [Expression params tables ('Null x)]
134+ -> Expression params tables ('NotNull x)
135+ -> Expression params tables ('NotNull x)
136+coalesce nulls notNull = UnsafeExpression $ mconcat
137+ [ "COALESCE("
138+ , ByteString.intercalate ", " $ map renderExpression nulls
139+ , ", ", renderExpression notNull
140+ , ")"
141+ ]
129
142
130caseWhenThenElse
143caseWhenThenElse
131− :: [(Expression params tables 'PGBool, Expression params tables ty)]
144+ :: [(Expression params tables ('NotNull 'PGBool), Expression params tables ty)]
132 -> Expression params tables ty
145 -> Expression params tables ty
133 -> Expression params tables ty
146 -> Expression params tables ty
134caseWhenThenElse whenThens else_ = UnsafeExpression $ mconcat
147caseWhenThenElse whenThens else_ = UnsafeExpression $ mconcat
@@ -157,45 +170,105 @@ instance OrdB (Expression params tables ty) where
157 (<*) = unsafeBinaryOp "<"
170 (<*) = unsafeBinaryOp "<"
158 (<=*) = unsafeBinaryOp "<="
171 (<=*) = unsafeBinaryOp "<="
159
172
160−newtype TableRef
173+newtype TableExpression
161− (params :: [PGType])
174+ (params :: [NullityType])
162− (schema :: [(Symbol,[(Symbol,PGType)])])
175+ (schema :: [(Symbol,[(Symbol,NullityType)])])
163− (tables :: [(Symbol,[(Symbol,PGType)])])
176+ (columns :: [(Symbol,NullityType)])
164− = UnsafeTableRef { renderTableRef :: ByteString }
177+ = UnsafeTableExpression { renderTableExpression :: ByteString }
178+
179+data JoinExpression params schema tables where
180+ Table
181+ :: Aliased (TableExpression params schema) table
182+ -> JoinExpression params schema '[table]
183+ Subselect
184+ :: Aliased (Selection params schema) table
185+ -> JoinExpression params schema '[table]
186+ Cross
187+ :: Aliased (TableExpression params schema) table
188+ -> JoinExpression params schema tables
189+ -> JoinExpression params schema (table ': tables)
190+ Inner
191+ :: Aliased (TableExpression params schema) table
192+ -> Expression params (table ': tables) ('NotNull 'PGBool)
193+ -> JoinExpression params schema tables
194+ -> JoinExpression params schema (table ': tables)
195+ LeftOuter
196+ :: Aliased (TableExpression params schema) right
197+ -> Expression params '[left,right] ('NotNull 'PGBool)
198+ -> JoinExpression params schema (tables)
199+ -> JoinExpression params schema (NullifyTable right ': left ': tables)
200+ RightOuter
201+ :: Aliased (TableExpression params schema) right
202+ -> Expression params '[left,right] ('NotNull 'PGBool)
203+ -> JoinExpression params schema (left : tables)
204+ -> JoinExpression params schema (right ': NullifyTable left ': tables)
205+ FullOuter
206+ :: Aliased (TableExpression params schema) right
207+ -> Expression params '[left,right] ('NotNull 'PGBool)
208+ -> JoinExpression params schema (left : tables)
209+ -> JoinExpression params schema
210+ (NullifyTable right ': NullifyTable left ': tables)
211+
212+renderJoinExpression :: JoinExpression params schema tables -> ByteString
213+renderJoinExpression = \case
214+ Table table -> renderAliased renderTableExpression table
215+ Subselect selection -> "SELECT " <> renderAliased renderSelection selection
216+ Cross table tables -> mconcat
217+ [ renderJoinExpression tables
218+ , " CROSS JOIN "
219+ , renderAliased renderTableExpression table
220+ ]
221+ Inner table on tables -> mconcat
222+ [ renderJoinExpression tables
223+ , " INNER JOIN "
224+ , renderAliased renderTableExpression table
225+ , " ON "
226+ , renderExpression on
227+ ]
228+ LeftOuter table on tables -> mconcat
229+ [ renderJoinExpression tables
230+ , " LEFT OUTER JOIN "
231+ , renderAliased renderTableExpression table
232+ , " ON "
233+ , renderExpression on
234+ ]
235+ RightOuter table on tables -> mconcat
236+ [ renderJoinExpression tables
237+ , " RIGHT OUTER JOIN "
238+ , renderAliased renderTableExpression table
239+ , " ON "
240+ , renderExpression on
241+ ]
242+ FullOuter table on tables -> mconcat
243+ [ renderJoinExpression tables
244+ , " FULL OUTER JOIN "
245+ , renderAliased renderTableExpression table
246+ , " ON "
247+ , renderExpression on
248+ ]
165
249
166class KnownSymbol table => HasTable table tables columns
250class KnownSymbol table => HasTable table tables columns
167 | table tables -> columns where
251 | table tables -> columns where
168− getTable :: Proxy# table -> TableRef params tables '[table ::: columns]
252+ getTable :: Proxy# table -> TableExpression params tables columns
169− getTable table = UnsafeTableRef $ fromString $ symbolVal' table
253+ getTable table = UnsafeTableExpression $ fromString $ symbolVal' table
170instance {-# OVERLAPPING #-} KnownSymbol table
254instance {-# OVERLAPPING #-} KnownSymbol table
171 => HasTable table ((table ::: columns) ': tables) columns
255 => HasTable table ((table ::: columns) ': tables) columns
172instance {-# OVERLAPPABLE #-}
256instance {-# OVERLAPPABLE #-}
173 (KnownSymbol table, HasTable table schema columns)
257 (KnownSymbol table, HasTable table schema columns)
174 => HasTable table (table' ': schema) columns
258 => HasTable table (table' ': schema) columns
175
259
176−crossJoin
260+instance HasTable table schema columns
177− :: TableRef params schema '[table]
261+ => IsLabel table (TableExpression params schema columns) where
178− -> TableRef params schema tables
262+ fromLabel = getTable
179− -> TableRef params schema (table ': tables)
263+
180−crossJoin tab tabs = UnsafeTableRef $
264+instance HasTable table schema columns
181− renderTableRef tabs <> " CROSS JOIN " <> renderTableRef tab
265+ => IsLabel table (JoinExpression params schema '[table ::: columns]) where
182−
266+ fromLabel p = Table $ fromLabel p
183−innerJoin
184− :: TableRef params schema '[table]
185− -> Expression params (table ': tables) 'PGBool
186− -> TableRef params schema tables
187− -> TableRef params schema (table ': tables)
188−innerJoin tab on tabs = UnsafeTableRef $
189− renderTableRef tabs
190− <> " INNER JOIN " <>
191− renderTableRef tab
192− <> " ON " <>
193− renderExpression on
194
267
195data Clauses params tables = Clauses
268data Clauses params tables = Clauses
196− { whereClause :: Maybe (Expression params tables 'PGBool)
269+ { whereClause :: Maybe (Expression params tables ('NotNull 'PGBool))
197− , limitClause :: Maybe (Expression params '[] 'PGInt8)
270+ , limitClause :: Maybe (Expression params '[] ('NotNull 'PGInt8))
198− , offsetClause :: Maybe (Expression params '[] 'PGInt8)
271+ , offsetClause :: Maybe (Expression params '[] ('NotNull 'PGInt8))
199 }
272 }
200
273
201instance Monoid (Clauses params tables) where
274instance Monoid (Clauses params tables) where
@@ -218,84 +291,79 @@ instance Monoid (Clauses params tables) where
218 (Just o1,Just o2) -> Just (o1 + o2)
291 (Just o1,Just o2) -> Just (o1 + o2)
219 }
292 }
220
293
221−data TableExpression
294+data FromExpression
222− (params :: [PGType])
295+ (params :: [NullityType])
223− (schema :: [(Symbol,[(Symbol,PGType)])])
296+ (schema :: [(Symbol,[(Symbol,NullityType)])])
224− (tables :: [(Symbol,[(Symbol,PGType)])])
297+ (tables :: [(Symbol,[(Symbol,NullityType)])])
225− = TableExpression
298+ = FromExpression
226− { tableRef :: TableRef params schema tables
299+ { joinExpression :: JoinExpression params schema tables
227− , clauses :: Clauses params tables
300+ , clauses :: Clauses params tables
228− }
301+ }
229
302
230−tables
303+join
231− :: TableRef params schema tables
304+ :: JoinExpression params schema tables
232− -> TableExpression params schema tables
305+ -> FromExpression params schema tables
233−tables tref = TableExpression tref mempty
306+join tref = FromExpression tref mempty
234
307
235−renderTabulation :: TableExpression params schema tables -> ByteString
308+renderFromExpression :: FromExpression params schema tables -> ByteString
236−renderTabulation (TableExpression tref (Clauses wh lim off))= mconcat
309+renderFromExpression (FromExpression tref (Clauses wh lim off))= mconcat
237− [ renderTableRef tref
310+ [ renderJoinExpression tref
238 , maybe "" ((" WHERE " <>) . renderExpression) wh
311 , maybe "" ((" WHERE " <>) . renderExpression) wh
239 , maybe "" ((" LIMIT " <>) . renderExpression) lim
312 , maybe "" ((" LIMIT " <>) . renderExpression) lim
240 , maybe "" ((" OFFSET " <>) . renderExpression) off
313 , maybe "" ((" OFFSET " <>) . renderExpression) off
241 ]
314 ]
242
315
243instance (HasTable table schema columns, table ~ table')
316instance (HasTable table schema columns, table ~ table')
244− => IsLabel table (TableRef params schema '[table' ::: columns]) where
245− fromLabel = getTable
246−
247−instance (HasTable table schema columns, table ~ table')
248− => IsLabel table (TableExpression params schema '[table' ::: columns]) where
317+ => IsLabel table (FromExpression params schema '[table' ::: columns]) where
249− fromLabel p = TableExpression (getTable p) mempty
318+ fromLabel p = FromExpression (fromLabel p) mempty
250
319
251where_
320where_
252− :: Expression params tables 'PGBool
321+ :: Expression params tables ('NotNull 'PGBool)
253− -> TableExpression params schema tables
322+ -> FromExpression params schema tables
254− -> TableExpression params schema tables
323+ -> FromExpression params schema tables
255−where_ wh (TableExpression tabs clauses1) = TableExpression tabs
324+where_ wh (FromExpression tabs clauses1) = FromExpression tabs
256 (clauses1 <> Clauses (Just wh) Nothing Nothing)
325 (clauses1 <> Clauses (Just wh) Nothing Nothing)
257
326
258limit
327limit
259− :: Expression params '[] 'PGInt8
328+ :: Expression params '[] ('NotNull 'PGInt8)
260− -> TableExpression params schema tables
329+ -> FromExpression params schema tables
261− -> TableExpression params schema tables
330+ -> FromExpression params schema tables
262−limit lim (TableExpression tabs clauses1) = TableExpression tabs
331+limit lim (FromExpression tabs clauses1) = FromExpression tabs
263 (clauses1 <> Clauses Nothing (Just lim) Nothing)
332 (clauses1 <> Clauses Nothing (Just lim) Nothing)
264
333
265offset
334offset
266− :: Expression params '[] 'PGInt8
335+ :: Expression params '[] ('NotNull 'PGInt8)
267− -> TableExpression params schema tables
336+ -> FromExpression params schema tables
268− -> TableExpression params schema tables
337+ -> FromExpression params schema tables
269−offset off (TableExpression tabs clauses1) = TableExpression tabs
338+offset off (FromExpression tabs clauses1) = FromExpression tabs
270 (clauses1 <> Clauses Nothing Nothing (Just off))
339 (clauses1 <> Clauses Nothing Nothing (Just off))
271
340
272newtype Selection
341newtype Selection
273− (params :: [PGType])
342+ (params :: [NullityType])
274− (schema :: [(Symbol,[(Symbol,PGType)])])
343+ (schema :: [(Symbol,[(Symbol,NullityType)])])
275− (columns :: [(Symbol,PGType)])
344+ (columns :: [(Symbol,NullityType)])
276− = UnsafeSelection
277− { renderSelection :: ByteString }
345+ = UnsafeSelection { renderSelection :: ByteString }
278
346
279starFrom
347starFrom
280 :: tables ~ '[table ::: columns]
348 :: tables ~ '[table ::: columns]
281− => TableExpression params schema tables
349+ => FromExpression params schema tables
282 -> Selection params schema columns
350 -> Selection params schema columns
283−starFrom tabs = UnsafeSelection $ "* FROM " <> renderTabulation tabs
351+starFrom tabs = UnsafeSelection $ "* FROM " <> renderFromExpression tabs
284
352
285−tableStarFrom
353+dotStarFrom
286 :: HasTable table tables columns
354 :: HasTable table tables columns
287 => Alias table
355 => Alias table
288− -> TableExpression params schema tables
356+ -> FromExpression params schema tables
289 -> Selection params schema columns
357 -> Selection params schema columns
290−Alias tab `tableStarFrom` tabs = UnsafeSelection $
358+Alias tab `dotStarFrom` tabs = UnsafeSelection $
291− fromString (symbolVal' tab) <> ".* FROM" <> renderTabulation tabs
359+ fromString (symbolVal' tab) <> ".* FROM " <> renderFromExpression tabs
292
360
293from
361from
294 :: Rec (Aliased (Expression params tables)) columns
362 :: Rec (Aliased (Expression params tables)) columns
295− -> TableExpression params schema tables
363+ -> FromExpression params schema tables
296 -> Selection params schema columns
364 -> Selection params schema columns
297list `from` tabs = UnsafeSelection $
365list `from` tabs = UnsafeSelection $
298− renderList list <> " FROM " <> renderTabulation tabs
366+ renderList list <> " FROM " <> renderFromExpression tabs
299 where
367 where
300 renderList
368 renderList
301 = ByteString.intercalate ", "
369 = ByteString.intercalate ", "
@@ -303,17 +371,24 @@ list `from` tabs = UnsafeSelection $
303 . rmap (Const . renderAliased renderExpression)
371 . rmap (Const . renderAliased renderExpression)
304
372
305newtype Statement
373newtype Statement
306− (params :: [PGType])
374+ (params :: [NullityType])
307− (schema0 :: [(Symbol,[(Symbol,PGType)])])
375+ (schema0 :: [(Symbol,[(Symbol,NullityType)])])
308− (schema1 :: [(Symbol,[(Symbol,PGType)])])
376+ (schema1 :: [(Symbol,[(Symbol,NullityType)])])
309− (columns :: [(Symbol,PGType)])
377+ (columns :: [(Symbol,NullityType)])
310 = UnsafeStatement { renderStatement :: ByteString }
378 = UnsafeStatement { renderStatement :: ByteString }
311
379
380+(.>>.)
381+ :: Statement params schema0 schema1 '[]
382+ -> Statement params schema1 schema2 results
383+ -> Statement params schema0 schema2 results
384+statement1 .>>. statement2 = UnsafeStatement $
385+ renderStatement statement1 <> " " <> renderStatement statement2
386+
312newtype PreparedStatement
387newtype PreparedStatement
313− (params :: [PGType])
388+ (params :: [NullityType])
314− (schema0 :: [(Symbol,[(Symbol,PGType)])])
389+ (schema0 :: [(Symbol,[(Symbol,NullityType)])])
315− (schema1 :: [(Symbol,[(Symbol,PGType)])])
390+ (schema1 :: [(Symbol,[(Symbol,NullityType)])])
316− (columns :: [(Symbol,PGType)])
391+ (columns :: [(Symbol,NullityType)])
317 = UnsafePreparedStatement { renderPreparedStatement :: ByteString }
392 = UnsafePreparedStatement { renderPreparedStatement :: ByteString }
318
393
319select
394select
@@ -323,10 +398,9 @@ select = UnsafeStatement . ("SELECT " <>) . (<> ";") . renderSelection
323
398
324subselect
399subselect
325 :: Aliased (Selection params schema) table
400 :: Aliased (Selection params schema) table
326− -> TableExpression params schema '[table]
401+ -> FromExpression params schema '[table]
327−subselect selection = TableExpression
402+subselect selection = FromExpression
328− { tableRef = UnsafeTableRef . ("SELECT " <>) $
403+ { joinExpression = Subselect selection
329− renderAliased renderSelection selection
330 , clauses = mempty
404 , clauses = mempty
331 }
405 }
332
406
@@ -373,3 +447,34 @@ instance {-# OVERLAPPING #-}
373instance {-# OVERLAPPABLE #-}
447instance {-# OVERLAPPABLE #-}
374 (KnownSymbol table, DropTable table schema0 schema1)
448 (KnownSymbol table, DropTable table schema0 schema1)
375 => DropTable table (tabCols ': schema0) (tabCols ': schema1)
449 => DropTable table (tabCols ': schema0) (tabCols ': schema1)
450+
451+set :: g x -> (Maybe `Compose` g) x
452+set = Compose . Just
453+
454+same :: (Maybe `Compose` g) x
455+same = Compose Nothing
456+
457+update
458+ :: HasTable table schema columns
459+ => Alias table
460+ -> Rec (Aliased (Maybe `Compose` Expression params '[table ::: columns])) columns
461+ -> Expression params '[table ::: columns] ('NotNull 'PGBool)
462+ -> Statement params schema schema '[]
463+update (Alias table) columns where' = UnsafeStatement $ mconcat
464+ [ "UPDATE "
465+ , fromString $ symbolVal' table
466+ , " SET "
467+ , ByteString.intercalate ", " . catMaybes . recordToList $
468+ rmap (Const . renderSet) columns
469+ , " WHERE ", renderExpression where'
470+ ] where
471+ renderSet
472+ :: Aliased (Maybe `Compose` Expression params tables) column
473+ -> Maybe ByteString
474+ renderSet = \case
475+ Compose (Just expression) `As` Alias column -> Just $ mconcat
476+ [ fromString $ symbolVal' column
477+ , " = "
478+ , renderExpression expression
479+ ]
480+ Compose Nothing `As` _ -> Nothing
squeel-postgresql/test/Squeel/PostgreSQL/StatementSpec.hs+44−35
@@ -28,7 +28,7 @@ spec = do
28 ((#col1 + #col2) `As` #sum :& #col1 :& RNil)
28 ((#col1 + #col2) `As` #sum :& #col1 :& RNil)
29 `from` (#table1 & where_ true)
29 `from` (#table1 & where_ true)
30 statement `shouldRenderAs`
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
32 it "combines WHEREs using AND" $ do
33 let
33 let
34 statement :: Statement '[] Tables Tables SumAndCol1
34 statement :: Statement '[] Tables Tables SumAndCol1
@@ -36,40 +36,40 @@ spec = do
36 ((#col1 + #col2) `As` #sum :& #col1 :& RNil)
36 ((#col1 + #col2) `As` #sum :& #col1 :& RNil)
37 `from` (#table1 & where_ true & where_ false)
37 `from` (#table1 & where_ true & where_ false)
38 statement `shouldRenderAs`
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
40 it "performs sub SELECTs" $ do
41 let
41 let
42 selection = ((#col1 + #col2) `As` #sum :& #col1 :& RNil) `from` #table1
42 selection = ((#col1 + #col2) `As` #sum :& #col1 :& RNil) `from` #table1
43 statement :: Statement '[] Tables Tables SumAndCol1
43 statement :: Statement '[] Tables Tables SumAndCol1
44 statement = select $ starFrom (subselect (selection `As` #sub))
44 statement = select $ starFrom (subselect (selection `As` #sub))
45 statement `shouldRenderAs`
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
47 it "does LIMIT clauses" $ do
48 let
48 let
49 statement :: Statement '[] Tables Tables Columns
49 statement :: Statement '[] Tables Tables Columns
50 statement = select $ starFrom (#table1 & limit 1)
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
52 it "should use the minimum of given LIMITs" $ do
53 let
53 let
54 statement :: Statement '[] Tables Tables Columns
54 statement :: Statement '[] Tables Tables Columns
55 statement = select $ starFrom (#table1 & limit 1 & limit 2)
55 statement = select $ starFrom (#table1 & limit 1 & limit 2)
56 statement `shouldRenderAs`
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
58 it "should render parameters using $ signs" $ do
59 let
59 let
60− statement :: Statement '[ 'PGInt8] Tables Tables Columns
60+ statement :: Statement '[ 'NotNull 'PGInt8] Tables Tables Columns
61 statement = select $ starFrom (#table1 & limit param1)
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
63 it "does OFFSET clauses" $ do
64 let
64 let
65 statement :: Statement '[] Tables Tables Columns
65 statement :: Statement '[] Tables Tables Columns
66 statement = select $ starFrom (#table1 & offset 1)
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
68 it "should use the sum of given OFFSETs" $ do
69 let
69 let
70 statement :: Statement '[] Tables Tables Columns
70 statement :: Statement '[] Tables Tables Columns
71 statement = select $ starFrom (#table1 & offset 1 & offset 2)
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
73 it "correctly render simple INSERTs" $ do
74 let
74 let
75 statement :: Statement '[] Tables Tables '[]
75 statement :: Statement '[] Tables Tables '[]
@@ -93,23 +93,23 @@ spec = do
93 let
93 let
94 statement :: Statement '[] JoinTables JoinTables ValueColumns
94 statement :: Statement '[] JoinTables JoinTables ValueColumns
95 statement = select $ vals `from`
95 statement = select $ vals `from`
96− (tables (#orders & crossJoin #customers & crossJoin #shippers))
96+ (join (#orders & Cross #customers & Cross #shippers))
97 statement `shouldRenderAs`
97 statement `shouldRenderAs`
98 "SELECT\
98 "SELECT\
99 \ orders.orderVal AS orderVal,\
99 \ orders.orderVal AS orderVal,\
100 \ customers.customerVal AS customerVal,\
100 \ customers.customerVal AS customerVal,\
101 \ shippers.shipperVal AS shipperVal\
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
105 it "should render INNER JOINs" $ do
106 let
106 let
107− innerJoins :: TableExpression '[] JoinTables JoinTables
107+ innerJoins :: FromExpression '[] JoinTables JoinTables
108− innerJoins = tables $
108+ innerJoins = join $
109 #orders
109 #orders
110− & innerJoin #customers
110+ & Inner #customers
111 (#orders .&. #customerID ==* #customers .&. #customerID)
111 (#orders .&. #customerID ==* #customers .&. #customerID)
112− & innerJoin #shippers
112+ & Inner #shippers
113 (#orders .&. #shipperID ==* #shippers .&. #shipperID)
113 (#orders .&. #shipperID ==* #shippers .&. #shipperID)
114 selection :: Statement '[] JoinTables JoinTables ValueColumns
114 selection :: Statement '[] JoinTables JoinTables ValueColumns
115 selection = select $ vals `from` innerJoins
115 selection = select $ vals `from` innerJoins
@@ -118,46 +118,55 @@ spec = do
118 \ orders.orderVal AS orderVal,\
118 \ orders.orderVal AS orderVal,\
119 \ customers.customerVal AS customerVal,\
119 \ customers.customerVal AS customerVal,\
120 \ shippers.shipperVal AS shipperVal\
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)\
123 \ ON (orders.customerID = customers.customerID)\
124− \ INNER JOIN shippers\
124+ \ INNER JOIN shippers AS shippers\
125 \ ON (orders.shipperID = shippers.shipperID);"
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 (Table (#orders `As` #orders1)
131+ & Cross (#orders `As` #orders2)))
132+ statement `shouldRenderAs`
133+ "SELECT orders1.*\
134+ \ FROM orders AS orders1\
135+ \ CROSS JOIN orders AS orders2;"
126 it "should render simple CREATE TABLE statements" $ do
136 it "should render simple CREATE TABLE statements" $ do
127 let
137 let
128 statement :: Statement '[] '[] Tables '[]
138 statement :: Statement '[] '[] Tables '[]
129 statement = createTable #table1 (proxy# :: Proxy# Columns)
139 statement = createTable #table1 (proxy# :: Proxy# Columns)
130 statement `shouldRenderAs`
140 statement `shouldRenderAs`
131− "CREATE TABLE table1 (col1 int4, col2 int4);"
141+ "CREATE TABLE table1 (col1 int4 NOT NULL, col2 int4 NOT NULL);"
132 it "should render DROP TABLE statements" $ do
142 it "should render DROP TABLE statements" $ do
133 let
143 let
134 statement :: Statement '[] Tables '[] '[]
144 statement :: Statement '[] Tables '[] '[]
135 statement = dropTable #table1
145 statement = dropTable #table1
136− statement `shouldRenderAs`
146+ statement `shouldRenderAs` "DROP TABLE table1;"
137− "DROP TABLE table1;"
138
147
139−type Columns = '[ "col1" ::: 'PGInt4, "col2" ::: 'PGInt4]
148+type Columns = '[ "col1" ::: 'NotNull 'PGInt4, "col2" ::: 'NotNull 'PGInt4]
140type Tables = '[ "table1" ::: Columns ]
149type Tables = '[ "table1" ::: Columns ]
141−type SumAndCol1 = '[ "sum" ::: 'PGInt4, "col1" ::: 'PGInt4]
150+type SumAndCol1 = '[ "sum" ::: 'NotNull 'PGInt4, "col1" ::: 'NotNull 'PGInt4]
142−type StudentsColumns = '["name" ::: 'PGText]
151+type StudentsColumns = '["name" ::: 'NotNull 'PGText]
143type StudentsTable = '["students" ::: StudentsColumns]
152type StudentsTable = '["students" ::: StudentsColumns]
144type OrderColumns =
153type OrderColumns =
145− [ "orderID" ::: 'PGInt4
154+ [ "orderID" ::: 'NotNull 'PGInt4
146− , "orderVal" ::: 'PGText
155+ , "orderVal" ::: 'NotNull 'PGText
147− , "customerID" ::: 'PGInt4
156+ , "customerID" ::: 'NotNull 'PGInt4
148− , "shipperID" ::: 'PGInt4
157+ , "shipperID" ::: 'NotNull 'PGInt4
149 ]
158 ]
150type CustomerColumns =
159type CustomerColumns =
151− [ "customerID" ::: 'PGInt4, "customerVal" ::: 'PGFloat4 ]
160+ [ "customerID" ::: 'NotNull 'PGInt4, "customerVal" ::: 'NotNull 'PGFloat4 ]
152type ShipperColumns =
161type ShipperColumns =
153− [ "shipperID" ::: 'PGInt4, "shipperVal" ::: 'PGBool ]
162+ [ "shipperID" ::: 'NotNull 'PGInt4, "shipperVal" ::: 'NotNull 'PGBool ]
154type JoinTables =
163type JoinTables =
155 [ "shippers" ::: ShipperColumns
164 [ "shippers" ::: ShipperColumns
156 , "customers" ::: CustomerColumns
165 , "customers" ::: CustomerColumns
157 , "orders" ::: OrderColumns
166 , "orders" ::: OrderColumns
158 ]
167 ]
159type ValueColumns =
168type ValueColumns =
160− [ "orderVal" ::: 'PGText
169+ [ "orderVal" ::: 'NotNull 'PGText
161− , "customerVal" ::: 'PGFloat4
170+ , "customerVal" ::: 'NotNull 'PGFloat4
162− , "shipperVal" ::: 'PGBool
171+ , "shipperVal" ::: 'NotNull 'PGBool
163 ]
172 ]