99bbfbe · squeal · git.iko.soy

git.iko.soy/squeal

on dev help sign in

Merge pull request #42 from morphismtech/0.4

99bbfbeEitan Chatav8 years ago

.circleci/config.yml+1−1

compare with dev

unifiedsplit

@@ -2,7 +2,7 @@ version: 2

2jobs:

3 build:

4 docker:

5− - image: haskell:8.2.2

5+ - image: haskell:8.4.3

6 - image: circleci/postgres:latest

7 environment:

8 POSTGRES_DB: exampledb

README.md+18−17

@@ -45,7 +45,8 @@ composable and cover a large portion of SQL.

45* connection pools

46* transactions

47* views

48−* composite and enumerated types

48+* array, composite and enumerated types

49+* json operations

50## installation

51## installation

@@ -133,16 +134,16 @@ let

133 setup :: Definition '[] Schema

134 setup :: Definition '[] Schema

134 setup =

135 setup =

135 createTable #users

136 createTable #users

136− ( serial `As` #id :*

137+ ( serial `as` #id :*

137− (text & notNullable) `As` #name :* Nil )

138+ (text & notNullable) `as` #name )

138− ( primaryKey #id `As` #pk_users :* Nil ) >>>

139+ ( primaryKey #id `as` #pk_users ) >>>

139 createTable #emails

140 createTable #emails

140− ( serial `As` #id :*

141+ ( serial `as` #id :*

141− (int & notNullable) `As` #user_id :*

142+ (int & notNullable) `as` #user_id :*

142− (text & nullable) `As` #email :* Nil )

143+ (text & nullable) `as` #email )

143− ( primaryKey #id `As` #pk_emails :*

144+ ( primaryKey #id `as` #pk_emails :*

144 foreignKey #user_id #users #id

145 foreignKey #user_id #users #id

145− OnDeleteCascade OnUpdateCascade `As` #fk_user_id :* Nil )

146+ OnDeleteCascade OnUpdateCascade `as` #fk_user_id )

146:}

147:}

147```

148```

148

149

@@ -187,17 +188,17 @@ of our inserts.

187let

188let

188 insertUser :: Manipulation Schema '[ 'NotNull 'PGtext ] '[ "fromOnly" ::: 'NotNull 'PGint4 ]

189 insertUser :: Manipulation Schema '[ 'NotNull 'PGtext ] '[ "fromOnly" ::: 'NotNull 'PGint4 ]

189 insertUser = insertRow #users

190 insertUser = insertRow #users

190− (Default `As` #id :* Set (param @1) `As` #name :* Nil)

191+ (Default `as` #id :* Set (param @1) `as` #name)

191− OnConflictDoNothing (Returning (#id `As` #fromOnly :* Nil))

192+ OnConflictDoNothing (Returning (#id `as` #fromOnly))

192:}

193:}

193

194

194>>> :{

195>>> :{

195let

196let

196 insertEmail :: Manipulation Schema '[ 'NotNull 'PGint4, 'Null 'PGtext] '[]

197 insertEmail :: Manipulation Schema '[ 'NotNull 'PGint4, 'Null 'PGtext] '[]

197 insertEmail = insertRow #emails

198 insertEmail = insertRow #emails

198− ( Default `As` #id :*

199+ ( Default `as` #id :*

199− Set (param @1) `As` #user_id :*

200+ Set (param @1) `as` #user_id :*

200− Set (param @2) `As` #email :* Nil )

201+ Set (param @2) `as` #email )

201 OnConflictDoNothing (Returning Nil)

202 OnConflictDoNothing (Returning Nil)

202:}

203:}

203

204

@@ -219,9 +220,9 @@ let

219 '[ "userName" ::: 'NotNull 'PGtext

220 '[ "userName" ::: 'NotNull 'PGtext

220 , "userEmail" ::: 'Null 'PGtext ]

221 , "userEmail" ::: 'Null 'PGtext ]

221 getUsers = select

222 getUsers = select

222− (#u ! #name `As` #userName :* #e ! #email `As` #userEmail :* Nil)

223+ (#u ! #name `as` #userName :* #e ! #email `as` #userEmail)

223− ( from (table (#users `As` #u)

224+ ( from (table (#users `as` #u)

224− & innerJoin (table (#emails `As` #e))

225+ & innerJoin (table (#emails `as` #e))

225 (#u ! #id .== #e ! #user_id)) )

226 (#u ! #id .== #e ! #user_id)) )

226:}

227:}

227

228

RELEASE NOTES.md+418

@@ -1,5 +1,423 @@

1## RELEASE NOTES

3+### Version 0.4

5+Version 0.4 of strengthens Squeal's type system, adds

6+support for multidimensional arrays, improves support

7+for container type, improves `with` statements,

8+improves runtime exceptions, accomodates SQL's three-valued logic,

9+adds subquery expressions, and adds table and view type expressions.

10+

11+**Types**

12+

13+Squeal 0.4 renames some kinds to aid intuition:

14+

15+```Haskell

16+type RowType = [(Symbol, NullityType)] -- previously RelationType

17+type FromType = [(Symbol, RowType)] -- previously RelationsType

18+```

19+

20+Null safety for array and composite types is gained by having the base

21+type of an array be a `NullityType` and the base type of a composite

22+a `RowType`.

23+

24+```Haskell

25+data PGType

26+ = ..

27+ | PGvararray NullityType

28+ | PGfixarray Nat NullityType

29+ | PGcomposite RowType

30+```

31+

32+Squeal embeds Postgres types into Haskell using data kinds and type-in-type:

33+

34+```Haskell

35+data PGType = PGbool | ..

36+data NullityType = Null PGType | NotNull PGType

37+type RowType = [(Symbol, NullityType)] -- previously RelationType

38+type FromType = [(Symbol, RowType)] -- previously RelationsType

39+```

40+

41+In another sense, we can embed Haskell types

42+into Postgres types by providing type families:

43+

44+```Haskell

45+type family PG (hask :: Type) :: PGType

46+type family NullPG (hask :: Type) :: NullityType

47+type family TuplePG (hask :: Type) :: [NullityType]

48+type family RowPG (hask :: Type) :: RowType

49+```

50+

51+Let's look at these one by one.

52+

53+`PG` was introduced in Squeal 0.3. It was a closed type family that

54+associates some Haskell types to their obvious corresponding Postgres

55+types like `PG Double = 'PGfloat8`. It only worked on base types,

56+no arrays or composites. Squeal 0.4 extends it to

57+such container types and makes it an open type family so that

58+users can make their own type instances.

59+

60+`NullPG` had a different name before but it does the obvious

61+thing for Haskell with `Maybe`s:

62+

63+```Haskell

64+type family NullPG hask where

65+ NullPG (Maybe hask) = 'Null (PG hask)

66+ NullPG hask = 'NotNull (PG hask)

67+```

68+

69+`TuplePG` uses generics to turn tuple types (including records)

70+into lists of `NullityType`s in the logical way, e.g.

71+`TuplePG (Bool, Day) = '[ 'PGbool, 'PGdate]`.

72+

73+`RowPG` also uses generics to turn record types into a `RowType` in the logical way, e.g.

74+

75+```Haskell

76+>>> data Person = Person { name :: Text, age :: Int32 } deriving GHC.Generic

77+>>> instance SOP.Generic Person

78+>>> instance SOP.HasDatatypeInfo Person

79+>>> :kind! TuplePG Person

80+TuplePG Person :: [NullityType]

81+= '['NotNull 'PGtext, 'NotNull 'PGint4]

82+>>> :kind! RowPG Person

83+RowPG Person :: [(Symbol, NullityType)]

84+= '["name" ::: 'NotNull 'PGtext, "age" ::: 'NotNull 'PGint4]

85+```

86+

87+We've already seen a hint of why these types are useful in one construction

88+from Squeal 0.3. Creating composite types in Postgres directly from a Haskell

89+record type essentially uses `RowPG`. Another important use is in simplifying

90+the type signatures for a `Query` or `Manipulation`. Very often, you will have

91+a tuple type corresponding to the parameters and a record type corresponding

92+to the returned columns of a `Query` or `Manipulation`. Instead of writing

93+boilerplate signature you can reuse these with the help of `TuplePG` and `RowPG`

94+

95+For instance:

96+

97+```Haskell

98+>>> :{

99+let

100+ query :: Query '["user" ::: 'View (RowPG Person)] (TuplePG (Only Int32)) (RowPG Person)

101+ query = selectStar (from (view #user) & where_ (#age .> param @1))

102+:}

103+```

104+

105+**Arrays**

106+

107+In addition to being able to encode and decode basic Haskell types

108+like `Int16` and `Text`, Squeal 0.4 permits you to encode and decode Haskell types to

109+Postgres array types. The `Vector` type corresponds to to variable length arrays.

110+And thanks to an idea from [Mike Ledger](https://github.com/mikeplus64),

111+homogeneous tuples correspond to fixed length arrays. We can even

112+create multi-dimensional fixed length arrays. Let's see an example.

113+

114+```Haskell

115+>>> :{

116+data Row = Row

117+ { col1 :: Vector Int16

118+ , col2 :: (Maybe Int16,Maybe Int16)

119+ , col3 :: ((Int16,Int16),(Int16,Int16),(Int16,Int16))

120+ } deriving (Eq, GHC.Generic)

121+:}

122+

123+>>> instance Generic Row

124+>>> instance HasDatatypeInfo Row

125+```

126+

127+Define a simple round trip query.

128+

129+```Haskell

130+>>> :{

131+let

132+ roundTrip :: Query '[] (TuplePG Row) (RowPG Row)

133+ roundTrip = values_ $

134+ parameter @1 (int2 & vararray) `as` #col1 :*

135+ parameter @2 (int2 & fixarray @2) `as` #col2 :*

136+ parameter @3 (int2 & fixarray @2 & fixarray @3) `as` #col3

137+:}

138+

139+>>> :set -XOverloadedLists

140+>>> let input = Row [1,2] (Just 1,Nothing) ((1,2),(3,4),(5,6))

141+>>> :{

142+void . withConnection "host=localhost port=5432 dbname=exampledb" $ do

143+ result <- runQueryParams roundTrip input

144+ Just output <- firstRow result

145+ liftBase . print $ input == output

146+:}

147+True

148+```

149+

150+**Containers**

151+

152+Squeal aims to provide a correspondence between Haskell types and Postgres types.

153+In particular, Haskell ADTs with nullary constructors can correspond to

154+Postgres enum types and Haskell record types can correspond to Postgres

155+composite types. However, it's not always obvious that that's how a user

156+will choose to store values of those types. So Squeal 0.4 introduces newtypes

157+whose purpose is to specify how a user wants to store values of a type.

158+

159+```Haskell

160+newtype Json hask = Json {getJson :: hask}

161+newtype Jsonb hask = Jsonb {getJsonb :: hask}

162+newtype Composite record = Composite {getComposite :: record}

163+newtype Enumerated enum = Enumerated {getEnumerated :: enum}

164+```

165+

166+Let's see an example:

167+

168+```Haskell

169+>>> data Schwarma = Beef | Lamb | Chicken deriving (Eq, Show, GHC.Generic)

170+>>> instance SOP.Generic Schwarma

171+>>> instance SOP.HasDatatypeInfo Schwarma

172+>>>

173+>>> data Person = Person {name :: Text, age :: Int32} deriving (Eq, Show, GHC.Generic)

174+>>> instance SOP.Generic Person

175+>>> instance SOP.HasDatatypeInfo Person

176+>>> instance Aeson.FromJSON Person

177+>>> instance Aeson.ToJSON Person

178+```

179+

180+We can create the equivalent Postgres types directly from their Haskell types.

181+

182+```Haskell

183+>>> :{

184+type Schema =

185+ '[ "schwarma" ::: 'Typedef (PG (Enumerated Schwarma))

186+ , "person" ::: 'Typedef (PG (Composite Person))

187+ ]

188+:}

189+

190+>>> :{

191+let

192+ setup :: Definition '[] Schema

193+ setup =

194+ createTypeEnumFrom @Schwarma #schwarma >>>

195+ createTypeCompositeFrom @Person #person

196+:}

197+```

198+

199+Let's demonstrate how to associate our Haskell types `Schwarma` and `Person`

200+with enumerated, composite or json types in Postgres. First create a Haskell

201+`Row` type using the `Enumerated`, `Composite` and `Json` newtypes as fields.

202+

203+```Haskell

204+>>> :{

205+data Row = Row

206+ { schwarma :: Enumerated Schwarma

207+ , person1 :: Composite Person

208+ , person2 :: Json Person

209+ } deriving (Eq, GHC.Generic)

210+:}

211+

212+>>> instance Generic Row

213+>>> instance HasDatatypeInfo Row

214+>>> :{

215+let

216+ input = Row

217+ (Enumerated Chicken)

218+ (Composite (Person "Faisal" 24))

219+ (Json (Person "Ahmad" 48))

220+:}

221+```

222+

223+Once again, define a round trip query.

224+

225+```Haskell

226+>>> :{

227+let

228+ roundTrip :: Query Schema (TuplePG Row) (RowPG Row)

229+ roundTrip = values_ $

230+ parameter @1 (typedef #schwarma) `as` #schwarma :*

231+ parameter @2 (typedef #person) `as` #person1 :*

232+ parameter @3 json `as` #person2

233+:}

234+```

235+

236+Finally, we can drop our type definitions.

237+

238+```Haskell

239+>>> :{

240+let

241+ teardown :: Definition Schema '[]

242+ teardown = dropType #schwarma >>> dropType #person

243+:}

244+```

245+

246+Now let's run it.

247+

248+```Haskell

249+>>> :{

250+let

251+ session = do

252+ result <- runQueryParams roundTrip input

253+ Just output <- firstRow result

254+ liftBase . print $ input == output

255+in

256+ void . withConnection "host=localhost port=5432 dbname=exampledb" $

257+ define setup

258+ & pqThen session

259+ & pqThen (define teardown)

260+:}

261+True

262+```

263+

264+**With**

265+

266+Squeal 0.3 supported WITH statements but there's a couple problems with them.

267+Here's the type signature for `with` in Squeal 0.3.

268+

269+```Haskell

270+with

271+ :: SOP.SListI commons

272+ => NP (Aliased (Manipulation schema params)) (common ': commons)

273+ -- ^ common table expressions

274+ -> Manipulation (With (common ': commons) schema) params results

275+ -> Manipulation schema params results

276+```

277+

278+The first problem is that `with` only works with `Manipulations`.

279+It can work on `Query`s by using `queryStatement` but it still will

280+return a `Manipulation`. We can fix this issue by making `with` a

281+method of a type class with instances for both `Query` and `Manipulation`.

282+

283+The second problem is that all the common table expressions

284+refer the base schema, whereas in SQL, each subsequent CTE can

285+refer to previous CTEs as well. But this can be fixed! First define a datatype:

286+

287+```Haskell

288+data CommonTableExpression statement params schema0 schema1 where

289+ CommonTableExpression

290+ :: Aliased (statement schema params) (alias ::: cte)

291+ -> CommonTableExpression statement params schema (alias ::: 'View cte ': schema)

292+```

293+

294+It's just a wrapper around an aliased statement, where the statement

295+could be either a `Query` or `Manipulation`, but it augments the schema

296+by adding a view to it. It almost looks like a morphism between schemas

297+but there is no way yet to compose them. Luckily, Squeal already has

298+a datatype for this, which is used for migrations, the `AlignedList`

299+type which is really the "free category". So we can then define a `With` type class:

300+

301+```Haskell

302+class With statement where

303+ with

304+ :: AlignedList (CommonTableExpression statement params) schema0 schema1

305+ -> statement schema1 params row

306+ -> statement schema0 params row

307+```

308+

309+By giving `Aliasable` instances to CTEs and aligned singleton lists of CTEs (i.e. scrap-your-nils), we get a nice syntax for WITH statements in Squeal.

310+

311+Here's an example of using `with` for a `Query` and a `Manipulation`:

312+

313+```Haskell

314+>>> :{

315+let

316+ query :: Query

317+ '[ "t1" ::: 'View

318+ '[ "c1" ::: 'NotNull 'PGtext

319+ , "c2" ::: 'NotNull 'PGtext] ]

320+ '[]

321+ '[ "c1" ::: 'NotNull 'PGtext

322+ , "c2" ::: 'NotNull 'PGtext ]

323+ query = with (

324+ selectStar (from (view #t1)) `as` #t2 :>>

325+ selectStar (from (view #t2)) `as` #t3

326+ ) (selectStar (from (view #t3)))

327+in printSQL query

328+:}

329+WITH "t2" AS (SELECT * FROM "t1" AS "t1"), "t3" AS (SELECT * FROM "t2" AS "t2") SELECT * FROM "t3" AS "t3"

330+

331+>>> type ProductsTable = '[] :=> '["product" ::: 'NoDef :=> 'NotNull 'PGtext, "date" ::: 'Def :=> 'NotNull 'PGdate]

332+

333+>>> :{

334+let

335+ manipulation :: Manipulation

336+ '[ "products" ::: 'Table ProductsTable

337+ , "products_deleted" ::: 'Table ProductsTable

338+ ] '[ 'NotNull 'PGdate] '[]

339+ manipulation = with

340+ (deleteFrom #products (#date .< param @1) ReturningStar `as` #deleted_rows)

341+ (insertQuery_ #products_deleted (selectStar (from (view (#deleted_rows `as` #t)))))

342+in printSQL manipulation

343+:}

344+WITH "deleted_rows" AS (DELETE FROM "products" WHERE ("date" < ($1 :: date)) RETURNING *) INSERT INTO "products_deleted" SELECT * FROM "deleted_rows" AS "t"

345+```

346+

347+**Three Valued Logic**

348+

349+In previous versions of Squeal, conditions followed classical two valued logic

350+of `true` and `false`.

351+

352+```Haskell

353+-- Squeal 0.3

354+type Condition schema from grouping params =

355+ Expression schema from grouping params ('NotNull 'PGbool)

356+```

357+

358+I had thought that three valued logic, which is what SQL uses, was confusing.

359+However, multiple users reported being confused at being forced to do `NULL`

360+handling, particularly in their left joins. Since the original motivation

361+of being less confusing evaporated I decided to switch to three valued logic

362+of `true`, `false` and `null_`.

363+

364+```Haskell

365+-- Squeal 0.4

366+type Condition schema from grouping params =

367+ Expression schema from grouping params ('Null 'PGbool)

368+```

369+

370+**Subquery Expressions**

371+

372+Squeal 0.4 adds support for subquery expressions such as `IN` and `op ANY/ALL`.

373+

374+**Row Types**

375+

376+Squeal 0.4 adds functions to define type expressions from tables and views

377+and a type expression for user defined types, `typetable`, `typeview` and

378+`typedef`.

379+

380+**Runtime Exceptions**

381+

382+Squeal now has an exception type which gives details on the sort of error

383+encountered and handler functions.

384+

385+```Haskell

386+data SquealException

387+ = PQException

388+ { sqlExecStatus :: LibPQ.ExecStatus

389+ , sqlStateCode :: Maybe ByteString

390+ -- ^ https://www.postgresql.org/docs/current/static/errcodes-appendix.html

391+ , sqlErrorMessage :: Maybe ByteString

392+ }

393+ | ResultException Text

394+ | ParseException Text

395+ deriving (Eq, Show)

396+instance Exception SquealException

397+

398+catchSqueal

399+ :: MonadBaseControl IO io

400+ => io a

401+ -> (SquealException -> io a) -- ^ handler

402+ -> io a

403+

404+handleSqueal

405+ :: MonadBaseControl IO io

406+ => (SquealException -> io a) -- ^ handler

407+ -> io a -> io a

408+```

409+

410+**Additional Changes**

411+

412+Squeal 0.4 adds `field` and `index` functions to get components of composite

413+and array expressions.

414+

415+Squeal 0.4 adds a dependency on `records-sop` to offload a lot of boilerplate

416+type family logic that was needed for `RowPG`.

417+

418+The above changes required major and minor changes to Squeal DSL functions.

419+Please consult the documentation.

420+

3### Version 0.3.2 - August 4, 2018

421### Version 0.3.2 - August 4, 2018

422

5Version 0.3.2 features extensive support for `JSON` functionality with

423Version 0.3.2 features extensive support for `JSON` functionality with

squeal-postgresql/exe/Example.hs+3−3

@@ -29,7 +29,7 @@ type Schema =

29 '[ "pk_users" ::: 'PrimaryKey '["id"] ] :=>

30 '[ "id" ::: 'Def :=> 'NotNull 'PGint4

31 , "name" ::: 'NoDef :=> 'NotNull 'PGtext

32− , "vec" ::: 'NoDef :=> 'NotNull ('PGvararray 'PGint2)

32+ , "vec" ::: 'NoDef :=> 'NotNull ('PGvararray ('Null 'PGint2))

33 ])

34 , "emails" ::: 'Table (

35 '[ "pk_emails" ::: 'PrimaryKey '["id"]

@@ -60,7 +60,7 @@ setup =

60teardown :: Definition Schema '[]

61teardown = dropTable #emails >>> dropTable #users

63−insertUser :: Manipulation Schema '[ 'NotNull 'PGtext, 'NotNull ('PGvararray 'PGint2)]

63+insertUser :: Manipulation Schema '[ 'NotNull 'PGtext, 'NotNull ('PGvararray ('Null 'PGint2))]

64 '[ "fromOnly" ::: 'NotNull 'PGint4 ]

65insertUser = insertRows #users

66 (Default `as` #id :* Set (param @1) `as` #name :* Set (param @2) `as` #vec) []

@@ -76,7 +76,7 @@ insertEmail = insertRows #emails

76getUsers :: Query Schema '[]

77 '[ "userName" ::: 'NotNull 'PGtext

78 , "userEmail" ::: 'Null 'PGtext

79− , "userVec" ::: 'NotNull ('PGvararray 'PGint2)]

79+ , "userVec" ::: 'NotNull ('PGvararray ('Null 'PGint2))]

80getUsers = select

81 (#u ! #name `as` #userName :* #e ! #email `as` #userEmail :* #u ! #vec `as` #userVec)

82 ( from (table (#users `as` #u)

squeal-postgresql/squeal-postgresql.cabal+21−3

@@ -1,5 +1,5 @@

1name: squeal-postgresql

2−version: 0.3.2.0

2+version: 0.4.0.0

3synopsis: Squeal PostgreSQL Library

4description: Squeal is a type-safe embedding of PostgreSQL in Haskell

5homepage: https://github.com/morphismtech/squeal

@@ -37,7 +37,7 @@ library

37 ghc-options: -Wall

38 build-depends:

39 aeson >= 1.2.4.0

40− , base >= 4.10.1.0 && < 5.0

40+ , base >= 4.11.1.0 && < 5.0

41 , binary-parser >= 0.5.5

42 , bytestring >= 0.10.8.2

43 , bytestring-strict-builder >= 0.4.5

@@ -50,7 +50,7 @@ library

50 , network-ip >= 0.3.0.2

51 , postgresql-binary >= 0.12.1

52 , postgresql-libpq >= 0.9.4.1

53− , profunctors >= 5.2.2

53+ , records-sop >= 0.1.0.0

54 , resource-pool >= 0.2.3.2

55 , scientific >= 0.3.5.3

56 , text >= 1.2.3.0

@@ -70,6 +70,24 @@ test-suite squeal-postgresql-doctest

70 base >= 4.10.0.0

71 , doctest >= 0.11.4

73+test-suite squeal-postgresql-specs

74+ default-language: Haskell2010

75+ type: exitcode-stdio-1.0

76+ hs-source-dirs: test/Specs

77+ ghc-options: -Wall -main-is Specs

78+ main-is: Specs.hs

79+ other-modules: ExceptionHandling

80+ build-depends:

81+ base >= 4.10.0.0

82+ , bytestring >= 0.10.8.2

83+ , generics-sop >= 0.3.1.0

84+ , hspec >= 2.4.8

85+ , squeal-postgresql

86+ , text >= 1.2.2.2

87+ , transformers >= 0.5.2.0

88+ , transformers-base >= 0.4.4

89+ , vector >= 0.12.0.1

90+

73executable squeal-postgresql-example

91executable squeal-postgresql-example

74 default-language: Haskell2010

92 default-language: Haskell2010

75 hs-source-dirs: exe

93 hs-source-dirs: exe

squeal-postgresql/src/Squeal/PostgreSQL/Binary.hs+334−207

@@ -11,65 +11,104 @@ Instances are governed by the `Generic` and `HasDatatypeInfo` typeclasses, so yo

11do not need to define your own instances to decode retrieved rows into Haskell values or

12to encode Haskell values into statement parameters.

14+Let's see some examples. We'll need some imports

15+

14>>> import Data.Int (Int16)

16>>> import Data.Int (Int16)

15>>> import Data.Text (Text)

17>>> import Data.Text (Text)

16−

17−>>> data Row = Row { col1 :: Int16, col2 :: Text } deriving (Eq, GHC.Generic)

18−>>> instance Generic Row

19−>>> instance HasDatatypeInfo Row

20−

21>>> import Control.Monad (void)

18>>> import Control.Monad (void)

22>>> import Control.Monad.Base (liftBase)

19>>> import Control.Monad.Base (liftBase)

23>>> import Squeal.PostgreSQL

20>>> import Squeal.PostgreSQL

22+Define a Haskell datatype `Row` that will serve as both the input and output of a simple

23+round trip query.

24+

25+>>> data Row = Row { col1 :: Int16, col2 :: Text, col3 :: Maybe Bool } deriving (Eq, GHC.Generic)

26+>>> instance Generic Row

27+>>> instance HasDatatypeInfo Row

25>>> :{

28>>> :{

26let

29let

27− query :: Query '[]

30+ roundTrip :: Query '[] (TuplePG Row) (RowPG Row)

28− '[ 'NotNull 'PGint2, 'NotNull 'PGtext]

31+ roundTrip = values_ $

29− '["col1" ::: 'NotNull 'PGint2, "col2" ::: 'NotNull 'PGtext]

32+ parameter @1 int2 `as` #col1 :*

30− query = values_ (param @1 `as` #col1 :* param @2 `as` #col2)

33+ parameter @2 text `as` #col2 :*

34+ parameter @3 bool `as` #col3

31:}

35:}

37+So long as we can encode the parameters and then decode the result of the query,

38+the input and output should be equal.

39+

40+>>> let input = Row 2 "hi" (Just True)

41+>>> :{

42+void . withConnection "host=localhost port=5432 dbname=exampledb" $ do

43+ result <- runQueryParams roundTrip input

44+ Just output <- firstRow result

45+ liftBase . print $ input == output

46+:}

47+True

48+

49+In addition to being able to encode and decode basic Haskell types

50+like `Int16` and `Text`, Squeal permits you to encode and decode Haskell types to

51+Postgres array, enumerated and composite types and json. Let's see another example,

52+this time using the `Vector` type which corresponds to variable length arrays

53+and homogeneous tuples which correspond to fixed length arrays. We can even

54+create multi-dimensional fixed length arrays.

55+

56+>>> :{

57+data Row = Row

58+ { col1 :: Vector Int16

59+ , col2 :: (Maybe Int16,Maybe Int16)

60+ , col3 :: ((Int16,Int16),(Int16,Int16),(Int16,Int16))

61+ } deriving (Eq, GHC.Generic)

62+:}

63+

64+>>> instance Generic Row

65+>>> instance HasDatatypeInfo Row

66+

67+Once again, we define a simple round trip query.

68+

33>>> :{

69>>> :{

34let

70let

35− roundtrip :: IO ()

71+ roundTrip :: Query '[] (TuplePG Row) (RowPG Row)

36− roundtrip = void . withConnection "host=localhost port=5432 dbname=exampledb" $ do

72+ roundTrip = values_ $

37− result <- runQueryParams query (2 :: Int16, "hi" :: Text)

73+ parameter @1 (int2 & vararray) `as` #col1 :*

38− Just row <- firstRow result

74+ parameter @2 (int2 & fixarray @2) `as` #col2 :*

39− liftBase . print $ row == Row 2 "hi"

75+ parameter @3 (int2 & fixarray @2 & fixarray @3) `as` #col3

40:}

76:}

42−>>> roundtrip

78+>>> :set -XOverloadedLists

79+>>> let input = Row [1,2] (Just 1,Nothing) ((1,2),(3,4),(5,6))

80+>>> :{

81+void . withConnection "host=localhost port=5432 dbname=exampledb" $ do

82+ result <- runQueryParams roundTrip input

83+ Just output <- firstRow result

84+ liftBase . print $ input == output

85+:}

43True

86True

45−In addition to being able to encode and decode basic Haskell types like `Int16` and `Text`,

46−Squeal permits you to encode and decode Haskell types which are equivalent to

47−Postgres enumerated and composite types.

48−

49Enumerated (enum) types are data types that comprise a static, ordered set of values.

88Enumerated (enum) types are data types that comprise a static, ordered set of values.

50They are equivalent to Haskell algebraic data types whose constructors are nullary.

89They are equivalent to Haskell algebraic data types whose constructors are nullary.

51An example of an enum type might be the days of the week,

90An example of an enum type might be the days of the week,

52or a set of status values for a piece of data.

91or a set of status values for a piece of data.

54−>>> data Schwarma = Beef | Lamb | Chicken deriving (Show, GHC.Generic)

93+>>> data Schwarma = Beef | Lamb | Chicken deriving (Eq, Show, GHC.Generic)

55>>> instance Generic Schwarma

94>>> instance Generic Schwarma

56>>> instance HasDatatypeInfo Schwarma

95>>> instance HasDatatypeInfo Schwarma

58A composite type represents the structure of a row or record;

97A composite type represents the structure of a row or record;

59−it is essentially just a list of field names and their data types. They are almost

98+it is essentially just a list of field names and their data types.

60−equivalent to Haskell record types. However, because of the potential presence of @NULL@

61−all the record fields must be `Maybe`s of basic types.

63−>>> data Person = Person {name :: Maybe Text, age :: Maybe Int32} deriving (Show, GHC.Generic)

100+>>> data Person = Person {name :: Text, age :: Int32} deriving (Eq, Show, GHC.Generic)

64>>> instance Generic Person

101>>> instance Generic Person

65>>> instance HasDatatypeInfo Person

102>>> instance HasDatatypeInfo Person

103+>>> instance Aeson.FromJSON Person

104+>>> instance Aeson.ToJSON Person

105

67We can create the equivalent Postgres types directly from their Haskell types.

106We can create the equivalent Postgres types directly from their Haskell types.

107

69>>> :{

108>>> :{

70type Schema =

109type Schema =

71− '[ "schwarma" ::: 'Typedef (EnumFrom Schwarma)

110+ '[ "schwarma" ::: 'Typedef (PG (Enumerated Schwarma))

72− , "person" ::: 'Typedef (CompositeFrom Person)

111+ , "person" ::: 'Typedef (PG (Composite Person))

73 ]

112 ]

74:}

113:}

114

@@ -81,25 +120,40 @@ let

81 createTypeCompositeFrom @Person #person

120 createTypeCompositeFrom @Person #person

82:}

121:}

122

84−Then we can perform roundtrip queries;

123+Let's demonstrate how to associate our Haskell types `Schwarma` and `Person`

124+with enumerated, composite or json types in Postgres. First create a Haskell

125+`Row` type using the `Enumerated`, `Composite` and `Json` newtypes as fields.

126+

127+>>> :{

128+data Row = Row

129+ { schwarma :: Enumerated Schwarma

130+ , person1 :: Composite Person

131+ , person2 :: Json Person

132+ } deriving (Eq, GHC.Generic)

133+:}

134

135+>>> instance Generic Row

136+>>> instance HasDatatypeInfo Row

86>>> :{

137>>> :{

87let

138let

88− querySchwarma :: Query Schema

139+ input = Row

89− '[ 'NotNull (EnumFrom Schwarma)]

140+ (Enumerated Chicken)

90− '["fromOnly" ::: 'NotNull (EnumFrom Schwarma)]

141+ (Composite (Person "Faisal" 24))

91− querySchwarma = values_ (parameter @1 #schwarma `as` #fromOnly)

142+ (Json (Person "Ahmad" 48))

92:}

143:}

144

145+Once again, define a round trip query.

146+

94>>> :{

147>>> :{

95let

148let

96− queryPerson :: Query Schema

149+ roundTrip :: Query Schema (TuplePG Row) (RowPG Row)

97− '[ 'NotNull (CompositeFrom Person)]

150+ roundTrip = values_ $

98− '["fromOnly" ::: 'NotNull (CompositeFrom Person)]

151+ parameter @1 (typedef #schwarma) `as` #schwarma :*

99− queryPerson = values_ (parameter @1 #person `as` #fromOnly)

152+ parameter @2 (typedef #person) `as` #person1 :*

153+ parameter @3 json `as` #person2

100:}

154:}

101

155

102−And finally drop the types.

156+Finally, we can drop our type definitions.

103

157

104>>> :{

158>>> :{

105let

159let

@@ -112,20 +166,16 @@ Now let's run it.

112>>> :{

166>>> :{

113let

167let

114 session = do

168 session = do

115− result1 <- runQueryParams querySchwarma (Only Chicken)

169+ result <- runQueryParams roundTrip input

116− Just (Only schwarma) <- firstRow result1

170+ Just output <- firstRow result

117− liftBase $ print (schwarma :: Schwarma)

171+ liftBase . print $ input == output

118− result2 <- runQueryParams queryPerson (Only (Person (Just "Faisal") (Just 24)))

119− Just (Only person) <- firstRow result2

120− liftBase $ print (person :: Person)

121in

172in

122 void . withConnection "host=localhost port=5432 dbname=exampledb" $

173 void . withConnection "host=localhost port=5432 dbname=exampledb" $

123 define setup

174 define setup

124 & pqThen session

175 & pqThen session

125 & pqThen (define teardown)

176 & pqThen (define teardown)

126:}

177:}

127−Chicken

178+True

128−Person {name = Just "Faisal", age = Just 24}

129-}

179-}

130

180

131{-# LANGUAGE

181{-# LANGUAGE

@@ -134,10 +184,13 @@ Person {name = Just "Faisal", age = Just 24}

134 , DeriveFunctor

184 , DeriveFunctor

135 , DeriveGeneric

185 , DeriveGeneric

136 , DeriveTraversable

186 , DeriveTraversable

187+ , DefaultSignatures

137 , FlexibleContexts

188 , FlexibleContexts

138 , FlexibleInstances

189 , FlexibleInstances

190+ , FunctionalDependencies

139 , GADTs

191 , GADTs

140 , LambdaCase

192 , LambdaCase

193+ , OverloadedStrings

141 , MultiParamTypeClasses

194 , MultiParamTypeClasses

142 , ScopedTypeVariables

195 , ScopedTypeVariables

143 , TypeApplications

196 , TypeApplications

@@ -149,35 +202,37 @@ Person {name = Just "Faisal", age = Just 24}

149module Squeal.PostgreSQL.Binary

202module Squeal.PostgreSQL.Binary

150 ( -- * Encoding

203 ( -- * Encoding

151 ToParam (..)

204 ToParam (..)

152− , ToColumnParam (..)

153 , ToParams (..)

205 , ToParams (..)

154 -- * Decoding

206 -- * Decoding

155 , FromValue (..)

207 , FromValue (..)

156− , FromColumnValue (..)

157 , FromRow (..)

208 , FromRow (..)

158 -- * Only

209 -- * Only

159 , Only (..)

210 , Only (..)

160 ) where

211 ) where

161

212

162import BinaryParser

213import BinaryParser

163−import ByteString.StrictBuilder

214+import ByteString.StrictBuilder (builderLength, int32BE, int64BE, word32BE)

164−import Data.Aeson hiding (Null)

215+import Control.Arrow (left)

216+import Control.Monad

165import Data.Int

217import Data.Int

166import Data.Kind

218import Data.Kind

167−import Data.Monoid hiding (All)

168import Data.Scientific

219import Data.Scientific

169import Data.Time

220import Data.Time

170import Data.UUID.Types

221import Data.UUID.Types

171import Data.Vector (Vector)

222import Data.Vector (Vector)

172import Data.Word

223import Data.Word

173import Generics.SOP

224import Generics.SOP

225+import Generics.SOP.Record

174import GHC.TypeLits

226import GHC.TypeLits

175import Network.IP.Addr

227import Network.IP.Addr

176

228

177−import qualified Data.ByteString.Lazy as Lazy

229+import qualified Data.Aeson as Aeson

230+import qualified Data.ByteString.Lazy as Lazy (ByteString)

178−import qualified Data.ByteString as Strict hiding (pack, unpack)

231+import qualified Data.ByteString.Lazy as Lazy.ByteString

232+import qualified Data.ByteString as Strict (ByteString)

179−import qualified Data.Text.Lazy as Lazy

233+import qualified Data.Text.Lazy as Lazy (Text)

234+import qualified Data.Text as Strict (Text)

180−import qualified Data.Text as Strict

235+import qualified Data.Text as Strict.Text

181import qualified Data.Vector as Vector

236import qualified Data.Vector as Vector

182import qualified GHC.Generics as GHC

237import qualified GHC.Generics as GHC

183import qualified PostgreSQL.Binary.Decoding as Decoding

238import qualified PostgreSQL.Binary.Decoding as Decoding

@@ -219,6 +274,8 @@ instance ToParam (NetAddr IP) 'PGinet where toParam = K . Encoding.inet

219instance ToParam Char ('PGchar 1) where toParam = K . Encoding.char_utf8

274instance ToParam Char ('PGchar 1) where toParam = K . Encoding.char_utf8

220instance ToParam Strict.Text 'PGtext where toParam = K . Encoding.text_strict

275instance ToParam Strict.Text 'PGtext where toParam = K . Encoding.text_strict

221instance ToParam Lazy.Text 'PGtext where toParam = K . Encoding.text_lazy

276instance ToParam Lazy.Text 'PGtext where toParam = K . Encoding.text_lazy

277+instance ToParam String 'PGtext where

278+ toParam = K . Encoding.text_strict . Strict.Text.pack

222instance ToParam Strict.ByteString 'PGbytea where

279instance ToParam Strict.ByteString 'PGbytea where

223 toParam = K . Encoding.bytea_strict

280 toParam = K . Encoding.bytea_strict

224instance ToParam Lazy.ByteString 'PGbytea where

281instance ToParam Lazy.ByteString 'PGbytea where

@@ -232,17 +289,29 @@ instance ToParam LocalTime 'PGtimestamp where

232instance ToParam UTCTime 'PGtimestamptz where

289instance ToParam UTCTime 'PGtimestamptz where

233 toParam = K . Encoding.timestamptz_int

290 toParam = K . Encoding.timestamptz_int

234instance ToParam DiffTime 'PGinterval where toParam = K . Encoding.interval_int

291instance ToParam DiffTime 'PGinterval where toParam = K . Encoding.interval_int

235−instance ToParam Value 'PGjson where toParam = K . Encoding.json_ast

292+instance ToParam Aeson.Value 'PGjson where toParam = K . Encoding.json_ast

236−instance ToParam Value 'PGjsonb where toParam = K . Encoding.jsonb_ast

293+instance ToParam Aeson.Value 'PGjsonb where toParam = K . Encoding.jsonb_ast

237−instance (HasOid pg, ToParam x pg)

294+instance Aeson.ToJSON x => ToParam (Json x) 'PGjson where

238− => ToParam (Vector (Maybe x)) ('PGvararray pg) where

295+ toParam = K . Encoding.json_bytes

239− toParam = K . Encoding.nullableArray_vector

296+ . Lazy.ByteString.toStrict . Aeson.encode . getJson

240− (oid @pg) (unK . toParam @x @pg)

297+instance Aeson.ToJSON x => ToParam (Jsonb x) 'PGjsonb where

298+ toParam = K . Encoding.jsonb_bytes

299+ . Lazy.ByteString.toStrict . Aeson.encode . getJsonb

300+instance ToArray x ('NotNull ('PGvararray ty))

301+ => ToParam x ('PGvararray ty) where

302+ toParam

303+ = K . Encoding.array (baseOid @x @('NotNull ('PGvararray ty)))

304+ . unK . toArray @x @('NotNull ('PGvararray ty))

305+instance ToArray x ('NotNull ('PGfixarray n ty))

306+ => ToParam x ('PGfixarray n ty) where

307+ toParam

308+ = K . Encoding.array (baseOid @x @('NotNull ('PGfixarray n ty)))

309+ . unK . toArray @x @('NotNull ('PGfixarray n ty))

241instance

310instance

242 ( IsEnumType x

311 ( IsEnumType x

243 , HasDatatypeInfo x

312 , HasDatatypeInfo x

244− , LabelsFrom x ~ labels

313+ , LabelsPG x ~ labels

245− ) => ToParam x ('PGenum labels) where

314+ ) => ToParam (Enumerated x) ('PGenum labels) where

246 toParam =

315 toParam =

247 let

316 let

248 gshowConstructor :: NP ConstructorInfo xss -> SOP I xss -> String

317 gshowConstructor :: NP ConstructorInfo xss -> SOP I xss -> String

@@ -253,21 +322,20 @@ instance

253 gshowConstructor constructors (SOP xs)

322 gshowConstructor constructors (SOP xs)

254 in

323 in

255 K . Encoding.text_strict

324 K . Encoding.text_strict

256− . Strict.pack

325+ . Strict.Text.pack

257 . gshowConstructor (constructorInfo (datatypeInfo (Proxy @x)))

326 . gshowConstructor (constructorInfo (datatypeInfo (Proxy @x)))

258 . from

327 . from

328+ . getEnumerated

259instance

329instance

260 ( SListI fields

330 ( SListI fields

261− , MapMaybes xs

331+ , IsRecord x xs

262− , IsProductType x (Maybes xs)

332+ , AllZip ToField xs fields

263− , AllZip ToAliasedParam xs fields

264− , FieldNamesFrom x ~ AliasesOf fields

265 , All HasAliasedOid fields

333 , All HasAliasedOid fields

266− ) => ToParam x ('PGcomposite fields) where

334+ ) => ToParam (Composite x) ('PGcomposite fields) where

267 toParam =

335 toParam =

268 let

336 let

269

337

270− encoders = htrans (Proxy @ToAliasedParam) toAliasedParam

338+ encoders = htrans (Proxy @ToField) toField

271

339

272 composite

340 composite

273 :: All HasAliasedOid row

341 :: All HasAliasedOid row

@@ -301,35 +369,65 @@ instance

301 hcfoldMap (Proxy @HasAliasedOid) each fields

369 hcfoldMap (Proxy @HasAliasedOid) each fields

302

370

303 in

371 in

304− composite . encoders . unMaybes . unZ . unSOP . from

372+ composite . encoders . toRecord . getComposite

305−

373+

306−class HasAliasedOid (field :: (Symbol, PGType)) where aliasedOid :: Word32

374+class HasAliasedOid (field :: (Symbol, NullityType)) where

375+ aliasedOid :: Word32

307−instance HasOid ty => HasAliasedOid (alias ::: ty) where aliasedOid = oid @ty

376+instance HasOid ty => HasAliasedOid (alias ::: nullity ty) where

308−

377+ aliasedOid = oid @ty

378+

379+class ToNullityParam (x :: Type) (ty :: NullityType) where

380+ toNullityParam :: x -> K (Maybe Encoding.Encoding) ty

381+instance ToParam x pg => ToNullityParam x ('NotNull pg) where

382+ toNullityParam = K . Just . unK . toParam @x @pg

383+instance ToParam x pg => ToNullityParam (Maybe x) ('Null pg) where

384+ toNullityParam = K . fmap (unK . toParam @x @pg)

385+

309−class ToAliasedParam (x :: Type) (field :: (Symbol, PGType)) where

386+class ToField (x :: (Symbol, Type)) (field :: (Symbol, NullityType)) where

310− toAliasedParam :: Maybe x -> K (Maybe Encoding.Encoding) field

387+ toField :: P x -> K (Maybe Encoding.Encoding) field

311−instance ToParam x ty => ToAliasedParam x (alias ::: ty) where

388+instance ToNullityParam x ty => ToField (alias ::: x) (alias ::: ty) where

312− toAliasedParam = \case

389+ toField (P x) = K . unK $ toNullityParam @x @ty x

313− Nothing -> K Nothing

390+

314− Just x -> K . Just . unK $ toParam @x @ty x

315−

316−-- | A `ToColumnParam` constraint lifts the `ToParam` encoding

317−-- of a `Type` to a `NullityType`, encoding `Maybe`s to `Null`s. You should

318−-- not define instances of `ToColumnParam`, just use the provided instances.

319−class ToColumnParam (x :: Type) (ty :: NullityType) where

391+class ToArray (x :: Type) (array :: NullityType) where

320− -- | >>> toColumnParam @Int16 @('NotNull 'PGint2) 0

392+ toArray :: x -> K Encoding.Array array

321− -- K (Just "\NUL\NUL")

393+ baseOid :: Word32

322− --

394+ default baseOid :: HasOid (PGTypeOf array) => Word32

323− -- >>> toColumnParam @(Maybe Int16) @('Null 'PGint2) (Just 0)

395+ baseOid = oid @(PGTypeOf array)

324− -- K (Just "\NUL\NUL")

396+instance {-# OVERLAPPABLE #-} (HasOid pg, ToParam x pg)

325− --

326− -- >>> toColumnParam @(Maybe Int16) @('Null 'PGint2) Nothing

327− -- K Nothing

328− toColumnParam :: x -> K (Maybe Strict.ByteString) ty

329−instance ToParam x pg => ToColumnParam x ('NotNull pg) where

397+ => ToArray x ('NotNull pg) where

330− toColumnParam = K . Just . Encoding.encodingBytes . unK . toParam @x @pg

398+ toArray = K . Encoding.encodingArray . unK . toParam @x @pg

399+instance {-# OVERLAPPABLE #-} (HasOid pg, ToParam x pg)

331−instance ToParam x pg => ToColumnParam (Maybe x) ('Null pg) where

400+ => ToArray (Maybe x) ('Null pg) where

401+ toArray = K . maybe Encoding.nullArray

332− toColumnParam = K . fmap (Encoding.encodingBytes . unK . toParam @x @pg)

402+ (Encoding.encodingArray . unK . toParam @x @pg)

403+instance {-# OVERLAPPING #-} ToArray x array

404+ => ToArray (Vector x) ('NotNull ('PGvararray array)) where

405+ toArray = K . Encoding.dimensionArray Vector.foldl'

406+ (unK . toArray @x @array)

407+ baseOid = baseOid @x @array

408+instance {-# OVERLAPPING #-} ToArray x array

409+ => ToArray (Maybe (Vector x)) ('Null ('PGvararray array)) where

410+ toArray = K . maybe Encoding.nullArray

411+ (Encoding.dimensionArray Vector.foldl' (unK . toArray @x @array))

412+ baseOid = baseOid @x @array

413+instance {-# OVERLAPPING #-}

414+ ( IsProductType product xs

415+ , Length xs ~ n

416+ , All ((~) x) xs

417+ , ToArray x array )

418+ => ToArray product ('NotNull ('PGfixarray n array)) where

419+ toArray = K . Encoding.dimensionArray foldlN

420+ (unK . toArray @x @array) . unZ . unSOP . from

421+ baseOid = baseOid @x @array

422+instance {-# OVERLAPPING #-}

423+ ( IsProductType product xs

424+ , Length xs ~ n

425+ , All ((~) x) xs

426+ , ToArray x array )

427+ => ToArray (Maybe product) ('Null ('PGfixarray n array)) where

428+ toArray = K . maybe Encoding.nullArray

429+ (Encoding.dimensionArray foldlN (unK . toArray @x @array) . unZ . unSOP . from)

430+ baseOid = baseOid @x @array

333

431

334-- | A `ToParams` constraint generically sequences the encodings of `Type`s

432-- | A `ToParams` constraint generically sequences the encodings of `Type`s

335-- of the fields of a tuple or record to a row of `ColumnType`s. You should

433-- of the fields of a tuple or record to a row of `ColumnType`s. You should

@@ -345,61 +443,67 @@ class SListI tys => ToParams (x :: Type) (tys :: [NullityType]) where

345 -- >>> instance Generic Tuple

443 -- >>> instance Generic Tuple

346 -- >>> toParams @Tuple @Params (Tuple False (Just 0))

444 -- >>> toParams @Tuple @Params (Tuple False (Just 0))

347 -- K (Just "\NUL") :* K (Just "\NUL\NUL") :* Nil

445 -- K (Just "\NUL") :* K (Just "\NUL\NUL") :* Nil

348− toParams :: x -> NP (K (Maybe Strict.ByteString)) tys

446+ toParams :: x -> NP (K (Maybe Encoding.Encoding)) tys

349−instance (SListI tys, IsProductType x xs, AllZip ToColumnParam xs tys)

447+instance (SListI tys, IsProductType x xs, AllZip ToNullityParam xs tys)

350 => ToParams x tys where

448 => ToParams x tys where

351 toParams

449 toParams

352− = htrans (Proxy @ToColumnParam) (toColumnParam . unI)

450+ = htrans (Proxy @ToNullityParam) (toNullityParam . unI)

353 . unZ . unSOP . from

451 . unZ . unSOP . from

354

452

355-- | A `FromValue` constraint gives a parser from the binary format of

453-- | A `FromValue` constraint gives a parser from the binary format of

356-- a PostgreSQL `PGType` into a Haskell `Type`.

454-- a PostgreSQL `PGType` into a Haskell `Type`.

357class FromValue (pg :: PGType) (y :: Type) where

455class FromValue (pg :: PGType) (y :: Type) where

358 -- | >>> newtype Id = Id { getId :: Int16 } deriving Show

456 -- | >>> newtype Id = Id { getId :: Int16 } deriving Show

359− -- >>> instance FromValue 'PGint2 Id where fromValue = fmap Id . fromValue

457+ -- >>> instance FromValue 'PGint2 Id where fromValue = Id <$> fromValue @'PGint2

360− fromValue :: proxy pg -> Decoding.Value y

458+ fromValue :: Decoding.Value y

361−instance FromValue 'PGbool Bool where fromValue _ = Decoding.bool

459+instance FromValue 'PGbool Bool where fromValue = Decoding.bool

362−instance FromValue 'PGint2 Int16 where fromValue _ = Decoding.int

460+instance FromValue 'PGint2 Int16 where fromValue = Decoding.int

363−instance FromValue 'PGint4 Int32 where fromValue _ = Decoding.int

461+instance FromValue 'PGint4 Int32 where fromValue = Decoding.int

364−instance FromValue 'PGint8 Int64 where fromValue _ = Decoding.int

462+instance FromValue 'PGint8 Int64 where fromValue = Decoding.int

365−instance FromValue 'PGfloat4 Float where fromValue _ = Decoding.float4

463+instance FromValue 'PGfloat4 Float where fromValue = Decoding.float4

366−instance FromValue 'PGfloat8 Double where fromValue _ = Decoding.float8

464+instance FromValue 'PGfloat8 Double where fromValue = Decoding.float8

367−instance FromValue 'PGnumeric Scientific where fromValue _ = Decoding.numeric

465+instance FromValue 'PGnumeric Scientific where fromValue = Decoding.numeric

368−instance FromValue 'PGuuid UUID where fromValue _ = Decoding.uuid

466+instance FromValue 'PGuuid UUID where fromValue = Decoding.uuid

369−instance FromValue 'PGinet (NetAddr IP) where fromValue _ = Decoding.inet

467+instance FromValue 'PGinet (NetAddr IP) where fromValue = Decoding.inet

370−instance FromValue ('PGchar 1) Char where fromValue _ = Decoding.char

468+instance FromValue ('PGchar 1) Char where fromValue = Decoding.char

371−instance FromValue 'PGtext Strict.Text where fromValue _ = Decoding.text_strict

469+instance FromValue 'PGtext Strict.Text where fromValue = Decoding.text_strict

372−instance FromValue 'PGtext Lazy.Text where fromValue _ = Decoding.text_lazy

470+instance FromValue 'PGtext Lazy.Text where fromValue = Decoding.text_lazy

471+instance FromValue 'PGtext String where

472+ fromValue = Strict.Text.unpack <$> Decoding.text_strict

373instance FromValue 'PGbytea Strict.ByteString where

473instance FromValue 'PGbytea Strict.ByteString where

374− fromValue _ = Decoding.bytea_strict

474+ fromValue = Decoding.bytea_strict

375instance FromValue 'PGbytea Lazy.ByteString where

475instance FromValue 'PGbytea Lazy.ByteString where

376− fromValue _ = Decoding.bytea_lazy

476+ fromValue = Decoding.bytea_lazy

377−instance FromValue 'PGdate Day where fromValue _ = Decoding.date

477+instance FromValue 'PGdate Day where fromValue = Decoding.date

378−instance FromValue 'PGtime TimeOfDay where fromValue _ = Decoding.time_int

478+instance FromValue 'PGtime TimeOfDay where fromValue = Decoding.time_int

379instance FromValue 'PGtimetz (TimeOfDay, TimeZone) where

479instance FromValue 'PGtimetz (TimeOfDay, TimeZone) where

380− fromValue _ = Decoding.timetz_int

480+ fromValue = Decoding.timetz_int

381instance FromValue 'PGtimestamp LocalTime where

481instance FromValue 'PGtimestamp LocalTime where

382− fromValue _ = Decoding.timestamp_int

482+ fromValue = Decoding.timestamp_int

383instance FromValue 'PGtimestamptz UTCTime where

483instance FromValue 'PGtimestamptz UTCTime where

384− fromValue _ = Decoding.timestamptz_int

484+ fromValue = Decoding.timestamptz_int

385instance FromValue 'PGinterval DiffTime where

485instance FromValue 'PGinterval DiffTime where

386− fromValue _ = Decoding.interval_int

486+ fromValue = Decoding.interval_int

387−instance FromValue 'PGjson Value where fromValue _ = Decoding.json_ast

487+instance FromValue 'PGjson Aeson.Value where fromValue = Decoding.json_ast

388−instance FromValue 'PGjsonb Value where fromValue _ = Decoding.jsonb_ast

488+instance FromValue 'PGjsonb Aeson.Value where fromValue = Decoding.jsonb_ast

389−instance FromValue pg y => FromValue ('PGvararray pg) (Vector (Maybe y)) where

489+instance Aeson.FromJSON x => FromValue 'PGjson (Json x) where

490+ fromValue = Json <$>

491+ Decoding.json_bytes (left Strict.Text.pack . Aeson.eitherDecodeStrict)

492+instance Aeson.FromJSON x => FromValue 'PGjsonb (Jsonb x) where

390− fromValue _ = Decoding.array

493+ fromValue = Jsonb <$>

391− (Decoding.dimensionArray Vector.replicateM

494+ Decoding.jsonb_bytes (left Strict.Text.pack . Aeson.eitherDecodeStrict)

392− (Decoding.nullableValueArray (fromValue (Proxy @pg))))

495+instance FromArray ('NotNull ('PGvararray ty)) y

496+ => FromValue ('PGvararray ty) y where

497+ fromValue = Decoding.array (fromArray @('NotNull ('PGvararray ty)) @y)

498+instance FromArray ('NotNull ('PGfixarray n ty)) y

393−instance FromValue pg y => FromValue ('PGfixarray n pg) (Vector (Maybe y)) where

499+ => FromValue ('PGfixarray n ty) y where

394− fromValue _ = Decoding.array

500+ fromValue = Decoding.array (fromArray @('NotNull ('PGfixarray n ty)) @y)

395− (Decoding.dimensionArray Vector.replicateM

396− (Decoding.nullableValueArray (fromValue (Proxy @pg))))

397instance

501instance

398 ( IsEnumType y

502 ( IsEnumType y

399 , HasDatatypeInfo y

503 , HasDatatypeInfo y

400− , LabelsFrom y ~ labels

504+ , LabelsPG y ~ labels

401− ) => FromValue ('PGenum labels) y where

505+ ) => FromValue ('PGenum labels) (Enumerated y) where

402− fromValue _ =

506+ fromValue =

403 let

507 let

404 greadConstructor

508 greadConstructor

405 :: All ((~) '[]) xss

509 :: All ((~) '[]) xss

@@ -412,29 +516,16 @@ instance

412 then Just (SOP (Z Nil))

516 then Just (SOP (Z Nil))

413 else SOP . S . unSOP <$> greadConstructor constructors name

517 else SOP . S . unSOP <$> greadConstructor constructors name

414 in

518 in

519+ fmap Enumerated

415− Decoding.enum

520+ . Decoding.enum

416 $ fmap to

521 $ fmap to

417 . greadConstructor (constructorInfo (datatypeInfo (Proxy @y)))

522 . greadConstructor (constructorInfo (datatypeInfo (Proxy @y)))

418− . Strict.unpack

523+ . Strict.Text.unpack

419−

420instance

524instance

421− ( SListI fields

525+ ( FromRow fields y

422− , MapMaybes ys

423− , IsProductType y (Maybes ys)

424− , AllZip FromAliasedValue fields ys

425− , FieldNamesFrom y ~ AliasesOf fields

426− ) => FromValue ('PGcomposite fields) y where

526+ ) => FromValue ('PGcomposite fields) (Composite y) where

427 fromValue =

527 fromValue =

428 let

528 let

429− decoders

430− :: forall pgs zs proxy

431− . AllZip FromAliasedValue pgs zs

432− => proxy ('PGcomposite pgs)

433− -> NP Decoding.Value zs

434− decoders _ = htrans (Proxy @FromAliasedValue) fromAliasedValue

435− (hpure Proxy :: NP Proxy pgs)

436−

437− composite fields = do

438 -- <number of fields: 4 bytes>

529 -- <number of fields: 4 bytes>

439 -- [for each field]

530 -- [for each field]

440 -- <OID of field's type: sizeof(Oid) bytes>

531 -- <OID of field's type: sizeof(Oid) bytes>

@@ -445,80 +536,103 @@ instance

445 -- <value: <length> bytes>

536 -- <value: <length> bytes>

446 -- [end if]

537 -- [end if]

447 -- [end for]

538 -- [end for]

539+ composite = Decoding.valueParser $ do

448 unitOfSize 4

540 unitOfSize 4

449− let

541+ hsequence' $ hpure $ Comp $ do

450− each field = do

451− unitOfSize 4

542+ unitOfSize 4

452− len <- sized 4 Decoding.int

543+ len <- sized 4 Decoding.int

544+ if len == -1

453− if len == -1 then return Nothing else Just <$> sized len field

545+ then return (K Nothing)

454− htraverse' each fields

546+ else K . Just <$> bytesOfSize len

455−

547+ in

456− in fmap (to . SOP . Z . maybes) . composite . decoders

548+ fmap Composite (Decoding.fn (fromRow @fields <=< composite))

457−

458−class FromAliasedValue (pg :: (Symbol,PGType)) (y :: Type) where

459− fromAliasedValue :: proxy pg -> Decoding.Value y

460−instance FromValue pg y => FromAliasedValue (alias ::: pg) y where

461− fromAliasedValue _ = fromValue (Proxy @pg)

462

549

463−-- | A `FromColumnValue` constraint lifts the `FromValue` parser

550+-- | A `FromField` constraint lifts the `FromValue` parser

464-- to a decoding of a @(Symbol, NullityType)@ to a `Type`,

551-- to a decoding of a @(Symbol, NullityType)@ to a `Type`,

465-- decoding `Null`s to `Maybe`s. You should not define instances for

552-- decoding `Null`s to `Maybe`s. You should not define instances for

466−-- `FromColumnValue`, just use the provided instances.

553+-- `FromField`, just use the provided instances.

467−class FromColumnValue (colty :: (Symbol,NullityType)) (y :: Type) where

554+class FromField (pg :: (Symbol, NullityType)) (y :: (Symbol, Type)) where

468− -- | >>> :set -XTypeOperators -XOverloadedStrings

555+ fromField

469− -- >>> newtype Id = Id { getId :: Int16 } deriving Show

470− -- >>> instance FromValue 'PGint2 Id where fromValue = fmap Id . fromValue

471− -- >>> fromColumnValue @("col" ::: 'NotNull 'PGint2) @Id (K (Just "\NUL\SOH"))

472− -- Id {getId = 1}

473− --

474− -- >>> fromColumnValue @("col" ::: 'Null 'PGint2) @(Maybe Id) (K (Just "\NUL\SOH"))

475− -- Just (Id {getId = 1})

476− fromColumnValue :: K (Maybe Strict.ByteString) colty -> y

556+ :: K (Maybe Strict.ByteString) pg

557+ -> (Either Strict.Text :.: P) y

477instance FromValue pg y

558instance FromValue pg y

478− => FromColumnValue (column ::: ('NotNull pg)) y where

559+ => FromField (column ::: ('NotNull pg)) (column ::: y) where

479− fromColumnValue = \case

560+ fromField = Comp . \case

480− K Nothing -> error "fromColumnValue: saw NULL when expecting NOT NULL"

561+ K Nothing -> Left "fromField: saw NULL when expecting NOT NULL"

481− K (Just bs) ->

562+ K (Just bytestring) -> P <$>

482− let

483− errOrValue =

484− Decoding.valueParser (fromValue @pg @y Proxy) bs

563+ Decoding.valueParser (fromValue @pg) bytestring

485− err str = error $ "fromColumnValue: " ++ Strict.unpack str

486− in

487− either err id errOrValue

488instance FromValue pg y

564instance FromValue pg y

489− => FromColumnValue (column ::: ('Null pg)) (Maybe y) where

565+ => FromField (column ::: 'Null pg) (column ::: Maybe y) where

490− fromColumnValue (K nullOrBytes)

566+ fromField = Comp . \case

491− = either err id

567+ K Nothing -> Right $ P Nothing

568+ K (Just bytestring) -> P . Just <$>

492− . Decoding.valueParser (fromValue @pg @y Proxy)

569+ Decoding.valueParser (fromValue @pg) bytestring

493− <$> nullOrBytes

570+

494− where

571+class FromArray (ty :: NullityType) (y :: Type) where

495− err str = error $ "fromColumnValue: " ++ Strict.unpack str

572+ fromArray :: Decoding.Array y

573+instance {-# OVERLAPPABLE #-} FromValue pg y

574+ => FromArray ('NotNull pg) y where

575+ fromArray = Decoding.valueArray (fromValue @pg @y)

576+instance {-# OVERLAPPABLE #-} FromValue pg y

577+ => FromArray ('Null pg) (Maybe y) where

578+ fromArray = Decoding.nullableValueArray (fromValue @pg @y)

579+instance {-# OVERLAPPING #-} FromArray array y

580+ => FromArray ('NotNull ('PGvararray array)) (Vector y) where

581+ fromArray =

582+ Decoding.dimensionArray Vector.replicateM (fromArray @array @y)

583+instance {-# OVERLAPPING #-} FromArray array y

584+ => FromArray ('Null ('PGvararray array)) (Maybe (Vector y)) where

585+ fromArray = Just <$>

586+ Decoding.dimensionArray Vector.replicateM (fromArray @array @y)

587+instance {-# OVERLAPPING #-}

588+ ( FromArray array y

589+ , All ((~) y) ys

590+ , SListI ys

591+ , IsProductType product ys )

592+ => FromArray ('NotNull ('PGfixarray n array)) product where

593+ fromArray =

594+ let

595+ rep _ = fmap (to . SOP . Z) . replicateMN

596+ in

597+ Decoding.dimensionArray rep (fromArray @array @y)

598+instance {-# OVERLAPPING #-}

599+ ( FromArray array y

600+ , All ((~) y) ys

601+ , SListI ys

602+ , IsProductType product ys )

603+ => FromArray ('Null ('PGfixarray n array)) (Maybe product) where

604+ fromArray =

605+ let

606+ rep _ = fmap (to . SOP . Z) . replicateMN

607+ in

608+ Just <$> Decoding.dimensionArray rep (fromArray @array @y)

496

609

497-- | A `FromRow` constraint generically sequences the parsings of the columns

610-- | A `FromRow` constraint generically sequences the parsings of the columns

498−-- of a `RelationType` into the fields of a record `Type` provided they have

611+-- of a `RowType` into the fields of a record `Type` provided they have

499-- the same field names. You should not define instances of `FromRow`.

612-- the same field names. You should not define instances of `FromRow`.

500-- Instead define `Generic` and `HasDatatypeInfo` instances which in turn

613-- Instead define `Generic` and `HasDatatypeInfo` instances which in turn

501-- provide `FromRow` instances.

614-- provide `FromRow` instances.

502−class SListI results => FromRow (results :: RelationType) y where

615+class SListI result => FromRow (result :: RowType) y where

503 -- | >>> :set -XOverloadedStrings

616 -- | >>> :set -XOverloadedStrings

504 -- >>> import Data.Text

617 -- >>> import Data.Text

505 -- >>> newtype UserId = UserId { getUserId :: Int16 } deriving Show

618 -- >>> newtype UserId = UserId { getUserId :: Int16 } deriving Show

506− -- >>> instance FromValue 'PGint2 UserId where fromValue = fmap UserId . fromValue

619+ -- >>> instance FromValue 'PGint2 UserId where fromValue = UserId <$> fromValue @'PGint2

507 -- >>> data UserRow = UserRow { userId :: UserId, userName :: Maybe Text } deriving (Show, GHC.Generic)

620 -- >>> data UserRow = UserRow { userId :: UserId, userName :: Maybe Text } deriving (Show, GHC.Generic)

508 -- >>> instance Generic UserRow

621 -- >>> instance Generic UserRow

509 -- >>> instance HasDatatypeInfo UserRow

622 -- >>> instance HasDatatypeInfo UserRow

510 -- >>> type User = '["userId" ::: 'NotNull 'PGint2, "userName" ::: 'Null 'PGtext]

623 -- >>> type User = '["userId" ::: 'NotNull 'PGint2, "userName" ::: 'Null 'PGtext]

511 -- >>> fromRow @User @UserRow (K (Just "\NUL\SOH") :* K (Just "bloodninja") :* Nil)

624 -- >>> fromRow @User @UserRow (K (Just "\NUL\SOH") :* K (Just "bloodninja") :* Nil)

512− -- UserRow {userId = UserId {getUserId = 1}, userName = Just "bloodninja"}

625+ -- Right (UserRow {userId = UserId {getUserId = 1}, userName = Just "bloodninja"})

513− fromRow :: NP (K (Maybe Strict.ByteString)) results -> y

626+ fromRow :: NP (K (Maybe Strict.ByteString)) result -> Either Strict.Text y

514instance

627instance

515− ( SListI results

628+ ( SListI result

516− , IsProductType y ys

629+ , IsRecord y ys

517− , AllZip FromColumnValue results ys

630+ , AllZip FromField result ys

518− , FieldNamesFrom y ~ AliasesOf results

519− ) => FromRow results y where

631+ ) => FromRow result y where

520 fromRow

632 fromRow

521− = to . SOP . Z . htrans (Proxy @FromColumnValue) (I . fromColumnValue)

633+ = fmap fromRecord

634+ . hsequence'

635+ . htrans (Proxy @FromField) fromField

522

636

523-- | `Only` is a 1-tuple type, useful for encoding a single parameter with

637-- | `Only` is a 1-tuple type, useful for encoding a single parameter with

524-- `toParams` or decoding a single value with `fromRow`.

638-- `toParams` or decoding a single value with `fromRow`.

@@ -528,8 +642,21 @@ instance

528-- K (Just "foo") :* Nil

642-- K (Just "foo") :* Nil

529--

643--

530-- >>> fromRow @'["fromOnly" ::: 'Null 'PGtext] @(Only (Maybe Text)) (K (Just "bar") :* Nil)

644-- >>> fromRow @'["fromOnly" ::: 'Null 'PGtext] @(Only (Maybe Text)) (K (Just "bar") :* Nil)

531−-- Only {fromOnly = Just "bar"}

645+-- Right (Only {fromOnly = Just "bar"})

532newtype Only x = Only { fromOnly :: x }

646newtype Only x = Only { fromOnly :: x }

533 deriving (Functor,Foldable,Traversable,Eq,Ord,Read,Show,GHC.Generic)

647 deriving (Functor,Foldable,Traversable,Eq,Ord,Read,Show,GHC.Generic)

534instance Generic (Only x)

648instance Generic (Only x)

535instance HasDatatypeInfo (Only x)

649instance HasDatatypeInfo (Only x)

650+

651+foldlN

652+ :: All ((~) x) xs

653+ => (z -> x -> z) -> z -> NP I xs -> z

654+foldlN f z = \case

655+ Nil -> z

656+ I x :* xs -> let z' = f z x in seq z' $ foldlN f z' xs

657+

658+replicateMN

659+ :: forall x xs m. (All ((~) x) xs, Monad m, SListI xs)

660+ => m x -> m (NP I xs)

661+replicateMN mx = hsequence' $

662+ hcpure (Proxy :: Proxy ((~) x)) (Comp (I <$> mx))

squeal-postgresql/src/Squeal/PostgreSQL/Definition.hs+31−24

@@ -270,7 +270,7 @@ CREATE TABLE "tab" ("a" int NOT NULL, "b" int NOT NULL, CONSTRAINT "inequality"

270-}

271check

272 :: ( Has alias schema ('Table table)

273− , HasAll aliases (TableToRelation table) subcolumns )

273+ , HasAll aliases (TableToRow table) subcolumns )

274 => NP Alias aliases

275 -- ^ specify the subcolumns which are getting checked

276 -> (forall tab. Condition schema '[tab ::: subcolumns] 'Ungrouped '[])

@@ -304,7 +304,7 @@ CREATE TABLE "tab" ("a" int NULL, "b" int NULL, CONSTRAINT "uq_a_b" UNIQUE ("a",

304-}

305unique

306 :: ( Has alias schema ('Table table)

307− , HasAll aliases (TableToRelation table) subcolumns )

307+ , HasAll aliases (TableToRow table) subcolumns )

308 => NP Alias aliases

309 -- ^ specify subcolumns which together are unique for each row

310 -> TableConstraintExpression schema alias ('Unique aliases)

@@ -807,9 +807,9 @@ alterType ty = UnsafeAlterColumn $ "TYPE" <+> renderColumnTypeExpression ty

807createView

808 :: KnownSymbol view

809 => Alias view -- ^ the name of the view to add

810− -> Query schema '[] relation

810+ -> Query schema '[] row

811 -- ^ query

812− -> Definition schema (Create view ('View relation) schema)

812+ -> Definition schema (Create view ('View row) schema)

813createView alias query = UnsafeDefinition $

814 "CREATE" <+> "VIEW" <+> renderAlias alias <+> "AS"

815 <+> renderQuery query <> ";"

@@ -857,19 +857,23 @@ createTypeEnum enum labels = UnsafeDefinition $

857createTypeEnumFrom

858 :: forall hask enum schema.

859 ( SOP.Generic hask

860− , SOP.All KnownSymbol (LabelsFrom hask)

860+ , SOP.All KnownSymbol (LabelsPG hask)

861 , KnownSymbol enum

862 )

863 => Alias enum

864 -- ^ name of the user defined enumerated type

865− -> Definition schema (Create enum ('Typedef (EnumFrom hask)) schema)

865+ -> Definition schema (Create enum ('Typedef (PG (Enumerated hask))) schema)

866createTypeEnumFrom enum = createTypeEnum enum

867− (SOP.hpure label :: NP PGlabel (LabelsFrom hask))

867+ (SOP.hpure label :: NP PGlabel (LabelsPG hask))

868

869{- | `createTypeComposite` creates a composite type. The composite type is

870specified by a list of attribute names and data types.

871

872+>>> :{

872−>>> type PGcomplex = 'PGcomposite '["real" ::: 'PGfloat8, "imaginary" ::: 'PGfloat8]

873+type PGcomplex = 'PGcomposite

874+ '[ "real" ::: 'NotNull 'PGfloat8

875+ , "imaginary" ::: 'NotNull 'PGfloat8 ]

876+:}

873

877

874>>> :{

878>>> :{

875let

879let

@@ -892,36 +896,39 @@ createTypeComposite ty fields = UnsafeDefinition $

892 (renderCommaSeparated renderField fields) <> ";"

896 (renderCommaSeparated renderField fields) <> ";"

893 where

897 where

894 renderField :: Aliased (TypeExpression schema) x -> ByteString

898 renderField :: Aliased (TypeExpression schema) x -> ByteString

895− renderField (typ `As` field) =

899+ renderField (typ `As` alias) =

896− renderAlias field <+> renderTypeExpression typ

900+ renderAlias alias <+> renderTypeExpression typ

897

901

898-- | Composite types can also be generated from a Haskell type, for example

902-- | Composite types can also be generated from a Haskell type, for example

899--

903--

900−-- >>> data Complex = Complex {real :: Maybe Double, imaginary :: Maybe Double} deriving GHC.Generic

904+-- >>> data Complex = Complex {real :: Double, imaginary :: Double} deriving GHC.Generic

901-- >>> instance SOP.Generic Complex

905-- >>> instance SOP.Generic Complex

902-- >>> instance SOP.HasDatatypeInfo Complex

906-- >>> instance SOP.HasDatatypeInfo Complex

903-- >>> printSQL $ createTypeCompositeFrom @Complex #complex

907-- >>> printSQL $ createTypeCompositeFrom @Complex #complex

904-- CREATE TYPE "complex" AS ("real" float8, "imaginary" float8);

908-- CREATE TYPE "complex" AS ("real" float8, "imaginary" float8);

905createTypeCompositeFrom

909createTypeCompositeFrom

906 :: forall hask ty schema.

910 :: forall hask ty schema.

907− ( ZipAliased (FieldNamesFrom hask) (FieldTypesFrom hask)

908− , SOP.All (PGTyped schema) (FieldTypesFrom hask)

911+ ( SOP.All (FieldTyped schema) (RowPG hask)

909− , KnownSymbol ty

912+ , KnownSymbol ty )

910− )

911 => Alias ty

913 => Alias ty

912 -- ^ name of the user defined composite type

914 -- ^ name of the user defined composite type

913− -> Definition schema (Create ty ( 'Typedef (CompositeFrom hask)) schema)

915+ -> Definition schema (Create ty ( 'Typedef (PG (Composite hask))) schema)

914−createTypeCompositeFrom ty = createTypeComposite ty $ zipAs

916+createTypeCompositeFrom ty = createTypeComposite ty

915− (SOP.hpure Alias :: NP Alias (FieldNamesFrom hask))

916− (SOP.hcpure (SOP.Proxy :: SOP.Proxy (PGTyped schema)) pgtype

917+ (SOP.hcpure (SOP.Proxy :: SOP.Proxy (FieldTyped schema)) fieldtype

917− :: NP (TypeExpression schema) (FieldTypesFrom hask))

918+ :: NP (Aliased (TypeExpression schema)) (RowPG hask))

919+

920+class FieldTyped schema ty where

921+ fieldtype :: Aliased (TypeExpression schema) ty

922+instance (KnownSymbol alias, PGTyped schema ty)

923+ => FieldTyped schema (alias ::: ty) where

924+ fieldtype = pgtype `As` Alias

918

925

919-- | Drop a type.

926-- | Drop a type.

920--

927--

921-- >>> data Schwarma = Beef | Lamb | Chicken deriving GHC.Generic

928-- >>> data Schwarma = Beef | Lamb | Chicken deriving GHC.Generic

922-- >>> instance SOP.Generic Schwarma

929-- >>> instance SOP.Generic Schwarma

923-- >>> instance SOP.HasDatatypeInfo Schwarma

930-- >>> instance SOP.HasDatatypeInfo Schwarma

924−-- >>> printSQL (dropType #schwarma :: Definition '["schwarma" ::: 'Typedef (EnumFrom Schwarma)] '[])

931+-- >>> printSQL (dropType #schwarma :: Definition '["schwarma" ::: 'Typedef (PG (Enumerated Schwarma))] '[])

925-- DROP TYPE "schwarma";

932-- DROP TYPE "schwarma";

926dropType

933dropType

927 :: Has tydef schema ('Typedef ty)

934 :: Has tydef schema ('Typedef ty)

@@ -938,15 +945,15 @@ newtype ColumnTypeExpression (schema :: SchemaType) (ty :: ColumnType)

938-- | used in `createTable` commands as a column constraint to note that

945-- | used in `createTable` commands as a column constraint to note that

939-- @NULL@ may be present in a column

946-- @NULL@ may be present in a column

940nullable

947nullable

941− :: TypeExpression schema ty

948+ :: TypeExpression schema (nullity ty)

942 -> ColumnTypeExpression schema ('NoDef :=> 'Null ty)

949 -> ColumnTypeExpression schema ('NoDef :=> 'Null ty)

943nullable ty = UnsafeColumnTypeExpression $ renderTypeExpression ty <+> "NULL"

950nullable ty = UnsafeColumnTypeExpression $ renderTypeExpression ty <+> "NULL"

944

951

945-- | used in `createTable` commands as a column constraint to ensure

952-- | used in `createTable` commands as a column constraint to ensure

946-- @NULL@ is not present in a column

953-- @NULL@ is not present in a column

947notNullable

954notNullable

948− :: TypeExpression schema ty

955+ :: TypeExpression schema (nullity ty)

949− -> ColumnTypeExpression schema (def :=> 'NotNull ty)

956+ -> ColumnTypeExpression schema ('NoDef :=> 'NotNull ty)

950notNullable ty = UnsafeColumnTypeExpression $ renderTypeExpression ty <+> "NOT NULL"

957notNullable ty = UnsafeColumnTypeExpression $ renderTypeExpression ty <+> "NOT NULL"

951

958

952-- | used in `createTable` commands as a column constraint to give a default

959-- | used in `createTable` commands as a column constraint to give a default

squeal-postgresql/src/Squeal/PostgreSQL/Expression.hs+502−450

@@ -45,7 +45,9 @@ module Squeal.PostgreSQL.Expression

45 , nullIf

46 -- ** Collections

47 , array

48+ , index

48 , row

49 , row

50+ , field

49 -- ** Functions

51 -- ** Functions

50 , unsafeBinaryOp

52 , unsafeBinaryOp

51 , unsafeUnaryOp

53 , unsafeUnaryOp

@@ -61,12 +63,12 @@ module Squeal.PostgreSQL.Expression

61 , greatest

63 , greatest

62 , least

64 , least

63 -- ** Conditions

65 -- ** Conditions

64− , Condition

65 , true

66 , true

66 , false

67 , false

67 , not_

68 , not_

68 , (.&&)

69 , (.&&)

69 , (.||)

70 , (.||)

71+ , Condition

70 , caseWhenThenElse

72 , caseWhenThenElse

71 , ifThenElse

73 , ifThenElse

72 , (.==)

74 , (.==)

@@ -86,16 +88,13 @@ module Squeal.PostgreSQL.Expression

86 , upper

88 , upper

87 , charLength

89 , charLength

88 , like

90 , like

91+ -- ** Json

89− -- ** json or jsonb operators

92+ -- *** Json and Jsonb operators

90− , PGarray

91− , PGarrayOf

92− , PGjsonKey

93− , PGjson_

94 , (.->)

93 , (.->)

95 , (.->>)

94 , (.->>)

96 , (.#>)

95 , (.#>)

97 , (.#>>)

96 , (.#>>)

98− -- *** jsonb only operators

97+ -- *** Jsonb operators

99 , (.@>)

98 , (.@>)

100 , (.<@)

99 , (.<@)

101 , (.?)

100 , (.?)

@@ -124,8 +123,6 @@ module Squeal.PostgreSQL.Expression

124 , jsonbExtractPath

123 , jsonbExtractPath

125 , jsonExtractPathAsText

124 , jsonExtractPathAsText

126 , jsonbExtractPathAsText

125 , jsonbExtractPathAsText

127− , jsonObjectKeys

128− , jsonbObjectKeys

129 , jsonTypeof

126 , jsonTypeof

130 , jsonbTypeof

127 , jsonbTypeof

131 , jsonStripNulls

128 , jsonStripNulls

@@ -146,6 +143,9 @@ module Squeal.PostgreSQL.Expression

146 -- * Types

143 -- * Types

147 , TypeExpression (UnsafeTypeExpression, renderTypeExpression)

144 , TypeExpression (UnsafeTypeExpression, renderTypeExpression)

148 , PGTyped (pgtype)

145 , PGTyped (pgtype)

146+ , typedef

147+ , typetable

148+ , typeview

149 , bool

150 , int2

151 , smallint

@@ -191,6 +191,7 @@ import Data.Semigroup hiding (All)

191import qualified Data.Aeson as JSON

192import Data.Ratio

193import Data.String

194+import Data.Word

194import Generics.SOP hiding (from)

195import Generics.SOP hiding (from)

195import GHC.OverloadedLabels

196import GHC.OverloadedLabels

196import GHC.TypeLits

197import GHC.TypeLits

@@ -217,14 +218,14 @@ and other operations.

217-}

218-}

218newtype Expression

219newtype Expression

219 (schema :: SchemaType)

220 (schema :: SchemaType)

220− (relations :: RelationsType)

221+ (from :: FromType)

221 (grouping :: Grouping)

222 (grouping :: Grouping)

222 (params :: [NullityType])

223 (params :: [NullityType])

223 (ty :: NullityType)

224 (ty :: NullityType)

224 = UnsafeExpression { renderExpression :: ByteString }

225 = UnsafeExpression { renderExpression :: ByteString }

225 deriving (GHC.Generic,Show,Eq,Ord,NFData)

226 deriving (GHC.Generic,Show,Eq,Ord,NFData)

226

227

227−instance RenderSQL (Expression schema relations grouping params ty) where

228+instance RenderSQL (Expression schema from grouping params ty) where

228 renderSQL = renderExpression

229 renderSQL = renderExpression

229

230

230{- | A `HasParameter` constraint is used to indicate a value that is

231{- | A `HasParameter` constraint is used to indicate a value that is

@@ -247,10 +248,10 @@ class KnownNat n => HasParameter

247 -- >>> printSQL expr

248 -- >>> printSQL expr

248 -- ($1 :: int4)

249 -- ($1 :: int4)

249 parameter

250 parameter

250− :: TypeExpression schema (PGTypeOf ty)

251+ :: TypeExpression schema ty

251− -> Expression schema relations grouping params ty

252+ -> Expression schema from grouping params ty

252 parameter ty = UnsafeExpression $ parenthesized $

253 parameter ty = UnsafeExpression $ parenthesized $

253− "$" <> renderNat (Proxy @n) <+> "::"

254+ "$" <> renderNat @n <+> "::"

254 <+> renderTypeExpression ty

255 <+> renderTypeExpression ty

255instance {-# OVERLAPPING #-} HasParameter 1 schema (ty1:tys) ty1

256instance {-# OVERLAPPING #-} HasParameter 1 schema (ty1:tys) ty1

256instance {-# OVERLAPPABLE #-} (KnownNat n, HasParameter (n-1) schema params ty)

257instance {-# OVERLAPPABLE #-} (KnownNat n, HasParameter (n-1) schema params ty)

@@ -263,84 +264,84 @@ instance {-# OVERLAPPABLE #-} (KnownNat n, HasParameter (n-1) schema params ty)

263-- >>> printSQL expr

264-- >>> printSQL expr

264-- ($1 :: int4)

265-- ($1 :: int4)

265param

266param

266− :: forall n schema params relations grouping ty

267+ :: forall n schema params from grouping ty

267− . (PGTyped schema (PGTypeOf ty), HasParameter n schema params ty)

268+ . (PGTyped schema ty, HasParameter n schema params ty)

268− => Expression schema relations grouping params ty -- ^ param

269+ => Expression schema from grouping params ty -- ^ param

269param = parameter @n pgtype

270param = parameter @n pgtype

270

271

271−instance (HasUnique relation relations columns, Has column columns ty)

272+instance (HasUnique table from columns, Has column columns ty)

272− => IsLabel column (Expression schema relations 'Ungrouped params ty) where

273+ => IsLabel column (Expression schema from 'Ungrouped params ty) where

273 fromLabel = UnsafeExpression $ renderAlias (Alias @column)

274 fromLabel = UnsafeExpression $ renderAlias (Alias @column)

274−instance (HasUnique relation relations columns, Has column columns ty)

275+instance (HasUnique table from columns, Has column columns ty)

275 => IsLabel column

276 => IsLabel column

276− (Aliased (Expression schema relations 'Ungrouped params) (column ::: ty)) where

277+ (Aliased (Expression schema from 'Ungrouped params) (column ::: ty)) where

277 fromLabel = fromLabel @column `As` Alias @column

278 fromLabel = fromLabel @column `As` Alias @column

278−instance (HasUnique relation relations columns, Has column columns ty)

279+instance (HasUnique table from columns, Has column columns ty)

279 => IsLabel column

280 => IsLabel column

280− (NP (Aliased (Expression schema relations 'Ungrouped params)) '[column ::: ty]) where

281+ (NP (Aliased (Expression schema from 'Ungrouped params)) '[column ::: ty]) where

281 fromLabel = fromLabel @column :* Nil

282 fromLabel = fromLabel @column :* Nil

282

283

283−instance (Has relation relations columns, Has column columns ty)

284+instance (Has table from columns, Has column columns ty)

284− => IsQualified relation column (Expression schema relations 'Ungrouped params ty) where

285+ => IsQualified table column (Expression schema from 'Ungrouped params ty) where

285− relation ! column = UnsafeExpression $

286+ table ! column = UnsafeExpression $

286− renderAlias relation <> "." <> renderAlias column

287+ renderAlias table <> "." <> renderAlias column

287−instance (Has relation relations columns, Has column columns ty)

288+instance (Has table from columns, Has column columns ty)

288− => IsQualified relation column

289+ => IsQualified table column

289− (Aliased (Expression schema relations 'Ungrouped params) (column ::: ty)) where

290+ (Aliased (Expression schema from 'Ungrouped params) (column ::: ty)) where

290− relation ! column = relation ! column `As` column

291+ table ! column = table ! column `As` column

291−instance (Has relation relations columns, Has column columns ty)

292+instance (Has table from columns, Has column columns ty)

292− => IsQualified relation column

293+ => IsQualified table column

293− (NP (Aliased (Expression schema relations 'Ungrouped params)) '[column ::: ty]) where

294+ (NP (Aliased (Expression schema from 'Ungrouped params)) '[column ::: ty]) where

294− relation ! column = relation ! column :* Nil

295+ table ! column = table ! column :* Nil

295

296

296instance

297instance

297− ( HasUnique relation relations columns

298+ ( HasUnique table from columns

298 , Has column columns ty

299 , Has column columns ty

299− , GroupedBy relation column bys

300+ , GroupedBy table column bys

300 ) => IsLabel column

301 ) => IsLabel column

301− (Expression schema relations ('Grouped bys) params ty) where

302+ (Expression schema from ('Grouped bys) params ty) where

302 fromLabel = UnsafeExpression $ renderAlias (Alias @column)

303 fromLabel = UnsafeExpression $ renderAlias (Alias @column)

303instance

304instance

304− ( HasUnique relation relations columns

305+ ( HasUnique table from columns

305 , Has column columns ty

306 , Has column columns ty

306− , GroupedBy relation column bys

307+ , GroupedBy table column bys

307 ) => IsLabel column

308 ) => IsLabel column

308− ( Aliased (Expression schema relations ('Grouped bys) params)

309+ ( Aliased (Expression schema from ('Grouped bys) params)

309 (column ::: ty) ) where

310 (column ::: ty) ) where

310 fromLabel = fromLabel @column `As` Alias @column

311 fromLabel = fromLabel @column `As` Alias @column

311instance

312instance

312− ( HasUnique relation relations columns

313+ ( HasUnique table from columns

313 , Has column columns ty

314 , Has column columns ty

314− , GroupedBy relation column bys

315+ , GroupedBy table column bys

315 ) => IsLabel column

316 ) => IsLabel column

316− ( NP (Aliased (Expression schema relations ('Grouped bys) params))

317+ ( NP (Aliased (Expression schema from ('Grouped bys) params))

317 '[column ::: ty] ) where

318 '[column ::: ty] ) where

318 fromLabel = fromLabel @column :* Nil

319 fromLabel = fromLabel @column :* Nil

319

320

320instance

321instance

321− ( Has relation relations columns

322+ ( Has table from columns

322 , Has column columns ty

323 , Has column columns ty

323− , GroupedBy relation column bys

324+ , GroupedBy table column bys

324− ) => IsQualified relation column

325+ ) => IsQualified table column

325− (Expression schema relations ('Grouped bys) params ty) where

326+ (Expression schema from ('Grouped bys) params ty) where

326− relation ! column = UnsafeExpression $

327+ table ! column = UnsafeExpression $

327− renderAlias relation <> "." <> renderAlias column

328+ renderAlias table <> "." <> renderAlias column

328instance

329instance

329− ( Has relation relations columns

330+ ( Has table from columns

330 , Has column columns ty

331 , Has column columns ty

331− , GroupedBy relation column bys

332+ , GroupedBy table column bys

332− ) => IsQualified relation column

333+ ) => IsQualified table column

333− (Aliased (Expression schema relations ('Grouped bys) params)

334+ (Aliased (Expression schema from ('Grouped bys) params)

334 (column ::: ty)) where

335 (column ::: ty)) where

335− relation ! column = relation ! column `As` column

336+ table ! column = table ! column `As` column

336instance

337instance

337− ( Has relation relations columns

338+ ( Has table from columns

338 , Has column columns ty

339 , Has column columns ty

339− , GroupedBy relation column bys

340+ , GroupedBy table column bys

340− ) => IsQualified relation column

341+ ) => IsQualified table column

341− ( NP (Aliased (Expression schema relations ('Grouped bys) params))

342+ ( NP (Aliased (Expression schema from ('Grouped bys) params))

342 '[column ::: ty]) where

343 '[column ::: ty]) where

343− relation ! column = relation ! column :* Nil

344+ table ! column = table ! column :* Nil

344

345

345-- | analagous to `Nothing`

346-- | analagous to `Nothing`

346--

347--

@@ -360,14 +361,14 @@ notNull = UnsafeExpression . renderExpression

360

361

361-- | return the leftmost value which is not NULL

362-- | return the leftmost value which is not NULL

362--

363--

363−-- >>> printSQL $ coalesce [null_, notNull true] false

364+-- >>> printSQL $ coalesce [null_, true] false

364-- COALESCE(NULL, TRUE, FALSE)

365-- COALESCE(NULL, TRUE, FALSE)

365coalesce

366coalesce

366− :: [Expression schema relations grouping params ('Null ty)]

367+ :: [Expression schema from grouping params ('Null ty)]

367 -- ^ @NULL@s may be present

368 -- ^ @NULL@s may be present

368− -> Expression schema relations grouping params ('NotNull ty)

369+ -> Expression schema from grouping params ('NotNull ty)

369 -- ^ @NULL@ is absent

370 -- ^ @NULL@ is absent

370− -> Expression schema relations grouping params ('NotNull ty)

371+ -> Expression schema from grouping params ('NotNull ty)

371coalesce nullxs notNullx = UnsafeExpression $

372coalesce nullxs notNullx = UnsafeExpression $

372 "COALESCE" <> parenthesized (commaSeparated

373 "COALESCE" <> parenthesized (commaSeparated

373 ((renderExpression <$> nullxs) <> [renderExpression notNullx]))

374 ((renderExpression <$> nullxs) <> [renderExpression notNullx]))

@@ -377,26 +378,26 @@ coalesce nullxs notNullx = UnsafeExpression $

377-- >>> printSQL $ fromNull true null_

378-- >>> printSQL $ fromNull true null_

378-- COALESCE(NULL, TRUE)

379-- COALESCE(NULL, TRUE)

379fromNull

380fromNull

380− :: Expression schema relations grouping params ('NotNull ty)

381+ :: Expression schema from grouping params ('NotNull ty)

381 -- ^ what to convert @NULL@ to

382 -- ^ what to convert @NULL@ to

382− -> Expression schema relations grouping params ('Null ty)

383+ -> Expression schema from grouping params ('Null ty)

383− -> Expression schema relations grouping params ('NotNull ty)

384+ -> Expression schema from grouping params ('NotNull ty)

384fromNull notNullx nullx = coalesce [nullx] notNullx

385fromNull notNullx nullx = coalesce [nullx] notNullx

385

386

386-- | >>> printSQL $ null_ & isNull

387-- | >>> printSQL $ null_ & isNull

387-- NULL IS NULL

388-- NULL IS NULL

388isNull

389isNull

389− :: Expression schema relations grouping params ('Null ty)

390+ :: Expression schema from grouping params ('Null ty)

390 -- ^ possibly @NULL@

391 -- ^ possibly @NULL@

391− -> Condition schema relations grouping params

392+ -> Condition schema from grouping params

392isNull x = UnsafeExpression $ renderExpression x <+> "IS NULL"

393isNull x = UnsafeExpression $ renderExpression x <+> "IS NULL"

393

394

394-- | >>> printSQL $ null_ & isNotNull

395-- | >>> printSQL $ null_ & isNotNull

395-- NULL IS NOT NULL

396-- NULL IS NOT NULL

396isNotNull

397isNotNull

397− :: Expression schema relations grouping params ('Null ty)

398+ :: Expression schema from grouping params ('Null ty)

398 -- ^ possibly @NULL@

399 -- ^ possibly @NULL@

399− -> Condition schema relations grouping params

400+ -> Condition schema from grouping params

400isNotNull x = UnsafeExpression $ renderExpression x <+> "IS NOT NULL"

401isNotNull x = UnsafeExpression $ renderExpression x <+> "IS NOT NULL"

401

402

402-- | analagous to `maybe` using @IS NULL@

403-- | analagous to `maybe` using @IS NULL@

@@ -404,13 +405,13 @@ isNotNull x = UnsafeExpression $ renderExpression x <+> "IS NOT NULL"

404-- >>> printSQL $ matchNull true not_ null_

405-- >>> printSQL $ matchNull true not_ null_

405-- CASE WHEN NULL IS NULL THEN TRUE ELSE (NOT NULL) END

406-- CASE WHEN NULL IS NULL THEN TRUE ELSE (NOT NULL) END

406matchNull

407matchNull

407− :: Expression schema relations grouping params (nullty)

408+ :: Expression schema from grouping params (nullty)

408 -- ^ what to convert @NULL@ to

409 -- ^ what to convert @NULL@ to

409− -> ( Expression schema relations grouping params ('NotNull ty)

410+ -> ( Expression schema from grouping params ('NotNull ty)

410− -> Expression schema relations grouping params (nullty) )

411+ -> Expression schema from grouping params (nullty) )

411 -- ^ function to perform when @NULL@ is absent

412 -- ^ function to perform when @NULL@ is absent

412− -> Expression schema relations grouping params ('Null ty)

413+ -> Expression schema from grouping params ('Null ty)

413− -> Expression schema relations grouping params (nullty)

414+ -> Expression schema from grouping params (nullty)

414matchNull y f x = ifThenElse (isNull x) y

415matchNull y f x = ifThenElse (isNull x) y

415 (f (UnsafeExpression (renderExpression x)))

416 (f (UnsafeExpression (renderExpression x)))

416

417

@@ -423,55 +424,81 @@ matchNull y f x = ifThenElse (isNull x) y

423NULL IF (FALSE, ($1 :: bool))

424NULL IF (FALSE, ($1 :: bool))

424-}

425-}

425nullIf

426nullIf

426− :: Expression schema relations grouping params ('NotNull ty)

427+ :: Expression schema from grouping params ('NotNull ty)

427 -- ^ @NULL@ is absent

428 -- ^ @NULL@ is absent

428− -> Expression schema relations grouping params ('NotNull ty)

429+ -> Expression schema from grouping params ('NotNull ty)

429 -- ^ @NULL@ is absent

430 -- ^ @NULL@ is absent

430− -> Expression schema relations grouping params ('Null ty)

431+ -> Expression schema from grouping params ('Null ty)

431nullIf x y = UnsafeExpression $ "NULL IF" <+> parenthesized

432nullIf x y = UnsafeExpression $ "NULL IF" <+> parenthesized

432 (renderExpression x <> ", " <> renderExpression y)

433 (renderExpression x <> ", " <> renderExpression y)

433

434

434−-- | >>> printSQL $ array [null_, notNull false, notNull true]

435+-- | >>> printSQL $ array [null_, false, true]

435-- ARRAY[NULL, FALSE, TRUE]

436-- ARRAY[NULL, FALSE, TRUE]

436array

437array

437− :: [Expression schema relations grouping params ('Null ty)]

438+ :: [Expression schema from grouping params ty]

438 -- ^ array elements

439 -- ^ array elements

439− -> Expression schema relations grouping params (nullity ('PGvararray ty))

440+ -> Expression schema from grouping params (nullity ('PGvararray ty))

440array xs = UnsafeExpression $

441array xs = UnsafeExpression $

441 "ARRAY[" <> commaSeparated (renderExpression <$> xs) <> "]"

442 "ARRAY[" <> commaSeparated (renderExpression <$> xs) <> "]"

442

443

444+-- | >>> printSQL $ array [null_, false, true] & index 2

445+-- (ARRAY[NULL, FALSE, TRUE])[2]

446+index

447+ :: Word64 -- ^ index

448+ -> Expression schema from grouping params (nullity ('PGvararray ty)) -- ^ array

449+ -> Expression schema from grouping params (NullifyType ty)

450+index n expr = UnsafeExpression $

451+ parenthesized (renderExpression expr) <> "[" <> fromString (show n) <> "]"

452+

443instance (KnownSymbol label, label `In` labels) => IsPGlabel label

453instance (KnownSymbol label, label `In` labels) => IsPGlabel label

444− (Expression schema relations grouping params (nullity ('PGenum labels))) where

454+ (Expression schema from grouping params (nullity ('PGenum labels))) where

445 label = UnsafeExpression $ renderLabel (PGlabel @label)

455 label = UnsafeExpression $ renderLabel (PGlabel @label)

446

456

447-- | A row constructor is an expression that builds a row value

457-- | A row constructor is an expression that builds a row value

448-- (also called a composite value) using values for its member fields.

458-- (also called a composite value) using values for its member fields.

449--

459--

460+-- >>> :{

450−-- >>> type Complex = PGcomposite '["real" ::: 'PGfloat8, "imaginary" ::: 'PGfloat8]

461+-- type Complex = 'PGcomposite

462+-- '[ "real" ::: 'NotNull 'PGfloat8

463+-- , "imaginary" ::: 'NotNull 'PGfloat8 ]

464+-- :}

465+--

451-- >>> let i = row (0 `as` #real :* 1 `as` #imaginary) :: Expression '[] '[] 'Ungrouped '[] ('NotNull Complex)

466-- >>> let i = row (0 `as` #real :* 1 `as` #imaginary) :: Expression '[] '[] 'Ungrouped '[] ('NotNull Complex)

452-- >>> printSQL i

467-- >>> printSQL i

453-- ROW(0, 1)

468-- ROW(0, 1)

454row

469row

455− :: SListI (Nulls fields)

470+ :: SListI row

456− => NP (Aliased (Expression schema relations grouping params)) (Nulls fields)

471+ => NP (Aliased (Expression schema from grouping params)) row

457 -- ^ zero or more expressions for the row field values

472 -- ^ zero or more expressions for the row field values

458− -> Expression schema relations grouping params (nullity ('PGcomposite fields))

473+ -> Expression schema from grouping params (nullity ('PGcomposite row))

459row exprs = UnsafeExpression $ "ROW" <> parenthesized

474row exprs = UnsafeExpression $ "ROW" <> parenthesized

460 (renderCommaSeparated (\ (expr `As` _) -> renderExpression expr) exprs)

475 (renderCommaSeparated (\ (expr `As` _) -> renderExpression expr) exprs)

461

476

462−instance Has field fields ty => IsLabel field

477+-- | >>> :{

478+-- type Complex = 'PGcomposite

479+-- '[ "real" ::: 'NotNull 'PGfloat8

480+-- , "imaginary" ::: 'NotNull 'PGfloat8 ]

481+-- :}

482+--

483+-- >>> let i = row (0 `as` #real :* 1 `as` #imaginary) :: Expression '["complex" ::: 'Typedef Complex] '[] 'Ungrouped '[] ('NotNull Complex)

484+-- >>> printSQL $ i & field #complex #imaginary

485+-- (ROW(0, 1)::"complex")."imaginary"

486+field

487+ :: (Has tydef schema ('Typedef ('PGcomposite row)), Has field row ty)

488+ => Alias tydef -- ^ row type

489+ -> Alias field -- ^ field name

463− ( Expression schema relation grouping params (nullity ('PGcomposite fields))

490+ -> Expression schema from grouping params ('NotNull ('PGcomposite row))

464− -> Expression schema relation grouping params ('Null ty) ) where

491+ -> Expression schema from grouping params ty

465− fromLabel expr = UnsafeExpression $

492+field td fld expr = UnsafeExpression $

466− parenthesized (renderExpression expr) <> "." <>

493+ parenthesized (renderExpression expr <> "::" <> renderAlias td)

467− fromString (symbolVal (Proxy @field))

494+ <> "." <> renderAlias fld

468

495

469instance Semigroup

496instance Semigroup

470− (Expression schema relations grouping params (nullity ('PGvararray ty))) where

497+ (Expression schema from grouping params (nullity ('PGvararray ty))) where

471 (<>) = unsafeBinaryOp "||"

498 (<>) = unsafeBinaryOp "||"

472

499

473instance Monoid

500instance Monoid

474− (Expression schema relations grouping params (nullity ('PGvararray ty))) where

501+ (Expression schema from grouping params (nullity ('PGvararray ty))) where

475 mempty = array []

502 mempty = array []

476 mappend = (<>)

503 mappend = (<>)

477

504

@@ -479,22 +506,22 @@ instance Monoid

479-- >>> printSQL expr

506-- >>> printSQL expr

480-- GREATEST(CURRENT_TIMESTAMP, ($1 :: timestamp with time zone))

507-- GREATEST(CURRENT_TIMESTAMP, ($1 :: timestamp with time zone))

481greatest

508greatest

482− :: Expression schema relations grouping params (nullty)

509+ :: Expression schema from grouping params (nullty)

483 -- ^ needs at least 1 argument

510 -- ^ needs at least 1 argument

484− -> [Expression schema relations grouping params (nullty)]

511+ -> [Expression schema from grouping params (nullty)]

485 -- ^ or more

512 -- ^ or more

486− -> Expression schema relations grouping params (nullty)

513+ -> Expression schema from grouping params (nullty)

487greatest x xs = UnsafeExpression $ "GREATEST("

514greatest x xs = UnsafeExpression $ "GREATEST("

488 <> commaSeparated (renderExpression <$> (x:xs)) <> ")"

515 <> commaSeparated (renderExpression <$> (x:xs)) <> ")"

489

516

490-- | >>> printSQL $ least currentTimestamp [null_]

517-- | >>> printSQL $ least currentTimestamp [null_]

491-- LEAST(CURRENT_TIMESTAMP, NULL)

518-- LEAST(CURRENT_TIMESTAMP, NULL)

492least

519least

493− :: Expression schema relations grouping params (nullty)

520+ :: Expression schema from grouping params (nullty)

494 -- ^ needs at least 1 argument

521 -- ^ needs at least 1 argument

495− -> [Expression schema relations grouping params (nullty)]

522+ -> [Expression schema from grouping params (nullty)]

496 -- ^ or more

523 -- ^ or more

497− -> Expression schema relations grouping params (nullty)

524+ -> Expression schema from grouping params (nullty)

498least x xs = UnsafeExpression $ "LEAST("

525least x xs = UnsafeExpression $ "LEAST("

499 <> commaSeparated (renderExpression <$> (x:xs)) <> ")"

526 <> commaSeparated (renderExpression <$> (x:xs)) <> ")"

500

527

@@ -503,9 +530,9 @@ least x xs = UnsafeExpression $ "LEAST("

503unsafeBinaryOp

530unsafeBinaryOp

504 :: ByteString

531 :: ByteString

505 -- ^ operator

532 -- ^ operator

506− -> Expression schema relations grouping params (ty0)

533+ -> Expression schema from grouping params (ty0)

507− -> Expression schema relations grouping params (ty1)

534+ -> Expression schema from grouping params (ty1)

508− -> Expression schema relations grouping params (ty2)

535+ -> Expression schema from grouping params (ty2)

509unsafeBinaryOp op x y = UnsafeExpression $ parenthesized $

536unsafeBinaryOp op x y = UnsafeExpression $ parenthesized $

510 renderExpression x <+> op <+> renderExpression y

537 renderExpression x <+> op <+> renderExpression y

511

538

@@ -514,8 +541,8 @@ unsafeBinaryOp op x y = UnsafeExpression $ parenthesized $

514unsafeUnaryOp

541unsafeUnaryOp

515 :: ByteString

542 :: ByteString

516 -- ^ operator

543 -- ^ operator

517− -> Expression schema relations grouping params (ty0)

544+ -> Expression schema from grouping params (ty0)

518− -> Expression schema relations grouping params (ty1)

545+ -> Expression schema from grouping params (ty1)

519unsafeUnaryOp op x = UnsafeExpression $ parenthesized $

546unsafeUnaryOp op x = UnsafeExpression $ parenthesized $

520 op <+> renderExpression x

547 op <+> renderExpression x

521

548

@@ -524,8 +551,8 @@ unsafeUnaryOp op x = UnsafeExpression $ parenthesized $

524unsafeFunction

551unsafeFunction

525 :: ByteString

552 :: ByteString

526 -- ^ function

553 -- ^ function

527− -> Expression schema relations grouping params (xty)

554+ -> Expression schema from grouping params (xty)

528− -> Expression schema relations grouping params (yty)

555+ -> Expression schema from grouping params (yty)

529unsafeFunction fun x = UnsafeExpression $

556unsafeFunction fun x = UnsafeExpression $

530 fun <> parenthesized (renderExpression x)

557 fun <> parenthesized (renderExpression x)

531

558

@@ -534,13 +561,13 @@ unsafeVariadicFunction

534 :: SListI elems

561 :: SListI elems

535 => ByteString

562 => ByteString

536 -- ^ function

563 -- ^ function

537− -> NP (Expression schema relations grouping params) elems

564+ -> NP (Expression schema from grouping params) elems

538− -> Expression schema relations grouping params ret

565+ -> Expression schema from grouping params ret

539unsafeVariadicFunction fun x = UnsafeExpression $

566unsafeVariadicFunction fun x = UnsafeExpression $

540 fun <> parenthesized (commaSeparated (hcollapse (hmap (K . renderExpression) x)))

567 fun <> parenthesized (commaSeparated (hcollapse (hmap (K . renderExpression) x)))

541

568

542−instance PGNum ty

569+instance ty `In` PGNum

543− => Num (Expression schema relations grouping params (nullity ty)) where

570+ => Num (Expression schema from grouping params (nullity ty)) where

544 (+) = unsafeBinaryOp "+"

571 (+) = unsafeBinaryOp "+"

545 (-) = unsafeBinaryOp "-"

572 (-) = unsafeBinaryOp "-"

546 (*) = unsafeBinaryOp "*"

573 (*) = unsafeBinaryOp "*"

@@ -551,13 +578,13 @@ instance PGNum ty

551 . fromString

578 . fromString

552 . show

579 . show

553

580

554−instance (PGNum ty, PGFloating ty) => Fractional

581+instance (ty `In` PGNum, ty `In` PGFloating) => Fractional

555− (Expression schema relations grouping params (nullity ty)) where

582+ (Expression schema from grouping params (nullity ty)) where

556 (/) = unsafeBinaryOp "/"

583 (/) = unsafeBinaryOp "/"

557 fromRational x = fromInteger (numerator x) / fromInteger (denominator x)

584 fromRational x = fromInteger (numerator x) / fromInteger (denominator x)

558

585

559−instance (PGNum ty, PGFloating ty) => Floating

586+instance (ty `In` PGNum, ty `In` PGFloating) => Floating

560− (Expression schema relations grouping params (nullity ty)) where

587+ (Expression schema from grouping params (nullity ty)) where

561 pi = UnsafeExpression "pi()"

588 pi = UnsafeExpression "pi()"

562 exp = unsafeFunction "exp"

589 exp = unsafeFunction "exp"

563 log = unsafeFunction "ln"

590 log = unsafeFunction "ln"

@@ -580,18 +607,18 @@ instance (PGNum ty, PGFloating ty) => Floating

580

607

581-- | >>> :{

608-- | >>> :{

582-- let

609-- let

583−-- expression :: Expression schema relations grouping params (nullity 'PGfloat4)

610+-- expression :: Expression schema from grouping params (nullity 'PGfloat4)

584-- expression = atan2_ pi 2

611-- expression = atan2_ pi 2

585-- in printSQL expression

612-- in printSQL expression

586-- :}

613-- :}

587-- atan2(pi(), 2)

614-- atan2(pi(), 2)

588atan2_

615atan2_

589− :: PGFloating float

616+ :: float `In` PGFloating

590− => Expression schema relations grouping params (nullity float)

617+ => Expression schema from grouping params (nullity float)

591 -- ^ numerator

618 -- ^ numerator

592− -> Expression schema relations grouping params (nullity float)

619+ -> Expression schema from grouping params (nullity float)

593 -- ^ denominator

620 -- ^ denominator

594− -> Expression schema relations grouping params (nullity float)

621+ -> Expression schema from grouping params (nullity float)

595atan2_ y x = UnsafeExpression $

622atan2_ y x = UnsafeExpression $

596 "atan2(" <> renderExpression y <> ", " <> renderExpression x <> ")"

623 "atan2(" <> renderExpression y <> ", " <> renderExpression x <> ")"

597

624

@@ -604,9 +631,9 @@ atan2_ y x = UnsafeExpression $

604cast

631cast

605 :: TypeExpression schema ty1

632 :: TypeExpression schema ty1

606 -- ^ type to cast as

633 -- ^ type to cast as

607− -> Expression schema relations grouping params (nullity ty0)

634+ -> Expression schema from grouping params ty0

608 -- ^ value to convert

635 -- ^ value to convert

609− -> Expression schema relations grouping params (nullity ty1)

636+ -> Expression schema from grouping params ty1

610cast ty x = UnsafeExpression $ parenthesized $

637cast ty x = UnsafeExpression $ parenthesized $

611 renderExpression x <+> "::" <+> renderTypeExpression ty

638 renderExpression x <+> "::" <+> renderTypeExpression ty

612

639

@@ -614,135 +641,136 @@ cast ty x = UnsafeExpression $ parenthesized $

614--

641--

615-- >>> :{

642-- >>> :{

616-- let

643-- let

617−-- expression :: Expression schema relations grouping params (nullity 'PGint2)

644+-- expression :: Expression schema from grouping params (nullity 'PGint2)

618-- expression = 5 `quot_` 2

645-- expression = 5 `quot_` 2

619-- in printSQL expression

646-- in printSQL expression

620-- :}

647-- :}

621-- (5 / 2)

648-- (5 / 2)

622quot_

649quot_

623− :: PGIntegral int

650+ :: int `In` PGIntegral

624− => Expression schema relations grouping params (nullity int)

651+ => Expression schema from grouping params (nullity int)

625 -- ^ numerator

652 -- ^ numerator

626− -> Expression schema relations grouping params (nullity int)

653+ -> Expression schema from grouping params (nullity int)

627 -- ^ denominator

654 -- ^ denominator

628− -> Expression schema relations grouping params (nullity int)

655+ -> Expression schema from grouping params (nullity int)

629quot_ = unsafeBinaryOp "/"

656quot_ = unsafeBinaryOp "/"

630

657

631-- | remainder upon integer division

658-- | remainder upon integer division

632--

659--

633-- >>> :{

660-- >>> :{

634-- let

661-- let

635−-- expression :: Expression schema relations grouping params (nullity 'PGint2)

662+-- expression :: Expression schema from grouping params (nullity 'PGint2)

636-- expression = 5 `rem_` 2

663-- expression = 5 `rem_` 2

637-- in printSQL expression

664-- in printSQL expression

638-- :}

665-- :}

639-- (5 % 2)

666-- (5 % 2)

640rem_

667rem_

641− :: PGIntegral int

668+ :: int `In` PGIntegral

642− => Expression schema relations grouping params (nullity int)

669+ => Expression schema from grouping params (nullity int)

643 -- ^ numerator

670 -- ^ numerator

644− -> Expression schema relations grouping params (nullity int)

671+ -> Expression schema from grouping params (nullity int)

645 -- ^ denominator

672 -- ^ denominator

646− -> Expression schema relations grouping params (nullity int)

673+ -> Expression schema from grouping params (nullity int)

647rem_ = unsafeBinaryOp "%"

674rem_ = unsafeBinaryOp "%"

648

675

649-- | >>> :{

676-- | >>> :{

650-- let

677-- let

651−-- expression :: Expression schema relations grouping params (nullity 'PGfloat4)

678+-- expression :: Expression schema from grouping params (nullity 'PGfloat4)

652-- expression = trunc pi

679-- expression = trunc pi

653-- in printSQL expression

680-- in printSQL expression

654-- :}

681-- :}

655-- trunc(pi())

682-- trunc(pi())

656trunc

683trunc

657− :: PGFloating frac

684+ :: frac `In` PGFloating

658− => Expression schema relations grouping params (nullity frac)

685+ => Expression schema from grouping params (nullity frac)

659 -- ^ fractional number

686 -- ^ fractional number

660− -> Expression schema relations grouping params (nullity frac)

687+ -> Expression schema from grouping params (nullity frac)

661trunc = unsafeFunction "trunc"

688trunc = unsafeFunction "trunc"

662

689

663-- | >>> :{

690-- | >>> :{

664-- let

691-- let

665−-- expression :: Expression schema relations grouping params (nullity 'PGfloat4)

692+-- expression :: Expression schema from grouping params (nullity 'PGfloat4)

666-- expression = round_ pi

693-- expression = round_ pi

667-- in printSQL expression

694-- in printSQL expression

668-- :}

695-- :}

669-- round(pi())

696-- round(pi())

670round_

697round_

671− :: PGFloating frac

698+ :: frac `In` PGFloating

672− => Expression schema relations grouping params (nullity frac)

699+ => Expression schema from grouping params (nullity frac)

673 -- ^ fractional number

700 -- ^ fractional number

674− -> Expression schema relations grouping params (nullity frac)

701+ -> Expression schema from grouping params (nullity frac)

675round_ = unsafeFunction "round"

702round_ = unsafeFunction "round"

676

703

677-- | >>> :{

704-- | >>> :{

678-- let

705-- let

679−-- expression :: Expression schema relations grouping params (nullity 'PGfloat4)

706+-- expression :: Expression schema from grouping params (nullity 'PGfloat4)

680-- expression = ceiling_ pi

707-- expression = ceiling_ pi

681-- in printSQL expression

708-- in printSQL expression

682-- :}

709-- :}

683-- ceiling(pi())

710-- ceiling(pi())

684ceiling_

711ceiling_

685− :: PGFloating frac

712+ :: frac `In` PGFloating

686− => Expression schema relations grouping params (nullity frac)

713+ => Expression schema from grouping params (nullity frac)

687 -- ^ fractional number

714 -- ^ fractional number

688− -> Expression schema relations grouping params (nullity frac)

715+ -> Expression schema from grouping params (nullity frac)

689ceiling_ = unsafeFunction "ceiling"

716ceiling_ = unsafeFunction "ceiling"

690

717

691−-- | A `Condition` is a boolean valued `Expression`. While SQL allows

718+-- | A `Condition` is an `Expression`, which can evaluate

692−-- conditions to have @NULL@, Squeal instead chooses to disallow @NULL@,

719+-- to `true`, `false` or `null_`. This is because SQL uses

693−-- forcing one to handle the case of @NULL@ explicitly to produce

720+-- a three valued logic.

694−-- a `Condition`.

695−type Condition schema relations grouping params =

721+type Condition schema from grouping params =

696− Expression schema relations grouping params ('NotNull 'PGbool)

722+ Expression schema from grouping params ('Null 'PGbool)

697

723

698-- | >>> printSQL true

724-- | >>> printSQL true

699-- TRUE

725-- TRUE

700−true :: Condition schema relations grouping params

726+true :: Expression schema from grouping params (nullity 'PGbool)

701true = UnsafeExpression "TRUE"

727true = UnsafeExpression "TRUE"

702

728

703-- | >>> printSQL false

729-- | >>> printSQL false

704-- FALSE

730-- FALSE

705−false :: Condition schema relations grouping params

731+false :: Expression schema from grouping params (nullity 'PGbool)

706false = UnsafeExpression "FALSE"

732false = UnsafeExpression "FALSE"

707

733

708-- | >>> printSQL $ not_ true

734-- | >>> printSQL $ not_ true

709-- (NOT TRUE)

735-- (NOT TRUE)

710not_

736not_

711− :: Condition schema relations grouping params

737+ :: Expression schema from grouping params (nullity 'PGbool)

712− -> Condition schema relations grouping params

738+ -> Expression schema from grouping params (nullity 'PGbool)

713not_ = unsafeUnaryOp "NOT"

739not_ = unsafeUnaryOp "NOT"

714

740

715-- | >>> printSQL $ true .&& false

741-- | >>> printSQL $ true .&& false

716-- (TRUE AND FALSE)

742-- (TRUE AND FALSE)

717(.&&)

743(.&&)

718− :: Condition schema relations grouping params

744+ :: Expression schema from grouping params (nullity 'PGbool)

719− -> Condition schema relations grouping params

745+ -> Expression schema from grouping params (nullity 'PGbool)

720− -> Condition schema relations grouping params

746+ -> Expression schema from grouping params (nullity 'PGbool)

747+infixr 3 .&&

721(.&&) = unsafeBinaryOp "AND"

748(.&&) = unsafeBinaryOp "AND"

722

749

723-- | >>> printSQL $ true .|| false

750-- | >>> printSQL $ true .|| false

724-- (TRUE OR FALSE)

751-- (TRUE OR FALSE)

725(.||)

752(.||)

726− :: Condition schema relations grouping params

753+ :: Expression schema from grouping params (nullity 'PGbool)

727− -> Condition schema relations grouping params

754+ -> Expression schema from grouping params (nullity 'PGbool)

728− -> Condition schema relations grouping params

755+ -> Expression schema from grouping params (nullity 'PGbool)

756+infixr 2 .||

729(.||) = unsafeBinaryOp "OR"

757(.||) = unsafeBinaryOp "OR"

730

758

731-- | >>> :{

759-- | >>> :{

732-- let

760-- let

733−-- expression :: Expression schema relations grouping params (nullity 'PGint2)

761+-- expression :: Expression schema from grouping params (nullity 'PGint2)

734-- expression = caseWhenThenElse [(true, 1), (false, 2)] 3

762-- expression = caseWhenThenElse [(true, 1), (false, 2)] 3

735-- in printSQL expression

763-- in printSQL expression

736-- :}

764-- :}

737-- CASE WHEN TRUE THEN 1 WHEN FALSE THEN 2 ELSE 3 END

765-- CASE WHEN TRUE THEN 1 WHEN FALSE THEN 2 ELSE 3 END

738caseWhenThenElse

766caseWhenThenElse

739− :: [ ( Condition schema relations grouping params

767+ :: [ ( Condition schema from grouping params

740− , Expression schema relations grouping params (ty)

768+ , Expression schema from grouping params ty

741 ) ]

769 ) ]

742 -- ^ whens and thens

770 -- ^ whens and thens

743− -> Expression schema relations grouping params (ty)

771+ -> Expression schema from grouping params ty

744 -- ^ else

772 -- ^ else

745− -> Expression schema relations grouping params (ty)

773+ -> Expression schema from grouping params ty

746caseWhenThenElse whenThens else_ = UnsafeExpression $ mconcat

774caseWhenThenElse whenThens else_ = UnsafeExpression $ mconcat

747 [ "CASE"

775 [ "CASE"

748 , mconcat

776 , mconcat

@@ -758,103 +786,103 @@ caseWhenThenElse whenThens else_ = UnsafeExpression $ mconcat

758

786

759-- | >>> :{

787-- | >>> :{

760-- let

788-- let

761−-- expression :: Expression schema relations grouping params (nullity 'PGint2)

789+-- expression :: Expression schema from grouping params (nullity 'PGint2)

762-- expression = ifThenElse true 1 0

790-- expression = ifThenElse true 1 0

763-- in printSQL expression

791-- in printSQL expression

764-- :}

792-- :}

765-- CASE WHEN TRUE THEN 1 ELSE 0 END

793-- CASE WHEN TRUE THEN 1 ELSE 0 END

766ifThenElse

794ifThenElse

767− :: Condition schema relations grouping params

795+ :: Condition schema from grouping params

768− -> Expression schema relations grouping params (ty) -- ^ then

796+ -> Expression schema from grouping params ty -- ^ then

769− -> Expression schema relations grouping params (ty) -- ^ else

797+ -> Expression schema from grouping params ty -- ^ else

770− -> Expression schema relations grouping params (ty)

798+ -> Expression schema from grouping params ty

771ifThenElse if_ then_ else_ = caseWhenThenElse [(if_,then_)] else_

799ifThenElse if_ then_ else_ = caseWhenThenElse [(if_,then_)] else_

772

800

773-- | Comparison operations like `.==`, `./=`, `.>`, `.>=`, `.<` and `.<=`

801-- | Comparison operations like `.==`, `./=`, `.>`, `.>=`, `.<` and `.<=`

774-- will produce @NULL@s if one of their arguments is @NULL@.

802-- will produce @NULL@s if one of their arguments is @NULL@.

775--

803--

776−-- >>> printSQL $ notNull true .== null_

804+-- >>> printSQL $ true .== null_

777-- (TRUE = NULL)

805-- (TRUE = NULL)

778(.==)

806(.==)

779− :: Expression schema relations grouping params (nullity ty) -- ^ lhs

807+ :: Expression schema from grouping params (nullity0 ty) -- ^ lhs

780− -> Expression schema relations grouping params (nullity ty) -- ^ rhs

808+ -> Expression schema from grouping params (nullity1 ty) -- ^ rhs

781− -> Expression schema relations grouping params (nullity 'PGbool)

809+ -> Condition schema from grouping params

782(.==) = unsafeBinaryOp "="

810(.==) = unsafeBinaryOp "="

783infix 4 .==

811infix 4 .==

784

812

785−-- | >>> printSQL $ notNull true ./= null_

813+-- | >>> printSQL $ true ./= null_

786-- (TRUE <> NULL)

814-- (TRUE <> NULL)

787(./=)

815(./=)

788− :: Expression schema relations grouping params (nullity ty) -- ^ lhs

816+ :: Expression schema from grouping params (nullity0 ty) -- ^ lhs

789− -> Expression schema relations grouping params (nullity ty) -- ^ rhs

817+ -> Expression schema from grouping params (nullity1 ty) -- ^ rhs

790− -> Expression schema relations grouping params (nullity 'PGbool)

818+ -> Condition schema from grouping params

791(./=) = unsafeBinaryOp "<>"

819(./=) = unsafeBinaryOp "<>"

792infix 4 ./=

820infix 4 ./=

793

821

794−-- | >>> printSQL $ notNull true .>= null_

822+-- | >>> printSQL $ true .>= null_

795-- (TRUE >= NULL)

823-- (TRUE >= NULL)

796(.>=)

824(.>=)

797− :: Expression schema relations grouping params (nullity ty) -- ^ lhs

825+ :: Expression schema from grouping params (nullity0 ty) -- ^ lhs

798− -> Expression schema relations grouping params (nullity ty) -- ^ rhs

826+ -> Expression schema from grouping params (nullity1 ty) -- ^ rhs

799− -> Expression schema relations grouping params (nullity 'PGbool)

827+ -> Condition schema from grouping params

800(.>=) = unsafeBinaryOp ">="

828(.>=) = unsafeBinaryOp ">="

801infix 4 .>=

829infix 4 .>=

802

830

803−-- | >>> printSQL $ notNull true .< null_

831+-- | >>> printSQL $ true .< null_

804-- (TRUE < NULL)

832-- (TRUE < NULL)

805(.<)

833(.<)

806− :: Expression schema relations grouping params (nullity ty) -- ^ lhs

834+ :: Expression schema from grouping params (nullity0 ty) -- ^ lhs

807− -> Expression schema relations grouping params (nullity ty) -- ^ rhs

835+ -> Expression schema from grouping params (nullity1 ty) -- ^ rhs

808− -> Expression schema relations grouping params (nullity 'PGbool)

836+ -> Condition schema from grouping params

809(.<) = unsafeBinaryOp "<"

837(.<) = unsafeBinaryOp "<"

810infix 4 .<

838infix 4 .<

811

839

812−-- | >>> printSQL $ notNull true .<= null_

840+-- | >>> printSQL $ true .<= null_

813-- (TRUE <= NULL)

841-- (TRUE <= NULL)

814(.<=)

842(.<=)

815− :: Expression schema relations grouping params (nullity ty) -- ^ lhs

843+ :: Expression schema from grouping params (nullity0 ty) -- ^ lhs

816− -> Expression schema relations grouping params (nullity ty) -- ^ rhs

844+ -> Expression schema from grouping params (nullity1 ty) -- ^ rhs

817− -> Expression schema relations grouping params (nullity 'PGbool)

845+ -> Condition schema from grouping params

818(.<=) = unsafeBinaryOp "<="

846(.<=) = unsafeBinaryOp "<="

819infix 4 .<=

847infix 4 .<=

820

848

821−-- | >>> printSQL $ notNull true .> null_

849+-- | >>> printSQL $ true .> null_

822-- (TRUE > NULL)

850-- (TRUE > NULL)

823(.>)

851(.>)

824− :: Expression schema relations grouping params (nullity ty) -- ^ lhs

852+ :: Expression schema from grouping params (nullity0 ty) -- ^ lhs

825− -> Expression schema relations grouping params (nullity ty) -- ^ rhs

853+ -> Expression schema from grouping params (nullity1 ty) -- ^ rhs

826− -> Expression schema relations grouping params (nullity 'PGbool)

854+ -> Condition schema from grouping params

827(.>) = unsafeBinaryOp ">"

855(.>) = unsafeBinaryOp ">"

828infix 4 .>

856infix 4 .>

829

857

830-- | >>> printSQL currentDate

858-- | >>> printSQL currentDate

831-- CURRENT_DATE

859-- CURRENT_DATE

832currentDate

860currentDate

833− :: Expression schema relations grouping params (nullity 'PGdate)

861+ :: Expression schema from grouping params (nullity 'PGdate)

834currentDate = UnsafeExpression "CURRENT_DATE"

862currentDate = UnsafeExpression "CURRENT_DATE"

835

863

836-- | >>> printSQL currentTime

864-- | >>> printSQL currentTime

837-- CURRENT_TIME

865-- CURRENT_TIME

838currentTime

866currentTime

839− :: Expression schema relations grouping params (nullity 'PGtimetz)

867+ :: Expression schema from grouping params (nullity 'PGtimetz)

840currentTime = UnsafeExpression "CURRENT_TIME"

868currentTime = UnsafeExpression "CURRENT_TIME"

841

869

842-- | >>> printSQL currentTimestamp

870-- | >>> printSQL currentTimestamp

843-- CURRENT_TIMESTAMP

871-- CURRENT_TIMESTAMP

844currentTimestamp

872currentTimestamp

845− :: Expression schema relations grouping params (nullity 'PGtimestamptz)

873+ :: Expression schema from grouping params (nullity 'PGtimestamptz)

846currentTimestamp = UnsafeExpression "CURRENT_TIMESTAMP"

874currentTimestamp = UnsafeExpression "CURRENT_TIMESTAMP"

847

875

848-- | >>> printSQL localTime

876-- | >>> printSQL localTime

849-- LOCALTIME

877-- LOCALTIME

850localTime

878localTime

851− :: Expression schema relations grouping params (nullity 'PGtime)

879+ :: Expression schema from grouping params (nullity 'PGtime)

852localTime = UnsafeExpression "LOCALTIME"

880localTime = UnsafeExpression "LOCALTIME"

853

881

854-- | >>> printSQL localTimestamp

882-- | >>> printSQL localTimestamp

855-- LOCALTIMESTAMP

883-- LOCALTIMESTAMP

856localTimestamp

884localTimestamp

857− :: Expression schema relations grouping params (nullity 'PGtimestamp)

885+ :: Expression schema from grouping params (nullity 'PGtimestamp)

858localTimestamp = UnsafeExpression "LOCALTIMESTAMP"

886localTimestamp = UnsafeExpression "LOCALTIMESTAMP"

859

887

860{-----------------------------------------

888{-----------------------------------------

@@ -862,7 +890,7 @@ text

862-----------------------------------------}

890-----------------------------------------}

863

891

864instance IsString

892instance IsString

865− (Expression schema relations grouping params (nullity 'PGtext)) where

893+ (Expression schema from grouping params (nullity 'PGtext)) where

866 fromString str = UnsafeExpression $

894 fromString str = UnsafeExpression $

867 "E\'" <> fromString (escape =<< str) <> "\'"

895 "E\'" <> fromString (escape =<< str) <> "\'"

868 where

896 where

@@ -878,36 +906,36 @@ instance IsString

878 c -> [c]

906 c -> [c]

879

907

880instance Semigroup

908instance Semigroup

881− (Expression schema relations grouping params (nullity 'PGtext)) where

909+ (Expression schema from grouping params (nullity 'PGtext)) where

882 (<>) = unsafeBinaryOp "||"

910 (<>) = unsafeBinaryOp "||"

883

911

884instance Monoid

912instance Monoid

885− (Expression schema relations grouping params (nullity 'PGtext)) where

913+ (Expression schema from grouping params (nullity 'PGtext)) where

886 mempty = fromString ""

914 mempty = fromString ""

887 mappend = (<>)

915 mappend = (<>)

888

916

889-- | >>> printSQL $ lower "ARRRGGG"

917-- | >>> printSQL $ lower "ARRRGGG"

890-- lower(E'ARRRGGG')

918-- lower(E'ARRRGGG')

891lower

919lower

892− :: Expression schema relations grouping params (nullity 'PGtext)

920+ :: Expression schema from grouping params (nullity 'PGtext)

893 -- ^ string to lower case

921 -- ^ string to lower case

894− -> Expression schema relations grouping params (nullity 'PGtext)

922+ -> Expression schema from grouping params (nullity 'PGtext)

895lower = unsafeFunction "lower"

923lower = unsafeFunction "lower"

896

924

897-- | >>> printSQL $ upper "eeee"

925-- | >>> printSQL $ upper "eeee"

898-- upper(E'eeee')

926-- upper(E'eeee')

899upper

927upper

900− :: Expression schema relations grouping params (nullity 'PGtext)

928+ :: Expression schema from grouping params (nullity 'PGtext)

901 -- ^ string to upper case

929 -- ^ string to upper case

902− -> Expression schema relations grouping params (nullity 'PGtext)

930+ -> Expression schema from grouping params (nullity 'PGtext)

903upper = unsafeFunction "upper"

931upper = unsafeFunction "upper"

904

932

905-- | >>> printSQL $ charLength "four"

933-- | >>> printSQL $ charLength "four"

906-- char_length(E'four')

934-- char_length(E'four')

907charLength

935charLength

908− :: Expression schema relations grouping params (nullity 'PGtext)

936+ :: Expression schema from grouping params (nullity 'PGtext)

909 -- ^ string to measure

937 -- ^ string to measure

910− -> Expression schema relations grouping params (nullity 'PGint4)

938+ -> Expression schema from grouping params (nullity 'PGint4)

911charLength = unsafeFunction "char_length"

939charLength = unsafeFunction "char_length"

912

940

913-- | The `like` expression returns true if the @string@ matches

941-- | The `like` expression returns true if the @string@ matches

@@ -920,11 +948,11 @@ charLength = unsafeFunction "char_length"

920-- >>> printSQL $ "abc" `like` "a%"

948-- >>> printSQL $ "abc" `like` "a%"

921-- (E'abc' LIKE E'a%')

949-- (E'abc' LIKE E'a%')

922like

950like

923− :: Expression schema relations grouping params (nullity 'PGtext)

951+ :: Expression schema from grouping params (nullity 'PGtext)

924 -- ^ string

952 -- ^ string

925− -> Expression schema relations grouping params (nullity 'PGtext)

953+ -> Expression schema from grouping params (nullity 'PGtext)

926 -- ^ pattern

954 -- ^ pattern

927− -> Expression schema relations grouping params (nullity 'PGbool)

955+ -> Expression schema from grouping params (nullity 'PGbool)

928like = unsafeBinaryOp "LIKE"

956like = unsafeBinaryOp "LIKE"

929

957

930{-----------------------------------------

958{-----------------------------------------

@@ -938,34 +966,38 @@ Table 9.44: json and jsonb operators

938

966

939-- | Get JSON value (object field or array element) at a key.

967-- | Get JSON value (object field or array element) at a key.

940(.->)

968(.->)

941− :: (PGjson_ json, PGjsonKey key)

969+ :: (json `In` PGJsonType, key `In` PGJsonKey)

942− => Expression schema relations grouping params (nullity json)

970+ => Expression schema from grouping params (nullity json)

943− -> Expression schema relations grouping params (nullity key)

971+ -> Expression schema from grouping params (nullity key)

944− -> Expression schema relations grouping params ('Null json)

972+ -> Expression schema from grouping params ('Null json)

973+infixl 8 .->

945(.->) = unsafeBinaryOp "->"

974(.->) = unsafeBinaryOp "->"

946

975

947-- | Get JSON value (object field or array element) at a key, as text.

976-- | Get JSON value (object field or array element) at a key, as text.

948(.->>)

977(.->>)

949− :: (PGjson_ json, PGjsonKey key)

978+ :: (json `In` PGJsonType, key `In` PGJsonKey)

950− => Expression schema relations grouping params (nullity json)

979+ => Expression schema from grouping params (nullity json)

951− -> Expression schema relations grouping params (nullity key)

980+ -> Expression schema from grouping params (nullity key)

952− -> Expression schema relations grouping params ('Null 'PGtext)

981+ -> Expression schema from grouping params ('Null 'PGtext)

982+infixl 8 .->>

953(.->>) = unsafeBinaryOp "->>"

983(.->>) = unsafeBinaryOp "->>"

954

984

955-- | Get JSON value at a specified path.

985-- | Get JSON value at a specified path.

956(.#>)

986(.#>)

957− :: (PGjson_ json, PGtextArray "(.#>)" path)

987+ :: (json `In` PGJsonType, PGTextArray "(.#>)" path)

958− => Expression schema relations grouping params (nullity json)

988+ => Expression schema from grouping params (nullity json)

959− -> Expression schema relations grouping params (nullity path)

989+ -> Expression schema from grouping params (nullity path)

960− -> Expression schema relations grouping params ('Null json)

990+ -> Expression schema from grouping params ('Null json)

991+infixl 8 .#>

961(.#>) = unsafeBinaryOp "#>"

992(.#>) = unsafeBinaryOp "#>"

962

993

963-- | Get JSON value at a specified path as text.

994-- | Get JSON value at a specified path as text.

964(.#>>)

995(.#>>)

965− :: (PGjson_ json, PGtextArray "(.#>>)" path)

996+ :: (json `In` PGJsonType, PGTextArray "(.#>>)" path)

966− => Expression schema relations grouping params (nullity json)

997+ => Expression schema from grouping params (nullity json)

967− -> Expression schema relations grouping params (nullity path)

998+ -> Expression schema from grouping params (nullity path)

968− -> Expression schema relations grouping params ('Null 'PGtext)

999+ -> Expression schema from grouping params ('Null 'PGtext)

1000+infixl 8 .#>>

969(.#>>) = unsafeBinaryOp "#>>"

1001(.#>>) = unsafeBinaryOp "#>>"

970

1002

971-- Additional jsonb operators

1003-- Additional jsonb operators

@@ -973,43 +1005,48 @@ Table 9.44: json and jsonb operators

973-- | Does the left JSON value contain the right JSON path/value entries at the

1005-- | Does the left JSON value contain the right JSON path/value entries at the

974-- top level?

1006-- top level?

975(.@>)

1007(.@>)

976− :: Expression schema relations grouping params (nullity 'PGjsonb)

1008+ :: Expression schema from grouping params (nullity 'PGjsonb)

977− -> Expression schema relations grouping params (nullity 'PGjsonb)

1009+ -> Expression schema from grouping params (nullity 'PGjsonb)

978− -> Condition schema relations grouping params

1010+ -> Condition schema from grouping params

1011+infixl 9 .@>

979(.@>) = unsafeBinaryOp "@>"

1012(.@>) = unsafeBinaryOp "@>"

980

1013

981-- | Are the left JSON path/value entries contained at the top level within the

1014-- | Are the left JSON path/value entries contained at the top level within the

982-- right JSON value?

1015-- right JSON value?

983(.<@)

1016(.<@)

984− :: Expression schema relations grouping params (nullity 'PGjsonb)

1017+ :: Expression schema from grouping params (nullity 'PGjsonb)

985− -> Expression schema relations grouping params (nullity 'PGjsonb)

1018+ -> Expression schema from grouping params (nullity 'PGjsonb)

986− -> Condition schema relations grouping params

1019+ -> Condition schema from grouping params

1020+infixl 9 .<@

987(.<@) = unsafeBinaryOp "<@"

1021(.<@) = unsafeBinaryOp "<@"

988

1022

989-- | Does the string exist as a top-level key within the JSON value?

1023-- | Does the string exist as a top-level key within the JSON value?

990(.?)

1024(.?)

991− :: Expression schema relations grouping params (nullity 'PGjsonb)

1025+ :: Expression schema from grouping params (nullity 'PGjsonb)

992− -> Expression schema relations grouping params (nullity 'PGtext)

1026+ -> Expression schema from grouping params (nullity 'PGtext)

993− -> Condition schema relations grouping params

1027+ -> Condition schema from grouping params

1028+infixl 9 .?

994(.?) = unsafeBinaryOp "?"

1029(.?) = unsafeBinaryOp "?"

995

1030

996-- | Do any of these array strings exist as top-level keys?

1031-- | Do any of these array strings exist as top-level keys?

997(.?|)

1032(.?|)

998− :: Expression schema relations grouping params (nullity 'PGjsonb)

1033+ :: Expression schema from grouping params (nullity 'PGjsonb)

999− -> Expression schema relations grouping params (nullity ('PGvararray 'PGtext))

1034+ -> Expression schema from grouping params (nullity ('PGvararray ('NotNull 'PGtext)))

1000− -> Condition schema relations grouping params

1035+ -> Condition schema from grouping params

1036+infixl 9 .?|

1001(.?|) = unsafeBinaryOp "?|"

1037(.?|) = unsafeBinaryOp "?|"

1002

1038

1003-- | Do all of these array strings exist as top-level keys?

1039-- | Do all of these array strings exist as top-level keys?

1004(.?&)

1040(.?&)

1005− :: Expression schema relations grouping params (nullity 'PGjsonb)

1041+ :: Expression schema from grouping params (nullity 'PGjsonb)

1006− -> Expression schema relations grouping params (nullity ('PGvararray 'PGtext))

1042+ -> Expression schema from grouping params (nullity ('PGvararray ('NotNull 'PGtext)))

1007− -> Condition schema relations grouping params

1043+ -> Condition schema from grouping params

1044+infixl 9 .?&

1008(.?&) = unsafeBinaryOp "?&"

1045(.?&) = unsafeBinaryOp "?&"

1009

1046

1010-- | Concatenate two jsonb values into a new jsonb value.

1047-- | Concatenate two jsonb values into a new jsonb value.

1011instance

1048instance

1012− Semigroup (Expression schema relations grouping param (nullity 'PGjsonb)) where

1049+ Semigroup (Expression schema from grouping param (nullity 'PGjsonb)) where

1013 (<>) = unsafeBinaryOp "||"

1050 (<>) = unsafeBinaryOp "||"

1014

1051

1015-- | Delete a key or keys from a JSON object, or remove an array element.

1052-- | Delete a key or keys from a JSON object, or remove an array element.

@@ -1025,19 +1062,21 @@ instance

1025-- @ integer @: Delete the array element with specified index (Negative integers

1062-- @ integer @: Delete the array element with specified index (Negative integers

1026-- count from the end). Throws an error if top level container is not an array.

1063-- count from the end). Throws an error if top level container is not an array.

1027(.-.)

1064(.-.)

1028− :: (key `In` '[ 'PGtext, 'PGvararray 'PGtext, 'PGint4, 'PGint2 ]) -- hlint error without parens here

1065+ :: (key `In` '[ 'PGtext, 'PGvararray ('NotNull 'PGtext), 'PGint4, 'PGint2 ]) -- hlint error without parens here

1029− => Expression schema relations grouping params (nullity 'PGjsonb)

1066+ => Expression schema from grouping params (nullity 'PGjsonb)

1030− -> Expression schema relations grouping params (nullity key)

1067+ -> Expression schema from grouping params (nullity key)

1031− -> Expression schema relations grouping params (nullity 'PGjsonb)

1068+ -> Expression schema from grouping params (nullity 'PGjsonb)

1069+infixl 6 .-.

1032(.-.) = unsafeBinaryOp "-"

1070(.-.) = unsafeBinaryOp "-"

1033

1071

1034-- | Delete the field or element with specified path (for JSON arrays, negative

1072-- | Delete the field or element with specified path (for JSON arrays, negative

1035-- integers count from the end)

1073-- integers count from the end)

1036(#-.)

1074(#-.)

1037− :: PGtextArray "(#-.)" arrayty

1075+ :: PGTextArray "(#-.)" arrayty

1038− => Expression schema relations grouping params (nullity 'PGjsonb)

1076+ => Expression schema from grouping params (nullity 'PGjsonb)

1039− -> Expression schema relations grouping params (nullity arrayty)

1077+ -> Expression schema from grouping params (nullity arrayty)

1040− -> Expression schema relations grouping params (nullity 'PGjsonb)

1078+ -> Expression schema from grouping params (nullity 'PGjsonb)

1079+infixl 6 #-.

1041(#-.) = unsafeBinaryOp "#-"

1080(#-.) = unsafeBinaryOp "#-"

1042

1081

1043{-----------------------------------------

1082{-----------------------------------------

@@ -1045,12 +1084,18 @@ Table 9.45: JSON creation functions

1045-----------------------------------------}

1084-----------------------------------------}

1046

1085

1047-- | Literal binary JSON

1086-- | Literal binary JSON

1087+jsonbLit

1088+ :: JSON.ToJSON x

1048−jsonbLit :: JSON.Value -> Expression schema relations grouping params (nullity 'PGjsonb)

1089+ => x -> Expression schema from grouping params (nullity 'PGjsonb)

1090+jsonbLit = cast jsonb . UnsafeExpression

1049−jsonbLit = cast jsonb . UnsafeExpression . singleQuotedUtf8 . toStrict . JSON.encode

1091+ . singleQuotedUtf8 . toStrict . JSON.encode

1050

1092

1051-- | Literal JSON

1093-- | Literal JSON

1094+jsonLit

1095+ :: JSON.ToJSON x

1052−jsonLit :: JSON.Value -> Expression schema relations grouping params (nullity 'PGjson)

1096+ => x -> Expression schema from grouping params (nullity 'PGjson)

1097+jsonLit = cast json . UnsafeExpression

1053−jsonLit = cast json . UnsafeExpression . singleQuotedUtf8 . toStrict . JSON.encode

1098+ . singleQuotedUtf8 . toStrict . JSON.encode

1054

1099

1055-- | Returns the value as json. Arrays and composites are converted

1100-- | Returns the value as json. Arrays and composites are converted

1056-- (recursively) to arrays and objects; otherwise, if there is a cast from the

1101-- (recursively) to arrays and objects; otherwise, if there is a cast from the

@@ -1059,8 +1104,8 @@ jsonLit = cast json . UnsafeExpression . singleQuotedUtf8 . toStrict . JSON.enco

1059-- number, a Boolean, or a null value, the text representation will be used, in

1104-- number, a Boolean, or a null value, the text representation will be used, in

1060-- such a fashion that it is a valid json value.

1105-- such a fashion that it is a valid json value.

1061toJson

1106toJson

1062− :: Expression schema relations grouping params (nullity ty)

1107+ :: Expression schema from grouping params (nullity ty)

1063− -> Expression schema relations grouping params (nullity 'PGjson)

1108+ -> Expression schema from grouping params (nullity 'PGjson)

1064toJson = unsafeFunction "to_json"

1109toJson = unsafeFunction "to_json"

1065

1110

1066-- | Returns the value as jsonb. Arrays and composites are converted

1111-- | Returns the value as jsonb. Arrays and composites are converted

@@ -1070,43 +1115,43 @@ toJson = unsafeFunction "to_json"

1070-- number, a Boolean, or a null value, the text representation will be used, in

1115-- number, a Boolean, or a null value, the text representation will be used, in

1071-- such a fashion that it is a valid jsonb value.

1116-- such a fashion that it is a valid jsonb value.

1072toJsonb

1117toJsonb

1073− :: Expression schema relations grouping params (nullity ty)

1118+ :: Expression schema from grouping params (nullity ty)

1074− -> Expression schema relations grouping params (nullity 'PGjsonb)

1119+ -> Expression schema from grouping params (nullity 'PGjsonb)

1075toJsonb = unsafeFunction "to_jsonb"

1120toJsonb = unsafeFunction "to_jsonb"

1076

1121

1077-- | Returns the array as a JSON array. A PostgreSQL multidimensional array

1122-- | Returns the array as a JSON array. A PostgreSQL multidimensional array

1078-- becomes a JSON array of arrays.

1123-- becomes a JSON array of arrays.

1079arrayToJson

1124arrayToJson

1080− :: PGarray "arrayToJson" arr

1125+ :: PGArray "arrayToJson" arr

1081− => Expression schema relations grouping params (nullity arr)

1126+ => Expression schema from grouping params (nullity arr)

1082− -> Expression schema relations grouping params (nullity 'PGjson)

1127+ -> Expression schema from grouping params (nullity 'PGjson)

1083arrayToJson = unsafeFunction "array_to_json"

1128arrayToJson = unsafeFunction "array_to_json"

1084

1129

1085-- | Returns the row as a JSON object.

1130-- | Returns the row as a JSON object.

1086rowToJson

1131rowToJson

1087− :: Expression schema relations grouping params (nullity ('PGcomposite ty))

1132+ :: Expression schema from grouping params (nullity ('PGcomposite ty))

1088− -> Expression schema relations grouping params (nullity 'PGjson)

1133+ -> Expression schema from grouping params (nullity 'PGjson)

1089rowToJson = unsafeFunction "row_to_json"

1134rowToJson = unsafeFunction "row_to_json"

1090

1135

1091-- | Builds a possibly-heterogeneously-typed JSON array out of a variadic

1136-- | Builds a possibly-heterogeneously-typed JSON array out of a variadic

1092-- argument list.

1137-- argument list.

1093jsonBuildArray

1138jsonBuildArray

1094 :: SListI elems

1139 :: SListI elems

1095− => NP (Expression schema relations grouping params) elems

1140+ => NP (Expression schema from grouping params) elems

1096− -> Expression schema relations grouping params (nullity 'PGjson)

1141+ -> Expression schema from grouping params (nullity 'PGjson)

1097jsonBuildArray = unsafeVariadicFunction "json_build_array"

1142jsonBuildArray = unsafeVariadicFunction "json_build_array"

1098

1143

1099-- | Builds a possibly-heterogeneously-typed (binary) JSON array out of a

1144-- | Builds a possibly-heterogeneously-typed (binary) JSON array out of a

1100-- variadic argument list.

1145-- variadic argument list.

1101jsonbBuildArray

1146jsonbBuildArray

1102 :: SListI elems

1147 :: SListI elems

1103− => NP (Expression schema relations grouping params) elems

1148+ => NP (Expression schema from grouping params) elems

1104− -> Expression schema relations grouping params (nullity 'PGjsonb)

1149+ -> Expression schema from grouping params (nullity 'PGjsonb)

1105jsonbBuildArray = unsafeVariadicFunction "jsonb_build_array"

1150jsonbBuildArray = unsafeVariadicFunction "jsonb_build_array"

1106

1151

1107unsafeRowFunction

1152unsafeRowFunction

1108 :: All Top elems

1153 :: All Top elems

1109− => NP (Aliased (Expression schema relations grouping params)) elems

1154+ => NP (Aliased (Expression schema from grouping params)) elems

1110 -> [ByteString]

1155 -> [ByteString]

1111unsafeRowFunction =

1156unsafeRowFunction =

1112 (`appEndo` []) . hcfoldMap (Proxy :: Proxy Top)

1157 (`appEndo` []) . hcfoldMap (Proxy :: Proxy Top)

@@ -1118,8 +1163,8 @@ unsafeRowFunction =

1118-- and values.

1163-- and values.

1119jsonBuildObject

1164jsonBuildObject

1120 :: All Top elems

1165 :: All Top elems

1121− => NP (Aliased (Expression schema relations grouping params)) elems

1166+ => NP (Aliased (Expression schema from grouping params)) elems

1122− -> Expression schema relations grouping params (nullity 'PGjson)

1167+ -> Expression schema from grouping params (nullity 'PGjson)

1123jsonBuildObject

1168jsonBuildObject

1124 = unsafeFunction "json_build_object"

1169 = unsafeFunction "json_build_object"

1125 . UnsafeExpression

1170 . UnsafeExpression

@@ -1131,8 +1176,8 @@ jsonBuildObject

1131-- between text and values.

1176-- between text and values.

1132jsonbBuildObject

1177jsonbBuildObject

1133 :: All Top elems

1178 :: All Top elems

1134− => NP (Aliased (Expression schema relations grouping params)) elems

1179+ => NP (Aliased (Expression schema from grouping params)) elems

1135− -> Expression schema relations grouping params (nullity 'PGjsonb)

1180+ -> Expression schema from grouping params (nullity 'PGjsonb)

1136jsonbBuildObject

1181jsonbBuildObject

1137 = unsafeFunction "jsonb_build_object"

1182 = unsafeFunction "jsonb_build_object"

1138 . UnsafeExpression

1183 . UnsafeExpression

@@ -1144,9 +1189,9 @@ jsonbBuildObject

1144-- taken as alternating key/value pairs, or two dimensions such that each inner

1189-- taken as alternating key/value pairs, or two dimensions such that each inner

1145-- array has exactly two elements, which are taken as a key/value pair.

1190-- array has exactly two elements, which are taken as a key/value pair.

1146jsonObject

1191jsonObject

1147− :: PGarrayOf "jsonObject" arr 'PGtext

1192+ :: PGArrayOf "jsonObject" arr ('NotNull 'PGtext)

1148− => Expression schema relations grouping params (nullity arr)

1193+ => Expression schema from grouping params (nullity arr)

1149− -> Expression schema relations grouping params (nullity 'PGjson)

1194+ -> Expression schema from grouping params (nullity 'PGjson)

1150jsonObject = unsafeFunction "json_object"

1195jsonObject = unsafeFunction "json_object"

1151

1196

1152-- | Builds a binary JSON object out of a text array. The array must have either

1197-- | Builds a binary JSON object out of a text array. The array must have either

@@ -1154,19 +1199,19 @@ jsonObject = unsafeFunction "json_object"

1154-- taken as alternating key/value pairs, or two dimensions such that each inner

1199-- taken as alternating key/value pairs, or two dimensions such that each inner

1155-- array has exactly two elements, which are taken as a key/value pair.

1200-- array has exactly two elements, which are taken as a key/value pair.

1156jsonbObject

1201jsonbObject

1157− :: PGarrayOf "jsonbObject" arr 'PGtext

1202+ :: PGArrayOf "jsonbObject" arr ('NotNull 'PGtext)

1158− => Expression schema relations grouping params (nullity arr)

1203+ => Expression schema from grouping params (nullity arr)

1159− -> Expression schema relations grouping params (nullity 'PGjsonb)

1204+ -> Expression schema from grouping params (nullity 'PGjsonb)

1160jsonbObject = unsafeFunction "jsonb_object"

1205jsonbObject = unsafeFunction "jsonb_object"

1161

1206

1162-- | This is an alternate form of 'jsonObject' that takes two arrays; one for

1207-- | This is an alternate form of 'jsonObject' that takes two arrays; one for

1163-- keys and one for values, that are zipped pairwise to create a JSON object.

1208-- keys and one for values, that are zipped pairwise to create a JSON object.

1164jsonZipObject

1209jsonZipObject

1165− :: ( PGarrayOf "jsonZipObject" keysArray 'PGtext

1210+ :: ( PGArrayOf "jsonZipObject" keysArray ('NotNull 'PGtext)

1166− , PGarrayOf "jsonZipObject" valuesArray 'PGtext)

1211+ , PGArrayOf "jsonZipObject" valuesArray ('NotNull 'PGtext))

1167− => Expression schema relations grouping params (nullity keysArray)

1212+ => Expression schema from grouping params (nullity keysArray)

1168− -> Expression schema relations grouping params (nullity valuesArray)

1213+ -> Expression schema from grouping params (nullity valuesArray)

1169− -> Expression schema relations grouping params (nullity 'PGjson)

1214+ -> Expression schema from grouping params (nullity 'PGjson)

1170jsonZipObject ks vs =

1215jsonZipObject ks vs =

1171 unsafeVariadicFunction "json_object" (ks :* vs :* Nil)

1216 unsafeVariadicFunction "json_object" (ks :* vs :* Nil)

1172

1217

@@ -1174,11 +1219,11 @@ jsonZipObject ks vs =

1174-- keys and one for values, that are zipped pairwise to create a binary JSON

1219-- keys and one for values, that are zipped pairwise to create a binary JSON

1175-- object.

1220-- object.

1176jsonbZipObject

1221jsonbZipObject

1177− :: ( PGarrayOf "jsonbZipObject" keysArray 'PGtext

1222+ :: ( PGArrayOf "jsonbZipObject" keysArray ('NotNull 'PGtext)

1178− , PGarrayOf "jsonbZipObject" valuesArray 'PGtext)

1223+ , PGArrayOf "jsonbZipObject" valuesArray ('NotNull 'PGtext))

1179− => Expression schema relations grouping params (nullity keysArray)

1224+ => Expression schema from grouping params (nullity keysArray)

1180− -> Expression schema relations grouping params (nullity valuesArray)

1225+ -> Expression schema from grouping params (nullity valuesArray)

1181− -> Expression schema relations grouping params (nullity 'PGjsonb)

1226+ -> Expression schema from grouping params (nullity 'PGjsonb)

1182jsonbZipObject ks vs =

1227jsonbZipObject ks vs =

1183 unsafeVariadicFunction "jsonb_object" (ks :* vs :* Nil)

1228 unsafeVariadicFunction "jsonb_object" (ks :* vs :* Nil)

1184

1229

@@ -1188,23 +1233,23 @@ Table 9.46: JSON processing functions

1188

1233

1189-- | Returns the number of elements in the outermost JSON array.

1234-- | Returns the number of elements in the outermost JSON array.

1190jsonArrayLength

1235jsonArrayLength

1191− :: Expression schema relations grouping params (nullity 'PGjson)

1236+ :: Expression schema from grouping params (nullity 'PGjson)

1192− -> Expression schema relations grouping params (nullity 'PGint4)

1237+ -> Expression schema from grouping params (nullity 'PGint4)

1193jsonArrayLength = unsafeFunction "json_array_length"

1238jsonArrayLength = unsafeFunction "json_array_length"

1194

1239

1195-- | Returns the number of elements in the outermost binary JSON array.

1240-- | Returns the number of elements in the outermost binary JSON array.

1196jsonbArrayLength

1241jsonbArrayLength

1197− :: Expression schema relations grouping params (nullity 'PGjsonb)

1242+ :: Expression schema from grouping params (nullity 'PGjsonb)

1198− -> Expression schema relations grouping params (nullity 'PGint4)

1243+ -> Expression schema from grouping params (nullity 'PGint4)

1199jsonbArrayLength = unsafeFunction "jsonb_array_length"

1244jsonbArrayLength = unsafeFunction "jsonb_array_length"

1200

1245

1201-- | Returns JSON value pointed to by the given path (equivalent to #>

1246-- | Returns JSON value pointed to by the given path (equivalent to #>

1202-- operator).

1247-- operator).

1203jsonExtractPath

1248jsonExtractPath

1204 :: SListI elems

1249 :: SListI elems

1205− => Expression schema relations grouping params (nullity 'PGjson)

1250+ => Expression schema from grouping params (nullity 'PGjson)

1206− -> NP (Expression schema relations grouping params) elems

1251+ -> NP (Expression schema from grouping params) elems

1207− -> Expression schema relations grouping params (nullity 'PGjsonb)

1252+ -> Expression schema from grouping params (nullity 'PGjsonb)

1208jsonExtractPath x xs =

1253jsonExtractPath x xs =

1209 unsafeVariadicFunction "json_extract_path" (x :* xs)

1254 unsafeVariadicFunction "json_extract_path" (x :* xs)

1210

1255

@@ -1212,9 +1257,9 @@ jsonExtractPath x xs =

1212-- operator).

1257-- operator).

1213jsonbExtractPath

1258jsonbExtractPath

1214 :: SListI elems

1259 :: SListI elems

1215− => Expression schema relations grouping params (nullity 'PGjsonb)

1260+ => Expression schema from grouping params (nullity 'PGjsonb)

1216− -> NP (Expression schema relations grouping params) elems

1261+ -> NP (Expression schema from grouping params) elems

1217− -> Expression schema relations grouping params (nullity 'PGjsonb)

1262+ -> Expression schema from grouping params (nullity 'PGjsonb)

1218jsonbExtractPath x xs =

1263jsonbExtractPath x xs =

1219 unsafeVariadicFunction "jsonb_extract_path" (x :* xs)

1264 unsafeVariadicFunction "jsonb_extract_path" (x :* xs)

1220

1265

@@ -1222,9 +1267,9 @@ jsonbExtractPath x xs =

1222-- operator), as text.

1267-- operator), as text.

1223jsonExtractPathAsText

1268jsonExtractPathAsText

1224 :: SListI elems

1269 :: SListI elems

1225− => Expression schema relations grouping params (nullity 'PGjson)

1270+ => Expression schema from grouping params (nullity 'PGjson)

1226− -> NP (Expression schema relations grouping params) elems

1271+ -> NP (Expression schema from grouping params) elems

1227− -> Expression schema relations grouping params (nullity 'PGjson)

1272+ -> Expression schema from grouping params (nullity 'PGjson)

1228jsonExtractPathAsText x xs =

1273jsonExtractPathAsText x xs =

1229 unsafeVariadicFunction "json_extract_path_text" (x :* xs)

1274 unsafeVariadicFunction "json_extract_path_text" (x :* xs)

1230

1275

@@ -1232,50 +1277,38 @@ jsonExtractPathAsText x xs =

1232-- operator), as text.

1277-- operator), as text.

1233jsonbExtractPathAsText

1278jsonbExtractPathAsText

1234 :: SListI elems

1279 :: SListI elems

1235− => Expression schema relations grouping params (nullity 'PGjsonb)

1280+ => Expression schema from grouping params (nullity 'PGjsonb)

1236− -> NP (Expression schema relations grouping params) elems

1281+ -> NP (Expression schema from grouping params) elems

1237− -> Expression schema relations grouping params (nullity 'PGjsonb)

1282+ -> Expression schema from grouping params (nullity 'PGjsonb)

1238jsonbExtractPathAsText x xs =

1283jsonbExtractPathAsText x xs =

1239 unsafeVariadicFunction "jsonb_extract_path_text" (x :* xs)

1284 unsafeVariadicFunction "jsonb_extract_path_text" (x :* xs)

1240

1285

1241−-- | Returns set of keys in the outermost JSON object.

1242−jsonObjectKeys

1243− :: Expression schema relations grouping params (nullity 'PGjson)

1244− -> Expression schema relations grouping params (nullity 'PGtext)

1245−jsonObjectKeys = unsafeFunction "json_object_keys"

1246−

1247−-- | Returns set of keys in the outermost JSON object.

1248−jsonbObjectKeys

1249− :: Expression schema relations grouping params (nullity 'PGjsonb)

1250− -> Expression schema relations grouping params (nullity 'PGtext)

1251−jsonbObjectKeys = unsafeFunction "jsonb_object_keys"

1252−

1253-- | Returns the type of the outermost JSON value as a text string. Possible

1286-- | Returns the type of the outermost JSON value as a text string. Possible

1254-- types are object, array, string, number, boolean, and null.

1287-- types are object, array, string, number, boolean, and null.

1255jsonTypeof

1288jsonTypeof

1256− :: Expression schema relations grouping params (nullity 'PGjson)

1289+ :: Expression schema from grouping params (nullity 'PGjson)

1257− -> Expression schema relations grouping params (nullity 'PGtext)

1290+ -> Expression schema from grouping params (nullity 'PGtext)

1258jsonTypeof = unsafeFunction "json_typeof"

1291jsonTypeof = unsafeFunction "json_typeof"

1259

1292

1260-- | Returns the type of the outermost binary JSON value as a text string.

1293-- | Returns the type of the outermost binary JSON value as a text string.

1261-- Possible types are object, array, string, number, boolean, and null.

1294-- Possible types are object, array, string, number, boolean, and null.

1262jsonbTypeof

1295jsonbTypeof

1263− :: Expression schema relations grouping params (nullity 'PGjsonb)

1296+ :: Expression schema from grouping params (nullity 'PGjsonb)

1264− -> Expression schema relations grouping params (nullity 'PGtext)

1297+ -> Expression schema from grouping params (nullity 'PGtext)

1265jsonbTypeof = unsafeFunction "jsonb_typeof"

1298jsonbTypeof = unsafeFunction "jsonb_typeof"

1266

1299

1267-- | Returns its argument with all object fields that have null values omitted.

1300-- | Returns its argument with all object fields that have null values omitted.

1268-- Other null values are untouched.

1301-- Other null values are untouched.

1269jsonStripNulls

1302jsonStripNulls

1270− :: Expression schema relations grouping params (nullity 'PGjson)

1303+ :: Expression schema from grouping params (nullity 'PGjson)

1271− -> Expression schema relations grouping params (nullity 'PGjson)

1304+ -> Expression schema from grouping params (nullity 'PGjson)

1272jsonStripNulls = unsafeFunction "json_strip_nulls"

1305jsonStripNulls = unsafeFunction "json_strip_nulls"

1273

1306

1274-- | Returns its argument with all object fields that have null values omitted.

1307-- | Returns its argument with all object fields that have null values omitted.

1275-- Other null values are untouched.

1308-- Other null values are untouched.

1276jsonbStripNulls

1309jsonbStripNulls

1277− :: Expression schema relations grouping params (nullity 'PGjsonb)

1310+ :: Expression schema from grouping params (nullity 'PGjsonb)

1278− -> Expression schema relations grouping params (nullity 'PGjsonb)

1311+ -> Expression schema from grouping params (nullity 'PGjsonb)

1279jsonbStripNulls = unsafeFunction "jsonb_strip_nulls"

1312jsonbStripNulls = unsafeFunction "jsonb_strip_nulls"

1280

1313

1281-- | @ jsonbSet target path new_value create_missing @

1314-- | @ jsonbSet target path new_value create_missing @

@@ -1286,12 +1319,12 @@ jsonbStripNulls = unsafeFunction "jsonb_strip_nulls"

1286-- operators, negative integers that appear in path count from the end of JSON

1319-- operators, negative integers that appear in path count from the end of JSON

1287-- arrays.

1320-- arrays.

1288jsonbSet

1321jsonbSet

1289− :: PGtextArray "jsonbSet" arr

1322+ :: PGTextArray "jsonbSet" arr

1290− => Expression schema relations grouping params (nullity 'PGjsonb)

1323+ => Expression schema from grouping params (nullity 'PGjsonb)

1291− -> Expression schema relations grouping params (nullity arr)

1324+ -> Expression schema from grouping params (nullity arr)

1292− -> Expression schema relations grouping params (nullity 'PGjsonb)

1325+ -> Expression schema from grouping params (nullity 'PGjsonb)

1293− -> Maybe (Expression schema relations grouping params (nullity 'PGbool))

1326+ -> Maybe (Expression schema from grouping params (nullity 'PGbool))

1294− -> Expression schema relations grouping params (nullity 'PGjsonb)

1327+ -> Expression schema from grouping params (nullity 'PGjsonb)

1295jsonbSet tgt path val createMissing = case createMissing of

1328jsonbSet tgt path val createMissing = case createMissing of

1296 Just m -> unsafeVariadicFunction "jsonb_set" (tgt :* path :* val :* m :* Nil)

1329 Just m -> unsafeVariadicFunction "jsonb_set" (tgt :* path :* val :* m :* Nil)

1297 Nothing -> unsafeVariadicFunction "jsonb_set" (tgt :* path :* val :* Nil)

1330 Nothing -> unsafeVariadicFunction "jsonb_set" (tgt :* path :* val :* Nil)

@@ -1305,20 +1338,20 @@ jsonbSet tgt path val createMissing = case createMissing of

1305-- exist. As with the path orientated operators, negative integers that appear

1338-- exist. As with the path orientated operators, negative integers that appear

1306-- in path count from the end of JSON arrays.

1339-- in path count from the end of JSON arrays.

1307jsonbInsert

1340jsonbInsert

1308− :: PGtextArray "jsonbInsert" arr

1341+ :: PGTextArray "jsonbInsert" arr

1309− => Expression schema relations grouping params (nullity 'PGjsonb)

1342+ => Expression schema from grouping params (nullity 'PGjsonb)

1310− -> Expression schema relations grouping params (nullity arr)

1343+ -> Expression schema from grouping params (nullity arr)

1311− -> Expression schema relations grouping params (nullity 'PGjsonb)

1344+ -> Expression schema from grouping params (nullity 'PGjsonb)

1312− -> Maybe (Expression schema relations grouping params (nullity 'PGbool))

1345+ -> Maybe (Expression schema from grouping params (nullity 'PGbool))

1313− -> Expression schema relations grouping params (nullity 'PGjsonb)

1346+ -> Expression schema from grouping params (nullity 'PGjsonb)

1314jsonbInsert tgt path val insertAfter = case insertAfter of

1347jsonbInsert tgt path val insertAfter = case insertAfter of

1315 Just i -> unsafeVariadicFunction "jsonb_insert" (tgt :* path :* val :* i :* Nil)

1348 Just i -> unsafeVariadicFunction "jsonb_insert" (tgt :* path :* val :* i :* Nil)

1316 Nothing -> unsafeVariadicFunction "jsonb_insert" (tgt :* path :* val :* Nil)

1349 Nothing -> unsafeVariadicFunction "jsonb_insert" (tgt :* path :* val :* Nil)

1317

1350

1318-- | Returns its argument as indented JSON text.

1351-- | Returns its argument as indented JSON text.

1319jsonbPretty

1352jsonbPretty

1320− :: Expression schema relations grouping params (nullity 'PGjsonb)

1353+ :: Expression schema from grouping params (nullity 'PGjsonb)

1321− -> Expression schema relations grouping params (nullity 'PGtext)

1354+ -> Expression schema from grouping params (nullity 'PGtext)

1322jsonbPretty = unsafeFunction "jsonb_pretty"

1355jsonbPretty = unsafeFunction "jsonb_pretty"

1323

1356

1324{-----------------------------------------

1357{-----------------------------------------

@@ -1328,16 +1361,16 @@ aggregation

1328-- | escape hatch to define aggregate functions

1361-- | escape hatch to define aggregate functions

1329unsafeAggregate

1362unsafeAggregate

1330 :: ByteString -- ^ aggregate function

1363 :: ByteString -- ^ aggregate function

1331− -> Expression schema relations 'Ungrouped params (xty)

1364+ -> Expression schema from 'Ungrouped params (xty)

1332− -> Expression schema relations ('Grouped bys) params (yty)

1365+ -> Expression schema from ('Grouped bys) params (yty)

1333unsafeAggregate fun x = UnsafeExpression $ mconcat

1366unsafeAggregate fun x = UnsafeExpression $ mconcat

1334 [fun, "(", renderExpression x, ")"]

1367 [fun, "(", renderExpression x, ")"]

1335

1368

1336-- | escape hatch to define aggregate functions over distinct values

1369-- | escape hatch to define aggregate functions over distinct values

1337unsafeAggregateDistinct

1370unsafeAggregateDistinct

1338 :: ByteString -- ^ aggregate function

1371 :: ByteString -- ^ aggregate function

1339− -> Expression schema relations 'Ungrouped params (xty)

1372+ -> Expression schema from 'Ungrouped params (xty)

1340− -> Expression schema relations ('Grouped bys) params (yty)

1373+ -> Expression schema from ('Grouped bys) params (yty)

1341unsafeAggregateDistinct fun x = UnsafeExpression $ mconcat

1374unsafeAggregateDistinct fun x = UnsafeExpression $ mconcat

1342 [fun, "(DISTINCT ", renderExpression x, ")"]

1375 [fun, "(DISTINCT ", renderExpression x, ")"]

1343

1376

@@ -1349,10 +1382,10 @@ unsafeAggregateDistinct fun x = UnsafeExpression $ mconcat

1349-- :}

1382-- :}

1350-- sum("col")

1383-- sum("col")

1351sum_

1384sum_

1352− :: PGNum ty

1385+ :: ty `In` PGNum

1353− => Expression schema relations 'Ungrouped params (nullity ty)

1386+ => Expression schema from 'Ungrouped params (nullity ty)

1354 -- ^ what to sum

1387 -- ^ what to sum

1355− -> Expression schema relations ('Grouped bys) params (nullity ty)

1388+ -> Expression schema from ('Grouped bys) params (nullity ty)

1356sum_ = unsafeAggregate "sum"

1389sum_ = unsafeAggregate "sum"

1357

1390

1358-- | >>> :{

1391-- | >>> :{

@@ -1363,19 +1396,19 @@ sum_ = unsafeAggregate "sum"

1363-- :}

1396-- :}

1364-- sum(DISTINCT "col")

1397-- sum(DISTINCT "col")

1365sumDistinct

1398sumDistinct

1366− :: PGNum ty

1399+ :: ty `In` PGNum

1367− => Expression schema relations 'Ungrouped params (nullity ty)

1400+ => Expression schema from 'Ungrouped params (nullity ty)

1368 -- ^ what to sum

1401 -- ^ what to sum

1369− -> Expression schema relations ('Grouped bys) params (nullity ty)

1402+ -> Expression schema from ('Grouped bys) params (nullity ty)

1370sumDistinct = unsafeAggregateDistinct "sum"

1403sumDistinct = unsafeAggregateDistinct "sum"

1371

1404

1372-- | A constraint for `PGType`s that you can take averages of and the resulting

1405-- | A constraint for `PGType`s that you can take averages of and the resulting

1373-- `PGType`.

1406-- `PGType`.

1374class PGAvg ty avg | ty -> avg where

1407class PGAvg ty avg | ty -> avg where

1375 avg, avgDistinct

1408 avg, avgDistinct

1376− :: Expression schema relations 'Ungrouped params (nullity ty)

1409+ :: Expression schema from 'Ungrouped params (nullity ty)

1377 -- ^ what to average

1410 -- ^ what to average

1378− -> Expression schema relations ('Grouped bys) params (nullity avg)

1411+ -> Expression schema from ('Grouped bys) params (nullity avg)

1379 avg = unsafeAggregate "avg"

1412 avg = unsafeAggregate "avg"

1380 avgDistinct = unsafeAggregateDistinct "avg"

1413 avgDistinct = unsafeAggregateDistinct "avg"

1381instance PGAvg 'PGint2 'PGnumeric

1414instance PGAvg 'PGint2 'PGnumeric

@@ -1394,10 +1427,10 @@ instance PGAvg 'PGinterval 'PGinterval

1394-- :}

1427-- :}

1395-- bit_and("col")

1428-- bit_and("col")

1396bitAnd

1429bitAnd

1397− :: PGIntegral int

1430+ :: int `In` PGIntegral

1398− => Expression schema relations 'Ungrouped params (nullity int)

1431+ => Expression schema from 'Ungrouped params (nullity int)

1399 -- ^ what to aggregate

1432 -- ^ what to aggregate

1400− -> Expression schema relations ('Grouped bys) params (nullity int)

1433+ -> Expression schema from ('Grouped bys) params (nullity int)

1401bitAnd = unsafeAggregate "bit_and"

1434bitAnd = unsafeAggregate "bit_and"

1402

1435

1403-- | >>> :{

1436-- | >>> :{

@@ -1408,10 +1441,10 @@ bitAnd = unsafeAggregate "bit_and"

1408-- :}

1441-- :}

1409-- bit_or("col")

1442-- bit_or("col")

1410bitOr

1443bitOr

1411− :: PGIntegral int

1444+ :: int `In` PGIntegral

1412− => Expression schema relations 'Ungrouped params (nullity int)

1445+ => Expression schema from 'Ungrouped params (nullity int)

1413 -- ^ what to aggregate

1446 -- ^ what to aggregate

1414− -> Expression schema relations ('Grouped bys) params (nullity int)

1447+ -> Expression schema from ('Grouped bys) params (nullity int)

1415bitOr = unsafeAggregate "bit_or"

1448bitOr = unsafeAggregate "bit_or"

1416

1449

1417-- | >>> :{

1450-- | >>> :{

@@ -1422,10 +1455,10 @@ bitOr = unsafeAggregate "bit_or"

1422-- :}

1455-- :}

1423-- bit_and(DISTINCT "col")

1456-- bit_and(DISTINCT "col")

1424bitAndDistinct

1457bitAndDistinct

1425− :: PGIntegral int

1458+ :: int `In` PGIntegral

1426− => Expression schema relations 'Ungrouped params (nullity int)

1459+ => Expression schema from 'Ungrouped params (nullity int)

1427 -- ^ what to aggregate

1460 -- ^ what to aggregate

1428− -> Expression schema relations ('Grouped bys) params (nullity int)

1461+ -> Expression schema from ('Grouped bys) params (nullity int)

1429bitAndDistinct = unsafeAggregateDistinct "bit_and"

1462bitAndDistinct = unsafeAggregateDistinct "bit_and"

1430

1463

1431-- | >>> :{

1464-- | >>> :{

@@ -1436,10 +1469,10 @@ bitAndDistinct = unsafeAggregateDistinct "bit_and"

1436-- :}

1469-- :}

1437-- bit_or(DISTINCT "col")

1470-- bit_or(DISTINCT "col")

1438bitOrDistinct

1471bitOrDistinct

1439− :: PGIntegral int

1472+ :: int `In` PGIntegral

1440− => Expression schema relations 'Ungrouped params (nullity int)

1473+ => Expression schema from 'Ungrouped params (nullity int)

1441 -- ^ what to aggregate

1474 -- ^ what to aggregate

1442− -> Expression schema relations ('Grouped bys) params (nullity int)

1475+ -> Expression schema from ('Grouped bys) params (nullity int)

1443bitOrDistinct = unsafeAggregateDistinct "bit_or"

1476bitOrDistinct = unsafeAggregateDistinct "bit_or"

1444

1477

1445-- | >>> :{

1478-- | >>> :{

@@ -1450,9 +1483,9 @@ bitOrDistinct = unsafeAggregateDistinct "bit_or"

1450-- :}

1483-- :}

1451-- bool_and("col")

1484-- bool_and("col")

1452boolAnd

1485boolAnd

1453− :: Expression schema relations 'Ungrouped params (nullity 'PGbool)

1486+ :: Expression schema from 'Ungrouped params (nullity 'PGbool)

1454 -- ^ what to aggregate

1487 -- ^ what to aggregate

1455− -> Expression schema relations ('Grouped bys) params (nullity 'PGbool)

1488+ -> Expression schema from ('Grouped bys) params (nullity 'PGbool)

1456boolAnd = unsafeAggregate "bool_and"

1489boolAnd = unsafeAggregate "bool_and"

1457

1490

1458-- | >>> :{

1491-- | >>> :{

@@ -1463,9 +1496,9 @@ boolAnd = unsafeAggregate "bool_and"

1463-- :}

1496-- :}

1464-- bool_or("col")

1497-- bool_or("col")

1465boolOr

1498boolOr

1466− :: Expression schema relations 'Ungrouped params (nullity 'PGbool)

1499+ :: Expression schema from 'Ungrouped params (nullity 'PGbool)

1467 -- ^ what to aggregate

1500 -- ^ what to aggregate

1468− -> Expression schema relations ('Grouped bys) params (nullity 'PGbool)

1501+ -> Expression schema from ('Grouped bys) params (nullity 'PGbool)

1469boolOr = unsafeAggregate "bool_or"

1502boolOr = unsafeAggregate "bool_or"

1470

1503

1471-- | >>> :{

1504-- | >>> :{

@@ -1476,9 +1509,9 @@ boolOr = unsafeAggregate "bool_or"

1476-- :}

1509-- :}

1477-- bool_and(DISTINCT "col")

1510-- bool_and(DISTINCT "col")

1478boolAndDistinct

1511boolAndDistinct

1479− :: Expression schema relations 'Ungrouped params (nullity 'PGbool)

1512+ :: Expression schema from 'Ungrouped params (nullity 'PGbool)

1480 -- ^ what to aggregate

1513 -- ^ what to aggregate

1481− -> Expression schema relations ('Grouped bys) params (nullity 'PGbool)

1514+ -> Expression schema from ('Grouped bys) params (nullity 'PGbool)

1482boolAndDistinct = unsafeAggregateDistinct "bool_and"

1515boolAndDistinct = unsafeAggregateDistinct "bool_and"

1483

1516

1484-- | >>> :{

1517-- | >>> :{

@@ -1489,9 +1522,9 @@ boolAndDistinct = unsafeAggregateDistinct "bool_and"

1489-- :}

1522-- :}

1490-- bool_or(DISTINCT "col")

1523-- bool_or(DISTINCT "col")

1491boolOrDistinct

1524boolOrDistinct

1492− :: Expression schema relations 'Ungrouped params (nullity 'PGbool)

1525+ :: Expression schema from 'Ungrouped params (nullity 'PGbool)

1493 -- ^ what to aggregate

1526 -- ^ what to aggregate

1494− -> Expression schema relations ('Grouped bys) params (nullity 'PGbool)

1527+ -> Expression schema from ('Grouped bys) params (nullity 'PGbool)

1495boolOrDistinct = unsafeAggregateDistinct "bool_or"

1528boolOrDistinct = unsafeAggregateDistinct "bool_or"

1496

1529

1497-- | A special aggregation that does not require an input

1530-- | A special aggregation that does not require an input

@@ -1499,7 +1532,7 @@ boolOrDistinct = unsafeAggregateDistinct "bool_or"

1499-- >>> printSQL countStar

1532-- >>> printSQL countStar

1500-- count(*)

1533-- count(*)

1501countStar

1534countStar

1502− :: Expression schema relations ('Grouped bys) params ('NotNull 'PGint8)

1535+ :: Expression schema from ('Grouped bys) params ('NotNull 'PGint8)

1503countStar = UnsafeExpression $ "count(*)"

1536countStar = UnsafeExpression $ "count(*)"

1504

1537

1505-- | >>> :{

1538-- | >>> :{

@@ -1510,9 +1543,9 @@ countStar = UnsafeExpression $ "count(*)"

1510-- :}

1543-- :}

1511-- count("col")

1544-- count("col")

1512count

1545count

1513− :: Expression schema relations 'Ungrouped params ty

1546+ :: Expression schema from 'Ungrouped params ty

1514 -- ^ what to count

1547 -- ^ what to count

1515− -> Expression schema relations ('Grouped bys) params ('NotNull 'PGint8)

1548+ -> Expression schema from ('Grouped bys) params ('NotNull 'PGint8)

1516count = unsafeAggregate "count"

1549count = unsafeAggregate "count"

1517

1550

1518-- | >>> :{

1551-- | >>> :{

@@ -1523,9 +1556,9 @@ count = unsafeAggregate "count"

1523-- :}

1556-- :}

1524-- count(DISTINCT "col")

1557-- count(DISTINCT "col")

1525countDistinct

1558countDistinct

1526− :: Expression schema relations 'Ungrouped params ty

1559+ :: Expression schema from 'Ungrouped params ty

1527 -- ^ what to count

1560 -- ^ what to count

1528− -> Expression schema relations ('Grouped bys) params ('NotNull 'PGint8)

1561+ -> Expression schema from ('Grouped bys) params ('NotNull 'PGint8)

1529countDistinct = unsafeAggregateDistinct "count"

1562countDistinct = unsafeAggregateDistinct "count"

1530

1563

1531-- | synonym for `boolAnd`

1564-- | synonym for `boolAnd`

@@ -1538,9 +1571,9 @@ countDistinct = unsafeAggregateDistinct "count"

1538-- :}

1571-- :}

1539-- every("col")

1572-- every("col")

1540every

1573every

1541− :: Expression schema relations 'Ungrouped params (nullity 'PGbool)

1574+ :: Expression schema from 'Ungrouped params (nullity 'PGbool)

1542 -- ^ what to aggregate

1575 -- ^ what to aggregate

1543− -> Expression schema relations ('Grouped bys) params (nullity 'PGbool)

1576+ -> Expression schema from ('Grouped bys) params (nullity 'PGbool)

1544every = unsafeAggregate "every"

1577every = unsafeAggregate "every"

1545

1578

1546-- | synonym for `boolAndDistinct`

1579-- | synonym for `boolAndDistinct`

@@ -1553,16 +1586,16 @@ every = unsafeAggregate "every"

1553-- :}

1586-- :}

1554-- every(DISTINCT "col")

1587-- every(DISTINCT "col")

1555everyDistinct

1588everyDistinct

1556− :: Expression schema relations 'Ungrouped params (nullity 'PGbool)

1589+ :: Expression schema from 'Ungrouped params (nullity 'PGbool)

1557 -- ^ what to aggregate

1590 -- ^ what to aggregate

1558− -> Expression schema relations ('Grouped bys) params (nullity 'PGbool)

1591+ -> Expression schema from ('Grouped bys) params (nullity 'PGbool)

1559everyDistinct = unsafeAggregateDistinct "every"

1592everyDistinct = unsafeAggregateDistinct "every"

1560

1593

1561-- | minimum and maximum aggregation

1594-- | minimum and maximum aggregation

1562max_, min_, maxDistinct, minDistinct

1595max_, min_, maxDistinct, minDistinct

1563− :: Expression schema relations 'Ungrouped params (nullity ty)

1596+ :: Expression schema from 'Ungrouped params (nullity ty)

1564 -- ^ what to aggregate

1597 -- ^ what to aggregate

1565− -> Expression schema relations ('Grouped bys) params (nullity ty)

1598+ -> Expression schema from ('Grouped bys) params (nullity ty)

1566max_ = unsafeAggregate "max"

1599max_ = unsafeAggregate "max"

1567min_ = unsafeAggregate "min"

1600min_ = unsafeAggregate "min"

1568maxDistinct = unsafeAggregateDistinct "max"

1601maxDistinct = unsafeAggregateDistinct "max"

@@ -1573,134 +1606,153 @@ type expressions

1573-----------------------------------------}

1606-----------------------------------------}

1574

1607

1575-- | `TypeExpression`s are used in `cast`s and `createTable` commands.

1608-- | `TypeExpression`s are used in `cast`s and `createTable` commands.

1576−newtype TypeExpression (schema :: SchemaType) (ty :: PGType)

1609+newtype TypeExpression (schema :: SchemaType) (ty :: NullityType)

1577 = UnsafeTypeExpression { renderTypeExpression :: ByteString }

1610 = UnsafeTypeExpression { renderTypeExpression :: ByteString }

1578 deriving (GHC.Generic,Show,Eq,Ord,NFData)

1611 deriving (GHC.Generic,Show,Eq,Ord,NFData)

1579

1612

1613+-- | The enum or composite type in a `Typedef` can be expressed by its alias.

1614+typedef

1580−instance (Has alias schema ('Typedef ty))

1615+ :: Has alias schema ('Typedef ty)

1616+ => Alias alias

1581− => IsLabel alias (TypeExpression schema ty) where

1617+ -> TypeExpression schema (nullity ty)

1582− fromLabel = UnsafeTypeExpression (renderAlias (fromLabel @alias))

1618+typedef = UnsafeTypeExpression . renderAlias

1619+

1620+-- | The composite type corresponding to a `Table` definition can be expressed

1621+-- by its alias.

1622+typetable

1623+ :: Has alias schema ('Table tab)

1624+ => Alias alias

1625+ -> TypeExpression schema (nullity ('PGcomposite (TableToRow tab)))

1626+typetable = UnsafeTypeExpression . renderAlias

1627+

1628+-- | The composite type corresponding to a `View` definition can be expressed

1629+-- by its alias.

1630+typeview

1631+ :: Has alias schema ('View view)

1632+ => Alias alias

1633+ -> TypeExpression schema (nullity ('PGcomposite view))

1634+typeview = UnsafeTypeExpression . renderAlias

1583

1635

1584-- | logical Boolean (true/false)

1636-- | logical Boolean (true/false)

1585−bool :: TypeExpression schema 'PGbool

1637+bool :: TypeExpression schema (nullity 'PGbool)

1586bool = UnsafeTypeExpression "bool"

1638bool = UnsafeTypeExpression "bool"

1587-- | signed two-byte integer

1639-- | signed two-byte integer

1588−int2, smallint :: TypeExpression schema 'PGint2

1640+int2, smallint :: TypeExpression schema (nullity 'PGint2)

1589int2 = UnsafeTypeExpression "int2"

1641int2 = UnsafeTypeExpression "int2"

1590smallint = UnsafeTypeExpression "smallint"

1642smallint = UnsafeTypeExpression "smallint"

1591-- | signed four-byte integer

1643-- | signed four-byte integer

1592−int4, int, integer :: TypeExpression schema 'PGint4

1644+int4, int, integer :: TypeExpression schema (nullity 'PGint4)

1593int4 = UnsafeTypeExpression "int4"

1645int4 = UnsafeTypeExpression "int4"

1594int = UnsafeTypeExpression "int"

1646int = UnsafeTypeExpression "int"

1595integer = UnsafeTypeExpression "integer"

1647integer = UnsafeTypeExpression "integer"

1596-- | signed eight-byte integer

1648-- | signed eight-byte integer

1597−int8, bigint :: TypeExpression schema 'PGint8

1649+int8, bigint :: TypeExpression schema (nullity 'PGint8)

1598int8 = UnsafeTypeExpression "int8"

1650int8 = UnsafeTypeExpression "int8"

1599bigint = UnsafeTypeExpression "bigint"

1651bigint = UnsafeTypeExpression "bigint"

1600-- | arbitrary precision numeric type

1652-- | arbitrary precision numeric type

1601−numeric :: TypeExpression schema 'PGnumeric

1653+numeric :: TypeExpression schema (nullity 'PGnumeric)

1602numeric = UnsafeTypeExpression "numeric"

1654numeric = UnsafeTypeExpression "numeric"

1603-- | single precision floating-point number (4 bytes)

1655-- | single precision floating-point number (4 bytes)

1604−float4, real :: TypeExpression schema 'PGfloat4

1656+float4, real :: TypeExpression schema (nullity 'PGfloat4)

1605float4 = UnsafeTypeExpression "float4"

1657float4 = UnsafeTypeExpression "float4"

1606real = UnsafeTypeExpression "real"

1658real = UnsafeTypeExpression "real"

1607-- | double precision floating-point number (8 bytes)

1659-- | double precision floating-point number (8 bytes)

1608−float8, doublePrecision :: TypeExpression schema 'PGfloat8

1660+float8, doublePrecision :: TypeExpression schema (nullity 'PGfloat8)

1609float8 = UnsafeTypeExpression "float8"

1661float8 = UnsafeTypeExpression "float8"

1610doublePrecision = UnsafeTypeExpression "double precision"

1662doublePrecision = UnsafeTypeExpression "double precision"

1611-- | variable-length character string

1663-- | variable-length character string

1612−text :: TypeExpression schema 'PGtext

1664+text :: TypeExpression schema (nullity 'PGtext)

1613text = UnsafeTypeExpression "text"

1665text = UnsafeTypeExpression "text"

1614-- | fixed-length character string

1666-- | fixed-length character string

1615char, character

1667char, character

1616− :: (KnownNat n, 1 <= n)

1668+ :: forall n schema nullity. (KnownNat n, 1 <= n)

1617− => proxy n

1618− -> TypeExpression schema ('PGchar n)

1669+ => TypeExpression schema (nullity ('PGchar n))

1619−char p = UnsafeTypeExpression $ "char(" <> renderNat p <> ")"

1670+char = UnsafeTypeExpression $ "char(" <> renderNat @n <> ")"

1620−character p = UnsafeTypeExpression $ "character(" <> renderNat p <> ")"

1671+character = UnsafeTypeExpression $ "character(" <> renderNat @n <> ")"

1621-- | variable-length character string

1672-- | variable-length character string

1622varchar, characterVarying

1673varchar, characterVarying

1623− :: (KnownNat n, 1 <= n)

1674+ :: forall n schema nullity. (KnownNat n, 1 <= n)

1624− => proxy n

1625− -> TypeExpression schema ('PGvarchar n)

1675+ => TypeExpression schema (nullity ('PGvarchar n))

1626−varchar p = UnsafeTypeExpression $ "varchar(" <> renderNat p <> ")"

1676+varchar = UnsafeTypeExpression $ "varchar(" <> renderNat @n <> ")"

1627−characterVarying p = UnsafeTypeExpression $

1677+characterVarying = UnsafeTypeExpression $

1628− "character varying(" <> renderNat p <> ")"

1678+ "character varying(" <> renderNat @n <> ")"

1629-- | binary data ("byte array")

1679-- | binary data ("byte array")

1630−bytea :: TypeExpression schema 'PGbytea

1680+bytea :: TypeExpression schema (nullity 'PGbytea)

1631bytea = UnsafeTypeExpression "bytea"

1681bytea = UnsafeTypeExpression "bytea"

1632-- | date and time (no time zone)

1682-- | date and time (no time zone)

1633−timestamp :: TypeExpression schema 'PGtimestamp

1683+timestamp :: TypeExpression schema (nullity 'PGtimestamp)

1634timestamp = UnsafeTypeExpression "timestamp"

1684timestamp = UnsafeTypeExpression "timestamp"

1635-- | date and time, including time zone

1685-- | date and time, including time zone

1636−timestampWithTimeZone :: TypeExpression schema 'PGtimestamptz

1686+timestampWithTimeZone :: TypeExpression schema (nullity 'PGtimestamptz)

1637timestampWithTimeZone = UnsafeTypeExpression "timestamp with time zone"

1687timestampWithTimeZone = UnsafeTypeExpression "timestamp with time zone"

1638-- | calendar date (year, month, day)

1688-- | calendar date (year, month, day)

1639−date :: TypeExpression schema 'PGdate

1689+date :: TypeExpression schema (nullity 'PGdate)

1640date = UnsafeTypeExpression "date"

1690date = UnsafeTypeExpression "date"

1641-- | time of day (no time zone)

1691-- | time of day (no time zone)

1642−time :: TypeExpression schema 'PGtime

1692+time :: TypeExpression schema (nullity 'PGtime)

1643time = UnsafeTypeExpression "time"

1693time = UnsafeTypeExpression "time"

1644-- | time of day, including time zone

1694-- | time of day, including time zone

1645−timeWithTimeZone :: TypeExpression schema 'PGtimetz

1695+timeWithTimeZone :: TypeExpression schema (nullity 'PGtimetz)

1646timeWithTimeZone = UnsafeTypeExpression "time with time zone"

1696timeWithTimeZone = UnsafeTypeExpression "time with time zone"

1647-- | time span

1697-- | time span

1648−interval :: TypeExpression schema 'PGinterval

1698+interval :: TypeExpression schema (nullity 'PGinterval)

1649interval = UnsafeTypeExpression "interval"

1699interval = UnsafeTypeExpression "interval"

1650-- | universally unique identifier

1700-- | universally unique identifier

1651−uuid :: TypeExpression schema 'PGuuid

1701+uuid :: TypeExpression schema (nullity 'PGuuid)

1652uuid = UnsafeTypeExpression "uuid"

1702uuid = UnsafeTypeExpression "uuid"

1653-- | IPv4 or IPv6 host address

1703-- | IPv4 or IPv6 host address

1654−inet :: TypeExpression schema 'PGinet

1704+inet :: TypeExpression schema (nullity 'PGinet)

1655inet = UnsafeTypeExpression "inet"

1705inet = UnsafeTypeExpression "inet"

1656-- | textual JSON data

1706-- | textual JSON data

1657−json :: TypeExpression schema 'PGjson

1707+json :: TypeExpression schema (nullity 'PGjson)

1658json = UnsafeTypeExpression "json"

1708json = UnsafeTypeExpression "json"

1659-- | binary JSON data, decomposed

1709-- | binary JSON data, decomposed

1660−jsonb :: TypeExpression schema 'PGjsonb

1710+jsonb :: TypeExpression schema (nullity 'PGjsonb)

1661jsonb = UnsafeTypeExpression "jsonb"

1711jsonb = UnsafeTypeExpression "jsonb"

1662-- | variable length array

1712-- | variable length array

1663vararray

1713vararray

1664 :: TypeExpression schema pg

1714 :: TypeExpression schema pg

1665− -> TypeExpression schema ('PGvararray pg)

1715+ -> TypeExpression schema (nullity ('PGvararray pg))

1666vararray ty = UnsafeTypeExpression $ renderTypeExpression ty <> "[]"

1716vararray ty = UnsafeTypeExpression $ renderTypeExpression ty <> "[]"

1667-- | fixed length array

1717-- | fixed length array

1668--

1718--

1669−-- >>> renderTypeExpression (fixarray (Proxy @2) json)

1719+-- >>> renderTypeExpression (fixarray @2 json)

1670-- "json[2]"

1720-- "json[2]"

1671fixarray

1721fixarray

1672− :: KnownNat n

1722+ :: forall n schema nullity pg. KnownNat n

1673− => proxy n

1674− -> TypeExpression schema pg

1723+ => TypeExpression schema pg

1675− -> TypeExpression schema ('PGfixarray n pg)

1724+ -> TypeExpression schema (nullity ('PGfixarray n pg))

1676−fixarray p ty = UnsafeTypeExpression $

1725+fixarray ty = UnsafeTypeExpression $

1677− renderTypeExpression ty <> "[" <> renderNat p <> "]"

1726+ renderTypeExpression ty <> "[" <> renderNat @n <> "]"

1678

1727

1679-- | `pgtype` is a demoted version of a `PGType`

1728-- | `pgtype` is a demoted version of a `PGType`

1729+class PGTyped schema (ty :: NullityType) where

1680−class PGTyped schema (ty :: PGType) where pgtype :: TypeExpression schema ty

1730+ pgtype :: TypeExpression schema ty

1681−instance PGTyped schema 'PGbool where pgtype = bool

1731+instance PGTyped schema (nullity 'PGbool) where pgtype = bool

1682−instance PGTyped schema 'PGint2 where pgtype = int2

1732+instance PGTyped schema (nullity 'PGint2) where pgtype = int2

1683−instance PGTyped schema 'PGint4 where pgtype = int4

1733+instance PGTyped schema (nullity 'PGint4) where pgtype = int4

1684−instance PGTyped schema 'PGint8 where pgtype = int8

1734+instance PGTyped schema (nullity 'PGint8) where pgtype = int8

1685−instance PGTyped schema 'PGnumeric where pgtype = numeric

1735+instance PGTyped schema (nullity 'PGnumeric) where pgtype = numeric

1686−instance PGTyped schema 'PGfloat4 where pgtype = float4

1736+instance PGTyped schema (nullity 'PGfloat4) where pgtype = float4

1687−instance PGTyped schema 'PGfloat8 where pgtype = float8

1737+instance PGTyped schema (nullity 'PGfloat8) where pgtype = float8

1688−instance PGTyped schema 'PGtext where pgtype = text

1738+instance PGTyped schema (nullity 'PGtext) where pgtype = text

1689instance (KnownNat n, 1 <= n)

1739instance (KnownNat n, 1 <= n)

1690− => PGTyped schema ('PGchar n) where pgtype = char (Proxy @n)

1740+ => PGTyped schema (nullity ('PGchar n)) where pgtype = char @n

1691instance (KnownNat n, 1 <= n)

1741instance (KnownNat n, 1 <= n)

1692− => PGTyped schema ('PGvarchar n) where pgtype = varchar (Proxy @n)

1742+ => PGTyped schema (nullity ('PGvarchar n)) where pgtype = varchar @n

1693−instance PGTyped schema 'PGbytea where pgtype = bytea

1743+instance PGTyped schema (nullity 'PGbytea) where pgtype = bytea

1694−instance PGTyped schema 'PGtimestamp where pgtype = timestamp

1744+instance PGTyped schema (nullity 'PGtimestamp) where pgtype = timestamp

1695−instance PGTyped schema 'PGtimestamptz where pgtype = timestampWithTimeZone

1745+instance PGTyped schema (nullity 'PGtimestamptz) where pgtype = timestampWithTimeZone

1696−instance PGTyped schema 'PGdate where pgtype = date

1746+instance PGTyped schema (nullity 'PGdate) where pgtype = date

1697−instance PGTyped schema 'PGtime where pgtype = time

1747+instance PGTyped schema (nullity 'PGtime) where pgtype = time

1698−instance PGTyped schema 'PGtimetz where pgtype = timeWithTimeZone

1748+instance PGTyped schema (nullity 'PGtimetz) where pgtype = timeWithTimeZone

1699−instance PGTyped schema 'PGinterval where pgtype = interval

1749+instance PGTyped schema (nullity 'PGinterval) where pgtype = interval

1700−instance PGTyped schema 'PGuuid where pgtype = uuid

1750+instance PGTyped schema (nullity 'PGuuid) where pgtype = uuid

1701−instance PGTyped schema 'PGjson where pgtype = json

1751+instance PGTyped schema (nullity 'PGjson) where pgtype = json

1702−instance PGTyped schema 'PGjsonb where pgtype = jsonb

1752+instance PGTyped schema (nullity 'PGjsonb) where pgtype = jsonb

1753+instance PGTyped schema ty

1703−instance PGTyped schema ty => PGTyped schema ('PGvararray ty) where

1754+ => PGTyped schema (nullity ('PGvararray ty)) where

1704− pgtype = vararray (pgtype @schema @ty)

1755+ pgtype = vararray (pgtype @schema @ty)

1705−instance (KnownNat n, PGTyped schema ty) => PGTyped schema ('PGfixarray n ty) where

1756+instance (KnownNat n, PGTyped schema ty)

1757+ => PGTyped schema (nullity ('PGfixarray n ty)) where

1706− pgtype = fixarray (Proxy @n) (pgtype @schema @ty)

1758+ pgtype = fixarray @n (pgtype @schema @ty)

squeal-postgresql/src/Squeal/PostgreSQL/Manipulation.hs+66−74

@@ -42,13 +42,10 @@ module Squeal.PostgreSQL.Manipulation

42 -- * Delete

43 , deleteFrom

44 , deleteFrom_

45− -- * With

46− , with

47 ) where

45 ) where

49import Control.DeepSeq

47import Control.DeepSeq

50import Data.ByteString hiding (foldr)

48import Data.ByteString hiding (foldr)

51−import Data.Monoid

53import qualified Generics.SOP as SOP

50import qualified Generics.SOP as SOP

54import qualified GHC.Generics as GHC

51import qualified GHC.Generics as GHC

@@ -180,16 +177,38 @@ let

180in printSQL manipulation

177in printSQL manipulation

181:}

178:}

182DELETE FROM "tab" WHERE ("col1" = "col2") RETURNING *

179DELETE FROM "tab" WHERE ("col1" = "col2") RETURNING *

180+

181+with manipulation:

182+

183+>>> type ProductsTable = '[] :=> '["product" ::: 'NoDef :=> 'NotNull 'PGtext, "date" ::: 'Def :=> 'NotNull 'PGdate]

184+

185+>>> :{

186+let

187+ manipulation :: Manipulation

188+ '[ "products" ::: 'Table ProductsTable

189+ , "products_deleted" ::: 'Table ProductsTable

190+ ] '[ 'NotNull 'PGdate] '[]

191+ manipulation = with

192+ (deleteFrom #products (#date .< param @1) ReturningStar `as` #deleted_rows)

193+ (insertQuery_ #products_deleted (selectStar (from (view (#deleted_rows `as` #t)))))

194+in printSQL manipulation

195+:}

196+WITH "deleted_rows" AS (DELETE FROM "products" WHERE ("date" < ($1 :: date)) RETURNING *) INSERT INTO "products_deleted" SELECT * FROM "deleted_rows" AS "t"

183-}

197-}

198+

184newtype Manipulation

199newtype Manipulation

185 (schema :: SchemaType)

200 (schema :: SchemaType)

186 (params :: [NullityType])

201 (params :: [NullityType])

187− (columns :: RelationType)

202+ (columns :: RowType)

188 = UnsafeManipulation { renderManipulation :: ByteString }

203 = UnsafeManipulation { renderManipulation :: ByteString }

189 deriving (GHC.Generic,Show,Eq,Ord,NFData)

204 deriving (GHC.Generic,Show,Eq,Ord,NFData)

190−

191instance RenderSQL (Manipulation schema params columns) where

205instance RenderSQL (Manipulation schema params columns) where

192 renderSQL = renderManipulation

206 renderSQL = renderManipulation

207+instance With Manipulation where

208+ with Done manip = manip

209+ with (cte :>> ctes) manip = UnsafeManipulation $

210+ "WITH" <+> renderCommonTableExpressions renderManipulation cte ctes

211+ <+> renderManipulation manip

193

212

194-- | Convert a `Query` into a `Manipulation`.

213-- | Convert a `Query` into a `Manipulation`.

195queryStatement

214queryStatement

@@ -212,13 +231,14 @@ insertRows

212 :: ( SOP.SListI columns

231 :: ( SOP.SListI columns

213 , SOP.SListI results

232 , SOP.SListI results

214 , Has tab schema ('Table table)

233 , Has tab schema ('Table table)

234+ , row ~ TableToRow table

215 , columns ~ TableToColumns table )

235 , columns ~ TableToColumns table )

216 => Alias tab -- ^ table to insert into

236 => Alias tab -- ^ table to insert into

217 -> NP (Aliased (ColumnValue schema '[] params)) columns -- ^ row to insert

237 -> NP (Aliased (ColumnValue schema '[] params)) columns -- ^ row to insert

218 -> [NP (Aliased (ColumnValue schema '[] params)) columns] -- ^ more rows to insert

238 -> [NP (Aliased (ColumnValue schema '[] params)) columns] -- ^ more rows to insert

219− -> ConflictClause schema columns params

239+ -> ConflictClause schema table params

220 -- ^ what to do in case of constraint conflict

240 -- ^ what to do in case of constraint conflict

221− -> ReturningClause schema columns params results -- ^ results to return

241+ -> ReturningClause schema params row results -- ^ results to return

222 -> Manipulation schema params results

242 -> Manipulation schema params results

223insertRows tab rw rws conflict returning = UnsafeManipulation $

243insertRows tab rw rws conflict returning = UnsafeManipulation $

224 "INSERT" <+> "INTO" <+> renderAlias tab

244 "INSERT" <+> "INTO" <+> renderAlias tab

@@ -242,12 +262,13 @@ insertRow

242 :: ( SOP.SListI columns

262 :: ( SOP.SListI columns

243 , SOP.SListI results

263 , SOP.SListI results

244 , Has tab schema ('Table table)

264 , Has tab schema ('Table table)

265+ , row ~ TableToRow table

245 , columns ~ TableToColumns table )

266 , columns ~ TableToColumns table )

246 => Alias tab -- ^ table to insert into

267 => Alias tab -- ^ table to insert into

247 -> NP (Aliased (ColumnValue schema '[] params)) columns -- ^ row to insert

268 -> NP (Aliased (ColumnValue schema '[] params)) columns -- ^ row to insert

248− -> ConflictClause schema columns params

269+ -> ConflictClause schema table params

249 -- ^ what to do in case of constraint conflict

270 -- ^ what to do in case of constraint conflict

250− -> ReturningClause schema columns params results -- ^ results to return

271+ -> ReturningClause schema params row results -- ^ results to return

251 -> Manipulation schema params results

272 -> Manipulation schema params results

252insertRow tab rw = insertRows tab rw []

273insertRow tab rw = insertRows tab rw []

253

274

@@ -278,12 +299,13 @@ insertQuery

278 :: ( SOP.SListI columns

299 :: ( SOP.SListI columns

279 , SOP.SListI results

300 , SOP.SListI results

280 , Has tab schema ('Table table)

301 , Has tab schema ('Table table)

302+ , row ~ TableToRow table

281 , columns ~ TableToColumns table )

303 , columns ~ TableToColumns table )

282 => Alias tab -- ^ table to insert into

304 => Alias tab -- ^ table to insert into

283− -> Query schema params (ColumnsToRelation columns)

305+ -> Query schema params (TableToRow table)

284− -> ConflictClause schema columns params

306+ -> ConflictClause schema table params

285 -- ^ what to do in case of constraint conflict

307 -- ^ what to do in case of constraint conflict

286− -> ReturningClause schema columns params results -- ^ results to return

308+ -> ReturningClause schema params row results -- ^ results to return

287 -> Manipulation schema params results

309 -> Manipulation schema params results

288insertQuery tab query conflict returning = UnsafeManipulation $

310insertQuery tab query conflict returning = UnsafeManipulation $

289 "INSERT" <+> "INTO" <+> renderAlias tab

311 "INSERT" <+> "INTO" <+> renderAlias tab

@@ -297,7 +319,7 @@ insertQuery_

297 , Has tab schema ('Table table)

319 , Has tab schema ('Table table)

298 , columns ~ TableToColumns table )

320 , columns ~ TableToColumns table )

299 => Alias tab -- ^ table to insert into

321 => Alias tab -- ^ table to insert into

300− -> Query schema params (ColumnsToRelation columns)

322+ -> Query schema params (TableToRow table)

301 -> Manipulation schema params '[]

323 -> Manipulation schema params '[]

302insertQuery_ tab query =

324insertQuery_ tab query =

303 insertQuery tab query OnConflictDoRaise (Returning Nil)

325 insertQuery tab query OnConflictDoRaise (Returning Nil)

@@ -309,7 +331,7 @@ insertQuery_ tab query =

309-- existing value in the row for an update.

331-- existing value in the row for an update.

310data ColumnValue

332data ColumnValue

311 (schema :: SchemaType)

333 (schema :: SchemaType)

312− (columns :: RelationType)

334+ (columns :: RowType)

313 (params :: [NullityType])

335 (params :: [NullityType])

314 (ty :: ColumnType)

336 (ty :: ColumnType)

315 where

337 where

@@ -331,17 +353,15 @@ data ColumnValue

331-- values are desired.

353-- values are desired.

332data ReturningClause

354data ReturningClause

333 (schema :: SchemaType)

355 (schema :: SchemaType)

334− (columns :: ColumnsType)

335 (params :: [NullityType])

356 (params :: [NullityType])

336− (results :: RelationType)

357+ (row0 :: RowType)

358+ (row1 :: RowType)

337 where

359 where

338 ReturningStar

360 ReturningStar

339− :: results ~ ColumnsToRelation columns

340− => ReturningClause schema columns params results

361+ :: ReturningClause schema params row row

341 Returning

362 Returning

342− :: rel ~ ColumnsToRelation columns

343− => NP (Aliased (Expression schema '[table ::: rel] 'Ungrouped params)) results

363+ :: NP (Aliased (Expression schema '[table ::: row0] 'Ungrouped params)) row1

344− -> ReturningClause schema columns params results

364+ -> ReturningClause schema params row0 row1

345

365

346-- | Render a `ReturningClause`.

366-- | Render a `ReturningClause`.

347renderReturningClause

367renderReturningClause

@@ -359,18 +379,22 @@ renderReturningClause = \case

359-- `OnConflictDoNothing` simply avoids inserting a row.

379-- `OnConflictDoNothing` simply avoids inserting a row.

360-- `OnConflictDoUpdate` updates the existing row that conflicts with the row

380-- `OnConflictDoUpdate` updates the existing row that conflicts with the row

361-- proposed for insertion.

381-- proposed for insertion.

362−data ConflictClause (schema :: SchemaType) (columns :: ColumnsType) params where

382+data ConflictClause

383+ (schema :: SchemaType)

384+ (table :: TableType)

385+ (params :: [NullityType]) where

363− OnConflictDoRaise :: ConflictClause schema columns params

386+ OnConflictDoRaise :: ConflictClause schema table params

364− OnConflictDoNothing :: ConflictClause schema columns params

387+ OnConflictDoNothing :: ConflictClause schema table params

365− OnConflictDoUpdate

388+ OnConflictDoUpdate

389+ :: (row ~ TableToRow table, columns ~ TableToColumns table)

366− :: NP (Aliased (ColumnValue schema (ColumnsToRelation columns) params)) columns

390+ => NP (Aliased (ColumnValue schema row params)) columns

367− -> [Condition schema '[table ::: ColumnsToRelation columns] 'Ungrouped params]

391+ -> [Condition schema '[t ::: row] 'Ungrouped params]

368− -> ConflictClause schema columns params

392+ -> ConflictClause schema table params

369

393

370-- | Render a `ConflictClause`.

394-- | Render a `ConflictClause`.

371renderConflictClause

395renderConflictClause

372− :: SOP.SListI columns

396+ :: SOP.SListI (TableToColumns table)

373− => ConflictClause schema columns params

397+ => ConflictClause schema table params

374 -> ByteString

398 -> ByteString

375renderConflictClause = \case

399renderConflictClause = \case

376 OnConflictDoRaise -> ""

400 OnConflictDoRaise -> ""

@@ -402,13 +426,14 @@ update

402 :: ( SOP.SListI columns

426 :: ( SOP.SListI columns

403 , SOP.SListI results

427 , SOP.SListI results

404 , Has tab schema ('Table table)

428 , Has tab schema ('Table table)

429+ , row ~ TableToRow table

405 , columns ~ TableToColumns table )

430 , columns ~ TableToColumns table )

406 => Alias tab -- ^ table to update

431 => Alias tab -- ^ table to update

407− -> NP (Aliased (ColumnValue schema (ColumnsToRelation columns) params)) columns

432+ -> NP (Aliased (ColumnValue schema row params)) columns

408 -- ^ modified values to replace old values

433 -- ^ modified values to replace old values

409− -> Condition schema '[tab ::: ColumnsToRelation columns] 'Ungrouped params

434+ -> (forall t. Condition schema '[t ::: row] 'Ungrouped params)

410 -- ^ condition under which to perform update on a row

435 -- ^ condition under which to perform update on a row

411− -> ReturningClause schema columns params results -- ^ results to return

436+ -> ReturningClause schema params row results -- ^ results to return

412 -> Manipulation schema params results

437 -> Manipulation schema params results

413update tab columns wh returning = UnsafeManipulation $

438update tab columns wh returning = UnsafeManipulation $

414 "UPDATE"

439 "UPDATE"

@@ -432,11 +457,12 @@ update tab columns wh returning = UnsafeManipulation $

432update_

457update_

433 :: ( SOP.SListI columns

458 :: ( SOP.SListI columns

434 , Has tab schema ('Table table)

459 , Has tab schema ('Table table)

460+ , row ~ TableToRow table

435 , columns ~ TableToColumns table )

461 , columns ~ TableToColumns table )

436 => Alias tab -- ^ table to update

462 => Alias tab -- ^ table to update

437− -> NP (Aliased (ColumnValue schema (ColumnsToRelation columns) params)) columns

463+ -> NP (Aliased (ColumnValue schema row params)) columns

438 -- ^ modified values to replace old values

464 -- ^ modified values to replace old values

439− -> Condition schema '[tab ::: ColumnsToRelation columns] 'Ungrouped params

465+ -> (forall t. Condition schema '[t ::: row] 'Ungrouped params)

440 -- ^ condition under which to perform update on a row

466 -- ^ condition under which to perform update on a row

441 -> Manipulation schema params '[]

467 -> Manipulation schema params '[]

442update_ tab columns wh = update tab columns wh (Returning Nil)

468update_ tab columns wh = update tab columns wh (Returning Nil)

@@ -449,11 +475,12 @@ DELETE statements

449deleteFrom

475deleteFrom

450 :: ( SOP.SListI results

476 :: ( SOP.SListI results

451 , Has tab schema ('Table table)

477 , Has tab schema ('Table table)

478+ , row ~ TableToRow table

452 , columns ~ TableToColumns table )

479 , columns ~ TableToColumns table )

453 => Alias tab -- ^ table to delete from

480 => Alias tab -- ^ table to delete from

454− -> Condition schema '[tab ::: ColumnsToRelation columns] 'Ungrouped params

481+ -> Condition schema '[tab ::: row] 'Ungrouped params

455 -- ^ condition under which to delete a row

482 -- ^ condition under which to delete a row

456− -> ReturningClause schema columns params results -- ^ results to return

483+ -> ReturningClause schema params row results -- ^ results to return

457 -> Manipulation schema params results

484 -> Manipulation schema params results

458deleteFrom tab wh returning = UnsafeManipulation $

485deleteFrom tab wh returning = UnsafeManipulation $

459 "DELETE FROM" <+> renderAlias tab

486 "DELETE FROM" <+> renderAlias tab

@@ -463,45 +490,10 @@ deleteFrom tab wh returning = UnsafeManipulation $

463-- | Delete rows returning `Nil`.

490-- | Delete rows returning `Nil`.

464deleteFrom_

491deleteFrom_

465 :: ( Has tab schema ('Table table)

492 :: ( Has tab schema ('Table table)

493+ , row ~ TableToRow table

466 , columns ~ TableToColumns table )

494 , columns ~ TableToColumns table )

467 => Alias tab -- ^ table to delete from

495 => Alias tab -- ^ table to delete from

468− -> Condition schema '[tab ::: ColumnsToRelation columns] 'Ungrouped params

496+ -> (forall t. Condition schema '[t ::: row] 'Ungrouped params)

469 -- ^ condition under which to delete a row

497 -- ^ condition under which to delete a row

470 -> Manipulation schema params '[]

498 -> Manipulation schema params '[]

471deleteFrom_ tab wh = deleteFrom tab wh (Returning Nil)

499deleteFrom_ tab wh = deleteFrom tab wh (Returning Nil)

472−

473−{-----------------------------------------

474−WITH statements

475−-----------------------------------------}

476−

477−-- | `with` provides a way to write auxiliary statements for use in a larger statement.

478−-- These statements, which are often referred to as Common Table Expressions or CTEs,

479−-- can be thought of as defining temporary tables that exist just for one statement.

480−--

481−-- >>> type ProductsTable = '[] :=> '["product" ::: 'NoDef :=> 'NotNull 'PGtext, "date" ::: 'Def :=> 'NotNull 'PGdate]

482−--

483−-- >>> :{

484−-- let

485−-- manipulation :: Manipulation '["products" ::: 'Table ProductsTable, "products_deleted" ::: 'Table ProductsTable] '[ 'NotNull 'PGdate] '[]

486−-- manipulation = with

487−-- (deleteFrom #products (#date .< param @1) ReturningStar `as` #deleted_rows)

488−-- (insertQuery_ #products_deleted (selectStar (from (view (#deleted_rows `as` #t)))))

489−-- in printSQL manipulation

490−-- :}

491−-- WITH "deleted_rows" AS (DELETE FROM "products" WHERE ("date" < ($1 :: date)) RETURNING *) INSERT INTO "products_deleted" SELECT * FROM "deleted_rows" AS "t"

492−with

493− :: SOP.SListI commons

494− => NP (Aliased (Manipulation schema params)) (common ': commons)

495− -- ^ common table expressions

496− -> Manipulation (With (common ': commons) schema) params results

497− -> Manipulation schema params results

498−with commons manipulation = UnsafeManipulation $

499− "WITH" <+> renderCommaSeparated renderCommon commons

500− <+> renderManipulation manipulation

501− where

502− renderCommon

503− :: Aliased (Manipulation schema params) common

504− -> ByteString

505− renderCommon (common `As` alias) =

506− renderAlias alias <+> "AS" <+>

507− parenthesized (renderManipulation common)

squeal-postgresql/src/Squeal/PostgreSQL/Migration.hs−21

@@ -105,9 +105,6 @@ module Squeal.PostgreSQL.Migration

105 Migration (..)

106 , migrateUp

107 , migrateDown

108− -- * Aligned lists

109− , AlignedList (..)

110− , single

111 -- * Migration table

108 -- * Migration table

112 , MigrationsTable

109 , MigrationsTable

113 , createMigrations

110 , createMigrations

@@ -116,15 +113,12 @@ module Squeal.PostgreSQL.Migration

116 , selectMigration

113 , selectMigration

117 ) where

114 ) where

118

115

119−import Control.Category

120import Control.Monad

116import Control.Monad

121import Control.Monad.Base

117import Control.Monad.Base

122import Control.Monad.Trans.Control

118import Control.Monad.Trans.Control

123−import Data.Monoid

124import Generics.SOP (K(..))

119import Generics.SOP (K(..))

125import Data.Function ((&))

120import Data.Function ((&))

126import Data.Text (Text)

121import Data.Text (Text)

127−import Prelude hiding (id, (.))

128

122

129import Squeal.PostgreSQL

123import Squeal.PostgreSQL

130

124

@@ -137,21 +131,6 @@ data Migration io schema0 schema1 = Migration

137 , down :: PQ schema1 schema0 io () -- ^ The `down` instruction of a `Migration`.

131 , down :: PQ schema1 schema0 io () -- ^ The `down` instruction of a `Migration`.

138 }

132 }

139

133

140−-- | An `AlignedList` is a type-aligned list or free category.

141−data AlignedList p x0 x1 where

142− Done :: AlignedList p x x

143− (:>>) :: p x0 x1 -> AlignedList p x1 x2 -> AlignedList p x0 x2

144−infixr 7 :>>

145−instance Category (AlignedList p) where

146− id = Done

147− (.) list = \case

148− Done -> list

149− step :>> steps -> step :>> (steps >>> list)

150−

151−-- | A `single` step.

152−single :: p x0 x1 -> AlignedList p x0 x1

153−single step = step :>> Done

154−

155-- | Run `Migration`s by creating the `MigrationsTable`

134-- | Run `Migration`s by creating the `MigrationsTable`

156-- if it does not exist and then in a transaction, for each each `Migration`

135-- if it does not exist and then in a transaction, for each each `Migration`

157-- query to see if the `Migration` is executed. If not, then

136-- query to see if the `Migration` is executed. If not, then

squeal-postgresql/src/Squeal/PostgreSQL/PQ.hs+102−45

@@ -50,7 +50,7 @@ module Squeal.PostgreSQL.PQ

50 , MonadPQ (..)

51 , PQRun

52 , pqliftWith

53− -- * Result

53+ -- * Results

54 , LibPQ.Result

55 , LibPQ.Row

56 , ntuples

@@ -62,6 +62,11 @@ module Squeal.PostgreSQL.PQ

62 , LibPQ.ExecStatus (..)

63 , resultStatus

64 , resultErrorMessage

65+ , resultErrorCode

66+ -- * Exceptions

67+ , SquealException (..)

68+ , catchSqueal

69+ , handleSqueal

65 ) where

70 ) where

67import Control.Exception.Lifted

72import Control.Exception.Lifted

@@ -73,9 +78,10 @@ import Data.ByteString (ByteString)

73import Data.Foldable

78import Data.Foldable

74import Data.Function ((&))

79import Data.Function ((&))

75import Data.Kind

80import Data.Kind

76−import Data.Monoid

81+import Data.Text (pack, Text)

77import Data.Traversable

82import Data.Traversable

78import Generics.SOP

83import Generics.SOP

84+import PostgreSQL.Binary.Encoding (encodingBytes)

80import qualified Database.PostgreSQL.LibPQ as LibPQ

86import qualified Database.PostgreSQL.LibPQ as LibPQ

@@ -90,7 +96,6 @@ import Control.Monad.Trans.Identity

90import Control.Monad.Trans.Reader

96import Control.Monad.Trans.Reader

91import Control.Monad.Trans.Maybe

97import Control.Monad.Trans.Maybe

92import Control.Monad.Trans.Cont

98import Control.Monad.Trans.Cont

93−import Control.Monad.Trans.List

95import qualified Control.Monad.Trans.State.Lazy as Lazy

100import qualified Control.Monad.Trans.State.Lazy as Lazy

96import qualified Control.Monad.Trans.State.Strict as Strict

101import qualified Control.Monad.Trans.State.Strict as Strict

@@ -269,7 +274,7 @@ instance IndexedMonadTransPQ PQ where

269 define (UnsafeDefinition q) = PQ $ \ (K conn) -> do

274 define (UnsafeDefinition q) = PQ $ \ (K conn) -> do

270 resultMaybe <- liftBase $ LibPQ.exec conn q

275 resultMaybe <- liftBase $ LibPQ.exec conn q

271 case resultMaybe of

276 case resultMaybe of

272− Nothing -> error

277+ Nothing -> throw $ ResultException

273 "define: LibPQ.exec returned no results"

278 "define: LibPQ.exec returned no results"

274 Just result -> return $ K (K result)

279 Just result -> return $ K (K result)

275

280

@@ -393,14 +398,17 @@ instance (MonadBase IO io, schema0 ~ schema, schema1 ~ schema)

393 (UnsafeManipulation q :: Manipulation schema ps ys) (params :: x) =

398 (UnsafeManipulation q :: Manipulation schema ps ys) (params :: x) =

394 PQ $ \ (K conn) -> do

399 PQ $ \ (K conn) -> do

395 let

400 let

401+ toParam' encoding =

396− toParam' bytes = (LibPQ.invalidOid,bytes,LibPQ.Binary)

402+ (LibPQ.invalidOid, encodingBytes encoding, LibPQ.Binary)

397 params' = fmap (fmap toParam') (hcollapse (toParams @x @ps params))

403 params' = fmap (fmap toParam') (hcollapse (toParams @x @ps params))

398 q' = q <> ";"

404 q' = q <> ";"

399 resultMaybe <- liftBase $ LibPQ.execParams conn q' params' LibPQ.Binary

405 resultMaybe <- liftBase $ LibPQ.execParams conn q' params' LibPQ.Binary

400 case resultMaybe of

406 case resultMaybe of

401− Nothing -> error

407+ Nothing -> throw $ ResultException

402 "manipulateParams: LibPQ.execParams returned no results"

408 "manipulateParams: LibPQ.execParams returned no results"

409+ Just result -> do

410+ tryResult result

403− Just result -> return $ K (K result)

411+ return $ K (K result)

404

412

405 traversePrepared

413 traversePrepared

406 (UnsafeManipulation q :: Manipulation schema xs ys) (list :: list x) =

414 (UnsafeManipulation q :: Manipulation schema xs ys) (list :: list x) =

@@ -408,29 +416,25 @@ instance (MonadBase IO io, schema0 ~ schema, schema1 ~ schema)

408 let temp = "temporary_statement"

416 let temp = "temporary_statement"

409 prepResultMaybe <- LibPQ.prepare conn temp q Nothing

417 prepResultMaybe <- LibPQ.prepare conn temp q Nothing

410 case prepResultMaybe of

418 case prepResultMaybe of

411− Nothing -> error

419+ Nothing -> throw $ ResultException

412 "traversePrepared: LibPQ.prepare returned no results"

420 "traversePrepared: LibPQ.prepare returned no results"

413− Just prepResult -> do

421+ Just prepResult -> tryResult prepResult

414− status <- LibPQ.resultStatus prepResult

415− unless (status == LibPQ.CommandOk) . error $

416− "traversePrepared: LibPQ.prepare status " <> show status

417 results <- for list $ \ params -> do

422 results <- for list $ \ params -> do

418 let

423 let

419− toParam' bytes = (bytes,LibPQ.Binary)

424+ toParam' encoding = (encodingBytes encoding,LibPQ.Binary)

420 params' = fmap (fmap toParam') (hcollapse (toParams @x @xs params))

425 params' = fmap (fmap toParam') (hcollapse (toParams @x @xs params))

421 resultMaybe <- LibPQ.execPrepared conn temp params' LibPQ.Binary

426 resultMaybe <- LibPQ.execPrepared conn temp params' LibPQ.Binary

422 case resultMaybe of

427 case resultMaybe of

423− Nothing -> error

428+ Nothing -> throw $ ResultException

424 "traversePrepared: LibPQ.execParams returned no results"

429 "traversePrepared: LibPQ.execParams returned no results"

430+ Just result -> do

431+ tryResult result

425− Just result -> return $ K result

432+ return $ K result

426 deallocResultMaybe <- LibPQ.exec conn ("DEALLOCATE " <> temp <> ";")

433 deallocResultMaybe <- LibPQ.exec conn ("DEALLOCATE " <> temp <> ";")

427 case deallocResultMaybe of

434 case deallocResultMaybe of

428− Nothing -> error

435+ Nothing -> throw $ ResultException

429 "traversePrepared: LibPQ.exec DEALLOCATE returned no results"

436 "traversePrepared: LibPQ.exec DEALLOCATE returned no results"

430− Just deallocResult -> do

437+ Just deallocResult -> tryResult deallocResult

431− status <- LibPQ.resultStatus deallocResult

432− unless (status == LibPQ.CommandOk) . error $

433− "traversePrepared: DEALLOCATE status " <> show status

434 return (K results)

438 return (K results)

435

439

436 traversePrepared_

440 traversePrepared_

@@ -439,29 +443,23 @@ instance (MonadBase IO io, schema0 ~ schema, schema1 ~ schema)

439 let temp = "temporary_statement"

443 let temp = "temporary_statement"

440 prepResultMaybe <- LibPQ.prepare conn temp q Nothing

444 prepResultMaybe <- LibPQ.prepare conn temp q Nothing

441 case prepResultMaybe of

445 case prepResultMaybe of

442− Nothing -> error

446+ Nothing -> throw $ ResultException

443 "traversePrepared_: LibPQ.prepare returned no results"

447 "traversePrepared_: LibPQ.prepare returned no results"

444− Just prepResult -> do

448+ Just prepResult -> tryResult prepResult

445− status <- LibPQ.resultStatus prepResult

446− unless (status == LibPQ.CommandOk) . error $

447− "traversePrepared: LibPQ.prepare status " <> show status

448 for_ list $ \ params -> do

449 for_ list $ \ params -> do

449 let

450 let

450− toParam' bytes = (bytes,LibPQ.Binary)

451+ toParam' encoding = (encodingBytes encoding, LibPQ.Binary)

451 params' = fmap (fmap toParam') (hcollapse (toParams @x @xs params))

452 params' = fmap (fmap toParam') (hcollapse (toParams @x @xs params))

452 resultMaybe <- LibPQ.execPrepared conn temp params' LibPQ.Binary

453 resultMaybe <- LibPQ.execPrepared conn temp params' LibPQ.Binary

453 case resultMaybe of

454 case resultMaybe of

454− Nothing -> error

455+ Nothing -> throw $ ResultException

455 "traversePrepared_: LibPQ.execParams returned no results"

456 "traversePrepared_: LibPQ.execParams returned no results"

456− Just _result -> return ()

457+ Just result -> tryResult result

457 deallocResultMaybe <- LibPQ.exec conn ("DEALLOCATE " <> temp <> ";")

458 deallocResultMaybe <- LibPQ.exec conn ("DEALLOCATE " <> temp <> ";")

458 case deallocResultMaybe of

459 case deallocResultMaybe of

459− Nothing -> error

460+ Nothing -> throw $ ResultException

460 "traversePrepared: LibPQ.exec DEALLOCATE returned no results"

461 "traversePrepared: LibPQ.exec DEALLOCATE returned no results"

461− Just deallocResult -> do

462+ Just deallocResult -> tryResult deallocResult

462− status <- LibPQ.resultStatus deallocResult

463− unless (status == LibPQ.CommandOk) . error $

464− "traversePrepared: DEALLOCATE status " <> show status

465 return (K ())

463 return (K ())

466

464

467 liftPQ pq = PQ $ \ (K conn) -> do

465 liftPQ pq = PQ $ \ (K conn) -> do

@@ -479,7 +477,6 @@ instance MonadPQ schema m => MonadPQ schema (ExceptT e m)

479instance (Monoid w, MonadPQ schema m) => MonadPQ schema (Strict.RWST r w s m)

477instance (Monoid w, MonadPQ schema m) => MonadPQ schema (Strict.RWST r w s m)

480instance (Monoid w, MonadPQ schema m) => MonadPQ schema (Lazy.RWST r w s m)

478instance (Monoid w, MonadPQ schema m) => MonadPQ schema (Lazy.RWST r w s m)

481instance MonadPQ schema m => MonadPQ schema (ContT r m)

479instance MonadPQ schema m => MonadPQ schema (ContT r m)

482−instance MonadPQ schema m => MonadPQ schema (ListT m)

483

480

484instance (Monad m, schema0 ~ schema1)

481instance (Monad m, schema0 ~ schema1)

485 => Applicative (PQ schema0 schema1 m) where

482 => Applicative (PQ schema0 schema1 m) where

@@ -534,14 +531,16 @@ getRow

534 -> io y

531 -> io y

535getRow r (K result :: K LibPQ.Result columns) = liftBase $ do

532getRow r (K result :: K LibPQ.Result columns) = liftBase $ do

536 numRows <- LibPQ.ntuples result

533 numRows <- LibPQ.ntuples result

537− when (numRows < r) $ error $

534+ when (numRows < r) $ throw $ ResultException $

538− "getRow: expected at least " <> show r <> "rows but only saw "

535+ "getRow: expected at least " <> pack (show r) <> "rows but only saw "

539− <> show numRows

536+ <> pack (show numRows)

540 let len = fromIntegral (lengthSList (Proxy @columns))

537 let len = fromIntegral (lengthSList (Proxy @columns))

541 row' <- traverse (LibPQ.getvalue result r) [0 .. len - 1]

538 row' <- traverse (LibPQ.getvalue result r) [0 .. len - 1]

542 case fromList row' of

539 case fromList row' of

543− Nothing -> error "getRow: found unexpected length"

540+ Nothing -> throw $ ResultException "getRow: found unexpected length"

544− Just row -> return $ fromRow @columns row

541+ Just row -> case fromRow @columns row of

542+ Left parseError -> throw $ ParseException $ "getRow: " <> parseError

543+ Right y -> return y

545

544

546-- | Intended to be used for unfolding in streaming libraries, `nextRow`

545-- | Intended to be used for unfolding in streaming libraries, `nextRow`

547-- takes a total number of rows (which can be found with `ntuples`)

546-- takes a total number of rows (which can be found with `ntuples`)

@@ -558,8 +557,10 @@ nextRow total (K result :: K LibPQ.Result columns) r

558 let len = fromIntegral (lengthSList (Proxy @columns))

557 let len = fromIntegral (lengthSList (Proxy @columns))

559 row' <- traverse (LibPQ.getvalue result r) [0 .. len - 1]

558 row' <- traverse (LibPQ.getvalue result r) [0 .. len - 1]

560 case fromList row' of

559 case fromList row' of

561− Nothing -> error "nextRow: found unexpected length"

560+ Nothing -> throw $ ResultException "nextRow: found unexpected length"

561+ Just row -> case fromRow @columns row of

562+ Left parseError -> throw $ ParseException $ "nextRow: " <> parseError

562− Just row -> return $ Just (r+1, fromRow @columns row)

563+ Right y -> return $ Just (r+1, y)

563

564

564-- | Get all rows from a `LibPQ.Result`.

565-- | Get all rows from a `LibPQ.Result`.

565getRows

566getRows

@@ -572,8 +573,10 @@ getRows (K result :: K LibPQ.Result columns) = liftBase $ do

572 for [0 .. numRows - 1] $ \ r -> do

573 for [0 .. numRows - 1] $ \ r -> do

573 row' <- traverse (LibPQ.getvalue result r) [0 .. len - 1]

574 row' <- traverse (LibPQ.getvalue result r) [0 .. len - 1]

574 case fromList row' of

575 case fromList row' of

575− Nothing -> error "getRows: found unexpected length"

576+ Nothing -> throw $ ResultException "getRows: found unexpected length"

576− Just row -> return $ fromRow @columns row

577+ Just row -> case fromRow @columns row of

578+ Left parseError -> throw $ ParseException $ "getRows: " <> parseError

579+ Right y -> return y

577

580

578-- | Get the first row if possible from a `LibPQ.Result`.

581-- | Get the first row if possible from a `LibPQ.Result`.

579firstRow

582firstRow

@@ -586,8 +589,10 @@ firstRow (K result :: K LibPQ.Result columns) = liftBase $ do

586 let len = fromIntegral (lengthSList (Proxy @columns))

589 let len = fromIntegral (lengthSList (Proxy @columns))

587 row' <- traverse (LibPQ.getvalue result 0) [0 .. len - 1]

590 row' <- traverse (LibPQ.getvalue result 0) [0 .. len - 1]

588 case fromList row' of

591 case fromList row' of

589− Nothing -> error "firstRow: found unexpected length"

592+ Nothing -> throw $ ResultException "firstRow: found unexpected length"

590− Just row -> return . Just $ fromRow @columns row

593+ Just row -> case fromRow @columns row of

594+ Left parseError -> throw $ ParseException $ "firstRow: " <> parseError

595+ Right y -> return $ Just y

591

596

592-- | Lifts actions on results from @LibPQ@.

597-- | Lifts actions on results from @LibPQ@.

593liftResult

598liftResult

@@ -609,3 +614,55 @@ resultStatus = liftResult LibPQ.resultStatus

609resultErrorMessage

614resultErrorMessage

610 :: MonadBase IO io => K LibPQ.Result results -> io (Maybe ByteString)

615 :: MonadBase IO io => K LibPQ.Result results -> io (Maybe ByteString)

611resultErrorMessage = liftResult LibPQ.resultErrorMessage

616resultErrorMessage = liftResult LibPQ.resultErrorMessage

617+

618+-- | Returns the error code most recently generated by an operation

619+-- on the connection.

620+--

621+-- https://www.postgresql.org/docs/current/static/errcodes-appendix.html

622+resultErrorCode

623+ :: MonadBase IO io

624+ => K LibPQ.Result results

625+ -> io (Maybe ByteString)

626+resultErrorCode = liftResult (flip LibPQ.resultErrorField LibPQ.DiagSqlstate)

627+

628+-- | `Exception`s that can be thrown by Squeal.

629+data SquealException

630+ = PQException

631+ { sqlExecStatus :: LibPQ.ExecStatus

632+ , sqlStateCode :: Maybe ByteString

633+ -- ^ https://www.postgresql.org/docs/current/static/errcodes-appendix.html

634+ , sqlErrorMessage :: Maybe ByteString

635+ }

636+ | ResultException Text

637+ | ParseException Text

638+ deriving (Eq, Show)

639+instance Exception SquealException

640+

641+tryResult

642+ :: MonadBase IO io

643+ => LibPQ.Result

644+ -> io ()

645+tryResult result = liftBase $ do

646+ status <- LibPQ.resultStatus result

647+ case status of

648+ LibPQ.CommandOk -> return ()

649+ LibPQ.TuplesOk -> return ()

650+ _ -> do

651+ stateCode <- LibPQ.resultErrorField result LibPQ.DiagSqlstate

652+ msg <- LibPQ.resultErrorMessage result

653+ throw $ PQException status stateCode msg

654+

655+-- | Catch `SquealException`s.

656+catchSqueal

657+ :: MonadBaseControl IO io

658+ => io a

659+ -> (SquealException -> io a) -- ^ handler

660+ -> io a

661+catchSqueal = catch

662+

663+-- | Handle `SquealException`s.

664+handleSqueal

665+ :: MonadBaseControl IO io

666+ => (SquealException -> io a) -- ^ handler

667+ -> io a -> io a

668+handleSqueal = handle

squeal-postgresql/src/Squeal/PostgreSQL/Query.hs+610−269

@@ -29,21 +29,43 @@ Squeal queries.

29module Squeal.PostgreSQL.Query

30 ( -- * Queries

31 Query (UnsafeQuery, renderQuery)

32− , union

33− , unionAll

34− , intersect

35− , intersectAll

36− , except

37− , exceptAll

38− -- * Select

32+ -- ** Select

39 , select

33 , select

40 , selectDistinct

34 , selectDistinct

41 , selectStar

35 , selectStar

42 , selectDistinctStar

36 , selectDistinctStar

43 , selectDotStar

37 , selectDotStar

44 , selectDistinctDotStar

38 , selectDistinctDotStar

39+ -- ** Values

45 , values

40 , values

46 , values_

41 , values_

42+ -- ** Set Operations

43+ , union

44+ , unionAll

45+ , intersect

46+ , intersectAll

47+ , except

48+ , exceptAll

49+ -- ** With

50+ , With (with)

51+ , CommonTableExpression (..)

52+ , renderCommonTableExpression

53+ , renderCommonTableExpressions

54+ -- ** Json

55+ , jsonEach

56+ , jsonbEach

57+ , jsonEachAsText

58+ , jsonbEachAsText

59+ , jsonObjectKeys

60+ , jsonbObjectKeys

61+ , jsonPopulateRecord

62+ , jsonbPopulateRecord

63+ , jsonPopulateRecordSet

64+ , jsonbPopulateRecordSet

65+ , jsonToRecord

66+ , jsonbToRecord

67+ , jsonToRecordSet

68+ , jsonbToRecordSet

47 -- * Table Expressions

69 -- * Table Expressions

48 , TableExpression (..)

70 , TableExpression (..)

49 , renderTableExpression

71 , renderTableExpression

@@ -54,22 +76,7 @@ module Squeal.PostgreSQL.Query

54 , orderBy

76 , orderBy

55 , limit

77 , limit

56 , offset

78 , offset

57− -- ** JSON table expressions

58− , PGjson_each

59− , PGjsonb_each

60− , jsonEach

61− , jsonbEach

62− , jsonEachAsText

63− , jsonbEachAsText

64− , jsonPopulateRecordAs

65− , jsonbPopulateRecordAs

66− , jsonPopulateRecordSetAs

67− , jsonbPopulateRecordSetAs

68− , jsonToRecordAs

69− , jsonbToRecordAs

70− , jsonToRecordSetAs

71− , jsonbToRecordSetAs

72− -- * From

79+ -- * From Clauses

73 , FromClause (..)

80 , FromClause (..)

74 , table

81 , table

75 , subquery

82 , subquery

@@ -89,11 +96,37 @@ module Squeal.PostgreSQL.Query

89 -- * Sorting

96 -- * Sorting

90 , SortExpression (..)

97 , SortExpression (..)

91 , renderSortExpression

98 , renderSortExpression

99+ -- * Subquery Expressions

100+ , in_

101+ , rowIn

102+ , eqAll

103+ , rowEqAll

104+ , eqAny

105+ , rowEqAny

106+ , neqAll

107+ , rowNeqAll

108+ , neqAny

109+ , rowNeqAny

110+ , allLt

111+ , rowLtAll

112+ , ltAny

113+ , rowLtAny

114+ , lteAll

115+ , rowLteAll

116+ , lteAny

117+ , rowLteAny

118+ , gtAll

119+ , rowGtAll

120+ , gtAny

121+ , rowGtAny

122+ , gteAll

123+ , rowGteAll

124+ , gteAny

125+ , rowGteAny

92 ) where

126 ) where

127

94import Control.DeepSeq

128import Control.DeepSeq

95import Data.ByteString (ByteString)

129import Data.ByteString (ByteString)

96−import Data.Monoid hiding (All)

97import Data.String

130import Data.String

98import Data.Word

131import Data.Word

99import Generics.SOP hiding (from)

132import Generics.SOP hiding (from)

@@ -107,9 +140,7 @@ import Squeal.PostgreSQL.Schema

107

140

108{- |

141{- |

109The process of retrieving or the command to retrieve data from a database

142The process of retrieving or the command to retrieve data from a database

110−is called a `Query`. The `select`, `selectStar`, `selectDotStar`,

143+is called a `Query`. Let's see some examples of queries.

111−`selectDistinct`, `selectDistinctStar` and `selectDistinctDotStar` commands

112−are used to specify queries.

113

144

114simple query:

145simple query:

115

146

@@ -280,6 +311,16 @@ in printSQL query

280:}

311:}

281SELECT "t1".* FROM "tab" AS "t1" CROSS JOIN "tab" AS "t2"

312SELECT "t1".* FROM "tab" AS "t1" CROSS JOIN "tab" AS "t2"

282

313

314+value queries:

315+

316+>>> :{

317+let

318+ query :: Query '[] '[] '["foo" ::: 'NotNull 'PGint2, "bar" ::: 'NotNull 'PGbool]

319+ query = values (1 `as` #foo :* true `as` #bar) [2 `as` #foo :* false `as` #bar]

320+in printSQL query

321+:}

322+SELECT * FROM (VALUES (1, TRUE), (2, FALSE)) AS t ("foo", "bar")

323+

283set operations:

324set operations:

284

325

285>>> :{

326>>> :{

@@ -295,11 +336,30 @@ let

295in printSQL query

336in printSQL query

296:}

337:}

297(SELECT * FROM "tab" AS "tab") UNION ALL (SELECT * FROM "tab" AS "tab")

338(SELECT * FROM "tab" AS "tab") UNION ALL (SELECT * FROM "tab" AS "tab")

339+

340+with queries:

341+

342+>>> :{

343+let

344+ query :: Query

345+ '[ "t1" ::: 'View

346+ '[ "c1" ::: 'NotNull 'PGtext

347+ , "c2" ::: 'NotNull 'PGtext] ]

348+ '[]

349+ '[ "c1" ::: 'NotNull 'PGtext

350+ , "c2" ::: 'NotNull 'PGtext ]

351+ query = with (

352+ selectStar (from (view #t1)) `as` #t2 :>>

353+ selectStar (from (view #t2)) `as` #t3

354+ ) (selectStar (from (view #t3)))

355+in printSQL query

356+:}

357+WITH "t2" AS (SELECT * FROM "t1" AS "t1"), "t3" AS (SELECT * FROM "t2" AS "t2") SELECT * FROM "t3" AS "t3"

298-}

358-}

299newtype Query

359newtype Query

300 (schema :: SchemaType)

360 (schema :: SchemaType)

301 (params :: [NullityType])

361 (params :: [NullityType])

302− (columns :: RelationType)

362+ (columns :: RowType)

303 = UnsafeQuery { renderQuery :: ByteString }

363 = UnsafeQuery { renderQuery :: ByteString }

304 deriving (GHC.Generic,Show,Eq,Ord,NFData)

364 deriving (GHC.Generic,Show,Eq,Ord,NFData)

305instance RenderSQL (Query schema params columns) where renderSQL = renderQuery

365instance RenderSQL (Query schema params columns) where renderSQL = renderQuery

@@ -381,9 +441,9 @@ SELECT queries

381-- the intermediate table are actually output.

441-- the intermediate table are actually output.

382select

442select

383 :: SListI columns

443 :: SListI columns

384− => NP (Aliased (Expression schema relations grouping params)) (column ': columns)

444+ => NP (Aliased (Expression schema from grouping params)) (column ': columns)

385 -- ^ select list

445 -- ^ select list

386− -> TableExpression schema params relations grouping

446+ -> TableExpression schema params from grouping

387 -- ^ intermediate virtual table

447 -- ^ intermediate virtual table

388 -> Query schema params (column ': columns)

448 -> Query schema params (column ': columns)

389select list rels = UnsafeQuery $

449select list rels = UnsafeQuery $

@@ -395,9 +455,9 @@ select list rels = UnsafeQuery $

395-- be subject to the elimination of duplicate rows using `selectDistinct`.

455-- be subject to the elimination of duplicate rows using `selectDistinct`.

396selectDistinct

456selectDistinct

397 :: SListI columns

457 :: SListI columns

398− => NP (Aliased (Expression schema relations 'Ungrouped params)) (column ': columns)

458+ => NP (Aliased (Expression schema from 'Ungrouped params)) (column ': columns)

399 -- ^ select list

459 -- ^ select list

400− -> TableExpression schema params relations 'Ungrouped

460+ -> TableExpression schema params from 'Ungrouped

401 -- ^ intermediate virtual table

461 -- ^ intermediate virtual table

402 -> Query schema params (column ': columns)

462 -> Query schema params (column ': columns)

403selectDistinct list rels = UnsafeQuery $

463selectDistinct list rels = UnsafeQuery $

@@ -408,8 +468,8 @@ selectDistinct list rels = UnsafeQuery $

408-- | The simplest kind of query is `selectStar` which emits all columns

468-- | The simplest kind of query is `selectStar` which emits all columns

409-- that the table expression produces.

469-- that the table expression produces.

410selectStar

470selectStar

411− :: HasUnique relation relations columns

471+ :: HasUnique table from columns

412− => TableExpression schema params relations 'Ungrouped

472+ => TableExpression schema params from 'Ungrouped

413 -- ^ intermediate virtual table

473 -- ^ intermediate virtual table

414 -> Query schema params columns

474 -> Query schema params columns

415selectStar rels = UnsafeQuery $ "SELECT" <+> "*" <+> renderTableExpression rels

475selectStar rels = UnsafeQuery $ "SELECT" <+> "*" <+> renderTableExpression rels

@@ -417,8 +477,8 @@ selectStar rels = UnsafeQuery $ "SELECT" <+> "*" <+> renderTableExpression rels

417-- | A `selectDistinctStar` emits all columns that the table expression

477-- | A `selectDistinctStar` emits all columns that the table expression

418-- produces and eliminates duplicate rows.

478-- produces and eliminates duplicate rows.

419selectDistinctStar

479selectDistinctStar

420− :: HasUnique relation relations columns

480+ :: HasUnique table from columns

421− => TableExpression schema params relations 'Ungrouped

481+ => TableExpression schema params from 'Ungrouped

422 -- ^ intermediate virtual table

482 -- ^ intermediate virtual table

423 -> Query schema params columns

483 -> Query schema params columns

424selectDistinctStar rels = UnsafeQuery $

484selectDistinctStar rels = UnsafeQuery $

@@ -427,27 +487,27 @@ selectDistinctStar rels = UnsafeQuery $

427-- | When working with multiple tables, it can also be useful to ask

487-- | When working with multiple tables, it can also be useful to ask

428-- for all the columns of a particular table, using `selectDotStar`.

488-- for all the columns of a particular table, using `selectDotStar`.

429selectDotStar

489selectDotStar

430− :: Has relation relations columns

490+ :: Has table from columns

431− => Alias relation

491+ => Alias table

432 -- ^ particular virtual subtable

492 -- ^ particular virtual subtable

433− -> TableExpression schema params relations 'Ungrouped

493+ -> TableExpression schema params from 'Ungrouped

434 -- ^ intermediate virtual table

494 -- ^ intermediate virtual table

435 -> Query schema params columns

495 -> Query schema params columns

436−selectDotStar rel relations = UnsafeQuery $

496+selectDotStar rel tab = UnsafeQuery $

437− "SELECT" <+> renderAlias rel <> ".*" <+> renderTableExpression relations

497+ "SELECT" <+> renderAlias rel <> ".*" <+> renderTableExpression tab

438

498

439-- | A `selectDistinctDotStar` asks for all the columns of a particular table,

499-- | A `selectDistinctDotStar` asks for all the columns of a particular table,

440-- and eliminates duplicate rows.

500-- and eliminates duplicate rows.

441selectDistinctDotStar

501selectDistinctDotStar

442− :: Has relation relations columns

502+ :: Has table from columns

443− => Alias relation

503+ => Alias table

444 -- ^ particular virtual table

504 -- ^ particular virtual table

445− -> TableExpression schema params relations 'Ungrouped

505+ -> TableExpression schema params from 'Ungrouped

446 -- ^ intermediate virtual table

506 -- ^ intermediate virtual table

447 -> Query schema params columns

507 -> Query schema params columns

448−selectDistinctDotStar rel relations = UnsafeQuery $

508+selectDistinctDotStar rel tab = UnsafeQuery $

449 "SELECT DISTINCT" <+> renderAlias rel <> ".*"

509 "SELECT DISTINCT" <+> renderAlias rel <> ".*"

450− <+> renderTableExpression relations

510+ <+> renderTableExpression tab

451

511

452-- | `values` computes a row value or set of row values

512-- | `values` computes a row value or set of row values

453-- specified by value expressions. It is most commonly used

513-- specified by value expressions. It is most commonly used

@@ -501,13 +561,13 @@ Table Expressions

501data TableExpression

561data TableExpression

502 (schema :: SchemaType)

562 (schema :: SchemaType)

503 (params :: [NullityType])

563 (params :: [NullityType])

504− (relations :: RelationsType)

564+ (from :: FromType)

505 (grouping :: Grouping)

565 (grouping :: Grouping)

506 = TableExpression

566 = TableExpression

507− { fromClause :: FromClause schema params relations

567+ { fromClause :: FromClause schema params from

508 -- ^ A table reference that can be a table name, or a derived table such

568 -- ^ A table reference that can be a table name, or a derived table such

509 -- as a subquery, a @JOIN@ construct, or complex combinations of these.

569 -- as a subquery, a @JOIN@ construct, or complex combinations of these.

510− , whereClause :: [Condition schema relations 'Ungrouped params]

570+ , whereClause :: [Condition schema from 'Ungrouped params]

511 -- ^ optional search coditions, combined with `.&&`. After the processing

571 -- ^ optional search coditions, combined with `.&&`. After the processing

512 -- of the `fromClause` is done, each row of the derived virtual table

572 -- of the `fromClause` is done, each row of the derived virtual table

513 -- is checked against the search condition. If the result of the

573 -- is checked against the search condition. If the result of the

@@ -516,20 +576,20 @@ data TableExpression

516 -- at least one column of the table generated in the `fromClause`;

576 -- at least one column of the table generated in the `fromClause`;

517 -- this is not required, but otherwise the WHERE clause will

577 -- this is not required, but otherwise the WHERE clause will

518 -- be fairly useless.

578 -- be fairly useless.

519− , groupByClause :: GroupByClause relations grouping

579+ , groupByClause :: GroupByClause from grouping

520 -- ^ The `groupByClause` is used to group together those rows in a table

580 -- ^ The `groupByClause` is used to group together those rows in a table

521 -- that have the same values in all the columns listed. The order in which

581 -- that have the same values in all the columns listed. The order in which

522 -- the columns are listed does not matter. The effect is to combine each

582 -- the columns are listed does not matter. The effect is to combine each

523 -- set of rows having common values into one group row that represents all

583 -- set of rows having common values into one group row that represents all

524 -- rows in the group. This is done to eliminate redundancy in the output

584 -- rows in the group. This is done to eliminate redundancy in the output

525 -- and/or compute aggregates that apply to these groups.

585 -- and/or compute aggregates that apply to these groups.

526− , havingClause :: HavingClause schema relations grouping params

586+ , havingClause :: HavingClause schema from grouping params

527 -- ^ If a table has been grouped using `groupBy`, but only certain groups

587 -- ^ If a table has been grouped using `groupBy`, but only certain groups

528 -- are of interest, the `havingClause` can be used, much like a

588 -- are of interest, the `havingClause` can be used, much like a

529 -- `whereClause`, to eliminate groups from the result. Expressions in the

589 -- `whereClause`, to eliminate groups from the result. Expressions in the

530 -- `havingClause` can refer both to grouped expressions and to ungrouped

590 -- `havingClause` can refer both to grouped expressions and to ungrouped

531 -- expressions (which necessarily involve an aggregate function).

591 -- expressions (which necessarily involve an aggregate function).

532− , orderByClause :: [SortExpression schema relations grouping params]

592+ , orderByClause :: [SortExpression schema from grouping params]

533 -- ^ The `orderByClause` is for optional sorting. When more than one

593 -- ^ The `orderByClause` is for optional sorting. When more than one

534 -- `SortExpression` is specified, the later (right) values are used to sort

594 -- `SortExpression` is specified, the later (right) values are used to sort

535 -- rows that are equal according to the earlier (left) values.

595 -- rows that are equal according to the earlier (left) values.

@@ -547,7 +607,7 @@ data TableExpression

547

607

548-- | Render a `TableExpression`

608-- | Render a `TableExpression`

549renderTableExpression

609renderTableExpression

550− :: TableExpression schema params relations grouping

610+ :: TableExpression schema params from grouping

551 -> ByteString

611 -> ByteString

552renderTableExpression

612renderTableExpression

553 (TableExpression frm' whs' grps' hvs' srts' lims' offs') = mconcat

613 (TableExpression frm' whs' grps' hvs' srts' lims' offs') = mconcat

@@ -581,16 +641,16 @@ renderTableExpression

581-- `group`, `having`, `orderBy`, `limit` and `offset`, using the `&` operator

641-- `group`, `having`, `orderBy`, `limit` and `offset`, using the `&` operator

582-- to match the left-to-right sequencing of their placement in SQL.

642-- to match the left-to-right sequencing of their placement in SQL.

583from

643from

584− :: FromClause schema params relations -- ^ table reference

644+ :: FromClause schema params from -- ^ table reference

585− -> TableExpression schema params relations 'Ungrouped

645+ -> TableExpression schema params from 'Ungrouped

586from rels = TableExpression rels [] NoGroups NoHaving [] [] []

646from rels = TableExpression rels [] NoGroups NoHaving [] [] []

587

647

588-- | A `where_` is an endomorphism of `TableExpression`s which adds a

648-- | A `where_` is an endomorphism of `TableExpression`s which adds a

589-- search condition to the `whereClause`.

649-- search condition to the `whereClause`.

590where_

650where_

591− :: Condition schema relations 'Ungrouped params -- ^ filtering condition

651+ :: Condition schema from 'Ungrouped params -- ^ filtering condition

592− -> TableExpression schema params relations grouping

652+ -> TableExpression schema params from grouping

593− -> TableExpression schema params relations grouping

653+ -> TableExpression schema params from grouping

594where_ wh rels = rels {whereClause = wh : whereClause rels}

654where_ wh rels = rels {whereClause = wh : whereClause rels}

595

655

596-- | A `groupBy` is a transformation of `TableExpression`s which switches

656-- | A `groupBy` is a transformation of `TableExpression`s which switches

@@ -598,9 +658,9 @@ where_ wh rels = rels {whereClause = wh : whereClause rels}

598-- a "grand total" aggregation query.

658-- a "grand total" aggregation query.

599groupBy

659groupBy

600 :: SListI bys

660 :: SListI bys

601− => NP (By relations) bys -- ^ grouped columns

661+ => NP (By from) bys -- ^ grouped columns

602− -> TableExpression schema params relations 'Ungrouped

662+ -> TableExpression schema params from 'Ungrouped

603− -> TableExpression schema params relations ('Grouped bys)

663+ -> TableExpression schema params from ('Grouped bys)

604groupBy bys rels = TableExpression

664groupBy bys rels = TableExpression

605 { fromClause = fromClause rels

665 { fromClause = fromClause rels

606 , whereClause = whereClause rels

666 , whereClause = whereClause rels

@@ -614,218 +674,176 @@ groupBy bys rels = TableExpression

614-- | A `having` is an endomorphism of `TableExpression`s which adds a

674-- | A `having` is an endomorphism of `TableExpression`s which adds a

615-- search condition to the `havingClause`.

675-- search condition to the `havingClause`.

616having

676having

617− :: Condition schema relations ('Grouped bys) params -- ^ having condition

677+ :: Condition schema from ('Grouped bys) params -- ^ having condition

618− -> TableExpression schema params relations ('Grouped bys)

678+ -> TableExpression schema params from ('Grouped bys)

619− -> TableExpression schema params relations ('Grouped bys)

679+ -> TableExpression schema params from ('Grouped bys)

620having hv rels = rels

680having hv rels = rels

621 { havingClause = case havingClause rels of Having hvs -> Having (hv:hvs) }

681 { havingClause = case havingClause rels of Having hvs -> Having (hv:hvs) }

622

682

623-- | An `orderBy` is an endomorphism of `TableExpression`s which appends an

683-- | An `orderBy` is an endomorphism of `TableExpression`s which appends an

624-- ordering to the right of the `orderByClause`.

684-- ordering to the right of the `orderByClause`.

625orderBy

685orderBy

626− :: [SortExpression schema relations grouping params] -- ^ sort expressions

686+ :: [SortExpression schema from grouping params] -- ^ sort expressions

627− -> TableExpression schema params relations grouping

687+ -> TableExpression schema params from grouping

628− -> TableExpression schema params relations grouping

688+ -> TableExpression schema params from grouping

629orderBy srts rels = rels {orderByClause = orderByClause rels ++ srts}

689orderBy srts rels = rels {orderByClause = orderByClause rels ++ srts}

630

690

631-- | A `limit` is an endomorphism of `TableExpression`s which adds to the

691-- | A `limit` is an endomorphism of `TableExpression`s which adds to the

632-- `limitClause`.

692-- `limitClause`.

633limit

693limit

634 :: Word64 -- ^ limit parameter

694 :: Word64 -- ^ limit parameter

635− -> TableExpression schema params relations grouping

695+ -> TableExpression schema params from grouping

636− -> TableExpression schema params relations grouping

696+ -> TableExpression schema params from grouping

637limit lim rels = rels {limitClause = lim : limitClause rels}

697limit lim rels = rels {limitClause = lim : limitClause rels}

638

698

639-- | An `offset` is an endomorphism of `TableExpression`s which adds to the

699-- | An `offset` is an endomorphism of `TableExpression`s which adds to the

640-- `offsetClause`.

700-- `offsetClause`.

641offset

701offset

642 :: Word64 -- ^ offset parameter

702 :: Word64 -- ^ offset parameter

643− -> TableExpression schema params relations grouping

703+ -> TableExpression schema params from grouping

644− -> TableExpression schema params relations grouping

704+ -> TableExpression schema params from grouping

645offset off rels = rels {offsetClause = off : offsetClause rels}

705offset off rels = rels {offsetClause = off : offsetClause rels}

646

706

647{-----------------------------------------

707{-----------------------------------------

648JSON stuff

708JSON stuff

649-----------------------------------------}

709-----------------------------------------}

650

710

651−type PGjson_each_variant val tab =

711+unsafeSetOfFunction

652− '[ tab ::: '[ "key" ::: 'NotNull 'PGtext, "value" ::: 'NotNull val ] ]

712+ :: ByteString

653−

654−-- | The type of a `json_each` `FromClause`.

655−type PGjson_each tab = PGjson_each_variant 'PGjson tab

656−-- | The type of a `jsonb_each` `FromClause`.

657−type PGjsonb_each tab = PGjson_each_variant 'PGjsonb tab

658−-- | The type of a `json_each_text` `FromClause`.

659−type PGjson_each_text tab = PGjson_each_variant 'PGtext tab

660−-- | The type of a `jsonb_each_text` `FromClause`.

661−type PGjsonb_each_text tab = PGjson_each_variant 'PGtext tab

662−

663−unsafeAliasedFromClauseExpression

664− :: Aliased (Expression schema' relations' grouping' params') ty'

713+ -> Expression schema '[] 'Ungrouped params ty

665− -> FromClause schema params relations

714+ -> Query schema params row

666−unsafeAliasedFromClauseExpression aliasedExpr = UnsafeFromClause

715+unsafeSetOfFunction fun expr = UnsafeQuery $

667− (renderAliasedAs renderExpression aliasedExpr)

716+ "SELECT * FROM " <> fun <> "(" <> renderExpression expr <> ")"

668

717

669-- | Expands the outermost JSON object into a set of key/value pairs.

718-- | Expands the outermost JSON object into a set of key/value pairs.

670jsonEach

719jsonEach

671− :: Aliased (Expression schema '[] 'Ungrouped params) '(tab, nullity 'PGjson)

720+ :: Expression schema '[] 'Ungrouped params (nullity 'PGjson) -- ^ json object

672− -> FromClause schema params (PGjson_each tab)

721+ -> Query schema params

673−jsonEach (As jexpr jname) = unsafeAliasedFromClauseExpression

722+ '["key" ::: 'NotNull 'PGtext, "value" ::: 'NotNull 'PGjson]

674− (As (unsafeFunction "json_each" jexpr) jname)

723+jsonEach = unsafeSetOfFunction "json_each"

675

724

676-- | Expands the outermost binary JSON object into a set of key/value pairs.

725-- | Expands the outermost binary JSON object into a set of key/value pairs.

677jsonbEach

726jsonbEach

678− :: Aliased (Expression schema '[] 'Ungrouped params) '(tab, nullity 'PGjsonb)

727+ :: Expression schema '[] 'Ungrouped params (nullity 'PGjsonb) -- ^ jsonb object

679− -> FromClause schema params (PGjsonb_each tab)

728+ -> Query schema params

680−jsonbEach (As jexpr jname) = unsafeAliasedFromClauseExpression

729+ '["key" ::: 'NotNull 'PGtext, "value" ::: 'NotNull 'PGjsonb]

681− (As (unsafeFunction "jsonb_each" jexpr) jname)

730+jsonbEach = unsafeSetOfFunction "jsonb_each"

682

731

683-- | Expands the outermost JSON object into a set of key/value pairs.

732-- | Expands the outermost JSON object into a set of key/value pairs.

684jsonEachAsText

733jsonEachAsText

685− :: Aliased (Expression schema '[] 'Ungrouped params) '(tab, nullity 'PGjson)

734+ :: Expression schema '[] 'Ungrouped params (nullity 'PGjson) -- ^ json object

686− -> FromClause schema params (PGjson_each_text tab)

735+ -> Query schema params

687−jsonEachAsText (As jexpr jname) = unsafeAliasedFromClauseExpression

736+ '["key" ::: 'NotNull 'PGtext, "value" ::: 'NotNull 'PGtext]

688− (As (unsafeFunction "json_each" jexpr) jname)

737+jsonEachAsText = unsafeSetOfFunction "json_each_text"

689

738

690-- | Expands the outermost binary JSON object into a set of key/value pairs.

739-- | Expands the outermost binary JSON object into a set of key/value pairs.

691jsonbEachAsText

740jsonbEachAsText

692− :: Aliased (Expression schema '[] 'Ungrouped params) '(tab, nullity 'PGjsonb)

741+ :: Expression schema '[] 'Ungrouped params (nullity 'PGjsonb) -- ^ jsonb object

693− -> FromClause schema params (PGjsonb_each_text tab)

742+ -> Query schema params

694−jsonbEachAsText (As jexpr jname) = unsafeAliasedFromClauseExpression

743+ '["key" ::: 'NotNull 'PGtext, "value" ::: 'NotNull 'PGtext]

695− (As (unsafeFunction "jsonb_each" jexpr) jname)

744+jsonbEachAsText = unsafeSetOfFunction "jsonb_each_text"

696−

745+

697−nullRow

746+-- | Returns set of keys in the outermost JSON object.

698− :: Has tab schema ('Table table)

747+jsonObjectKeys

699− => Alias tab

748+ :: Expression schema '[] 'Ungrouped params (nullity 'PGjson) -- ^ json object

700− -> Expression schema relations grouping params

749+ -> Query schema params '["json_object_keys" ::: 'NotNull 'PGtext]

701− (nullity ('PGcomposite (RelationToRowType (TableToRelation table))))

750+jsonObjectKeys = unsafeSetOfFunction "json_object_keys"

702−nullRow tab = UnsafeExpression ("null::"<+>renderAlias tab)

751+

752+-- | Returns set of keys in the outermost JSON object.

753+jsonbObjectKeys

754+ :: Expression schema '[] 'Ungrouped params (nullity 'PGjsonb) -- ^ jsonb object

755+ -> Query schema params '["jsonb_object_keys" ::: 'NotNull 'PGtext]

756+jsonbObjectKeys = unsafeSetOfFunction "jsonb_object_keys"

757+

758+unsafePopulateFunction

759+ :: ByteString

760+ -> TypeExpression schema (nullity ('PGcomposite row))

761+ -> Expression schema '[] 'Ungrouped params ty

762+ -> Query schema params row

763+unsafePopulateFunction fun ty expr = UnsafeQuery $

764+ "SELECT * FROM " <> fun <> "("

765+ <> "null::" <> renderTypeExpression ty <> ", "

766+ <> renderExpression expr <> ")"

703

767

704-- | Expands the JSON expression to a row whose columns match the record

768-- | Expands the JSON expression to a row whose columns match the record

705-- type defined by the given table.

769-- type defined by the given table.

706−jsonPopulateRecordAs

770+jsonPopulateRecord

707− :: (KnownSymbol alias, Has tab schema ('Table table))

771+ :: TypeExpression schema (nullity ('PGcomposite row)) -- ^ row type

708− => Alias tab

709− -> Expression schema '[] 'Ungrouped params (nullity 'PGjson)

772+ -> Expression schema '[] 'Ungrouped params (nullity 'PGjson) -- ^ json object

710− -> Alias alias

773+ -> Query schema params row

711− -> FromClause schema params '[alias ::: TableToRelation table]

774+jsonPopulateRecord = unsafePopulateFunction "json_populate_record"

712−jsonPopulateRecordAs tableName expr alias = unsafeAliasedFromClauseExpression

713− (unsafeVariadicFunction "json_populate_record"

714− (nullRow tableName :* expr :* Nil) `As` alias)

715

775

716-- | Expands the binary JSON expression to a row whose columns match the record

776-- | Expands the binary JSON expression to a row whose columns match the record

717-- type defined by the given table.

777-- type defined by the given table.

718−jsonbPopulateRecordAs

778+jsonbPopulateRecord

719− :: (KnownSymbol alias, Has tab schema ('Table table))

779+ :: TypeExpression schema (nullity ('PGcomposite row)) -- ^ row type

720− => Alias tab

721− -> Expression schema '[] 'Ungrouped params (nullity 'PGjsonb)

780+ -> Expression schema '[] 'Ungrouped params (nullity 'PGjsonb) -- ^ jsonb object

722− -> Alias alias

781+ -> Query schema params row

723− -> FromClause schema params '[alias ::: TableToRelation table]

724−jsonbPopulateRecordAs tableName expr alias = unsafeAliasedFromClauseExpression

725− (unsafeVariadicFunction "jsonb_populate_record"

782+jsonbPopulateRecord = unsafePopulateFunction "jsonb_populate_record"

726− (nullRow tableName :* expr :* Nil) `As` alias)

727

783

728-- | Expands the outermost array of objects in the given JSON expression to a

784-- | Expands the outermost array of objects in the given JSON expression to a

729-- set of rows whose columns match the record type defined by the given table.

785-- set of rows whose columns match the record type defined by the given table.

730−jsonPopulateRecordSetAs

786+jsonPopulateRecordSet

731− :: (KnownSymbol alias, Has tab schema ('Table table))

787+ :: TypeExpression schema (nullity ('PGcomposite row)) -- ^ row type

732− => Alias tab

733− -> Expression schema '[] 'Ungrouped params (nullity 'PGjson)

788+ -> Expression schema '[] 'Ungrouped params (nullity 'PGjson) -- ^ json array

734− -> Alias alias

789+ -> Query schema params row

735− -> FromClause schema params '[alias ::: TableToRelation table]

736−jsonPopulateRecordSetAs tableName expr alias = unsafeAliasedFromClauseExpression

737− (unsafeVariadicFunction "json_populate_record_set"

790+jsonPopulateRecordSet = unsafePopulateFunction "json_populate_record_set"

738− (nullRow tableName :* expr :* Nil) `As` alias)

739

791

740-- | Expands the outermost array of objects in the given binary JSON expression

792-- | Expands the outermost array of objects in the given binary JSON expression

741-- to a set of rows whose columns match the record type defined by the given

793-- to a set of rows whose columns match the record type defined by the given

742-- table.

794-- table.

743−jsonbPopulateRecordSetAs

795+jsonbPopulateRecordSet

744− :: (KnownSymbol alias, Has tab schema ('Table table))

796+ :: TypeExpression schema (nullity ('PGcomposite row)) -- ^ row type

745− => Alias tab

746− -> Expression schema '[] 'Ungrouped params (nullity 'PGjsonb)

797+ -> Expression schema '[] 'Ungrouped params (nullity 'PGjsonb) -- ^ jsonb array

747− -> Alias alias

798+ -> Query schema params row

748− -> FromClause schema params '[alias ::: TableToRelation table]

749−jsonbPopulateRecordSetAs tableName expr alias = unsafeAliasedFromClauseExpression

750− (unsafeVariadicFunction "jsonb_populate_record_set"

799+jsonbPopulateRecordSet = unsafePopulateFunction "jsonb_populate_record_set"

751− (nullRow tableName :* expr :* Nil) `As` alias)

800+

752−

801+unsafeRecordFunction

753−renderTableTypeExpression

802+ :: (SListI record, json `In` PGJsonType)

754− :: All Top types

803+ => ByteString

804+ -> Expression schema '[] 'Ungrouped params (nullity json)

755− => Aliased (NP (Aliased (TypeExpression schema))) (tab ::: types)

805+ -> NP (Aliased (TypeExpression schema)) record

756− -> ByteString

806+ -> Query schema params record

757−renderTableTypeExpression (hc `As` tab)

807+unsafeRecordFunction fun expr types = UnsafeQuery $

758− = (renderAlias tab <>)

808+ "SELECT * FROM " <> fun <> "("

809+ <> renderExpression expr <> ")"

759− . parenthesized

810+ <+> "AS" <+> "x" <> parenthesized (renderCommaSeparated renderTy types)

760− . commaSeparated

811+ where

761− . flip appEndo []

812+ renderTy :: Aliased (TypeExpression schema) ty -> ByteString

762− . hcfoldMap

813+ renderTy (ty `As` alias) =

763− (Proxy :: Proxy Top)

764− (\(ty `As` name) -> Endo

765− ((renderAlias name <+> renderTypeExpression ty):))

814+ renderAlias alias <+> renderTypeExpression ty

766− $ hc

815+

767−

768−unsafeTableAliasedFromClauseExpression

769− :: All Top types

770− => Expression schema' relations' grouping' params' ty'

771− -> Aliased (NP (Aliased (TypeExpression schema))) (tab ::: types)

772− -> FromClause schema params '[alias ::: types]

773−unsafeTableAliasedFromClauseExpression expr types = UnsafeFromClause

774− (renderExpression expr

775− <+> "AS"

776− <+> renderTableTypeExpression types)

777−

778−-- | Builds an arbitrary record from a JSON object. As with all functions

816+-- | Builds an arbitrary record from a JSON object.

779−-- returning record, the caller must explicitly define the structure of the

817+jsonToRecord

780−-- record with an AS clause.

818+ :: SListI record

781−jsonToRecordAs

782− :: All Top types

783− => Expression schema '[] 'Ungrouped params (nullity 'PGjson)

819+ => Expression schema '[] 'Ungrouped params (nullity 'PGjson) -- ^ json object

784− -> Aliased (NP (Aliased (TypeExpression schema))) (tab ::: types)

820+ -> NP (Aliased (TypeExpression schema)) record -- ^ record types

785− -> FromClause schema params '[tab ::: types]

821+ -> Query schema params record

786−jsonToRecordAs expr types =

822+jsonToRecord = unsafeRecordFunction "json_to_record"

787− unsafeTableAliasedFromClauseExpression

823+

788− (unsafeFunction "json_to_record" expr)

789− types

790−

791−-- | Builds an arbitrary record from a binary JSON object. As with all functions

824+-- | Builds an arbitrary record from a binary JSON object.

792−-- returning record, the caller must explicitly define the structure of the

825+jsonbToRecord

793−-- record with an AS clause.

826+ :: SListI record

794−jsonbToRecordAs

795− :: All Top types

796− => Expression schema '[] 'Ungrouped params (nullity 'PGjsonb)

827+ => Expression schema '[] 'Ungrouped params (nullity 'PGjsonb) -- ^ jsonb object

797− -> Aliased (NP (Aliased (TypeExpression schema))) (tab ::: types)

828+ -> NP (Aliased (TypeExpression schema)) record -- ^ record types

798− -> FromClause schema params '[tab ::: types]

829+ -> Query schema params record

799−jsonbToRecordAs expr types =

830+jsonbToRecord = unsafeRecordFunction "jsonb_to_record"

800− unsafeTableAliasedFromClauseExpression

831+

801− (unsafeFunction "jsonb_to_record" expr)

802− types

803−

804−-- | Builds an arbitrary set of records from a JSON array of objects (see note

832+-- | Builds an arbitrary set of records from a JSON array of objects.

805−-- below). As with all functions returning record, the caller must explicitly

833+jsonToRecordSet

806−-- define the structure of the record with an AS clause.

834+ :: SListI record

807−jsonToRecordSetAs

808− :: All Top types

809− => Expression schema '[] 'Ungrouped params (nullity 'PGjson)

835+ => Expression schema '[] 'Ungrouped params (nullity 'PGjson) -- ^ json array

810− -> Aliased (NP (Aliased (TypeExpression schema))) (tab ::: types)

836+ -> NP (Aliased (TypeExpression schema)) record -- ^ record types

811− -> FromClause schema params '[tab ::: types]

837+ -> Query schema params record

812−jsonToRecordSetAs expr types =

838+jsonToRecordSet = unsafeRecordFunction "json_to_record_set"

813− unsafeTableAliasedFromClauseExpression

839+

814− (unsafeFunction "json_to_recordset" expr)

815− types

816−

817−-- | Builds an arbitrary set of records from a binary JSON array of objects (see

840+-- | Builds an arbitrary set of records from a binary JSON array of objects.

818−-- note below). As with all functions returning record, the caller must

841+jsonbToRecordSet

819−-- explicitly define the structure of the record with an AS clause.

842+ :: SListI record

820−jsonbToRecordSetAs

821− :: All Top types

822− => Expression schema '[] 'Ungrouped params (nullity 'PGjsonb)

843+ => Expression schema '[] 'Ungrouped params (nullity 'PGjsonb) -- ^ jsonb array

823− -> Aliased (NP (Aliased (TypeExpression schema))) (tab ::: types)

844+ -> NP (Aliased (TypeExpression schema)) record -- ^ record types

824− -> FromClause schema params '[tab ::: types]

845+ -> Query schema params record

825−jsonbToRecordSetAs expr types =

846+jsonbToRecordSet = unsafeRecordFunction "jsonb_to_record_set"

826− unsafeTableAliasedFromClauseExpression

827− (unsafeFunction "jsonb_to_recordset" expr)

828− types

829

847

830{-----------------------------------------

848{-----------------------------------------

831FROM clauses

849FROM clauses

@@ -835,7 +853,7 @@ FROM clauses

835A `FromClause` can be a table name, or a derived table such

853A `FromClause` can be a table name, or a derived table such

836as a subquery, a @JOIN@ construct, or complex combinations of these.

854as a subquery, a @JOIN@ construct, or complex combinations of these.

837-}

855-}

838−newtype FromClause schema params relations

856+newtype FromClause schema params from

839 = UnsafeFromClause { renderFromClause :: ByteString }

857 = UnsafeFromClause { renderFromClause :: ByteString }

840 deriving (GHC.Generic,Show,Eq,Ord,NFData)

858 deriving (GHC.Generic,Show,Eq,Ord,NFData)

841

859

@@ -843,7 +861,7 @@ newtype FromClause schema params relations

843table

861table

844 :: Has tab schema ('Table table)

862 :: Has tab schema ('Table table)

845 => Aliased Alias (alias ::: tab)

863 => Aliased Alias (alias ::: tab)

846− -> FromClause schema params '[alias ::: TableToRelation table]

864+ -> FromClause schema params '[alias ::: TableToRow table]

847table (tab `As` alias) = UnsafeFromClause $

865table (tab `As` alias) = UnsafeFromClause $

848 renderAlias tab <+> "AS" <+> renderAlias alias

866 renderAlias tab <+> "AS" <+> renderAlias alias

849

867

@@ -855,9 +873,9 @@ subquery = UnsafeFromClause . renderAliasedAs (parenthesized . renderQuery)

855

873

856-- | `view` derives a table from a `View`.

874-- | `view` derives a table from a `View`.

857view

875view

858− :: Has view schema ('View rel)

876+ :: Has view schema ('View row)

859 => Aliased Alias (alias ::: view)

877 => Aliased Alias (alias ::: view)

860− -> FromClause schema params '[alias ::: rel]

878+ -> FromClause schema params '[alias ::: row]

861view (vw `As` alias) = UnsafeFromClause $

879view (vw `As` alias) = UnsafeFromClause $

862 renderAlias vw <+> "AS" <+> renderAlias alias

880 renderAlias vw <+> "AS" <+> renderAlias alias

863

881

@@ -903,7 +921,7 @@ leftOuterJoin

903 -- ^ @on@ condition

921 -- ^ @on@ condition

904 -> FromClause schema params left

922 -> FromClause schema params left

905 -- ^ left

923 -- ^ left

906− -> FromClause schema params (Join left (NullifyRelations right))

924+ -> FromClause schema params (Join left (NullifyFrom right))

907leftOuterJoin right on left = UnsafeFromClause $

925leftOuterJoin right on left = UnsafeFromClause $

908 renderFromClause left <+> "LEFT OUTER JOIN" <+> renderFromClause right

926 renderFromClause left <+> "LEFT OUTER JOIN" <+> renderFromClause right

909 <+> "ON" <+> renderExpression on

927 <+> "ON" <+> renderExpression on

@@ -921,7 +939,7 @@ rightOuterJoin

921 -- ^ @on@ condition

939 -- ^ @on@ condition

922 -> FromClause schema params left

940 -> FromClause schema params left

923 -- ^ left

941 -- ^ left

924− -> FromClause schema params (Join (NullifyRelations left) right)

942+ -> FromClause schema params (Join (NullifyFrom left) right)

925rightOuterJoin right on left = UnsafeFromClause $

943rightOuterJoin right on left = UnsafeFromClause $

926 renderFromClause left <+> "RIGHT OUTER JOIN" <+> renderFromClause right

944 renderFromClause left <+> "RIGHT OUTER JOIN" <+> renderFromClause right

927 <+> "ON" <+> renderExpression on

945 <+> "ON" <+> renderExpression on

@@ -941,7 +959,7 @@ fullOuterJoin

941 -> FromClause schema params left

959 -> FromClause schema params left

942 -- ^ left

960 -- ^ left

943 -> FromClause schema params

961 -> FromClause schema params

944− (Join (NullifyRelations left) (NullifyRelations right))

962+ (Join (NullifyFrom left) (NullifyFrom right))

945fullOuterJoin right on left = UnsafeFromClause $

963fullOuterJoin right on left = UnsafeFromClause $

946 renderFromClause left <+> "FULL OUTER JOIN" <+> renderFromClause right

964 renderFromClause left <+> "FULL OUTER JOIN" <+> renderFromClause right

947 <+> "ON" <+> renderExpression on

965 <+> "ON" <+> renderExpression on

@@ -956,20 +974,20 @@ Grouping

956-- column @col@; otherwise @By2 (\#tab \! \#col)@ will reference a table

974-- column @col@; otherwise @By2 (\#tab \! \#col)@ will reference a table

957-- qualified column @tab.col@.

975-- qualified column @tab.col@.

958data By

976data By

959− (relations :: RelationsType)

977+ (from :: FromType)

960 (by :: (Symbol,Symbol)) where

978 (by :: (Symbol,Symbol)) where

961 By1

979 By1

962− :: (HasUnique relation relations columns, Has column columns ty)

980+ :: (HasUnique table from columns, Has column columns ty)

963 => Alias column

981 => Alias column

964− -> By relations '(relation, column)

982+ -> By from '(table, column)

965 By2

983 By2

966− :: (Has relation relations columns, Has column columns ty)

984+ :: (Has table from columns, Has column columns ty)

967− => Alias relation

985+ => Alias table

968 -> Alias column

986 -> Alias column

969− -> By relations '(relation, column)

987+ -> By from '(table, column)

970−deriving instance Show (By relations by)

988+deriving instance Show (By from by)

971−deriving instance Eq (By relations by)

989+deriving instance Eq (By from by)

972−deriving instance Ord (By relations by)

990+deriving instance Ord (By from by)

973

991

974instance (HasUnique rel rels cols, Has col cols ty, by ~ '(rel, col))

992instance (HasUnique rel rels cols, Has col cols ty, by ~ '(rel, col))

975 => IsLabel col (By rels by) where fromLabel = By1 fromLabel

993 => IsLabel col (By rels by) where fromLabel = By1 fromLabel

@@ -982,7 +1000,7 @@ instance (Has rel rels cols, Has col cols ty, bys ~ '[ '(rel, col)])

982 rel ! col = By2 rel col :* Nil

1000 rel ! col = By2 rel col :* Nil

983

1001

984-- | Renders a `By`.

1002-- | Renders a `By`.

985−renderBy :: By relations by -> ByteString

1003+renderBy :: By from by -> ByteString

986renderBy = \case

1004renderBy = \case

987 By1 column -> renderAlias column

1005 By1 column -> renderAlias column

988 By2 rel column -> renderAlias rel <> "." <> renderAlias column

1006 By2 rel column -> renderAlias rel <> "." <> renderAlias column

@@ -993,15 +1011,15 @@ renderBy = \case

993-- done on @NoGroups@ while all output `Expression`s must be aggregated

1011-- done on @NoGroups@ while all output `Expression`s must be aggregated

994-- in @Group Nil@. In general, all output `Expression`s in the

1012-- in @Group Nil@. In general, all output `Expression`s in the

995-- complement of @bys@ must be aggregated in @Group bys@.

1013-- complement of @bys@ must be aggregated in @Group bys@.

996−data GroupByClause relations grouping where

1014+data GroupByClause from grouping where

997− NoGroups :: GroupByClause relations 'Ungrouped

1015+ NoGroups :: GroupByClause from 'Ungrouped

998 Group

1016 Group

999 :: SListI bys

1017 :: SListI bys

1000− => NP (By relations) bys

1018+ => NP (By from) bys

1001− -> GroupByClause relations ('Grouped bys)

1019+ -> GroupByClause from ('Grouped bys)

1002

1020

1003-- | Renders a `GroupByClause`.

1021-- | Renders a `GroupByClause`.

1004−renderGroupByClause :: GroupByClause relations grouping -> ByteString

1022+renderGroupByClause :: GroupByClause from grouping -> ByteString

1005renderGroupByClause = \case

1023renderGroupByClause = \case

1006 NoGroups -> ""

1024 NoGroups -> ""

1007 Group Nil -> ""

1025 Group Nil -> ""

@@ -1011,17 +1029,17 @@ renderGroupByClause = \case

1011-- An `Ungrouped` `TableExpression` may only use `NoHaving` while a `Grouped`

1029-- An `Ungrouped` `TableExpression` may only use `NoHaving` while a `Grouped`

1012-- `TableExpression` must use `Having` whose conditions are combined with

1030-- `TableExpression` must use `Having` whose conditions are combined with

1013-- `.&&`.

1031-- `.&&`.

1014−data HavingClause schema relations grouping params where

1032+data HavingClause schema from grouping params where

1015− NoHaving :: HavingClause schema relations 'Ungrouped params

1033+ NoHaving :: HavingClause schema from 'Ungrouped params

1016 Having

1034 Having

1017− :: [Condition schema relations ('Grouped bys) params]

1035+ :: [Condition schema from ('Grouped bys) params]

1018− -> HavingClause schema relations ('Grouped bys) params

1036+ -> HavingClause schema from ('Grouped bys) params

1019−deriving instance Show (HavingClause schema relations grouping params)

1037+deriving instance Show (HavingClause schema from grouping params)

1020−deriving instance Eq (HavingClause schema relations grouping params)

1038+deriving instance Eq (HavingClause schema from grouping params)

1021−deriving instance Ord (HavingClause schema relations grouping params)

1039+deriving instance Ord (HavingClause schema from grouping params)

1022

1040

1023-- | Render a `HavingClause`.

1041-- | Render a `HavingClause`.

1024−renderHavingClause :: HavingClause schema relations grouping params -> ByteString

1042+renderHavingClause :: HavingClause schema from grouping params -> ByteString

1025renderHavingClause = \case

1043renderHavingClause = \case

1026 NoHaving -> ""

1044 NoHaving -> ""

1027 Having [] -> ""

1045 Having [] -> ""

@@ -1040,29 +1058,29 @@ Sorting

1040-- `AscNullsLast`, `DescNullsFirst` and `DescNullsLast` options are used to

1058-- `AscNullsLast`, `DescNullsFirst` and `DescNullsLast` options are used to

1041-- determine whether nulls appear before or after non-null values in the sort

1059-- determine whether nulls appear before or after non-null values in the sort

1042-- ordering of a `Null` result column.

1060-- ordering of a `Null` result column.

1043−data SortExpression schema relations grouping params where

1061+data SortExpression schema from grouping params where

1044 Asc

1062 Asc

1045− :: Expression schema relations grouping params ('NotNull ty)

1063+ :: Expression schema from grouping params ('NotNull ty)

1046− -> SortExpression schema relations grouping params

1064+ -> SortExpression schema from grouping params

1047 Desc

1065 Desc

1048− :: Expression schema relations grouping params ('NotNull ty)

1066+ :: Expression schema from grouping params ('NotNull ty)

1049− -> SortExpression schema relations grouping params

1067+ -> SortExpression schema from grouping params

1050 AscNullsFirst

1068 AscNullsFirst

1051− :: Expression schema relations grouping params ('Null ty)

1069+ :: Expression schema from grouping params ('Null ty)

1052− -> SortExpression schema relations grouping params

1070+ -> SortExpression schema from grouping params

1053 AscNullsLast

1071 AscNullsLast

1054− :: Expression schema relations grouping params ('Null ty)

1072+ :: Expression schema from grouping params ('Null ty)

1055− -> SortExpression schema relations grouping params

1073+ -> SortExpression schema from grouping params

1056 DescNullsFirst

1074 DescNullsFirst

1057− :: Expression schema relations grouping params ('Null ty)

1075+ :: Expression schema from grouping params ('Null ty)

1058− -> SortExpression schema relations grouping params

1076+ -> SortExpression schema from grouping params

1059 DescNullsLast

1077 DescNullsLast

1060− :: Expression schema relations grouping params ('Null ty)

1078+ :: Expression schema from grouping params ('Null ty)

1061− -> SortExpression schema relations grouping params

1079+ -> SortExpression schema from grouping params

1062−deriving instance Show (SortExpression schema relations grouping params)

1080+deriving instance Show (SortExpression schema from grouping params)

1063

1081

1064-- | Render a `SortExpression`.

1082-- | Render a `SortExpression`.

1065−renderSortExpression :: SortExpression schema relations grouping params -> ByteString

1083+renderSortExpression :: SortExpression schema from grouping params -> ByteString

1066renderSortExpression = \case

1084renderSortExpression = \case

1067 Asc expression -> renderExpression expression <+> "ASC"

1085 Asc expression -> renderExpression expression <+> "ASC"

1068 Desc expression -> renderExpression expression <+> "DESC"

1086 Desc expression -> renderExpression expression <+> "DESC"

@@ -1072,3 +1090,326 @@ renderSortExpression = \case

1072 <+> "DESC NULLS FIRST"

1090 <+> "DESC NULLS FIRST"

1073 AscNullsLast expression -> renderExpression expression <+> "ASC NULLS LAST"

1091 AscNullsLast expression -> renderExpression expression <+> "ASC NULLS LAST"

1074 DescNullsLast expression -> renderExpression expression <+> "DESC NULLS LAST"

1092 DescNullsLast expression -> renderExpression expression <+> "DESC NULLS LAST"

1093+

1094+unsafeSubqueryExpression

1095+ :: ByteString

1096+ -> Expression schema from grp params ty

1097+ -> Query schema params '[alias ::: ty]

1098+ -> Expression schema from grp params (nullity 'PGbool)

1099+unsafeSubqueryExpression op x q = UnsafeExpression $

1100+ renderExpression x <+> op <+> parenthesized (renderQuery q)

1101+

1102+unsafeRowSubqueryExpression

1103+ :: SListI row

1104+ => ByteString

1105+ -> NP (Aliased (Expression schema from grp params)) row

1106+ -> Query schema params row

1107+ -> Expression schema from grp params (nullity 'PGbool)

1108+unsafeRowSubqueryExpression op xs q = UnsafeExpression $

1109+ renderExpression (row xs) <+> op <+> parenthesized (renderQuery q)

1110+

1111+-- | The right-hand side is a sub`Query`, which must return exactly one column.

1112+-- The left-hand expression is evaluated and compared to each row of the

1113+-- sub`Query` result. The result of `in_` is `true` if any equal subquery row is found.

1114+-- The result is `false` if no equal row is found

1115+-- (including the case where the subquery returns no rows).

1116+--

1117+-- >>> printSQL $ true `in_` values_ (true `as` #foo)

1118+-- TRUE IN (SELECT * FROM (VALUES (TRUE)) AS t ("foo"))

1119+in_

1120+ :: Expression schema from grp params ty -- ^ expression

1121+ -> Query schema params '[alias ::: ty] -- ^ subquery

1122+ -> Expression schema from grp params (nullity 'PGbool)

1123+in_ = unsafeSubqueryExpression "IN"

1124+

1125+{- | The left-hand side of this form of `rowIn` is a row constructor.

1126+The right-hand side is a sub`Query`,

1127+which must return exactly as many columns as

1128+there are expressions in the left-hand row.

1129+The left-hand expressions are evaluated and compared row-wise to each row

1130+of the subquery result. The result of `rowIn`

1131+is `true` if any equal subquery row is found.

1132+The result is `false` if no equal row is found

1133+(including the case where the subquery returns no rows).

1134+

1135+>>> let myRow = 1 `as` #foo :* false `as` #bar :: NP (Aliased (Expression '[] '[] 'Ungrouped '[])) '["foo" ::: 'NotNull 'PGint2, "bar" ::: 'NotNull 'PGbool]

1136+>>> printSQL $ myRow `rowIn` values_ myRow

1137+ROW(1, FALSE) IN (SELECT * FROM (VALUES (1, FALSE)) AS t ("foo", "bar"))

1138+-}

1139+rowIn

1140+ :: SListI row

1141+ => NP (Aliased (Expression schema from grp params)) row -- ^ row constructor

1142+ -> Query schema params row -- ^ subquery

1143+ -> Expression schema from grp params (nullity 'PGbool)

1144+rowIn = unsafeRowSubqueryExpression "IN"

1145+

1146+-- | >>> printSQL $ true `eqAll` values_ (true `as` #foo)

1147+-- TRUE = ALL (SELECT * FROM (VALUES (TRUE)) AS t ("foo"))

1148+eqAll

1149+ :: Expression schema from grp params ty -- ^ expression

1150+ -> Query schema params '[alias ::: ty] -- ^ subquery

1151+ -> Expression schema from grp params (nullity 'PGbool)

1152+eqAll = unsafeSubqueryExpression "= ALL"

1153+

1154+-- | >>> let myRow = 1 `as` #foo :* false `as` #bar :: NP (Aliased (Expression '[] '[] 'Ungrouped '[])) '["foo" ::: 'NotNull 'PGint2, "bar" ::: 'NotNull 'PGbool]

1155+-- >>> printSQL $ myRow `rowEqAll` values_ myRow

1156+-- ROW(1, FALSE) = ALL (SELECT * FROM (VALUES (1, FALSE)) AS t ("foo", "bar"))

1157+rowEqAll

1158+ :: SListI row

1159+ => NP (Aliased (Expression schema from grp params)) row -- ^ row constructor

1160+ -> Query schema params row -- ^ subquery

1161+ -> Expression schema from grp params (nullity 'PGbool)

1162+rowEqAll = unsafeRowSubqueryExpression "= ALL"

1163+

1164+-- | >>> printSQL $ true `eqAny` values_ (true `as` #foo)

1165+-- TRUE = ANY (SELECT * FROM (VALUES (TRUE)) AS t ("foo"))

1166+eqAny

1167+ :: Expression schema from grp params ty -- ^ expression

1168+ -> Query schema params '[alias ::: ty] -- ^ subquery

1169+ -> Expression schema from grp params (nullity 'PGbool)

1170+eqAny = unsafeSubqueryExpression "= ANY"

1171+

1172+-- | >>> let myRow = 1 `as` #foo :* false `as` #bar :: NP (Aliased (Expression '[] '[] 'Ungrouped '[])) '["foo" ::: 'NotNull 'PGint2, "bar" ::: 'NotNull 'PGbool]

1173+-- >>> printSQL $ myRow `rowEqAny` values_ myRow

1174+-- ROW(1, FALSE) = ANY (SELECT * FROM (VALUES (1, FALSE)) AS t ("foo", "bar"))

1175+rowEqAny

1176+ :: SListI row

1177+ => NP (Aliased (Expression schema from grp params)) row -- ^ row constructor

1178+ -> Query schema params row -- ^ subquery

1179+ -> Expression schema from grp params (nullity 'PGbool)

1180+rowEqAny = unsafeRowSubqueryExpression "= ANY"

1181+

1182+-- | >>> printSQL $ true `neqAll` values_ (true `as` #foo)

1183+-- TRUE <> ALL (SELECT * FROM (VALUES (TRUE)) AS t ("foo"))

1184+neqAll

1185+ :: Expression schema from grp params ty -- ^ expression

1186+ -> Query schema params '[alias ::: ty] -- ^ subquery

1187+ -> Expression schema from grp params (nullity 'PGbool)

1188+neqAll = unsafeSubqueryExpression "<> ALL"

1189+

1190+-- | >>> let myRow = 1 `as` #foo :* false `as` #bar :: NP (Aliased (Expression '[] '[] 'Ungrouped '[])) '["foo" ::: 'NotNull 'PGint2, "bar" ::: 'NotNull 'PGbool]

1191+-- >>> printSQL $ myRow `rowNeqAll` values_ myRow

1192+-- ROW(1, FALSE) <> ALL (SELECT * FROM (VALUES (1, FALSE)) AS t ("foo", "bar"))

1193+rowNeqAll

1194+ :: SListI row

1195+ => NP (Aliased (Expression schema from grp params)) row -- ^ row constructor

1196+ -> Query schema params row -- ^ subquery

1197+ -> Expression schema from grp params (nullity 'PGbool)

1198+rowNeqAll = unsafeRowSubqueryExpression "<> ALL"

1199+

1200+-- | >>> printSQL $ true `neqAny` values_ (true `as` #foo)

1201+-- TRUE <> ANY (SELECT * FROM (VALUES (TRUE)) AS t ("foo"))

1202+neqAny

1203+ :: Expression schema from grp params ty -- ^ expression

1204+ -> Query schema params '[alias ::: ty] -- ^ subquery

1205+ -> Expression schema from grp params (nullity 'PGbool)

1206+neqAny = unsafeSubqueryExpression "<> ANY"

1207+

1208+-- | >>> let myRow = 1 `as` #foo :* false `as` #bar :: NP (Aliased (Expression '[] '[] 'Ungrouped '[])) '["foo" ::: 'NotNull 'PGint2, "bar" ::: 'NotNull 'PGbool]

1209+-- >>> printSQL $ myRow `rowNeqAny` values_ myRow

1210+-- ROW(1, FALSE) <> ANY (SELECT * FROM (VALUES (1, FALSE)) AS t ("foo", "bar"))

1211+rowNeqAny

1212+ :: SListI row

1213+ => NP (Aliased (Expression schema from grp params)) row -- ^ row constructor

1214+ -> Query schema params row -- ^ subquery

1215+ -> Expression schema from grp params (nullity 'PGbool)

1216+rowNeqAny = unsafeRowSubqueryExpression "<> ANY"

1217+

1218+-- | >>> printSQL $ true `allLt` values_ (true `as` #foo)

1219+-- TRUE ALL < (SELECT * FROM (VALUES (TRUE)) AS t ("foo"))

1220+allLt

1221+ :: Expression schema from grp params ty -- ^ expression

1222+ -> Query schema params '[alias ::: ty] -- ^ subquery

1223+ -> Expression schema from grp params (nullity 'PGbool)

1224+allLt = unsafeSubqueryExpression "ALL <"

1225+

1226+-- | >>> let myRow = 1 `as` #foo :* false `as` #bar :: NP (Aliased (Expression '[] '[] 'Ungrouped '[])) '["foo" ::: 'NotNull 'PGint2, "bar" ::: 'NotNull 'PGbool]

1227+-- >>> printSQL $ myRow `rowLtAll` values_ myRow

1228+-- ROW(1, FALSE) ALL < (SELECT * FROM (VALUES (1, FALSE)) AS t ("foo", "bar"))

1229+rowLtAll

1230+ :: SListI row

1231+ => NP (Aliased (Expression schema from grp params)) row -- ^ row constructor

1232+ -> Query schema params row -- ^ subquery

1233+ -> Expression schema from grp params (nullity 'PGbool)

1234+rowLtAll = unsafeRowSubqueryExpression "ALL <"

1235+

1236+-- | >>> printSQL $ true `ltAny` values_ (true `as` #foo)

1237+-- TRUE ANY < (SELECT * FROM (VALUES (TRUE)) AS t ("foo"))

1238+ltAny

1239+ :: Expression schema from grp params ty -- ^ expression

1240+ -> Query schema params '[alias ::: ty] -- ^ subquery

1241+ -> Expression schema from grp params (nullity 'PGbool)

1242+ltAny = unsafeSubqueryExpression "ANY <"

1243+

1244+-- | >>> let myRow = 1 `as` #foo :* false `as` #bar :: NP (Aliased (Expression '[] '[] 'Ungrouped '[])) '["foo" ::: 'NotNull 'PGint2, "bar" ::: 'NotNull 'PGbool]

1245+-- >>> printSQL $ myRow `rowLtAll` values_ myRow

1246+-- ROW(1, FALSE) ALL < (SELECT * FROM (VALUES (1, FALSE)) AS t ("foo", "bar"))

1247+rowLtAny

1248+ :: SListI row

1249+ => NP (Aliased (Expression schema from grp params)) row -- ^ row constructor

1250+ -> Query schema params row -- ^ subquery

1251+ -> Expression schema from grp params (nullity 'PGbool)

1252+rowLtAny = unsafeRowSubqueryExpression "ANY <"

1253+

1254+-- | >>> printSQL $ true `lteAll` values_ (true `as` #foo)

1255+-- TRUE <= ALL (SELECT * FROM (VALUES (TRUE)) AS t ("foo"))

1256+lteAll

1257+ :: Expression schema from grp params ty -- ^ expression

1258+ -> Query schema params '[alias ::: ty] -- ^ subquery

1259+ -> Expression schema from grp params (nullity 'PGbool)

1260+lteAll = unsafeSubqueryExpression "<= ALL"

1261+

1262+-- | >>> let myRow = 1 `as` #foo :* false `as` #bar :: NP (Aliased (Expression '[] '[] 'Ungrouped '[])) '["foo" ::: 'NotNull 'PGint2, "bar" ::: 'NotNull 'PGbool]

1263+-- >>> printSQL $ myRow `rowLteAll` values_ myRow

1264+-- ROW(1, FALSE) <= ALL (SELECT * FROM (VALUES (1, FALSE)) AS t ("foo", "bar"))

1265+rowLteAll

1266+ :: SListI row

1267+ => NP (Aliased (Expression schema from grp params)) row -- ^ row constructor

1268+ -> Query schema params row -- ^ subquery

1269+ -> Expression schema from grp params (nullity 'PGbool)

1270+rowLteAll = unsafeRowSubqueryExpression "<= ALL"

1271+

1272+-- | >>> printSQL $ true `lteAny` values_ (true `as` #foo)

1273+-- TRUE <= ANY (SELECT * FROM (VALUES (TRUE)) AS t ("foo"))

1274+lteAny

1275+ :: Expression schema from grp params ty -- ^ expression

1276+ -> Query schema params '[alias ::: ty] -- ^ subquery

1277+ -> Expression schema from grp params (nullity 'PGbool)

1278+lteAny = unsafeSubqueryExpression "<= ANY"

1279+

1280+-- | >>> let myRow = 1 `as` #foo :* false `as` #bar :: NP (Aliased (Expression '[] '[] 'Ungrouped '[])) '["foo" ::: 'NotNull 'PGint2, "bar" ::: 'NotNull 'PGbool]

1281+-- >>> printSQL $ myRow `rowLteAny` values_ myRow

1282+-- ROW(1, FALSE) <= ANY (SELECT * FROM (VALUES (1, FALSE)) AS t ("foo", "bar"))

1283+rowLteAny

1284+ :: SListI row

1285+ => NP (Aliased (Expression schema from grp params)) row -- ^ row constructor

1286+ -> Query schema params row -- ^ subquery

1287+ -> Expression schema from grp params (nullity 'PGbool)

1288+rowLteAny = unsafeRowSubqueryExpression "<= ANY"

1289+

1290+-- | >>> printSQL $ true `gtAll` values_ (true `as` #foo)

1291+-- TRUE > ALL (SELECT * FROM (VALUES (TRUE)) AS t ("foo"))

1292+gtAll

1293+ :: Expression schema from grp params ty -- ^ expression

1294+ -> Query schema params '[alias ::: ty] -- ^ subquery

1295+ -> Expression schema from grp params (nullity 'PGbool)

1296+gtAll = unsafeSubqueryExpression "> ALL"

1297+

1298+-- | >>> let myRow = 1 `as` #foo :* false `as` #bar :: NP (Aliased (Expression '[] '[] 'Ungrouped '[])) '["foo" ::: 'NotNull 'PGint2, "bar" ::: 'NotNull 'PGbool]

1299+-- >>> printSQL $ myRow `rowGtAll` values_ myRow

1300+-- ROW(1, FALSE) > ALL (SELECT * FROM (VALUES (1, FALSE)) AS t ("foo", "bar"))

1301+rowGtAll

1302+ :: SListI row

1303+ => NP (Aliased (Expression schema from grp params)) row -- ^ row constructor

1304+ -> Query schema params row -- ^ subquery

1305+ -> Expression schema from grp params (nullity 'PGbool)

1306+rowGtAll = unsafeRowSubqueryExpression "> ALL"

1307+

1308+-- | >>> printSQL $ true `gtAny` values_ (true `as` #foo)

1309+-- TRUE > ANY (SELECT * FROM (VALUES (TRUE)) AS t ("foo"))

1310+gtAny

1311+ :: Expression schema from grp params ty -- ^ expression

1312+ -> Query schema params '[alias ::: ty] -- ^ subquery

1313+ -> Expression schema from grp params (nullity 'PGbool)

1314+gtAny = unsafeSubqueryExpression "> ANY"

1315+

1316+-- | >>> let myRow = 1 `as` #foo :* false `as` #bar :: NP (Aliased (Expression '[] '[] 'Ungrouped '[])) '["foo" ::: 'NotNull 'PGint2, "bar" ::: 'NotNull 'PGbool]

1317+-- >>> printSQL $ myRow `rowGtAny` values_ myRow

1318+-- ROW(1, FALSE) > ANY (SELECT * FROM (VALUES (1, FALSE)) AS t ("foo", "bar"))

1319+rowGtAny

1320+ :: SListI row

1321+ => NP (Aliased (Expression schema from grp params)) row -- ^ row constructor

1322+ -> Query schema params row -- ^ subquery

1323+ -> Expression schema from grp params (nullity 'PGbool)

1324+rowGtAny = unsafeRowSubqueryExpression "> ANY"

1325+

1326+-- | >>> printSQL $ true `gteAll` values_ (true `as` #foo)

1327+-- TRUE >= ALL (SELECT * FROM (VALUES (TRUE)) AS t ("foo"))

1328+gteAll

1329+ :: Expression schema from grp params ty -- ^ expression

1330+ -> Query schema params '[alias ::: ty] -- ^ subquery

1331+ -> Expression schema from grp params (nullity 'PGbool)

1332+gteAll = unsafeSubqueryExpression ">= ALL"

1333+

1334+-- | >>> let myRow = 1 `as` #foo :* false `as` #bar :: NP (Aliased (Expression '[] '[] 'Ungrouped '[])) '["foo" ::: 'NotNull 'PGint2, "bar" ::: 'NotNull 'PGbool]

1335+-- >>> printSQL $ myRow `rowGteAll` values_ myRow

1336+-- ROW(1, FALSE) >= ALL (SELECT * FROM (VALUES (1, FALSE)) AS t ("foo", "bar"))

1337+rowGteAll

1338+ :: SListI row

1339+ => NP (Aliased (Expression schema from grp params)) row -- ^ row constructor

1340+ -> Query schema params row -- ^ subquery

1341+ -> Expression schema from grp params (nullity 'PGbool)

1342+rowGteAll = unsafeRowSubqueryExpression ">= ALL"

1343+

1344+-- | >>> printSQL $ true `gteAny` values_ (true `as` #foo)

1345+-- TRUE >= ANY (SELECT * FROM (VALUES (TRUE)) AS t ("foo"))

1346+gteAny

1347+ :: Expression schema from grp params ty -- ^ expression

1348+ -> Query schema params '[alias ::: ty] -- ^ subquery

1349+ -> Expression schema from grp params (nullity 'PGbool)

1350+gteAny = unsafeSubqueryExpression ">= ANY"

1351+

1352+-- | >>> let myRow = 1 `as` #foo :* false `as` #bar :: NP (Aliased (Expression '[] '[] 'Ungrouped '[])) '["foo" ::: 'NotNull 'PGint2, "bar" ::: 'NotNull 'PGbool]

1353+-- >>> printSQL $ myRow `rowGteAny` values_ myRow

1354+-- ROW(1, FALSE) >= ANY (SELECT * FROM (VALUES (1, FALSE)) AS t ("foo", "bar"))

1355+rowGteAny

1356+ :: SListI row

1357+ => NP (Aliased (Expression schema from grp params)) row -- ^ row constructor

1358+ -> Query schema params row -- ^ subquery

1359+ -> Expression schema from grp params (nullity 'PGbool)

1360+rowGteAny = unsafeRowSubqueryExpression ">= ANY"

1361+

1362+-- | A `CommonTableExpression` is an auxiliary statement in a `with` clause.

1363+data CommonTableExpression statement

1364+ (params :: [NullityType])

1365+ (schema0 :: SchemaType)

1366+ (schema1 :: SchemaType) where

1367+ CommonTableExpression

1368+ :: Aliased (statement schema params) (alias ::: cte)

1369+ -> CommonTableExpression

1370+ statement params schema (alias ::: 'View cte ': schema)

1371+instance (KnownSymbol alias, schema1 ~ (alias ::: 'View cte ': schema))

1372+ => Aliasable alias

1373+ (statement schema params cte)

1374+ (CommonTableExpression statement params schema schema1) where

1375+ statement `as` alias = CommonTableExpression (statement `as` alias)

1376+instance (KnownSymbol alias, schema1 ~ (alias ::: 'View cte ': schema))

1377+ => Aliasable alias (statement schema params cte)

1378+ (AlignedList (CommonTableExpression statement params) schema schema1) where

1379+ statement `as` alias = single (statement `as` alias)

1380+

1381+-- | render a `CommonTableExpression`.

1382+renderCommonTableExpression

1383+ :: (forall sch ps row. statement ps sch row -> ByteString) -- ^ render statement

1384+ -> CommonTableExpression statement params schema0 schema1 -> ByteString

1385+renderCommonTableExpression renderStatement

1386+ (CommonTableExpression (statement `As` alias)) =

1387+ renderAlias alias <+> "AS" <+> parenthesized (renderStatement statement)

1388+

1389+-- | render a non-empty `AlignedList` of `CommonTableExpression`s.

1390+renderCommonTableExpressions

1391+ :: (forall sch ps row. statement ps sch row -> ByteString) -- ^ render statement

1392+ -> CommonTableExpression statement params schema0 schema1

1393+ -> AlignedList (CommonTableExpression statement params) schema1 schema2

1394+ -> ByteString

1395+renderCommonTableExpressions renderStatement cte ctes =

1396+ renderCommonTableExpression renderStatement cte <> case ctes of

1397+ Done -> ""

1398+ cte' :>> ctes' -> "," <+>

1399+ renderCommonTableExpressions renderStatement cte' ctes'

1400+

1401+-- | `with` provides a way to write auxiliary statements for use in a larger query.

1402+-- These statements, referred to as `CommonTableExpression`s, can be thought of as

1403+-- defining temporary tables that exist just for one query.

1404+class With statement where

1405+ with

1406+ :: AlignedList (CommonTableExpression statement params) schema0 schema1

1407+ -- ^ common table expressions

1408+ -> statement schema1 params row

1409+ -- ^ larger query

1410+ -> statement schema0 params row

1411+instance With Query where

1412+ with Done query = query

1413+ with (cte :>> ctes) query = UnsafeQuery $

1414+ "WITH" <+> renderCommonTableExpressions renderQuery cte ctes

1415+ <+> renderQuery query

squeal-postgresql/src/Squeal/PostgreSQL/Render.hs+11−3

@@ -9,12 +9,14 @@ Rendering helper functions.

9-}

11{-# LANGUAGE

12+ AllowAmbiguousTypes

12− FlexibleContexts

13+ , FlexibleContexts

13 , MagicHash

14 , MagicHash

14 , OverloadedStrings

15 , OverloadedStrings

15 , PolyKinds

16 , PolyKinds

16 , RankNTypes

17 , RankNTypes

17 , ScopedTypeVariables

18 , ScopedTypeVariables

19+ , TypeApplications

18#-}

20#-}

20module Squeal.PostgreSQL.Render

22module Squeal.PostgreSQL.Render

@@ -28,6 +30,7 @@ module Squeal.PostgreSQL.Render

28 , renderCommaSeparated

30 , renderCommaSeparated

29 , renderCommaSeparatedMaybe

31 , renderCommaSeparatedMaybe

30 , renderNat

32 , renderNat

33+ , renderSymbol

31 , RenderSQL (..)

34 , RenderSQL (..)

32 , printSQL

35 , printSQL

33 ) where

36 ) where

@@ -51,6 +54,7 @@ parenthesized str = "(" <> str <> ")"

52-- | Concatenate two `ByteString`s with a space between.

55-- | Concatenate two `ByteString`s with a space between.

53(<+>) :: ByteString -> ByteString -> ByteString

56(<+>) :: ByteString -> ByteString -> ByteString

57+infixr 7 <+>

54str1 <+> str2 = str1 <> " " <> str2

58str1 <+> str2 = str1 <> " " <> str2

56-- | Comma separate a list of `ByteString`s.

60-- | Comma separate a list of `ByteString`s.

@@ -92,8 +96,12 @@ renderCommaSeparatedMaybe render

92 . hmap (K . render)

96 . hmap (K . render)

94-- | Render a promoted `Nat`.

98-- | Render a promoted `Nat`.

95−renderNat :: KnownNat n => proxy n -> ByteString

99+renderNat :: forall n. KnownNat n => ByteString

96−renderNat (_ :: proxy n) = fromString (show (natVal' (proxy# :: Proxy# n)))

100+renderNat = fromString (show (natVal' (proxy# :: Proxy# n)))

101+

102+-- | Render a promoted `Symbol`.

103+renderSymbol :: forall s. KnownSymbol s => ByteString

104+renderSymbol = fromString (symbolVal' (proxy# :: Proxy# s))

105

98-- | A class for rendering SQL

106-- | A class for rendering SQL

99class RenderSQL sql where

107class RenderSQL sql where

squeal-postgresql/src/Squeal/PostgreSQL/Schema.hs+307−348

@@ -20,6 +20,7 @@ it defines an embedding of Haskell types into Postgres types.

20 , FlexibleInstances

21 , FunctionalDependencies

22 , GADTs

23+ , LambdaCase

23 , OverloadedStrings

24 , OverloadedStrings

24 , RankNTypes

25 , RankNTypes

25 , ScopedTypeVariables

26 , ScopedTypeVariables

@@ -33,18 +34,24 @@ it defines an embedding of Haskell types into Postgres types.

33#-}

34#-}

35module Squeal.PostgreSQL.Schema

36module Squeal.PostgreSQL.Schema

36− ( -- * Types

37+ ( -- * Postgres Types

37 PGType (..)

38 PGType (..)

38− , HasOid (..)

39 , NullityType (..)

40+ , RowType

41+ , FromType

42+ -- * Haskell to Postgres Types

43+ , PG

44+ , NullPG

45+ , TuplePG

46+ , RowPG

47+ , Json (..)

48+ , Jsonb (..)

49+ , Composite (..)

50+ , Enumerated (..)

51+ -- * Schema Types

40 , ColumnType

52 , ColumnType

41− -- * Tables

42 , ColumnsType

53 , ColumnsType

43− , RelationType

44− , NilRelation

45− , RelationsType

46 , TableType

54 , TableType

47− -- * Schema

48 , SchemumType (..)

55 , SchemumType (..)

49 , SchemaType

56 , SchemaType

50 -- * Constraints

57 -- * Constraints

@@ -52,7 +59,6 @@ module Squeal.PostgreSQL.Schema

52 , ColumnConstraint (..)

59 , ColumnConstraint (..)

53 , TableConstraint (..)

60 , TableConstraint (..)

54 , TableConstraints

61 , TableConstraints

55− , NilTableConstraints

56 , Uniquely

62 , Uniquely

57 -- * Aliases

63 -- * Aliases

58 , (:::)

64 , (:::)

@@ -62,8 +68,6 @@ module Squeal.PostgreSQL.Schema

62 , Aliased (As)

68 , Aliased (As)

63 , Aliasable (as)

69 , Aliasable (as)

64 , renderAliasedAs

70 , renderAliasedAs

65− , AliasesOf

66− , ZipAliased (..)

67 , Has

71 , Has

68 , HasUnique

72 , HasUnique

69 , HasAll

73 , HasAll

@@ -75,62 +79,48 @@ module Squeal.PostgreSQL.Schema

75 , PGlabel (..)

79 , PGlabel (..)

76 , renderLabel

80 , renderLabel

77 , renderLabels

81 , renderLabels

82+ , LabelsPG

78 -- * Grouping

83 -- * Grouping

79 , Grouping (..)

84 , Grouping (..)

80 , GroupedBy

85 , GroupedBy

81− -- * Type Families

86+ -- * Aligned lists

82− , Join

87+ , AlignedList (..)

83− , With

88+ , single

89+ -- * Data Definitions

84 , Create

90 , Create

85 , Drop

91 , Drop

86 , Alter

92 , Alter

87 , Rename

93 , Rename

94+ , DropIfConstraintsInvolve

95+ -- * Lists

96+ , Join

88 , Elem

97 , Elem

89 , In

98 , In

99+ , Length

100+ -- * Type Classifications

101+ , HasOid (..)

90 , PGNum

102 , PGNum

91 , PGIntegral

103 , PGIntegral

92 , PGFloating

104 , PGFloating

93 , PGTypeOf

105 , PGTypeOf

94− , PGarrayOf

106+ , PGArrayOf

95− , PGarray

107+ , PGArray

96− , PGtextArray

108+ , PGTextArray

97− , SameTypes

109+ , PGJsonType

110+ , PGJsonKey

98 , SamePGType

111 , SamePGType

99 , AllNotNull

112 , AllNotNull

100 , NotAllNull

113 , NotAllNull

114+ -- * Nullifications

101 , NullifyType

115 , NullifyType

102− , NullifyRelation

116+ , NullifyRow

103− , NullifyRelations

117+ , NullifyFrom

104− , ColumnsToRelation

118+ -- * Table Conversions

105 , TableToColumns

119 , TableToColumns

106− , TableToRelation

120+ , TableToRow

107− , RelationToRowType

108− , RelationToNullityTypes

109− , ConstraintInvolves

110− , DropIfConstraintsInvolve

111− -- ** JSON support

112− , PGjson_

113− , PGjsonKey

114− -- * Embedding

115− , PG

116− , EnumFrom

117− , LabelsFrom

118− , CompositeFrom

119− , FieldNamesFrom

120− , FieldTypesFrom

121− , ConstructorsOf

122− , ConstructorNameOf

123− , ConstructorNamesOf

124− , FieldsOf

125− , FieldNameOf

126− , FieldNamesOf

127− , FieldTypeOf

128− , FieldTypesOf

129− , RecordCodeOf

130− , MapMaybes (..)

131− , Nulls

132 ) where

121 ) where

133

122

123+import Control.Category

134import Control.DeepSeq

124import Control.DeepSeq

135import Data.Aeson (Value)

125import Data.Aeson (Value)

136import Data.ByteString (ByteString)

126import Data.ByteString (ByteString)

@@ -144,10 +134,13 @@ import Data.Time

144import Data.Word (Word16, Word32, Word64)

134import Data.Word (Word16, Word32, Word64)

145import Data.Type.Bool

135import Data.Type.Bool

146import Data.UUID.Types (UUID)

136import Data.UUID.Types (UUID)

137+import Data.Vector (Vector)

147import Generics.SOP

138import Generics.SOP

139+import Generics.SOP.Record

148import GHC.OverloadedLabels

140import GHC.OverloadedLabels

149import GHC.TypeLits

141import GHC.TypeLits

150import Network.IP.Addr

142import Network.IP.Addr

143+import Prelude hiding (id, (.))

151

144

152import qualified Data.ByteString.Lazy as Lazy

145import qualified Data.ByteString.Lazy as Lazy

153import qualified Data.Text.Lazy as Lazy

146import qualified Data.Text.Lazy as Lazy

@@ -183,10 +176,10 @@ data PGType

183 | PGinet -- ^ IPv4 or IPv6 host address

176 | PGinet -- ^ IPv4 or IPv6 host address

184 | PGjson -- ^ textual JSON data

177 | PGjson -- ^ textual JSON data

185 | PGjsonb -- ^ binary JSON data, decomposed

178 | PGjsonb -- ^ binary JSON data, decomposed

186− | PGvararray PGType -- ^ variable length array

179+ | PGvararray NullityType -- ^ variable length array

187− | PGfixarray Nat PGType -- ^ fixed length array

180+ | PGfixarray Nat NullityType -- ^ fixed length array

188− | PGenum [Symbol]

181+ | PGenum [Symbol] -- ^ enumerated (enum) types are data types that comprise a static, ordered set of values.

189− | PGcomposite [(Symbol, PGType)]

182+ | PGcomposite RowType -- ^ a composite type represents the structure of a row or record; it is essentially just a list of field names and their data types.

190 | UnsafePGType Symbol -- ^ an escape hatch for unsupported PostgreSQL types

183 | UnsafePGType Symbol -- ^ an escape hatch for unsupported PostgreSQL types

191

184

192-- | The object identifier of a `PGType`.

185-- | The object identifier of a `PGType`.

@@ -283,9 +276,6 @@ data TableConstraint

283

276

284-- | A `TableConstraints` is a row of `TableConstraint`s.

277-- | A `TableConstraints` is a row of `TableConstraint`s.

285type TableConstraints = [(Symbol,TableConstraint)]

278type TableConstraints = [(Symbol,TableConstraint)]

286−-- | A monokinded empty `TableConstraints`.

287−type family NilTableConstraints :: TableConstraints where

288− NilTableConstraints = '[]

289

279

290-- | A `ForeignKey` must reference columns that either are

280-- | A `ForeignKey` must reference columns that either are

291-- a `PrimaryKey` or form a `Unique` constraint.

281-- a `PrimaryKey` or form a `Unique` constraint.

@@ -309,36 +299,39 @@ type family Uniquely

309-- :}

299-- :}

310type TableType = (TableConstraints,ColumnsType)

300type TableType = (TableConstraints,ColumnsType)

311

301

312−-- | `RelationType` is a row of `NullityType`

302+{- | A `RowType` is a row of `NullityType`. They correspond to Haskell

313−--

303+record types by means of `RowPG` and are used in many places.

304+

314−-- >>> :{

305+>>> :{

315−-- type family PersonRelation :: RelationType where

306+type family PersonRow :: RowType where

316−-- PersonRelation =

307+ PersonRow =

317−-- '[ "name" ::: 'NotNull 'PGtext

308+ '[ "name" ::: 'NotNull 'PGtext

318−-- , "age" ::: 'NotNull 'PGint4

309+ , "age" ::: 'NotNull 'PGint4

319−-- , "dateOfBirth" ::: 'Null 'PGdate

310+ , "dateOfBirth" ::: 'Null 'PGdate

320−-- ]

311+ ]

321−-- :}

312+:}

313+-}

322−type RelationType = [(Symbol,NullityType)]

314+type RowType = [(Symbol,NullityType)]

323−-- | A monokinded empty `RelationType`.

324−type family NilRelation :: RelationType where NilRelation = '[]

325

315

326−-- | `RelationsType` is a row of `RelationType`s, thought of as a product.

316+{- | `FromType` is a row of `RowType`s. It can be thought of as

327−type RelationsType = [(Symbol,RelationType)]

317+a product, or horizontal gluing and is used in `Squeal.PostgreSQL.Query.FromClause`s

318+and `Squeal.PostgreSQL.Query.TableExpression`s.

319+-}

320+type FromType = [(Symbol,RowType)]

328

321

329−-- | `ColumnsToRelation` removes column constraints.

322+-- | `ColumnsToRow` removes column constraints.

330−type family ColumnsToRelation (columns :: ColumnsType) :: RelationType where

323+type family ColumnsToRow (columns :: ColumnsType) :: RowType where

331− ColumnsToRelation '[] = '[]

324+ ColumnsToRow '[] = '[]

332− ColumnsToRelation (column ::: constraint :=> ty ': columns) =

325+ ColumnsToRow (column ::: constraint :=> ty ': columns) =

333− column ::: ty ': ColumnsToRelation columns

326+ column ::: ty ': ColumnsToRow columns

334

327

335-- | `TableToColumns` removes table constraints.

328-- | `TableToColumns` removes table constraints.

336type family TableToColumns (table :: TableType) :: ColumnsType where

329type family TableToColumns (table :: TableType) :: ColumnsType where

337 TableToColumns (constraints :=> columns) = columns

330 TableToColumns (constraints :=> columns) = columns

338

331

339−-- | Convert a table to a relation.

332+-- | Convert a table to a row type.

340−type family TableToRelation (table :: TableType) :: RelationType where

333+type family TableToRow (table :: TableType) :: RowType where

341− TableToRelation tab = ColumnsToRelation (TableToColumns tab)

334+ TableToRow tab = ColumnsToRow (TableToColumns tab)

342

335

343-- | `Grouping` is an auxiliary namespace, created by

336-- | `Grouping` is an auxiliary namespace, created by

344-- @GROUP BY@ clauses (`Squeal.PostgreSQL.Query.group`), and used

337-- @GROUP BY@ clauses (`Squeal.PostgreSQL.Query.group`), and used

@@ -351,15 +344,15 @@ data Grouping

351a member of the auxiliary namespace created by @GROUP BY@ clauses and thus,

344a member of the auxiliary namespace created by @GROUP BY@ clauses and thus,

352may be called in an output `Squeal.PostgreSQL.Expression.Expression` without aggregating.

345may be called in an output `Squeal.PostgreSQL.Expression.Expression` without aggregating.

353-}

346-}

354−class (KnownSymbol relation, KnownSymbol column)

347+class (KnownSymbol table, KnownSymbol column)

355− => GroupedBy relation column bys where

348+ => GroupedBy table column bys where

356−instance {-# OVERLAPPING #-} (KnownSymbol relation, KnownSymbol column)

349+instance {-# OVERLAPPING #-} (KnownSymbol table, KnownSymbol column)

357− => GroupedBy relation column ('(table,column) ': bys)

350+ => GroupedBy table column ('(table,column) ': bys)

358instance {-# OVERLAPPABLE #-}

351instance {-# OVERLAPPABLE #-}

359− ( KnownSymbol relation

352+ ( KnownSymbol table

360 , KnownSymbol column

353 , KnownSymbol column

361− , GroupedBy relation column bys

354+ , GroupedBy table column bys

362− ) => GroupedBy relation column (tabcol ': bys)

355+ ) => GroupedBy table column (tabcol ': bys)

363

356

364-- | `Alias`es are proxies for a type level string or `Symbol`

357-- | `Alias`es are proxies for a type level string or `Symbol`

365-- and have an `IsLabel` instance so that with @-XOverloadedLabels@

358-- and have an `IsLabel` instance so that with @-XOverloadedLabels@

@@ -420,7 +413,7 @@ class KnownSymbol alias => Aliasable alias expression aliased

420 | aliased -> expression

413 | aliased -> expression

421 , aliased -> alias

414 , aliased -> alias

422 where as :: expression -> Alias alias -> aliased

415 where as :: expression -> Alias alias -> aliased

423−instance (alias ~ alias1, KnownSymbol alias) => Aliasable alias

416+instance (KnownSymbol alias, alias ~ alias1) => Aliasable alias

424 (expression ty)

417 (expression ty)

425 (Aliased expression (alias1 ::: ty))

418 (Aliased expression (alias1 ::: ty))

426 where

419 where

@@ -441,41 +434,6 @@ renderAliasedAs

441renderAliasedAs render (expression `As` alias) =

434renderAliasedAs render (expression `As` alias) =

442 render expression <> " AS " <> renderAlias alias

435 render expression <> " AS " <> renderAlias alias

443

436

444−-- | `AliasesOf` retains the AliasesOf in a row.

445−type family AliasesOf aliaseds where

446− AliasesOf '[] = '[]

447− AliasesOf (alias ::: ty ': tys) = alias ': AliasesOf tys

448−

449−-- | The `ZipAliased` class provides a type family for zipping

450−-- `Symbol` lists together with arbitrary lists of the same size,

451−-- with an associated type family `ZipAs`, together with

452−-- a method `zipAs` for zipping heterogeneous lists of `Alias`es

453−-- together with a heterogeneous list of expressions into

454−-- a heterogeneous list of `Aliased` expressions.

455−class

456− ( SListI (ZipAs ns xs)

457− , All KnownSymbol ns

458− ) => ZipAliased ns xs where

459−

460− type family ZipAs

461− (ns :: [Symbol]) (xs :: [k]) = (zs :: [(Symbol,k)]) | zs -> ns xs

462−

463− zipAs

464− :: NP Alias ns

465− -> NP expr xs

466− -> NP (Aliased expr) (ZipAs ns xs)

467−

468−instance ZipAliased '[] '[] where

469− type ZipAs '[] '[] = '[]

470− zipAs Nil Nil = Nil

471−

472−instance

473− ( KnownSymbol n

474− , ZipAliased ns xs

475− ) => ZipAliased (n ': ns) (x ': xs) where

476− type ZipAs (n ': ns) (x ': xs) = '(n,x) ': ZipAs ns xs

477− zipAs (n :* ns) (x :* xs) = x `As` n :* zipAs ns xs

478−

479-- | @HasUnique alias fields field@ is a constraint that proves that

437-- | @HasUnique alias fields field@ is a constraint that proves that

480-- @fields@ is a singleton of @alias ::: field@.

438-- @fields@ is a singleton of @alias ::: field@.

481type HasUnique alias fields field = fields ~ '[alias ::: field]

439type HasUnique alias fields field = fields ~ '[alias ::: field]

@@ -522,21 +480,15 @@ type family Elem x xs where

522-- | @In x xs@ is a constraint that proves that @x@ is in @xs@.

480-- | @In x xs@ is a constraint that proves that @x@ is in @xs@.

523type family In x xs :: Constraint where In x xs = Elem x xs ~ 'True

481type family In x xs :: Constraint where In x xs = Elem x xs ~ 'True

524

482

525−-- | `PGNum` is a constraint on `PGType` whose

483+-- | Numeric Postgres types.

526−-- `Squeal.PostgreSQL.Expression.Expression`s have a `Num` constraint.

527−type PGNum ty =

484+type PGNum =

528− In ty '[ 'PGint2, 'PGint4, 'PGint8, 'PGnumeric, 'PGfloat4, 'PGfloat8]

485+ '[ 'PGint2, 'PGint4, 'PGint8, 'PGnumeric, 'PGfloat4, 'PGfloat8]

529

486

530−-- | `PGFloating` is a constraint on `PGType` whose

487+-- | Floating Postgres types.

531−-- `Squeal.PostgreSQL.Expression.Expression`s

532−-- have `Fractional` and `Floating` constraints.

533−type PGFloating ty = In ty '[ 'PGfloat4, 'PGfloat8, 'PGnumeric]

488+type PGFloating = '[ 'PGfloat4, 'PGfloat8, 'PGnumeric]

534

489

535−-- | `PGIntegral` is a constraint on `PGType` whose

490+-- | Integral Postgres types.

536−-- `Squeal.PostgreSQL.Expression.Expression`s

537−-- have `Squeal.PostgreSQL.Expression.div_` and

538−-- `Squeal.PostgreSQL.Expression.mod_` functions.

539−type PGIntegral ty = In ty '[ 'PGint2, 'PGint4, 'PGint8]

491+type PGIntegral = '[ 'PGint2, 'PGint4, 'PGint8]

540

492

541-- | Error message helper for displaying unavailable\/unknown\/placeholder type

493-- | Error message helper for displaying unavailable\/unknown\/placeholder type

542-- variables whose kind is known.

494-- variables whose kind is known.

@@ -547,40 +499,32 @@ type ErrPGfixarrayOf t = ErrArrayOf ('ShowType 'PGfixarray :<>: 'Text " " :<>: P

547type ErrPGvararrayOf t = ErrArrayOf ('ShowType 'PGvararray) t

499type ErrPGvararrayOf t = ErrArrayOf ('ShowType 'PGvararray) t

548

500

549-- | Ensure a type is a valid array type.

501-- | Ensure a type is a valid array type.

550−type family PGarray name arr :: Constraint where

502+type family PGArray name arr :: Constraint where

551− PGarray name ('PGvararray x) = ()

503+ PGArray name ('PGvararray x) = ()

552− PGarray name ('PGfixarray n x) = ()

504+ PGArray name ('PGfixarray n x) = ()

553− PGarray name val = TypeError

505+ PGArray name val = TypeError

554− ('Text name :<>: 'Text ": Unsatisfied PGarray constraint. Expected either: "

506+ ('Text name :<>: 'Text ": Unsatisfied PGArray constraint. Expected either: "

555 :$$: 'Text " • " :<>: ErrPGvararrayOf (Placeholder PGType)

507 :$$: 'Text " • " :<>: ErrPGvararrayOf (Placeholder PGType)

556 :$$: 'Text " • " :<>: ErrPGfixarrayOf (Placeholder PGType)

508 :$$: 'Text " • " :<>: ErrPGfixarrayOf (Placeholder PGType)

557 :$$: 'Text "But got: " :<>: 'ShowType val)

509 :$$: 'Text "But got: " :<>: 'ShowType val)

558

510

559-- | Ensure a type is a valid array type with a specific element type.

511-- | Ensure a type is a valid array type with a specific element type.

560−type family PGarrayOf name arr ty :: Constraint where

512+type family PGArrayOf name arr ty :: Constraint where

561− PGarrayOf name ('PGvararray x) ty = x ~ ty

513+ PGArrayOf name ('PGvararray x) ty = x ~ ty

562− PGarrayOf name ('PGfixarray n x) ty = x ~ ty

514+ PGArrayOf name ('PGfixarray n x) ty = x ~ ty

563− PGarrayOf name val ty = TypeError

515+ PGArrayOf name val ty = TypeError

564− ( 'Text name :<>: 'Text "Unsatisfied PGarrayOf constraint. Expected either: "

516+ ( 'Text name :<>: 'Text "Unsatisfied PGArrayOf constraint. Expected either: "

565 :$$: 'Text " • " :<>: ErrPGvararrayOf ( 'ShowType ty )

517 :$$: 'Text " • " :<>: ErrPGvararrayOf ( 'ShowType ty )

566 :$$: 'Text " • " :<>: ErrPGfixarrayOf ( 'ShowType ty )

518 :$$: 'Text " • " :<>: ErrPGfixarrayOf ( 'ShowType ty )

567 :$$: 'Text "But got: " :<>: 'ShowType val)

519 :$$: 'Text "But got: " :<>: 'ShowType val)

568

520

569-- | Ensure a type is a valid array type whose elements are text.

521-- | Ensure a type is a valid array type whose elements are text.

570−type PGtextArray name arr = PGarrayOf name arr 'PGtext

522+type PGTextArray name arr = PGArrayOf name arr ('NotNull 'PGtext)

571

523

572-- | `PGTypeOf` forgets about @NULL@ and any column constraints.

524-- | `PGTypeOf` forgets about @NULL@ and any column constraints.

573type family PGTypeOf (ty :: NullityType) :: PGType where

525type family PGTypeOf (ty :: NullityType) :: PGType where

574 PGTypeOf (nullity pg) = pg

526 PGTypeOf (nullity pg) = pg

575

527

576−-- | `SameTypes` is a constraint that proves two `ColumnsType`s have the same

577−-- length and the same `ColumnType`s.

578−type family SameTypes (columns0 :: ColumnsType) (columns1 :: ColumnsType)

579− :: Constraint where

580− SameTypes '[] '[] = ()

581− SameTypes (column0 ::: def0 :=> ty0 ': columns0) (column1 ::: def1 :=> ty1 ': columns1)

582− = (ty0 ~ ty1, SameTypes columns0 columns1)

583−

584-- | Equality constraint on the underlying `PGType` of two columns.

528-- | Equality constraint on the underlying `PGType` of two columns.

585class SamePGType

529class SamePGType

586 (ty0 :: (Symbol,ColumnType)) (ty1 :: (Symbol,ColumnType)) where

530 (ty0 :: (Symbol,ColumnType)) (ty1 :: (Symbol,ColumnType)) where

@@ -599,34 +543,24 @@ type family NotAllNull (columns :: ColumnsType) :: Constraint where

599 NotAllNull (column ::: def :=> 'NotNull ty ': columns) = ()

543 NotAllNull (column ::: def :=> 'NotNull ty ': columns) = ()

600 NotAllNull (column ::: def :=> 'Null ty ': columns) = NotAllNull columns

544 NotAllNull (column ::: def :=> 'Null ty ': columns) = NotAllNull columns

601

545

602−-- | `NullifyType` is an idempotent that nullifies a `ColumnType`.

546+-- | `NullifyType` is an idempotent that nullifies a `NullityType`.

603type family NullifyType (ty :: NullityType) :: NullityType where

547type family NullifyType (ty :: NullityType) :: NullityType where

604 NullifyType ('Null ty) = 'Null ty

548 NullifyType ('Null ty) = 'Null ty

605 NullifyType ('NotNull ty) = 'Null ty

549 NullifyType ('NotNull ty) = 'Null ty

606

550

607−-- | `NullifyRelation` is an idempotent that nullifies a `ColumnsType`.

551+-- | `NullifyRow` is an idempotent that nullifies a `RowType`.

608−type family NullifyRelation (columns :: RelationType) :: RelationType where

552+type family NullifyRow (columns :: RowType) :: RowType where

609− NullifyRelation '[] = '[]

553+ NullifyRow '[] = '[]

610− NullifyRelation (column ::: ty ': columns) =

554+ NullifyRow (column ::: ty ': columns) =

611− column ::: NullifyType ty ': NullifyRelation columns

555+ column ::: NullifyType ty ': NullifyRow columns

612

556

613−-- | `NullifyRelations` is an idempotent that nullifies a `RelationsType`

557+-- | `NullifyFrom` is an idempotent that nullifies a `FromType`

614-- used to nullify the left or right hand side of an outer join

558-- used to nullify the left or right hand side of an outer join

615-- in a `Squeal.PostgreSQL.Query.FromClause`.

559-- in a `Squeal.PostgreSQL.Query.FromClause`.

616−type family NullifyRelations (tables :: RelationsType) :: RelationsType where

560+type family NullifyFrom (tables :: FromType) :: FromType where

617− NullifyRelations '[] = '[]

561+ NullifyFrom '[] = '[]

618− NullifyRelations (table ::: columns ': tables) =

562+ NullifyFrom (table ::: columns ': tables) =

619− table ::: NullifyRelation columns ': NullifyRelations tables

563+ table ::: NullifyRow columns ': NullifyFrom tables

620−

621−-- | `RelationToRowType` drops the nullity constraints of its argument relations.

622−type family RelationToRowType (tables :: RelationType) :: [(Symbol, PGType)] where

623− RelationToRowType (nullity x : xs) = x : RelationToRowType xs

624− RelationToRowType '[] = '[]

625−

626−-- | `RelationToNullityTypes` drops the column constraints.

627−type family RelationToNullityTypes (rel :: RelationType) :: [NullityType] where

628− RelationToNullityTypes ('(k, x) : xs) = x : RelationToNullityTypes xs

629− RelationToNullityTypes '[] = '[]

630

564

631-- | `Join` is simply promoted `++` and is used in @JOIN@s in

565-- | `Join` is simply promoted `++` and is used in @JOIN@s in

632-- `Squeal.PostgreSQL.Query.FromClause`s.

566-- `Squeal.PostgreSQL.Query.FromClause`s.

@@ -659,19 +593,6 @@ type family Alter alias x xs where

659 Alter alias x1 (alias ::: x0 ': xs) = alias ::: x1 ': xs

593 Alter alias x1 (alias ::: x0 ': xs) = alias ::: x1 ': xs

660 Alter alias x1 (x0 ': xs) = x0 ': Alter alias x1 xs

594 Alter alias x1 (x0 ': xs) = x0 ': Alter alias x1 xs

661

595

662−-- type family AddConstraint constraint ty where

663−-- AddConstraint constraint (constraints :=> ty)

664−-- = AsSet (constraint ': constraints) :=> ty

665−

666−-- type family DeleteFromList (e :: elem) (list :: [elem]) where

667−-- DeleteFromList elem '[] = '[]

668−-- DeleteFromList elem (x ': xs) =

669−-- If (Cmp elem x == 'EQ) xs (x ': DeleteFromList elem xs)

670−

671−-- type family DropConstraint constraint ty where

672−-- DropConstraint constraint (constraints :=> ty)

673−-- = (AsSet (DeleteFromList constraint constraints)) :=> ty

674−

675-- | @Rename alias0 alias1 xs@ replaces the alias @alias0@ by @alias1@ in @xs@

596-- | @Rename alias0 alias1 xs@ replaces the alias @alias0@ by @alias1@ in @xs@

676-- and is used in `Squeal.PostgreSQL.Definition.alterTableRename` and

597-- and is used in `Squeal.PostgreSQL.Definition.alterTableRename` and

677-- `Squeal.PostgreSQL.Definition.renameColumn`.

598-- `Squeal.PostgreSQL.Definition.renameColumn`.

@@ -679,26 +600,6 @@ type family Rename alias0 alias1 xs where

679 Rename alias0 alias1 ((alias0 ::: x0) ': xs) = (alias1 ::: x0) ': xs

600 Rename alias0 alias1 ((alias0 ::: x0) ': xs) = (alias1 ::: x0) ': xs

680 Rename alias0 alias1 (x ': xs) = x ': Rename alias0 alias1 xs

601 Rename alias0 alias1 (x ': xs) = x ': Rename alias0 alias1 xs

681

602

682−-- | `MapMaybes` is used in the binary instances of composite types.

683−class MapMaybes xs where

684− type family Maybes (xs :: [Type]) = (mxs :: [Type]) | mxs -> xs

685− maybes :: NP Maybe xs -> NP I (Maybes xs)

686− unMaybes :: NP I (Maybes xs) -> NP Maybe xs

687−instance MapMaybes '[] where

688− type Maybes '[] = '[]

689− maybes Nil = Nil

690− unMaybes Nil = Nil

691−instance MapMaybes xs => MapMaybes (x ': xs) where

692− type Maybes (x ': xs) = Maybe x ': Maybes xs

693− maybes (x :* xs) = I x :* maybes xs

694− unMaybes (I mx :* xs) = mx :* unMaybes xs

695−

696−-- | `Nulls` is used to construct a `Squeal.Postgresql.Expression.row`

697−-- of a composite type.

698−type family Nulls tys where

699− Nulls '[] = '[]

700− Nulls (field ::: ty ': tys) = field ::: 'Null ty ': Nulls tys

701−

702-- | Check if a `TableConstraint` involves a column

603-- | Check if a `TableConstraint` involves a column

703type family ConstraintInvolves column constraint where

604type family ConstraintInvolves column constraint where

704 ConstraintInvolves column ('Check columns) = column `Elem` columns

605 ConstraintInvolves column ('Check columns) = column `Elem` columns

@@ -715,26 +616,47 @@ type family DropIfConstraintsInvolve column constraints where

715 (DropIfConstraintsInvolve column constraints)

616 (DropIfConstraintsInvolve column constraints)

716 (alias ::: constraint ': DropIfConstraintsInvolve column constraints)

617 (alias ::: constraint ': DropIfConstraintsInvolve column constraints)

717

618

619+{- | Calculate the `Length` of a type level list

620+

621+>>> :kind! Length '[Char,String,Bool,Double]

622+Length '[Char,String,Bool,Double] :: Nat

623+= 4

624+-}

625+type family Length (xs :: [k]) :: Nat where

626+ Length (x : xs) = 1 + Length xs

627+ Length '[] = 0

628+

718-- | A `SchemumType` is a user-defined type, either a `Table`,

629-- | A `SchemumType` is a user-defined type, either a `Table`,

719-- `View` or `Typedef`.

630-- `View` or `Typedef`.

720data SchemumType

631data SchemumType

721 = Table TableType

632 = Table TableType

722− | View RelationType

633+ | View RowType

723 | Typedef PGType

634 | Typedef PGType

724

635

725−-- | The schema of a database consists of a list of aliased,

636+{- | The schema of a database consists of a list of aliased,

726−-- user-defined `SchemumType`s.

637+user-defined `SchemumType`s.

638+

639+>>> :{

640+type family Schema :: SchemaType where

641+ Schema =

642+ '[ "users" ::: 'Table (

643+ '[ "pk_users" ::: 'PrimaryKey '["id"] ] :=>

644+ '[ "id" ::: 'Def :=> 'NotNull 'PGint4

645+ , "name" ::: 'NoDef :=> 'NotNull 'PGtext

646+ ])

647+ , "emails" ::: 'Table (

648+ '[ "pk_emails" ::: 'PrimaryKey '["id"]

649+ , "fk_user_id" ::: 'ForeignKey '["user_id"] "users" '["id"]

650+ ] :=>

651+ '[ "id" ::: 'Def :=> 'NotNull 'PGint4

652+ , "user_id" ::: 'NoDef :=> 'NotNull 'PGint4

653+ , "email" ::: 'NoDef :=> 'Null 'PGtext

654+ ])

655+ ]

656+:}

657+-}

727type SchemaType = [(Symbol,SchemumType)]

658type SchemaType = [(Symbol,SchemumType)]

728

659

729−-- | Used in `Squeal.Postgresql.Manipulation.with`.

730−type family With

731− (relations :: RelationsType)

732− (schema :: SchemaType)

733− :: SchemaType where

734− With '[] schema = schema

735− With (alias ::: rel ': rels) schema =

736− alias ::: 'View rel ': With rels schema

737−

738-- | `IsPGlabel` looks very much like the `IsLabel` class. Whereas

660-- | `IsPGlabel` looks very much like the `IsLabel` class. Whereas

739-- the overloaded label, `fromLabel` is used for column references,

661-- the overloaded label, `fromLabel` is used for column references,

740-- `label`s are used for enum terms. A `label` is called with

662-- `label`s are used for enum terms. A `label` is called with

@@ -749,104 +671,165 @@ data PGlabel (label :: Symbol) = PGlabel

749-- | Renders a label

671-- | Renders a label

750renderLabel :: KnownSymbol label => proxy label -> ByteString

672renderLabel :: KnownSymbol label => proxy label -> ByteString

751renderLabel (_ :: proxy label) =

673renderLabel (_ :: proxy label) =

752− "\'" <> fromString (symbolVal (Proxy @label)) <> "\'"

674+ "\'" <> renderSymbol @label <> "\'"

753-- | Renders a list of labels

675-- | Renders a list of labels

754renderLabels

676renderLabels

755 :: All KnownSymbol labels => NP PGlabel labels -> [ByteString]

677 :: All KnownSymbol labels => NP PGlabel labels -> [ByteString]

756renderLabels = hcollapse

678renderLabels = hcollapse

757 . hcmap (Proxy @KnownSymbol) (K . renderLabel)

679 . hcmap (Proxy @KnownSymbol) (K . renderLabel)

758

680

759−-- | The `PG` type family embeds a subset of Haskell types

681+{- | The `PG` type family embeds a subset of Haskell types

760−-- as Postgres basic types.

682+as Postgres types. As an open type family, `PG` is extensible.

761−--

683+

762−-- >>> :kind! PG LocalTime

684+>>> :kind! PG LocalTime

763−-- PG LocalTime :: PGType

685+PG LocalTime :: PGType

764−-- = 'PGtimestamp

686+= 'PGtimestamp

687+

688+>>> newtype MyDouble = My Double

689+>>> type instance PG MyDouble = 'PGfloat8

690+-}

765−type family PG (hask :: Type) :: PGType where

691+type family PG (hask :: Type) :: PGType

766− PG Bool = 'PGbool

692+type instance PG Bool = 'PGbool

767− PG Int16 = 'PGint2

693+type instance PG Int16 = 'PGint2

768− PG Int32 = 'PGint4

694+type instance PG Int32 = 'PGint4

769− PG Int64 = 'PGint8

695+type instance PG Int64 = 'PGint8

770− PG Word16 = 'PGint2

696+type instance PG Word16 = 'PGint2

771− PG Word32 = 'PGint4

697+type instance PG Word32 = 'PGint4

772− PG Word64 = 'PGint8

698+type instance PG Word64 = 'PGint8

773− PG Scientific = 'PGnumeric

699+type instance PG Scientific = 'PGnumeric

774− PG Float = 'PGfloat4

700+type instance PG Float = 'PGfloat4

775− PG Double = 'PGfloat8

701+type instance PG Double = 'PGfloat8

776− PG Char = 'PGchar 1

702+type instance PG Char = 'PGchar 1

777− PG Text = 'PGtext

703+type instance PG Text = 'PGtext

778− PG Lazy.Text = 'PGtext

704+type instance PG Lazy.Text = 'PGtext

705+type instance PG String = 'PGtext

779− PG ByteString = 'PGbytea

706+type instance PG ByteString = 'PGbytea

780− PG Lazy.ByteString = 'PGbytea

707+type instance PG Lazy.ByteString = 'PGbytea

781− PG LocalTime = 'PGtimestamp

708+type instance PG LocalTime = 'PGtimestamp

782− PG UTCTime = 'PGtimestamptz

709+type instance PG UTCTime = 'PGtimestamptz

783− PG Day = 'PGdate

710+type instance PG Day = 'PGdate

784− PG TimeOfDay = 'PGtime

711+type instance PG TimeOfDay = 'PGtime

785− PG (TimeOfDay, TimeZone) = 'PGtimetz

712+type instance PG (TimeOfDay, TimeZone) = 'PGtimetz

786− PG DiffTime = 'PGinterval

713+type instance PG DiffTime = 'PGinterval

787− PG UUID = 'PGuuid

714+type instance PG UUID = 'PGuuid

788− PG (NetAddr IP) = 'PGinet

715+type instance PG (NetAddr IP) = 'PGinet

789− PG Value = 'PGjson

716+type instance PG Value = 'PGjson

790− PG ty = TypeError

717+type instance PG (Json hask) = 'PGjson

791− ('Text "There is no Postgres basic type for " ':<>: 'ShowType ty)

718+type instance PG (Jsonb hask) = 'PGjsonb

792−

719+type instance PG (Vector hask) = 'PGvararray (NullPG hask)

793−-- | The `EnumFrom` type family embeds Haskell enum types, ADTs with

720+type instance PG (hask, hask) = 'PGfixarray 2 (NullPG hask)

794−-- nullary constructors, as Postgres enum types

721+type instance PG (hask, hask, hask) = 'PGfixarray 3 (NullPG hask)

795−--

722+type instance PG (hask, hask, hask, hask) = 'PGfixarray 4 (NullPG hask)

796−-- >>> data Schwarma = Beef | Lamb | Chicken deriving GHC.Generic

723+type instance PG (hask, hask, hask, hask, hask) = 'PGfixarray 5 (NullPG hask)

797−-- >>> instance Generic Schwarma

724+type instance PG (hask, hask, hask, hask, hask, hask)

798−-- >>> instance HasDatatypeInfo Schwarma

725+ = 'PGfixarray 6 (NullPG hask)

799−-- >>> :kind! EnumFrom Schwarma

726+type instance PG (hask, hask, hask, hask, hask, hask, hask)

800−-- EnumFrom Schwarma :: PGType

727+ = 'PGfixarray 7 (NullPG hask)

801−-- = 'PGenum '["Beef", "Lamb", "Chicken"]

728+type instance PG (hask, hask, hask, hask, hask, hask, hask, hask)

802−type family EnumFrom (hask :: Type) :: PGType where

729+ = 'PGfixarray 8 (NullPG hask)

803− EnumFrom hask = 'PGenum (LabelsFrom hask)

730+type instance PG (hask, hask, hask, hask, hask, hask, hask, hask, hask)

804−

731+ = 'PGfixarray 9 (NullPG hask)

732+type instance PG (hask, hask, hask, hask, hask, hask, hask, hask, hask, hask)

733+ = 'PGfixarray 10 (NullPG hask)

734+type instance PG (Composite hask) = 'PGcomposite (RowPG hask)

735+type instance PG (Enumerated hask) = 'PGenum (LabelsPG hask)

736+

737+{- | The `Json` newtype is an indication that the Haskell

738+type it's applied to should be stored as `PGjson`.

739+-}

740+newtype Json hask = Json {getJson :: hask}

741+ deriving (Eq, Ord, Show, Read, GHC.Generic)

742+

743+{- | The `Jsonb` newtype is an indication that the Haskell

744+type it's applied to should be stored as `PGjsonb`.

745+-}

746+newtype Jsonb hask = Jsonb {getJsonb :: hask}

747+ deriving (Eq, Ord, Show, Read, GHC.Generic)

748+

749+{- | The `Composite` newtype is an indication that the Haskell

750+type it's applied to should be stored as a `PGcomposite`.

751+-}

752+newtype Composite record = Composite {getComposite :: record}

753+ deriving (Eq, Ord, Show, Read, GHC.Generic)

754+

755+{- | The `Enumerated` newtype is an indication that the Haskell

756+type it's applied to should be stored as `PGenum`.

757+-}

758+newtype Enumerated enum = Enumerated {getEnumerated :: enum}

759+ deriving (Eq, Ord, Show, Read, GHC.Generic)

760+

805−-- | The `LabelsFrom` type family calculates the constructors of a

761+{-| The `LabelsPG` type family calculates the constructors of a

806−-- Haskell enum type.

762+Haskell enum type.

807−--

763+

808−-- >>> data Schwarma = Beef | Lamb | Chicken deriving GHC.Generic

764+>>> data Schwarma = Beef | Lamb | Chicken deriving GHC.Generic

809−-- >>> instance Generic Schwarma

765+>>> instance Generic Schwarma

810−-- >>> instance HasDatatypeInfo Schwarma

766+>>> instance HasDatatypeInfo Schwarma

811−-- >>> :kind! LabelsFrom Schwarma

767+>>> :kind! LabelsPG Schwarma

812−-- LabelsFrom Schwarma :: [Type.ConstructorName]

768+LabelsPG Schwarma :: [Type.ConstructorName]

813−-- = '["Beef", "Lamb", "Chicken"]

769+= '["Beef", "Lamb", "Chicken"]

770+-}

814−type family LabelsFrom (hask :: Type) :: [Type.ConstructorName] where

771+type family LabelsPG (hask :: Type) :: [Type.ConstructorName] where

815− LabelsFrom hask =

772+ LabelsPG hask =

816 ConstructorNamesOf (ConstructorsOf (DatatypeInfoOf hask))

773 ConstructorNamesOf (ConstructorsOf (DatatypeInfoOf hask))

817

774

818−-- | The `CompositeFrom` type family embeds Haskell record types as

775+{- | `RowPG` turns a Haskell record type into a `RowType`.

819−-- Postgres composite types, as long as the record fields

776+

820−-- are `Maybe`s of Haskell types that can be embedded as basic types

821−-- with the `PG` type family.

822−--

823−-- >>> data Row = Row { a :: Maybe Int16, b :: Maybe LocalTime } deriving GHC.Generic

777+>>> data Person = Person { name :: Text, age :: Int32 } deriving GHC.Generic

824−-- >>> instance Generic Row

778+>>> instance Generic Person

825−-- >>> instance HasDatatypeInfo Row

779+>>> instance HasDatatypeInfo Person

826−-- >>> :kind! CompositeFrom Row

780+>>> :kind! RowPG Person

827−-- CompositeFrom Row :: PGType

781+RowPG Person :: [(Symbol, NullityType)]

828−-- = 'PGcomposite '['("a", 'PGint2), '("b", 'PGtimestamp)]

782+= '["name" ::: 'NotNull 'PGtext, "age" ::: 'NotNull 'PGint4]

829−type family CompositeFrom (hask :: Type) :: PGType where

783+-}

830− CompositeFrom hask =

831− 'PGcomposite (ZipAs (FieldNamesFrom hask) (FieldTypesFrom hask))

832−

833−-- | >>> data Row = Row { a :: Maybe Int16, b :: Maybe LocalTime } deriving GHC.Generic

834−-- >>> instance Generic Row

835−-- >>> instance HasDatatypeInfo Row

836−-- >>> :kind! FieldNamesFrom Row

837−-- FieldNamesFrom Row :: [Type.FieldName]

838−-- = '["a", "b"]

839−type family FieldNamesFrom (hask :: Type) :: [Type.FieldName] where

840− FieldNamesFrom hask = FieldNamesOf (FieldsOf (DatatypeInfoOf hask))

841−

842−-- | >>> data Row = Row { a :: Maybe Int16, b :: Maybe LocalTime } deriving GHC.Generic

843−-- >>> instance Generic Row

844−-- >>> instance HasDatatypeInfo Row

845−-- >>> :kind! FieldTypesFrom Row

846−-- FieldTypesFrom Row :: [PGType]

847−-- = '['PGint2, 'PGtimestamp]

848−type family FieldTypesFrom (hask :: Type) :: [PGType] where

784+type family RowPG (hask :: Type) :: RowType where

849− FieldTypesFrom hask = FieldTypesOf (RecordCodeOf hask (Code hask))

785+ RowPG hask = RowOf (RecordCodeOf hask)

786+

787+type family RowOf (fields :: [(Symbol, Type)]) :: RowType where

788+ RowOf '[] = '[]

789+ RowOf (field ': fields) = FieldPG field ': RowOf fields

790+

791+type family FieldPG (field :: (Symbol, Type)) :: (Symbol, NullityType) where

792+ FieldPG (field ::: hask) = field ::: NullPG hask

793+

794+{- | `NullPG` turns a Haskell type into a `NullityType`.

795+

796+>>> :kind! NullPG Double

797+NullPG Double :: NullityType

798+= 'NotNull 'PGfloat8

799+>>> :kind! NullPG (Maybe Double)

800+NullPG (Maybe Double) :: NullityType

801+= 'Null 'PGfloat8

802+-}

803+type family NullPG (hask :: Type) :: NullityType where

804+ NullPG (Maybe hask) = 'Null (PG hask)

805+ NullPG hask = 'NotNull (PG hask)

806+

807+{- | `TuplePG` turns a Haskell tuple type (including record types) into

808+the corresponding list of `NullityType`s.

809+

810+>>> :kind! TuplePG (Double, Maybe Char)

811+TuplePG (Double, Maybe Char) :: [NullityType]

812+= '['NotNull 'PGfloat8, 'Null ('PGchar 1)]

813+-}

814+type family TuplePG (hask :: Type) :: [NullityType] where

815+ TuplePG hask = TupleOf (TupleCodeOf hask (Code hask))

816+

817+type family TupleOf (tuple :: [Type]) :: [NullityType] where

818+ TupleOf '[] = '[]

819+ TupleOf (hask ': tuple) = NullPG hask ': TupleOf tuple

820+

821+type family TupleCodeOf (hask :: Type) (code :: [[Type]]) :: [Type] where

822+ TupleCodeOf hask '[tuple] = tuple

823+ TupleCodeOf hask '[] =

824+ TypeError

825+ ( 'Text "The type `" :<>: 'ShowType hask :<>: 'Text "' is not a tuple type."

826+ :$$: 'Text "It is a void type with no constructors."

827+ )

828+ TupleCodeOf hask (_ ': _ ': _) =

829+ TypeError

830+ ( 'Text "The type `" :<>: 'ShowType hask :<>: 'Text "' is not a tuple type."

831+ :$$: 'Text "It is a sum type with more than one constructor."

832+ )

850

833

851-- | Calculates constructors of a datatype.

834-- | Calculates constructors of a datatype.

852type family ConstructorsOf (datatype :: Type.DatatypeInfo)

835type family ConstructorsOf (datatype :: Type.DatatypeInfo)

@@ -875,47 +858,23 @@ type family ConstructorNamesOf (constructors :: [Type.ConstructorInfo])

875 ConstructorNamesOf (constructor ': constructors) =

858 ConstructorNamesOf (constructor ': constructors) =

876 ConstructorNameOf constructor ': ConstructorNamesOf constructors

859 ConstructorNameOf constructor ': ConstructorNamesOf constructors

877

860

878−-- | Calculate the fields of a datatype.

879−type family FieldsOf (datatype :: Type.DatatypeInfo)

880− :: [Type.FieldInfo] where

881− FieldsOf ('Type.ADT _module _datatype '[ 'Type.Record _name fields]) =

882− fields

883− FieldsOf ('Type.Newtype _module _datatype ('Type.Record _name fields)) =

884− fields

885−

886−-- | Calculate the name of a field.

887−type family FieldNameOf (field :: Type.FieldInfo) :: Type.FieldName where

888− FieldNameOf ('Type.FieldInfo name) = name

889−

890−-- | Calculate the names of fields.

891−type family FieldNamesOf (fields :: [Type.FieldInfo])

892− :: [Type.FieldName] where

893− FieldNamesOf '[] = '[]

894− FieldNamesOf (field ': fields) = FieldNameOf field ': FieldNamesOf fields

895−

896−-- | >>> :kind! FieldTypeOf (Maybe Int16)

897−-- FieldTypeOf (Maybe Int16) :: PGType

898−-- = 'PGint2

899−type family FieldTypeOf (maybe :: Type) where

900− FieldTypeOf (Maybe hask) = PG hask

901− FieldTypeOf ty = TypeError

902− ('Text "FieldTypeOf error: non-Maybe type " ':<>: 'ShowType ty)

903−

904−-- | Calculate the types of fields.

905−type family FieldTypesOf (fields :: [Type]) where

906− FieldTypesOf '[] = '[]

907− FieldTypesOf (field ': fields) = FieldTypeOf field ': FieldTypesOf fields

908−

909−-- | Inspect the code of an algebraic datatype and ensure it's a product,

910−-- otherwise generate a type error

911−type family RecordCodeOf (hask :: Type) (code ::[[Type]]) :: [Type] where

912− RecordCodeOf _hask '[tys] = tys

913− RecordCodeOf hask _tys = TypeError

914− ('Text "RecordCodeOf error: non-Record type " ':<>: 'ShowType hask)

915−

916-- | Is a type a valid JSON key?

861-- | Is a type a valid JSON key?

917−type PGjsonKey key = key `In` '[ 'PGint2, 'PGint4, 'PGtext ]

862+type PGJsonKey = '[ 'PGint2, 'PGint4, 'PGtext ]

918

863

919-- | Is a type a valid JSON type?

864-- | Is a type a valid JSON type?

920−type PGjson_ json = json `In` '[ 'PGjson, 'PGjsonb ]

865+type PGJsonType = '[ 'PGjson, 'PGjsonb ]

921−

866+

867+-- | An `AlignedList` is a type-aligned list or free category.

868+data AlignedList p x0 x1 where

869+ Done :: AlignedList p x x

870+ (:>>) :: p x0 x1 -> AlignedList p x1 x2 -> AlignedList p x0 x2

871+infixr 7 :>>

872+instance Category (AlignedList p) where

873+ id = Done

874+ (.) list = \case

875+ Done -> list

876+ step :>> steps -> step :>> (steps >>> list)

877+

878+-- | A `single` step.

879+single :: p x0 x1 -> AlignedList p x0 x1

880+single step = step :>> Done

squeal-postgresql/src/Squeal/PostgreSQL/Transaction.hs+6−5

@@ -9,9 +9,11 @@ Squeal transaction control language.

9-}

11{-# LANGUAGE

12+ DataKinds

12− FlexibleContexts

13+ , FlexibleContexts

13 , LambdaCase

14 , LambdaCase

14 , OverloadedStrings

15 , OverloadedStrings

16+ , TypeInType

15#-}

17#-}

17module Squeal.PostgreSQL.Transaction

19module Squeal.PostgreSQL.Transaction

@@ -39,7 +41,6 @@ import Control.Exception.Lifted

39import Control.Monad.Base

41import Control.Monad.Base

40import Control.Monad.Trans.Control

42import Control.Monad.Trans.Control

41import Data.ByteString

43import Data.ByteString

42−import Data.Monoid

43import Generics.SOP

44import Generics.SOP

45import qualified Database.PostgreSQL.LibPQ as LibPQ

46import qualified Database.PostgreSQL.LibPQ as LibPQ

@@ -69,16 +70,16 @@ transactionally_

69transactionally_ = transactionally defaultMode

70transactionally_ = transactionally defaultMode

71-- | @BEGIN@ a transaction.

72-- | @BEGIN@ a transaction.

72−begin :: MonadPQ schema tx => TransactionMode -> tx (K Result NilRelation)

73+begin :: MonadPQ schema tx => TransactionMode -> tx (K Result ('[] :: RowType))

73begin mode = manipulate . UnsafeManipulation $

74begin mode = manipulate . UnsafeManipulation $

74 "BEGIN" <+> renderTransactionMode mode <> ";"

75 "BEGIN" <+> renderTransactionMode mode <> ";"

76-- | @COMMIT@ a schema invariant transaction.

77-- | @COMMIT@ a schema invariant transaction.

77−commit :: MonadPQ schema tx => tx (K Result NilRelation)

78+commit :: MonadPQ schema tx => tx (K Result ('[] :: RowType))

78commit = manipulate $ UnsafeManipulation "COMMIT;"

79commit = manipulate $ UnsafeManipulation "COMMIT;"

80-- | @ROLLBACK@ a schema invariant transaction.

81-- | @ROLLBACK@ a schema invariant transaction.

81−rollback :: MonadPQ schema tx => tx (K Result NilRelation)

82+rollback :: MonadPQ schema tx => tx (K Result ('[] :: RowType))

82rollback = manipulate $ UnsafeManipulation "ROLLBACK;"

83rollback = manipulate $ UnsafeManipulation "ROLLBACK;"

84-- | Run a schema changing computation `transactionallySchema`.

85-- | Run a schema changing computation `transactionallySchema`.

squeal-postgresql/test/Specs/ExceptionHandling.hsnew file+121

@@ -0,0 +1,121 @@

1+{-# LANGUAGE DataKinds #-}

2+{-# LANGUAGE DeriveGeneric #-}

3+{-# LANGUAGE DuplicateRecordFields #-}

4+{-# LANGUAGE FlexibleContexts #-}

5+{-# LANGUAGE OverloadedLabels #-}

6+{-# LANGUAGE OverloadedLists #-}

7+{-# LANGUAGE OverloadedStrings #-}

8+{-# LANGUAGE TypeApplications #-}

9+{-# LANGUAGE TypeFamilies #-}

10+{-# LANGUAGE TypeOperators #-}

11+module ExceptionHandling

12+ ( specs

13+ , User (..)

14+ )

15+where

16+

17+import Control.Monad (void)

18+import Control.Monad.Base (MonadBase)

19+import qualified Data.ByteString.Char8 as Char8

20+import Data.Int (Int16)

21+import Data.Text (Text)

22+import Data.Vector (Vector)

23+import qualified Generics.SOP as SOP

24+import qualified GHC.Generics as GHC

25+import Squeal.PostgreSQL

26+import Squeal.PostgreSQL.Migration

27+import Test.Hspec

28+

29+type Schema =

30+ '[ "users" ::: 'Table (

31+ '[ "pk_users" ::: 'PrimaryKey '["id"]

32+ , "unique_names" ::: 'Unique '["name"]

33+ ] :=>

34+ '[ "id" ::: 'Def :=> 'NotNull 'PGint4

35+ , "name" ::: 'NoDef :=> 'NotNull 'PGtext

36+ , "vec" ::: 'NoDef :=> 'NotNull ('PGvararray ('Null 'PGint2))

37+ ])

38+ , "emails" ::: 'Table (

39+ '[ "pk_emails" ::: 'PrimaryKey '["id"]

40+ , "fk_user_id" ::: 'ForeignKey '["user_id"] "users" '["id"]

41+ ] :=>

42+ '[ "id" ::: 'Def :=> 'NotNull 'PGint4

43+ , "user_id" ::: 'NoDef :=> 'NotNull 'PGint4

44+ , "email" ::: 'NoDef :=> 'Null 'PGtext

45+ ])

46+ ]

47+

48+data User =

49+ User { userName :: Text

50+ , userEmail :: Maybe Text

51+ , userVec :: Vector (Maybe Int16) }

52+ deriving (Show, GHC.Generic)

53+instance SOP.Generic User

54+instance SOP.HasDatatypeInfo User

55+

56+insertUser :: Manipulation Schema '[ 'NotNull 'PGtext, 'NotNull ('PGvararray ('Null 'PGint2))]

57+ '[ "fromOnly" ::: 'NotNull 'PGint4 ]

58+insertUser = insertRows #users

59+ (Default `as` #id :* Set (param @1) `as` #name :* Set (param @2) `as` #vec) []

60+ OnConflictDoRaise (Returning (#id `as` #fromOnly))

61+

62+setup :: Definition '[] Schema

63+setup =

64+ createTable #users

65+ ( serial `as` #id :*

66+ (text & notNullable) `as` #name :*

67+ (vararray int2 & notNullable) `as` #vec )

68+ ( primaryKey #id `as` #pk_users

69+ :* unique #name `as` #unique_names )

70+ >>>

71+ createTable #emails

72+ ( serial `as` #id :*

73+ (int & notNullable) `as` #user_id :*

74+ (text & nullable) `as` #email )

75+ ( primaryKey #id `as` #pk_emails :*

76+ foreignKey #user_id #users #id

77+ OnDeleteCascade OnUpdateCascade `as` #fk_user_id )

78+

79+teardown :: Definition Schema '[]

80+teardown = dropTable #emails >>> dropTable #users

81+

82+migration :: Migration IO '[] Schema

83+migration = Migration { name = "test"

84+ , up = void $ define setup

85+ , down = void $ define teardown }

86+

87+setupDB :: IO ()

88+setupDB = void . withConnection connectionString $

89+ migrateUp $ single migration

90+

91+dropDB :: IO ()

92+dropDB = void . withConnection connectionString $

93+ migrateDown $ single migration

94+

95+connectionString :: Char8.ByteString

96+connectionString = "host=localhost port=5432 dbname=exampledb"

97+

98+testUser :: User

99+testUser = User "TestUser" Nothing []

100+

101+newUser :: (MonadBase IO m, MonadPQ Schema m) => User -> m ()

102+newUser u = void $ manipulateParams insertUser (userName u, userVec u)

103+

104+insertUserTwice :: (MonadBase IO m, MonadPQ Schema m) => m ()

105+insertUserTwice = newUser testUser >> newUser testUser

106+

107+specs :: SpecWith ()

108+specs = before_ setupDB $ after_ dropDB $

109+ describe "Exceptions" $ do

110+

111+ let

112+ dupKeyErr = PQException FatalError (Just "23505")

113+ (Just "ERROR: duplicate key value violates unique constraint \"unique_names\"\nDETAIL: Key (name)=(TestUser) already exists.\n")

114+

115+ it "should be thrown for unique constraint violation in a manipulation" $

116+ withConnection connectionString insertUserTwice

117+ `shouldThrow` (== dupKeyErr)

118+

119+ it "should be rethrown for unique constraint violation in a manipulation by a transaction" $

120+ withConnection connectionString (transactionally_ insertUserTwice)

121+ `shouldThrow` (== dupKeyErr)

squeal-postgresql/test/Specs/Specs.hsnew file+7

@@ -0,0 +1,7 @@

1+module Specs where

3+import Test.Hspec

4+import qualified ExceptionHandling

6+main :: IO ()

7+main = hspec ExceptionHandling.specs

stack.yaml+1−1

@@ -1,3 +1,3 @@

1−resolver: lts-11.15

1+resolver: nightly-2018-09-03

2packages:

3- squeal-postgresql