0e036d0...dev · squeal

git.iko.soy/squeal

13 files changed+290−209

since splitsnapshots

unifiedsplit

README.md+1−1

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

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−26

@@ -35,8 +35,6 @@ module Squeal.PostgreSQL.Definition

3535 Definition (..)

3636 , (>>>)

3737 , manipDefinition

38− , PGNullityTyped (..)

39− , hask

4038 ) where

4139

4240import Control.Category

@@ -47,10 +45,7 @@ import Prelude hiding ((.), id)

4745

4846import qualified GHC.Generics as GHC

4947

50−import Squeal.PostgreSQL.Definition.Table.Column

51−import Squeal.PostgreSQL.Expression.Type

5248import Squeal.PostgreSQL.Manipulation

53−import Squeal.PostgreSQL.PG

5449import Squeal.PostgreSQL.Render

5550import Squeal.PostgreSQL.Schema

5651

@@ -85,24 +80,3 @@ manipDefinition

8580 -- ^ no input or output

8681 -> Definition schemas schemas

8782manipDefinition = UnsafeDefinition . (<> ";") . renderSQL

88−

89−-- | Like @PGTyped@ but also accounts for nullity.

90−class PGNullityTyped schemas (nullty :: NullityType) where

91− pgNullityType :: ColumnTypeExpression schemas ('NoDef :=> nullty)

92−

93−instance PGTyped schemas ('Null ty) => PGNullityTyped schemas ('Null ty) where

94− pgNullityType = nullable (pgtype @_ @('Null ty))

95−

96−instance PGTyped schemas ('NotNull ty) => PGNullityTyped schemas ('NotNull ty) where

97− pgNullityType = notNullable (pgtype @_ @('NotNull ty))

98−

99−-- | Allow you to specify pg column types in relation to haskell types.

100−-- >>> printSQL $ hask @(Maybe String)

101−-- text NULL

102−--

103−-- >>> printSQL $ hask @Double

104−-- float8 NOT NULL

105−hask

106− :: forall h schemas. PGNullityTyped schemas (NullPG h)

107− => ColumnTypeExpression schemas ('NoDef :=> NullPG h)

108−hask = pgNullityType

squeal-postgresql/src/Squeal/PostgreSQL/Definition/Table.hs+1−1

@@ -62,9 +62,9 @@ import qualified GHC.Generics as GHC

6262

6363import Squeal.PostgreSQL.Alias

6464import Squeal.PostgreSQL.Definition

65−import Squeal.PostgreSQL.Definition.Table.Column

6665import Squeal.PostgreSQL.Definition.Table.Constraint

6766import Squeal.PostgreSQL.Expression

67+import Squeal.PostgreSQL.Expression.Type

6868import Squeal.PostgreSQL.List

6969import Squeal.PostgreSQL.Render

7070import Squeal.PostgreSQL.Schema

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/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+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 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/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