git.iko.soy/squeal
on dev help sign in
lots of stuff
3be316aEitan Chatav
squeal-postgresql/src/Squeal/PostgreSQL/Binary.hs+30−50
compare with dev
unifiedsplit
@@ -9,10 +9,7 @@ Binary encoding and decoding between Haskell and PostgreSQL types.
9-}
9-}
10
10
11{-# LANGUAGE
11{-# LANGUAGE
12− ConstraintKinds
13− , DataKinds
14− , DefaultSignatures
15− , DeriveFoldable
12+ DeriveFoldable
16 , DeriveFunctor
13 , DeriveFunctor
17 , DeriveGeneric
14 , DeriveGeneric
18 , DeriveTraversable
15 , DeriveTraversable
@@ -20,12 +17,9 @@ Binary encoding and decoding between Haskell and PostgreSQL types.
20 , FlexibleInstances
17 , FlexibleInstances
21 , GADTs
18 , GADTs
22 , LambdaCase
19 , LambdaCase
23− , KindSignatures
24 , MultiParamTypeClasses
20 , MultiParamTypeClasses
25 , ScopedTypeVariables
21 , ScopedTypeVariables
26 , TypeApplications
22 , TypeApplications
27− , TypeFamilies
28− , TypeFamilyDependencies
29 , TypeInType
23 , TypeInType
30 , TypeOperators
24 , TypeOperators
31 , UndecidableInstances
25 , UndecidableInstances
@@ -231,61 +225,47 @@ instance
231 Decoding.enum (readMaybe . upper . Strict.unpack)
225 Decoding.enum (readMaybe . upper . Strict.unpack)
232instance
226instance
233 ( SListI fields
227 ( SListI fields
234− , IsMaybes ys
228+ , MapMaybes ys
235 , IsProductType y (Maybes ys)
229 , IsProductType y (Maybes ys)
236 , AllZip FromAliasedValue fields ys
230 , AllZip FromAliasedValue fields ys
237 , SameFields (DatatypeInfoOf y) fields
231 , SameFields (DatatypeInfoOf y) fields
238 ) => FromValue ('PGcomposite fields) y where
232 ) => FromValue ('PGcomposite fields) y where
239− fromValue = fmap (to . SOP . Z . maybes) . composite . decoders
233+ fromValue =
240−
234+ let
241−class IsMaybes (xs :: [Type]) where
235+ decoders
242− type family Maybes xs = (mxs :: [Type]) | mxs -> xs
236+ :: forall pgs zs proxy
243− maybes :: NP Maybe xs -> NP I (Maybes xs)
237+ . AllZip FromAliasedValue pgs zs
238+ => proxy ('PGcomposite pgs)
239+ -> NP Decoding.Value zs
240+ decoders _ = htrans (Proxy @FromAliasedValue) fromAliasedValue
241+ (hpure Proxy :: NP Proxy pgs)
244
242
245−instance IsMaybes '[] where
243+ composite fields = do
246− type Maybes '[] = '[]
244+ -- [for each field]
247− maybes Nil = Nil
245+ -- <OID of field's type: sizeof(Oid) bytes>
246+ -- [if value is NULL]
247+ -- <-1: 4 bytes>
248+ -- [else]
249+ -- <length of value: 4 bytes>
250+ -- <value: <length> bytes>
251+ -- [end if]
252+ -- [end for]
253+ -- <number of fields: 4 bytes>
254+ unitOfSize 4
255+ let
256+ each field = do
257+ unitOfSize 4
258+ len <- sized 4 Decoding.int
259+ if len == -1 then return Nothing else Just <$> sized len field
260+ htraverse' each fields
248
261
249−instance IsMaybes xs => IsMaybes (x ': xs) where
262+ in fmap (to . SOP . Z . maybes) . composite . decoders
250− type Maybes (x ': xs) = Maybe x ': Maybes xs
251− maybes (x :* xs) = I x :* maybes xs
252
263
253class FromAliasedValue (pg :: (Symbol,PGType)) (y :: Type) where
264class FromAliasedValue (pg :: (Symbol,PGType)) (y :: Type) where
254 fromAliasedValue :: proxy pg -> Decoding.Value y
265 fromAliasedValue :: proxy pg -> Decoding.Value y
255instance FromValue pg y => FromAliasedValue (alias ::: pg) y where
266instance FromValue pg y => FromAliasedValue (alias ::: pg) y where
256 fromAliasedValue _ = fromValue (Proxy @pg)
267 fromAliasedValue _ = fromValue (Proxy @pg)
257
268
258−decoders
259− :: forall pgs ys proxy
260− . AllZip FromAliasedValue pgs ys
261− => proxy ('PGcomposite pgs)
262− -> NP Decoding.Value ys
263−decoders _ = htrans (Proxy @FromAliasedValue) fromAliasedValue
264− (hpure Proxy :: NP Proxy pgs)
265−
266−composite
267− :: SListI ys
268− => NP Decoding.Value ys
269− -> Decoding.Value (NP Maybe ys)
270−composite fields = do
271−-- [for each field]
272−-- <OID of field's type: sizeof(Oid) bytes>
273−-- [if value is NULL]
274−-- <-1: 4 bytes>
275−-- [else]
276−-- <length of value: 4 bytes>
277−-- <value: <length> bytes>
278−-- [end if]
279−-- [end for]
280−-- <number of fields: 4 bytes>
281− unitOfSize 4
282− let
283− each field = do
284− unitOfSize 4
285− len <- sized 4 Decoding.int
286− if len == -1 then return Nothing else Just <$> sized len field
287− htraverse' each fields
288−
289-- | A `FromColumnValue` constraint lifts the `FromValue` parser
269-- | A `FromColumnValue` constraint lifts the `FromValue` parser
290-- to a decoding of a @(Symbol, ColumnType)@ to a `Type`,
270-- to a decoding of a @(Symbol, ColumnType)@ to a `Type`,
291-- decoding `Null`s to `Maybe`s. You should not define instances for
271-- decoding `Null`s to `Maybe`s. You should not define instances for
squeal-postgresql/src/Squeal/PostgreSQL/Definition.hs−4
@@ -10,20 +10,16 @@ Squeal data definition language.
10
10
11{-# LANGUAGE
11{-# LANGUAGE
12 ConstraintKinds
12 ConstraintKinds
13− , DataKinds
14− , DeriveDataTypeable
15 , DeriveGeneric
13 , DeriveGeneric
16 , FlexibleContexts
14 , FlexibleContexts
17 , FlexibleInstances
15 , FlexibleInstances
18 , GADTs
16 , GADTs
19 , GeneralizedNewtypeDeriving
17 , GeneralizedNewtypeDeriving
20− , KindSignatures
21 , LambdaCase
18 , LambdaCase
22 , MultiParamTypeClasses
19 , MultiParamTypeClasses
23 , OverloadedStrings
20 , OverloadedStrings
24 , RankNTypes
21 , RankNTypes
25 , ScopedTypeVariables
22 , ScopedTypeVariables
26− , StandaloneDeriving
27 , TypeApplications
23 , TypeApplications
28 , TypeInType
24 , TypeInType
29 , TypeOperators
25 , TypeOperators
squeal-postgresql/src/Squeal/PostgreSQL/Expression.hs+3−11
@@ -11,21 +11,15 @@ Squeal expressions are the atoms used to build statements.
11{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
11{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
12{-# LANGUAGE
12{-# LANGUAGE
13 AllowAmbiguousTypes
13 AllowAmbiguousTypes
14− , DataKinds
15 , DeriveGeneric
14 , DeriveGeneric
16− , DeriveDataTypeable
17 , FlexibleContexts
15 , FlexibleContexts
18 , FlexibleInstances
16 , FlexibleInstances
19 , FunctionalDependencies
17 , FunctionalDependencies
20− , GADTs
21 , GeneralizedNewtypeDeriving
18 , GeneralizedNewtypeDeriving
22 , LambdaCase
19 , LambdaCase
23 , MagicHash
20 , MagicHash
24 , OverloadedStrings
21 , OverloadedStrings
25− , PolyKinds
26− , RankNTypes
27 , ScopedTypeVariables
22 , ScopedTypeVariables
28− , StandaloneDeriving
29 , TypeApplications
23 , TypeApplications
30 , TypeFamilies
24 , TypeFamilies
31 , TypeInType
25 , TypeInType
@@ -46,8 +40,10 @@ module Squeal.PostgreSQL.Expression
46 , isn'tNull
40 , isn'tNull
47 , matchNull
41 , matchNull
48 , nullIf
42 , nullIf
49− -- ** Arrays
43+ -- ** Arrays, Enums, Composites
50 , array
44 , array
45+ , label
46+ , row
51 -- ** Functions
47 -- ** Functions
52 , unsafeBinaryOp
48 , unsafeBinaryOp
53 , unsafeUnaryOp
49 , unsafeUnaryOp
@@ -330,10 +326,6 @@ label
330label (_ :: Alias label) = UnsafeExpression $
326label (_ :: Alias label) = UnsafeExpression $
331 fromString $ symbolVal (Proxy @label)
327 fromString $ symbolVal (Proxy @label)
332
328
333−type family Nulls tys where
334− Nulls '[] = '[]
335− Nulls (field ::: ty ': tys) = field ::: 'Null ty ': Nulls tys
336−
337row
329row
338 :: (SListI (Nulls fields))
330 :: (SListI (Nulls fields))
339 => NP (Aliased (Expression relation grouping params)) (Nulls fields)
331 => NP (Aliased (Expression relation grouping params)) (Nulls fields)
squeal-postgresql/src/Squeal/PostgreSQL/Manipulation.hs+41−45
@@ -9,17 +9,13 @@ Squeal data manipulation language.
9-}
9-}
10
10
11{-# LANGUAGE
11{-# LANGUAGE
12− DataKinds
13− , DeriveDataTypeable
14− , DeriveGeneric
12+ DeriveGeneric
15 , FlexibleContexts
13 , FlexibleContexts
16 , GADTs
14 , GADTs
17 , GeneralizedNewtypeDeriving
15 , GeneralizedNewtypeDeriving
18− , KindSignatures
19 , LambdaCase
16 , LambdaCase
20 , OverloadedStrings
17 , OverloadedStrings
21 , RankNTypes
18 , RankNTypes
22− , StandaloneDeriving
23 , TypeInType
19 , TypeInType
24 , TypeOperators
20 , TypeOperators
25#-}
21#-}
@@ -203,32 +199,32 @@ queryStatement q = UnsafeManipulation $ renderQuery q <> ";"
203INSERT statements
199INSERT statements
204-----------------------------------------}
200-----------------------------------------}
205
201
206−-- | Insert multiple rows.
202+-- | Insert multiple rws.
207--
203--
208-- When a table is created, it contains no data. The first thing to do
204-- When a table is created, it contains no data. The first thing to do
209-- before a database can be of much use is to insert data. Data is
205-- before a database can be of much use is to insert data. Data is
210−-- conceptually inserted one row at a time. Of course you can also insert
206+-- conceptually inserted one rw at a time. Of course you can also insert
211−-- more than one row, but there is no way to insert less than one row.
207+-- more than one rw, but there is no way to insert less than one rw.
212−-- Even if you know only some column values, a complete row must be created.
208+-- Even if you know only some column values, a complete rw must be created.
213insertRows
209insertRows
214 :: ( SOP.SListI columns
210 :: ( SOP.SListI columns
215 , SOP.SListI results
211 , SOP.SListI results
216 , Has tab schema ('Table table)
212 , Has tab schema ('Table table)
217 , columns ~ TableToColumns table )
213 , columns ~ TableToColumns table )
218 => Alias tab -- ^ table to insert into
214 => Alias tab -- ^ table to insert into
219− -> NP (Aliased (ColumnValue '[] params)) columns -- ^ row to insert
215+ -> NP (Aliased (ColumnValue '[] params)) columns -- ^ rw to insert
220− -> [NP (Aliased (ColumnValue '[] params)) columns] -- ^ more rows to insert
216+ -> [NP (Aliased (ColumnValue '[] params)) columns] -- ^ more rws to insert
221 -> ConflictClause columns params
217 -> ConflictClause columns params
222 -- ^ what to do in case of constraint conflict
218 -- ^ what to do in case of constraint conflict
223 -> ReturningClause columns params results -- ^ results to return
219 -> ReturningClause columns params results -- ^ results to return
224 -> Manipulation schema params results
220 -> Manipulation schema params results
225−insertRows tab row rows conflict returning = UnsafeManipulation $
221+insertRows tab rw rws conflict returning = UnsafeManipulation $
226 "INSERT" <+> "INTO" <+> renderAlias tab
222 "INSERT" <+> "INTO" <+> renderAlias tab
227− <+> parenthesized (renderCommaSeparated renderAliasPart row)
223+ <+> parenthesized (renderCommaSeparated renderAliasPart rw)
228 <+> "VALUES"
224 <+> "VALUES"
229 <+> commaSeparated
225 <+> commaSeparated
230 ( parenthesized
226 ( parenthesized
231− . renderCommaSeparated renderColumnValuePart <$> row:rows )
227+ . renderCommaSeparated renderColumnValuePart <$> rw:rws )
232 <> renderConflictClause conflict
228 <> renderConflictClause conflict
233 <> renderReturningClause returning
229 <> renderReturningClause returning
234 where
230 where
@@ -239,41 +235,41 @@ insertRows tab row rows conflict returning = UnsafeManipulation $
239 Default -> "DEFAULT"
235 Default -> "DEFAULT"
240 Set expression -> renderExpression expression
236 Set expression -> renderExpression expression
241
237
242−-- | Insert a single row.
238+-- | Insert a single rw.
243insertRow
239insertRow
244 :: ( SOP.SListI columns
240 :: ( SOP.SListI columns
245 , SOP.SListI results
241 , SOP.SListI results
246 , Has tab schema ('Table table)
242 , Has tab schema ('Table table)
247 , columns ~ TableToColumns table )
243 , columns ~ TableToColumns table )
248 => Alias tab -- ^ table to insert into
244 => Alias tab -- ^ table to insert into
249− -> NP (Aliased (ColumnValue '[] params)) columns -- ^ row to insert
245+ -> NP (Aliased (ColumnValue '[] params)) columns -- ^ rw to insert
250 -> ConflictClause columns params
246 -> ConflictClause columns params
251 -- ^ what to do in case of constraint conflict
247 -- ^ what to do in case of constraint conflict
252 -> ReturningClause columns params results -- ^ results to return
248 -> ReturningClause columns params results -- ^ results to return
253 -> Manipulation schema params results
249 -> Manipulation schema params results
254−insertRow tab row = insertRows tab row []
250+insertRow tab rw = insertRows tab rw []
255
251
256−-- | Insert multiple rows returning `Nil` and raising an error on conflicts.
252+-- | Insert multiple rws returning `Nil` and raising an error on conflicts.
257insertRows_
253insertRows_
258 :: ( SOP.SListI columns
254 :: ( SOP.SListI columns
259 , Has tab schema ('Table table)
255 , Has tab schema ('Table table)
260 , columns ~ TableToColumns table )
256 , columns ~ TableToColumns table )
261 => Alias tab -- ^ table to insert into
257 => Alias tab -- ^ table to insert into
262− -> NP (Aliased (ColumnValue '[] params)) columns -- ^ row to insert
258+ -> NP (Aliased (ColumnValue '[] params)) columns -- ^ rw to insert
263− -> [NP (Aliased (ColumnValue '[] params)) columns] -- ^ more rows to insert
259+ -> [NP (Aliased (ColumnValue '[] params)) columns] -- ^ more rws to insert
264 -> Manipulation schema params '[]
260 -> Manipulation schema params '[]
265−insertRows_ tab row rows =
261+insertRows_ tab rw rws =
266− insertRows tab row rows OnConflictDoRaise (Returning Nil)
262+ insertRows tab rw rws OnConflictDoRaise (Returning Nil)
267
263
268−-- | Insert a single row returning `Nil` and raising an error on conflicts.
264+-- | Insert a single rw returning `Nil` and raising an error on conflicts.
269insertRow_
265insertRow_
270 :: ( SOP.SListI columns
266 :: ( SOP.SListI columns
271 , Has tab schema ('Table table)
267 , Has tab schema ('Table table)
272 , columns ~ TableToColumns table )
268 , columns ~ TableToColumns table )
273 => Alias tab -- ^ table to insert into
269 => Alias tab -- ^ table to insert into
274− -> NP (Aliased (ColumnValue '[] params)) columns -- ^ row to insert
270+ -> NP (Aliased (ColumnValue '[] params)) columns -- ^ rw to insert
275 -> Manipulation schema params '[]
271 -> Manipulation schema params '[]
276−insertRow_ tab row = insertRow tab row OnConflictDoRaise (Returning Nil)
272+insertRow_ tab rw = insertRow tab rw OnConflictDoRaise (Returning Nil)
277
273
278-- | Insert a `Query`.
274-- | Insert a `Query`.
279insertQuery
275insertQuery
@@ -304,11 +300,11 @@ insertQuery_
304insertQuery_ tab query =
300insertQuery_ tab query =
305 insertQuery tab query OnConflictDoRaise (Returning Nil)
301 insertQuery tab query OnConflictDoRaise (Returning Nil)
306
302
307−-- | `ColumnValue`s are values to insert or update in a row
303+-- | `ColumnValue`s are values to insert or update in a rw
308-- `Same` updates with the same value.
304-- `Same` updates with the same value.
309-- `Default` inserts or updates with the @DEFAULT@ value
305-- `Default` inserts or updates with the @DEFAULT@ value
310-- `Set` a value to be an `Expression`, relative to the given
306-- `Set` a value to be an `Expression`, relative to the given
311−-- row for an update, and closed for an insert.
307+-- rw for an update, and closed for an insert.
312data ColumnValue
308data ColumnValue
313 (columns :: RelationType)
309 (columns :: RelationType)
314 (params :: [NullityType])
310 (params :: [NullityType])
@@ -321,14 +317,14 @@ data ColumnValue
321 -> ColumnValue columns params (constraint :=> ty)
317 -> ColumnValue columns params (constraint :=> ty)
322
318
323-- | A `ReturningClause` computes and return value(s) based
319-- | A `ReturningClause` computes and return value(s) based
324−-- on each row actually inserted, updated or deleted. This is primarily
320+-- on each rw actually inserted, updated or deleted. This is primarily
325-- useful for obtaining values that were supplied by defaults, such as a
321-- useful for obtaining values that were supplied by defaults, such as a
326-- serial sequence number. However, any expression using the table's columns
322-- serial sequence number. However, any expression using the table's columns
327−-- is allowed. Only rows that were successfully inserted or updated or
323+-- is allowed. Only rws that were successfully inserted or updated or
328−-- deleted will be returned. For example, if a row was locked
324+-- deleted will be returned. For example, if a rw was locked
329-- but not updated because an `OnConflictDoUpdate` condition was not satisfied,
325-- but not updated because an `OnConflictDoUpdate` condition was not satisfied,
330−-- the row will not be returned. `ReturningStar` will return all columns
326+-- the rw will not be returned. `ReturningStar` will return all columns
331−-- in the row. Use @Returning Nil@ in the common case where no return
327+-- in the rw. Use @Returning Nil@ in the common case where no return
332-- values are desired.
328-- values are desired.
333data ReturningClause
329data ReturningClause
334 (columns :: ColumnsType)
330 (columns :: ColumnsType)
@@ -356,8 +352,8 @@ renderReturningClause = \case
356
352
357-- | A `ConflictClause` specifies an action to perform upon a constraint
353-- | A `ConflictClause` specifies an action to perform upon a constraint
358-- violation. `OnConflictDoRaise` will raise an error.
354-- violation. `OnConflictDoRaise` will raise an error.
359−-- `OnConflictDoNothing` simply avoids inserting a row.
355+-- `OnConflictDoNothing` simply avoids inserting a rw.
360−-- `OnConflictDoUpdate` updates the existing row that conflicts with the row
356+-- `OnConflictDoUpdate` updates the existing rw that conflicts with the rw
361-- proposed for insertion.
357-- proposed for insertion.
362data ConflictClause (columns :: ColumnsType) params where
358data ConflictClause (columns :: ColumnsType) params where
363 OnConflictDoRaise :: ConflictClause columns params
359 OnConflictDoRaise :: ConflictClause columns params
@@ -397,7 +393,7 @@ UPDATE statements
397-----------------------------------------}
393-----------------------------------------}
398
394
399-- | An `update` command changes the values of the specified columns
395-- | An `update` command changes the values of the specified columns
400−-- in all rows that satisfy the condition.
396+-- in all rws that satisfy the condition.
401update
397update
402 :: ( SOP.SListI columns
398 :: ( SOP.SListI columns
403 , SOP.SListI results
399 , SOP.SListI results
@@ -407,7 +403,7 @@ update
407 -> NP (Aliased (ColumnValue (ColumnsToRelation columns) params)) columns
403 -> NP (Aliased (ColumnValue (ColumnsToRelation columns) params)) columns
408 -- ^ modified values to replace old values
404 -- ^ modified values to replace old values
409 -> Condition '[tab ::: ColumnsToRelation columns] 'Ungrouped params
405 -> Condition '[tab ::: ColumnsToRelation columns] 'Ungrouped params
410− -- ^ condition under which to perform update on a row
406+ -- ^ condition under which to perform update on a rw
411 -> ReturningClause columns params results -- ^ results to return
407 -> ReturningClause columns params results -- ^ results to return
412 -> Manipulation schema params results
408 -> Manipulation schema params results
413update tab columns wh returning = UnsafeManipulation $
409update tab columns wh returning = UnsafeManipulation $
@@ -428,7 +424,7 @@ update tab columns wh returning = UnsafeManipulation $
428 Set expression `As` column -> Just $
424 Set expression `As` column -> Just $
429 renderAlias column <+> "=" <+> renderExpression expression
425 renderAlias column <+> "=" <+> renderExpression expression
430
426
431−-- | Update a row returning `Nil`.
427+-- | Update a rw returning `Nil`.
432update_
428update_
433 :: ( SOP.SListI columns
429 :: ( SOP.SListI columns
434 , Has tab schema ('Table table)
430 , Has tab schema ('Table table)
@@ -437,7 +433,7 @@ update_
437 -> NP (Aliased (ColumnValue (ColumnsToRelation columns) params)) columns
433 -> NP (Aliased (ColumnValue (ColumnsToRelation columns) params)) columns
438 -- ^ modified values to replace old values
434 -- ^ modified values to replace old values
439 -> Condition '[tab ::: ColumnsToRelation columns] 'Ungrouped params
435 -> Condition '[tab ::: ColumnsToRelation columns] 'Ungrouped params
440− -- ^ condition under which to perform update on a row
436+ -- ^ condition under which to perform update on a rw
441 -> Manipulation schema params '[]
437 -> Manipulation schema params '[]
442update_ tab columns wh = update tab columns wh (Returning Nil)
438update_ tab columns wh = update tab columns wh (Returning Nil)
443
439
@@ -445,14 +441,14 @@ update_ tab columns wh = update tab columns wh (Returning Nil)
445DELETE statements
441DELETE statements
446-----------------------------------------}
442-----------------------------------------}
447
443
448−-- | Delete rows of a table.
444+-- | Delete rws of a table.
449deleteFrom
445deleteFrom
450 :: ( SOP.SListI results
446 :: ( SOP.SListI results
451 , Has tab schema ('Table table)
447 , Has tab schema ('Table table)
452 , columns ~ TableToColumns table )
448 , columns ~ TableToColumns table )
453 => Alias tab -- ^ table to delete from
449 => Alias tab -- ^ table to delete from
454 -> Condition '[tab ::: ColumnsToRelation columns] 'Ungrouped params
450 -> Condition '[tab ::: ColumnsToRelation columns] 'Ungrouped params
455− -- ^ condition under which to delete a row
451+ -- ^ condition under which to delete a rw
456 -> ReturningClause columns params results -- ^ results to return
452 -> ReturningClause columns params results -- ^ results to return
457 -> Manipulation schema params results
453 -> Manipulation schema params results
458deleteFrom tab wh returning = UnsafeManipulation $
454deleteFrom tab wh returning = UnsafeManipulation $
@@ -460,13 +456,13 @@ deleteFrom tab wh returning = UnsafeManipulation $
460 <+> "WHERE" <+> renderExpression wh
456 <+> "WHERE" <+> renderExpression wh
461 <> renderReturningClause returning
457 <> renderReturningClause returning
462
458
463−-- | Delete rows returning `Nil`.
459+-- | Delete rws returning `Nil`.
464deleteFrom_
460deleteFrom_
465 :: ( Has tab schema ('Table table)
461 :: ( Has tab schema ('Table table)
466 , columns ~ TableToColumns table )
462 , columns ~ TableToColumns table )
467 => Alias tab -- ^ table to delete from
463 => Alias tab -- ^ table to delete from
468 -> Condition '[tab ::: ColumnsToRelation columns] 'Ungrouped params
464 -> Condition '[tab ::: ColumnsToRelation columns] 'Ungrouped params
469− -- ^ condition under which to delete a row
465+ -- ^ condition under which to delete a rw
470 -> Manipulation schema params '[]
466 -> Manipulation schema params '[]
471deleteFrom_ tab wh = deleteFrom tab wh (Returning Nil)
467deleteFrom_ tab wh = deleteFrom tab wh (Returning Nil)
472
468
@@ -484,11 +480,11 @@ WITH statements
484-- let
480-- let
485-- manipulation :: Manipulation '["products" ::: 'Table ProductsTable, "products_deleted" ::: 'Table ProductsTable] '[ 'NotNull 'PGdate] '[]
481-- manipulation :: Manipulation '["products" ::: 'Table ProductsTable, "products_deleted" ::: 'Table ProductsTable] '[ 'NotNull 'PGdate] '[]
486-- manipulation = with
482-- manipulation = with
487−-- (deleteFrom #products (#date .< param @1) ReturningStar `As` #deleted_rows :* Nil)
483+-- (deleteFrom #products (#date .< param @1) ReturningStar `As` #deleted_rws :* Nil)
488−-- (insertQuery_ #products_deleted (selectStar (from (view (#deleted_rows `As` #t)))))
484+-- (insertQuery_ #products_deleted (selectStar (from (view (#deleted_rws `As` #t)))))
489-- in renderManipulation manipulation
485-- in renderManipulation manipulation
490-- :}
486-- :}
491−-- "WITH \"deleted_rows\" AS (DELETE FROM \"products\" WHERE (\"date\" < ($1 :: date)) RETURNING *) INSERT INTO \"products_deleted\" SELECT * FROM \"deleted_rows\" AS \"t\";"
487+-- "WITH \"deleted_rws\" AS (DELETE FROM \"products\" WHERE (\"date\" < ($1 :: date)) RETURNING *) INSERT INTO \"products_deleted\" SELECT * FROM \"deleted_rws\" AS \"t\";"
492with
488with
493 :: SOP.SListI commons
489 :: SOP.SListI commons
494 => NP (Aliased (Manipulation schema params)) commons
490 => NP (Aliased (Manipulation schema params)) commons
squeal-postgresql/src/Squeal/PostgreSQL/Migration.hs+1−3
@@ -90,9 +90,7 @@ Row 0
90-}
90-}
91
91
92{-# LANGUAGE
92{-# LANGUAGE
93− ScopedTypeVariables
94− , OverloadedStrings
95− , DataKinds
93+ DataKinds
96 , GADTs
94 , GADTs
97 , LambdaCase
95 , LambdaCase
98 , PolyKinds
96 , PolyKinds
squeal-postgresql/src/Squeal/PostgreSQL/PQ.hs+1−6
@@ -20,15 +20,10 @@ of executing Squeal commands.
20
20
21{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
21{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
22{-# LANGUAGE
22{-# LANGUAGE
23− DataKinds
24− , DefaultSignatures
23+ DefaultSignatures
25 , FunctionalDependencies
24 , FunctionalDependencies
26− , PolyKinds
27− , DeriveFunctor
28 , FlexibleContexts
25 , FlexibleContexts
29 , FlexibleInstances
26 , FlexibleInstances
30− , MagicHash
31− , MultiParamTypeClasses
32 , OverloadedStrings
27 , OverloadedStrings
33 , RankNTypes
28 , RankNTypes
34 , ScopedTypeVariables
29 , ScopedTypeVariables
squeal-postgresql/src/Squeal/PostgreSQL/Pool.hs+1−2
@@ -9,8 +9,7 @@ A `MonadPQ` for pooled connections.
9-}
9-}
10
10
11{-# LANGUAGE
11{-# LANGUAGE
12− DataKinds
13− , DeriveFunctor
12+ DeriveFunctor
14 , FlexibleContexts
13 , FlexibleContexts
15 , FlexibleInstances
14 , FlexibleInstances
16 , MultiParamTypeClasses
15 , MultiParamTypeClasses
squeal-postgresql/src/Squeal/PostgreSQL/Query.hs+1−10
@@ -9,23 +9,14 @@ Squeal queries.
9-}
9-}
10
10
11{-# LANGUAGE
11{-# LANGUAGE
12− DataKinds
13− , DeriveDataTypeable
14− , DeriveGeneric
12+ DeriveGeneric
15− , FlexibleContexts
16− , FlexibleInstances
17 , GADTs
13 , GADTs
18 , GeneralizedNewtypeDeriving
14 , GeneralizedNewtypeDeriving
19− , KindSignatures
20 , LambdaCase
15 , LambdaCase
21− , MultiParamTypeClasses
22 , OverloadedStrings
16 , OverloadedStrings
23− , ScopedTypeVariables
24 , StandaloneDeriving
17 , StandaloneDeriving
25− , TypeApplications
26 , TypeInType
18 , TypeInType
27 , TypeOperators
19 , TypeOperators
28− , UndecidableInstances
29#-}
20#-}
30
21
31module Squeal.PostgreSQL.Query
22module Squeal.PostgreSQL.Query
squeal-postgresql/src/Squeal/PostgreSQL/Render.hs−1
@@ -14,7 +14,6 @@ Rendering helper functions.
14 , PolyKinds
14 , PolyKinds
15 , RankNTypes
15 , RankNTypes
16 , ScopedTypeVariables
16 , ScopedTypeVariables
17− , TypeApplications
18#-}
17#-}
19
18
20module Squeal.PostgreSQL.Render
19module Squeal.PostgreSQL.Render
squeal-postgresql/src/Squeal/PostgreSQL/Schema.hs+18−49
@@ -11,23 +11,17 @@ A type-level DSL for kinds of PostgreSQL types, constraints, and aliases.
11{-# LANGUAGE
11{-# LANGUAGE
12 AllowAmbiguousTypes
12 AllowAmbiguousTypes
13 , ConstraintKinds
13 , ConstraintKinds
14− , DataKinds
15 , DeriveAnyClass
14 , DeriveAnyClass
16− , DeriveDataTypeable
17 , DeriveGeneric
15 , DeriveGeneric
18 , FlexibleContexts
16 , FlexibleContexts
19 , FlexibleInstances
17 , FlexibleInstances
20 , FunctionalDependencies
18 , FunctionalDependencies
21 , GADTs
19 , GADTs
22− , MagicHash
23− , MultiParamTypeClasses
24 , OverloadedStrings
20 , OverloadedStrings
25− , PolyKinds
26 , RankNTypes
21 , RankNTypes
27− , ScopedTypeVariables
28 , StandaloneDeriving
22 , StandaloneDeriving
29 , TypeApplications
23 , TypeApplications
30− , TypeFamilies
24+ , TypeFamilyDependencies
31 , TypeInType
25 , TypeInType
32 , TypeOperators
26 , TypeOperators
33 , UndecidableInstances
27 , UndecidableInstances
@@ -45,8 +39,6 @@ module Squeal.PostgreSQL.Schema
45 , NilRelation
39 , NilRelation
46 , RelationsType
40 , RelationsType
47 , TableType
41 , TableType
48− , TablesType
49− , NilTables
50 -- * Grouping
42 -- * Grouping
51 , Grouping (..)
43 , Grouping (..)
52 , GroupedBy
44 , GroupedBy
@@ -92,8 +84,6 @@ module Squeal.PostgreSQL.Schema
92 , ColumnsToRelation
84 , ColumnsToRelation
93 , RelationToColumns
85 , RelationToColumns
94 , TableToColumns
86 , TableToColumns
95− , TablesToRelations
96− , RelationsToTables
97 , ConstraintInvolves
87 , ConstraintInvolves
98 , DropIfConstraintsInvolve
88 , DropIfConstraintsInvolve
99 -- * Generics
89 -- * Generics
@@ -101,6 +91,8 @@ module Squeal.PostgreSQL.Schema
101 , SameFields
91 , SameFields
102 , SameLabel
92 , SameLabel
103 , SameLabels
93 , SameLabels
94+ , MapMaybes (..)
95+ , Nulls
104 -- * Schema
96 -- * Schema
105 , SchemumType (..)
97 , SchemumType (..)
106 , SchemaType
98 , SchemaType
@@ -109,11 +101,11 @@ module Squeal.PostgreSQL.Schema
109
101
110import Control.DeepSeq
102import Control.DeepSeq
111import Data.ByteString
103import Data.ByteString
104+import Data.Kind
112import Data.Monoid hiding (All)
105import Data.Monoid hiding (All)
113import Data.String
106import Data.String
114import Data.Word
107import Data.Word
115import Data.Type.Bool
108import Data.Type.Bool
116−import GHC.Exts
117import GHC.OverloadedLabels
109import GHC.OverloadedLabels
118import GHC.TypeLits
110import GHC.TypeLits
119
111
@@ -279,31 +271,6 @@ type family Uniquely
279-- :}
271-- :}
280type TableType = (TableConstraints,ColumnsType)
272type TableType = (TableConstraints,ColumnsType)
281
273
282−-- | `TablesType` is a row of `TableType`s, thought of as a union.
283−--
284−-- >>> :{
285−-- type family Schema :: TablesType where
286−-- Schema =
287−-- '[ "users" :::
288−-- '[ "pk_users" ::: 'PrimaryKey '["id"] ] :=>
289−-- '[ "id" ::: 'Def :=> 'NotNull 'PGint4
290−-- , "name" ::: 'NoDef :=> 'NotNull 'PGtext
291−-- , "vec" ::: 'NoDef :=> 'NotNull ('PGvararray 'PGint2)
292−-- ]
293−-- , "emails" :::
294−-- '[ "pk_emails" ::: 'PrimaryKey '["id"]
295−-- , "fk_user_id" ::: 'ForeignKey '["user_id"] "users" '["id"]
296−-- ] :=>
297−-- '[ "id" ::: 'Def :=> 'NotNull 'PGint4
298−-- , "user_id" ::: 'NoDef :=> 'NotNull 'PGint4
299−-- , "email" ::: 'NoDef :=> 'Null 'PGtext
300−-- ]
301−-- ]
302−-- :}
303−type TablesType = [(Symbol,TableType)]
304−-- | A monokinded empty `TablesType`.
305−type family NilTables :: TablesType where NilTables = '[]
306−
307-- | `RelationType` is a row of `NullityType`
274-- | `RelationType` is a row of `NullityType`
308--
275--
309-- >>> :{
276-- >>> :{
@@ -337,18 +304,6 @@ type family RelationToColumns (relation :: RelationType) :: ColumnsType where
337type family TableToColumns (table :: TableType) :: ColumnsType where
304type family TableToColumns (table :: TableType) :: ColumnsType where
338 TableToColumns (constraints :=> columns) = columns
305 TableToColumns (constraints :=> columns) = columns
339
306
340−-- | `TablesToRelations` removes both table and column constraints.
341−type family TablesToRelations (tables :: TablesType) :: RelationsType where
342− TablesToRelations '[] = '[]
343− TablesToRelations (alias ::: constraint :=> columns ': tables) =
344− alias ::: ColumnsToRelation columns ': TablesToRelations tables
345−
346−-- | `RelationsToTables` adds both trivial table and column constraints.
347−type family RelationsToTables (tables :: RelationsType) :: TablesType where
348− RelationsToTables '[] = '[]
349− RelationsToTables (alias ::: columns ': relations) =
350− alias ::: '[] :=> RelationToColumns columns ': RelationsToTables relations
351−
352-- | `Grouping` is an auxiliary namespace, created by
307-- | `Grouping` is an auxiliary namespace, created by
353-- @GROUP BY@ clauses (`Squeal.PostgreSQL.Query.group`), and used
308-- @GROUP BY@ clauses (`Squeal.PostgreSQL.Query.group`), and used
354-- for typesafe aggregation
309-- for typesafe aggregation
@@ -619,6 +574,20 @@ type family SameLabels
619 ('Type.ADT _module _datatype constructors) labels
574 ('Type.ADT _module _datatype constructors) labels
620 = SOP.AllZip SameLabel constructors labels
575 = SOP.AllZip SameLabel constructors labels
621
576
577+class MapMaybes xs where
578+ type family Maybes (xs :: [Type]) = (mxs :: [Type]) | mxs -> xs
579+ maybes :: SOP.NP Maybe xs -> SOP.NP SOP.I (Maybes xs)
580+instance MapMaybes '[] where
581+ type Maybes '[] = '[]
582+ maybes SOP.Nil = SOP.Nil
583+instance MapMaybes xs => MapMaybes (x ': xs) where
584+ type Maybes (x ': xs) = Maybe x ': Maybes xs
585+ maybes (x SOP.:* xs) = SOP.I x SOP.:* maybes xs
586+
587+type family Nulls tys where
588+ Nulls '[] = '[]
589+ Nulls (field ::: ty ': tys) = field ::: 'Null ty ': Nulls tys
590+
622-- | Check if a `TableConstraint` involves a column
591-- | Check if a `TableConstraint` involves a column
623type family ConstraintInvolves column constraint where
592type family ConstraintInvolves column constraint where
624 ConstraintInvolves column ('Check columns) = column `Elem` columns
593 ConstraintInvolves column ('Check columns) = column `Elem` columns
squeal-postgresql/src/Squeal/PostgreSQL/Transaction.hs+1−8
@@ -9,16 +9,9 @@ Squeal transaction control language.
9-}
9-}
10
10
11{-# LANGUAGE
11{-# LANGUAGE
12− DataKinds
13− , EmptyCase
14− , FlexibleContexts
12+ FlexibleContexts
15− , FlexibleInstances
16 , LambdaCase
13 , LambdaCase
17 , OverloadedStrings
14 , OverloadedStrings
18− , MultiParamTypeClasses
19− , ScopedTypeVariables
20− , TypeFamilies
21− , TypeInType
22#-}
15#-}
23
16
24module Squeal.PostgreSQL.Transaction
17module Squeal.PostgreSQL.Transaction