git.iko.soy/squeal
on dev help sign in
fix outer joins, def, null, fix EqB, fix OrdB
40400faEitan Chatav
squeel-postgresql/src/Squeel/PostgreSQL/Schema.hs+15−93
compare with dev
unifiedsplit
@@ -21,13 +21,11 @@ module Squeel.PostgreSQL.Schema
21 , (:::)
21 , (:::)
22 , Alias (Alias)
22 , Alias (Alias)
23 , Aliased (As)
23 , Aliased (As)
24− , KnownPGType (..)
25− , KnownColumns (..)
26 , renderAliased
24 , renderAliased
27 , NullityType (..)
25 , NullityType (..)
28− -- , NullifyType
26+ , NullifyColumn
29− -- , NullifyColumns
27+ , NullifyColumns
30− -- , NullifyTable
28+ , NullifyTable
31 , ColumnType (..)
29 , ColumnType (..)
32 , module GHC.OverloadedLabels
30 , module GHC.OverloadedLabels
33 , module GHC.TypeLits
31 , module GHC.TypeLits
@@ -114,94 +112,18 @@ renderAliased
114renderAliased render (expression `As` Alias alias) =
112renderAliased render (expression `As` Alias alias) =
115 render expression <> " AS " <> fromString (symbolVal' alias)
113 render expression <> " AS " <> fromString (symbolVal' alias)
116
114
117−class KnownPGType (ty :: PGType) where
118− renderPGType :: Proxy# ty -> ByteString
119−instance KnownPGType 'PGBool where renderPGType _ = "bool"
120−instance KnownPGType 'PGInt2 where renderPGType _ = "int2"
121−instance KnownPGType 'PGInt4 where renderPGType _ = "int4"
122−instance KnownPGType 'PGInt8 where renderPGType _ = "int8"
123−instance KnownPGType 'PGNumeric where renderPGType _ = "numeric"
124−instance KnownPGType 'PGFloat4 where renderPGType _ = "float4"
125−instance KnownPGType 'PGFloat8 where renderPGType _ = "float8"
126−instance KnownPGType 'PGSerial2 where renderPGType _ = "serial2"
127−instance KnownPGType 'PGSerial4 where renderPGType _ = "serial4"
128−instance KnownPGType 'PGSerial8 where renderPGType _ = "serial8"
129−instance KnownPGType 'PGMoney where renderPGType _ = "money"
130−instance KnownNat n => KnownPGType ('PGChar n) where
131− renderPGType _ = "char("
132− <> fromString (show (natVal' (proxy# :: Proxy# n)))
133− <> ")"
134−instance KnownNat n => KnownPGType ('PGVarChar n) where
135− renderPGType _ = "varchar("
136− <> fromString (show (natVal' (proxy# :: Proxy# n)))
137− <> ")"
138−instance KnownPGType 'PGText where renderPGType _ = "text"
139−instance KnownPGType 'PGBytea where renderPGType _ = "bytea"
140−instance KnownPGType 'PGTimestamp where renderPGType _ = "timestamp"
141−instance KnownPGType 'PGTimestampTZ where renderPGType _ = "timestampTZ"
142−instance KnownPGType 'PGDate where renderPGType _ = "date"
143−instance KnownPGType 'PGTime where renderPGType _ = "time"
144−instance KnownPGType 'PGTimeTZ where renderPGType _ = "timeTZ"
145−instance KnownPGType 'PGInterval where renderPGType _ = "interval"
146−instance KnownPGType 'PGUuid where renderPGType _ = "uuid"
147−instance KnownPGType 'PGJson where renderPGType _ = "json"
148−instance KnownPGType 'PGJsonb where renderPGType _ = "jsonb"
149−
150−class KnownColumns (columns :: [(Symbol,NullityType)]) where
151− renderColumns :: Proxy# columns -> ByteString
152−instance
153− ( KnownSymbol column
154− , KnownPGType ty
155− ) => KnownColumns '[column ::: 'NotNull ty] where
156− renderColumns _ =
157− fromString (symbolVal' (proxy# :: Proxy# column))
158− <> " "
159− <> renderPGType (proxy# :: Proxy# ty)
160− <> " NOT NULL"
161−instance
162− ( KnownSymbol column
163− , KnownPGType ty
164− ) => KnownColumns '[column ::: 'Null ty] where
165− renderColumns _ =
166− fromString (symbolVal' (proxy# :: Proxy# column))
167− <> " "
168− <> renderPGType (proxy# :: Proxy# ty)
169− <> " NULL"
170−instance
171− ( KnownSymbol column
172− , KnownPGType ty
173− , KnownColumns (columnsHead ': columnsTail)
174− ) => KnownColumns ((column ::: 'NotNull ty) ': columnsHead ': columnsTail) where
175− renderColumns _ =
176− fromString (symbolVal' (proxy# :: Proxy# column))
177− <> " "
178− <> renderPGType (proxy# :: Proxy# ty)
179− <> " NOT NULL, "
180− <> renderColumns (proxy# :: Proxy# (columnsHead ': columnsTail))
181−instance
182− ( KnownSymbol column
183− , KnownPGType ty
184− , KnownColumns (columnsHead ': columnsTail)
185− ) => KnownColumns ((column ::: 'Null ty) ': columnsHead ': columnsTail) where
186− renderColumns _ =
187− fromString (symbolVal' (proxy# :: Proxy# column))
188− <> " "
189− <> renderPGType (proxy# :: Proxy# ty)
190− <> " NULL, "
191− <> renderColumns (proxy# :: Proxy# (columnsHead ': columnsTail))
192−
193data NullityType = Null PGType | NotNull PGType
115data NullityType = Null PGType | NotNull PGType
194
116
195−-- type family NullifyType nullty where
196−-- NullifyType ('Null ty) = 'Null ty
197−-- NullifyType ('NotNull ty) = 'Null ty
198−--
199−-- type family NullifyColumns columns where
200−-- NullifyColumns '[] = '[]
201−-- NullifyColumns ((column ::: ty) ': columns) =
202−-- (column ::: (NullifyType ty)) ': (NullifyColumns columns)
203−--
204−-- type family NullifyTable table where
205−-- NullifyTable (table ::: columns) = table ::: NullifyColumns columns
206−
207data ColumnType = Optional NullityType | Required NullityType
117data ColumnType = Optional NullityType | Required NullityType
118+
119+type family NullifyColumn (column :: ColumnType) where
120+ NullifyColumn (optionality ('Null ty)) = optionality ('Null ty)
121+ NullifyColumn (optionality ('NotNull ty)) = optionality ('Null ty)
122+
123+type family NullifyColumns columns where
124+ NullifyColumns '[] = '[]
125+ NullifyColumns ((column ::: ty) ': columns) =
126+ (column ::: NullifyColumn ty) ': (NullifyColumns columns)
127+
128+type family NullifyTable table where
129+ NullifyTable (table ::: columns) = table ::: NullifyColumns columns
squeel-postgresql/src/Squeel/PostgreSQL/Statement.hs+215−175
@@ -31,11 +31,16 @@ import qualified Data.ByteString as ByteString
31
31
32import Squeel.PostgreSQL.Schema
32import Squeel.PostgreSQL.Schema
33
33
34+{-----------------------------------------
35+column expressions
36+-----------------------------------------}
37+
34newtype Expression
38newtype Expression
35 (params :: [ColumnType])
39 (params :: [ColumnType])
36 (tables :: [(Symbol,[(Symbol,ColumnType)])])
40 (tables :: [(Symbol,[(Symbol,ColumnType)])])
37 (ty :: ColumnType)
41 (ty :: ColumnType)
38− = UnsafeExpression { renderExpression :: ByteString }
42+ = UnsafeExpression { renderExpression :: ByteString }
43+ deriving (Show,Eq)
39
44
40class KnownNat n => HasParameter (n :: Nat) params ty | n params -> ty where
45class KnownNat n => HasParameter (n :: Nat) params ty | n params -> ty where
41 param :: Proxy# n -> Expression params tables ty
46 param :: Proxy# n -> Expression params tables ty
@@ -76,6 +81,23 @@ Alias table &. Alias column = UnsafeExpression $
76 <> "." <>
81 <> "." <>
77 fromString (symbolVal' column)
82 fromString (symbolVal' column)
78
83
84+def :: Expression params '[] ('Optional (nullity ty))
85+def = UnsafeExpression "DEFAULT"
86+
87+null :: Expression params tables (optionality ('Null ty))
88+null = UnsafeExpression "NULL"
89+
90+coalesce
91+ :: [Expression params tables ('Required ('Null x))]
92+ -> Expression params tables ('Required ('NotNull x))
93+ -> Expression params tables ('Required ('NotNull x))
94+coalesce nulls isn'tNull = UnsafeExpression $ mconcat
95+ [ "COALESCE("
96+ , ByteString.intercalate ", " $ map renderExpression nulls
97+ , ", ", renderExpression isn'tNull
98+ , ")"
99+ ]
100+
79unsafeBinaryOp
101unsafeBinaryOp
80 :: ByteString
102 :: ByteString
81 -> Expression params tables ty0
103 -> Expression params tables ty0
@@ -131,17 +153,6 @@ instance Boolean (Expression params tables ('Required ('NotNull 'PGBool))) where
131type instance BooleanOf (Expression params tables ty) =
153type instance BooleanOf (Expression params tables ty) =
132 Expression params tables ('Required ('NotNull 'PGBool))
154 Expression params tables ('Required ('NotNull 'PGBool))
133
155
134−coalesce
135− :: [Expression params tables ('Required ('Null x))]
136− -> Expression params tables ('Required ('NotNull x))
137− -> Expression params tables ('Required ('NotNull x))
138−coalesce nulls isn'tNull = UnsafeExpression $ mconcat
139− [ "COALESCE("
140− , ByteString.intercalate ", " $ map renderExpression nulls
141− , ", ", renderExpression isn'tNull
142− , ")"
143− ]
144−
145caseWhenThenElse
156caseWhenThenElse
146 :: [(Expression params tables ('Required ('NotNull 'PGBool)), Expression params tables ty)]
157 :: [(Expression params tables ('Required ('NotNull 'PGBool)), Expression params tables ty)]
147 -> Expression params tables ty
158 -> Expression params tables ty
@@ -162,109 +173,143 @@ caseWhenThenElse whenThens else_ = UnsafeExpression $ mconcat
162instance IfB (Expression params tables ty) where
173instance IfB (Expression params tables ty) where
163 ifB if_ then_ else_ = caseWhenThenElse [(if_,then_)] else_
174 ifB if_ then_ else_ = caseWhenThenElse [(if_,then_)] else_
164
175
165−instance EqB (Expression params tables ty) where
176+instance EqB (Expression params tables (optionality ('NotNull ty))) where
166 (==*) = unsafeBinaryOp "="
177 (==*) = unsafeBinaryOp "="
167 (/=*) = unsafeBinaryOp "<>"
178 (/=*) = unsafeBinaryOp "<>"
168
179
169−instance OrdB (Expression params tables ty) where
180+instance OrdB (Expression params tables (optionality ('NotNull ty))) where
170 (>*) = unsafeBinaryOp ">"
181 (>*) = unsafeBinaryOp ">"
171 (>=*) = unsafeBinaryOp ">="
182 (>=*) = unsafeBinaryOp ">="
172 (<*) = unsafeBinaryOp "<"
183 (<*) = unsafeBinaryOp "<"
173 (<=*) = unsafeBinaryOp "<="
184 (<=*) = unsafeBinaryOp "<="
174
185
186+{-----------------------------------------
187+table expressions
188+-----------------------------------------}
189+
175newtype TableExpression
190newtype TableExpression
176 (params :: [ColumnType])
191 (params :: [ColumnType])
177 (schema :: [(Symbol,[(Symbol,ColumnType)])])
192 (schema :: [(Symbol,[(Symbol,ColumnType)])])
178 (columns :: [(Symbol,ColumnType)])
193 (columns :: [(Symbol,ColumnType)])
179 = UnsafeTableExpression { renderTableExpression :: ByteString }
194 = UnsafeTableExpression { renderTableExpression :: ByteString }
195+ deriving (Show,Eq)
196+
197+class KnownSymbol table => HasTable table tables columns
198+ | table tables -> columns where
199+ getTable :: Proxy# table -> TableExpression params tables columns
200+ getTable table = UnsafeTableExpression $ fromString $ symbolVal' table
201+instance {-# OVERLAPPING #-} KnownSymbol table
202+ => HasTable table ((table ::: columns) ': tables) columns
203+instance {-# OVERLAPPABLE #-}
204+ (KnownSymbol table, HasTable table schema columns)
205+ => HasTable table (table' ': schema) columns
180
206
207+instance HasTable table schema columns
208+ => IsLabel table (TableExpression params schema columns) where
209+ fromLabel = getTable
210+
211+{-----------------------------------------
212+statements
213+-----------------------------------------}
214+
215+newtype Statement
216+ (params :: [ColumnType])
217+ (columns :: [(Symbol,ColumnType)])
218+ (schema0 :: [(Symbol,[(Symbol,ColumnType)])])
219+ (schema1 :: [(Symbol,[(Symbol,ColumnType)])])
220+ = UnsafeStatement { renderStatement :: ByteString }
221+ deriving (Show,Eq)
222+
223+instance Category (Statement '[] '[]) where
224+ id = UnsafeStatement ";"
225+ statement2 . statement1 = UnsafeStatement $
226+ renderStatement statement1 <> " " <> renderStatement statement2
227+
228+newtype PreparedStatement
229+ (params :: [ColumnType])
230+ (columns :: [(Symbol,ColumnType)])
231+ (schema0 :: [(Symbol,[(Symbol,ColumnType)])])
232+ (schema1 :: [(Symbol,[(Symbol,ColumnType)])])
233+ = UnsafePreparedStatement { renderPreparedStatement :: ByteString }
234+ deriving (Show,Eq)
235+
236+{-----------------------------------------
237+SELECT statements
238+-----------------------------------------}
239+
181−data JoinExpression params schema tables where
240+data Join params schema tables where
182 Table
241 Table
183 :: Aliased (TableExpression params schema) table
242 :: Aliased (TableExpression params schema) table
184− -> JoinExpression params schema '[table]
243+ -> Join params schema '[table]
185 Subselect
244 Subselect
186 :: Aliased (Selection params schema) table
245 :: Aliased (Selection params schema) table
187− -> JoinExpression params schema '[table]
246+ -> Join params schema '[table]
188 Cross
247 Cross
189 :: Aliased (TableExpression params schema) table
248 :: Aliased (TableExpression params schema) table
190− -> JoinExpression params schema tables
249+ -> Join params schema tables
191− -> JoinExpression params schema (table ': tables)
250+ -> Join params schema (table ': tables)
192 Inner
251 Inner
193 :: Aliased (TableExpression params schema) table
252 :: Aliased (TableExpression params schema) table
194 -> Expression params (table ': tables) ('Required ('NotNull 'PGBool))
253 -> Expression params (table ': tables) ('Required ('NotNull 'PGBool))
195− -> JoinExpression params schema tables
254+ -> Join params schema tables
196− -> JoinExpression params schema (table ': tables)
255+ -> Join params schema (table ': tables)
197− -- LeftOuter
256+ LeftOuter
198− -- :: Aliased (TableExpression params schema) right
257+ :: Aliased (TableExpression params schema) right
199− -- -> Expression params '[left,right] ('Required ('NotNull 'PGBool))
258+ -> Expression params '[left,right] ('Required ('NotNull 'PGBool))
200− -- -> JoinExpression params schema (tables)
259+ -> Join params schema (tables)
201− -- -> JoinExpression params schema (NullifyTable right ': left ': tables)
260+ -> Join params schema (NullifyTable right ': left ': tables)
202− -- RightOuter
261+ RightOuter
203− -- :: Aliased (TableExpression params schema) right
262+ :: Aliased (TableExpression params schema) right
204− -- -> Expression params '[left,right] ('Required ('NotNull 'PGBool))
263+ -> Expression params '[left,right] ('Required ('NotNull 'PGBool))
205− -- -> JoinExpression params schema (left : tables)
264+ -> Join params schema (left : tables)
206− -- -> JoinExpression params schema (right ': NullifyTable left ': tables)
265+ -> Join params schema (right ': NullifyTable left ': tables)
207− -- FullOuter
266+ FullOuter
208− -- :: Aliased (TableExpression params schema) right
267+ :: Aliased (TableExpression params schema) right
209− -- -> Expression params '[left,right] ('Required ('NotNull 'PGBool))
268+ -> Expression params '[left,right] ('Required ('NotNull 'PGBool))
210− -- -> JoinExpression params schema (left : tables)
269+ -> Join params schema (left : tables)
211− -- -> JoinExpression params schema
270+ -> Join params schema
212− -- (NullifyTable right ': NullifyTable left ': tables)
271+ (NullifyTable right ': NullifyTable left ': tables)
213−
272+
214−renderJoinExpression :: JoinExpression params schema tables -> ByteString
273+renderJoin :: Join params schema tables -> ByteString
215−renderJoinExpression = \case
274+renderJoin = \case
216 Table table -> renderAliased renderTableExpression table
275 Table table -> renderAliased renderTableExpression table
217 Subselect selection -> "SELECT " <> renderAliased renderSelection selection
276 Subselect selection -> "SELECT " <> renderAliased renderSelection selection
218 Cross table tables -> mconcat
277 Cross table tables -> mconcat
219− [ renderJoinExpression tables
278+ [ renderJoin tables
220 , " CROSS JOIN "
279 , " CROSS JOIN "
221 , renderAliased renderTableExpression table
280 , renderAliased renderTableExpression table
222 ]
281 ]
223 Inner table on tables -> mconcat
282 Inner table on tables -> mconcat
224− [ renderJoinExpression tables
283+ [ renderJoin tables
225 , " INNER JOIN "
284 , " INNER JOIN "
226 , renderAliased renderTableExpression table
285 , renderAliased renderTableExpression table
227 , " ON "
286 , " ON "
228 , renderExpression on
287 , renderExpression on
229 ]
288 ]
230− -- LeftOuter table on tables -> mconcat
289+ LeftOuter table on tables -> mconcat
231− -- [ renderJoinExpression tables
290+ [ renderJoin tables
232− -- , " LEFT OUTER JOIN "
291+ , " LEFT OUTER JOIN "
233− -- , renderAliased renderTableExpression table
292+ , renderAliased renderTableExpression table
234− -- , " ON "
293+ , " ON "
235− -- , renderExpression on
294+ , renderExpression on
236− -- ]
295+ ]
237− -- RightOuter table on tables -> mconcat
296+ RightOuter table on tables -> mconcat
238− -- [ renderJoinExpression tables
297+ [ renderJoin tables
239− -- , " RIGHT OUTER JOIN "
298+ , " RIGHT OUTER JOIN "
240− -- , renderAliased renderTableExpression table
299+ , renderAliased renderTableExpression table
241− -- , " ON "
300+ , " ON "
242− -- , renderExpression on
301+ , renderExpression on
243− -- ]
302+ ]
244− -- FullOuter table on tables -> mconcat
303+ FullOuter table on tables -> mconcat
245− -- [ renderJoinExpression tables
304+ [ renderJoin tables
246− -- , " FULL OUTER JOIN "
305+ , " FULL OUTER JOIN "
247− -- , renderAliased renderTableExpression table
306+ , renderAliased renderTableExpression table
248− -- , " ON "
307+ , " ON "
249− -- , renderExpression on
308+ , renderExpression on
250− -- ]
309+ ]
251−
252−class KnownSymbol table => HasTable table tables columns
253− | table tables -> columns where
254− getTable :: Proxy# table -> TableExpression params tables columns
255− getTable table = UnsafeTableExpression $ fromString $ symbolVal' table
256−instance {-# OVERLAPPING #-} KnownSymbol table
257− => HasTable table ((table ::: columns) ': tables) columns
258−instance {-# OVERLAPPABLE #-}
259− (KnownSymbol table, HasTable table schema columns)
260− => HasTable table (table' ': schema) columns
261−
262−instance HasTable table schema columns
263− => IsLabel table (TableExpression params schema columns) where
264− fromLabel = getTable
265
310
266instance HasTable table schema columns
311instance HasTable table schema columns
267− => IsLabel table (JoinExpression params schema '[table ::: columns]) where
312+ => IsLabel table (Join params schema '[table ::: columns]) where
268 fromLabel p = Table $ fromLabel p
313 fromLabel p = Table $ fromLabel p
269
314
270data Clauses params tables = Clauses
315data Clauses params tables = Clauses
@@ -293,104 +338,86 @@ instance Monoid (Clauses params tables) where
293 (Just o1,Just o2) -> Just (o1 + o2)
338 (Just o1,Just o2) -> Just (o1 + o2)
294 }
339 }
295
340
296−data FromExpression
341+data From
297 (params :: [ColumnType])
342 (params :: [ColumnType])
298 (schema :: [(Symbol,[(Symbol,ColumnType)])])
343 (schema :: [(Symbol,[(Symbol,ColumnType)])])
299 (tables :: [(Symbol,[(Symbol,ColumnType)])])
344 (tables :: [(Symbol,[(Symbol,ColumnType)])])
300− = FromExpression
345+ = From
301− { joinExpression :: JoinExpression params schema tables
346+ { fromJoin :: Join params schema tables
302− , clauses :: Clauses params tables
347+ , fromClauses :: Clauses params tables
303 }
348 }
304
349
305join
350join
306− :: JoinExpression params schema tables
351+ :: Join params schema tables
307− -> FromExpression params schema tables
352+ -> From params schema tables
308−join tref = FromExpression tref mempty
353+join tables = From tables mempty
309
354
310−renderFromExpression :: FromExpression params schema tables -> ByteString
355+renderFrom :: From params schema tables -> ByteString
311−renderFromExpression (FromExpression tref (Clauses wh lim off))= mconcat
356+renderFrom (From tref (Clauses wh lim off))= mconcat
312− [ renderJoinExpression tref
357+ [ renderJoin tref
313 , maybe "" ((" WHERE " <>) . renderExpression) wh
358 , maybe "" ((" WHERE " <>) . renderExpression) wh
314 , maybe "" ((" LIMIT " <>) . renderExpression) lim
359 , maybe "" ((" LIMIT " <>) . renderExpression) lim
315 , maybe "" ((" OFFSET " <>) . renderExpression) off
360 , maybe "" ((" OFFSET " <>) . renderExpression) off
316 ]
361 ]
317
362
318instance (HasTable table schema columns, table ~ table')
363instance (HasTable table schema columns, table ~ table')
319− => IsLabel table (FromExpression params schema '[table' ::: columns]) where
364+ => IsLabel table (From params schema '[table' ::: columns]) where
320− fromLabel p = FromExpression (fromLabel p) mempty
365+ fromLabel p = From (fromLabel p) mempty
321
366
322where_
367where_
323 :: Expression params tables ('Required ('NotNull 'PGBool))
368 :: Expression params tables ('Required ('NotNull 'PGBool))
324− -> FromExpression params schema tables
369+ -> From params schema tables
325− -> FromExpression params schema tables
370+ -> From params schema tables
326−where_ wh (FromExpression tabs clauses1) = FromExpression tabs
371+where_ wh (From tabs fromClauses1) = From tabs
327− (clauses1 <> Clauses (Just wh) Nothing Nothing)
372+ (fromClauses1 <> Clauses (Just wh) Nothing Nothing)
328
373
329limit
374limit
330 :: Expression params '[] ('Required ('NotNull 'PGInt8))
375 :: Expression params '[] ('Required ('NotNull 'PGInt8))
331− -> FromExpression params schema tables
376+ -> From params schema tables
332− -> FromExpression params schema tables
377+ -> From params schema tables
333−limit lim (FromExpression tabs clauses1) = FromExpression tabs
378+limit lim (From tabs fromClauses1) = From tabs
334− (clauses1 <> Clauses Nothing (Just lim) Nothing)
379+ (fromClauses1 <> Clauses Nothing (Just lim) Nothing)
335
380
336offset
381offset
337 :: Expression params '[] ('Required ('NotNull 'PGInt8))
382 :: Expression params '[] ('Required ('NotNull 'PGInt8))
338− -> FromExpression params schema tables
383+ -> From params schema tables
339− -> FromExpression params schema tables
384+ -> From params schema tables
340−offset off (FromExpression tabs clauses1) = FromExpression tabs
385+offset off (From tabs fromClauses1) = From tabs
341− (clauses1 <> Clauses Nothing Nothing (Just off))
386+ (fromClauses1 <> Clauses Nothing Nothing (Just off))
342
387
343newtype Selection
388newtype Selection
344 (params :: [ColumnType])
389 (params :: [ColumnType])
345 (schema :: [(Symbol,[(Symbol,ColumnType)])])
390 (schema :: [(Symbol,[(Symbol,ColumnType)])])
346 (columns :: [(Symbol,ColumnType)])
391 (columns :: [(Symbol,ColumnType)])
347 = UnsafeSelection { renderSelection :: ByteString }
392 = UnsafeSelection { renderSelection :: ByteString }
393+ deriving (Show,Eq)
348
394
349starFrom
395starFrom
350 :: tables ~ '[table ::: columns]
396 :: tables ~ '[table ::: columns]
351− => FromExpression params schema tables
397+ => From params schema tables
352 -> Selection params schema columns
398 -> Selection params schema columns
353−starFrom tabs = UnsafeSelection $ "* FROM " <> renderFromExpression tabs
399+starFrom tabs = UnsafeSelection $ "* FROM " <> renderFrom tabs
354
400
355dotStarFrom
401dotStarFrom
356 :: HasTable table tables columns
402 :: HasTable table tables columns
357 => Alias table
403 => Alias table
358− -> FromExpression params schema tables
404+ -> From params schema tables
359 -> Selection params schema columns
405 -> Selection params schema columns
360Alias tab `dotStarFrom` tabs = UnsafeSelection $
406Alias tab `dotStarFrom` tabs = UnsafeSelection $
361− fromString (symbolVal' tab) <> ".* FROM " <> renderFromExpression tabs
407+ fromString (symbolVal' tab) <> ".* FROM " <> renderFrom tabs
362
408
363from
409from
364 :: Rec (Aliased (Expression params tables)) columns
410 :: Rec (Aliased (Expression params tables)) columns
365− -> FromExpression params schema tables
411+ -> From params schema tables
366 -> Selection params schema columns
412 -> Selection params schema columns
367list `from` tabs = UnsafeSelection $
413list `from` tabs = UnsafeSelection $
368− renderList list <> " FROM " <> renderFromExpression tabs
414+ renderList list <> " FROM " <> renderFrom tabs
369 where
415 where
370 renderList
416 renderList
371 = ByteString.intercalate ", "
417 = ByteString.intercalate ", "
372 . recordToList
418 . recordToList
373 . rmap (Const . renderAliased renderExpression)
419 . rmap (Const . renderAliased renderExpression)
374
420
375−newtype Statement
376− (params :: [ColumnType])
377− (columns :: [(Symbol,ColumnType)])
378− (schema0 :: [(Symbol,[(Symbol,ColumnType)])])
379− (schema1 :: [(Symbol,[(Symbol,ColumnType)])])
380− = UnsafeStatement { renderStatement :: ByteString }
381−
382−instance Category (Statement '[] '[]) where
383− id = UnsafeStatement ""
384− statement2 . statement1 = UnsafeStatement $
385− renderStatement statement1 <> " " <> renderStatement statement2
386−
387−newtype PreparedStatement
388− (params :: [ColumnType])
389− (columns :: [(Symbol,ColumnType)])
390− (schema0 :: [(Symbol,[(Symbol,ColumnType)])])
391− (schema1 :: [(Symbol,[(Symbol,ColumnType)])])
392− = UnsafePreparedStatement { renderPreparedStatement :: ByteString }
393−
394select
421select
395 :: Selection params schema columns
422 :: Selection params schema columns
396 -> Statement params columns schema schema
423 -> Statement params columns schema schema
@@ -398,12 +425,16 @@ select = UnsafeStatement . ("SELECT " <>) . (<> ";") . renderSelection
398
425
399subselect
426subselect
400 :: Aliased (Selection params schema) table
427 :: Aliased (Selection params schema) table
401− -> FromExpression params schema '[table]
428+ -> From params schema '[table]
402−subselect selection = FromExpression
429+subselect selection = From
403− { joinExpression = Subselect selection
430+ { fromJoin = Subselect selection
404− , clauses = mempty
431+ , fromClauses = mempty
405 }
432 }
406
433
434+{-----------------------------------------
435+INSERT statements
436+-----------------------------------------}
437+
407insertInto
438insertInto
408 :: HasTable table schema columns
439 :: HasTable table schema columns
409 => Alias table
440 => Alias table
@@ -423,56 +454,14 @@ insertInto (Alias table) expressions = UnsafeStatement $ "INSERT INTO "
423 (\ (expression `As` _) -> Const (renderExpression expression))
454 (\ (expression `As` _) -> Const (renderExpression expression))
424 expressions
455 expressions
425
456
426−class KnownSymbol table => DropTable table schema0 schema1
427− | table schema0 -> schema1 where
428− dropTable :: Alias table -> Statement '[] '[] schema0 schema1
429− dropTable (Alias table) = UnsafeStatement $
430− "DROP TABLE " <> fromString (symbolVal' table) <> ";"
431−instance {-# OVERLAPPING #-}
432− (KnownSymbol table, table ~ table')
433− => DropTable table ((table' ::: columns) ': schema) schema
434−instance {-# OVERLAPPABLE #-}
435− (KnownSymbol table, DropTable table schema0 schema1)
436− => DropTable table (tabCols ': schema0) (tabCols ': schema1)
437−
438−set :: g x -> (Maybe `Compose` g) x
439−set = Compose . Just
440−
441−same :: (Maybe `Compose` g) x
442−same = Compose Nothing
443−
444−update
445− :: HasTable table schema columns
446− => Alias table
447− -> Rec (Aliased (Maybe `Compose` Expression params '[table ::: columns])) columns
448− -> Expression params '[table ::: columns] ('Required ('NotNull 'PGBool))
449− -> Statement params '[] schema schema
450−update (Alias table) columns where' = UnsafeStatement $ mconcat
451− [ "UPDATE "
452− , fromString $ symbolVal' table
453− , " SET "
454− , ByteString.intercalate ", " . catMaybes . recordToList $
455− rmap (Const . renderSet) columns
456− , " WHERE ", renderExpression where'
457− ] where
458− renderSet
459− :: Aliased (Maybe `Compose` Expression params tables) column
460− -> Maybe ByteString
461− renderSet = \case
462− Compose (Just expression) `As` Alias column -> Just $ mconcat
463− [ fromString $ symbolVal' column
464− , " = "
465− , renderExpression expression
466− ]
467− Compose Nothing `As` _ -> Nothing
468−
469−
470{-----------------------------------------
457{-----------------------------------------
471CREATE statements
458CREATE statements
472-----------------------------------------}
459-----------------------------------------}
473
460
474newtype TypeExpression (ty :: ColumnType)
461newtype TypeExpression (ty :: ColumnType)
475 = UnsafeTypeExpression { renderTypeExpression :: ByteString }
462 = UnsafeTypeExpression { renderTypeExpression :: ByteString }
463+ deriving (Show,Eq)
464+
476int2 :: TypeExpression ('Required ('Null 'PGInt2))
465int2 :: TypeExpression ('Required ('Null 'PGInt2))
477int2 = UnsafeTypeExpression "int2"
466int2 = UnsafeTypeExpression "int2"
478int4 :: TypeExpression ('Required ('Null 'PGInt4))
467int4 :: TypeExpression ('Required ('Null 'PGInt4))
@@ -513,3 +502,54 @@ createTable (Alias table) columns = UnsafeStatement $ mconcat
513 renderColumn :: Aliased TypeExpression x -> ByteString
502 renderColumn :: Aliased TypeExpression x -> ByteString
514 renderColumn (ty `As` Alias column) =
503 renderColumn (ty `As` Alias column) =
515 fromString (symbolVal' column) <> " " <> renderTypeExpression ty
504 fromString (symbolVal' column) <> " " <> renderTypeExpression ty
505+
506+{-----------------------------------------
507+DROP statements
508+-----------------------------------------}
509+
510+class KnownSymbol table => DropTable table schema0 schema1
511+ | table schema0 -> schema1 where
512+ dropTable :: Alias table -> Statement '[] '[] schema0 schema1
513+ dropTable (Alias table) = UnsafeStatement $
514+ "DROP TABLE " <> fromString (symbolVal' table) <> ";"
515+instance {-# OVERLAPPING #-}
516+ (KnownSymbol table, table ~ table')
517+ => DropTable table ((table' ::: columns) ': schema) schema
518+instance {-# OVERLAPPABLE #-}
519+ (KnownSymbol table, DropTable table schema0 schema1)
520+ => DropTable table (tabCols ': schema0) (tabCols ': schema1)
521+
522+{-----------------------------------------
523+UPDATE statements
524+-----------------------------------------}
525+
526+set :: g x -> (Maybe `Compose` g) x
527+set = Compose . Just
528+
529+same :: (Maybe `Compose` g) x
530+same = Compose Nothing
531+
532+update
533+ :: HasTable table schema columns
534+ => Alias table
535+ -> Rec (Aliased (Maybe `Compose` Expression params '[table ::: columns])) columns
536+ -> Expression params '[table ::: columns] ('Required ('NotNull 'PGBool))
537+ -> Statement params '[] schema schema
538+update (Alias table) columns where' = UnsafeStatement $ mconcat
539+ [ "UPDATE "
540+ , fromString $ symbolVal' table
541+ , " SET "
542+ , ByteString.intercalate ", " . catMaybes . recordToList $
543+ rmap (Const . renderSet) columns
544+ , " WHERE ", renderExpression where'
545+ ] where
546+ renderSet
547+ :: Aliased (Maybe `Compose` Expression params tables) column
548+ -> Maybe ByteString
549+ renderSet = \case
550+ Compose (Just expression) `As` Alias column -> Just $ mconcat
551+ [ fromString $ symbolVal' column
552+ , " = "
553+ , renderExpression expression
554+ ]
555+ Compose Nothing `As` _ -> Nothing
squeel-postgresql/test/Squeel/PostgreSQL/StatementSpec.hs+1−1
@@ -103,7 +103,7 @@ spec = do
103 \ CROSS JOIN shippers AS shippers;"
103 \ CROSS JOIN shippers AS shippers;"
104 it "should render INNER JOINs" $ do
104 it "should render INNER JOINs" $ do
105 let
105 let
106− innerJoins :: FromExpression '[] JoinTables JoinTables
106+ innerJoins :: From '[] JoinTables JoinTables
107 innerJoins = join $
107 innerJoins = join $
108 #orders
108 #orders
109 & Inner #customers
109 & Inner #customers