git.iko.soy/squeal
on dev help sign in
fix outer joins, def, null, fix EqB, fix OrdB

and clean up, renaming, removal

commit40400fad7c46a9faaeebd682192a2b43af2907bb authorEitan Chatav <eitan.chatav@gmail.com> dateTue 27 Jun 2017, 22:45 (9 years ago) parent7477c38
3 files changed+231−269
compare with dev
unifiedsplit
squeel-postgresql/src/Squeel/PostgreSQL/Schema.hs+15−93 squeel-postgresql/src/Squeel/PostgreSQL/Statement.hs+215−175 squeel-postgresql/test/Squeel/PostgreSQL/StatementSpec.hs+1−1
squeel-postgresql/src/Squeel/PostgreSQL/Schema.hs+15−93
@@ -21,13 +21,11 @@ module Squeel.PostgreSQL.Schema
2121 , (:::)
2222 , Alias (Alias)
2323 , Aliased (As)
24− , KnownPGType (..)
25− , KnownColumns (..)
2624 , renderAliased
2725 , NullityType (..)
28− -- , NullifyType
29− -- , NullifyColumns
30− -- , NullifyTable
26+ , NullifyColumn
27+ , NullifyColumns
28+ , NullifyTable
3129 , ColumnType (..)
3230 , module GHC.OverloadedLabels
3331 , module GHC.TypeLits
@@ -114,94 +112,18 @@ renderAliased
114112renderAliased render (expression `As` Alias alias) =
115113 render expression <> " AS " <> fromString (symbolVal' alias)
116114
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−
193115data NullityType = Null PGType | NotNull PGType
194116
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−
207117data 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
3131
3232import Squeel.PostgreSQL.Schema
3333
34+{-----------------------------------------
35+column expressions
36+-----------------------------------------}
37+
3438newtype Expression
3539 (params :: [ColumnType])
3640 (tables :: [(Symbol,[(Symbol,ColumnType)])])
3741 (ty :: ColumnType)
38− = UnsafeExpression { renderExpression :: ByteString }
42+ = UnsafeExpression { renderExpression :: ByteString }
43+ deriving (Show,Eq)
3944
4045class KnownNat n => HasParameter (n :: Nat) params ty | n params -> ty where
4146 param :: Proxy# n -> Expression params tables ty
@@ -76,6 +81,23 @@ Alias table &. Alias column = UnsafeExpression $
7681 <> "." <>
7782 fromString (symbolVal' column)
7883
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+
79101unsafeBinaryOp
80102 :: ByteString
81103 -> Expression params tables ty0
@@ -131,17 +153,6 @@ instance Boolean (Expression params tables ('Required ('NotNull 'PGBool))) where
131153type instance BooleanOf (Expression params tables ty) =
132154 Expression params tables ('Required ('NotNull 'PGBool))
133155
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−
145156caseWhenThenElse
146157 :: [(Expression params tables ('Required ('NotNull 'PGBool)), Expression params tables ty)]
147158 -> Expression params tables ty
@@ -162,109 +173,143 @@ caseWhenThenElse whenThens else_ = UnsafeExpression $ mconcat
162173instance IfB (Expression params tables ty) where
163174 ifB if_ then_ else_ = caseWhenThenElse [(if_,then_)] else_
164175
165−instance EqB (Expression params tables ty) where
176+instance EqB (Expression params tables (optionality ('NotNull ty))) where
166177 (==*) = unsafeBinaryOp "="
167178 (/=*) = unsafeBinaryOp "<>"
168179
169−instance OrdB (Expression params tables ty) where
180+instance OrdB (Expression params tables (optionality ('NotNull ty))) where
170181 (>*) = unsafeBinaryOp ">"
171182 (>=*) = unsafeBinaryOp ">="
172183 (<*) = unsafeBinaryOp "<"
173184 (<=*) = unsafeBinaryOp "<="
174185
186+{-----------------------------------------
187+table expressions
188+-----------------------------------------}
189+
175190newtype TableExpression
176191 (params :: [ColumnType])
177192 (schema :: [(Symbol,[(Symbol,ColumnType)])])
178193 (columns :: [(Symbol,ColumnType)])
179194 = 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
180206
181−data JoinExpression params schema tables where
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+
240+data Join params schema tables where
182241 Table
183242 :: Aliased (TableExpression params schema) table
184− -> JoinExpression params schema '[table]
243+ -> Join params schema '[table]
185244 Subselect
186245 :: Aliased (Selection params schema) table
187− -> JoinExpression params schema '[table]
246+ -> Join params schema '[table]
188247 Cross
189248 :: Aliased (TableExpression params schema) table
190− -> JoinExpression params schema tables
191− -> JoinExpression params schema (table ': tables)
249+ -> Join params schema tables
250+ -> Join params schema (table ': tables)
192251 Inner
193252 :: Aliased (TableExpression params schema) table
194253 -> Expression params (table ': tables) ('Required ('NotNull 'PGBool))
195− -> JoinExpression params schema tables
196− -> JoinExpression params schema (table ': tables)
197− -- LeftOuter
198− -- :: Aliased (TableExpression params schema) right
199− -- -> Expression params '[left,right] ('Required ('NotNull 'PGBool))
200− -- -> JoinExpression params schema (tables)
201− -- -> JoinExpression params schema (NullifyTable right ': left ': tables)
202− -- RightOuter
203− -- :: Aliased (TableExpression params schema) right
204− -- -> Expression params '[left,right] ('Required ('NotNull 'PGBool))
205− -- -> JoinExpression params schema (left : tables)
206− -- -> JoinExpression params schema (right ': NullifyTable left ': tables)
207− -- FullOuter
208− -- :: Aliased (TableExpression params schema) right
209− -- -> Expression params '[left,right] ('Required ('NotNull 'PGBool))
210− -- -> JoinExpression params schema (left : tables)
211− -- -> JoinExpression params schema
212− -- (NullifyTable right ': NullifyTable left ': tables)
213−
214−renderJoinExpression :: JoinExpression params schema tables -> ByteString
215−renderJoinExpression = \case
254+ -> Join params schema tables
255+ -> Join params schema (table ': tables)
256+ LeftOuter
257+ :: Aliased (TableExpression params schema) right
258+ -> Expression params '[left,right] ('Required ('NotNull 'PGBool))
259+ -> Join params schema (tables)
260+ -> Join params schema (NullifyTable right ': left ': tables)
261+ RightOuter
262+ :: Aliased (TableExpression params schema) right
263+ -> Expression params '[left,right] ('Required ('NotNull 'PGBool))
264+ -> Join params schema (left : tables)
265+ -> Join params schema (right ': NullifyTable left ': tables)
266+ FullOuter
267+ :: Aliased (TableExpression params schema) right
268+ -> Expression params '[left,right] ('Required ('NotNull 'PGBool))
269+ -> Join params schema (left : tables)
270+ -> Join params schema
271+ (NullifyTable right ': NullifyTable left ': tables)
272+
273+renderJoin :: Join params schema tables -> ByteString
274+renderJoin = \case
216275 Table table -> renderAliased renderTableExpression table
217276 Subselect selection -> "SELECT " <> renderAliased renderSelection selection
218277 Cross table tables -> mconcat
219− [ renderJoinExpression tables
278+ [ renderJoin tables
220279 , " CROSS JOIN "
221280 , renderAliased renderTableExpression table
222281 ]
223282 Inner table on tables -> mconcat
224− [ renderJoinExpression tables
283+ [ renderJoin tables
225284 , " INNER JOIN "
226285 , renderAliased renderTableExpression table
227286 , " ON "
228287 , renderExpression on
229288 ]
230− -- LeftOuter table on tables -> mconcat
231− -- [ renderJoinExpression tables
232− -- , " LEFT OUTER JOIN "
233− -- , renderAliased renderTableExpression table
234− -- , " ON "
235− -- , renderExpression on
236− -- ]
237− -- RightOuter table on tables -> mconcat
238− -- [ renderJoinExpression tables
239− -- , " RIGHT OUTER JOIN "
240− -- , renderAliased renderTableExpression table
241− -- , " ON "
242− -- , renderExpression on
243− -- ]
244− -- FullOuter table on tables -> mconcat
245− -- [ renderJoinExpression tables
246− -- , " FULL OUTER JOIN "
247− -- , renderAliased renderTableExpression table
248− -- , " ON "
249− -- , renderExpression on
250− -- ]
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
289+ LeftOuter table on tables -> mconcat
290+ [ renderJoin tables
291+ , " LEFT OUTER JOIN "
292+ , renderAliased renderTableExpression table
293+ , " ON "
294+ , renderExpression on
295+ ]
296+ RightOuter table on tables -> mconcat
297+ [ renderJoin tables
298+ , " RIGHT OUTER JOIN "
299+ , renderAliased renderTableExpression table
300+ , " ON "
301+ , renderExpression on
302+ ]
303+ FullOuter table on tables -> mconcat
304+ [ renderJoin tables
305+ , " FULL OUTER JOIN "
306+ , renderAliased renderTableExpression table
307+ , " ON "
308+ , renderExpression on
309+ ]
265310
266311instance HasTable table schema columns
267− => IsLabel table (JoinExpression params schema '[table ::: columns]) where
312+ => IsLabel table (Join params schema '[table ::: columns]) where
268313 fromLabel p = Table $ fromLabel p
269314
270315data Clauses params tables = Clauses
@@ -293,104 +338,86 @@ instance Monoid (Clauses params tables) where
293338 (Just o1,Just o2) -> Just (o1 + o2)
294339 }
295340
296−data FromExpression
341+data From
297342 (params :: [ColumnType])
298343 (schema :: [(Symbol,[(Symbol,ColumnType)])])
299344 (tables :: [(Symbol,[(Symbol,ColumnType)])])
300− = FromExpression
301− { joinExpression :: JoinExpression params schema tables
302− , clauses :: Clauses params tables
345+ = From
346+ { fromJoin :: Join params schema tables
347+ , fromClauses :: Clauses params tables
303348 }
304349
305350join
306− :: JoinExpression params schema tables
307− -> FromExpression params schema tables
308−join tref = FromExpression tref mempty
351+ :: Join params schema tables
352+ -> From params schema tables
353+join tables = From tables mempty
309354
310−renderFromExpression :: FromExpression params schema tables -> ByteString
311−renderFromExpression (FromExpression tref (Clauses wh lim off))= mconcat
312− [ renderJoinExpression tref
355+renderFrom :: From params schema tables -> ByteString
356+renderFrom (From tref (Clauses wh lim off))= mconcat
357+ [ renderJoin tref
313358 , maybe "" ((" WHERE " <>) . renderExpression) wh
314359 , maybe "" ((" LIMIT " <>) . renderExpression) lim
315360 , maybe "" ((" OFFSET " <>) . renderExpression) off
316361 ]
317362
318363instance (HasTable table schema columns, table ~ table')
319− => IsLabel table (FromExpression params schema '[table' ::: columns]) where
320− fromLabel p = FromExpression (fromLabel p) mempty
364+ => IsLabel table (From params schema '[table' ::: columns]) where
365+ fromLabel p = From (fromLabel p) mempty
321366
322367where_
323368 :: Expression params tables ('Required ('NotNull 'PGBool))
324− -> FromExpression params schema tables
325− -> FromExpression params schema tables
326−where_ wh (FromExpression tabs clauses1) = FromExpression tabs
327− (clauses1 <> Clauses (Just wh) Nothing Nothing)
369+ -> From params schema tables
370+ -> From params schema tables
371+where_ wh (From tabs fromClauses1) = From tabs
372+ (fromClauses1 <> Clauses (Just wh) Nothing Nothing)
328373
329374limit
330375 :: Expression params '[] ('Required ('NotNull 'PGInt8))
331− -> FromExpression params schema tables
332− -> FromExpression params schema tables
333−limit lim (FromExpression tabs clauses1) = FromExpression tabs
334− (clauses1 <> Clauses Nothing (Just lim) Nothing)
376+ -> From params schema tables
377+ -> From params schema tables
378+limit lim (From tabs fromClauses1) = From tabs
379+ (fromClauses1 <> Clauses Nothing (Just lim) Nothing)
335380
336381offset
337382 :: Expression params '[] ('Required ('NotNull 'PGInt8))
338− -> FromExpression params schema tables
339− -> FromExpression params schema tables
340−offset off (FromExpression tabs clauses1) = FromExpression tabs
341− (clauses1 <> Clauses Nothing Nothing (Just off))
383+ -> From params schema tables
384+ -> From params schema tables
385+offset off (From tabs fromClauses1) = From tabs
386+ (fromClauses1 <> Clauses Nothing Nothing (Just off))
342387
343388newtype Selection
344389 (params :: [ColumnType])
345390 (schema :: [(Symbol,[(Symbol,ColumnType)])])
346391 (columns :: [(Symbol,ColumnType)])
347392 = UnsafeSelection { renderSelection :: ByteString }
393+ deriving (Show,Eq)
348394
349395starFrom
350396 :: tables ~ '[table ::: columns]
351− => FromExpression params schema tables
397+ => From params schema tables
352398 -> Selection params schema columns
353−starFrom tabs = UnsafeSelection $ "* FROM " <> renderFromExpression tabs
399+starFrom tabs = UnsafeSelection $ "* FROM " <> renderFrom tabs
354400
355401dotStarFrom
356402 :: HasTable table tables columns
357403 => Alias table
358− -> FromExpression params schema tables
404+ -> From params schema tables
359405 -> Selection params schema columns
360406Alias tab `dotStarFrom` tabs = UnsafeSelection $
361− fromString (symbolVal' tab) <> ".* FROM " <> renderFromExpression tabs
407+ fromString (symbolVal' tab) <> ".* FROM " <> renderFrom tabs
362408
363409from
364410 :: Rec (Aliased (Expression params tables)) columns
365− -> FromExpression params schema tables
411+ -> From params schema tables
366412 -> Selection params schema columns
367413list `from` tabs = UnsafeSelection $
368− renderList list <> " FROM " <> renderFromExpression tabs
414+ renderList list <> " FROM " <> renderFrom tabs
369415 where
370416 renderList
371417 = ByteString.intercalate ", "
372418 . recordToList
373419 . rmap (Const . renderAliased renderExpression)
374420
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−
394421select
395422 :: Selection params schema columns
396423 -> Statement params columns schema schema
@@ -398,12 +425,16 @@ select = UnsafeStatement . ("SELECT " <>) . (<> ";") . renderSelection
398425
399426subselect
400427 :: Aliased (Selection params schema) table
401− -> FromExpression params schema '[table]
402−subselect selection = FromExpression
403− { joinExpression = Subselect selection
404− , clauses = mempty
428+ -> From params schema '[table]
429+subselect selection = From
430+ { fromJoin = Subselect selection
431+ , fromClauses = mempty
405432 }
406433
434+{-----------------------------------------
435+INSERT statements
436+-----------------------------------------}
437+
407438insertInto
408439 :: HasTable table schema columns
409440 => Alias table
@@ -423,56 +454,14 @@ insertInto (Alias table) expressions = UnsafeStatement $ "INSERT INTO "
423454 (\ (expression `As` _) -> Const (renderExpression expression))
424455 expressions
425456
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−
470457{-----------------------------------------
471458CREATE statements
472459-----------------------------------------}
473460
474461newtype TypeExpression (ty :: ColumnType)
475462 = UnsafeTypeExpression { renderTypeExpression :: ByteString }
463+ deriving (Show,Eq)
464+
476465int2 :: TypeExpression ('Required ('Null 'PGInt2))
477466int2 = UnsafeTypeExpression "int2"
478467int4 :: TypeExpression ('Required ('Null 'PGInt4))
@@ -513,3 +502,54 @@ createTable (Alias table) columns = UnsafeStatement $ mconcat
513502 renderColumn :: Aliased TypeExpression x -> ByteString
514503 renderColumn (ty `As` Alias column) =
515504 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
103103 \ CROSS JOIN shippers AS shippers;"
104104 it "should render INNER JOINs" $ do
105105 let
106− innerJoins :: FromExpression '[] JoinTables JoinTables
106+ innerJoins :: From '[] JoinTables JoinTables
107107 innerJoins = join $
108108 #orders
109109 & Inner #customers