9ff632c · squeal · git.iko.soy

git.iko.soy/squeal

parameter oids

commit9ff632cefe6e18d5cffe1585740daa966e068f41 authorEitan Chatav <eitan@EEM109LMBP-1.local> dateWed 23 Oct 2019, 10:44 (7 years ago) parentcfb3d8c

6 files changed+176−52

compare with dev

unifiedsplit

squeal-postgresql/src/Squeal/PostgreSQL/Binary.hs+113−23 squeal-postgresql/src/Squeal/PostgreSQL/Expression/Type.hs+6 squeal-postgresql/src/Squeal/PostgreSQL/PG.hs+3−10 squeal-postgresql/src/Squeal/PostgreSQL/PQ.hs+41−17 squeal-postgresql/test/Property.hs+2−2 squeal-postgresql/test/Spec.hs+11

squeal-postgresql/src/Squeal/PostgreSQL/Binary.hs+113−23

@@ -217,6 +217,7 @@ module Squeal.PostgreSQL.Binary

217217 , Only (..)

218218 -- * Oid

219219 , HasOid (..)

220+ , HasOidParam (..)

220221 , HasAliasedOid (..)

221222 ) where

222223

@@ -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

@@ -398,29 +401,113 @@ 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

404+-- Oid 16

405+class HasOid (ty :: PGType) where oidOf :: LibPQ.Oid

406+instance HasOid 'PGbool where oidOf = LibPQ.Oid 16

407+instance HasOid ('PGfixarray ns (null 'PGbool)) where oidOf = LibPQ.Oid 1000

408+instance HasOid ('PGvararray (null 'PGbool)) where oidOf = LibPQ.Oid 1000

409+instance HasOid 'PGint2 where oidOf = LibPQ.Oid 21

410+instance HasOid ('PGfixarray ns (null 'PGint2)) where oidOf = LibPQ.Oid 1005

411+instance HasOid ('PGvararray (null 'PGint2)) where oidOf = LibPQ.Oid 1005

412+instance HasOid 'PGint4 where oidOf = LibPQ.Oid 23

413+instance HasOid ('PGfixarray ns (null 'PGint4)) where oidOf = LibPQ.Oid 1007

414+instance HasOid ('PGvararray (null 'PGint4)) where oidOf = LibPQ.Oid 1007

415+instance HasOid 'PGint8 where oidOf = LibPQ.Oid 20

416+instance HasOid ('PGfixarray ns (null 'PGint8)) where oidOf = LibPQ.Oid 1016

417+instance HasOid ('PGvararray (null 'PGint8)) where oidOf = LibPQ.Oid 1016

418+instance HasOid 'PGnumeric where oidOf = LibPQ.Oid 1700

419+instance HasOid ('PGfixarray ns (null 'PGnumeric)) where oidOf = LibPQ.Oid 1231

420+instance HasOid ('PGvararray (null 'PGnumeric)) where oidOf = LibPQ.Oid 1231

421+instance HasOid 'PGfloat4 where oidOf = LibPQ.Oid 700

422+instance HasOid ('PGfixarray ns (null 'PGfloat4)) where oidOf = LibPQ.Oid 1021

423+instance HasOid ('PGvararray (null 'PGfloat4)) where oidOf = LibPQ.Oid 1021

424+instance HasOid 'PGfloat8 where oidOf = LibPQ.Oid 701

425+instance HasOid ('PGfixarray ns (null 'PGfloat8)) where oidOf = LibPQ.Oid 1022

426+instance HasOid ('PGvararray (null 'PGfloat8)) where oidOf = LibPQ.Oid 1022

427+instance HasOid 'PGmoney where oidOf = LibPQ.Oid 790

428+instance HasOid ('PGfixarray ns (null 'PGmoney)) where oidOf = LibPQ.Oid 791

429+instance HasOid ('PGvararray (null 'PGmoney)) where oidOf = LibPQ.Oid 791

430+instance HasOid ('PGchar n) where oidOf = LibPQ.Oid 18

431+instance HasOid ('PGfixarray ns (null ('PGchar n))) where oidOf = LibPQ.Oid 1002

432+instance HasOid ('PGvararray (null ('PGchar n))) where oidOf = LibPQ.Oid 1002

433+instance HasOid ('PGvarchar n) where oidOf = LibPQ.Oid 1043

434+instance HasOid ('PGfixarray ns (null ('PGvarchar n))) where oidOf = LibPQ.Oid 1015

435+instance HasOid ('PGvararray (null ('PGvarchar n))) where oidOf = LibPQ.Oid 1015

436+instance HasOid 'PGtext where oidOf = LibPQ.Oid 25

437+instance HasOid ('PGfixarray ns (null 'PGtext)) where oidOf = LibPQ.Oid 1009

438+instance HasOid ('PGvararray (null 'PGtext)) where oidOf = LibPQ.Oid 1009

439+instance HasOid 'PGbytea where oidOf = LibPQ.Oid 17

440+instance HasOid ('PGfixarray ns (null 'PGbytea)) where oidOf = LibPQ.Oid 1001

441+instance HasOid ('PGvararray (null 'PGbytea)) where oidOf = LibPQ.Oid 1001

442+instance HasOid 'PGtimestamp where oidOf = LibPQ.Oid 1114

443+instance HasOid ('PGfixarray ns (null 'PGtimestamp)) where oidOf = LibPQ.Oid 1115

444+instance HasOid ('PGvararray (null 'PGtimestamp)) where oidOf = LibPQ.Oid 1115

445+instance HasOid 'PGtimestamptz where oidOf = LibPQ.Oid 1184

446+instance HasOid ('PGfixarray ns (null 'PGtimestamptz)) where oidOf = LibPQ.Oid 1185

447+instance HasOid ('PGvararray (null 'PGtimestamptz)) where oidOf = LibPQ.Oid 1185

448+instance HasOid 'PGdate where oidOf = LibPQ.Oid 1082

449+instance HasOid ('PGfixarray ns (null 'PGdate)) where oidOf = LibPQ.Oid 1182

450+instance HasOid ('PGvararray (null 'PGdate)) where oidOf = LibPQ.Oid 1182

451+instance HasOid 'PGtime where oidOf = LibPQ.Oid 1083

452+instance HasOid ('PGfixarray ns (null 'PGtime)) where oidOf = LibPQ.Oid 1183

453+instance HasOid ('PGvararray (null 'PGtime)) where oidOf = LibPQ.Oid 1183

454+instance HasOid 'PGtimetz where oidOf = LibPQ.Oid 1266

455+instance HasOid ('PGfixarray ns (null 'PGtimetz)) where oidOf = LibPQ.Oid 1270

456+instance HasOid ('PGvararray (null 'PGtimetz)) where oidOf = LibPQ.Oid 1270

457+instance HasOid 'PGinterval where oidOf = LibPQ.Oid 1186

458+instance HasOid ('PGfixarray ns (null 'PGinterval)) where oidOf = LibPQ.Oid 1187

459+instance HasOid ('PGvararray (null 'PGinterval)) where oidOf = LibPQ.Oid 1187

460+instance HasOid 'PGuuid where oidOf = LibPQ.Oid 2950

461+instance HasOid ('PGfixarray ns (null 'PGuuid)) where oidOf = LibPQ.Oid 2951

462+instance HasOid ('PGvararray (null 'PGuuid)) where oidOf = LibPQ.Oid 2951

463+instance HasOid 'PGinet where oidOf = LibPQ.Oid 869

464+instance HasOid ('PGfixarray ns (null 'PGinet)) where oidOf = LibPQ.Oid 1041

465+instance HasOid ('PGvararray (null 'PGinet)) where oidOf = LibPQ.Oid 1041

466+instance HasOid 'PGjson where oidOf = LibPQ.Oid 114

467+instance HasOid ('PGfixarray ns (null 'PGjson)) where oidOf = LibPQ.Oid 199

468+instance HasOid ('PGvararray (null 'PGjson)) where oidOf = LibPQ.Oid 199

469+instance HasOid 'PGjsonb where oidOf = LibPQ.Oid 3802

470+instance HasOid ('PGfixarray ns (null 'PGjsonb)) where oidOf = LibPQ.Oid 3807

471+instance HasOid ('PGvararray (null 'PGjsonb)) where oidOf = LibPQ.Oid 3807

472+instance HasOid 'PGtsvector where oidOf = LibPQ.Oid 3614

473+instance HasOid ('PGfixarray ns (null 'PGtsvector)) where oidOf = LibPQ.Oid 3643

474+instance HasOid ('PGvararray (null 'PGtsvector)) where oidOf = LibPQ.Oid 3643

475+instance HasOid 'PGtsquery where oidOf = LibPQ.Oid 3615

476+instance HasOid ('PGfixarray ns (null 'PGtsquery)) where oidOf = LibPQ.Oid 3645

477+instance HasOid ('PGvararray (null 'PGtsquery)) where oidOf = LibPQ.Oid 3645

478+instance HasOid 'PGoid where oidOf = LibPQ.Oid 26

479+instance HasOid ('PGfixarray ns (null 'PGoid)) where oidOf = LibPQ.Oid 1028

480+instance HasOid ('PGvararray (null 'PGoid)) where oidOf = LibPQ.Oid 1028

481+instance HasOid ('PGrange 'PGint4) where oidOf = LibPQ.Oid 3904

482+instance HasOid ('PGfixarray ns (null ('PGrange 'PGint4))) where oidOf = LibPQ.Oid 3905

483+instance HasOid ('PGvararray (null ('PGrange 'PGint4))) where oidOf = LibPQ.Oid 3905

484+instance HasOid ('PGrange 'PGint8) where oidOf = LibPQ.Oid 3926

485+instance HasOid ('PGfixarray ns (null ('PGrange 'PGint8))) where oidOf = LibPQ.Oid 3927

486+instance HasOid ('PGvararray (null ('PGrange 'PGint8))) where oidOf = LibPQ.Oid 3927

487+instance HasOid ('PGrange 'PGnumeric) where oidOf = LibPQ.Oid 3906

488+instance HasOid ('PGfixarray ns (null ('PGrange 'PGnumeric))) where oidOf = LibPQ.Oid 3907

489+instance HasOid ('PGvararray (null ('PGrange 'PGnumeric))) where oidOf = LibPQ.Oid 3907

490+instance HasOid ('PGrange 'PGtimestamp) where oidOf = LibPQ.Oid 3908

491+instance HasOid ('PGfixarray ns (null ('PGrange 'PGtimestamp))) where oidOf = LibPQ.Oid 3909

492+instance HasOid ('PGvararray (null ('PGrange 'PGtimestamp))) where oidOf = LibPQ.Oid 3909

493+instance HasOid ('PGrange 'PGtimestamptz) where oidOf = LibPQ.Oid 3910

494+instance HasOid ('PGfixarray ns (null ('PGrange 'PGtimestamptz))) where oidOf = LibPQ.Oid 3911

495+instance HasOid ('PGvararray (null ('PGrange 'PGtimestamptz))) where oidOf = LibPQ.Oid 3911

496+instance HasOid ('PGrange 'PGdate) where oidOf = LibPQ.Oid 3912

497+instance HasOid ('PGfixarray ns (null ('PGrange 'PGdate))) where oidOf = LibPQ.Oid 3913

498+instance HasOid ('PGvararray (null ('PGrange 'PGdate))) where oidOf = LibPQ.Oid 3913

499+instance {-# OVERLAPPABLE #-} HasOid ('PGrange ty) where oidOf = LibPQ.invalidOid

500+instance {-# OVERLAPPABLE #-} HasOid ('PGfixarray ns (null ('PGrange ty))) where oidOf = LibPQ.invalidOid

501+instance {-# OVERLAPPABLE #-} HasOid ('PGvararray (null ('PGrange ty))) where oidOf = LibPQ.invalidOid

502+instance {-# OVERLAPPABLE #-} HasOid ('PGcomposite row) where oidOf = LibPQ.invalidOid

503+instance {-# OVERLAPPABLE #-} HasOid ('PGfixarray ns (null ('PGcomposite row))) where oidOf = LibPQ.invalidOid

504+instance {-# OVERLAPPABLE #-} HasOid ('PGvararray (null ('PGcomposite row))) where oidOf = LibPQ.invalidOid

505+instance {-# OVERLAPPABLE #-} HasOid ('PGenum labels) where oidOf = LibPQ.invalidOid

506+instance {-# OVERLAPPABLE #-} HasOid ('PGfixarray ns (null ('PGenum labels))) where oidOf = LibPQ.invalidOid

507+instance {-# OVERLAPPABLE #-} HasOid ('PGvararray (null ('PGenum labels))) where oidOf = LibPQ.invalidOid

508+

509+class HasOidParam (ty :: NullityType) where oidOfParam :: Oid

510+instance HasOid ty => HasOidParam (null ty) where oidOfParam = oidOf @ty

424511

425512-- | Lifts a `HasOid` constraint to a field.

426513class HasAliasedOid (field :: (Symbol, NullityType)) where

@@ -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/Expression/Type.hs+6

@@ -340,6 +340,12 @@ instance (SOP.All KnownNat dims, PGTyped schemas ty)

340340instance PGTyped schemas (null 'PGtsvector) where pgtype = tsvector

341341instance PGTyped schemas (null 'PGtsquery) where pgtype = tsquery

342342instance PGTyped schemas (null 'PGoid) where pgtype = oid

343+instance PGTyped schemas (null ('PGrange 'PGint4)) where pgtype = int4range

344+instance PGTyped schemas (null ('PGrange 'PGint8)) where pgtype = int8range

345+instance PGTyped schemas (null ('PGrange 'PGnumeric)) where pgtype = numrange

346+instance PGTyped schemas (null ('PGrange 'PGtimestamp)) where pgtype = tsrange

347+instance PGTyped schemas (null ('PGrange 'PGtimestamptz)) where pgtype = tstzrange

348+instance PGTyped schemas (null ('PGrange 'PGdate)) where pgtype = daterange

343349

344350-- | Lift `PGTyped` to a field

345351class FieldTyped schemas ty where

squeal-postgresql/src/Squeal/PostgreSQL/PG.hs+3−10

@@ -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`

@@ -386,10 +386,3 @@ newtype FixArray arr = FixArray {getFixArray :: arr}

386386 deriving anyclass (SOP.HasDatatypeInfo, SOP.Generic)

387387-- | `PGfixarray` @(@`DimPG` @hask) (@`FixPG` @hask)@

388388type instance PG (FixArray hask) = 'PGfixarray (DimPG hask) (FixPG hask)

389−

390−{- | Object identifiers (`Oid`s) are used internally by PostgreSQL

391−as primary keys for various system tables.

392−-}

393−newtype Oid = Oid { getOid :: Word32 }

394− deriving stock (Eq, Ord, Show, Read, GHC.Generic)

395− 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 HasOidParam 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 HasOidParam 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 HasOidParam 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 HasOidParam 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 HasOidParam 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 HasOidParam 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 HasOidParam 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 HasOidParam 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 HasOidParam 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 HasOidParam 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. HasOidParam 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 @HasOidParam) 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. HasOidParam p => K LibPQ.Oid p

440+ paramOid = K (oidOfParam @p)

441+ paramOids :: NP (K LibPQ.Oid) xs

442+ paramOids = hcpure (Proxy @HasOidParam) 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. HasOidParam p => K LibPQ.Oid p

474+ paramOid = K (oidOfParam @p)

475+ paramOids :: NP (K LibPQ.Oid) xs

476+ paramOids = hcpure (Proxy @HasOidParam) 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/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+ :: (HasOid 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+ :: (HasOid 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