git.iko.soy/squeal
on dev help sign in
remove unneeded constraints
commit41b35146d92cc2635936e6efd20884468568a6ec authorEitan Chatav <eitan.chatav@gmail.com> dateSat 9 Dec 2017, 20:24 (9 years ago) parent17aa55a
8 files changed+386−378
compare with dev
unifiedsplit
squeal-postgresql/exe/Example.hs+11−13 squeal-postgresql/src/Squeal/PostgreSQL/Binary.hs+8−8 squeal-postgresql/src/Squeal/PostgreSQL/Definition.hs+17−15 squeal-postgresql/src/Squeal/PostgreSQL/Expression.hs+177−197 squeal-postgresql/src/Squeal/PostgreSQL/Manipulation.hs+107−91 squeal-postgresql/src/Squeal/PostgreSQL/PQ.hs+1−1 squeal-postgresql/src/Squeal/PostgreSQL/Query.hs+12−12 squeal-postgresql/src/Squeal/PostgreSQL/Schema.hs+53−41
squeal-postgresql/exe/Example.hs+11−13
@@ -52,24 +52,22 @@ setup =
5252teardown :: Definition Schema '[]
5353teardown = dropTable #emails >>> dropTable #users
5454
55−insertUser :: Manipulation Schema
56− '[ '[] :=> 'NotNull 'PGtext]
57− '[ "fromOnly" ::: ('[] :=> 'NotNull 'PGint4) ]
58−insertUser = insertInto #users
59− ( Values (def `As` #id :* param @1 `As` #name :* Nil) [] )
55+insertUser :: Manipulation Schema '[ 'NotNull 'PGtext]
56+ '[ "fromOnly" ::: 'NotNull 'PGint4 ]
57+insertUser = insertRows #users
58+ (Def `As` #id :* Set (param @1) `As` #name :* Nil) []
6059 OnConflictDoNothing (Returning (#id `As` #fromOnly :* Nil))
6160
62−insertEmail :: Manipulation Schema
63− '[ '[] :=> 'NotNull 'PGint4, '[] :=> 'Null 'PGtext] '[]
64−insertEmail = insertInto #emails ( Values
65− ( def `As` #id :*
66− param @1 `As` #user_id :*
67− param @2 `As` #email :* Nil) [] )
61+insertEmail :: Manipulation Schema '[ 'NotNull 'PGint4, 'Null 'PGtext] '[]
62+insertEmail = insertRows #emails
63+ ( Def `As` #id :*
64+ Set (param @1) `As` #user_id :*
65+ Set (param @2) `As` #email :* Nil ) []
6866 OnConflictDoNothing (Returning Nil)
6967
7068getUsers :: Query Schema '[]
71− '[ "userName" ::: ('[] :=> 'NotNull 'PGtext)
72− , "userEmail" ::: ('[] :=> 'Null 'PGtext) ]
69+ '[ "userName" ::: 'NotNull 'PGtext
70+ , "userEmail" ::: 'Null 'PGtext ]
7371getUsers = select
7472 (#u ! #name `As` #userName :* #e ! #email `As` #userEmail :* Nil)
7573 ( from (Table (#users `As` #u)
squeal-postgresql/src/Squeal/PostgreSQL/Binary.hs+8−8
@@ -117,7 +117,7 @@ instance ToParam Value 'PGjsonb where toParam = K . Encoding.jsonb_ast
117117-- | A `ToColumnParam` constraint lifts the `ToParam` encoding
118118-- of a `Type` to a `ColumnType`, encoding `Maybe`s to `Null`s. You should
119119-- not define instances of `ToColumnParam`, just use the provided instances.
120−class ToColumnParam (x :: Type) (ty :: ColumnType) where
120+class ToColumnParam (x :: Type) (ty :: NullityType) where
121121 -- | >>> toColumnParam @Int16 @'( '[], ('NotNull 'PGint2)) 0
122122 -- K (Just "\NUL\NUL")
123123 --
@@ -127,16 +127,16 @@ class ToColumnParam (x :: Type) (ty :: ColumnType) where
127127 -- >>> toColumnParam @(Maybe Int16) @'( '[], ('Null 'PGint2)) Nothing
128128 -- K Nothing
129129 toColumnParam :: x -> K (Maybe Strict.ByteString) ty
130−instance ToParam x pg => ToColumnParam x (optionality ('NotNull pg)) where
130+instance ToParam x pg => ToColumnParam x ('NotNull pg) where
131131 toColumnParam = K . Just . Encoding.encodingBytes . unK . toParam @x @pg
132−instance ToParam x pg => ToColumnParam (Maybe x) (optionality ('Null pg)) where
132+instance ToParam x pg => ToColumnParam (Maybe x) ('Null pg) where
133133 toColumnParam = K . fmap (Encoding.encodingBytes . unK . toParam @x @pg)
134134
135135-- | A `ToParams` constraint generically sequences the encodings of `Type`s
136136-- of the fields of a tuple or record to a row of `ColumnType`s. You should
137137-- not define instances of `ToParams`. Instead define `Generic` instances
138138-- which in turn provide `ToParams` instances.
139−class SListI tys => ToParams (x :: Type) (tys :: [ColumnType]) where
139+class SListI tys => ToParams (x :: Type) (tys :: [NullityType]) where
140140 -- | >>> type PGparams = '[ 'Required ('NotNull 'PGbool), 'Required ('Null 'PGint2)]
141141 -- >>> toParams @(Bool, Maybe Int16) @PGparams (False, Just 0)
142142 -- K (Just "\NUL") :* (K (Just "\NUL\NUL") :* Nil)
@@ -192,7 +192,7 @@ instance FromValue 'PGjsonb Value where fromValue _ = Decoding.jsonb_ast
192192-- to a decoding of a @(Symbol, ColumnType)@ to a `Type`,
193193-- decoding `Null`s to `Maybe`s. You should not define instances for
194194-- `FromColumnValue`, just use the provided instances.
195−class FromColumnValue (colty :: (Symbol,ColumnType)) (y :: Type) where
195+class FromColumnValue (colty :: (Symbol,NullityType)) (y :: Type) where
196196 -- | >>> :set -XTypeOperators -XOverloadedStrings
197197 -- >>> newtype Id = Id { getId :: Int16 } deriving Show
198198 -- >>> instance FromValue 'PGint2 Id where fromValue = fmap Id . fromValue
@@ -203,7 +203,7 @@ class FromColumnValue (colty :: (Symbol,ColumnType)) (y :: Type) where
203203 -- Just (Id {getId = 1})
204204 fromColumnValue :: K (Maybe Strict.ByteString) colty -> y
205205instance FromValue pg y
206− => FromColumnValue (column ::: '( '[], ('NotNull pg))) y where
206+ => FromColumnValue (column ::: ('NotNull pg)) y where
207207 fromColumnValue = \case
208208 K Nothing -> error "fromColumnValue: saw NULL when expecting NOT NULL"
209209 K (Just bytes) ->
@@ -214,7 +214,7 @@ instance FromValue pg y
214214 in
215215 either err id errOrValue
216216instance FromValue pg y
217− => FromColumnValue (column ::: '( '[], ('Null pg))) (Maybe y) where
217+ => FromColumnValue (column ::: ('Null pg)) (Maybe y) where
218218 fromColumnValue (K nullOrBytes)
219219 = either err id
220220 . Decoding.valueParser (fromValue @pg @y Proxy)
@@ -227,7 +227,7 @@ instance FromValue pg y
227227-- the same field names. You should not define instances of `FromRow`.
228228-- Instead define `Generic` and `HasDatatypeInfo` instances which in turn
229229-- provide `FromRow` instances.
230−class SListI results => FromRow (results :: ColumnsType) y where
230+class SListI results => FromRow (results :: RelationType) y where
231231 -- | >>> :set -XOverloadedStrings
232232 -- >>> import Data.Text
233233 -- >>> newtype Id = Id { getId :: Int16 } deriving Show
squeal-postgresql/src/Squeal/PostgreSQL/Definition.hs+17−15
@@ -32,8 +32,8 @@ module Squeal.PostgreSQL.Definition
3232 , createTable
3333 , TableConstraintExpression (..)
3434 , check
35− , unique
36− , primaryKey
35+ , uniques
36+ , primaryKeys
3737 , foreignKey
3838 , OnDeleteClause (OnDeleteNoAction, OnDeleteRestrict, OnDeleteCascade)
3939 , renderOnDeleteClause
@@ -107,13 +107,15 @@ CREATE statements
107107-- "CREATE TABLE tab (a int, b real);"
108108createTable
109109 :: ( KnownSymbol tab
110+ , columns ~ (col ': cols)
110111 , SOP.SListI columns
111112 , SOP.SListI constraints
112− , table ~ (constraints :=> (column ': columns)))
113+ , table ~ (constraints :=> columns))
113114 => Alias tab -- ^ the name of the table to add
114− -> NP (Aliased TypeExpression) (column ': columns)
115+ -> NP (Aliased TypeExpression) columns
115116 -- ^ the names and datatype of each column
116− -> NP (TableConstraintExpression schema (column ': columns)) constraints
117+ -> NP (TableConstraintExpression schema (UnconstrainColumns columns))
118+ constraints
117119 -- ^ constraints that must hold for the table
118120 -> Definition schema (Create tab table schema)
119121createTable table columns constraints = UnsafeDefinition $
@@ -141,7 +143,7 @@ createTable table columns constraints = UnsafeDefinition $
141143-- even if the value came from the default value definition.
142144newtype TableConstraintExpression
143145 (schema :: SchemaType)
144− (columns :: ColumnsType)
146+ (columns :: RelationType)
145147 (tableConstraint :: TableConstraint)
146148 = UnsafeTableConstraintExpression
147149 { renderTableConstraintExpression :: ByteString }
@@ -177,12 +179,12 @@ check condition = UnsafeTableConstraintExpression $
177179-- [ unique (Column #a :* Column #b :* Nil) ]
178180-- :}
179181-- "CREATE TABLE tab (a int, b int, UNIQUE (a, b));"
180−unique
182+uniques
181183 :: SOP.SListI subcolumns
182184 => NP (Column columns) subcolumns
183185 -- ^ unique column or group of columns
184186 -> TableConstraintExpression schema columns ( 'Uniques (Aliases subcolumns))
185−unique columns = UnsafeTableConstraintExpression $
187+uniques columns = UnsafeTableConstraintExpression $
186188 "UNIQUE" <+> parenthesized (renderCommaSeparated renderColumn columns)
187189
188190-- | A `primaryKey` constraint indicates that a column, or group of columns,
@@ -197,12 +199,12 @@ unique columns = UnsafeTableConstraintExpression $
197199-- [ primaryKey (Column #id :* Nil) ]
198200-- :}
199201-- "CREATE TABLE tab (id serial, name text NOT NULL, PRIMARY KEY (id));"
200−primaryKey
201− :: (SOP.SListI subcolumns, NotAllNull subcolumns)
202+primaryKeys
203+ :: (SOP.SListI subcolumns, AllNotNull subcolumns)
202204 => NP (Column columns) subcolumns
203205 -- ^ identifying column or group of columns
204206 -> TableConstraintExpression schema columns ('Uniques (Aliases subcolumns))
205−primaryKey columns = UnsafeTableConstraintExpression $
207+primaryKeys columns = UnsafeTableConstraintExpression $
206208 "PRIMARY KEY" <+> parenthesized (renderCommaSeparated renderColumn columns)
207209
208210-- | A `foreignKey` specifies that the values in a column
@@ -239,7 +241,7 @@ primaryKey columns = UnsafeTableConstraintExpression $
239241-- :}
240242-- "CREATE TABLE users (id serial, username text NOT NULL, PRIMARY KEY (id)); CREATE TABLE emails (id serial, userid integer NOT NULL, email text NOT NULL, PRIMARY KEY (id), FOREIGN KEY (userid) REFERENCES users (id) ON DELETE CASCADE ON UPDATE RESTRICT);"
241243foreignKey
242− :: ( SchemaHasTable tab schema refcolumns
244+ :: ( HasTable tab (UnconstrainSchema schema) refcolumns
243245 , SameTypes subcolumns refsubcolumns
244246 , AllNotNull subcolumns
245247 , SOP.SListI subcolumns
@@ -493,7 +495,7 @@ renameColumn column0 column1 = UnsafeAlterTable $
493495
494496-- | An `alterColumn` alters a single column.
495497alterColumn
496− :: (KnownSymbol column, HasColumn column columns ty0)
498+ :: (KnownSymbol column, Has column columns ty0)
497499 => Alias column -- ^ column to alter
498500 -> AlterColumn ty0 ty1 -- ^ alteration to perform
499501 -> AlterTable schema ('[] :=> columns) ('[] :=> Alter column columns ty1)
@@ -519,8 +521,8 @@ newtype AlterColumn (ty0 :: ColumnType) (ty1 :: ColumnType) =
519521-- :}
520522-- "ALTER TABLE tab ALTER COLUMN col SET DEFAULT 5;"
521523setDefault
522− :: Expression '[] 'Ungrouped '[] '( constraints, ty) -- ^ default value to set
523− -> AlterColumn (optionality ty) '( '[ 'Default] `Union` constraints, ty)
524+ :: Expression '[] 'Ungrouped '[] ty -- ^ default value to set
525+ -> AlterColumn (constraints :=> ty) (AsSet ('Default ': constraints) :=> ty)
524526setDefault expression = UnsafeAlterColumn $
525527 "SET DEFAULT" <+> renderExpression expression
526528
squeal-postgresql/src/Squeal/PostgreSQL/Expression.hs+177−197
@@ -41,9 +41,6 @@ module Squeal.PostgreSQL.Expression
4141 , Column (Column)
4242 , renderColumn
4343 , GroupedBy (getGroup1, getGroup2)
44− -- ** Default
45− , def
46− , unDef
4744 -- ** Null
4845 , null_
4946 , unNull
@@ -105,8 +102,6 @@ module Squeal.PostgreSQL.Expression
105102 -- * Tables
106103 , Table (UnsafeTable, renderTable)
107104 , HasTable (getTable)
108− , SchemaHasTable
109− -- * TypeExpression
110105 , TypeExpression (UnsafeTypeExpression, renderTypeExpression)
111106 , PGTyped (pgtype)
112107 , bool
@@ -182,10 +177,10 @@ values from primitive expression using arithmetic, logical,
182177and other operations.
183178-}
184179newtype Expression
185− (tables :: RelationType)
180+ (relation :: RelationsType)
186181 (grouping :: Grouping)
187− (params :: [ColumnType])
188− (ty :: ColumnType)
182+ (params :: [NullityType])
183+ (ty :: NullityType)
189184 = UnsafeExpression { renderExpression :: ByteString }
190185 deriving (GHC.Generic,Show,Eq,Ord,NFData)
191186
@@ -197,8 +192,11 @@ supplied externally to a SQL statement.
197192separately from the SQL command string, in which case `param`s are used to
198193refer to the out-of-line data values.
199194-}
200−class (PGTyped (PGTypeOf ty), KnownNat n)
201− => HasParameter (n :: Nat) params ty | n params -> ty where
195+class (PGTyped (PGTypeOf ty), KnownNat n) => HasParameter
196+ (n :: Nat)
197+ (params :: [NullityType])
198+ (ty :: NullityType)
199+ | n params -> ty where
202200 param :: Expression tables grouping params ty
203201 param = UnsafeExpression $ parenthesized $
204202 "$" <> renderNat (Proxy @n) <+> "::"
@@ -214,7 +212,10 @@ references is unique, in which case the column may be referenced using
214212@-XOverloadedLabels@. Otherwise, combined with a `HasTable` constraint, the
215213qualified column reference operator `!` may be used.
216214-}
217−class KnownSymbol column => HasColumn column columns ty
215+class KnownSymbol column => HasColumn
216+ (column :: Symbol)
217+ (columns :: RelationType)
218+ (ty :: NullityType)
218219 | column columns -> ty where
219220 getColumn
220221 :: HasUnique table tables columns
@@ -222,7 +223,7 @@ class KnownSymbol column => HasColumn column columns ty
222223 -> Expression tables 'Ungrouped params ty
223224 getColumn column = UnsafeExpression $ renderAlias column
224225instance {-# OVERLAPPING #-} KnownSymbol column
225− => HasColumn column ((column ::: optionality ty) ': tys) ( '[] :=> ty)
226+ => HasColumn column (column ::: ty ': tys) ty
226227instance {-# OVERLAPPABLE #-} (KnownSymbol column, HasColumn column table ty)
227228 => HasColumn column (ty' ': table) ty
228229
@@ -240,8 +241,8 @@ instance (HasTable table tables columns, HasColumn column columns ty)
240241-- `Squeel.PostgreSQL.Definition.TableConstraint`s to witness a
241242-- subcolumns relationship.
242243data Column
243− (columns :: ColumnsType)
244− (columnty :: (Symbol,ColumnType))
244+ (columns :: RelationType)
245+ (columnty :: (Symbol,NullityType))
245246 where
246247 Column
247248 :: HasColumn column columns ty
@@ -296,27 +297,11 @@ instance
296297 ) => IsTableColumn table column
297298 (Expression tables ('Grouped bys) params ty) where (!) = getGroup2
298299
299−-- | >>> renderExpression def
300−-- "DEFAULT"
301−def
302− :: 'Default `In` constraints
303− => Expression '[] 'Ungrouped params (constraints :=> nullity ty)
304−def = UnsafeExpression "DEFAULT"
305−
306−-- | >>> renderExpression $ unDef false
307−-- "FALSE"
308−unDef
309− :: 'Default `In` constraints
310− => Expression '[] 'Ungrouped params ( '[] :=> nullity ty)
311− -- ^ not @DEFAULT@
312− -> Expression '[] 'Ungrouped params (constraints :=> nullity ty)
313−unDef = UnsafeExpression . renderExpression
314−
315300-- | analagous to `Nothing`
316301--
317302-- >>> renderExpression $ null_
318303-- "NULL"
319−null_ :: Expression tables grouping params (constraints :=> 'Null ty)
304+null_ :: Expression tables grouping params ('Null ty)
320305null_ = UnsafeExpression "NULL"
321306
322307-- | analagous to `Just`
@@ -324,9 +309,9 @@ null_ = UnsafeExpression "NULL"
324309-- >>> renderExpression $ unNull true
325310-- "TRUE"
326311unNull
327− :: Expression tables grouping params (constraints :=> 'NotNull ty)
312+ :: Expression tables grouping params ('NotNull ty)
328313 -- ^ not @NULL@
329− -> Expression tables grouping params (constraints :=> 'Null ty)
314+ -> Expression tables grouping params ('Null ty)
330315unNull = UnsafeExpression . renderExpression
331316
332317-- | return the leftmost value which is not NULL
@@ -334,11 +319,11 @@ unNull = UnsafeExpression . renderExpression
334319-- >>> renderExpression $ coalesce [null_, unNull true] false
335320-- "COALESCE(NULL, TRUE, FALSE)"
336321coalesce
337− :: [Expression tables grouping params ( '[] :=> 'Null ty)]
322+ :: [Expression tables grouping params ('Null ty)]
338323 -- ^ @NULL@s may be present
339− -> Expression tables grouping params ( '[] :=> 'NotNull ty)
324+ -> Expression tables grouping params ('NotNull ty)
340325 -- ^ @NULL@ is absent
341− -> Expression tables grouping params ( '[] :=> 'NotNull ty)
326+ -> Expression tables grouping params ('NotNull ty)
342327coalesce nullxs notNullx = UnsafeExpression $
343328 "COALESCE" <> parenthesized (commaSeparated
344329 ((renderExpression <$> nullxs) <> [renderExpression notNullx]))
@@ -348,16 +333,16 @@ coalesce nullxs notNullx = UnsafeExpression $
348333-- >>> renderExpression $ fromNull true null_
349334-- "COALESCE(NULL, TRUE)"
350335fromNull
351− :: Expression tables grouping params ( '[] :=> 'NotNull ty)
336+ :: Expression tables grouping params ('NotNull ty)
352337 -- ^ what to convert @NULL@ to
353− -> Expression tables grouping params ( '[] :=> 'Null ty)
354− -> Expression tables grouping params ( '[] :=> 'NotNull ty)
338+ -> Expression tables grouping params ('Null ty)
339+ -> Expression tables grouping params ('NotNull ty)
355340fromNull notNullx nullx = coalesce [nullx] notNullx
356341
357342-- | >>> renderExpression $ null_ & isNull
358343-- "NULL IS NULL"
359344isNull
360− :: Expression tables grouping params ( '[] :=> 'Null ty)
345+ :: Expression tables grouping params ('Null ty)
361346 -- ^ possibly @NULL@
362347 -> Condition tables grouping params
363348isNull x = UnsafeExpression $ renderExpression x <+> "IS NULL"
@@ -365,7 +350,7 @@ isNull x = UnsafeExpression $ renderExpression x <+> "IS NULL"
365350-- | >>> renderExpression $ null_ & isn'tNull
366351-- "NULL IS NOT NULL"
367352isn'tNull
368− :: Expression tables grouping params ( '[] :=> 'Null ty)
353+ :: Expression tables grouping params ('Null ty)
369354 -- ^ possibly @NULL@
370355 -> Condition tables grouping params
371356isn'tNull x = UnsafeExpression $ renderExpression x <+> "IS NOT NULL"
@@ -375,13 +360,13 @@ isn'tNull x = UnsafeExpression $ renderExpression x <+> "IS NOT NULL"
375360-- >>> renderExpression $ matchNull true not_ null_
376361-- "CASE WHEN NULL IS NULL THEN TRUE ELSE (NOT NULL) END"
377362matchNull
378− :: Expression tables grouping params ( '[] :=> nullty)
363+ :: Expression tables grouping params (nullty)
379364 -- ^ what to convert @NULL@ to
380− -> ( Expression tables grouping params ( '[] :=> 'NotNull ty)
381− -> Expression tables grouping params ( '[] :=> nullty) )
365+ -> ( Expression tables grouping params ('NotNull ty)
366+ -> Expression tables grouping params (nullty) )
382367 -- ^ function to perform when @NULL@ is absent
383− -> Expression tables grouping params ( '[] :=> 'Null ty)
384− -> Expression tables grouping params ( '[] :=> nullty)
368+ -> Expression tables grouping params ('Null ty)
369+ -> Expression tables grouping params (nullty)
385370matchNull y f x = ifThenElse (isNull x) y
386371 (f (UnsafeExpression (renderExpression x)))
387372
@@ -392,33 +377,33 @@ matchNull y f x = ifThenElse (isNull x) y
392377-- >>> renderExpression @_ @_ @'[_] $ fromNull false (nullIf false (param @1))
393378-- "COALESCE(NULL IF (FALSE, ($1 :: bool)), FALSE)"
394379nullIf
395− :: Expression tables grouping params ( '[] :=> 'NotNull ty)
380+ :: Expression tables grouping params ('NotNull ty)
396381 -- ^ @NULL@ is absent
397− -> Expression tables grouping params ( '[] :=> 'NotNull ty)
382+ -> Expression tables grouping params ('NotNull ty)
398383 -- ^ @NULL@ is absent
399− -> Expression tables grouping params ( '[] :=> 'Null ty)
384+ -> Expression tables grouping params ('Null ty)
400385nullIf x y = UnsafeExpression $ "NULL IF" <+> parenthesized
401386 (renderExpression x <> ", " <> renderExpression y)
402387
403388-- | >>> renderExpression @_ @_ @'[_] $ greatest currentTimestamp [param @1]
404389-- "GREATEST(CURRENT_TIMESTAMP, ($1 :: timestamp with time zone))"
405390greatest
406− :: Expression tables grouping params ( '[] :=> nullty)
391+ :: Expression tables grouping params (nullty)
407392 -- ^ needs at least 1 argument
408− -> [Expression tables grouping params ( '[] :=> nullty)]
393+ -> [Expression tables grouping params (nullty)]
409394 -- ^ or more
410− -> Expression tables grouping params ( '[] :=> nullty)
395+ -> Expression tables grouping params (nullty)
411396greatest x xs = UnsafeExpression $ "GREATEST("
412397 <> commaSeparated (renderExpression <$> (x:xs)) <> ")"
413398
414399-- | >>> renderExpression $ least currentTimestamp [null_]
415400-- "LEAST(CURRENT_TIMESTAMP, NULL)"
416401least
417− :: Expression tables grouping params ( '[] :=> nullty)
402+ :: Expression tables grouping params (nullty)
418403 -- ^ needs at least 1 argument
419− -> [Expression tables grouping params ( '[] :=> nullty)]
404+ -> [Expression tables grouping params (nullty)]
420405 -- ^ or more
421− -> Expression tables grouping params ( '[] :=> nullty)
406+ -> Expression tables grouping params (nullty)
422407least x xs = UnsafeExpression $ "LEAST("
423408 <> commaSeparated (renderExpression <$> (x:xs)) <> ")"
424409
@@ -427,9 +412,9 @@ least x xs = UnsafeExpression $ "LEAST("
427412unsafeBinaryOp
428413 :: ByteString
429414 -- ^ operator
430− -> Expression tables grouping params ( '[] :=> ty0)
431− -> Expression tables grouping params ( '[] :=> ty1)
432− -> Expression tables grouping params ( '[] :=> ty2)
415+ -> Expression tables grouping params (ty0)
416+ -> Expression tables grouping params (ty1)
417+ -> Expression tables grouping params (ty2)
433418unsafeBinaryOp op x y = UnsafeExpression $ parenthesized $
434419 renderExpression x <+> op <+> renderExpression y
435420
@@ -438,8 +423,8 @@ unsafeBinaryOp op x y = UnsafeExpression $ parenthesized $
438423unsafeUnaryOp
439424 :: ByteString
440425 -- ^ operator
441− -> Expression tables grouping params ( '[] :=> ty0)
442− -> Expression tables grouping params ( '[] :=> ty1)
426+ -> Expression tables grouping params (ty0)
427+ -> Expression tables grouping params (ty1)
443428unsafeUnaryOp op x = UnsafeExpression $ parenthesized $
444429 op <+> renderExpression x
445430
@@ -448,13 +433,13 @@ unsafeUnaryOp op x = UnsafeExpression $ parenthesized $
448433unsafeFunction
449434 :: ByteString
450435 -- ^ function
451− -> Expression tables grouping params ( '[] :=> xty)
452− -> Expression tables grouping params ( '[] :=> yty)
436+ -> Expression tables grouping params (xty)
437+ -> Expression tables grouping params (yty)
453438unsafeFunction fun x = UnsafeExpression $
454439 fun <> parenthesized (renderExpression x)
455440
456441instance PGNum ty
457− => Num (Expression tables grouping params ( '[] :=> nullity ty)) where
442+ => Num (Expression tables grouping params (nullity ty)) where
458443 (+) = unsafeBinaryOp "+"
459444 (-) = unsafeBinaryOp "-"
460445 (*) = unsafeBinaryOp "*"
@@ -466,12 +451,12 @@ instance PGNum ty
466451 . show
467452
468453instance (PGNum ty, PGFloating ty) => Fractional
469− (Expression tables grouping params ( '[] :=> nullity ty)) where
454+ (Expression tables grouping params (nullity ty)) where
470455 (/) = unsafeBinaryOp "/"
471456 fromRational x = fromInteger (numerator x) / fromInteger (denominator x)
472457
473458instance (PGNum ty, PGFloating ty) => Floating
474− (Expression tables grouping params ( '[] :=> nullity ty)) where
459+ (Expression tables grouping params (nullity ty)) where
475460 pi = UnsafeExpression "pi()"
476461 exp = unsafeFunction "exp"
477462 log = unsafeFunction "ln"
@@ -496,11 +481,11 @@ instance (PGNum ty, PGFloating ty) => Floating
496481-- "atan2(pi(), 2)"
497482atan2_
498483 :: PGFloating float
499− => Expression tables grouping params ( '[] :=> nullity float)
484+ => Expression tables grouping params (nullity float)
500485 -- ^ numerator
501− -> Expression tables grouping params ( '[] :=> nullity float)
486+ -> Expression tables grouping params (nullity float)
502487 -- ^ denominator
503− -> Expression tables grouping params ( '[] :=> nullity float)
488+ -> Expression tables grouping params (nullity float)
504489atan2_ y x = UnsafeExpression $
505490 "atan2(" <> renderExpression y <> ", " <> renderExpression x <> ")"
506491
@@ -511,11 +496,11 @@ atan2_ y x = UnsafeExpression $
511496-- | >>> renderExpression $ true & cast int4
512497-- "(TRUE :: int4)"
513498cast
514− :: TypeExpression ( '[] :=> 'Null ty1)
499+ :: TypeExpression ('[] :=> 'Null ty1)
515500 -- ^ type to cast as
516− -> Expression tables grouping params ( '[] :=> nullity ty0)
501+ -> Expression tables grouping params (nullity ty0)
517502 -- ^ value to convert
518− -> Expression tables grouping params ( '[] :=> nullity ty1)
503+ -> Expression tables grouping params (nullity ty1)
519504cast ty x = UnsafeExpression $ parenthesized $
520505 renderExpression x <+> "::" <+> renderTypeExpression ty
521506
@@ -525,11 +510,11 @@ cast ty x = UnsafeExpression $ parenthesized $
525510-- "(5 / 2)"
526511quot_
527512 :: PGIntegral int
528− => Expression tables grouping params ( '[] :=> nullity int)
513+ => Expression tables grouping params (nullity int)
529514 -- ^ numerator
530− -> Expression tables grouping params ( '[] :=> nullity int)
515+ -> Expression tables grouping params (nullity int)
531516 -- ^ denominator
532− -> Expression tables grouping params ( '[] :=> nullity int)
517+ -> Expression tables grouping params (nullity int)
533518quot_ = unsafeBinaryOp "/"
534519
535520-- | remainder upon integer division
@@ -538,38 +523,38 @@ quot_ = unsafeBinaryOp "/"
538523-- "(5 % 2)"
539524rem_
540525 :: PGIntegral int
541− => Expression tables grouping params ( '[] :=> nullity int)
526+ => Expression tables grouping params (nullity int)
542527 -- ^ numerator
543− -> Expression tables grouping params ( '[] :=> nullity int)
528+ -> Expression tables grouping params (nullity int)
544529 -- ^ denominator
545− -> Expression tables grouping params ( '[] :=> nullity int)
530+ -> Expression tables grouping params (nullity int)
546531rem_ = unsafeBinaryOp "%"
547532
548533-- | >>> renderExpression @_ @_ @_ @(_ (_ 'PGfloat4)) $ trunc pi
549534-- "trunc(pi())"
550535trunc
551536 :: PGFloating frac
552− => Expression tables grouping params ( '[] :=> nullity frac)
537+ => Expression tables grouping params (nullity frac)
553538 -- ^ fractional number
554− -> Expression tables grouping params ( '[] :=> nullity frac)
539+ -> Expression tables grouping params (nullity frac)
555540trunc = unsafeFunction "trunc"
556541
557542-- | >>> renderExpression @_ @_ @_ @(_ (_ 'PGfloat4)) $ round_ pi
558543-- "round(pi())"
559544round_
560545 :: PGFloating frac
561− => Expression tables grouping params ( '[] :=> nullity frac)
546+ => Expression tables grouping params (nullity frac)
562547 -- ^ fractional number
563− -> Expression tables grouping params ( '[] :=> nullity frac)
548+ -> Expression tables grouping params (nullity frac)
564549round_ = unsafeFunction "round"
565550
566551-- | >>> renderExpression @_ @_ @_ @(_ (_ 'PGfloat4)) $ ceiling_ pi
567552-- "ceiling(pi())"
568553ceiling_
569554 :: PGFloating frac
570− => Expression tables grouping params ( '[] :=> nullity frac)
555+ => Expression tables grouping params (nullity frac)
571556 -- ^ fractional number
572− -> Expression tables grouping params ( '[] :=> nullity frac)
557+ -> Expression tables grouping params (nullity frac)
573558ceiling_ = unsafeFunction "ceiling"
574559
575560-- | A `Condition` is a boolean valued `Expression`. While SQL allows
@@ -577,7 +562,7 @@ ceiling_ = unsafeFunction "ceiling"
577562-- forcing one to handle the case of @NULL@ explicitly to produce
578563-- a `Condition`.
579564type Condition tables grouping params =
580− Expression tables grouping params ( '[] :=> 'NotNull 'PGbool)
565+ Expression tables grouping params ('NotNull 'PGbool)
581566
582567-- | >>> renderExpression true
583568-- "TRUE"
@@ -616,10 +601,10 @@ not_ = unsafeUnaryOp "NOT"
616601-- "CASE WHEN TRUE THEN 1 WHEN FALSE THEN 2 ELSE 3 END"
617602caseWhenThenElse
618603 :: [ ( Condition tables grouping params
619− , Expression tables grouping params ( '[] :=> ty)
604+ , Expression tables grouping params (ty)
620605 ) ]
621− -> Expression tables grouping params ( '[] :=> ty)
622− -> Expression tables grouping params ( '[] :=> ty)
606+ -> Expression tables grouping params (ty)
607+ -> Expression tables grouping params (ty)
623608caseWhenThenElse whenThens else_ = UnsafeExpression $ mconcat
624609 [ "CASE"
625610 , mconcat
@@ -637,9 +622,9 @@ caseWhenThenElse whenThens else_ = UnsafeExpression $ mconcat
637622-- "CASE WHEN TRUE THEN 1 ELSE 0 END"
638623ifThenElse
639624 :: Condition tables grouping params
640− -> Expression tables grouping params ( '[] :=> ty)
641− -> Expression tables grouping params ( '[] :=> ty)
642− -> Expression tables grouping params ( '[] :=> ty)
625+ -> Expression tables grouping params (ty)
626+ -> Expression tables grouping params (ty)
627+ -> Expression tables grouping params (ty)
643628ifThenElse if_ then_ else_ = caseWhenThenElse [(if_,then_)] else_
644629
645630-- | Comparison operations like `.==`, `./=`, `.>`, `.>=`, `.<` and `.<=`
@@ -648,85 +633,85 @@ ifThenElse if_ then_ else_ = caseWhenThenElse [(if_,then_)] else_
648633-- >>> renderExpression $ unNull true .== null_
649634-- "(TRUE = NULL)"
650635(.==)
651− :: Expression tables grouping params ( '[] :=> nullity ty) -- ^ lhs
652− -> Expression tables grouping params ( '[] :=> nullity ty) -- ^ rhs
653− -> Expression tables grouping params '( '[], (nullity 'PGbool))
636+ :: Expression tables grouping params (nullity ty) -- ^ lhs
637+ -> Expression tables grouping params (nullity ty) -- ^ rhs
638+ -> Expression tables grouping params (nullity 'PGbool)
654639(.==) = unsafeBinaryOp "="
655640infix 4 .==
656641
657642-- | >>> renderExpression $ unNull true ./= null_
658643-- "(TRUE <> NULL)"
659644(./=)
660− :: Expression tables grouping params ( '[] :=> nullity ty) -- ^ lhs
661− -> Expression tables grouping params ( '[] :=> nullity ty) -- ^ rhs
662− -> Expression tables grouping params '( '[], (nullity 'PGbool))
645+ :: Expression tables grouping params (nullity ty) -- ^ lhs
646+ -> Expression tables grouping params (nullity ty) -- ^ rhs
647+ -> Expression tables grouping params (nullity 'PGbool)
663648(./=) = unsafeBinaryOp "<>"
664649infix 4 ./=
665650
666651-- | >>> renderExpression $ unNull true .>= null_
667652-- "(TRUE >= NULL)"
668653(.>=)
669− :: Expression tables grouping params ( '[] :=> nullity ty) -- ^ lhs
670− -> Expression tables grouping params ( '[] :=> nullity ty) -- ^ rhs
671− -> Expression tables grouping params '( '[], (nullity 'PGbool))
654+ :: Expression tables grouping params (nullity ty) -- ^ lhs
655+ -> Expression tables grouping params (nullity ty) -- ^ rhs
656+ -> Expression tables grouping params (nullity 'PGbool)
672657(.>=) = unsafeBinaryOp ">="
673658infix 4 .>=
674659
675660-- | >>> renderExpression $ unNull true .< null_
676661-- "(TRUE < NULL)"
677662(.<)
678− :: Expression tables grouping params ( '[] :=> nullity ty) -- ^ lhs
679− -> Expression tables grouping params ( '[] :=> nullity ty) -- ^ rhs
680− -> Expression tables grouping params '( '[], (nullity 'PGbool))
663+ :: Expression tables grouping params (nullity ty) -- ^ lhs
664+ -> Expression tables grouping params (nullity ty) -- ^ rhs
665+ -> Expression tables grouping params (nullity 'PGbool)
681666(.<) = unsafeBinaryOp "<"
682667infix 4 .<
683668
684669-- | >>> renderExpression $ unNull true .<= null_
685670-- "(TRUE <= NULL)"
686671(.<=)
687− :: Expression tables grouping params ( '[] :=> nullity ty) -- ^ lhs
688− -> Expression tables grouping params ( '[] :=> nullity ty) -- ^ rhs
689− -> Expression tables grouping params '( '[], (nullity 'PGbool))
672+ :: Expression tables grouping params (nullity ty) -- ^ lhs
673+ -> Expression tables grouping params (nullity ty) -- ^ rhs
674+ -> Expression tables grouping params (nullity 'PGbool)
690675(.<=) = unsafeBinaryOp "<="
691676infix 4 .<=
692677
693678-- | >>> renderExpression $ unNull true .> null_
694679-- "(TRUE > NULL)"
695680(.>)
696− :: Expression tables grouping params ( '[] :=> nullity ty) -- ^ lhs
697− -> Expression tables grouping params ( '[] :=> nullity ty) -- ^ rhs
698− -> Expression tables grouping params '( '[], (nullity 'PGbool))
681+ :: Expression tables grouping params (nullity ty) -- ^ lhs
682+ -> Expression tables grouping params (nullity ty) -- ^ rhs
683+ -> Expression tables grouping params (nullity 'PGbool)
699684(.>) = unsafeBinaryOp ">"
700685infix 4 .>
701686
702687-- | >>> renderExpression $ currentDate
703688-- "CURRENT_DATE"
704689currentDate
705− :: Expression tables grouping params '( '[], (nullity 'PGdate))
690+ :: Expression tables grouping params (nullity 'PGdate)
706691currentDate = UnsafeExpression "CURRENT_DATE"
707692
708693-- | >>> renderExpression $ currentTime
709694-- "CURRENT_TIME"
710695currentTime
711− :: Expression tables grouping params '( '[], (nullity 'PGtimetz))
696+ :: Expression tables grouping params (nullity 'PGtimetz)
712697currentTime = UnsafeExpression "CURRENT_TIME"
713698
714699-- | >>> renderExpression $ currentTimestamp
715700-- "CURRENT_TIMESTAMP"
716701currentTimestamp
717− :: Expression tables grouping params '( '[], (nullity 'PGtimestamptz))
702+ :: Expression tables grouping params (nullity 'PGtimestamptz)
718703currentTimestamp = UnsafeExpression "CURRENT_TIMESTAMP"
719704
720705-- | >>> renderExpression $ localTime
721706-- "LOCALTIME"
722707localTime
723− :: Expression tables grouping params '( '[], (nullity 'PGtime))
708+ :: Expression tables grouping params (nullity 'PGtime)
724709localTime = UnsafeExpression "LOCALTIME"
725710
726711-- | >>> renderExpression $ localTimestamp
727712-- "LOCALTIMESTAMP"
728713localTimestamp
729− :: Expression tables grouping params '( '[], (nullity 'PGtimestamp))
714+ :: Expression tables grouping params (nullity 'PGtimestamp)
730715localTimestamp = UnsafeExpression "LOCALTIMESTAMP"
731716
732717{-----------------------------------------
@@ -734,7 +719,7 @@ text
734719-----------------------------------------}
735720
736721instance IsString
737− (Expression tables grouping params '( '[], (nullity 'PGtext))) where
722+ (Expression tables grouping params (nullity 'PGtext)) where
738723 fromString str = UnsafeExpression $
739724 "E\'" <> fromString (escape =<< str) <> "\'"
740725 where
@@ -750,32 +735,32 @@ instance IsString
750735 c -> [c]
751736
752737instance Monoid
753− (Expression tables grouping params '( '[], (nullity 'PGtext))) where
738+ (Expression tables grouping params (nullity 'PGtext)) where
754739 mempty = fromString ""
755740 mappend = unsafeBinaryOp "||"
756741
757742-- | >>> renderExpression $ lower "ARRRGGG"
758743-- "lower(E'ARRRGGG')"
759744lower
760− :: Expression tables grouping params '( '[], (nullity 'PGtext))
745+ :: Expression tables grouping params (nullity 'PGtext)
761746 -- ^ string to lower case
762− -> Expression tables grouping params '( '[], (nullity 'PGtext))
747+ -> Expression tables grouping params (nullity 'PGtext)
763748lower = unsafeFunction "lower"
764749
765750-- | >>> renderExpression $ upper "eeee"
766751-- "upper(E'eeee')"
767752upper
768− :: Expression tables grouping params '( '[], (nullity 'PGtext))
753+ :: Expression tables grouping params (nullity 'PGtext)
769754 -- ^ string to upper case
770− -> Expression tables grouping params '( '[], (nullity 'PGtext))
755+ -> Expression tables grouping params (nullity 'PGtext)
771756upper = unsafeFunction "upper"
772757
773758-- | >>> renderExpression $ charLength "four"
774759-- "char_length(E'four')"
775760charLength
776− :: Expression tables grouping params '( '[], (nullity 'PGtext))
761+ :: Expression tables grouping params (nullity 'PGtext)
777762 -- ^ string to measure
778− -> Expression tables grouping params '( '[], (nullity 'PGint4))
763+ -> Expression tables grouping params (nullity 'PGint4)
779764charLength = unsafeFunction "char_length"
780765
781766-- | The `like` expression returns true if the @string@ matches
@@ -788,11 +773,11 @@ charLength = unsafeFunction "char_length"
788773-- >>> renderExpression $ "abc" `like` "a%"
789774-- "(E'abc' LIKE E'a%')"
790775like
791− :: Expression tables grouping params '( '[], (nullity 'PGtext))
776+ :: Expression tables grouping params (nullity 'PGtext)
792777 -- ^ string
793− -> Expression tables grouping params '( '[], (nullity 'PGtext))
778+ -> Expression tables grouping params (nullity 'PGtext)
794779 -- ^ pattern
795− -> Expression tables grouping params '( '[], (nullity 'PGbool))
780+ -> Expression tables grouping params (nullity 'PGbool)
796781like = unsafeBinaryOp "LIKE"
797782
798783{-----------------------------------------
@@ -802,16 +787,16 @@ aggregation
802787-- | escape hatch to define aggregate functions
803788unsafeAggregate
804789 :: ByteString -- ^ aggregate function
805− -> Expression tables 'Ungrouped params ( '[] :=> xty)
806− -> Expression tables ('Grouped bys) params ( '[] :=> yty)
790+ -> Expression tables 'Ungrouped params (xty)
791+ -> Expression tables ('Grouped bys) params (yty)
807792unsafeAggregate fun x = UnsafeExpression $ mconcat
808793 [fun, "(", renderExpression x, ")"]
809794
810795-- | escape hatch to define aggregate functions over distinct values
811796unsafeAggregateDistinct
812797 :: ByteString -- ^ aggregate function
813− -> Expression tables 'Ungrouped params ( '[] :=> xty)
814− -> Expression tables ('Grouped bys) params ( '[] :=> yty)
798+ -> Expression tables 'Ungrouped params (xty)
799+ -> Expression tables ('Grouped bys) params (yty)
815800unsafeAggregateDistinct fun x = UnsafeExpression $ mconcat
816801 [fun, "(DISTINCT ", renderExpression x, ")"]
817802
@@ -819,27 +804,27 @@ unsafeAggregateDistinct fun x = UnsafeExpression $ mconcat
819804-- "sum(col)"
820805sum_
821806 :: PGNum ty
822− => Expression tables 'Ungrouped params ( '[] :=> nullity ty)
807+ => Expression tables 'Ungrouped params (nullity ty)
823808 -- ^ what to sum
824− -> Expression tables ('Grouped bys) params ( '[] :=> nullity ty)
809+ -> Expression tables ('Grouped bys) params (nullity ty)
825810sum_ = unsafeAggregate "sum"
826811
827812-- | >>> renderExpression @'[_ ::: '["col" ::: 'Required (_ 'PGnumeric)]] $ sumDistinct #col
828813-- "sum(DISTINCT col)"
829814sumDistinct
830815 :: PGNum ty
831− => Expression tables 'Ungrouped params ( '[] :=> nullity ty)
816+ => Expression tables 'Ungrouped params (nullity ty)
832817 -- ^ what to sum
833− -> Expression tables ('Grouped bys) params ( '[] :=> nullity ty)
818+ -> Expression tables ('Grouped bys) params (nullity ty)
834819sumDistinct = unsafeAggregateDistinct "sum"
835820
836821-- | A constraint for `PGType`s that you can take averages of and the resulting
837822-- `PGType`.
838823class PGAvg ty avg | ty -> avg where
839824 avg, avgDistinct
840− :: Expression tables 'Ungrouped params ( '[] :=> nullity ty)
825+ :: Expression tables 'Ungrouped params (nullity ty)
841826 -- ^ what to average
842− -> Expression tables ('Grouped bys) params '( '[], (nullity avg))
827+ -> Expression tables ('Grouped bys) params (nullity avg)
843828 avg = unsafeAggregate "avg"
844829 avgDistinct = unsafeAggregateDistinct "avg"
845830instance PGAvg 'PGint2 'PGnumeric
@@ -854,68 +839,68 @@ instance PGAvg 'PGinterval 'PGinterval
854839-- "bit_and(col)"
855840bitAnd
856841 :: PGIntegral int
857− => Expression tables 'Ungrouped params ( '[] :=> nullity int)
842+ => Expression tables 'Ungrouped params (nullity int)
858843 -- ^ what to aggregate
859− -> Expression tables ('Grouped bys) params ( '[] :=> nullity int)
844+ -> Expression tables ('Grouped bys) params (nullity int)
860845bitAnd = unsafeAggregate "bit_and"
861846
862847-- | >>> renderExpression @'[_ ::: '["col" ::: 'Required (_ 'PGint4)]] $ bitOr #col
863848-- "bit_or(col)"
864849bitOr
865850 :: PGIntegral int
866− => Expression tables 'Ungrouped params ( '[] :=> nullity int)
851+ => Expression tables 'Ungrouped params (nullity int)
867852 -- ^ what to aggregate
868− -> Expression tables ('Grouped bys) params ( '[] :=> nullity int)
853+ -> Expression tables ('Grouped bys) params (nullity int)
869854bitOr = unsafeAggregate "bit_or"
870855
871856-- | >>> renderExpression @'[_ ::: '["col" ::: 'Required (_ 'PGint4)]] $ bitAndDistinct #col
872857-- "bit_and(DISTINCT col)"
873858bitAndDistinct
874859 :: PGIntegral int
875− => Expression tables 'Ungrouped params ( '[] :=> nullity int)
860+ => Expression tables 'Ungrouped params (nullity int)
876861 -- ^ what to aggregate
877− -> Expression tables ('Grouped bys) params ( '[] :=> nullity int)
862+ -> Expression tables ('Grouped bys) params (nullity int)
878863bitAndDistinct = unsafeAggregateDistinct "bit_and"
879864
880865-- | >>> renderExpression @'[_ ::: '["col" ::: 'Required (_ 'PGint4)]] $ bitOrDistinct #col
881866-- "bit_or(DISTINCT col)"
882867bitOrDistinct
883868 :: PGIntegral int
884− => Expression tables 'Ungrouped params ( '[] :=> nullity int)
869+ => Expression tables 'Ungrouped params (nullity int)
885870 -- ^ what to aggregate
886− -> Expression tables ('Grouped bys) params ( '[] :=> nullity int)
871+ -> Expression tables ('Grouped bys) params (nullity int)
887872bitOrDistinct = unsafeAggregateDistinct "bit_or"
888873
889874-- | >>> renderExpression @'[_ ::: '["col" ::: 'Required (_ 'PGbool)]] $ boolAnd #col
890875-- "bool_and(col)"
891876boolAnd
892− :: Expression tables 'Ungrouped params '( '[], (nullity 'PGbool))
877+ :: Expression tables 'Ungrouped params (nullity 'PGbool)
893878 -- ^ what to aggregate
894− -> Expression tables ('Grouped bys) params '( '[], (nullity 'PGbool))
879+ -> Expression tables ('Grouped bys) params (nullity 'PGbool)
895880boolAnd = unsafeAggregate "bool_and"
896881
897882-- | >>> renderExpression @'[_ ::: '["col" ::: 'Required (_ 'PGbool)]] $ boolOr #col
898883-- "bool_or(col)"
899884boolOr
900− :: Expression tables 'Ungrouped params '( '[], (nullity 'PGbool))
885+ :: Expression tables 'Ungrouped params (nullity 'PGbool)
901886 -- ^ what to aggregate
902− -> Expression tables ('Grouped bys) params '( '[], (nullity 'PGbool))
887+ -> Expression tables ('Grouped bys) params (nullity 'PGbool)
903888boolOr = unsafeAggregate "bool_or"
904889
905890-- | >>> renderExpression @'[_ ::: '["col" ::: 'Required (_ 'PGbool)]] $ boolAndDistinct #col
906891-- "bool_and(DISTINCT col)"
907892boolAndDistinct
908− :: Expression tables 'Ungrouped params '( '[], (nullity 'PGbool))
893+ :: Expression tables 'Ungrouped params (nullity 'PGbool)
909894 -- ^ what to aggregate
910− -> Expression tables ('Grouped bys) params '( '[], (nullity 'PGbool))
895+ -> Expression tables ('Grouped bys) params (nullity 'PGbool)
911896boolAndDistinct = unsafeAggregateDistinct "bool_and"
912897
913898-- | >>> renderExpression @'[_ ::: '["col" ::: 'Required (_ 'PGbool)]] $ boolOrDistinct #col
914899-- "bool_or(DISTINCT col)"
915900boolOrDistinct
916− :: Expression tables 'Ungrouped params '( '[], (nullity 'PGbool))
901+ :: Expression tables 'Ungrouped params (nullity 'PGbool)
917902 -- ^ what to aggregate
918− -> Expression tables ('Grouped bys) params '( '[], (nullity 'PGbool))
903+ -> Expression tables ('Grouped bys) params (nullity 'PGbool)
919904boolOrDistinct = unsafeAggregateDistinct "bool_or"
920905
921906-- | A special aggregation that does not require an input
@@ -923,23 +908,23 @@ boolOrDistinct = unsafeAggregateDistinct "bool_or"
923908-- >>> renderExpression countStar
924909-- "count(*)"
925910countStar
926− :: Expression tables ('Grouped bys) params '( '[], ('NotNull 'PGint8))
911+ :: Expression tables ('Grouped bys) params ('NotNull 'PGint8)
927912countStar = UnsafeExpression $ "count(*)"
928913
929914-- | >>> renderExpression @'[_ ::: '["col" ::: 'Optional _]] $ count #col
930915-- "count(col)"
931916count
932− :: Expression tables 'Ungrouped params ( '[] :=> ty)
917+ :: Expression tables 'Ungrouped params (ty)
933918 -- ^ what to count
934− -> Expression tables ('Grouped bys) params '( '[], ('NotNull 'PGint8))
919+ -> Expression tables ('Grouped bys) params ('NotNull 'PGint8)
935920count = unsafeAggregate "count"
936921
937922-- | >>> renderExpression @'[_ ::: '["col" ::: 'Required _]] $ countDistinct #col
938923-- "count(DISTINCT col)"
939924countDistinct
940− :: Expression tables 'Ungrouped params ( '[] :=> ty)
925+ :: Expression tables 'Ungrouped params (ty)
941926 -- ^ what to count
942− -> Expression tables ('Grouped bys) params '( '[], ('NotNull 'PGint8))
927+ -> Expression tables ('Grouped bys) params ('NotNull 'PGint8)
943928countDistinct = unsafeAggregateDistinct "count"
944929
945930-- | synonym for `boolAnd`
@@ -947,9 +932,9 @@ countDistinct = unsafeAggregateDistinct "count"
947932-- >>> renderExpression @'[_ ::: '["col" ::: 'Required (_ 'PGbool)]] $ every #col
948933-- "every(col)"
949934every
950− :: Expression tables 'Ungrouped params '( '[], (nullity 'PGbool))
935+ :: Expression tables 'Ungrouped params (nullity 'PGbool)
951936 -- ^ what to aggregate
952− -> Expression tables ('Grouped bys) params '( '[], (nullity 'PGbool))
937+ -> Expression tables ('Grouped bys) params (nullity 'PGbool)
953938every = unsafeAggregate "every"
954939
955940-- | synonym for `boolAndDistinct`
@@ -957,16 +942,16 @@ every = unsafeAggregate "every"
957942-- >>> renderExpression @'[_ ::: '["col" ::: 'Required (_ 'PGbool)]] $ everyDistinct #col
958943-- "every(DISTINCT col)"
959944everyDistinct
960− :: Expression tables 'Ungrouped params '( '[], (nullity 'PGbool))
945+ :: Expression tables 'Ungrouped params (nullity 'PGbool)
961946 -- ^ what to aggregate
962− -> Expression tables ('Grouped bys) params '( '[], (nullity 'PGbool))
947+ -> Expression tables ('Grouped bys) params (nullity 'PGbool)
963948everyDistinct = unsafeAggregateDistinct "every"
964949
965950-- | minimum and maximum aggregation
966951max_, min_, maxDistinct, minDistinct
967− :: Expression tables 'Ungrouped params ( '[] :=> nullity ty)
952+ :: Expression tables 'Ungrouped params (nullity ty)
968953 -- ^ what to aggregate
969− -> Expression tables ('Grouped bys) params ( '[] :=> nullity ty)
954+ -> Expression tables ('Grouped bys) params (nullity ty)
970955max_ = unsafeAggregate "max"
971956min_ = unsafeAggregate "min"
972957maxDistinct = unsafeAggregateDistinct "max"
@@ -979,13 +964,16 @@ tables
979964-- | A `Table` from a schema without its alias with an `IsLabel` instance
980965-- to call a table reference by its alias.
981966newtype Table
982− (schema :: RelationType)
983− (columns :: ColumnsType)
967+ (schema :: RelationsType)
968+ (columns :: RelationType)
984969 = UnsafeTable { renderTable :: ByteString }
985970 deriving (GHC.Generic,Show,Eq,Ord,NFData)
986971
987972-- | A `HasTable` constraint indicates a table reference.
988−class KnownSymbol table => HasTable table tables columns
973+class KnownSymbol table => HasTable
974+ (table :: Symbol)
975+ (tables :: RelationsType)
976+ (columns :: RelationType)
989977 | table tables -> columns where
990978 getTable :: Alias table -> Table tables columns
991979 getTable table = UnsafeTable $ renderAlias table
@@ -999,14 +987,6 @@ instance HasTable table schema columns
999987 => IsLabel table (Table schema columns) where
1000988 fromLabel = getTable (Alias @table)
1001989
1002−type family SchemaHasTable
1003− (table :: Symbol)
1004− (schema :: SchemaType)
1005− (columns :: ColumnsType)
1006− where
1007− SchemaHasTable table schema columns =
1008− HasTable table (UnconstrainOver schema) columns
1009−
1010990{-----------------------------------------
1011991type expressions
1012992-----------------------------------------}
@@ -1017,30 +997,30 @@ newtype TypeExpression (ty :: ColumnType)
1017997 deriving (GHC.Generic,Show,Eq,Ord,NFData)
1018998
1019999-- | logical Boolean (true/false)
1020−bool :: TypeExpression ( '[] :=> 'Null 'PGbool)
1000+bool :: TypeExpression ('[] :=> 'Null 'PGbool)
10211001bool = UnsafeTypeExpression "bool"
10221002-- | signed two-byte integer
1023−int2, smallint :: TypeExpression ( '[] :=> 'Null 'PGint2)
1003+int2, smallint :: TypeExpression ('[] :=> 'Null 'PGint2)
10241004int2 = UnsafeTypeExpression "int2"
10251005smallint = UnsafeTypeExpression "smallint"
10261006-- | signed four-byte integer
1027−int4, int, integer :: TypeExpression ( '[] :=> 'Null 'PGint4)
1007+int4, int, integer :: TypeExpression ('[] :=> 'Null 'PGint4)
10281008int4 = UnsafeTypeExpression "int4"
10291009int = UnsafeTypeExpression "int"
10301010integer = UnsafeTypeExpression "integer"
10311011-- | signed eight-byte integer
1032−int8, bigint :: TypeExpression ( '[] :=> 'Null 'PGint8)
1012+int8, bigint :: TypeExpression ('[] :=> 'Null 'PGint8)
10331013int8 = UnsafeTypeExpression "int8"
10341014bigint = UnsafeTypeExpression "bigint"
10351015-- | arbitrary precision numeric type
1036−numeric :: TypeExpression ( '[] :=> 'Null 'PGnumeric)
1016+numeric :: TypeExpression ('[] :=> 'Null 'PGnumeric)
10371017numeric = UnsafeTypeExpression "numeric"
10381018-- | single precision floating-point number (4 bytes)
1039−float4, real :: TypeExpression ( '[] :=> 'Null 'PGfloat4)
1019+float4, real :: TypeExpression ('[] :=> 'Null 'PGfloat4)
10401020float4 = UnsafeTypeExpression "float4"
10411021real = UnsafeTypeExpression "real"
10421022-- | double precision floating-point number (8 bytes)
1043−float8, doublePrecision :: TypeExpression ( '[] :=> 'Null 'PGfloat8)
1023+float8, doublePrecision :: TypeExpression ('[] :=> 'Null 'PGfloat8)
10441024float8 = UnsafeTypeExpression "float8"
10451025doublePrecision = UnsafeTypeExpression "double precision"
10461026-- | not a true type, but merely a notational convenience for creating
@@ -1062,55 +1042,55 @@ serial8, bigserial
10621042serial8 = UnsafeTypeExpression "serial8"
10631043bigserial = UnsafeTypeExpression "bigserial"
10641044-- | variable-length character string
1065−text :: TypeExpression '( '[], ('Null 'PGtext))
1045+text :: TypeExpression ('[] :=> 'Null 'PGtext)
10661046text = UnsafeTypeExpression "text"
10671047-- | fixed-length character string
10681048char, character
10691049 :: (KnownNat n, 1 <= n)
10701050 => proxy n
1071− -> TypeExpression '( '[], ('Null ('PGchar n)))
1051+ -> TypeExpression ('[] :=> 'Null ('PGchar n))
10721052char p = UnsafeTypeExpression $ "char(" <> renderNat p <> ")"
10731053character p = UnsafeTypeExpression $ "character(" <> renderNat p <> ")"
10741054-- | variable-length character string
10751055varchar, characterVarying
10761056 :: (KnownNat n, 1 <= n)
10771057 => proxy n
1078− -> TypeExpression '( '[], ('Null ('PGvarchar n)))
1058+ -> TypeExpression ('[] :=> 'Null ('PGvarchar n))
10791059varchar p = UnsafeTypeExpression $ "varchar(" <> renderNat p <> ")"
10801060characterVarying p = UnsafeTypeExpression $
10811061 "character varying(" <> renderNat p <> ")"
10821062-- | binary data ("byte array")
1083−bytea :: TypeExpression ( '[] :=> 'Null 'PGbytea)
1063+bytea :: TypeExpression ('[] :=> 'Null 'PGbytea)
10841064bytea = UnsafeTypeExpression "bytea"
10851065-- | date and time (no time zone)
1086−timestamp :: TypeExpression ( '[] :=> 'Null 'PGtimestamp)
1066+timestamp :: TypeExpression ('[] :=> 'Null 'PGtimestamp)
10871067timestamp = UnsafeTypeExpression "timestamp"
10881068-- | date and time, including time zone
1089−timestampWithTimeZone :: TypeExpression ( '[] :=> 'Null 'PGtimestamptz)
1069+timestampWithTimeZone :: TypeExpression ('[] :=> 'Null 'PGtimestamptz)
10901070timestampWithTimeZone = UnsafeTypeExpression "timestamp with time zone"
10911071-- | calendar date (year, month, day)
1092−date :: TypeExpression ( '[] :=> 'Null 'PGdate)
1072+date :: TypeExpression ('[] :=> 'Null 'PGdate)
10931073date = UnsafeTypeExpression "date"
10941074-- | time of day (no time zone)
1095−time :: TypeExpression ( '[] :=> 'Null 'PGtime)
1075+time :: TypeExpression ('[] :=> 'Null 'PGtime)
10961076time = UnsafeTypeExpression "time"
10971077-- | time of day, including time zone
1098−timeWithTimeZone :: TypeExpression ( '[] :=> 'Null 'PGtimetz)
1078+timeWithTimeZone :: TypeExpression ('[] :=> 'Null 'PGtimetz)
10991079timeWithTimeZone = UnsafeTypeExpression "time with time zone"
11001080-- | time span
1101−interval :: TypeExpression ( '[] :=> 'Null 'PGinterval)
1081+interval :: TypeExpression ('[] :=> 'Null 'PGinterval)
11021082interval = UnsafeTypeExpression "interval"
11031083-- | universally unique identifier
1104−uuid :: TypeExpression ( '[] :=> 'Null 'PGuuid)
1084+uuid :: TypeExpression ('[] :=> 'Null 'PGuuid)
11051085uuid = UnsafeTypeExpression "uuid"
11061086-- | IPv4 or IPv6 host address
1107−inet :: TypeExpression ( '[] :=> 'Null 'PGinet)
1087+inet :: TypeExpression ('[] :=> 'Null 'PGinet)
11081088inet = UnsafeTypeExpression "inet"
11091089-- | textual JSON data
1110−json :: TypeExpression ( '[] :=> 'Null 'PGjson)
1090+json :: TypeExpression ('[] :=> 'Null 'PGjson)
11111091json = UnsafeTypeExpression "json"
11121092-- | binary JSON data, decomposed
1113−jsonb :: TypeExpression ( '[] :=> 'Null 'PGjsonb)
1093+jsonb :: TypeExpression ('[] :=> 'Null 'PGjsonb)
11141094jsonb = UnsafeTypeExpression "jsonb"
11151095
11161096-- | used in `createTable` commands as a column constraint to ensure
@@ -1122,15 +1102,15 @@ notNull ty = UnsafeTypeExpression $ renderTypeExpression ty <+> "NOT NULL"
11221102
11231103-- | used in `createTable` commands as a column constraint to give a default
11241104default_
1125− :: Expression '[] 'Ungrouped '[] ( '[] :=> ty)
1126− -> TypeExpression ( '[] :=> ty)
1127− -> TypeExpression '(constraints, ty)
1105+ :: Expression '[] 'Ungrouped '[] ty
1106+ -> TypeExpression (constraints :=> ty)
1107+ -> TypeExpression (AsSet ('Default ': constraints) :=> ty)
11281108default_ x ty = UnsafeTypeExpression $
11291109 renderTypeExpression ty <+> "DEFAULT" <+> renderExpression x
11301110
11311111-- | `pgtype` is a demoted version of a `PGType`
11321112class PGTyped (ty :: PGType) where
1133− pgtype :: TypeExpression ( '[] :=> 'Null ty)
1113+ pgtype :: TypeExpression ('[] :=> 'Null ty)
11341114instance PGTyped 'PGbool where pgtype = bool
11351115instance PGTyped 'PGint2 where pgtype = int2
11361116instance PGTyped 'PGint4 where pgtype = int4
squeal-postgresql/src/Squeal/PostgreSQL/Manipulation.hs+107−91
@@ -29,22 +29,20 @@ module Squeal.PostgreSQL.Manipulation
2929 Manipulation (UnsafeManipulation, renderManipulation)
3030 , queryStatement
3131 -- * Insert
32− , insertInto
33− , ValuesClause (Values, ValuesQuery)
34− , renderValuesClause
32+ , insertRows
33+ , insertQuery
3534 , ReturningClause (ReturningStar, Returning)
3635 , renderReturningClause
3736 , ConflictClause (OnConflictDoRaise, OnConflictDoNothing, OnConflictDoUpdate)
3837 , renderConflictClause
3938 -- * Update
4039 , update
41− , UpdateExpression (Same, Set)
42− , renderUpdateExpression
4340 , deleteFrom
41+ , ColumnValue (..)
4442 ) where
4543
4644import Control.DeepSeq
47−import Data.ByteString
45+import Data.ByteString hiding (foldr)
4846import Data.Monoid
4947
5048import qualified Generics.SOP as SOP
@@ -61,8 +59,8 @@ import Squeal.PostgreSQL.Schema
6159-- it does not modify data.
6260newtype Manipulation
6361 (schema :: SchemaType)
64− (params :: [ColumnType])
65− (columns :: ColumnsType)
62+ (params :: [NullityType])
63+ (columns :: RelationType)
6664 = UnsafeManipulation { renderManipulation :: ByteString }
6765 deriving (GHC.Generic,Show,Eq,Ord,NFData)
6866
@@ -92,7 +90,7 @@ let
9290 '[ "col1" ::: 'Required ('NotNull 'PGint4)
9391 , "col2" ::: 'Required ('NotNull 'PGint4) ]] '[] '[]
9492 manipulation =
95− insertInto #tab (Values (2 `As` #col1 :* 4 `As` #col2 :* Nil) [])
93+ insertInto #tab (ColumnValues (2 `As` #col1 :* 4 `As` #col2 :* Nil) [])
9694 OnConflictDoRaise (Returning Nil)
9795in renderManipulation manipulation
9896:}
@@ -110,7 +108,7 @@ let
110108 , 'Required ('NotNull 'PGint4) ] '[]
111109 manipulation =
112110 insertInto #tab
113− (Values (param @1 `As` #col1 :* param @2 `As` #col2 :* Nil) [])
111+ (ColumnValues (param @1 `As` #col1 :* param @2 `As` #col2 :* Nil) [])
114112 OnConflictDoRaise (Returning Nil)
115113in renderManipulation manipulation
116114:}
@@ -126,7 +124,7 @@ let
126124 , "col2" ::: 'Required ('NotNull 'PGint4) ]] '[]
127125 '["fromOnly" ::: 'Required ('NotNull 'PGint4)]
128126 manipulation =
129− insertInto #tab (Values (2 `As` #col1 :* 4 `As` #col2 :* Nil) [])
127+ insertInto #tab (ColumnValues (2 `As` #col1 :* 4 `As` #col2 :* Nil) [])
130128 OnConflictDoRaise (Returning (#col1 `As` #fromOnly :* Nil))
131129in renderManipulation manipulation
132130:}
@@ -148,7 +146,7 @@ let
148146 ] '[] '[]
149147 manipulation =
150148 insertInto #tab
151− ( ValuesQuery $
149+ ( ColumnValuesQuery $
152150 selectStar (from (Table (#other_tab `As` #t))) )
153151 OnConflictDoRaise (Returning Nil)
154152in renderManipulation manipulation
@@ -166,7 +164,7 @@ let
166164 '[] '[ "sum" ::: 'Required ('NotNull 'PGint4)]
167165 manipulation =
168166 insertInto #tab
169− (Values
167+ (ColumnValues
170168 (2 `As` #col1 :* 4 `As` #col2 :* Nil)
171169 [6 `As` #col1 :* 8 `As` #col2 :* Nil])
172170 (OnConflictDoUpdate
@@ -177,50 +175,64 @@ in renderManipulation manipulation
177175:}
178176"INSERT INTO tab (col1, col2) VALUES (2, 4), (6, 8) ON CONFLICT DO UPDATE SET col1 = 2 WHERE (col1 = col2) RETURNING (col1 + col2) AS sum;"
179177-}
180−insertInto
181− :: ( SOP.SListI columns, SOP.SListI results
182− , SchemaHasTable table schema columns )
183− => Alias table -- ^ table to insert into
184− -> ValuesClause schema params columns -- ^ values to insert
178+insertRows
179+ :: ( SOP.SListI columns
180+ , SOP.SListI results
181+ , Has tab schema table
182+ , columns ~ UnconstrainTable table )
183+ => Alias tab -- ^ table to insert into
184+ -> NP (Aliased (ColumnValue '[] params)) columns
185+ -> [NP (Aliased (ColumnValue '[] params)) columns]
185186 -> ConflictClause columns params
186187 -- ^ what to do in case of constraint conflict
187188 -> ReturningClause columns params results -- ^ results to return
188189 -> Manipulation schema params results
189−insertInto table insert conflict returning = UnsafeManipulation $
190− "INSERT" <+> "INTO" <+> renderAlias table
191− <+> renderValuesClause insert
192− <> renderConflictClause conflict
193− <> renderReturningClause returning
194−
195−-- | A `ValuesClause` lets you insert either values, free `Expression`s,
196−-- or the result of a `Query`.
197−data ValuesClause
198− (schema :: SchemaType)
199− (params :: [ColumnType])
200− (columns :: ColumnsType)
201− = Values
202− (NP (Aliased (Expression '[] 'Ungrouped params)) columns)
203− [NP (Aliased (Expression '[] 'Ungrouped params)) columns]
204− -- ^ at least one row of values
205− | ValuesQuery (Query schema params columns)
206−
207−-- | Render a `ValuesClause`.
208−renderValuesClause
209− :: SOP.SListI columns
210− => ValuesClause schema params columns
211− -> ByteString
212−renderValuesClause = \case
213− Values row rows ->
214− parenthesized (renderCommaSeparated renderAliasPart row)
190+insertRows tab row rows conflict returning = UnsafeManipulation $
191+ "INSERT" <+> "INTO" <+> renderAlias tab
192+ <+> parenthesized (renderCommaSeparated renderAliasPart row)
215193 <+> "VALUES"
216194 <+> commaSeparated
217− (parenthesized . renderCommaSeparated renderValuePart <$> row:rows)
195+ ( parenthesized
196+ . renderCommaSeparated renderColumnValuePart <$> row:rows )
197+ <> renderConflictClause conflict
198+ <> renderReturningClause returning
218199 where
219− renderAliasPart, renderValuePart
220− :: Aliased (Expression '[] 'Ungrouped params) ty -> ByteString
200+ renderAliasPart, renderColumnValuePart
201+ :: Aliased (ColumnValue '[] params) ty -> ByteString
221202 renderAliasPart (_ `As` name) = renderAlias name
222− renderValuePart (value `As` _) = renderExpression value
223− ValuesQuery q -> renderQuery q
203+ renderColumnValuePart (value `As` _) = case value of
204+ Def -> "DEFAULT"
205+ Set expression -> renderExpression expression
206+
207+insertQuery
208+ :: ( SOP.SListI columns
209+ , SOP.SListI results
210+ , Has tab schema table
211+ , columns ~ UnconstrainTable table )
212+ => Alias tab -- ^ table to insert into
213+ -> Query schema params (UnconstrainColumns columns)
214+ -> ConflictClause columns params
215+ -- ^ what to do in case of constraint conflict
216+ -> ReturningClause columns params results -- ^ results to return
217+ -> Manipulation schema params results
218+insertQuery tab query conflict returning = UnsafeManipulation $
219+ "INSERT" <+> "INTO" <+> renderAlias tab
220+ <+> renderQuery query
221+ <> renderConflictClause conflict
222+ <> renderReturningClause returning
223+
224+data ColumnValue
225+ (columns :: RelationType)
226+ (params :: [NullityType])
227+ (ty :: ColumnType)
228+ where
229+ Same :: ColumnValue (column ': columns) params ty
230+ Def
231+ :: 'Default `In` constraints
232+ => ColumnValue columns params (constraints :=> ty)
233+ Set
234+ :: (forall table. Expression '[table ::: columns] 'Ungrouped params ty)
235+ -> ColumnValue columns params (constraints :=> ty)
224236
225237-- | A `ReturningClause` computes and return value(s) based
226238-- on each row actually inserted, updated or deleted. This is primarily
@@ -234,13 +246,14 @@ renderValuesClause = \case
234246-- values are desired.
235247data ReturningClause
236248 (columns :: ColumnsType)
237− (params :: [ColumnType])
238− (results :: ColumnsType)
249+ (params :: [NullityType])
250+ (results :: RelationType)
239251 where
240− ReturningStar :: ReturningClause columns params columns
252+ ReturningStar
253+ :: ReturningClause columns params (UnconstrainColumns columns)
241254 Returning
242255 :: NP
243− (Aliased (Expression '[table ::: columns] 'Ungrouped params))
256+ (Aliased (Expression '[table ::: (UnconstrainColumns columns)] 'Ungrouped params))
244257 results
245258 -> ReturningClause columns params results
246259
@@ -260,12 +273,12 @@ renderReturningClause = \case
260273-- `OnConflictDoNothing` simply avoids inserting a row.
261274-- `OnConflictDoUpdate` updates the existing row that conflicts with the row
262275-- proposed for insertion.
263−data ConflictClause columns params where
276+data ConflictClause (columns :: ColumnsType) params where
264277 OnConflictDoRaise :: ConflictClause columns params
265278 OnConflictDoNothing :: ConflictClause columns params
266279 OnConflictDoUpdate
267− :: NP (Aliased (UpdateExpression columns params)) columns
268− -> Maybe (Condition '[table ::: columns] 'Ungrouped params)
280+ :: NP (Aliased (ColumnValue (UnconstrainColumns columns) params)) columns
281+ -> [Condition '[table ::: UnconstrainColumns columns] 'Ungrouped params]
269282 -> ConflictClause columns params
270283
271284-- | Render a `ConflictClause`.
@@ -276,12 +289,22 @@ renderConflictClause
276289renderConflictClause = \case
277290 OnConflictDoRaise -> ""
278291 OnConflictDoNothing -> " ON CONFLICT DO NOTHING"
279− OnConflictDoUpdate updates whMaybe
292+ OnConflictDoUpdate updates whs'
280293 -> " ON CONFLICT DO UPDATE SET"
281− <+> renderCommaSeparatedMaybe renderUpdateExpression updates
282− <> case whMaybe of
283− Nothing -> ""
284− Just wh -> " WHERE" <+> renderExpression wh
294+ <+> renderCommaSeparatedMaybe renderUpdate updates
295+ <> case whs' of
296+ [] -> ""
297+ wh:whs -> " WHERE" <+> renderExpression (foldr (.&&) wh whs)
298+ where
299+ renderUpdate
300+ :: Aliased (ColumnValue columns params) column
301+ -> Maybe ByteString
302+ renderUpdate = \case
303+ Same `As` _ -> Nothing
304+ Def `As` column -> Just $
305+ renderAlias column <+> "=" <+> "DEFAULT"
306+ Set expression `As` column -> Just $
307+ renderAlias column <+> "=" <+> renderExpression expression
285308
286309{-----------------------------------------
287310UPDATE statements
@@ -303,13 +326,14 @@ UPDATE statements
303326-- :}
304327-- "UPDATE tab SET col1 = 2 WHERE (col1 <> col2);"
305328update
306− :: ( SchemaHasTable table schema columns
307− , SOP.SListI columns
308− , SOP.SListI results )
309− => Alias table -- ^ table to update
310− -> NP (Aliased (UpdateExpression columns params)) columns
329+ :: ( SOP.SListI columns
330+ , SOP.SListI results
331+ , Has tab schema table
332+ , columns ~ UnconstrainTable table )
333+ => Alias tab -- ^ table to update
334+ -> NP (Aliased (ColumnValue (UnconstrainColumns columns) params)) columns
311335 -- ^ modified values to replace old values
312− -> Condition '[tab ::: columns] 'Ungrouped params
336+ -> Condition '[tab ::: UnconstrainColumns columns] 'Ungrouped params
313337 -- ^ condition under which to perform update on a row
314338 -> ReturningClause columns params results -- ^ results to return
315339 -> Manipulation schema params results
@@ -317,29 +341,19 @@ update table columns wh returning = UnsafeManipulation $
317341 "UPDATE"
318342 <+> renderAlias table
319343 <+> "SET"
320− <+> renderCommaSeparatedMaybe renderUpdateExpression columns
344+ <+> renderCommaSeparatedMaybe renderUpdate columns
321345 <+> "WHERE" <+> renderExpression wh
322346 <> renderReturningClause returning
323−
324−-- | Columns to be updated are mentioned with `Set`; columns which are to
325−-- remain the same are mentioned with `Same`.
326−data UpdateExpression columns params ty
327− = Same
328− -- ^ column to remain the same upon update
329− | Set (forall table. Expression '[table ::: columns] 'Ungrouped params ty)
330− -- ^ column to be updated
331−deriving instance Show (UpdateExpression columns params ty)
332−deriving instance Eq (UpdateExpression columns params ty)
333−deriving instance Ord (UpdateExpression columns params ty)
334−
335−-- | Render an `UpdateExpression`.
336−renderUpdateExpression
337− :: Aliased (UpdateExpression params columns) column
338− -> Maybe ByteString
339−renderUpdateExpression = \case
340− Same `As` _ -> Nothing
341− Set expression `As` column -> Just $
342− renderAlias column <+> "=" <+> renderExpression expression
347+ where
348+ renderUpdate
349+ :: Aliased (ColumnValue columns params) column
350+ -> Maybe ByteString
351+ renderUpdate = \case
352+ Same `As` _ -> Nothing
353+ Def `As` column -> Just $
354+ renderAlias column <+> "=" <+> "DEFAULT"
355+ Set expression `As` column -> Just $
356+ renderAlias column <+> "=" <+> renderExpression expression
343357
344358{-----------------------------------------
345359DELETE statements
@@ -360,9 +374,11 @@ DELETE statements
360374-- :}
361375-- "DELETE FROM tab WHERE (col1 = col2) RETURNING *;"
362376deleteFrom
363− :: (SOP.SListI results, SchemaHasTable table schema columns)
364− => Alias table -- ^ table to delete from
365− -> Condition '[table ::: columns] 'Ungrouped params
377+ :: ( SOP.SListI results
378+ , Has tab schema table
379+ , columns ~ UnconstrainTable table )
380+ => Alias tab -- ^ table to delete from
381+ -> Condition '[tab ::: UnconstrainColumns columns] 'Ungrouped params
366382 -- ^ condition under which to delete a row
367383 -> ReturningClause columns params results -- ^ results to return
368384 -> Manipulation schema params results
squeal-postgresql/src/Squeal/PostgreSQL/PQ.hs+1−1
@@ -457,7 +457,7 @@ instance MonadBaseControl b m => MonadBaseControl b (PQ schema schema m) where
457457-- | Encapsulates the result of a squeal command run by @LibPQ@.
458458-- `Result`s are parameterized by a `ColumnsType` describing the column names
459459-- and their types.
460−newtype Result (columns :: ColumnsType)
460+newtype Result (columns :: RelationType)
461461 = Result { unResult :: LibPQ.Result }
462462
463463-- | Just newtypes around a `CInt`
squeal-postgresql/src/Squeal/PostgreSQL/Query.hs+12−12
@@ -258,8 +258,8 @@ in renderQuery query
258258
259259newtype Query
260260 (schema :: SchemaType)
261− (params :: [ColumnType])
262− (columns :: ColumnsType)
261+ (params :: [NullityType])
262+ (columns :: RelationType)
263263 = UnsafeQuery { renderQuery :: ByteString }
264264 deriving (GHC.Generic,Show,Eq,Ord,NFData)
265265
@@ -420,8 +420,8 @@ Table Expressions
420420-- can be used to modify or combine base tables in various ways.
421421data TableExpression
422422 (schema :: SchemaType)
423− (params :: [ColumnType])
424− (tables :: RelationType)
423+ (params :: [NullityType])
424+ (tables :: RelationsType)
425425 (grouping :: Grouping)
426426 = TableExpression
427427 { fromClause :: FromClause schema params tables
@@ -612,7 +612,7 @@ their placement in SQL.
612612-}
613613data FromClause schema params tables where
614614 Table
615− :: Aliased (Table (UnconstrainOver schema)) table
615+ :: Aliased (Table (UnconstrainSchema schema)) table
616616 -> FromClause schema params '[table]
617617 Subquery
618618 :: Aliased (Query schema params) table
@@ -669,7 +669,7 @@ Grouping
669669-- column @col@; otherwise @By2 (\#tab \! \#col)@ will reference a table
670670-- qualified column @tab.col@.
671671data By
672− (tables :: RelationType)
672+ (tables :: RelationsType)
673673 (by :: (Symbol,Symbol)) where
674674 By
675675 :: (HasUnique table tables columns, HasColumn column columns ty)
@@ -743,22 +743,22 @@ Sorting
743743-- ordering of a `Null` result column.
744744data SortExpression tables grouping params where
745745 Asc
746− :: Expression tables grouping params '( '[], ('NotNull ty))
746+ :: Expression tables grouping params ('NotNull ty)
747747 -> SortExpression tables grouping params
748748 Desc
749− :: Expression tables grouping params '( '[], ('NotNull ty))
749+ :: Expression tables grouping params ('NotNull ty)
750750 -> SortExpression tables grouping params
751751 AscNullsFirst
752− :: Expression tables grouping params '( '[], ('Null ty))
752+ :: Expression tables grouping params ('Null ty)
753753 -> SortExpression tables grouping params
754754 AscNullsLast
755− :: Expression tables grouping params '( '[], ('Null ty))
755+ :: Expression tables grouping params ('Null ty)
756756 -> SortExpression tables grouping params
757757 DescNullsFirst
758− :: Expression tables grouping params '( '[], ('Null ty))
758+ :: Expression tables grouping params ('Null ty)
759759 -> SortExpression tables grouping params
760760 DescNullsLast
761− :: Expression tables grouping params '( '[], ('Null ty))
761+ :: Expression tables grouping params ('Null ty)
762762 -> SortExpression tables grouping params
763763deriving instance Show (SortExpression tables grouping params)
764764
squeal-postgresql/src/Squeal/PostgreSQL/Schema.hs+53−41
@@ -16,6 +16,7 @@ Embedding of PostgreSQL type and alias system
1616 , DeriveGeneric
1717 , FlexibleContexts
1818 , FlexibleInstances
19+ , FunctionalDependencies
1920 , GADTs
2021 , MagicHash
2122 , MultiParamTypeClasses
@@ -38,6 +39,7 @@ module Squeal.PostgreSQL.Schema
3839 , ColumnType
3940 , ColumnsType
4041 , RelationType
42+ , RelationsType
4143 , TableType
4244 , SchemaType
4345 , Grouping (..)
@@ -74,8 +76,10 @@ module Squeal.PostgreSQL.Schema
7476 , SameFields
7577 -- * PostgreSQL Constraints
7678 , (:=>)
77− , Unconstrain
78− , UnconstrainOver
79+ , UnconstrainColumn
80+ , UnconstrainColumns
81+ , UnconstrainTable
82+ , UnconstrainSchema
7983 , ColumnConstraint (..)
8084 -- , DropDefault
8185 -- , DropDefaultList
@@ -84,6 +88,7 @@ module Squeal.PostgreSQL.Schema
8488 , TableConstraint (..)
8589 , AsSet
8690 , Aliases
91+ , Has
8792 ) where
8893
8994import Control.DeepSeq
@@ -142,22 +147,27 @@ type ColumnType = ([ColumnConstraint],NullityType)
142147-- | `ColumnsType` is a kind synonym for a row of `ColumnType`s.
143148type ColumnsType = [(Symbol,ColumnType)]
144149
145−-- | `RelationType` is a kind synonym for a row of `ColumnsType`s.
146−-- It is used as a kind for both a schema, a disjoint union of tables,
147−-- and a joined table `Squeal.PostgreSQL.Query.FromClause`,
148−-- a product of tables.
149−type RelationType = [(Symbol,ColumnsType)]
150+type RelationType = [(Symbol,NullityType)]
151+type RelationsType = [(Symbol,RelationType)]
150152
151153type TableType = ([TableConstraint],ColumnsType)
152154type SchemaType = [(Symbol,TableType)]
153155
154−type family Unconstrain (ty :: ([constraint],kind)) :: kind where
155− Unconstrain '(constraints,ty) = ty
156+type family UnconstrainColumn (ty :: ColumnType) :: NullityType where
157+ UnconstrainColumn (constraints :=> ty) = ty
156158
157−type family UnconstrainOver (tys :: SchemaType) :: RelationType where
158− UnconstrainOver '[] = '[]
159− UnconstrainOver ((alias ::: x) ': xs) =
160− (alias ::: Unconstrain x) ': UnconstrainOver xs
159+type family UnconstrainColumns (columns :: ColumnsType) :: RelationType where
160+ UnconstrainColumns '[] = '[]
161+ UnconstrainColumns (column ::: ty ': columns) =
162+ column ::: UnconstrainColumn ty ': UnconstrainColumns columns
163+
164+type family UnconstrainTable (table :: TableType) :: ColumnsType where
165+ UnconstrainTable (constraints :=> columns) = columns
166+
167+type family UnconstrainSchema (schema :: SchemaType) :: RelationsType where
168+ UnconstrainSchema '[] = '[]
169+ UnconstrainSchema (tab ::: constraints :=> columns ': tables) =
170+ tab ::: UnconstrainColumns columns ': UnconstrainSchema tables
161171
162172-- | `Grouping` is an auxiliary namespace, created by
163173-- @GROUP BY@ clauses (`Squeal.PostgreSQL.Query.group`), and used
@@ -250,52 +260,46 @@ type family In x xs :: Constraint where
250260type HasUnique alias xs x = xs ~ '[alias ::: x]
251261
252262-- | `PGTypeOf` forgets about @NULL@ and any column constraints.
253−type family PGTypeOf (ty :: ColumnType) :: PGType where
254− PGTypeOf '(constraints, nullity pg) = pg
263+type family PGTypeOf (ty :: NullityType) :: PGType where
264+ PGTypeOf (nullity pg) = pg
255265
256266-- | `SameTypes` is a constraint that proves two `ColumnsType`s have the same
257267-- length and the same `ColumnType`s.
258−type family SameTypes
259− (columns0 :: ColumnsType) (columns1 :: ColumnsType)
260− :: Constraint where
268+type family SameTypes (columns0 :: RelationType) (columns1 :: RelationType)
269+ :: Constraint where
261270 SameTypes '[] '[] = ()
262− SameTypes ((column0 ::: ty0) ': columns0) ((column1 ::: ty1) ': columns1)
271+ SameTypes (column0 ::: ty0 ': columns0) (column1 ::: ty1 ': columns1)
263272 = (ty0 ~ ty1, SameTypes columns0 columns1)
264273
265274-- | `AllNotNull` is a constraint that proves a `ColumnsType` has no @NULL@s.
266−type family AllNotNull (columns :: ColumnsType) :: Constraint where
275+type family AllNotNull (columns :: RelationType) :: Constraint where
267276 AllNotNull '[] = ()
268− AllNotNull ((column ::: '(constraints, ('NotNull ty))) ': columns)
269− = AllNotNull columns
277+ AllNotNull (column ::: 'NotNull ty ': columns) = AllNotNull columns
270278
271279-- | `NotAllNull` is a constraint that proves a `ColumnsType` has some
272280-- @NOT NULL@.
273−type family NotAllNull columns :: Constraint where
274− NotAllNull ((column ::: '(constraints, ('NotNull ty))) ': columns) = ()
275− NotAllNull ((column ::: '(constraints, ('Null ty))) ': columns)
276− = NotAllNull columns
281+type family NotAllNull (columns :: RelationType) :: Constraint where
282+ NotAllNull (column ::: 'NotNull ty ': columns) = ()
283+ NotAllNull (column ::: 'Null ty ': columns) = NotAllNull columns
277284
278285-- | `NullifyType` is an idempotent that nullifies a `ColumnType`.
279−type family NullifyType (ty :: ColumnType) :: ColumnType where
280− NullifyType (optionality ('Null ty)) = optionality ('Null ty)
281− NullifyType (optionality ('NotNull ty)) = optionality ('Null ty)
286+type family NullifyType (ty :: NullityType) :: NullityType where
287+ NullifyType ('Null ty) = 'Null ty
288+ NullifyType ('NotNull ty) = 'Null ty
282289
283290-- | `NullifyColumns` is an idempotent that nullifies a `ColumnsType`.
284−type family NullifyColumns (columns :: ColumnsType) :: ColumnsType where
291+type family NullifyColumns (columns :: RelationType) :: RelationType where
285292 NullifyColumns '[] = '[]
286− NullifyColumns ((column ::: ty) ': columns) =
287− (column ::: NullifyType ty) ': NullifyColumns columns
293+ NullifyColumns (column ::: ty ': columns) =
294+ column ::: NullifyType ty ': NullifyColumns columns
288295
289−type family NullifyTable (table :: TableType) :: TableType where
290− NullifyTable '( '[], columns) = '( '[], NullifyColumns columns)
291−
292−-- | `NullifyTables` is an idempotent that nullifies a `RelationType`
296+-- | `NullifyTables` is an idempotent that nullifies a `RelationsType`
293297-- used to nullify the left or right hand side of an outer join
294298-- in a `Squeal.PostgreSQL.Query.FromClause`.
295−type family NullifyTables (tables :: RelationType) :: RelationType where
299+type family NullifyTables (tables :: RelationsType) :: RelationsType where
296300 NullifyTables '[] = '[]
297− NullifyTables ((tab ::: columns) ': tables) =
298− (tab ::: NullifyColumns columns) ': NullifyTables tables
301+ NullifyTables (table ::: columns ': tables) =
302+ table ::: NullifyColumns columns ': NullifyTables tables
299303
300304-- | `Join` is simply promoted `++` and is used in @JOIN@s in
301305-- `Squeal.PostgreSQL.Query.FromClause`s.
@@ -351,14 +355,14 @@ type family Rename alias0 alias1 xs where
351355-- | A `SameField` constraint is an equality constraint on a
352356-- `Generics.SOP.Type.Metadata.FieldInfo` and the column alias in a `:::` pair.
353357class SameField
354− (fieldInfo :: Type.FieldInfo) (fieldty :: (Symbol,ColumnType)) where
358+ (fieldInfo :: Type.FieldInfo) (fieldty :: (Symbol,NullityType)) where
355359instance field ~ column => SameField ('Type.FieldInfo field) (column ::: ty)
356360
357361-- | A `SameFields` constraint proves that a
358362-- `Generics.SOP.Type.Metadata.DatatypeInfo` of a record type has the same
359363-- field names as the column aliases of a `ColumnsType`.
360364type family SameFields
361− (datatypeInfo :: Type.DatatypeInfo) (columns :: ColumnsType)
365+ (datatypeInfo :: Type.DatatypeInfo) (columns :: RelationType)
362366 :: Constraint where
363367 SameFields
364368 ('Type.ADT _module _datatype '[ 'Type.Record _constructor fields])
@@ -396,3 +400,11 @@ data TableConstraint
396400type family Aliases xs where
397401 Aliases '[] = '[]
398402 Aliases ((alias ::: x) ': xs) = alias ': Aliases xs
403+
404+class KnownSymbol alias =>
405+ Has (alias :: Symbol) (fields :: [(Symbol,kind)]) (field :: kind)
406+ | alias fields -> field where
407+instance {-# OVERLAPPING #-} KnownSymbol alias
408+ => Has alias (alias ::: field ': fields) field
409+instance {-# OVERLAPPABLE #-} (KnownSymbol alias, Has alias fields field)
410+ => Has alias (field' ': fields) field