on dev help sign in
17 files changed+454−229
since splitsnapshots
unifiedsplit
README.md+6−6 squeal-postgresql/exe/Example.hs+2−2 squeal-postgresql/squeal-postgresql.cabal−1 squeal-postgresql/src/Squeal/PostgreSQL.hs−1 squeal-postgresql/src/Squeal/PostgreSQL/Binary.hs+130−40 squeal-postgresql/src/Squeal/PostgreSQL/Definition.hs+1 squeal-postgresql/src/Squeal/PostgreSQL/Definition/Table.hs+27−4 squeal-postgresql/src/Squeal/PostgreSQL/Definition/Table/Column.hs−105 squeal-postgresql/src/Squeal/PostgreSQL/Expression/Type.hs+101−4 squeal-postgresql/src/Squeal/PostgreSQL/List.hs+11−2 squeal-postgresql/src/Squeal/PostgreSQL/Migration.hs−1 squeal-postgresql/src/Squeal/PostgreSQL/PG.hs+22−12 squeal-postgresql/src/Squeal/PostgreSQL/PQ.hs+41−17 squeal-postgresql/src/Squeal/PostgreSQL/Query.hs+33−25 squeal-postgresql/src/Squeal/PostgreSQL/Schema.hs+67−7 squeal-postgresql/test/Property.hs+2−2 squeal-postgresql/test/Spec.hs+11
README.md+6−6
@@ -121,7 +121,7 @@ type Schemas = Public Schema
121121
122122Notice the use of type operators.
123123
124−`:::` is used to pair an alias `GHC.TypeLits.Symbol` with a `SchemumType`,
124+`:::` is used to pair an alias `Symbol` with a `SchemumType`,
125125a `TableConstraint` or a `ColumnType`. It is intended to connote Haskell's `::`
126126operator.
127127
@@ -180,8 +180,8 @@ DROP TABLE "emails";
180180DROP TABLE "users";
181181```
182182
183−We'll need a Haskell type for @User@s. We give the type `Generics.SOP.Generic` and
184−`Generics.SOP.HasDatatypeInfo` instances so that we can encode and decode @User@s.
183+We'll need a Haskell type for `User`s. We give the type `SOP.Generic` and
184+`SOP.HasDatatypeInfo` instances so that we can encode and decode `User`s.
185185
186186```Haskell
187187>>> data User = User { userName :: Text, userEmail :: Maybe Text } deriving (Show, GHC.Generic)
@@ -189,12 +189,12 @@ We'll need a Haskell type for @User@s. We give the type `Generics.SOP.Generic` a
189189>>> instance SOP.HasDatatypeInfo User
190190```
191191
192−Next, we'll write `Manipulation_`s to insert @User@s into our two tables.
192+Next, we'll write `Manipulation_`s to insert `User`s into our two tables.
193193A `Manipulation_` like `insertInto`, `update` or `deleteFrom`
194194has three type parameters, the schemas it refers to, input parameters
195195and an output row. When
196−we insert into the users table, we will need a parameter for the @name@
197−field but not for the @id@ field. Since it's serial, we can use a default
196+we insert into the users table, we will need a parameter for the `name`
197+field but not for the `id` field. Since it's serial, we can use a default
198198value. However, since the emails table refers to the users table, we will
199199need to retrieve the user id that the insert generates and insert it into
200200the emails table. We can do this in a single `Manipulation_` by using a
squeal-postgresql/exe/Example.hs+2−2
@@ -53,8 +53,8 @@ setup =
5353 >>>
5454 createTable #emails
5555 ( serial `as` #id :*
56− (int & notNullable) `as` #user_id :*
57− (text & nullable) `as` #email )
56+ hask @Int32 `as` #user_id :*
57+ hask @(Maybe Text) `as` #email )
5858 ( primaryKey #id `as` #pk_emails :*
5959 foreignKey #user_id #users #id
6060 OnDeleteCascade OnUpdateCascade `as` #fk_user_id )
squeal-postgresql/squeal-postgresql.cabal−1
@@ -28,7 +28,6 @@ library
2828 Squeal.PostgreSQL.Definition.Function
2929 Squeal.PostgreSQL.Definition.Index
3030 Squeal.PostgreSQL.Definition.Table
31− Squeal.PostgreSQL.Definition.Table.Column
3231 Squeal.PostgreSQL.Definition.Table.Constraint
3332 Squeal.PostgreSQL.Definition.Type
3433 Squeal.PostgreSQL.Definition.Schema
squeal-postgresql/src/Squeal/PostgreSQL.hs−1
@@ -199,7 +199,6 @@ import Squeal.PostgreSQL.Definition.Function as X
199199import Squeal.PostgreSQL.Definition.Index as X
200200import Squeal.PostgreSQL.Definition.Schema as X
201201import Squeal.PostgreSQL.Definition.Table as X
202−import Squeal.PostgreSQL.Definition.Table.Column as X
203202import Squeal.PostgreSQL.Definition.Table.Constraint as X
204203import Squeal.PostgreSQL.Definition.Type as X
205204import Squeal.PostgreSQL.Definition.View as X
squeal-postgresql/src/Squeal/PostgreSQL/Binary.hs+130−40
@@ -216,8 +216,9 @@ module Squeal.PostgreSQL.Binary
216216 -- * Only
217217 , Only (..)
218218 -- * Oid
219− , HasOid (..)
220− , HasAliasedOid (..)
219+ , OidOf (..)
220+ , OidOfParam (..)
221+ , OidOfField (..)
221222 ) where
222223
223224import BinaryParser
@@ -231,6 +232,7 @@ import Data.Time
231232import Data.UUID.Types
232233import Data.Vector (Vector)
233234import Data.Word
235+import Foreign.C.Types (CUInt(CUInt))
234236import Generics.SOP
235237import Generics.SOP.Record
236238import GHC.TypeLits
@@ -244,6 +246,7 @@ import qualified Data.Text.Lazy as Lazy (Text)
244246import qualified Data.Text as Strict (Text)
245247import qualified Data.Text as Strict.Text
246248import qualified Data.Vector as Vector
249+import qualified Database.PostgreSQL.LibPQ as LibPQ
247250import qualified GHC.Generics as GHC
248251import qualified PostgreSQL.Binary.Decoding as Decoding
249252import qualified PostgreSQL.Binary.Encoding as Encoding
@@ -309,24 +312,24 @@ instance Aeson.ToJSON x => ToParam (Json x) 'PGjson where
309312instance Aeson.ToJSON x => ToParam (Jsonb x) 'PGjsonb where
310313 toParam = K . Encoding.jsonb_bytes
311314 . Lazy.ByteString.toStrict . Aeson.encode . getJsonb
312−instance (ToNullityParam x ty, ty ~ nullity pg, HasOid pg)
315+instance (ToNullityParam x ty, ty ~ nullity pg, OidOf pg)
313316 => ToParam (VarArray [x]) ('PGvararray ty) where
314317 toParam = K
315318 . Encoding.array_foldable
316319 (getOid (oidOf @pg)) (unK . toNullityParam @x @ty)
317320 . getVarArray
318−instance (ToParam x pg, HasOid pg)
321+instance (ToParam x pg, OidOf pg)
319322 => ToParam (VarArray (Vector x)) ('PGvararray ('NotNull pg)) where
320323 toParam = K
321324 . Encoding.array_vector (getOid (oidOf @pg)) (unK . toParam @x @pg)
322325 . getVarArray
323−instance (ToParam x pg, HasOid pg)
326+instance (ToParam x pg, OidOf pg)
324327 => ToParam (VarArray (Vector (Maybe x))) ('PGvararray ('Null pg)) where
325328 toParam = K
326329 . Encoding.nullableArray_vector
327330 (getOid (oidOf @pg)) (unK . toParam @x @pg)
328331 . getVarArray
329−instance (ToFixArray x dims ty, ty ~ nullity pg, HasOid pg)
332+instance (ToFixArray x dims ty, ty ~ nullity pg, OidOf pg)
330333 => ToParam (FixArray x) ('PGfixarray dims ty) where
331334 toParam = K . Encoding.array (getOid (oidOf @pg))
332335 . unK . unK . toFixArray @x @dims @ty . getFixArray
@@ -353,7 +356,7 @@ instance
353356 ( SListI fields
354357 , IsRecord x xs
355358 , AllZip ToField xs fields
356− , All HasAliasedOid fields
359+ , All OidOfField fields
357360 ) => ToParam (Composite x) ('PGcomposite fields) where
358361 toParam =
359362 let
@@ -361,7 +364,7 @@ instance
361364 encoders = htrans (Proxy @ToField) toField
362365
363366 composite
364− :: All HasAliasedOid row
367+ :: All OidOfField row
365368 => NP (K (Maybe Encoding.Encoding)) row
366369 -> K Encoding.Encoding ('PGcomposite row)
367370 composite fields = K $
@@ -378,18 +381,18 @@ instance
378381 int32BE (fromIntegral (lengthSList (Proxy @xs))) <>
379382 let
380383 each
381− :: HasAliasedOid field
384+ :: OidOfField field
382385 => K (Maybe Encoding.Encoding) field
383386 -> Encoding.Encoding
384387 each (K field :: K (Maybe Encoding.Encoding) field) =
385− word32BE (getOid (aliasedOid @field))
388+ word32BE (getOid (oidOfField @field))
386389 <> case field of
387390 Nothing -> int64BE (-1)
388391 Just value ->
389392 int32BE (fromIntegral (builderLength value))
390393 <> value
391394 in
392− hcfoldMap (Proxy @HasAliasedOid) each fields
395+ hcfoldMap (Proxy @OidOfField) each fields
393396
394397 in
395398 composite . encoders . toRecord . getComposite
@@ -398,35 +401,119 @@ instance
398401--
399402-- >>> :set -XTypeApplications
400403-- >>> oidOf @'PGbool
401−-- Oid {getOid = 16}
402−class HasOid (ty :: PGType) where oidOf :: Oid
403−instance HasOid 'PGbool where oidOf = Oid 16
404−instance HasOid 'PGint2 where oidOf = Oid 21
405−instance HasOid 'PGint4 where oidOf = Oid 23
406−instance HasOid 'PGint8 where oidOf = Oid 20
407−instance HasOid 'PGnumeric where oidOf = Oid 1700
408−instance HasOid 'PGfloat4 where oidOf = Oid 700
409−instance HasOid 'PGfloat8 where oidOf = Oid 701
410−instance HasOid ('PGchar n) where oidOf = Oid 18
411−instance HasOid ('PGvarchar n) where oidOf = Oid 1043
412−instance HasOid 'PGtext where oidOf = Oid 25
413−instance HasOid 'PGbytea where oidOf = Oid 17
414−instance HasOid 'PGtimestamp where oidOf = Oid 1114
415−instance HasOid 'PGtimestamptz where oidOf = Oid 1184
416−instance HasOid 'PGdate where oidOf = Oid 1082
417−instance HasOid 'PGtime where oidOf = Oid 1083
418−instance HasOid 'PGtimetz where oidOf = Oid 1266
419−instance HasOid 'PGinterval where oidOf = Oid 1186
420−instance HasOid 'PGuuid where oidOf = Oid 2950
421−instance HasOid 'PGinet where oidOf = Oid 869
422−instance HasOid 'PGjson where oidOf = Oid 114
423−instance HasOid 'PGjsonb where oidOf = Oid 3802
424−
425−-- | Lifts a `HasOid` constraint to a field.
426−class HasAliasedOid (field :: (Symbol, NullityType)) where
427− aliasedOid :: Oid
428−instance HasOid ty => HasAliasedOid (alias ::: nullity ty) where
429− aliasedOid = oidOf @ty
404+-- Oid 16
405+class OidOf (ty :: PGType) where oidOf :: LibPQ.Oid
406+instance OidOf 'PGbool where oidOf = LibPQ.Oid 16
407+instance OidOf ('PGfixarray ns (null 'PGbool)) where oidOf = LibPQ.Oid 1000
408+instance OidOf ('PGvararray (null 'PGbool)) where oidOf = LibPQ.Oid 1000
409+instance OidOf 'PGint2 where oidOf = LibPQ.Oid 21
410+instance OidOf ('PGfixarray ns (null 'PGint2)) where oidOf = LibPQ.Oid 1005
411+instance OidOf ('PGvararray (null 'PGint2)) where oidOf = LibPQ.Oid 1005
412+instance OidOf 'PGint4 where oidOf = LibPQ.Oid 23
413+instance OidOf ('PGfixarray ns (null 'PGint4)) where oidOf = LibPQ.Oid 1007
414+instance OidOf ('PGvararray (null 'PGint4)) where oidOf = LibPQ.Oid 1007
415+instance OidOf 'PGint8 where oidOf = LibPQ.Oid 20
416+instance OidOf ('PGfixarray ns (null 'PGint8)) where oidOf = LibPQ.Oid 1016
417+instance OidOf ('PGvararray (null 'PGint8)) where oidOf = LibPQ.Oid 1016
418+instance OidOf 'PGnumeric where oidOf = LibPQ.Oid 1700
419+instance OidOf ('PGfixarray ns (null 'PGnumeric)) where oidOf = LibPQ.Oid 1231
420+instance OidOf ('PGvararray (null 'PGnumeric)) where oidOf = LibPQ.Oid 1231
421+instance OidOf 'PGfloat4 where oidOf = LibPQ.Oid 700
422+instance OidOf ('PGfixarray ns (null 'PGfloat4)) where oidOf = LibPQ.Oid 1021
423+instance OidOf ('PGvararray (null 'PGfloat4)) where oidOf = LibPQ.Oid 1021
424+instance OidOf 'PGfloat8 where oidOf = LibPQ.Oid 701
425+instance OidOf ('PGfixarray ns (null 'PGfloat8)) where oidOf = LibPQ.Oid 1022
426+instance OidOf ('PGvararray (null 'PGfloat8)) where oidOf = LibPQ.Oid 1022
427+instance OidOf 'PGmoney where oidOf = LibPQ.Oid 790
428+instance OidOf ('PGfixarray ns (null 'PGmoney)) where oidOf = LibPQ.Oid 791
429+instance OidOf ('PGvararray (null 'PGmoney)) where oidOf = LibPQ.Oid 791
430+instance OidOf ('PGchar n) where oidOf = LibPQ.Oid 18
431+instance OidOf ('PGfixarray ns (null ('PGchar n))) where oidOf = LibPQ.Oid 1002
432+instance OidOf ('PGvararray (null ('PGchar n))) where oidOf = LibPQ.Oid 1002
433+instance OidOf ('PGvarchar n) where oidOf = LibPQ.Oid 1043
434+instance OidOf ('PGfixarray ns (null ('PGvarchar n))) where oidOf = LibPQ.Oid 1015
435+instance OidOf ('PGvararray (null ('PGvarchar n))) where oidOf = LibPQ.Oid 1015
436+instance OidOf 'PGtext where oidOf = LibPQ.Oid 25
437+instance OidOf ('PGfixarray ns (null 'PGtext)) where oidOf = LibPQ.Oid 1009
438+instance OidOf ('PGvararray (null 'PGtext)) where oidOf = LibPQ.Oid 1009
439+instance OidOf 'PGbytea where oidOf = LibPQ.Oid 17
440+instance OidOf ('PGfixarray ns (null 'PGbytea)) where oidOf = LibPQ.Oid 1001
441+instance OidOf ('PGvararray (null 'PGbytea)) where oidOf = LibPQ.Oid 1001
442+instance OidOf 'PGtimestamp where oidOf = LibPQ.Oid 1114
443+instance OidOf ('PGfixarray ns (null 'PGtimestamp)) where oidOf = LibPQ.Oid 1115
444+instance OidOf ('PGvararray (null 'PGtimestamp)) where oidOf = LibPQ.Oid 1115
445+instance OidOf 'PGtimestamptz where oidOf = LibPQ.Oid 1184
446+instance OidOf ('PGfixarray ns (null 'PGtimestamptz)) where oidOf = LibPQ.Oid 1185
447+instance OidOf ('PGvararray (null 'PGtimestamptz)) where oidOf = LibPQ.Oid 1185
448+instance OidOf 'PGdate where oidOf = LibPQ.Oid 1082
449+instance OidOf ('PGfixarray ns (null 'PGdate)) where oidOf = LibPQ.Oid 1182
450+instance OidOf ('PGvararray (null 'PGdate)) where oidOf = LibPQ.Oid 1182
451+instance OidOf 'PGtime where oidOf = LibPQ.Oid 1083
452+instance OidOf ('PGfixarray ns (null 'PGtime)) where oidOf = LibPQ.Oid 1183
453+instance OidOf ('PGvararray (null 'PGtime)) where oidOf = LibPQ.Oid 1183
454+instance OidOf 'PGtimetz where oidOf = LibPQ.Oid 1266
455+instance OidOf ('PGfixarray ns (null 'PGtimetz)) where oidOf = LibPQ.Oid 1270
456+instance OidOf ('PGvararray (null 'PGtimetz)) where oidOf = LibPQ.Oid 1270
457+instance OidOf 'PGinterval where oidOf = LibPQ.Oid 1186
458+instance OidOf ('PGfixarray ns (null 'PGinterval)) where oidOf = LibPQ.Oid 1187
459+instance OidOf ('PGvararray (null 'PGinterval)) where oidOf = LibPQ.Oid 1187
460+instance OidOf 'PGuuid where oidOf = LibPQ.Oid 2950
461+instance OidOf ('PGfixarray ns (null 'PGuuid)) where oidOf = LibPQ.Oid 2951
462+instance OidOf ('PGvararray (null 'PGuuid)) where oidOf = LibPQ.Oid 2951
463+instance OidOf 'PGinet where oidOf = LibPQ.Oid 869
464+instance OidOf ('PGfixarray ns (null 'PGinet)) where oidOf = LibPQ.Oid 1041
465+instance OidOf ('PGvararray (null 'PGinet)) where oidOf = LibPQ.Oid 1041
466+instance OidOf 'PGjson where oidOf = LibPQ.Oid 114
467+instance OidOf ('PGfixarray ns (null 'PGjson)) where oidOf = LibPQ.Oid 199
468+instance OidOf ('PGvararray (null 'PGjson)) where oidOf = LibPQ.Oid 199
469+instance OidOf 'PGjsonb where oidOf = LibPQ.Oid 3802
470+instance OidOf ('PGfixarray ns (null 'PGjsonb)) where oidOf = LibPQ.Oid 3807
471+instance OidOf ('PGvararray (null 'PGjsonb)) where oidOf = LibPQ.Oid 3807
472+instance OidOf 'PGtsvector where oidOf = LibPQ.Oid 3614
473+instance OidOf ('PGfixarray ns (null 'PGtsvector)) where oidOf = LibPQ.Oid 3643
474+instance OidOf ('PGvararray (null 'PGtsvector)) where oidOf = LibPQ.Oid 3643
475+instance OidOf 'PGtsquery where oidOf = LibPQ.Oid 3615
476+instance OidOf ('PGfixarray ns (null 'PGtsquery)) where oidOf = LibPQ.Oid 3645
477+instance OidOf ('PGvararray (null 'PGtsquery)) where oidOf = LibPQ.Oid 3645
478+instance OidOf 'PGoid where oidOf = LibPQ.Oid 26
479+instance OidOf ('PGfixarray ns (null 'PGoid)) where oidOf = LibPQ.Oid 1028
480+instance OidOf ('PGvararray (null 'PGoid)) where oidOf = LibPQ.Oid 1028
481+instance OidOf ('PGrange 'PGint4) where oidOf = LibPQ.Oid 3904
482+instance OidOf ('PGfixarray ns (null ('PGrange 'PGint4))) where oidOf = LibPQ.Oid 3905
483+instance OidOf ('PGvararray (null ('PGrange 'PGint4))) where oidOf = LibPQ.Oid 3905
484+instance OidOf ('PGrange 'PGint8) where oidOf = LibPQ.Oid 3926
485+instance OidOf ('PGfixarray ns (null ('PGrange 'PGint8))) where oidOf = LibPQ.Oid 3927
486+instance OidOf ('PGvararray (null ('PGrange 'PGint8))) where oidOf = LibPQ.Oid 3927
487+instance OidOf ('PGrange 'PGnumeric) where oidOf = LibPQ.Oid 3906
488+instance OidOf ('PGfixarray ns (null ('PGrange 'PGnumeric))) where oidOf = LibPQ.Oid 3907
489+instance OidOf ('PGvararray (null ('PGrange 'PGnumeric))) where oidOf = LibPQ.Oid 3907
490+instance OidOf ('PGrange 'PGtimestamp) where oidOf = LibPQ.Oid 3908
491+instance OidOf ('PGfixarray ns (null ('PGrange 'PGtimestamp))) where oidOf = LibPQ.Oid 3909
492+instance OidOf ('PGvararray (null ('PGrange 'PGtimestamp))) where oidOf = LibPQ.Oid 3909
493+instance OidOf ('PGrange 'PGtimestamptz) where oidOf = LibPQ.Oid 3910
494+instance OidOf ('PGfixarray ns (null ('PGrange 'PGtimestamptz))) where oidOf = LibPQ.Oid 3911
495+instance OidOf ('PGvararray (null ('PGrange 'PGtimestamptz))) where oidOf = LibPQ.Oid 3911
496+instance OidOf ('PGrange 'PGdate) where oidOf = LibPQ.Oid 3912
497+instance OidOf ('PGfixarray ns (null ('PGrange 'PGdate))) where oidOf = LibPQ.Oid 3913
498+instance OidOf ('PGvararray (null ('PGrange 'PGdate))) where oidOf = LibPQ.Oid 3913
499+instance {-# OVERLAPPABLE #-} OidOf ('PGrange ty) where oidOf = LibPQ.invalidOid
500+instance {-# OVERLAPPABLE #-} OidOf ('PGfixarray ns (null ('PGrange ty))) where oidOf = LibPQ.invalidOid
501+instance {-# OVERLAPPABLE #-} OidOf ('PGvararray (null ('PGrange ty))) where oidOf = LibPQ.invalidOid
502+instance {-# OVERLAPPABLE #-} OidOf ('PGcomposite row) where oidOf = LibPQ.invalidOid
503+instance {-# OVERLAPPABLE #-} OidOf ('PGfixarray ns (null ('PGcomposite row))) where oidOf = LibPQ.invalidOid
504+instance {-# OVERLAPPABLE #-} OidOf ('PGvararray (null ('PGcomposite row))) where oidOf = LibPQ.invalidOid
505+instance {-# OVERLAPPABLE #-} OidOf ('PGenum labels) where oidOf = LibPQ.invalidOid
506+instance {-# OVERLAPPABLE #-} OidOf ('PGfixarray ns (null ('PGenum labels))) where oidOf = LibPQ.invalidOid
507+instance {-# OVERLAPPABLE #-} OidOf ('PGvararray (null ('PGenum labels))) where oidOf = LibPQ.invalidOid
508+
509+class OidOfParam (ty :: NullityType) where oidOfParam :: Oid
510+instance OidOf ty => OidOfParam (null ty) where oidOfParam = oidOf @ty
511+
512+-- | Lifts a `OidOf` constraint to a field.
513+class OidOfField (field :: (Symbol, NullityType)) where
514+ oidOfField :: Oid
515+instance OidOf ty => OidOfField (alias ::: nullity ty) where
516+ oidOfField = oidOf @ty
430517
431518-- | A `ToNullityParam` constraint gives an encoding of a Haskell `Type` into
432519-- into the binary format of a PostgreSQL `NullityType`.
@@ -756,3 +843,6 @@ replicateMN
756843 => m x -> m (NP I xs)
757844replicateMN mx = hsequence' $
758845 hcpure (Proxy :: Proxy ((~) x)) (Comp (I <$> mx))
846+
847+getOid :: LibPQ.Oid -> Word32
848+getOid (LibPQ.Oid (CUInt oid)) = oid
squeal-postgresql/src/Squeal/PostgreSQL/Definition.hs+1
@@ -27,6 +27,7 @@ Squeal data definition language.
2727 , TypeInType
2828 , TypeOperators
2929 , UndecidableSuperClasses
30+ , UndecidableInstances
3031#-}
3132
3233module Squeal.PostgreSQL.Definition
squeal-postgresql/src/Squeal/PostgreSQL/Definition/Table.hs+27−4
@@ -35,7 +35,9 @@ module Squeal.PostgreSQL.Definition.Table
3535 , dropTable
3636 , dropTableIfExists
3737 , alterTable
38+ , alterTableIfExists
3839 , alterTableRename
40+ , alterTableIfExistsRename
3941 , AlterTable (..)
4042 , addConstraint
4143 , dropConstraint
@@ -60,9 +62,9 @@ import qualified GHC.Generics as GHC
6062
6163import Squeal.PostgreSQL.Alias
6264import Squeal.PostgreSQL.Definition
63−import Squeal.PostgreSQL.Definition.Table.Column
6465import Squeal.PostgreSQL.Definition.Table.Constraint
6566import Squeal.PostgreSQL.Expression
67+import Squeal.PostgreSQL.Expression.Type
6668import Squeal.PostgreSQL.List
6769import Squeal.PostgreSQL.Render
6870import Squeal.PostgreSQL.Schema
@@ -202,16 +204,28 @@ dropTableIfExists tab = UnsafeDefinition $ "DROP TABLE IF EXISTS" <+> renderSQL
202204
203205-- | `alterTable` changes the definition of a table from the schema.
204206alterTable
205− :: (Has sch schemas schema, Has tab schema ('Table table0))
207+ :: (Has sch schemas schema, KnownSymbol tab)
206208 => QualifiedAlias sch tab -- ^ table to alter
207− -> AlterTable sch tab schemas table1 -- ^ alteration to perform
208− -> Definition schemas (Alter sch (Alter tab ('Table table1) schema) schemas)
209+ -> AlterTable sch tab schemas table -- ^ alteration to perform
210+ -> Definition schemas (Alter sch (Alter tab ('Table table) schema) schemas)
209211alterTable tab alteration = UnsafeDefinition $
210212 "ALTER TABLE"
211213 <+> renderSQL tab
212214 <+> renderAlterTable alteration
213215 <> ";"
214216
217+-- | `alterTable` changes the definition of a table from the schema.
218+alterTableIfExists
219+ :: (Has sch schemas schema, KnownSymbol tab)
220+ => QualifiedAlias sch tab -- ^ table to alter
221+ -> AlterTable sch tab schemas table -- ^ alteration to perform
222+ -> Definition schemas (Alter sch (AlterIfExists tab ('Table table) schema) schemas)
223+alterTableIfExists tab alteration = UnsafeDefinition $
224+ "ALTER TABLE IF EXISTS"
225+ <+> renderSQL tab
226+ <+> renderAlterTable alteration
227+ <> ";"
228+
215229-- | `alterTableRename` changes the name of a table from the schema.
216230--
217231-- >>> printSQL $ alterTableRename #foo #bar
@@ -225,6 +239,15 @@ alterTableRename tab0 tab1 = UnsafeDefinition $
225239 "ALTER TABLE" <+> renderSQL tab0
226240 <+> "RENAME TO" <+> renderSQL tab1 <> ";"
227241
242+alterTableIfExistsRename
243+ :: (KnownSymbol tab0, KnownSymbol tab1)
244+ => Alias tab0 -- ^ table to rename
245+ -> Alias tab1 -- ^ what to rename it
246+ -> Definition schema (RenameIfExists tab0 tab1 schema)
247+alterTableIfExistsRename tab0 tab1 = UnsafeDefinition $
248+ "ALTER TABLE IF EXISTS" <+> renderSQL tab0
249+ <+> "RENAME TO" <+> renderSQL tab1 <> ";"
250+
228251-- | An `AlterTable` describes the alteration to perform on the columns
229252-- of a table.
230253newtype AlterTable
squeal-postgresql/src/Squeal/PostgreSQL/Definition/Table/Column.hsdeleted−105
@@ -1,105 +0,0 @@
1−{-|
2−Module: Squeal.PostgreSQL.Definition.Table.Column
3−Description: Column type expressions
4−Copyright: (c) Eitan Chatav, 2017
5−Maintainer: eitan@morphism.tech
6−Stability: experimental
7−
8−Column type expressions.
9−-}
10−
11−{-# LANGUAGE
12− AllowAmbiguousTypes
13− , ConstraintKinds
14− , DeriveAnyClass
15− , DeriveGeneric
16− , DerivingStrategies
17− , FlexibleContexts
18− , FlexibleInstances
19− , GADTs
20− , LambdaCase
21− , MultiParamTypeClasses
22− , OverloadedLabels
23− , OverloadedStrings
24− , RankNTypes
25− , ScopedTypeVariables
26− , TypeApplications
27− , TypeInType
28− , TypeOperators
29− , UndecidableSuperClasses
30−#-}
31−
32−module Squeal.PostgreSQL.Definition.Table.Column
33− ( ColumnTypeExpression (..)
34− , nullable
35− , notNullable
36− , default_
37− , serial2
38− , smallserial
39− , serial4
40− , serial
41− , serial8
42− , bigserial
43− ) where
44−
45−import Control.DeepSeq
46−import Data.ByteString
47−
48−import qualified GHC.Generics as GHC
49−
50−import Squeal.PostgreSQL.Alias
51−import Squeal.PostgreSQL.Expression
52−import Squeal.PostgreSQL.Expression.Type
53−import Squeal.PostgreSQL.Render
54−import Squeal.PostgreSQL.Schema
55−
56−-- $setup
57−-- >>> import Squeal.PostgreSQL
58−
59−-- | `ColumnTypeExpression`s are used in `createTable` commands.
60−newtype ColumnTypeExpression (schemas :: SchemasType) (ty :: ColumnType)
61− = UnsafeColumnTypeExpression { renderColumnTypeExpression :: ByteString }
62− deriving (GHC.Generic,Show,Eq,Ord,NFData)
63−instance RenderSQL (ColumnTypeExpression schemas ty) where
64− renderSQL = renderColumnTypeExpression
65−
66−-- | used in `createTable` commands as a column constraint to note that
67−-- @NULL@ may be present in a column
68−nullable
69− :: TypeExpression schemas (nullity ty)
70− -> ColumnTypeExpression schemas ('NoDef :=> 'Null ty)
71−nullable ty = UnsafeColumnTypeExpression $ renderSQL ty <+> "NULL"
72−
73−-- | used in `createTable` commands as a column constraint to ensure
74−-- @NULL@ is not present in a column
75−notNullable
76− :: TypeExpression schemas (nullity ty)
77− -> ColumnTypeExpression schemas ('NoDef :=> 'NotNull ty)
78−notNullable ty = UnsafeColumnTypeExpression $ renderSQL ty <+> "NOT NULL"
79−
80−-- | used in `createTable` commands as a column constraint to give a default
81−default_
82− :: Expression '[] '[] 'Ungrouped schemas '[] '[] ty
83− -> ColumnTypeExpression schemas ('NoDef :=> ty)
84− -> ColumnTypeExpression schemas ('Def :=> ty)
85−default_ x ty = UnsafeColumnTypeExpression $
86− renderSQL ty <+> "DEFAULT" <+> renderExpression x
87−
88−-- | not a true type, but merely a notational convenience for creating
89−-- unique identifier columns with type `PGint2`
90−serial2, smallserial
91− :: ColumnTypeExpression schemas ('Def :=> 'NotNull 'PGint2)
92−serial2 = UnsafeColumnTypeExpression "serial2"
93−smallserial = UnsafeColumnTypeExpression "smallserial"
94−-- | not a true type, but merely a notational convenience for creating
95−-- unique identifier columns with type `PGint4`
96−serial4, serial
97− :: ColumnTypeExpression schemas ('Def :=> 'NotNull 'PGint4)
98−serial4 = UnsafeColumnTypeExpression "serial4"
99−serial = UnsafeColumnTypeExpression "serial"
100−-- | not a true type, but merely a notational convenience for creating
101−-- unique identifier columns with type `PGint8`
102−serial8, bigserial
103− :: ColumnTypeExpression schemas ('Def :=> 'NotNull 'PGint8)
104−serial8 = UnsafeColumnTypeExpression "serial8"
105−bigserial = UnsafeColumnTypeExpression "bigserial"
squeal-postgresql/src/Squeal/PostgreSQL/Expression/Type.hs+101−4
@@ -23,15 +23,16 @@ Type expressions.
2323 , ScopedTypeVariables
2424 , TypeApplications
2525 , TypeOperators
26+ , UndecidableInstances
2627#-}
2728
2829module Squeal.PostgreSQL.Expression.Type
29− ( TypeExpression (..)
30− , cast
30+ ( -- * type casting
31+ cast
3132 , astype
3233 , inferredtype
33− , PGTyped (..)
34− , FieldTyped (..)
34+ -- * type expressions
35+ , TypeExpression (..)
3536 , typedef
3637 , typetable
3738 , typeview
@@ -78,6 +79,22 @@ module Squeal.PostgreSQL.Expression.Type
7879 , tsrange
7980 , tstzrange
8081 , daterange
82+ -- * column type definitions
83+ , ColumnTypeExpression (..)
84+ , nullable
85+ , notNullable
86+ , default_
87+ , serial2
88+ , smallserial
89+ , serial4
90+ , serial
91+ , serial8
92+ , bigserial
93+ , hask
94+ -- * type inference
95+ , PGTyped (..)
96+ , PGNullityTyped (..)
97+ , FieldTyped (..)
8198 ) where
8299
83100import Control.DeepSeq
@@ -91,6 +108,7 @@ import qualified Generics.SOP as SOP
91108
92109import Squeal.PostgreSQL.Alias
93110import Squeal.PostgreSQL.Expression
111+import Squeal.PostgreSQL.PG
94112import Squeal.PostgreSQL.Render
95113import Squeal.PostgreSQL.Schema
96114
@@ -132,6 +150,7 @@ astype = cast
132150inferredtype
133151 :: PGTyped schemas ty
134152 => Expression outer common grp schemas params from ty
153+ -- ^ value
135154 -> Expression outer common grp schemas params from ty
136155inferredtype = astype pgtype
137156
@@ -151,6 +170,7 @@ instance RenderSQL (TypeExpression schemas ty) where
151170typedef
152171 :: (Has sch schemas schema, Has td schema ('Typedef ty))
153172 => QualifiedAlias sch td
173+ -- ^ type alias
154174 -> TypeExpression schemas (null ty)
155175typedef = UnsafeTypeExpression . renderSQL
156176
@@ -159,6 +179,7 @@ typedef = UnsafeTypeExpression . renderSQL
159179typetable
160180 :: (Has sch schemas schema, Has tab schema ('Table table))
161181 => QualifiedAlias sch tab
182+ -- ^ table alias
162183 -> TypeExpression schemas (null ('PGcomposite (TableToRow table)))
163184typetable = UnsafeTypeExpression . renderSQL
164185
@@ -167,6 +188,7 @@ typetable = UnsafeTypeExpression . renderSQL
167188typeview
168189 :: (Has sch schemas schema, Has vw schema ('View view))
169190 => QualifiedAlias sch vw
191+ -- ^ view alias
170192 -> TypeExpression schemas (null ('PGcomposite view))
171193typeview = UnsafeTypeExpression . renderSQL
172194
@@ -340,6 +362,12 @@ instance (SOP.All KnownNat dims, PGTyped schemas ty)
340362instance PGTyped schemas (null 'PGtsvector) where pgtype = tsvector
341363instance PGTyped schemas (null 'PGtsquery) where pgtype = tsquery
342364instance PGTyped schemas (null 'PGoid) where pgtype = oid
365+instance PGTyped schemas (null ('PGrange 'PGint4)) where pgtype = int4range
366+instance PGTyped schemas (null ('PGrange 'PGint8)) where pgtype = int8range
367+instance PGTyped schemas (null ('PGrange 'PGnumeric)) where pgtype = numrange
368+instance PGTyped schemas (null ('PGrange 'PGtimestamp)) where pgtype = tsrange
369+instance PGTyped schemas (null ('PGrange 'PGtimestamptz)) where pgtype = tstzrange
370+instance PGTyped schemas (null ('PGrange 'PGdate)) where pgtype = daterange
343371
344372-- | Lift `PGTyped` to a field
345373class FieldTyped schemas ty where
@@ -347,3 +375,72 @@ class FieldTyped schemas ty where
347375instance (KnownSymbol alias, PGTyped schemas ty)
348376 => FieldTyped schemas (alias ::: ty) where
349377 fieldtype = pgtype `As` Alias
378+
379+-- | `ColumnTypeExpression`s are used in `createTable` commands.
380+newtype ColumnTypeExpression (schemas :: SchemasType) (ty :: ColumnType)
381+ = UnsafeColumnTypeExpression { renderColumnTypeExpression :: ByteString }
382+ deriving (GHC.Generic,Show,Eq,Ord,NFData)
383+instance RenderSQL (ColumnTypeExpression schemas ty) where
384+ renderSQL = renderColumnTypeExpression
385+
386+-- | used in `createTable` commands as a column constraint to note that
387+-- @NULL@ may be present in a column
388+nullable
389+ :: TypeExpression schemas (nullity ty)
390+ -> ColumnTypeExpression schemas ('NoDef :=> 'Null ty)
391+nullable ty = UnsafeColumnTypeExpression $ renderSQL ty <+> "NULL"
392+
393+-- | used in `createTable` commands as a column constraint to ensure
394+-- @NULL@ is not present in a column
395+notNullable
396+ :: TypeExpression schemas (nullity ty)
397+ -> ColumnTypeExpression schemas ('NoDef :=> 'NotNull ty)
398+notNullable ty = UnsafeColumnTypeExpression $ renderSQL ty <+> "NOT NULL"
399+
400+-- | used in `createTable` commands as a column constraint to give a default
401+default_
402+ :: Expression '[] '[] 'Ungrouped schemas '[] '[] ty
403+ -> ColumnTypeExpression schemas ('NoDef :=> ty)
404+ -> ColumnTypeExpression schemas ('Def :=> ty)
405+default_ x ty = UnsafeColumnTypeExpression $
406+ renderSQL ty <+> "DEFAULT" <+> renderExpression x
407+
408+-- | not a true type, but merely a notational convenience for creating
409+-- unique identifier columns with type `PGint2`
410+serial2, smallserial
411+ :: ColumnTypeExpression schemas ('Def :=> 'NotNull 'PGint2)
412+serial2 = UnsafeColumnTypeExpression "serial2"
413+smallserial = UnsafeColumnTypeExpression "smallserial"
414+-- | not a true type, but merely a notational convenience for creating
415+-- unique identifier columns with type `PGint4`
416+serial4, serial
417+ :: ColumnTypeExpression schemas ('Def :=> 'NotNull 'PGint4)
418+serial4 = UnsafeColumnTypeExpression "serial4"
419+serial = UnsafeColumnTypeExpression "serial"
420+-- | not a true type, but merely a notational convenience for creating
421+-- unique identifier columns with type `PGint8`
422+serial8, bigserial
423+ :: ColumnTypeExpression schemas ('Def :=> 'NotNull 'PGint8)
424+serial8 = UnsafeColumnTypeExpression "serial8"
425+bigserial = UnsafeColumnTypeExpression "bigserial"
426+
427+-- | Like @PGTyped@ but also accounts for nullity.
428+class PGNullityTyped schemas (nullty :: NullityType) where
429+ pgNullityType :: ColumnTypeExpression schemas ('NoDef :=> nullty)
430+
431+instance PGTyped schemas ('Null ty) => PGNullityTyped schemas ('Null ty) where
432+ pgNullityType = nullable (pgtype @_ @('Null ty))
433+
434+instance PGTyped schemas ('NotNull ty) => PGNullityTyped schemas ('NotNull ty) where
435+ pgNullityType = notNullable (pgtype @_ @('NotNull ty))
436+
437+-- | Allow you to specify pg column types in relation to haskell types.
438+-- >>> printSQL $ hask @(Maybe String)
439+-- text NULL
440+--
441+-- >>> printSQL $ hask @Double
442+-- float8 NOT NULL
443+hask
444+ :: forall hask schemas. PGNullityTyped schemas (NullPG hask)
445+ => ColumnTypeExpression schemas ('NoDef :=> NullPG hask)
446+hask = pgNullityType
squeal-postgresql/src/Squeal/PostgreSQL/List.hs+11−2
@@ -84,7 +84,12 @@ infixl 9 *:
8484-- | @Elem@ is a promoted `Data.List.elem`.
8585type family Elem x xs where
8686 Elem x '[] = 'False
87− Elem x (x ': xs) = 'True
87+ Elem x (x ': _) = 'True
88+ Elem x (_ ': x ': _) = 'True
89+ Elem x (_ ': _ ': x ': _) = 'True
90+ Elem x (_ ': _ ': _ ': x ': _) = 'True
91+ Elem x (_ ': _ ': _ ': _ ': x ': _) = 'True
92+ Elem x (_ ': _ ': _ ': _ ': _ ': x ': _) = 'True
8893 Elem x (_ ': xs) = Elem x xs
8994
9095-- | @In x xs@ is a constraint that proves that @x@ is in @xs@.
@@ -99,5 +104,9 @@ Length '[Char,String,Bool,Double] :: Nat
99104= 4
100105-}
101106type family Length (xs :: [k]) :: Nat where
102− Length (x : xs) = 1 + Length xs
107+ Length (_ ': _ ': _ ': _ ': _ : xs) = 5 + Length xs
108+ Length (_ ': _ ': _ ': _ : xs) = 4 + Length xs
109+ Length (_ ': _ ': _ : xs) = 3 + Length xs
110+ Length (_ ': _ : xs) = 2 + Length xs
111+ Length (_ : xs) = 1 + Length xs
103112 Length '[] = 0
squeal-postgresql/src/Squeal/PostgreSQL/Migration.hs−1
@@ -168,7 +168,6 @@ import Squeal.PostgreSQL.Alias
168168import Squeal.PostgreSQL.Binary
169169import Squeal.PostgreSQL.Definition
170170import Squeal.PostgreSQL.Definition.Table
171−import Squeal.PostgreSQL.Definition.Table.Column
172171import Squeal.PostgreSQL.Definition.Table.Constraint
173172import Squeal.PostgreSQL.Expression.Comparison
174173import Squeal.PostgreSQL.Expression.Parameter
squeal-postgresql/src/Squeal/PostgreSQL/PG.hs+22−12
@@ -47,7 +47,7 @@ module Squeal.PostgreSQL.PG
4747 , Enumerated (..)
4848 , VarArray (..)
4949 , FixArray (..)
50− , Oid (..)
50+ , LibPQ.Oid (..)
5151 -- * Type families
5252 , LabelsPG
5353 , DimPG
@@ -66,7 +66,6 @@ import Data.Int (Int16, Int32, Int64)
6666import Data.Scientific (Scientific)
6767import Data.Time (Day, DiffTime, LocalTime, TimeOfDay, TimeZone, UTCTime)
6868import Data.Vector (Vector)
69−import Data.Word (Word32)
7069import Data.UUID.Types (UUID)
7170import GHC.TypeLits
7271import Network.IP.Addr (NetAddr, IP)
@@ -75,6 +74,7 @@ import qualified Data.ByteString.Lazy as Lazy (ByteString)
7574import qualified Data.ByteString as Strict (ByteString)
7675import qualified Data.Text.Lazy as Lazy (Text)
7776import qualified Data.Text as Strict (Text)
77+import qualified Database.PostgreSQL.LibPQ as LibPQ
7878import qualified GHC.Generics as GHC
7979import qualified Generics.SOP as SOP
8080import qualified Generics.SOP.Record as SOP
@@ -108,7 +108,7 @@ type instance PG Int32 = 'PGint4
108108-- | `PGint8`
109109type instance PG Int64 = 'PGint8
110110-- | `PGint2`
111−type instance PG Oid = 'PGoid
111+type instance PG LibPQ.Oid = 'PGoid
112112-- | `PGnumeric`
113113type instance PG Scientific = 'PGnumeric
114114-- | `PGfloat4`
@@ -178,8 +178,16 @@ type family RowPG (hask :: Type) :: RowType where
178178
179179-- | `RowOf` applies `NullPG` to the fields of a list.
180180type family RowOf (record :: [(Symbol, Type)]) :: RowType where
181− RowOf '[] = '[]
181+ RowOf (col ::: ty ': col1 ::: ty1 ': col2 ::: ty2 ': col3 ::: ty3 ': col4 ::: ty4 ': record) =
182+ col ::: NullPG ty ': col1 ::: NullPG ty1 ': col2 ::: NullPG ty2 ': col3 ::: NullPG ty3 ': col4 ::: NullPG ty4 ': RowOf record
183+ RowOf (col ::: ty ': col1 ::: ty1 ': col2 ::: ty2 ': col3 ::: ty3 ': record) =
184+ col ::: NullPG ty ': col1 ::: NullPG ty1 ': col2 ::: NullPG ty2 ': col3 ::: NullPG ty3 ': RowOf record
185+ RowOf (col ::: ty ': col1 ::: ty1 ': col2 ::: ty2 ': record) =
186+ col ::: NullPG ty ': col1 ::: NullPG ty1 ': col2 ::: NullPG ty2 ': RowOf record
187+ RowOf (col ::: ty ': col1 ::: ty1 ': record) =
188+ col ::: NullPG ty ': col1::: NullPG ty1 ': RowOf record
182189 RowOf (col ::: ty ': record) = col ::: NullPG ty ': RowOf record
190+ RowOf '[] = '[]
183191
184192{- | `NullPG` turns a Haskell type into a `NullityType`.
185193
@@ -206,8 +214,17 @@ type family TuplePG (hask :: Type) :: [NullityType] where
206214
207215-- | `TupleOf` turns a list of Haskell `Type`s into a list of `NullityType`s.
208216type family TupleOf (tuple :: [Type]) :: [NullityType] where
209− TupleOf '[] = '[]
217+ TupleOf (hask ': hask1 ': hask2 ': hask3 ': hask4 ': hask5 ': tuple) =
218+ NullPG hask ': NullPG hask1 ': NullPG hask2 ': NullPG hask3 ': NullPG hask4 ': NullPG hask5 ': TupleOf tuple
219+ TupleOf (hask ': hask1 ': hask2 ': hask3 ': hask4 ': tuple) =
220+ NullPG hask ': NullPG hask1 ': NullPG hask2 ': NullPG hask3 ': NullPG hask4 ': TupleOf tuple
221+ TupleOf (hask ': hask1 ': hask2 ': hask3 ': tuple) =
222+ NullPG hask ': NullPG hask1 ': NullPG hask2 ': NullPG hask3 ': TupleOf tuple
223+ TupleOf (hask ': hask1 ': hask2 ': tuple) =
224+ NullPG hask ': NullPG hask1 ': NullPG hask2 ': TupleOf tuple
225+ TupleOf (hask ': hask1 ': tuple) = NullPG hask ': NullPG hask1 ': TupleOf tuple
210226 TupleOf (hask ': tuple) = NullPG hask ': TupleOf tuple
227+ TupleOf '[] = '[]
211228
212229-- | `TupleCodeOf` takes the `SOP.Code` of a haskell `Type`
213230-- and if it's a simple product returns it, otherwise giving a `TypeError`.
@@ -369,10 +386,3 @@ newtype FixArray arr = FixArray {getFixArray :: arr}
369386 deriving anyclass (SOP.HasDatatypeInfo, SOP.Generic)
370387-- | `PGfixarray` @(@`DimPG` @hask) (@`FixPG` @hask)@
371388type instance PG (FixArray hask) = 'PGfixarray (DimPG hask) (FixPG hask)
372−
373−{- | Object identifiers (`Oid`s) are used internally by PostgreSQL
374−as primary keys for various system tables.
375−-}
376−newtype Oid = Oid { getOid :: Word32 }
377− deriving stock (Eq, Ord, Show, Read, GHC.Generic)
378− deriving anyclass (SOP.HasDatatypeInfo, SOP.Generic)
squeal-postgresql/src/Squeal/PostgreSQL/PQ.hs+41−17
@@ -78,6 +78,7 @@ import UnliftIO (MonadUnliftIO (..), bracket, catch, handle, try)
7878import Data.ByteString (ByteString)
7979import Data.Foldable
8080import Data.Function ((&))
81+import Data.Functor ((<&>))
8182import Data.Kind
8283import Data.Text (pack, Text)
8384import Data.Traversable
@@ -86,6 +87,7 @@ import PostgreSQL.Binary.Encoding (encodingBytes)
8687
8788import qualified Control.Monad.Fail as Fail
8889import qualified Database.PostgreSQL.LibPQ as LibPQ
90+import qualified PostgreSQL.Binary.Encoding as Encoding
8991
9092import Squeal.PostgreSQL.Binary
9193import Squeal.PostgreSQL.Definition
@@ -315,13 +317,13 @@ a default instance.
315317-}
316318class Monad pq => MonadPQ schemas pq | pq -> schemas where
317319 manipulateParams
318− :: ToParams x params
320+ :: (ToParams x params, All OidOfParam params)
319321 => Manipulation '[] schemas params ys
320322 -- ^ `insertInto`, `update` or `deleteFrom`
321323 -> x -> pq (K LibPQ.Result ys)
322324 default manipulateParams
323325 :: (MonadTrans t, MonadPQ schemas pq1, pq ~ t pq1)
324− => ToParams x params
326+ => (ToParams x params, All OidOfParam params)
325327 => Manipulation '[] schemas params ys
326328 -- ^ `insertInto`, `update` or `deleteFrom`
327329 -> x -> pq (K LibPQ.Result ys)
@@ -329,7 +331,7 @@ class Monad pq => MonadPQ schemas pq | pq -> schemas where
329331 manipulateParams manipulation params
330332
331333 manipulateParams_
332− :: ToParams x params
334+ :: (ToParams x params, All OidOfParam params)
333335 => Manipulation '[] schemas params '[]
334336 -- ^ `insertInto`, `update` or `deleteFrom`
335337 -> x -> pq ()
@@ -342,7 +344,7 @@ class Monad pq => MonadPQ schemas pq | pq -> schemas where
342344 manipulate_ = void . manipulate
343345
344346 runQueryParams
345− :: ToParams x params
347+ :: (ToParams x params, All OidOfParam params)
346348 => Query '[] '[] schemas params ys
347349 -- ^ `select` and friends
348350 -> x -> pq (K LibPQ.Result ys)
@@ -355,19 +357,19 @@ class Monad pq => MonadPQ schemas pq | pq -> schemas where
355357 runQuery q = runQueryParams q ()
356358
357359 traversePrepared
358− :: (ToParams x params, Traversable list)
360+ :: (ToParams x params, Traversable list, All OidOfParam params)
359361 => Manipulation '[] schemas params ys
360362 -- ^ `insertInto`, `update`, or `deleteFrom`, and friends
361363 -> list x -> pq (list (K LibPQ.Result ys))
362364 default traversePrepared
363365 :: (MonadTrans t, MonadPQ schemas pq1, pq ~ t pq1)
364− => (ToParams x params, Traversable list)
366+ => (ToParams x params, Traversable list, All OidOfParam params)
365367 => Manipulation '[] schemas params ys -> list x -> pq (list (K LibPQ.Result ys))
366368 traversePrepared manipulation params = lift $
367369 traversePrepared manipulation params
368370
369371 forPrepared
370− :: (ToParams x params, Traversable list)
372+ :: (ToParams x params, Traversable list, All OidOfParam params)
371373 => list x
372374 -> Manipulation '[] schemas params ys
373375 -- ^ `insertInto`, `update` or `deleteFrom`
@@ -375,13 +377,13 @@ class Monad pq => MonadPQ schemas pq | pq -> schemas where
375377 forPrepared = flip traversePrepared
376378
377379 traversePrepared_
378− :: (ToParams x params, Foldable list)
380+ :: (ToParams x params, Foldable list, All OidOfParam params)
379381 => Manipulation '[] schemas params '[]
380382 -- ^ `insertInto`, `update` or `deleteFrom`
381383 -> list x -> pq ()
382384 default traversePrepared_
383385 :: (MonadTrans t, MonadPQ schemas pq1, pq ~ t pq1)
384− => (ToParams x params, Foldable list)
386+ => (ToParams x params, Foldable list, All OidOfParam params)
385387 => Manipulation '[] schemas params '[]
386388 -- ^ `insertInto`, `update` or `deleteFrom`
387389 -> list x -> pq ()
@@ -389,7 +391,7 @@ class Monad pq => MonadPQ schemas pq | pq -> schemas where
389391 traversePrepared_ manipulation params
390392
391393 forPrepared_
392− :: (ToParams x params, Foldable list)
394+ :: (ToParams x params, Foldable list, All OidOfParam params)
393395 => list x
394396 -> Manipulation '[] schemas params '[]
395397 -- ^ `insertInto`, `update` or `deleteFrom`
@@ -409,9 +411,17 @@ instance (MonadIO io, schemas0 ~ schemas, schemas1 ~ schemas)
409411 (UnsafeManipulation q :: Manipulation '[] schemas ps ys) (params :: x) =
410412 PQ $ \ (K conn) -> do
411413 let
412− toParam' encoding =
413− (LibPQ.invalidOid, encodingBytes encoding, LibPQ.Binary)
414− params' = fmap (fmap toParam') (hcollapse (toParams @x @ps params))
414+ paramSet
415+ :: forall param. OidOfParam param
416+ => K (Maybe Encoding.Encoding) param
417+ -> K (Maybe (LibPQ.Oid, ByteString, LibPQ.Format)) param
418+ paramSet (K maybeEncoding) = K $
419+ maybeEncoding <&> \encoding ->
420+ (oidOfParam @param, encodingBytes encoding, LibPQ.Binary)
421+ params'
422+ = hcollapse
423+ . hcmap (Proxy @OidOfParam) paramSet
424+ $ toParams @x @ps params
415425 q' = q <> ";"
416426 resultMaybe <- liftIO $ LibPQ.execParams conn q' params' LibPQ.Binary
417427 case resultMaybe of
@@ -424,8 +434,15 @@ instance (MonadIO io, schemas0 ~ schemas, schemas1 ~ schemas)
424434 traversePrepared
425435 (UnsafeManipulation q :: Manipulation '[] schemas xs ys) (list :: list x) =
426436 PQ $ \ (K conn) -> liftIO $ do
427− let temp = "temporary_statement"
428− prepResultMaybe <- LibPQ.prepare conn temp q Nothing
437+ let
438+ temp = "temporary_statement"
439+ paramOid :: forall p. OidOfParam p => K LibPQ.Oid p
440+ paramOid = K (oidOfParam @p)
441+ paramOids :: NP (K LibPQ.Oid) xs
442+ paramOids = hcpure (Proxy @OidOfParam) paramOid
443+ paramOids' :: [LibPQ.Oid]
444+ paramOids' = hcollapse paramOids
445+ prepResultMaybe <- LibPQ.prepare conn temp q (Just paramOids')
429446 case prepResultMaybe of
430447 Nothing -> throw $ ResultException
431448 "traversePrepared: LibPQ.prepare returned no results"
@@ -451,8 +468,15 @@ instance (MonadIO io, schemas0 ~ schemas, schemas1 ~ schemas)
451468 traversePrepared_
452469 (UnsafeManipulation q :: Manipulation '[] schemas xs '[]) (list :: list x) =
453470 PQ $ \ (K conn) -> liftIO $ do
454− let temp = "temporary_statement"
455− prepResultMaybe <- LibPQ.prepare conn temp q Nothing
471+ let
472+ temp = "temporary_statement"
473+ paramOid :: forall p. OidOfParam p => K LibPQ.Oid p
474+ paramOid = K (oidOfParam @p)
475+ paramOids :: NP (K LibPQ.Oid) xs
476+ paramOids = hcpure (Proxy @OidOfParam) paramOid
477+ paramOids' :: [LibPQ.Oid]
478+ paramOids' = hcollapse paramOids
479+ prepResultMaybe <- LibPQ.prepare conn temp q (Just paramOids')
456480 case prepResultMaybe of
457481 Nothing -> throw $ ResultException
458482 "traversePrepared_: LibPQ.prepare returned no results"
squeal-postgresql/src/Squeal/PostgreSQL/Query.hs+33−25
@@ -554,9 +554,9 @@ select_ = select . List
554554-- be subject to the elimination of duplicate rows using `selectDistinct`.
555555selectDistinct
556556 :: (SListI columns, columns ~ (col ': cols))
557− => Selection outer commons 'Ungrouped schemas params from columns
557+ => Selection outer commons grp schemas params from columns
558558 -- ^ selection
559− -> TableExpression outer commons 'Ungrouped schemas params from
559+ -> TableExpression outer commons grp schemas params from
560560 -- ^ intermediate virtual table
561561 -> Query outer commons schemas params columns
562562selectDistinct selection tabexpr = UnsafeQuery $
@@ -568,9 +568,9 @@ selectDistinct selection tabexpr = UnsafeQuery $
568568-- of a general `Selection`.
569569selectDistinct_
570570 :: (SListI columns, columns ~ (col ': cols))
571− => NP (Aliased (Expression outer commons 'Ungrouped schemas params from)) columns
571+ => NP (Aliased (Expression outer commons grp schemas params from)) columns
572572 -- ^ select list
573− -> TableExpression outer commons 'Ungrouped schemas params from
573+ -> TableExpression outer commons grp schemas params from
574574 -- ^ intermediate virtual table
575575 -> Query outer commons schemas params columns
576576selectDistinct_ = selectDistinct . List
@@ -580,14 +580,21 @@ selectDistinct_ = selectDistinct . List
580580the given expressions evaluate to equal. The DISTINCT ON expressions are
581581interpreted using the same rules as for ORDER BY. ORDER BY is used to
582582ensure that the desired row appears first.
583+
584+The DISTINCT ON expression(s) must match the leftmost ORDER BY expression(s).
585+The ORDER BY clause will normally contain additional expression(s) that
586+determine the desired precedence of rows within each DISTINCT ON group.
587+
588+In order to guarantee they match and reduce redundancy, this function
589+will prepend the The DISTINCT ON expressions to the ORDER BY clause.
583590-}
584591selectDistinctOn
585592 :: (SListI columns, columns ~ (col ': cols))
586− => [SortExpression outer commons 'Ungrouped schemas params from]
587− -- ^ distinct on and return the first row in ordering
588− -> Selection outer commons 'Ungrouped schemas params from columns
593+ => [SortExpression outer commons grp schemas params from]
594+ -- ^ DISTINCT ON expression(s) and prepended to ORDER BY clause
595+ -> Selection outer commons grp schemas params from columns
589596 -- ^ selection
590− -> TableExpression outer commons 'Ungrouped schemas params from
597+ -> TableExpression outer commons grp schemas params from
591598 -- ^ intermediate virtual table
592599 -> Query outer commons schemas params columns
593600selectDistinctOn distincts selection tab = UnsafeQuery $
@@ -608,11 +615,11 @@ selectDistinctOn distincts selection tab = UnsafeQuery $
608615-- of a general `Selection`.
609616selectDistinctOn_
610617 :: (SListI columns, columns ~ (col ': cols))
611− => [SortExpression outer commons 'Ungrouped schemas params from]
618+ => [SortExpression outer commons grp schemas params from]
612619 -- ^ distinct on and return the first row in ordering
613− -> NP (Aliased (Expression outer commons 'Ungrouped schemas params from)) columns
620+ -> NP (Aliased (Expression outer commons grp schemas params from)) columns
614621 -- ^ selection
615− -> TableExpression outer commons 'Ungrouped schemas params from
622+ -> TableExpression outer commons grp schemas params from
616623 -- ^ intermediate virtual table
617624 -> Query outer commons schemas params columns
618625selectDistinctOn_ distincts = selectDistinctOn distincts . List
@@ -750,7 +757,7 @@ instance RenderSQL (TableExpression outer commons grp schemas params from) where
750757from
751758 :: FromClause outer commons schemas params from -- ^ table reference
752759 -> TableExpression outer commons 'Ungrouped schemas params from
753−from tab = TableExpression tab [] NoGroups NoHaving [] [] []
760+from tab = TableExpression tab [] noGroups NoHaving [] [] []
754761
755762-- | A `where_` is an endomorphism of `TableExpression`s which adds a
756763-- search condition to the `whereClause`.
@@ -771,7 +778,7 @@ groupBy
771778groupBy bys rels = TableExpression
772779 { fromClause = fromClause rels
773780 , whereClause = whereClause rels
774− , groupByClause = Group bys
781+ , groupByClause = group bys
775782 , havingClause = Having []
776783 , orderByClause = []
777784 , limitClause = limitClause rels
@@ -985,19 +992,20 @@ instance (Has rel rels cols, Has col cols ty, bys ~ '[ '(rel, col)])
985992-- done on @NoGroups@ while all output `Expression`s must be aggregated
986993-- in @Group Nil@. In general, all output `Expression`s in the
987994-- complement of @bys@ must be aggregated in @Group bys@.
988−data GroupByClause grp from where
989− NoGroups :: GroupByClause 'Ungrouped from
990− Group
991− :: SListI bys
992− => NP (By from) bys
993− -> GroupByClause ('Grouped bys) from
994−
995−-- | Renders a `GroupByClause`.
995+newtype GroupByClause grp from = UnsafeGroupByClause
996+ { renderGroupByClause :: ByteString }
997+ deriving (GHC.Generic,Show,Eq,Ord,NFData)
996998instance RenderSQL (GroupByClause grp from) where
997− renderSQL = \case
998− NoGroups -> ""
999− Group Nil -> ""
1000− Group bys -> " GROUP BY" <+> renderCommaSeparated renderSQL bys
999+ renderSQL = renderGroupByClause
1000+noGroups :: GroupByClause 'Ungrouped from
1001+noGroups = UnsafeGroupByClause ""
1002+group
1003+ :: SListI bys
1004+ => NP (By from) bys
1005+ -> GroupByClause ('Grouped bys) from
1006+group bys = UnsafeGroupByClause $ case bys of
1007+ Nil -> ""
1008+ bys' -> " GROUP BY" <+> renderCommaSeparated renderSQL bys'
10011009
10021010-- | A `HavingClause` is used to eliminate groups that are not of interest.
10031011-- An `Ungrouped` `TableExpression` may only use `NoHaving` while a `Grouped`
squeal-postgresql/src/Squeal/PostgreSQL/Schema.hs+67−7
@@ -69,7 +69,9 @@ module Squeal.PostgreSQL.Schema
6969 , DropIfExists
7070 , DropSchemumIfExists
7171 , Alter
72+ , AlterIfExists
7273 , Rename
74+ , RenameIfExists
7375 , ConstraintInvolves
7476 , DropIfConstraintsInvolve
7577 , IsNotElem
@@ -258,9 +260,19 @@ type FromType = [(Symbol,RowType)]
258260
259261-- | `ColumnsToRow` removes column constraints.
260262type family ColumnsToRow (columns :: ColumnsType) :: RowType where
261− ColumnsToRow '[] = '[]
262− ColumnsToRow (column ::: constraint :=> ty ': columns) =
263+ ColumnsToRow (column ::: _ :=> ty ': column1 ::: _ :=> ty1 ': column2 ::: _ :=> ty2 ': column3 ::: _ :=> ty3 ': column4 ::: _ :=> ty4 ': column5 ::: _ :=> ty5 ': columns) =
264+ column ::: ty ': column1 ::: ty1 ': column2 ::: ty2 ': column3 ::: ty3 ': column4 ::: ty4 ': column5 ::: ty5 ': ColumnsToRow columns
265+ ColumnsToRow (column ::: _ :=> ty ': column1 ::: _ :=> ty1 ': column2 ::: _ :=> ty2 ': column3 ::: _ :=> ty3 ': column4 ::: _ :=> ty4 ': columns) =
266+ column ::: ty ': column1 ::: ty1 ': column2 ::: ty2 ': column3 ::: ty3 ': column4 ::: ty4 ': ColumnsToRow columns
267+ ColumnsToRow (column ::: _ :=> ty ': column1 ::: _ :=> ty1 ': column2 ::: _ :=> ty2 ': column3 ::: _ :=> ty3 ': columns) =
268+ column ::: ty ': column1 ::: ty1 ': column2 ::: ty2 ': column3 ::: ty3 ': ColumnsToRow columns
269+ ColumnsToRow (column ::: _ :=> ty ': column1 ::: _ :=> ty1 ': column2 ::: _ :=> ty2 ': columns) =
270+ column ::: ty ': column1 ::: ty1 ': column2 ::: ty2 ': ColumnsToRow columns
271+ ColumnsToRow (column ::: _ :=> ty ': column1 ::: _ :=> ty1 ': columns) =
272+ column ::: ty ': column1 ::: ty1 ': ColumnsToRow columns
273+ ColumnsToRow (column ::: _ :=> ty ': columns) =
263274 column ::: ty ': ColumnsToRow columns
275+ ColumnsToRow '[] = '[]
264276
265277-- | `TableToColumns` removes table constraints.
266278type family TableToColumns (table :: TableType) :: ColumnsType where
@@ -293,14 +305,24 @@ instance ty0 ~ ty1 => SamePGType
293305
294306-- | `AllNotNull` is a constraint that proves a `ColumnsType` has no @NULL@s.
295307type family AllNotNull (columns :: ColumnsType) :: Constraint where
308+ AllNotNull (_ ::: _ :=> 'NotNull _ ': _ ::: _ :=> 'NotNull _ ': _ ::: _ :=> 'NotNull _ ': _ ::: _ :=> 'NotNull _ ': _ ::: _ :=> 'NotNull _ ': _ ::: _ :=> 'NotNull _ ': columns) = AllNotNull columns
309+ AllNotNull (_ ::: _ :=> 'NotNull _ ': _ ::: _ :=> 'NotNull _ ': _ ::: _ :=> 'NotNull _ ': _ ::: _ :=> 'NotNull _ ': _ ::: _ :=> 'NotNull _ ': columns) = AllNotNull columns
310+ AllNotNull (_ ::: _ :=> 'NotNull _ ': _ ::: _ :=> 'NotNull _ ': _ ::: _ :=> 'NotNull _ ': _ ::: _ :=> 'NotNull _ ': columns) = AllNotNull columns
311+ AllNotNull (_ ::: _ :=> 'NotNull _ ': _ ::: _ :=> 'NotNull _ ': _ ::: _ :=> 'NotNull _ ': columns) = AllNotNull columns
312+ AllNotNull (_ ::: _ :=> 'NotNull _ ': _ ::: _ :=> 'NotNull _ ': columns) = AllNotNull columns
313+ AllNotNull (_ ::: _ :=> 'NotNull _ ': columns) = AllNotNull columns
296314 AllNotNull '[] = ()
297− AllNotNull (column ::: def :=> 'NotNull ty ': columns) = AllNotNull columns
298315
299316-- | `NotAllNull` is a constraint that proves a `ColumnsType` has some
300317-- @NOT NULL@.
301318type family NotAllNull (columns :: ColumnsType) :: Constraint where
302− NotAllNull (column ::: def :=> 'NotNull ty ': columns) = ()
303− NotAllNull (column ::: def :=> 'Null ty ': columns) = NotAllNull columns
319+ NotAllNull (_ ::: _ :=> _ _ ': _ ::: _ :=> _ _ ': _ ::: _ :=> _ _ ': _ ::: _ :=> _ _ ': _ ::: _ :=> _ _ ': _ ::: _ :=> 'NotNull _ ': _) = ()
320+ NotAllNull (_ ::: _ :=> _ _ ': _ ::: _ :=> _ _ ': _ ::: _ :=> _ _ ': _ ::: _ :=> _ _ ': _ ::: _ :=> 'NotNull _ ': _) = ()
321+ NotAllNull (_ ::: _ :=> _ _ ': _ ::: _ :=> _ _ ': _ ::: _ :=> _ _ ': _ ::: _ :=> 'NotNull _ ': _) = ()
322+ NotAllNull (_ ::: _ :=> _ _ ': _ ::: _ :=> _ _ ': _ ::: _ :=> 'NotNull _ ': _) = ()
323+ NotAllNull (_ ::: _ :=> _ _ ': _ ::: _ :=> 'NotNull _ ': _) = ()
324+ NotAllNull (_ ::: _ :=> 'NotNull _ ': _) = ()
325+ NotAllNull (_ ::: _ :=> 'Null _ ': columns) = NotAllNull columns
304326
305327-- | `NullifyType` is an idempotent that nullifies a `NullityType`.
306328type family NullifyType (ty :: NullityType) :: NullityType where
@@ -309,17 +331,37 @@ type family NullifyType (ty :: NullityType) :: NullityType where
309331
310332-- | `NullifyRow` is an idempotent that nullifies a `RowType`.
311333type family NullifyRow (columns :: RowType) :: RowType where
312− NullifyRow '[] = '[]
334+ NullifyRow (column ::: ty ': column1 ::: ty1 ': column2 ::: ty2 ': column3 ::: ty3 ': column4 ::: ty4 ': column5 ::: ty5 ': columns) =
335+ column ::: NullifyType ty ': column1 ::: NullifyType ty1 ': column2 ::: NullifyType ty2 ': column3 ::: NullifyType ty3 ': column4 ::: NullifyType ty4 ': column5 ::: NullifyType ty5 ': NullifyRow columns
336+ NullifyRow (column ::: ty ': column1 ::: ty1 ': column2 ::: ty2 ': column3 ::: ty3 ': column4 ::: ty4 ': columns) =
337+ column ::: NullifyType ty ': column1 ::: NullifyType ty1 ': column2 ::: NullifyType ty2 ': column3 ::: NullifyType ty3 ': column4 ::: NullifyType ty4 ': NullifyRow columns
338+ NullifyRow (column ::: ty ': column1 ::: ty1 ': column2 ::: ty2 ': column3 ::: ty3 ': columns) =
339+ column ::: NullifyType ty ': column1 ::: NullifyType ty1 ': column2 ::: NullifyType ty2 ': column3 ::: NullifyType ty3 ': NullifyRow columns
340+ NullifyRow (column ::: ty ': column1 ::: ty1 ': column2 ::: ty2 ': columns) =
341+ column ::: NullifyType ty ': column1 ::: NullifyType ty1 ': column2 ::: NullifyType ty2 ': NullifyRow columns
342+ NullifyRow (column ::: ty ': column1 ::: ty1 ': columns) =
343+ column ::: NullifyType ty ': column1 ::: NullifyType ty1 ': NullifyRow columns
313344 NullifyRow (column ::: ty ': columns) =
314345 column ::: NullifyType ty ': NullifyRow columns
346+ NullifyRow '[] = '[]
315347
316348-- | `NullifyFrom` is an idempotent that nullifies a `FromType`
317349-- used to nullify the left or right hand side of an outer join
318350-- in a `Squeal.PostgreSQL.Query.FromClause`.
319351type family NullifyFrom (tables :: FromType) :: FromType where
320− NullifyFrom '[] = '[]
352+ NullifyFrom (table ::: columns ': table1 ::: columns1 ': table2 ::: columns2 ': table3 ::: columns3 ': table4 ::: columns4 ': table5 ::: columns5 ': tables) =
353+ table ::: NullifyRow columns ': table1 ::: NullifyRow columns1 ': table2 ::: NullifyRow columns2 ': table3 ::: NullifyRow columns3 ': table4 ::: NullifyRow columns5 ': table5 ::: NullifyRow columns4 ': NullifyFrom tables
354+ NullifyFrom (table ::: columns ': table1 ::: columns1 ': table2 ::: columns2 ': table3 ::: columns3 ': table4 ::: columns4 ': tables) =
355+ table ::: NullifyRow columns ': table1 ::: NullifyRow columns1 ': table2 ::: NullifyRow columns2 ': table3 ::: NullifyRow columns3 ': table4 ::: NullifyRow columns4 ': NullifyFrom tables
356+ NullifyFrom (table ::: columns ': table1 ::: columns1 ': table2 ::: columns2 ': table3 ::: columns3 ': tables) =
357+ table ::: NullifyRow columns ': table1 ::: NullifyRow columns1 ': table2 ::: NullifyRow columns2 ': table3 ::: NullifyRow columns3 ': NullifyFrom tables
358+ NullifyFrom (table ::: columns ': table1 ::: columns1 ': table2 ::: columns2 ': tables) =
359+ table ::: NullifyRow columns ': table1 ::: NullifyRow columns1 ': table2 ::: NullifyRow columns2 ': NullifyFrom tables
360+ NullifyFrom (table ::: columns ': table1 ::: columns1 ': tables) =
361+ table ::: NullifyRow columns ': table1 ::: NullifyRow columns1 ': NullifyFrom tables
321362 NullifyFrom (table ::: columns ': tables) =
322363 table ::: NullifyRow columns ': NullifyFrom tables
364+ NullifyFrom '[] = '[]
323365
324366-- | @Create alias x xs@ adds @alias ::: x@ to the end of @xs@ and is used in
325367-- `Squeal.PostgreSQL.Definition.createTable` statements and in @ALTER TABLE@
@@ -396,16 +438,34 @@ type family DropSchemumIfExists alias sch xs where
396438-- with the type @x@ and is used in `Squeal.PostgreSQL.Definition.alterTable`
397439-- and `Squeal.PostgreSQL.Definition.alterColumn`.
398440type family Alter alias x xs where
441+ Alter alias x '[] = TypeError
442+ ('Text "Alter: alias "
443+ ':<>: 'ShowType alias
444+ ':<>: 'Text " does not exist" )
399445 Alter alias x1 (alias ::: x0 ': xs) = alias ::: x1 ': xs
400446 Alter alias x1 (x0 ': xs) = x0 ': Alter alias x1 xs
401447
448+type family AlterIfExists alias x xs where
449+ AlterIfExists alias x '[] = '[]
450+ AlterIfExists alias x1 (alias ::: x0 ': xs) = alias ::: x1 ': xs
451+ AlterIfExists alias x1 (x0 ': xs) = x0 ': AlterIfExists alias x1 xs
452+
402453-- | @Rename alias0 alias1 xs@ replaces the alias @alias0@ by @alias1@ in @xs@
403454-- and is used in `Squeal.PostgreSQL.Definition.alterTableRename` and
404455-- `Squeal.PostgreSQL.Definition.renameColumn`.
405456type family Rename alias0 alias1 xs where
457+ Rename alias0 alias1 '[] = TypeError
458+ ('Text "Rename: alias "
459+ ':<>: 'ShowType alias0
460+ ':<>: 'Text " does not exist" )
406461 Rename alias0 alias1 ((alias0 ::: x0) ': xs) = (alias1 ::: x0) ': xs
407462 Rename alias0 alias1 (x ': xs) = x ': Rename alias0 alias1 xs
408463
464+type family RenameIfExists alias0 alias1 xs where
465+ RenameIfExists alias x '[] = '[]
466+ RenameIfExists alias0 alias1 ((alias0 ::: x0) ': xs) = (alias1 ::: x0) ': xs
467+ RenameIfExists alias0 alias1 (x ': xs) = x ': RenameIfExists alias0 alias1 xs
468+
409469-- | Check if a `TableConstraint` involves a column
410470type family ConstraintInvolves column constraint where
411471 ConstraintInvolves column ('Check columns) = column `Elem` columns
squeal-postgresql/test/Property.hs+2−2
@@ -92,14 +92,14 @@ roundtrips = Group "roundtrips"
9292 -- genTimeWithZone = (,) <$> genTimeOfDay <*> genTimeZone
9393
9494roundtrip
95− :: (ToParam x ty, FromValue ty x, Show x, Eq x)
95+ :: (OidOf ty, ToParam x ty, FromValue ty x, Show x, Eq x)
9696 => TypeExpression schemas ('NotNull ty)
9797 -> Gen x
9898 -> (PropertyName, Property)
9999roundtrip = roundtripOn id
100100
101101roundtripOn
102− :: (ToParam x ty, FromValue ty x, Show x, Eq x)
102+ :: (OidOf ty, ToParam x ty, FromValue ty x, Show x, Eq x)
103103 => (x -> x)
104104 -> TypeExpression schemas ('NotNull ty)
105105 -> Gen x
squeal-postgresql/test/Spec.hs+11
@@ -123,3 +123,14 @@ spec = before_ setupDB . after_ dropDB $ do
123123 getRows =<< runQuery query
124124 (fromOnly <$> rangesOut :: [Range Int32]) `shouldBe`
125125 [ atLeast 3, 3 <=..< 5, Empty, whole ]
126+
127+ describe "Parameters" $ do
128+
129+ it "should run queries that don't reference all their parameters" $ do
130+
131+ out <- withConnection connectionString $ do
132+ let
133+ query :: Query_ (Public '[]) (Char,Int32) (Only Int32)
134+ query = values_ (param @2 `as` #fromOnly)
135+ firstRow =<< runQueryParams query ('a', 3 :: Int32)
136+ (fromOnly <$> out :: Maybe Int32) `shouldBe` Just 3