99bbfbe · squeal · git.iko.soy

git.iko.soy/squeal

Merge pull request #42 from morphismtech/0.4

0.4

commit99bbfbe670bd9416f59eea63662b6d82cd2991d5 authorEitan Chatav <eitan.chatav@gmail.com> dateThu 6 Sep 2018, 17:19 (8 years ago) parent9ef61cc 3b61eb5

18 files changed+2559−1471

compare with dev

unifiedsplit

.circleci/config.yml+1−1

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

22jobs:

33 build:

44 docker:

5− - image: haskell:8.2.2

5+ - image: haskell:8.4.3

66 - image: circleci/postgres:latest

77 environment:

88 POSTGRES_DB: exampledb

README.md+18−17

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

4545* connection pools

4646* transactions

4747* views

48−* composite and enumerated types

48+* array, composite and enumerated types

49+* json operations

4950

5051## installation

5152

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

133134 setup :: Definition '[] Schema

134135 setup =

135136 createTable #users

136− ( serial `As` #id :*

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

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

137+ ( serial `as` #id :*

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

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

139140 createTable #emails

140− ( serial `As` #id :*

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

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

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

141+ ( serial `as` #id :*

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

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

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

144145 foreignKey #user_id #users #id

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

146+ OnDeleteCascade OnUpdateCascade `as` #fk_user_id )

146147:}

147148```

148149

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

187188let

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

189190 insertUser = insertRow #users

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

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

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

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

192193:}

193194

194195>>> :{

195196let

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

197198 insertEmail = insertRow #emails

198− ( Default `As` #id :*

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

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

199+ ( Default `as` #id :*

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

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

201202 OnConflictDoNothing (Returning Nil)

202203:}

203204

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

219220 '[ "userName" ::: 'NotNull 'PGtext

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

221222 getUsers = select

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

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

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

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

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

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

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

226227:}

227228

RELEASE NOTES.md+418

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

11## 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+

3421### Version 0.3.2 - August 4, 2018

4422

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

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

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

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

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

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

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

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

3333 ])

3434 , "emails" ::: 'Table (

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

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

6060teardown :: Definition Schema '[]

6161teardown = dropTable #emails >>> dropTable #users

6262

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

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

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

6565insertUser = insertRows #users

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

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

7676getUsers :: Query Schema '[]

7777 '[ "userName" ::: 'NotNull 'PGtext

7878 , "userEmail" ::: 'Null 'PGtext

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

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

8080getUsers = select

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

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

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

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

11name: squeal-postgresql

2−version: 0.3.2.0

2+version: 0.4.0.0

33synopsis: Squeal PostgreSQL Library

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

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

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

3737 ghc-options: -Wall

3838 build-depends:

3939 aeson >= 1.2.4.0

40− , base >= 4.10.1.0 && < 5.0

40+ , base >= 4.11.1.0 && < 5.0

4141 , binary-parser >= 0.5.5

4242 , bytestring >= 0.10.8.2

4343 , bytestring-strict-builder >= 0.4.5

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

5050 , network-ip >= 0.3.0.2

5151 , postgresql-binary >= 0.12.1

5252 , postgresql-libpq >= 0.9.4.1

53− , profunctors >= 5.2.2

53+ , records-sop >= 0.1.0.0

5454 , resource-pool >= 0.2.3.2

5555 , scientific >= 0.3.5.3

5656 , text >= 1.2.3.0

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

7070 base >= 4.10.0.0

7171 , doctest >= 0.11.4

7272

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+

7391executable squeal-postgresql-example

7492 default-language: Haskell2010

7593 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

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

1212to encode Haskell values into statement parameters.

1313

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

15+

1416>>> import Data.Int (Int16)

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

2118>>> import Control.Monad (void)

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

2320>>> import Squeal.PostgreSQL

2421

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

2528>>> :{

2629let

27− query :: Query '[]

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

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

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

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

31+ roundTrip = values_ $

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

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

34+ parameter @3 bool `as` #col3

3135:}

3236

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+

3369>>> :{

3470let

35− roundtrip :: IO ()

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

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

38− Just row <- firstRow result

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

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

72+ roundTrip = values_ $

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

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

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

4076:}

4177

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+:}

4386True

4487

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−

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

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

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

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

5392

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

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

5594>>> instance Generic Schwarma

5695>>> instance HasDatatypeInfo Schwarma

5796

5897A 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

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.

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

6299

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)

64101>>> instance Generic Person

65102>>> instance HasDatatypeInfo Person

103+>>> instance Aeson.FromJSON Person

104+>>> instance Aeson.ToJSON Person

66105

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

68107

69108>>> :{

70109type Schema =

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

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

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

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

73112 ]

74113:}

75114

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

81120 createTypeCompositeFrom @Person #person

82121:}

83122

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+:}

85134

135+>>> instance Generic Row

136+>>> instance HasDatatypeInfo Row

86137>>> :{

87138let

88− querySchwarma :: Query Schema

89− '[ 'NotNull (EnumFrom Schwarma)]

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

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

139+ input = Row

140+ (Enumerated Chicken)

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

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

92143:}

93144

145+Once again, define a round trip query.

146+

94147>>> :{

95148let

96− queryPerson :: Query Schema

97− '[ 'NotNull (CompositeFrom Person)]

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

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

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

150+ roundTrip = values_ $

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

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

153+ parameter @3 json `as` #person2

100154:}

101155

102−And finally drop the types.

156+Finally, we can drop our type definitions.

103157

104158>>> :{

105159let

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

112166>>> :{

113167let

114168 session = do

115− result1 <- runQueryParams querySchwarma (Only Chicken)

116− Just (Only schwarma) <- firstRow result1

117− liftBase $ print (schwarma :: Schwarma)

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

119− Just (Only person) <- firstRow result2

120− liftBase $ print (person :: Person)

169+ result <- runQueryParams roundTrip input

170+ Just output <- firstRow result

171+ liftBase . print $ input == output

121172in

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

123174 define setup

124175 & pqThen session

125176 & pqThen (define teardown)

126177:}

127−Chicken

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

178+True

129179-}

130180

131181{-# LANGUAGE

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

134184 , DeriveFunctor

135185 , DeriveGeneric

136186 , DeriveTraversable

187+ , DefaultSignatures

137188 , FlexibleContexts

138189 , FlexibleInstances

190+ , FunctionalDependencies

139191 , GADTs

140192 , LambdaCase

193+ , OverloadedStrings

141194 , MultiParamTypeClasses

142195 , ScopedTypeVariables

143196 , TypeApplications

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

149202module Squeal.PostgreSQL.Binary

150203 ( -- * Encoding

151204 ToParam (..)

152− , ToColumnParam (..)

153205 , ToParams (..)

154206 -- * Decoding

155207 , FromValue (..)

156− , FromColumnValue (..)

157208 , FromRow (..)

158209 -- * Only

159210 , Only (..)

160211 ) where

161212

162213import BinaryParser

163−import ByteString.StrictBuilder

164−import Data.Aeson hiding (Null)

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

215+import Control.Arrow (left)

216+import Control.Monad

165217import Data.Int

166218import Data.Kind

167−import Data.Monoid hiding (All)

168219import Data.Scientific

169220import Data.Time

170221import Data.UUID.Types

171222import Data.Vector (Vector)

172223import Data.Word

173224import Generics.SOP

225+import Generics.SOP.Record

174226import GHC.TypeLits

175227import Network.IP.Addr

176228

177−import qualified Data.ByteString.Lazy as Lazy

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

179−import qualified Data.Text.Lazy as Lazy

180−import qualified Data.Text as Strict

229+import qualified Data.Aeson as Aeson

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

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

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

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

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

235+import qualified Data.Text as Strict.Text

181236import qualified Data.Vector as Vector

182237import qualified GHC.Generics as GHC

183238import qualified PostgreSQL.Binary.Decoding as Decoding

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

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

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

221276instance 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

222279instance ToParam Strict.ByteString 'PGbytea where

223280 toParam = K . Encoding.bytea_strict

224281instance ToParam Lazy.ByteString 'PGbytea where

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

232289instance ToParam UTCTime 'PGtimestamptz where

233290 toParam = K . Encoding.timestamptz_int

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

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

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

237−instance (HasOid pg, ToParam x pg)

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

239− toParam = K . Encoding.nullableArray_vector

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

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

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

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

295+ toParam = K . Encoding.json_bytes

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

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

241310instance

242311 ( IsEnumType x

243312 , HasDatatypeInfo x

244− , LabelsFrom x ~ labels

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

313+ , LabelsPG x ~ labels

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

246315 toParam =

247316 let

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

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

253322 gshowConstructor constructors (SOP xs)

254323 in

255324 K . Encoding.text_strict

256− . Strict.pack

325+ . Strict.Text.pack

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

258327 . from

328+ . getEnumerated

259329instance

260330 ( SListI fields

261− , MapMaybes xs

262− , IsProductType x (Maybes xs)

263− , AllZip ToAliasedParam xs fields

264− , FieldNamesFrom x ~ AliasesOf fields

331+ , IsRecord x xs

332+ , AllZip ToField xs fields

265333 , All HasAliasedOid fields

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

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

267335 toParam =

268336 let

269337

270− encoders = htrans (Proxy @ToAliasedParam) toAliasedParam

338+ encoders = htrans (Proxy @ToField) toField

271339

272340 composite

273341 :: All HasAliasedOid row

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

301369 hcfoldMap (Proxy @HasAliasedOid) each fields

302370

303371 in

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

305−

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

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

308−

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

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

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

312− toAliasedParam = \case

313− Nothing -> K Nothing

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

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

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

322− --

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

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

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

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

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

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

372+ composite . encoders . toRecord . getComposite

373+

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

375+ aliasedOid :: Word32

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

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+

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

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

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

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

390+

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

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

393+ baseOid :: Word32

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

395+ baseOid = oid @(PGTypeOf array)

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

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

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

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

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

401+ toArray = K . maybe Encoding.nullArray

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

333431

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

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

345443 -- >>> instance Generic Tuple

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

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

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

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

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

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

350448 => ToParams x tys where

351449 toParams

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

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

353451 . unZ . unSOP . from

354452

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

458+ fromValue :: Decoding.Value y

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

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

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

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

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

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

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

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

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

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

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

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

373473instance FromValue 'PGbytea Strict.ByteString where

374− fromValue _ = Decoding.bytea_strict

474+ fromValue = Decoding.bytea_strict

375475instance FromValue 'PGbytea Lazy.ByteString where

376− fromValue _ = Decoding.bytea_lazy

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

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

476+ fromValue = Decoding.bytea_lazy

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

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

379479instance FromValue 'PGtimetz (TimeOfDay, TimeZone) where

380− fromValue _ = Decoding.timetz_int

480+ fromValue = Decoding.timetz_int

381481instance FromValue 'PGtimestamp LocalTime where

382− fromValue _ = Decoding.timestamp_int

482+ fromValue = Decoding.timestamp_int

383483instance FromValue 'PGtimestamptz UTCTime where

384− fromValue _ = Decoding.timestamptz_int

484+ fromValue = Decoding.timestamptz_int

385485instance FromValue 'PGinterval DiffTime where

386− fromValue _ = Decoding.interval_int

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

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

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

390− fromValue _ = Decoding.array

391− (Decoding.dimensionArray Vector.replicateM

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

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

394− fromValue _ = Decoding.array

395− (Decoding.dimensionArray Vector.replicateM

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

486+ fromValue = Decoding.interval_int

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

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

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

493+ fromValue = Jsonb <$>

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

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

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

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

397501instance

398502 ( IsEnumType y

399503 , HasDatatypeInfo y

400− , LabelsFrom y ~ labels

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

402− fromValue _ =

504+ , LabelsPG y ~ labels

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

506+ fromValue =

403507 let

404508 greadConstructor

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

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

412516 then Just (SOP (Z Nil))

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

414518 in

415− Decoding.enum

519+ fmap Enumerated

520+ . Decoding.enum

416521 $ fmap to

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

418− . Strict.unpack

419−

523+ . Strict.Text.unpack

420524instance

421− ( SListI fields

422− , MapMaybes ys

423− , IsProductType y (Maybes ys)

424− , AllZip FromAliasedValue fields ys

425− , FieldNamesFrom y ~ AliasesOf fields

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

525+ ( FromRow fields y

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

427527 fromValue =

428528 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

438529 -- <number of fields: 4 bytes>

439530 -- [for each field]

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

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

445536 -- <value: <length> bytes>

446537 -- [end if]

447538 -- [end for]

539+ composite = Decoding.valueParser $ do

448540 unitOfSize 4

449− let

450− each field = do

451− unitOfSize 4

452− len <- sized 4 Decoding.int

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

454− htraverse' each fields

455−

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

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)

541+ hsequence' $ hpure $ Comp $ do

542+ unitOfSize 4

543+ len <- sized 4 Decoding.int

544+ if len == -1

545+ then return (K Nothing)

546+ else K . Just <$> bytesOfSize len

547+ in

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

462549

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

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

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

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

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

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

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

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

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

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

555+ fromField

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

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

477558instance FromValue pg y

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

479− fromColumnValue = \case

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

481− K (Just bs) ->

482− let

483− errOrValue =

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

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

486− in

487− either err id errOrValue

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

560+ fromField = Comp . \case

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

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

563+ Decoding.valueParser (fromValue @pg) bytestring

488564instance FromValue pg y

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

490− fromColumnValue (K nullOrBytes)

491− = either err id

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

493− <$> nullOrBytes

494− where

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

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

566+ fromField = Comp . \case

567+ K Nothing -> Right $ P Nothing

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

569+ Decoding.valueParser (fromValue @pg) bytestring

570+

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

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)

496609

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

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

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

501614-- provide `FromRow` instances.

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

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

503616 -- | >>> :set -XOverloadedStrings

504617 -- >>> import Data.Text

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

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

508621 -- >>> instance Generic UserRow

509622 -- >>> instance HasDatatypeInfo UserRow

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

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

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

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

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

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

514627instance

515− ( SListI results

516− , IsProductType y ys

517− , AllZip FromColumnValue results ys

518− , FieldNamesFrom y ~ AliasesOf results

519− ) => FromRow results y where

628+ ( SListI result

629+ , IsRecord y ys

630+ , AllZip FromField result ys

631+ ) => FromRow result y where

520632 fromRow

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

633+ = fmap fromRecord

634+ . hsequence'

635+ . htrans (Proxy @FromField) fromField

522636

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

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

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

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

529643--

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

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

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

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

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

534648instance Generic (Only x)

535649instance 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"

270270-}

271271check

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

273− , HasAll aliases (TableToRelation table) subcolumns )

273+ , HasAll aliases (TableToRow table) subcolumns )

274274 => NP Alias aliases

275275 -- ^ specify the subcolumns which are getting checked

276276 -> (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",

304304-}

305305unique

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

307− , HasAll aliases (TableToRelation table) subcolumns )

307+ , HasAll aliases (TableToRow table) subcolumns )

308308 => NP Alias aliases

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

310310 -> TableConstraintExpression schema alias ('Unique aliases)

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

807807createView

808808 :: KnownSymbol view

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

810− -> Query schema '[] relation

810+ -> Query schema '[] row

811811 -- ^ query

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

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

813813createView alias query = UnsafeDefinition $

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

815815 <+> renderQuery query <> ";"

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

857857createTypeEnumFrom

858858 :: forall hask enum schema.

859859 ( SOP.Generic hask

860− , SOP.All KnownSymbol (LabelsFrom hask)

860+ , SOP.All KnownSymbol (LabelsPG hask)

861861 , KnownSymbol enum

862862 )

863863 => Alias enum

864864 -- ^ 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)

866866createTypeEnumFrom enum = createTypeEnum enum

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

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

868868

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

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

871871

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

872+>>> :{

873+type PGcomplex = 'PGcomposite

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

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

876+:}

873877

874878>>> :{

875879let

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

892896 (renderCommaSeparated renderField fields) <> ";"

893897 where

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

895− renderField (typ `As` field) =

896− renderAlias field <+> renderTypeExpression typ

899+ renderField (typ `As` alias) =

900+ renderAlias alias <+> renderTypeExpression typ

897901

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

899903--

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

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

901905-- >>> instance SOP.Generic Complex

902906-- >>> instance SOP.HasDatatypeInfo Complex

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

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

905909createTypeCompositeFrom

906910 :: forall hask ty schema.

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

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

909− , KnownSymbol ty

910− )

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

912+ , KnownSymbol ty )

911913 => Alias ty

912914 -- ^ name of the user defined composite type

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

914−createTypeCompositeFrom ty = createTypeComposite ty $ zipAs

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

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

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

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

916+createTypeCompositeFrom ty = createTypeComposite ty

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

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

918925

919926-- | Drop a type.

920927--

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

922929-- >>> instance SOP.Generic Schwarma

923930-- >>> instance SOP.HasDatatypeInfo Schwarma

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

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

925932-- DROP TYPE "schwarma";

926933dropType

927934 :: Has tydef schema ('Typedef ty)

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

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

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

940947nullable

941− :: TypeExpression schema ty

948+ :: TypeExpression schema (nullity ty)

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

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

944951

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

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

947954notNullable

948− :: TypeExpression schema ty

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

955+ :: TypeExpression schema (nullity ty)

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

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

951958

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

4545 , nullIf

4646 -- ** Collections

4747 , array

48+ , index

4849 , row

50+ , field

4951 -- ** Functions

5052 , unsafeBinaryOp

5153 , unsafeUnaryOp

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

6163 , greatest

6264 , least

6365 -- ** Conditions

64− , Condition

6566 , true

6667 , false

6768 , not_

6869 , (.&&)

6970 , (.||)

71+ , Condition

7072 , caseWhenThenElse

7173 , ifThenElse

7274 , (.==)

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

8688 , upper

8789 , charLength

8890 , like

89− -- ** json or jsonb operators

90− , PGarray

91− , PGarrayOf

92− , PGjsonKey

93− , PGjson_

91+ -- ** Json

92+ -- *** Json and Jsonb operators

9493 , (.->)

9594 , (.->>)

9695 , (.#>)

9796 , (.#>>)

98− -- *** jsonb only operators

97+ -- *** Jsonb operators

9998 , (.@>)

10099 , (.<@)

101100 , (.?)

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

124123 , jsonbExtractPath

125124 , jsonExtractPathAsText

126125 , jsonbExtractPathAsText

127− , jsonObjectKeys

128− , jsonbObjectKeys

129126 , jsonTypeof

130127 , jsonbTypeof

131128 , jsonStripNulls

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

146143 -- * Types

147144 , TypeExpression (UnsafeTypeExpression, renderTypeExpression)

148145 , PGTyped (pgtype)

146+ , typedef

147+ , typetable

148+ , typeview

149149 , bool

150150 , int2

151151 , smallint

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

191191import qualified Data.Aeson as JSON

192192import Data.Ratio

193193import Data.String

194+import Data.Word

194195import Generics.SOP hiding (from)

195196import GHC.OverloadedLabels

196197import GHC.TypeLits

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

217218-}

218219newtype Expression

219220 (schema :: SchemaType)

220− (relations :: RelationsType)

221+ (from :: FromType)

221222 (grouping :: Grouping)

222223 (params :: [NullityType])

223224 (ty :: NullityType)

224225 = UnsafeExpression { renderExpression :: ByteString }

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

226227

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

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

228229 renderSQL = renderExpression

229230

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

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

247248 -- >>> printSQL expr

248249 -- ($1 :: int4)

249250 parameter

250− :: TypeExpression schema (PGTypeOf ty)

251− -> Expression schema relations grouping params ty

251+ :: TypeExpression schema ty

252+ -> Expression schema from grouping params ty

252253 parameter ty = UnsafeExpression $ parenthesized $

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

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

254255 <+> renderTypeExpression ty

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

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

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

263264-- >>> printSQL expr

264265-- ($1 :: int4)

265266param

266− :: forall n schema params relations grouping ty

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

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

267+ :: forall n schema params from grouping ty

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

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

269270param = parameter @n pgtype

270271

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

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

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

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

273274 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)

275276 => IsLabel column

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

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

277278 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)

279280 => IsLabel column

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

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

281282 fromLabel = fromLabel @column :* Nil

282283

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

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

285− relation ! column = UnsafeExpression $

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

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

288− => IsQualified relation column

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

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

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

292− => IsQualified relation column

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

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

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

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

286+ table ! column = UnsafeExpression $

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

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

289+ => IsQualified table column

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

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

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

293+ => IsQualified table column

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

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

295296

296297instance

297− ( HasUnique relation relations columns

298+ ( HasUnique table from columns

298299 , Has column columns ty

299− , GroupedBy relation column bys

300+ , GroupedBy table column bys

300301 ) => IsLabel column

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

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

302303 fromLabel = UnsafeExpression $ renderAlias (Alias @column)

303304instance

304− ( HasUnique relation relations columns

305+ ( HasUnique table from columns

305306 , Has column columns ty

306− , GroupedBy relation column bys

307+ , GroupedBy table column bys

307308 ) => IsLabel column

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

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

309310 (column ::: ty) ) where

310311 fromLabel = fromLabel @column `As` Alias @column

311312instance

312− ( HasUnique relation relations columns

313+ ( HasUnique table from columns

313314 , Has column columns ty

314− , GroupedBy relation column bys

315+ , GroupedBy table column bys

315316 ) => IsLabel column

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

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

317318 '[column ::: ty] ) where

318319 fromLabel = fromLabel @column :* Nil

319320

320321instance

321− ( Has relation relations columns

322+ ( Has table from columns

322323 , Has column columns ty

323− , GroupedBy relation column bys

324− ) => IsQualified relation column

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

326− relation ! column = UnsafeExpression $

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

324+ , GroupedBy table column bys

325+ ) => IsQualified table column

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

327+ table ! column = UnsafeExpression $

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

328329instance

329− ( Has relation relations columns

330+ ( Has table from columns

330331 , Has column columns ty

331− , GroupedBy relation column bys

332− ) => IsQualified relation column

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

332+ , GroupedBy table column bys

333+ ) => IsQualified table column

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

334335 (column ::: ty)) where

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

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

336337instance

337− ( Has relation relations columns

338+ ( Has table from columns

338339 , Has column columns ty

339− , GroupedBy relation column bys

340− ) => IsQualified relation column

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

340+ , GroupedBy table column bys

341+ ) => IsQualified table column

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

342343 '[column ::: ty]) where

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

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

344345

345346-- | analagous to `Nothing`

346347--

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

360361

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

362363--

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

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

364365-- COALESCE(NULL, TRUE, FALSE)

365366coalesce

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

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

367368 -- ^ @NULL@s may be present

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

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

369370 -- ^ @NULL@ is absent

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

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

371372coalesce nullxs notNullx = UnsafeExpression $

372373 "COALESCE" <> parenthesized (commaSeparated

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

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

377378-- >>> printSQL $ fromNull true null_

378379-- COALESCE(NULL, TRUE)

379380fromNull

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

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

381382 -- ^ what to convert @NULL@ to

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

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

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

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

384385fromNull notNullx nullx = coalesce [nullx] notNullx

385386

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

387388-- NULL IS NULL

388389isNull

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

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

390391 -- ^ possibly @NULL@

391− -> Condition schema relations grouping params

392+ -> Condition schema from grouping params

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

393394

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

395396-- NULL IS NOT NULL

396397isNotNull

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

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

398399 -- ^ possibly @NULL@

399− -> Condition schema relations grouping params

400+ -> Condition schema from grouping params

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

401402

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

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

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

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

406407matchNull

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

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

408409 -- ^ what to convert @NULL@ to

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

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

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

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

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

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

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

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

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

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

415416 (f (UnsafeExpression (renderExpression x)))

416417

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

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

424425-}

425426nullIf

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

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

427428 -- ^ @NULL@ is absent

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

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

429430 -- ^ @NULL@ is absent

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

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

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

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

433434

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

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

435436-- ARRAY[NULL, FALSE, TRUE]

436437array

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

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

438439 -- ^ array elements

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

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

440441array xs = UnsafeExpression $

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

442443

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+

443453instance (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

445455 label = UnsafeExpression $ renderLabel (PGlabel @label)

446456

447457-- | A row constructor is an expression that builds a row value

448458-- (also called a composite value) using values for its member fields.

449459--

450−-- >>> type Complex = PGcomposite '["real" ::: 'PGfloat8, "imaginary" ::: 'PGfloat8]

460+-- >>> :{

461+-- type Complex = 'PGcomposite

462+-- '[ "real" ::: 'NotNull 'PGfloat8

463+-- , "imaginary" ::: 'NotNull 'PGfloat8 ]

464+-- :}

465+--

451466-- >>> let i = row (0 `as` #real :* 1 `as` #imaginary) :: Expression '[] '[] 'Ungrouped '[] ('NotNull Complex)

452467-- >>> printSQL i

453468-- ROW(0, 1)

454469row

455− :: SListI (Nulls fields)

456− => NP (Aliased (Expression schema relations grouping params)) (Nulls fields)

470+ :: SListI row

471+ => NP (Aliased (Expression schema from grouping params)) row

457472 -- ^ 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))

459474row exprs = UnsafeExpression $ "ROW" <> parenthesized

460475 (renderCommaSeparated (\ (expr `As` _) -> renderExpression expr) exprs)

461476

462−instance Has field fields ty => IsLabel field

463− ( Expression schema relation grouping params (nullity ('PGcomposite fields))

464− -> Expression schema relation grouping params ('Null ty) ) where

465− fromLabel expr = UnsafeExpression $

466− parenthesized (renderExpression expr) <> "." <>

467− fromString (symbolVal (Proxy @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

490+ -> Expression schema from grouping params ('NotNull ('PGcomposite row))

491+ -> Expression schema from grouping params ty

492+field td fld expr = UnsafeExpression $

493+ parenthesized (renderExpression expr <> "::" <> renderAlias td)

494+ <> "." <> renderAlias fld

468495

469496instance Semigroup

470− (Expression schema relations grouping params (nullity ('PGvararray ty))) where

497+ (Expression schema from grouping params (nullity ('PGvararray ty))) where

471498 (<>) = unsafeBinaryOp "||"

472499

473500instance Monoid

474− (Expression schema relations grouping params (nullity ('PGvararray ty))) where

501+ (Expression schema from grouping params (nullity ('PGvararray ty))) where

475502 mempty = array []

476503 mappend = (<>)

477504

@@ -479,22 +506,22 @@ instance Monoid

479506-- >>> printSQL expr

480507-- GREATEST(CURRENT_TIMESTAMP, ($1 :: timestamp with time zone))

481508greatest

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

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

483510 -- ^ needs at least 1 argument

484− -> [Expression schema relations grouping params (nullty)]

511+ -> [Expression schema from grouping params (nullty)]

485512 -- ^ or more

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

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

487514greatest x xs = UnsafeExpression $ "GREATEST("

488515 <> commaSeparated (renderExpression <$> (x:xs)) <> ")"

489516

490517-- | >>> printSQL $ least currentTimestamp [null_]

491518-- LEAST(CURRENT_TIMESTAMP, NULL)

492519least

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

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

494521 -- ^ needs at least 1 argument

495− -> [Expression schema relations grouping params (nullty)]

522+ -> [Expression schema from grouping params (nullty)]

496523 -- ^ or more

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

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

498525least x xs = UnsafeExpression $ "LEAST("

499526 <> commaSeparated (renderExpression <$> (x:xs)) <> ")"

500527

@@ -503,9 +530,9 @@ least x xs = UnsafeExpression $ "LEAST("

503530unsafeBinaryOp

504531 :: ByteString

505532 -- ^ operator

506− -> Expression schema relations grouping params (ty0)

507− -> Expression schema relations grouping params (ty1)

508− -> Expression schema relations grouping params (ty2)

533+ -> Expression schema from grouping params (ty0)

534+ -> Expression schema from grouping params (ty1)

535+ -> Expression schema from grouping params (ty2)

509536unsafeBinaryOp op x y = UnsafeExpression $ parenthesized $

510537 renderExpression x <+> op <+> renderExpression y

511538

@@ -514,8 +541,8 @@ unsafeBinaryOp op x y = UnsafeExpression $ parenthesized $

514541unsafeUnaryOp

515542 :: ByteString

516543 -- ^ operator

517− -> Expression schema relations grouping params (ty0)

518− -> Expression schema relations grouping params (ty1)

544+ -> Expression schema from grouping params (ty0)

545+ -> Expression schema from grouping params (ty1)

519546unsafeUnaryOp op x = UnsafeExpression $ parenthesized $

520547 op <+> renderExpression x

521548

@@ -524,8 +551,8 @@ unsafeUnaryOp op x = UnsafeExpression $ parenthesized $

524551unsafeFunction

525552 :: ByteString

526553 -- ^ function

527− -> Expression schema relations grouping params (xty)

528− -> Expression schema relations grouping params (yty)

554+ -> Expression schema from grouping params (xty)

555+ -> Expression schema from grouping params (yty)

529556unsafeFunction fun x = UnsafeExpression $

530557 fun <> parenthesized (renderExpression x)

531558

@@ -534,13 +561,13 @@ unsafeVariadicFunction

534561 :: SListI elems

535562 => ByteString

536563 -- ^ function

537− -> NP (Expression schema relations grouping params) elems

538− -> Expression schema relations grouping params ret

564+ -> NP (Expression schema from grouping params) elems

565+ -> Expression schema from grouping params ret

539566unsafeVariadicFunction fun x = UnsafeExpression $

540567 fun <> parenthesized (commaSeparated (hcollapse (hmap (K . renderExpression) x)))

541568

542−instance PGNum ty

543− => Num (Expression schema relations grouping params (nullity ty)) where

569+instance ty `In` PGNum

570+ => Num (Expression schema from grouping params (nullity ty)) where

544571 (+) = unsafeBinaryOp "+"

545572 (-) = unsafeBinaryOp "-"

546573 (*) = unsafeBinaryOp "*"

@@ -551,13 +578,13 @@ instance PGNum ty

551578 . fromString

552579 . show

553580

554−instance (PGNum ty, PGFloating ty) => Fractional

555− (Expression schema relations grouping params (nullity ty)) where

581+instance (ty `In` PGNum, ty `In` PGFloating) => Fractional

582+ (Expression schema from grouping params (nullity ty)) where

556583 (/) = unsafeBinaryOp "/"

557584 fromRational x = fromInteger (numerator x) / fromInteger (denominator x)

558585

559−instance (PGNum ty, PGFloating ty) => Floating

560− (Expression schema relations grouping params (nullity ty)) where

586+instance (ty `In` PGNum, ty `In` PGFloating) => Floating

587+ (Expression schema from grouping params (nullity ty)) where

561588 pi = UnsafeExpression "pi()"

562589 exp = unsafeFunction "exp"

563590 log = unsafeFunction "ln"

@@ -580,18 +607,18 @@ instance (PGNum ty, PGFloating ty) => Floating

580607

581608-- | >>> :{

582609-- let

583−-- expression :: Expression schema relations grouping params (nullity 'PGfloat4)

610+-- expression :: Expression schema from grouping params (nullity 'PGfloat4)

584611-- expression = atan2_ pi 2

585612-- in printSQL expression

586613-- :}

587614-- atan2(pi(), 2)

588615atan2_

589− :: PGFloating float

590− => Expression schema relations grouping params (nullity float)

616+ :: float `In` PGFloating

617+ => Expression schema from grouping params (nullity float)

591618 -- ^ numerator

592− -> Expression schema relations grouping params (nullity float)

619+ -> Expression schema from grouping params (nullity float)

593620 -- ^ denominator

594− -> Expression schema relations grouping params (nullity float)

621+ -> Expression schema from grouping params (nullity float)

595622atan2_ y x = UnsafeExpression $

596623 "atan2(" <> renderExpression y <> ", " <> renderExpression x <> ")"

597624

@@ -604,9 +631,9 @@ atan2_ y x = UnsafeExpression $

604631cast

605632 :: TypeExpression schema ty1

606633 -- ^ type to cast as

607− -> Expression schema relations grouping params (nullity ty0)

634+ -> Expression schema from grouping params ty0

608635 -- ^ value to convert

609− -> Expression schema relations grouping params (nullity ty1)

636+ -> Expression schema from grouping params ty1

610637cast ty x = UnsafeExpression $ parenthesized $

611638 renderExpression x <+> "::" <+> renderTypeExpression ty

612639

@@ -614,135 +641,136 @@ cast ty x = UnsafeExpression $ parenthesized $

614641--

615642-- >>> :{

616643-- let

617−-- expression :: Expression schema relations grouping params (nullity 'PGint2)

644+-- expression :: Expression schema from grouping params (nullity 'PGint2)

618645-- expression = 5 `quot_` 2

619646-- in printSQL expression

620647-- :}

621648-- (5 / 2)

622649quot_

623− :: PGIntegral int

624− => Expression schema relations grouping params (nullity int)

650+ :: int `In` PGIntegral

651+ => Expression schema from grouping params (nullity int)

625652 -- ^ numerator

626− -> Expression schema relations grouping params (nullity int)

653+ -> Expression schema from grouping params (nullity int)

627654 -- ^ denominator

628− -> Expression schema relations grouping params (nullity int)

655+ -> Expression schema from grouping params (nullity int)

629656quot_ = unsafeBinaryOp "/"

630657

631658-- | remainder upon integer division

632659--

633660-- >>> :{

634661-- let

635−-- expression :: Expression schema relations grouping params (nullity 'PGint2)

662+-- expression :: Expression schema from grouping params (nullity 'PGint2)

636663-- expression = 5 `rem_` 2

637664-- in printSQL expression

638665-- :}

639666-- (5 % 2)

640667rem_

641− :: PGIntegral int

642− => Expression schema relations grouping params (nullity int)

668+ :: int `In` PGIntegral

669+ => Expression schema from grouping params (nullity int)

643670 -- ^ numerator

644− -> Expression schema relations grouping params (nullity int)

671+ -> Expression schema from grouping params (nullity int)

645672 -- ^ denominator

646− -> Expression schema relations grouping params (nullity int)

673+ -> Expression schema from grouping params (nullity int)

647674rem_ = unsafeBinaryOp "%"

648675

649676-- | >>> :{

650677-- let

651−-- expression :: Expression schema relations grouping params (nullity 'PGfloat4)

678+-- expression :: Expression schema from grouping params (nullity 'PGfloat4)

652679-- expression = trunc pi

653680-- in printSQL expression

654681-- :}

655682-- trunc(pi())

656683trunc

657− :: PGFloating frac

658− => Expression schema relations grouping params (nullity frac)

684+ :: frac `In` PGFloating

685+ => Expression schema from grouping params (nullity frac)

659686 -- ^ fractional number

660− -> Expression schema relations grouping params (nullity frac)

687+ -> Expression schema from grouping params (nullity frac)

661688trunc = unsafeFunction "trunc"

662689

663690-- | >>> :{

664691-- let

665−-- expression :: Expression schema relations grouping params (nullity 'PGfloat4)

692+-- expression :: Expression schema from grouping params (nullity 'PGfloat4)

666693-- expression = round_ pi

667694-- in printSQL expression

668695-- :}

669696-- round(pi())

670697round_

671− :: PGFloating frac

672− => Expression schema relations grouping params (nullity frac)

698+ :: frac `In` PGFloating

699+ => Expression schema from grouping params (nullity frac)

673700 -- ^ fractional number

674− -> Expression schema relations grouping params (nullity frac)

701+ -> Expression schema from grouping params (nullity frac)

675702round_ = unsafeFunction "round"

676703

677704-- | >>> :{

678705-- let

679−-- expression :: Expression schema relations grouping params (nullity 'PGfloat4)

706+-- expression :: Expression schema from grouping params (nullity 'PGfloat4)

680707-- expression = ceiling_ pi

681708-- in printSQL expression

682709-- :}

683710-- ceiling(pi())

684711ceiling_

685− :: PGFloating frac

686− => Expression schema relations grouping params (nullity frac)

712+ :: frac `In` PGFloating

713+ => Expression schema from grouping params (nullity frac)

687714 -- ^ fractional number

688− -> Expression schema relations grouping params (nullity frac)

715+ -> Expression schema from grouping params (nullity frac)

689716ceiling_ = unsafeFunction "ceiling"

690717

691−-- | A `Condition` is a boolean valued `Expression`. While SQL allows

692−-- conditions to have @NULL@, Squeal instead chooses to disallow @NULL@,

693−-- forcing one to handle the case of @NULL@ explicitly to produce

694−-- a `Condition`.

695−type Condition schema relations grouping params =

696− Expression schema relations grouping params ('NotNull 'PGbool)

718+-- | A `Condition` is an `Expression`, which can evaluate

719+-- to `true`, `false` or `null_`. This is because SQL uses

720+-- a three valued logic.

721+type Condition schema from grouping params =

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

697723

698724-- | >>> printSQL true

699725-- TRUE

700−true :: Condition schema relations grouping params

726+true :: Expression schema from grouping params (nullity 'PGbool)

701727true = UnsafeExpression "TRUE"

702728

703729-- | >>> printSQL false

704730-- FALSE

705−false :: Condition schema relations grouping params

731+false :: Expression schema from grouping params (nullity 'PGbool)

706732false = UnsafeExpression "FALSE"

707733

708734-- | >>> printSQL $ not_ true

709735-- (NOT TRUE)

710736not_

711− :: Condition schema relations grouping params

712− -> Condition schema relations grouping params

737+ :: Expression schema from grouping params (nullity 'PGbool)

738+ -> Expression schema from grouping params (nullity 'PGbool)

713739not_ = unsafeUnaryOp "NOT"

714740

715741-- | >>> printSQL $ true .&& false

716742-- (TRUE AND FALSE)

717743(.&&)

718− :: Condition schema relations grouping params

719− -> Condition schema relations grouping params

720− -> Condition schema relations grouping params

744+ :: Expression schema from grouping params (nullity 'PGbool)

745+ -> Expression schema from grouping params (nullity 'PGbool)

746+ -> Expression schema from grouping params (nullity 'PGbool)

747+infixr 3 .&&

721748(.&&) = unsafeBinaryOp "AND"

722749

723750-- | >>> printSQL $ true .|| false

724751-- (TRUE OR FALSE)

725752(.||)

726− :: Condition schema relations grouping params

727− -> Condition schema relations grouping params

728− -> Condition schema relations grouping params

753+ :: Expression schema from grouping params (nullity 'PGbool)

754+ -> Expression schema from grouping params (nullity 'PGbool)

755+ -> Expression schema from grouping params (nullity 'PGbool)

756+infixr 2 .||

729757(.||) = unsafeBinaryOp "OR"

730758

731759-- | >>> :{

732760-- let

733−-- expression :: Expression schema relations grouping params (nullity 'PGint2)

761+-- expression :: Expression schema from grouping params (nullity 'PGint2)

734762-- expression = caseWhenThenElse [(true, 1), (false, 2)] 3

735763-- in printSQL expression

736764-- :}

737765-- CASE WHEN TRUE THEN 1 WHEN FALSE THEN 2 ELSE 3 END

738766caseWhenThenElse

739− :: [ ( Condition schema relations grouping params

740− , Expression schema relations grouping params (ty)

767+ :: [ ( Condition schema from grouping params

768+ , Expression schema from grouping params ty

741769 ) ]

742770 -- ^ whens and thens

743− -> Expression schema relations grouping params (ty)

771+ -> Expression schema from grouping params ty

744772 -- ^ else

745− -> Expression schema relations grouping params (ty)

773+ -> Expression schema from grouping params ty

746774caseWhenThenElse whenThens else_ = UnsafeExpression $ mconcat

747775 [ "CASE"

748776 , mconcat

@@ -758,103 +786,103 @@ caseWhenThenElse whenThens else_ = UnsafeExpression $ mconcat

758786

759787-- | >>> :{

760788-- let

761−-- expression :: Expression schema relations grouping params (nullity 'PGint2)

789+-- expression :: Expression schema from grouping params (nullity 'PGint2)

762790-- expression = ifThenElse true 1 0

763791-- in printSQL expression

764792-- :}

765793-- CASE WHEN TRUE THEN 1 ELSE 0 END

766794ifThenElse

767− :: Condition schema relations grouping params

768− -> Expression schema relations grouping params (ty) -- ^ then

769− -> Expression schema relations grouping params (ty) -- ^ else

770− -> Expression schema relations grouping params (ty)

795+ :: Condition schema from grouping params

796+ -> Expression schema from grouping params ty -- ^ then

797+ -> Expression schema from grouping params ty -- ^ else

798+ -> Expression schema from grouping params ty

771799ifThenElse if_ then_ else_ = caseWhenThenElse [(if_,then_)] else_

772800

773801-- | Comparison operations like `.==`, `./=`, `.>`, `.>=`, `.<` and `.<=`

774802-- will produce @NULL@s if one of their arguments is @NULL@.

775803--

776−-- >>> printSQL $ notNull true .== null_

804+-- >>> printSQL $ true .== null_

777805-- (TRUE = NULL)

778806(.==)

779− :: Expression schema relations grouping params (nullity ty) -- ^ lhs

780− -> Expression schema relations grouping params (nullity ty) -- ^ rhs

781− -> Expression schema relations grouping params (nullity 'PGbool)

807+ :: Expression schema from grouping params (nullity0 ty) -- ^ lhs

808+ -> Expression schema from grouping params (nullity1 ty) -- ^ rhs

809+ -> Condition schema from grouping params

782810(.==) = unsafeBinaryOp "="

783811infix 4 .==

784812

785−-- | >>> printSQL $ notNull true ./= null_

813+-- | >>> printSQL $ true ./= null_

786814-- (TRUE <> NULL)

787815(./=)

788− :: Expression schema relations grouping params (nullity ty) -- ^ lhs

789− -> Expression schema relations grouping params (nullity ty) -- ^ rhs

790− -> Expression schema relations grouping params (nullity 'PGbool)

816+ :: Expression schema from grouping params (nullity0 ty) -- ^ lhs

817+ -> Expression schema from grouping params (nullity1 ty) -- ^ rhs

818+ -> Condition schema from grouping params

791819(./=) = unsafeBinaryOp "<>"

792820infix 4 ./=

793821

794−-- | >>> printSQL $ notNull true .>= null_

822+-- | >>> printSQL $ true .>= null_

795823-- (TRUE >= NULL)

796824(.>=)

797− :: Expression schema relations grouping params (nullity ty) -- ^ lhs

798− -> Expression schema relations grouping params (nullity ty) -- ^ rhs

799− -> Expression schema relations grouping params (nullity 'PGbool)

825+ :: Expression schema from grouping params (nullity0 ty) -- ^ lhs

826+ -> Expression schema from grouping params (nullity1 ty) -- ^ rhs

827+ -> Condition schema from grouping params

800828(.>=) = unsafeBinaryOp ">="

801829infix 4 .>=

802830

803−-- | >>> printSQL $ notNull true .< null_

831+-- | >>> printSQL $ true .< null_

804832-- (TRUE < NULL)

805833(.<)

806− :: Expression schema relations grouping params (nullity ty) -- ^ lhs

807− -> Expression schema relations grouping params (nullity ty) -- ^ rhs

808− -> Expression schema relations grouping params (nullity 'PGbool)

834+ :: Expression schema from grouping params (nullity0 ty) -- ^ lhs

835+ -> Expression schema from grouping params (nullity1 ty) -- ^ rhs

836+ -> Condition schema from grouping params

809837(.<) = unsafeBinaryOp "<"

810838infix 4 .<

811839

812−-- | >>> printSQL $ notNull true .<= null_

840+-- | >>> printSQL $ true .<= null_

813841-- (TRUE <= NULL)

814842(.<=)

815− :: Expression schema relations grouping params (nullity ty) -- ^ lhs

816− -> Expression schema relations grouping params (nullity ty) -- ^ rhs

817− -> Expression schema relations grouping params (nullity 'PGbool)

843+ :: Expression schema from grouping params (nullity0 ty) -- ^ lhs

844+ -> Expression schema from grouping params (nullity1 ty) -- ^ rhs

845+ -> Condition schema from grouping params

818846(.<=) = unsafeBinaryOp "<="

819847infix 4 .<=

820848

821−-- | >>> printSQL $ notNull true .> null_

849+-- | >>> printSQL $ true .> null_

822850-- (TRUE > NULL)

823851(.>)

824− :: Expression schema relations grouping params (nullity ty) -- ^ lhs

825− -> Expression schema relations grouping params (nullity ty) -- ^ rhs

826− -> Expression schema relations grouping params (nullity 'PGbool)

852+ :: Expression schema from grouping params (nullity0 ty) -- ^ lhs

853+ -> Expression schema from grouping params (nullity1 ty) -- ^ rhs

854+ -> Condition schema from grouping params

827855(.>) = unsafeBinaryOp ">"

828856infix 4 .>

829857

830858-- | >>> printSQL currentDate

831859-- CURRENT_DATE

832860currentDate

833− :: Expression schema relations grouping params (nullity 'PGdate)

861+ :: Expression schema from grouping params (nullity 'PGdate)

834862currentDate = UnsafeExpression "CURRENT_DATE"

835863

836864-- | >>> printSQL currentTime

837865-- CURRENT_TIME

838866currentTime

839− :: Expression schema relations grouping params (nullity 'PGtimetz)

867+ :: Expression schema from grouping params (nullity 'PGtimetz)

840868currentTime = UnsafeExpression "CURRENT_TIME"

841869

842870-- | >>> printSQL currentTimestamp

843871-- CURRENT_TIMESTAMP

844872currentTimestamp

845− :: Expression schema relations grouping params (nullity 'PGtimestamptz)

873+ :: Expression schema from grouping params (nullity 'PGtimestamptz)

846874currentTimestamp = UnsafeExpression "CURRENT_TIMESTAMP"

847875

848876-- | >>> printSQL localTime

849877-- LOCALTIME

850878localTime

851− :: Expression schema relations grouping params (nullity 'PGtime)

879+ :: Expression schema from grouping params (nullity 'PGtime)

852880localTime = UnsafeExpression "LOCALTIME"

853881

854882-- | >>> printSQL localTimestamp

855883-- LOCALTIMESTAMP

856884localTimestamp

857− :: Expression schema relations grouping params (nullity 'PGtimestamp)

885+ :: Expression schema from grouping params (nullity 'PGtimestamp)

858886localTimestamp = UnsafeExpression "LOCALTIMESTAMP"

859887

860888{-----------------------------------------

@@ -862,7 +890,7 @@ text

862890-----------------------------------------}

863891

864892instance IsString

865− (Expression schema relations grouping params (nullity 'PGtext)) where

893+ (Expression schema from grouping params (nullity 'PGtext)) where

866894 fromString str = UnsafeExpression $

867895 "E\'" <> fromString (escape =<< str) <> "\'"

868896 where

@@ -878,36 +906,36 @@ instance IsString

878906 c -> [c]

879907

880908instance Semigroup

881− (Expression schema relations grouping params (nullity 'PGtext)) where

909+ (Expression schema from grouping params (nullity 'PGtext)) where

882910 (<>) = unsafeBinaryOp "||"

883911

884912instance Monoid

885− (Expression schema relations grouping params (nullity 'PGtext)) where

913+ (Expression schema from grouping params (nullity 'PGtext)) where

886914 mempty = fromString ""

887915 mappend = (<>)

888916

889917-- | >>> printSQL $ lower "ARRRGGG"

890918-- lower(E'ARRRGGG')

891919lower

892− :: Expression schema relations grouping params (nullity 'PGtext)

920+ :: Expression schema from grouping params (nullity 'PGtext)

893921 -- ^ string to lower case

894− -> Expression schema relations grouping params (nullity 'PGtext)

922+ -> Expression schema from grouping params (nullity 'PGtext)

895923lower = unsafeFunction "lower"

896924

897925-- | >>> printSQL $ upper "eeee"

898926-- upper(E'eeee')

899927upper

900− :: Expression schema relations grouping params (nullity 'PGtext)

928+ :: Expression schema from grouping params (nullity 'PGtext)

901929 -- ^ string to upper case

902− -> Expression schema relations grouping params (nullity 'PGtext)

930+ -> Expression schema from grouping params (nullity 'PGtext)

903931upper = unsafeFunction "upper"

904932

905933-- | >>> printSQL $ charLength "four"

906934-- char_length(E'four')

907935charLength

908− :: Expression schema relations grouping params (nullity 'PGtext)

936+ :: Expression schema from grouping params (nullity 'PGtext)

909937 -- ^ string to measure

910− -> Expression schema relations grouping params (nullity 'PGint4)

938+ -> Expression schema from grouping params (nullity 'PGint4)

911939charLength = unsafeFunction "char_length"

912940

913941-- | The `like` expression returns true if the @string@ matches

@@ -920,11 +948,11 @@ charLength = unsafeFunction "char_length"

920948-- >>> printSQL $ "abc" `like` "a%"

921949-- (E'abc' LIKE E'a%')

922950like

923− :: Expression schema relations grouping params (nullity 'PGtext)

951+ :: Expression schema from grouping params (nullity 'PGtext)

924952 -- ^ string

925− -> Expression schema relations grouping params (nullity 'PGtext)

953+ -> Expression schema from grouping params (nullity 'PGtext)

926954 -- ^ pattern

927− -> Expression schema relations grouping params (nullity 'PGbool)

955+ -> Expression schema from grouping params (nullity 'PGbool)

928956like = unsafeBinaryOp "LIKE"

929957

930958{-----------------------------------------

@@ -938,34 +966,38 @@ Table 9.44: json and jsonb operators

938966

939967-- | Get JSON value (object field or array element) at a key.

940968(.->)

941− :: (PGjson_ json, PGjsonKey key)

942− => Expression schema relations grouping params (nullity json)

943− -> Expression schema relations grouping params (nullity key)

944− -> Expression schema relations grouping params ('Null json)

969+ :: (json `In` PGJsonType, key `In` PGJsonKey)

970+ => Expression schema from grouping params (nullity json)

971+ -> Expression schema from grouping params (nullity key)

972+ -> Expression schema from grouping params ('Null json)

973+infixl 8 .->

945974(.->) = unsafeBinaryOp "->"

946975

947976-- | Get JSON value (object field or array element) at a key, as text.

948977(.->>)

949− :: (PGjson_ json, PGjsonKey key)

950− => Expression schema relations grouping params (nullity json)

951− -> Expression schema relations grouping params (nullity key)

952− -> Expression schema relations grouping params ('Null 'PGtext)

978+ :: (json `In` PGJsonType, key `In` PGJsonKey)

979+ => Expression schema from grouping params (nullity json)

980+ -> Expression schema from grouping params (nullity key)

981+ -> Expression schema from grouping params ('Null 'PGtext)

982+infixl 8 .->>

953983(.->>) = unsafeBinaryOp "->>"

954984

955985-- | Get JSON value at a specified path.

956986(.#>)

957− :: (PGjson_ json, PGtextArray "(.#>)" path)

958− => Expression schema relations grouping params (nullity json)

959− -> Expression schema relations grouping params (nullity path)

960− -> Expression schema relations grouping params ('Null json)

987+ :: (json `In` PGJsonType, PGTextArray "(.#>)" path)

988+ => Expression schema from grouping params (nullity json)

989+ -> Expression schema from grouping params (nullity path)

990+ -> Expression schema from grouping params ('Null json)

991+infixl 8 .#>

961992(.#>) = unsafeBinaryOp "#>"

962993

963994-- | Get JSON value at a specified path as text.

964995(.#>>)

965− :: (PGjson_ json, PGtextArray "(.#>>)" path)

966− => Expression schema relations grouping params (nullity json)

967− -> Expression schema relations grouping params (nullity path)

968− -> Expression schema relations grouping params ('Null 'PGtext)

996+ :: (json `In` PGJsonType, PGTextArray "(.#>>)" path)

997+ => Expression schema from grouping params (nullity json)

998+ -> Expression schema from grouping params (nullity path)

999+ -> Expression schema from grouping params ('Null 'PGtext)

1000+infixl 8 .#>>

9691001(.#>>) = unsafeBinaryOp "#>>"

9701002

9711003-- Additional jsonb operators

@@ -973,43 +1005,48 @@ Table 9.44: json and jsonb operators

9731005-- | Does the left JSON value contain the right JSON path/value entries at the

9741006-- top level?

9751007(.@>)

976− :: Expression schema relations grouping params (nullity 'PGjsonb)

977− -> Expression schema relations grouping params (nullity 'PGjsonb)

978− -> Condition schema relations grouping params

1008+ :: Expression schema from grouping params (nullity 'PGjsonb)

1009+ -> Expression schema from grouping params (nullity 'PGjsonb)

1010+ -> Condition schema from grouping params

1011+infixl 9 .@>

9791012(.@>) = unsafeBinaryOp "@>"

9801013

9811014-- | Are the left JSON path/value entries contained at the top level within the

9821015-- right JSON value?

9831016(.<@)

984− :: Expression schema relations grouping params (nullity 'PGjsonb)

985− -> Expression schema relations grouping params (nullity 'PGjsonb)

986− -> Condition schema relations grouping params

1017+ :: Expression schema from grouping params (nullity 'PGjsonb)

1018+ -> Expression schema from grouping params (nullity 'PGjsonb)

1019+ -> Condition schema from grouping params

1020+infixl 9 .<@

9871021(.<@) = unsafeBinaryOp "<@"

9881022

9891023-- | Does the string exist as a top-level key within the JSON value?

9901024(.?)

991− :: Expression schema relations grouping params (nullity 'PGjsonb)

992− -> Expression schema relations grouping params (nullity 'PGtext)

993− -> Condition schema relations grouping params

1025+ :: Expression schema from grouping params (nullity 'PGjsonb)

1026+ -> Expression schema from grouping params (nullity 'PGtext)

1027+ -> Condition schema from grouping params

1028+infixl 9 .?

9941029(.?) = unsafeBinaryOp "?"

9951030

9961031-- | Do any of these array strings exist as top-level keys?

9971032(.?|)

998− :: Expression schema relations grouping params (nullity 'PGjsonb)

999− -> Expression schema relations grouping params (nullity ('PGvararray 'PGtext))

1000− -> Condition schema relations grouping params

1033+ :: Expression schema from grouping params (nullity 'PGjsonb)

1034+ -> Expression schema from grouping params (nullity ('PGvararray ('NotNull 'PGtext)))

1035+ -> Condition schema from grouping params

1036+infixl 9 .?|

10011037(.?|) = unsafeBinaryOp "?|"

10021038

10031039-- | Do all of these array strings exist as top-level keys?

10041040(.?&)

1005− :: Expression schema relations grouping params (nullity 'PGjsonb)

1006− -> Expression schema relations grouping params (nullity ('PGvararray 'PGtext))

1007− -> Condition schema relations grouping params

1041+ :: Expression schema from grouping params (nullity 'PGjsonb)

1042+ -> Expression schema from grouping params (nullity ('PGvararray ('NotNull 'PGtext)))

1043+ -> Condition schema from grouping params

1044+infixl 9 .?&

10081045(.?&) = unsafeBinaryOp "?&"

10091046

10101047-- | Concatenate two jsonb values into a new jsonb value.

10111048instance

1012− Semigroup (Expression schema relations grouping param (nullity 'PGjsonb)) where

1049+ Semigroup (Expression schema from grouping param (nullity 'PGjsonb)) where

10131050 (<>) = unsafeBinaryOp "||"

10141051

10151052-- | Delete a key or keys from a JSON object, or remove an array element.

@@ -1025,19 +1062,21 @@ instance

10251062-- @ integer @: Delete the array element with specified index (Negative integers

10261063-- count from the end). Throws an error if top level container is not an array.

10271064(.-.)

1028− :: (key `In` '[ 'PGtext, 'PGvararray 'PGtext, 'PGint4, 'PGint2 ]) -- hlint error without parens here

1029− => Expression schema relations grouping params (nullity 'PGjsonb)

1030− -> Expression schema relations grouping params (nullity key)

1031− -> Expression schema relations grouping params (nullity 'PGjsonb)

1065+ :: (key `In` '[ 'PGtext, 'PGvararray ('NotNull 'PGtext), 'PGint4, 'PGint2 ]) -- hlint error without parens here

1066+ => Expression schema from grouping params (nullity 'PGjsonb)

1067+ -> Expression schema from grouping params (nullity key)

1068+ -> Expression schema from grouping params (nullity 'PGjsonb)

1069+infixl 6 .-.

10321070(.-.) = unsafeBinaryOp "-"

10331071

10341072-- | Delete the field or element with specified path (for JSON arrays, negative

10351073-- integers count from the end)

10361074(#-.)

1037− :: PGtextArray "(#-.)" arrayty

1038− => Expression schema relations grouping params (nullity 'PGjsonb)

1039− -> Expression schema relations grouping params (nullity arrayty)

1040− -> Expression schema relations grouping params (nullity 'PGjsonb)

1075+ :: PGTextArray "(#-.)" arrayty

1076+ => Expression schema from grouping params (nullity 'PGjsonb)

1077+ -> Expression schema from grouping params (nullity arrayty)

1078+ -> Expression schema from grouping params (nullity 'PGjsonb)

1079+infixl 6 #-.

10411080(#-.) = unsafeBinaryOp "#-"

10421081

10431082{-----------------------------------------

@@ -1045,12 +1084,18 @@ Table 9.45: JSON creation functions

10451084-----------------------------------------}

10461085

10471086-- | Literal binary JSON

1048−jsonbLit :: JSON.Value -> Expression schema relations grouping params (nullity 'PGjsonb)

1049−jsonbLit = cast jsonb . UnsafeExpression . singleQuotedUtf8 . toStrict . JSON.encode

1087+jsonbLit

1088+ :: JSON.ToJSON x

1089+ => x -> Expression schema from grouping params (nullity 'PGjsonb)

1090+jsonbLit = cast jsonb . UnsafeExpression

1091+ . singleQuotedUtf8 . toStrict . JSON.encode

10501092

10511093-- | Literal JSON

1052−jsonLit :: JSON.Value -> Expression schema relations grouping params (nullity 'PGjson)

1053−jsonLit = cast json . UnsafeExpression . singleQuotedUtf8 . toStrict . JSON.encode

1094+jsonLit

1095+ :: JSON.ToJSON x

1096+ => x -> Expression schema from grouping params (nullity 'PGjson)

1097+jsonLit = cast json . UnsafeExpression

1098+ . singleQuotedUtf8 . toStrict . JSON.encode

10541099

10551100-- | Returns the value as json. Arrays and composites are converted

10561101-- (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

10591104-- number, a Boolean, or a null value, the text representation will be used, in

10601105-- such a fashion that it is a valid json value.

10611106toJson

1062− :: Expression schema relations grouping params (nullity ty)

1063− -> Expression schema relations grouping params (nullity 'PGjson)

1107+ :: Expression schema from grouping params (nullity ty)

1108+ -> Expression schema from grouping params (nullity 'PGjson)

10641109toJson = unsafeFunction "to_json"

10651110

10661111-- | Returns the value as jsonb. Arrays and composites are converted

@@ -1070,43 +1115,43 @@ toJson = unsafeFunction "to_json"

10701115-- number, a Boolean, or a null value, the text representation will be used, in

10711116-- such a fashion that it is a valid jsonb value.

10721117toJsonb

1073− :: Expression schema relations grouping params (nullity ty)

1074− -> Expression schema relations grouping params (nullity 'PGjsonb)

1118+ :: Expression schema from grouping params (nullity ty)

1119+ -> Expression schema from grouping params (nullity 'PGjsonb)

10751120toJsonb = unsafeFunction "to_jsonb"

10761121

10771122-- | Returns the array as a JSON array. A PostgreSQL multidimensional array

10781123-- becomes a JSON array of arrays.

10791124arrayToJson

1080− :: PGarray "arrayToJson" arr

1081− => Expression schema relations grouping params (nullity arr)

1082− -> Expression schema relations grouping params (nullity 'PGjson)

1125+ :: PGArray "arrayToJson" arr

1126+ => Expression schema from grouping params (nullity arr)

1127+ -> Expression schema from grouping params (nullity 'PGjson)

10831128arrayToJson = unsafeFunction "array_to_json"

10841129

10851130-- | Returns the row as a JSON object.

10861131rowToJson

1087− :: Expression schema relations grouping params (nullity ('PGcomposite ty))

1088− -> Expression schema relations grouping params (nullity 'PGjson)

1132+ :: Expression schema from grouping params (nullity ('PGcomposite ty))

1133+ -> Expression schema from grouping params (nullity 'PGjson)

10891134rowToJson = unsafeFunction "row_to_json"

10901135

10911136-- | Builds a possibly-heterogeneously-typed JSON array out of a variadic

10921137-- argument list.

10931138jsonBuildArray

10941139 :: SListI elems

1095− => NP (Expression schema relations grouping params) elems

1096− -> Expression schema relations grouping params (nullity 'PGjson)

1140+ => NP (Expression schema from grouping params) elems

1141+ -> Expression schema from grouping params (nullity 'PGjson)

10971142jsonBuildArray = unsafeVariadicFunction "json_build_array"

10981143

10991144-- | Builds a possibly-heterogeneously-typed (binary) JSON array out of a

11001145-- variadic argument list.

11011146jsonbBuildArray

11021147 :: SListI elems

1103− => NP (Expression schema relations grouping params) elems

1104− -> Expression schema relations grouping params (nullity 'PGjsonb)

1148+ => NP (Expression schema from grouping params) elems

1149+ -> Expression schema from grouping params (nullity 'PGjsonb)

11051150jsonbBuildArray = unsafeVariadicFunction "jsonb_build_array"

11061151

11071152unsafeRowFunction

11081153 :: All Top elems

1109− => NP (Aliased (Expression schema relations grouping params)) elems

1154+ => NP (Aliased (Expression schema from grouping params)) elems

11101155 -> [ByteString]

11111156unsafeRowFunction =

11121157 (`appEndo` []) . hcfoldMap (Proxy :: Proxy Top)

@@ -1118,8 +1163,8 @@ unsafeRowFunction =

11181163-- and values.

11191164jsonBuildObject

11201165 :: All Top elems

1121− => NP (Aliased (Expression schema relations grouping params)) elems

1122− -> Expression schema relations grouping params (nullity 'PGjson)

1166+ => NP (Aliased (Expression schema from grouping params)) elems

1167+ -> Expression schema from grouping params (nullity 'PGjson)

11231168jsonBuildObject

11241169 = unsafeFunction "json_build_object"

11251170 . UnsafeExpression

@@ -1131,8 +1176,8 @@ jsonBuildObject

11311176-- between text and values.

11321177jsonbBuildObject

11331178 :: All Top elems

1134− => NP (Aliased (Expression schema relations grouping params)) elems

1135− -> Expression schema relations grouping params (nullity 'PGjsonb)

1179+ => NP (Aliased (Expression schema from grouping params)) elems

1180+ -> Expression schema from grouping params (nullity 'PGjsonb)

11361181jsonbBuildObject

11371182 = unsafeFunction "jsonb_build_object"

11381183 . UnsafeExpression

@@ -1144,9 +1189,9 @@ jsonbBuildObject

11441189-- taken as alternating key/value pairs, or two dimensions such that each inner

11451190-- array has exactly two elements, which are taken as a key/value pair.

11461191jsonObject

1147− :: PGarrayOf "jsonObject" arr 'PGtext

1148− => Expression schema relations grouping params (nullity arr)

1149− -> Expression schema relations grouping params (nullity 'PGjson)

1192+ :: PGArrayOf "jsonObject" arr ('NotNull 'PGtext)

1193+ => Expression schema from grouping params (nullity arr)

1194+ -> Expression schema from grouping params (nullity 'PGjson)

11501195jsonObject = unsafeFunction "json_object"

11511196

11521197-- | Builds a binary JSON object out of a text array. The array must have either

@@ -1154,19 +1199,19 @@ jsonObject = unsafeFunction "json_object"

11541199-- taken as alternating key/value pairs, or two dimensions such that each inner

11551200-- array has exactly two elements, which are taken as a key/value pair.

11561201jsonbObject

1157− :: PGarrayOf "jsonbObject" arr 'PGtext

1158− => Expression schema relations grouping params (nullity arr)

1159− -> Expression schema relations grouping params (nullity 'PGjsonb)

1202+ :: PGArrayOf "jsonbObject" arr ('NotNull 'PGtext)

1203+ => Expression schema from grouping params (nullity arr)

1204+ -> Expression schema from grouping params (nullity 'PGjsonb)

11601205jsonbObject = unsafeFunction "jsonb_object"

11611206

11621207-- | This is an alternate form of 'jsonObject' that takes two arrays; one for

11631208-- keys and one for values, that are zipped pairwise to create a JSON object.

11641209jsonZipObject

1165− :: ( PGarrayOf "jsonZipObject" keysArray 'PGtext

1166− , PGarrayOf "jsonZipObject" valuesArray 'PGtext)

1167− => Expression schema relations grouping params (nullity keysArray)

1168− -> Expression schema relations grouping params (nullity valuesArray)

1169− -> Expression schema relations grouping params (nullity 'PGjson)

1210+ :: ( PGArrayOf "jsonZipObject" keysArray ('NotNull 'PGtext)

1211+ , PGArrayOf "jsonZipObject" valuesArray ('NotNull 'PGtext))

1212+ => Expression schema from grouping params (nullity keysArray)

1213+ -> Expression schema from grouping params (nullity valuesArray)

1214+ -> Expression schema from grouping params (nullity 'PGjson)

11701215jsonZipObject ks vs =

11711216 unsafeVariadicFunction "json_object" (ks :* vs :* Nil)

11721217

@@ -1174,11 +1219,11 @@ jsonZipObject ks vs =

11741219-- keys and one for values, that are zipped pairwise to create a binary JSON

11751220-- object.

11761221jsonbZipObject

1177− :: ( PGarrayOf "jsonbZipObject" keysArray 'PGtext

1178− , PGarrayOf "jsonbZipObject" valuesArray 'PGtext)

1179− => Expression schema relations grouping params (nullity keysArray)

1180− -> Expression schema relations grouping params (nullity valuesArray)

1181− -> Expression schema relations grouping params (nullity 'PGjsonb)

1222+ :: ( PGArrayOf "jsonbZipObject" keysArray ('NotNull 'PGtext)

1223+ , PGArrayOf "jsonbZipObject" valuesArray ('NotNull 'PGtext))

1224+ => Expression schema from grouping params (nullity keysArray)

1225+ -> Expression schema from grouping params (nullity valuesArray)

1226+ -> Expression schema from grouping params (nullity 'PGjsonb)

11821227jsonbZipObject ks vs =

11831228 unsafeVariadicFunction "jsonb_object" (ks :* vs :* Nil)

11841229

@@ -1188,23 +1233,23 @@ Table 9.46: JSON processing functions

11881233

11891234-- | Returns the number of elements in the outermost JSON array.

11901235jsonArrayLength

1191− :: Expression schema relations grouping params (nullity 'PGjson)

1192− -> Expression schema relations grouping params (nullity 'PGint4)

1236+ :: Expression schema from grouping params (nullity 'PGjson)

1237+ -> Expression schema from grouping params (nullity 'PGint4)

11931238jsonArrayLength = unsafeFunction "json_array_length"

11941239

11951240-- | Returns the number of elements in the outermost binary JSON array.

11961241jsonbArrayLength

1197− :: Expression schema relations grouping params (nullity 'PGjsonb)

1198− -> Expression schema relations grouping params (nullity 'PGint4)

1242+ :: Expression schema from grouping params (nullity 'PGjsonb)

1243+ -> Expression schema from grouping params (nullity 'PGint4)

11991244jsonbArrayLength = unsafeFunction "jsonb_array_length"

12001245

12011246-- | Returns JSON value pointed to by the given path (equivalent to #>

12021247-- operator).

12031248jsonExtractPath

12041249 :: SListI elems

1205− => Expression schema relations grouping params (nullity 'PGjson)

1206− -> NP (Expression schema relations grouping params) elems

1207− -> Expression schema relations grouping params (nullity 'PGjsonb)

1250+ => Expression schema from grouping params (nullity 'PGjson)

1251+ -> NP (Expression schema from grouping params) elems

1252+ -> Expression schema from grouping params (nullity 'PGjsonb)

12081253jsonExtractPath x xs =

12091254 unsafeVariadicFunction "json_extract_path" (x :* xs)

12101255

@@ -1212,9 +1257,9 @@ jsonExtractPath x xs =

12121257-- operator).

12131258jsonbExtractPath

12141259 :: SListI elems

1215− => Expression schema relations grouping params (nullity 'PGjsonb)

1216− -> NP (Expression schema relations grouping params) elems

1217− -> Expression schema relations grouping params (nullity 'PGjsonb)

1260+ => Expression schema from grouping params (nullity 'PGjsonb)

1261+ -> NP (Expression schema from grouping params) elems

1262+ -> Expression schema from grouping params (nullity 'PGjsonb)

12181263jsonbExtractPath x xs =

12191264 unsafeVariadicFunction "jsonb_extract_path" (x :* xs)

12201265

@@ -1222,9 +1267,9 @@ jsonbExtractPath x xs =

12221267-- operator), as text.

12231268jsonExtractPathAsText

12241269 :: SListI elems

1225− => Expression schema relations grouping params (nullity 'PGjson)

1226− -> NP (Expression schema relations grouping params) elems

1227− -> Expression schema relations grouping params (nullity 'PGjson)

1270+ => Expression schema from grouping params (nullity 'PGjson)

1271+ -> NP (Expression schema from grouping params) elems

1272+ -> Expression schema from grouping params (nullity 'PGjson)

12281273jsonExtractPathAsText x xs =

12291274 unsafeVariadicFunction "json_extract_path_text" (x :* xs)

12301275

@@ -1232,50 +1277,38 @@ jsonExtractPathAsText x xs =

12321277-- operator), as text.

12331278jsonbExtractPathAsText

12341279 :: SListI elems

1235− => Expression schema relations grouping params (nullity 'PGjsonb)

1236− -> NP (Expression schema relations grouping params) elems

1237− -> Expression schema relations grouping params (nullity 'PGjsonb)

1280+ => Expression schema from grouping params (nullity 'PGjsonb)

1281+ -> NP (Expression schema from grouping params) elems

1282+ -> Expression schema from grouping params (nullity 'PGjsonb)

12381283jsonbExtractPathAsText x xs =

12391284 unsafeVariadicFunction "jsonb_extract_path_text" (x :* xs)

12401285

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−

12531286-- | Returns the type of the outermost JSON value as a text string. Possible

12541287-- types are object, array, string, number, boolean, and null.

12551288jsonTypeof

1256− :: Expression schema relations grouping params (nullity 'PGjson)

1257− -> Expression schema relations grouping params (nullity 'PGtext)

1289+ :: Expression schema from grouping params (nullity 'PGjson)

1290+ -> Expression schema from grouping params (nullity 'PGtext)

12581291jsonTypeof = unsafeFunction "json_typeof"

12591292

12601293-- | Returns the type of the outermost binary JSON value as a text string.

12611294-- Possible types are object, array, string, number, boolean, and null.

12621295jsonbTypeof

1263− :: Expression schema relations grouping params (nullity 'PGjsonb)

1264− -> Expression schema relations grouping params (nullity 'PGtext)

1296+ :: Expression schema from grouping params (nullity 'PGjsonb)

1297+ -> Expression schema from grouping params (nullity 'PGtext)

12651298jsonbTypeof = unsafeFunction "jsonb_typeof"

12661299

12671300-- | Returns its argument with all object fields that have null values omitted.

12681301-- Other null values are untouched.

12691302jsonStripNulls

1270− :: Expression schema relations grouping params (nullity 'PGjson)

1271− -> Expression schema relations grouping params (nullity 'PGjson)

1303+ :: Expression schema from grouping params (nullity 'PGjson)

1304+ -> Expression schema from grouping params (nullity 'PGjson)

12721305jsonStripNulls = unsafeFunction "json_strip_nulls"

12731306

12741307-- | Returns its argument with all object fields that have null values omitted.

12751308-- Other null values are untouched.

12761309jsonbStripNulls

1277− :: Expression schema relations grouping params (nullity 'PGjsonb)

1278− -> Expression schema relations grouping params (nullity 'PGjsonb)

1310+ :: Expression schema from grouping params (nullity 'PGjsonb)

1311+ -> Expression schema from grouping params (nullity 'PGjsonb)

12791312jsonbStripNulls = unsafeFunction "jsonb_strip_nulls"

12801313

12811314-- | @ jsonbSet target path new_value create_missing @

@@ -1286,12 +1319,12 @@ jsonbStripNulls = unsafeFunction "jsonb_strip_nulls"

12861319-- operators, negative integers that appear in path count from the end of JSON

12871320-- arrays.

12881321jsonbSet

1289− :: PGtextArray "jsonbSet" arr

1290− => Expression schema relations grouping params (nullity 'PGjsonb)

1291− -> Expression schema relations grouping params (nullity arr)

1292− -> Expression schema relations grouping params (nullity 'PGjsonb)

1293− -> Maybe (Expression schema relations grouping params (nullity 'PGbool))

1294− -> Expression schema relations grouping params (nullity 'PGjsonb)

1322+ :: PGTextArray "jsonbSet" arr

1323+ => Expression schema from grouping params (nullity 'PGjsonb)

1324+ -> Expression schema from grouping params (nullity arr)

1325+ -> Expression schema from grouping params (nullity 'PGjsonb)

1326+ -> Maybe (Expression schema from grouping params (nullity 'PGbool))

1327+ -> Expression schema from grouping params (nullity 'PGjsonb)

12951328jsonbSet tgt path val createMissing = case createMissing of

12961329 Just m -> unsafeVariadicFunction "jsonb_set" (tgt :* path :* val :* m :* Nil)

12971330 Nothing -> unsafeVariadicFunction "jsonb_set" (tgt :* path :* val :* Nil)

@@ -1305,20 +1338,20 @@ jsonbSet tgt path val createMissing = case createMissing of

13051338-- exist. As with the path orientated operators, negative integers that appear

13061339-- in path count from the end of JSON arrays.

13071340jsonbInsert

1308− :: PGtextArray "jsonbInsert" arr

1309− => Expression schema relations grouping params (nullity 'PGjsonb)

1310− -> Expression schema relations grouping params (nullity arr)

1311− -> Expression schema relations grouping params (nullity 'PGjsonb)

1312− -> Maybe (Expression schema relations grouping params (nullity 'PGbool))

1313− -> Expression schema relations grouping params (nullity 'PGjsonb)

1341+ :: PGTextArray "jsonbInsert" arr

1342+ => Expression schema from grouping params (nullity 'PGjsonb)

1343+ -> Expression schema from grouping params (nullity arr)

1344+ -> Expression schema from grouping params (nullity 'PGjsonb)

1345+ -> Maybe (Expression schema from grouping params (nullity 'PGbool))

1346+ -> Expression schema from grouping params (nullity 'PGjsonb)

13141347jsonbInsert tgt path val insertAfter = case insertAfter of

13151348 Just i -> unsafeVariadicFunction "jsonb_insert" (tgt :* path :* val :* i :* Nil)

13161349 Nothing -> unsafeVariadicFunction "jsonb_insert" (tgt :* path :* val :* Nil)

13171350

13181351-- | Returns its argument as indented JSON text.

13191352jsonbPretty

1320− :: Expression schema relations grouping params (nullity 'PGjsonb)

1321− -> Expression schema relations grouping params (nullity 'PGtext)

1353+ :: Expression schema from grouping params (nullity 'PGjsonb)

1354+ -> Expression schema from grouping params (nullity 'PGtext)

13221355jsonbPretty = unsafeFunction "jsonb_pretty"

13231356

13241357{-----------------------------------------

@@ -1328,16 +1361,16 @@ aggregation

13281361-- | escape hatch to define aggregate functions

13291362unsafeAggregate

13301363 :: ByteString -- ^ aggregate function

1331− -> Expression schema relations 'Ungrouped params (xty)

1332− -> Expression schema relations ('Grouped bys) params (yty)

1364+ -> Expression schema from 'Ungrouped params (xty)

1365+ -> Expression schema from ('Grouped bys) params (yty)

13331366unsafeAggregate fun x = UnsafeExpression $ mconcat

13341367 [fun, "(", renderExpression x, ")"]

13351368

13361369-- | escape hatch to define aggregate functions over distinct values

13371370unsafeAggregateDistinct

13381371 :: ByteString -- ^ aggregate function

1339− -> Expression schema relations 'Ungrouped params (xty)

1340− -> Expression schema relations ('Grouped bys) params (yty)

1372+ -> Expression schema from 'Ungrouped params (xty)

1373+ -> Expression schema from ('Grouped bys) params (yty)

13411374unsafeAggregateDistinct fun x = UnsafeExpression $ mconcat

13421375 [fun, "(DISTINCT ", renderExpression x, ")"]

13431376

@@ -1349,10 +1382,10 @@ unsafeAggregateDistinct fun x = UnsafeExpression $ mconcat

13491382-- :}

13501383-- sum("col")

13511384sum_

1352− :: PGNum ty

1353− => Expression schema relations 'Ungrouped params (nullity ty)

1385+ :: ty `In` PGNum

1386+ => Expression schema from 'Ungrouped params (nullity ty)

13541387 -- ^ what to sum

1355− -> Expression schema relations ('Grouped bys) params (nullity ty)

1388+ -> Expression schema from ('Grouped bys) params (nullity ty)

13561389sum_ = unsafeAggregate "sum"

13571390

13581391-- | >>> :{

@@ -1363,19 +1396,19 @@ sum_ = unsafeAggregate "sum"

13631396-- :}

13641397-- sum(DISTINCT "col")

13651398sumDistinct

1366− :: PGNum ty

1367− => Expression schema relations 'Ungrouped params (nullity ty)

1399+ :: ty `In` PGNum

1400+ => Expression schema from 'Ungrouped params (nullity ty)

13681401 -- ^ what to sum

1369− -> Expression schema relations ('Grouped bys) params (nullity ty)

1402+ -> Expression schema from ('Grouped bys) params (nullity ty)

13701403sumDistinct = unsafeAggregateDistinct "sum"

13711404

13721405-- | A constraint for `PGType`s that you can take averages of and the resulting

13731406-- `PGType`.

13741407class PGAvg ty avg | ty -> avg where

13751408 avg, avgDistinct

1376− :: Expression schema relations 'Ungrouped params (nullity ty)

1409+ :: Expression schema from 'Ungrouped params (nullity ty)

13771410 -- ^ what to average

1378− -> Expression schema relations ('Grouped bys) params (nullity avg)

1411+ -> Expression schema from ('Grouped bys) params (nullity avg)

13791412 avg = unsafeAggregate "avg"

13801413 avgDistinct = unsafeAggregateDistinct "avg"

13811414instance PGAvg 'PGint2 'PGnumeric

@@ -1394,10 +1427,10 @@ instance PGAvg 'PGinterval 'PGinterval

13941427-- :}

13951428-- bit_and("col")

13961429bitAnd

1397− :: PGIntegral int

1398− => Expression schema relations 'Ungrouped params (nullity int)

1430+ :: int `In` PGIntegral

1431+ => Expression schema from 'Ungrouped params (nullity int)

13991432 -- ^ what to aggregate

1400− -> Expression schema relations ('Grouped bys) params (nullity int)

1433+ -> Expression schema from ('Grouped bys) params (nullity int)

14011434bitAnd = unsafeAggregate "bit_and"

14021435

14031436-- | >>> :{

@@ -1408,10 +1441,10 @@ bitAnd = unsafeAggregate "bit_and"

14081441-- :}

14091442-- bit_or("col")

14101443bitOr

1411− :: PGIntegral int

1412− => Expression schema relations 'Ungrouped params (nullity int)

1444+ :: int `In` PGIntegral

1445+ => Expression schema from 'Ungrouped params (nullity int)

14131446 -- ^ what to aggregate

1414− -> Expression schema relations ('Grouped bys) params (nullity int)

1447+ -> Expression schema from ('Grouped bys) params (nullity int)

14151448bitOr = unsafeAggregate "bit_or"

14161449

14171450-- | >>> :{

@@ -1422,10 +1455,10 @@ bitOr = unsafeAggregate "bit_or"

14221455-- :}

14231456-- bit_and(DISTINCT "col")

14241457bitAndDistinct

1425− :: PGIntegral int

1426− => Expression schema relations 'Ungrouped params (nullity int)

1458+ :: int `In` PGIntegral

1459+ => Expression schema from 'Ungrouped params (nullity int)

14271460 -- ^ what to aggregate

1428− -> Expression schema relations ('Grouped bys) params (nullity int)

1461+ -> Expression schema from ('Grouped bys) params (nullity int)

14291462bitAndDistinct = unsafeAggregateDistinct "bit_and"

14301463

14311464-- | >>> :{

@@ -1436,10 +1469,10 @@ bitAndDistinct = unsafeAggregateDistinct "bit_and"

14361469-- :}

14371470-- bit_or(DISTINCT "col")

14381471bitOrDistinct

1439− :: PGIntegral int

1440− => Expression schema relations 'Ungrouped params (nullity int)

1472+ :: int `In` PGIntegral

1473+ => Expression schema from 'Ungrouped params (nullity int)

14411474 -- ^ what to aggregate

1442− -> Expression schema relations ('Grouped bys) params (nullity int)

1475+ -> Expression schema from ('Grouped bys) params (nullity int)

14431476bitOrDistinct = unsafeAggregateDistinct "bit_or"

14441477

14451478-- | >>> :{

@@ -1450,9 +1483,9 @@ bitOrDistinct = unsafeAggregateDistinct "bit_or"

14501483-- :}

14511484-- bool_and("col")

14521485boolAnd

1453− :: Expression schema relations 'Ungrouped params (nullity 'PGbool)

1486+ :: Expression schema from 'Ungrouped params (nullity 'PGbool)

14541487 -- ^ what to aggregate

1455− -> Expression schema relations ('Grouped bys) params (nullity 'PGbool)

1488+ -> Expression schema from ('Grouped bys) params (nullity 'PGbool)

14561489boolAnd = unsafeAggregate "bool_and"

14571490

14581491-- | >>> :{

@@ -1463,9 +1496,9 @@ boolAnd = unsafeAggregate "bool_and"

14631496-- :}

14641497-- bool_or("col")

14651498boolOr

1466− :: Expression schema relations 'Ungrouped params (nullity 'PGbool)

1499+ :: Expression schema from 'Ungrouped params (nullity 'PGbool)

14671500 -- ^ what to aggregate

1468− -> Expression schema relations ('Grouped bys) params (nullity 'PGbool)

1501+ -> Expression schema from ('Grouped bys) params (nullity 'PGbool)

14691502boolOr = unsafeAggregate "bool_or"

14701503

14711504-- | >>> :{

@@ -1476,9 +1509,9 @@ boolOr = unsafeAggregate "bool_or"

14761509-- :}

14771510-- bool_and(DISTINCT "col")

14781511boolAndDistinct

1479− :: Expression schema relations 'Ungrouped params (nullity 'PGbool)

1512+ :: Expression schema from 'Ungrouped params (nullity 'PGbool)

14801513 -- ^ what to aggregate

1481− -> Expression schema relations ('Grouped bys) params (nullity 'PGbool)

1514+ -> Expression schema from ('Grouped bys) params (nullity 'PGbool)

14821515boolAndDistinct = unsafeAggregateDistinct "bool_and"

14831516

14841517-- | >>> :{

@@ -1489,9 +1522,9 @@ boolAndDistinct = unsafeAggregateDistinct "bool_and"

14891522-- :}

14901523-- bool_or(DISTINCT "col")

14911524boolOrDistinct

1492− :: Expression schema relations 'Ungrouped params (nullity 'PGbool)

1525+ :: Expression schema from 'Ungrouped params (nullity 'PGbool)

14931526 -- ^ what to aggregate

1494− -> Expression schema relations ('Grouped bys) params (nullity 'PGbool)

1527+ -> Expression schema from ('Grouped bys) params (nullity 'PGbool)

14951528boolOrDistinct = unsafeAggregateDistinct "bool_or"

14961529

14971530-- | A special aggregation that does not require an input

@@ -1499,7 +1532,7 @@ boolOrDistinct = unsafeAggregateDistinct "bool_or"

14991532-- >>> printSQL countStar

15001533-- count(*)

15011534countStar

1502− :: Expression schema relations ('Grouped bys) params ('NotNull 'PGint8)

1535+ :: Expression schema from ('Grouped bys) params ('NotNull 'PGint8)

15031536countStar = UnsafeExpression $ "count(*)"

15041537

15051538-- | >>> :{

@@ -1510,9 +1543,9 @@ countStar = UnsafeExpression $ "count(*)"

15101543-- :}

15111544-- count("col")

15121545count

1513− :: Expression schema relations 'Ungrouped params ty

1546+ :: Expression schema from 'Ungrouped params ty

15141547 -- ^ what to count

1515− -> Expression schema relations ('Grouped bys) params ('NotNull 'PGint8)

1548+ -> Expression schema from ('Grouped bys) params ('NotNull 'PGint8)

15161549count = unsafeAggregate "count"

15171550

15181551-- | >>> :{

@@ -1523,9 +1556,9 @@ count = unsafeAggregate "count"

15231556-- :}

15241557-- count(DISTINCT "col")

15251558countDistinct

1526− :: Expression schema relations 'Ungrouped params ty

1559+ :: Expression schema from 'Ungrouped params ty

15271560 -- ^ what to count

1528− -> Expression schema relations ('Grouped bys) params ('NotNull 'PGint8)

1561+ -> Expression schema from ('Grouped bys) params ('NotNull 'PGint8)

15291562countDistinct = unsafeAggregateDistinct "count"

15301563

15311564-- | synonym for `boolAnd`

@@ -1538,9 +1571,9 @@ countDistinct = unsafeAggregateDistinct "count"

15381571-- :}

15391572-- every("col")

15401573every

1541− :: Expression schema relations 'Ungrouped params (nullity 'PGbool)

1574+ :: Expression schema from 'Ungrouped params (nullity 'PGbool)

15421575 -- ^ what to aggregate

1543− -> Expression schema relations ('Grouped bys) params (nullity 'PGbool)

1576+ -> Expression schema from ('Grouped bys) params (nullity 'PGbool)

15441577every = unsafeAggregate "every"

15451578

15461579-- | synonym for `boolAndDistinct`

@@ -1553,16 +1586,16 @@ every = unsafeAggregate "every"

15531586-- :}

15541587-- every(DISTINCT "col")

15551588everyDistinct

1556− :: Expression schema relations 'Ungrouped params (nullity 'PGbool)

1589+ :: Expression schema from 'Ungrouped params (nullity 'PGbool)

15571590 -- ^ what to aggregate

1558− -> Expression schema relations ('Grouped bys) params (nullity 'PGbool)

1591+ -> Expression schema from ('Grouped bys) params (nullity 'PGbool)

15591592everyDistinct = unsafeAggregateDistinct "every"

15601593

15611594-- | minimum and maximum aggregation

15621595max_, min_, maxDistinct, minDistinct

1563− :: Expression schema relations 'Ungrouped params (nullity ty)

1596+ :: Expression schema from 'Ungrouped params (nullity ty)

15641597 -- ^ what to aggregate

1565− -> Expression schema relations ('Grouped bys) params (nullity ty)

1598+ -> Expression schema from ('Grouped bys) params (nullity ty)

15661599max_ = unsafeAggregate "max"

15671600min_ = unsafeAggregate "min"

15681601maxDistinct = unsafeAggregateDistinct "max"

@@ -1573,134 +1606,153 @@ type expressions

15731606-----------------------------------------}

15741607

15751608-- | `TypeExpression`s are used in `cast`s and `createTable` commands.

1576−newtype TypeExpression (schema :: SchemaType) (ty :: PGType)

1609+newtype TypeExpression (schema :: SchemaType) (ty :: NullityType)

15771610 = UnsafeTypeExpression { renderTypeExpression :: ByteString }

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

15791612

1580−instance (Has alias schema ('Typedef ty))

1581− => IsLabel alias (TypeExpression schema ty) where

1582− fromLabel = UnsafeTypeExpression (renderAlias (fromLabel @alias))

1613+-- | The enum or composite type in a `Typedef` can be expressed by its alias.

1614+typedef

1615+ :: Has alias schema ('Typedef ty)

1616+ => Alias alias

1617+ -> TypeExpression schema (nullity ty)

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

15831635

15841636-- | logical Boolean (true/false)

1585−bool :: TypeExpression schema 'PGbool

1637+bool :: TypeExpression schema (nullity 'PGbool)

15861638bool = UnsafeTypeExpression "bool"

15871639-- | signed two-byte integer

1588−int2, smallint :: TypeExpression schema 'PGint2

1640+int2, smallint :: TypeExpression schema (nullity 'PGint2)

15891641int2 = UnsafeTypeExpression "int2"

15901642smallint = UnsafeTypeExpression "smallint"

15911643-- | signed four-byte integer

1592−int4, int, integer :: TypeExpression schema 'PGint4

1644+int4, int, integer :: TypeExpression schema (nullity 'PGint4)

15931645int4 = UnsafeTypeExpression "int4"

15941646int = UnsafeTypeExpression "int"

15951647integer = UnsafeTypeExpression "integer"

15961648-- | signed eight-byte integer

1597−int8, bigint :: TypeExpression schema 'PGint8

1649+int8, bigint :: TypeExpression schema (nullity 'PGint8)

15981650int8 = UnsafeTypeExpression "int8"

15991651bigint = UnsafeTypeExpression "bigint"

16001652-- | arbitrary precision numeric type

1601−numeric :: TypeExpression schema 'PGnumeric

1653+numeric :: TypeExpression schema (nullity 'PGnumeric)

16021654numeric = UnsafeTypeExpression "numeric"

16031655-- | single precision floating-point number (4 bytes)

1604−float4, real :: TypeExpression schema 'PGfloat4

1656+float4, real :: TypeExpression schema (nullity 'PGfloat4)

16051657float4 = UnsafeTypeExpression "float4"

16061658real = UnsafeTypeExpression "real"

16071659-- | double precision floating-point number (8 bytes)

1608−float8, doublePrecision :: TypeExpression schema 'PGfloat8

1660+float8, doublePrecision :: TypeExpression schema (nullity 'PGfloat8)

16091661float8 = UnsafeTypeExpression "float8"

16101662doublePrecision = UnsafeTypeExpression "double precision"

16111663-- | variable-length character string

1612−text :: TypeExpression schema 'PGtext

1664+text :: TypeExpression schema (nullity 'PGtext)

16131665text = UnsafeTypeExpression "text"

16141666-- | fixed-length character string

16151667char, character

1616− :: (KnownNat n, 1 <= n)

1617− => proxy n

1618− -> TypeExpression schema ('PGchar n)

1619−char p = UnsafeTypeExpression $ "char(" <> renderNat p <> ")"

1620−character p = UnsafeTypeExpression $ "character(" <> renderNat p <> ")"

1668+ :: forall n schema nullity. (KnownNat n, 1 <= n)

1669+ => TypeExpression schema (nullity ('PGchar n))

1670+char = UnsafeTypeExpression $ "char(" <> renderNat @n <> ")"

1671+character = UnsafeTypeExpression $ "character(" <> renderNat @n <> ")"

16211672-- | variable-length character string

16221673varchar, characterVarying

1623− :: (KnownNat n, 1 <= n)

1624− => proxy n

1625− -> TypeExpression schema ('PGvarchar n)

1626−varchar p = UnsafeTypeExpression $ "varchar(" <> renderNat p <> ")"

1627−characterVarying p = UnsafeTypeExpression $

1628− "character varying(" <> renderNat p <> ")"

1674+ :: forall n schema nullity. (KnownNat n, 1 <= n)

1675+ => TypeExpression schema (nullity ('PGvarchar n))

1676+varchar = UnsafeTypeExpression $ "varchar(" <> renderNat @n <> ")"

1677+characterVarying = UnsafeTypeExpression $

1678+ "character varying(" <> renderNat @n <> ")"

16291679-- | binary data ("byte array")

1630−bytea :: TypeExpression schema 'PGbytea

1680+bytea :: TypeExpression schema (nullity 'PGbytea)

16311681bytea = UnsafeTypeExpression "bytea"

16321682-- | date and time (no time zone)

1633−timestamp :: TypeExpression schema 'PGtimestamp

1683+timestamp :: TypeExpression schema (nullity 'PGtimestamp)

16341684timestamp = UnsafeTypeExpression "timestamp"

16351685-- | date and time, including time zone

1636−timestampWithTimeZone :: TypeExpression schema 'PGtimestamptz

1686+timestampWithTimeZone :: TypeExpression schema (nullity 'PGtimestamptz)

16371687timestampWithTimeZone = UnsafeTypeExpression "timestamp with time zone"

16381688-- | calendar date (year, month, day)

1639−date :: TypeExpression schema 'PGdate

1689+date :: TypeExpression schema (nullity 'PGdate)

16401690date = UnsafeTypeExpression "date"

16411691-- | time of day (no time zone)

1642−time :: TypeExpression schema 'PGtime

1692+time :: TypeExpression schema (nullity 'PGtime)

16431693time = UnsafeTypeExpression "time"

16441694-- | time of day, including time zone

1645−timeWithTimeZone :: TypeExpression schema 'PGtimetz

1695+timeWithTimeZone :: TypeExpression schema (nullity 'PGtimetz)

16461696timeWithTimeZone = UnsafeTypeExpression "time with time zone"

16471697-- | time span

1648−interval :: TypeExpression schema 'PGinterval

1698+interval :: TypeExpression schema (nullity 'PGinterval)

16491699interval = UnsafeTypeExpression "interval"

16501700-- | universally unique identifier

1651−uuid :: TypeExpression schema 'PGuuid

1701+uuid :: TypeExpression schema (nullity 'PGuuid)

16521702uuid = UnsafeTypeExpression "uuid"

16531703-- | IPv4 or IPv6 host address

1654−inet :: TypeExpression schema 'PGinet

1704+inet :: TypeExpression schema (nullity 'PGinet)

16551705inet = UnsafeTypeExpression "inet"

16561706-- | textual JSON data

1657−json :: TypeExpression schema 'PGjson

1707+json :: TypeExpression schema (nullity 'PGjson)

16581708json = UnsafeTypeExpression "json"

16591709-- | binary JSON data, decomposed

1660−jsonb :: TypeExpression schema 'PGjsonb

1710+jsonb :: TypeExpression schema (nullity 'PGjsonb)

16611711jsonb = UnsafeTypeExpression "jsonb"

16621712-- | variable length array

16631713vararray

16641714 :: TypeExpression schema pg

1665− -> TypeExpression schema ('PGvararray pg)

1715+ -> TypeExpression schema (nullity ('PGvararray pg))

16661716vararray ty = UnsafeTypeExpression $ renderTypeExpression ty <> "[]"

16671717-- | fixed length array

16681718--

1669−-- >>> renderTypeExpression (fixarray (Proxy @2) json)

1719+-- >>> renderTypeExpression (fixarray @2 json)

16701720-- "json[2]"

16711721fixarray

1672− :: KnownNat n

1673− => proxy n

1674− -> TypeExpression schema pg

1675− -> TypeExpression schema ('PGfixarray n pg)

1676−fixarray p ty = UnsafeTypeExpression $

1677− renderTypeExpression ty <> "[" <> renderNat p <> "]"

1722+ :: forall n schema nullity pg. KnownNat n

1723+ => TypeExpression schema pg

1724+ -> TypeExpression schema (nullity ('PGfixarray n pg))

1725+fixarray ty = UnsafeTypeExpression $

1726+ renderTypeExpression ty <> "[" <> renderNat @n <> "]"

16781727

16791728-- | `pgtype` is a demoted version of a `PGType`

1680−class PGTyped schema (ty :: PGType) where pgtype :: TypeExpression schema ty

1681−instance PGTyped schema 'PGbool where pgtype = bool

1682−instance PGTyped schema 'PGint2 where pgtype = int2

1683−instance PGTyped schema 'PGint4 where pgtype = int4

1684−instance PGTyped schema 'PGint8 where pgtype = int8

1685−instance PGTyped schema 'PGnumeric where pgtype = numeric

1686−instance PGTyped schema 'PGfloat4 where pgtype = float4

1687−instance PGTyped schema 'PGfloat8 where pgtype = float8

1688−instance PGTyped schema 'PGtext where pgtype = text

1729+class PGTyped schema (ty :: NullityType) where

1730+ pgtype :: TypeExpression schema ty

1731+instance PGTyped schema (nullity 'PGbool) where pgtype = bool

1732+instance PGTyped schema (nullity 'PGint2) where pgtype = int2

1733+instance PGTyped schema (nullity 'PGint4) where pgtype = int4

1734+instance PGTyped schema (nullity 'PGint8) where pgtype = int8

1735+instance PGTyped schema (nullity 'PGnumeric) where pgtype = numeric

1736+instance PGTyped schema (nullity 'PGfloat4) where pgtype = float4

1737+instance PGTyped schema (nullity 'PGfloat8) where pgtype = float8

1738+instance PGTyped schema (nullity 'PGtext) where pgtype = text

16891739instance (KnownNat n, 1 <= n)

1690− => PGTyped schema ('PGchar n) where pgtype = char (Proxy @n)

1740+ => PGTyped schema (nullity ('PGchar n)) where pgtype = char @n

16911741instance (KnownNat n, 1 <= n)

1692− => PGTyped schema ('PGvarchar n) where pgtype = varchar (Proxy @n)

1693−instance PGTyped schema 'PGbytea where pgtype = bytea

1694−instance PGTyped schema 'PGtimestamp where pgtype = timestamp

1695−instance PGTyped schema 'PGtimestamptz where pgtype = timestampWithTimeZone

1696−instance PGTyped schema 'PGdate where pgtype = date

1697−instance PGTyped schema 'PGtime where pgtype = time

1698−instance PGTyped schema 'PGtimetz where pgtype = timeWithTimeZone

1699−instance PGTyped schema 'PGinterval where pgtype = interval

1700−instance PGTyped schema 'PGuuid where pgtype = uuid

1701−instance PGTyped schema 'PGjson where pgtype = json

1702−instance PGTyped schema 'PGjsonb where pgtype = jsonb

1703−instance PGTyped schema ty => PGTyped schema ('PGvararray ty) where

1704− pgtype = vararray (pgtype @schema @ty)

1705−instance (KnownNat n, PGTyped schema ty) => PGTyped schema ('PGfixarray n ty) where

1706− pgtype = fixarray (Proxy @n) (pgtype @schema @ty)

1742+ => PGTyped schema (nullity ('PGvarchar n)) where pgtype = varchar @n

1743+instance PGTyped schema (nullity 'PGbytea) where pgtype = bytea

1744+instance PGTyped schema (nullity 'PGtimestamp) where pgtype = timestamp

1745+instance PGTyped schema (nullity 'PGtimestamptz) where pgtype = timestampWithTimeZone

1746+instance PGTyped schema (nullity 'PGdate) where pgtype = date

1747+instance PGTyped schema (nullity 'PGtime) where pgtype = time

1748+instance PGTyped schema (nullity 'PGtimetz) where pgtype = timeWithTimeZone

1749+instance PGTyped schema (nullity 'PGinterval) where pgtype = interval

1750+instance PGTyped schema (nullity 'PGuuid) where pgtype = uuid

1751+instance PGTyped schema (nullity 'PGjson) where pgtype = json

1752+instance PGTyped schema (nullity 'PGjsonb) where pgtype = jsonb

1753+instance PGTyped schema ty

1754+ => PGTyped schema (nullity ('PGvararray ty)) where

1755+ pgtype = vararray (pgtype @schema @ty)

1756+instance (KnownNat n, PGTyped schema ty)

1757+ => PGTyped schema (nullity ('PGfixarray n ty)) where

1758+ pgtype = fixarray @n (pgtype @schema @ty)

squeal-postgresql/src/Squeal/PostgreSQL/Manipulation.hs+66−74

@@ -42,13 +42,10 @@ module Squeal.PostgreSQL.Manipulation

4242 -- * Delete

4343 , deleteFrom

4444 , deleteFrom_

45− -- * With

46− , with

4745 ) where

4846

4947import Control.DeepSeq

5048import Data.ByteString hiding (foldr)

51−import Data.Monoid

5249

5350import qualified Generics.SOP as SOP

5451import qualified GHC.Generics as GHC

@@ -180,16 +177,38 @@ let

180177in printSQL manipulation

181178:}

182179DELETE 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"

183197-}

198+

184199newtype Manipulation

185200 (schema :: SchemaType)

186201 (params :: [NullityType])

187− (columns :: RelationType)

202+ (columns :: RowType)

188203 = UnsafeManipulation { renderManipulation :: ByteString }

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

190−

191205instance RenderSQL (Manipulation schema params columns) where

192206 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

193212

194213-- | Convert a `Query` into a `Manipulation`.

195214queryStatement

@@ -212,13 +231,14 @@ insertRows

212231 :: ( SOP.SListI columns

213232 , SOP.SListI results

214233 , Has tab schema ('Table table)

234+ , row ~ TableToRow table

215235 , columns ~ TableToColumns table )

216236 => Alias tab -- ^ table to insert into

217237 -> NP (Aliased (ColumnValue schema '[] params)) columns -- ^ row to insert

218238 -> [NP (Aliased (ColumnValue schema '[] params)) columns] -- ^ more rows to insert

219− -> ConflictClause schema columns params

239+ -> ConflictClause schema table params

220240 -- ^ 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

222242 -> Manipulation schema params results

223243insertRows tab rw rws conflict returning = UnsafeManipulation $

224244 "INSERT" <+> "INTO" <+> renderAlias tab

@@ -242,12 +262,13 @@ insertRow

242262 :: ( SOP.SListI columns

243263 , SOP.SListI results

244264 , Has tab schema ('Table table)

265+ , row ~ TableToRow table

245266 , columns ~ TableToColumns table )

246267 => Alias tab -- ^ table to insert into

247268 -> NP (Aliased (ColumnValue schema '[] params)) columns -- ^ row to insert

248− -> ConflictClause schema columns params

269+ -> ConflictClause schema table params

249270 -- ^ 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

251272 -> Manipulation schema params results

252273insertRow tab rw = insertRows tab rw []

253274

@@ -278,12 +299,13 @@ insertQuery

278299 :: ( SOP.SListI columns

279300 , SOP.SListI results

280301 , Has tab schema ('Table table)

302+ , row ~ TableToRow table

281303 , columns ~ TableToColumns table )

282304 => Alias tab -- ^ table to insert into

283− -> Query schema params (ColumnsToRelation columns)

284− -> ConflictClause schema columns params

305+ -> Query schema params (TableToRow table)

306+ -> ConflictClause schema table params

285307 -- ^ 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

287309 -> Manipulation schema params results

288310insertQuery tab query conflict returning = UnsafeManipulation $

289311 "INSERT" <+> "INTO" <+> renderAlias tab

@@ -297,7 +319,7 @@ insertQuery_

297319 , Has tab schema ('Table table)

298320 , columns ~ TableToColumns table )

299321 => Alias tab -- ^ table to insert into

300− -> Query schema params (ColumnsToRelation columns)

322+ -> Query schema params (TableToRow table)

301323 -> Manipulation schema params '[]

302324insertQuery_ tab query =

303325 insertQuery tab query OnConflictDoRaise (Returning Nil)

@@ -309,7 +331,7 @@ insertQuery_ tab query =

309331-- existing value in the row for an update.

310332data ColumnValue

311333 (schema :: SchemaType)

312− (columns :: RelationType)

334+ (columns :: RowType)

313335 (params :: [NullityType])

314336 (ty :: ColumnType)

315337 where

@@ -331,17 +353,15 @@ data ColumnValue

331353-- values are desired.

332354data ReturningClause

333355 (schema :: SchemaType)

334− (columns :: ColumnsType)

335356 (params :: [NullityType])

336− (results :: RelationType)

357+ (row0 :: RowType)

358+ (row1 :: RowType)

337359 where

338360 ReturningStar

339− :: results ~ ColumnsToRelation columns

340− => ReturningClause schema columns params results

361+ :: ReturningClause schema params row row

341362 Returning

342− :: rel ~ ColumnsToRelation columns

343− => NP (Aliased (Expression schema '[table ::: rel] 'Ungrouped params)) results

344− -> ReturningClause schema columns params results

363+ :: NP (Aliased (Expression schema '[table ::: row0] 'Ungrouped params)) row1

364+ -> ReturningClause schema params row0 row1

345365

346366-- | Render a `ReturningClause`.

347367renderReturningClause

@@ -359,18 +379,22 @@ renderReturningClause = \case

359379-- `OnConflictDoNothing` simply avoids inserting a row.

360380-- `OnConflictDoUpdate` updates the existing row that conflicts with the row

361381-- proposed for insertion.

362−data ConflictClause (schema :: SchemaType) (columns :: ColumnsType) params where

363− OnConflictDoRaise :: ConflictClause schema columns params

364− OnConflictDoNothing :: ConflictClause schema columns params

365− OnConflictDoUpdate

366− :: NP (Aliased (ColumnValue schema (ColumnsToRelation columns) params)) columns

367− -> [Condition schema '[table ::: ColumnsToRelation columns] 'Ungrouped params]

368− -> ConflictClause schema columns params

382+data ConflictClause

383+ (schema :: SchemaType)

384+ (table :: TableType)

385+ (params :: [NullityType]) where

386+ OnConflictDoRaise :: ConflictClause schema table params

387+ OnConflictDoNothing :: ConflictClause schema table params

388+ OnConflictDoUpdate

389+ :: (row ~ TableToRow table, columns ~ TableToColumns table)

390+ => NP (Aliased (ColumnValue schema row params)) columns

391+ -> [Condition schema '[t ::: row] 'Ungrouped params]

392+ -> ConflictClause schema table params

369393

370394-- | Render a `ConflictClause`.

371395renderConflictClause

372− :: SOP.SListI columns

373− => ConflictClause schema columns params

396+ :: SOP.SListI (TableToColumns table)

397+ => ConflictClause schema table params

374398 -> ByteString

375399renderConflictClause = \case

376400 OnConflictDoRaise -> ""

@@ -402,13 +426,14 @@ update

402426 :: ( SOP.SListI columns

403427 , SOP.SListI results

404428 , Has tab schema ('Table table)

429+ , row ~ TableToRow table

405430 , columns ~ TableToColumns table )

406431 => Alias tab -- ^ table to update

407− -> NP (Aliased (ColumnValue schema (ColumnsToRelation columns) params)) columns

432+ -> NP (Aliased (ColumnValue schema row params)) columns

408433 -- ^ modified values to replace old values

409− -> Condition schema '[tab ::: ColumnsToRelation columns] 'Ungrouped params

434+ -> (forall t. Condition schema '[t ::: row] 'Ungrouped params)

410435 -- ^ 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

412437 -> Manipulation schema params results

413438update tab columns wh returning = UnsafeManipulation $

414439 "UPDATE"

@@ -432,11 +457,12 @@ update tab columns wh returning = UnsafeManipulation $

432457update_

433458 :: ( SOP.SListI columns

434459 , Has tab schema ('Table table)

460+ , row ~ TableToRow table

435461 , columns ~ TableToColumns table )

436462 => Alias tab -- ^ table to update

437− -> NP (Aliased (ColumnValue schema (ColumnsToRelation columns) params)) columns

463+ -> NP (Aliased (ColumnValue schema row params)) columns

438464 -- ^ modified values to replace old values

439− -> Condition schema '[tab ::: ColumnsToRelation columns] 'Ungrouped params

465+ -> (forall t. Condition schema '[t ::: row] 'Ungrouped params)

440466 -- ^ condition under which to perform update on a row

441467 -> Manipulation schema params '[]

442468update_ tab columns wh = update tab columns wh (Returning Nil)

@@ -449,11 +475,12 @@ DELETE statements

449475deleteFrom

450476 :: ( SOP.SListI results

451477 , Has tab schema ('Table table)

478+ , row ~ TableToRow table

452479 , columns ~ TableToColumns table )

453480 => Alias tab -- ^ table to delete from

454− -> Condition schema '[tab ::: ColumnsToRelation columns] 'Ungrouped params

481+ -> Condition schema '[tab ::: row] 'Ungrouped params

455482 -- ^ 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

457484 -> Manipulation schema params results

458485deleteFrom tab wh returning = UnsafeManipulation $

459486 "DELETE FROM" <+> renderAlias tab

@@ -463,45 +490,10 @@ deleteFrom tab wh returning = UnsafeManipulation $

463490-- | Delete rows returning `Nil`.

464491deleteFrom_

465492 :: ( Has tab schema ('Table table)

493+ , row ~ TableToRow table

466494 , columns ~ TableToColumns table )

467495 => Alias tab -- ^ table to delete from

468− -> Condition schema '[tab ::: ColumnsToRelation columns] 'Ungrouped params

496+ -> (forall t. Condition schema '[t ::: row] 'Ungrouped params)

469497 -- ^ condition under which to delete a row

470498 -> Manipulation schema params '[]

471499deleteFrom_ 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

105105 Migration (..)

106106 , migrateUp

107107 , migrateDown

108− -- * Aligned lists

109− , AlignedList (..)

110− , single

111108 -- * Migration table

112109 , MigrationsTable

113110 , createMigrations

@@ -116,15 +113,12 @@ module Squeal.PostgreSQL.Migration

116113 , selectMigration

117114 ) where

118115

119−import Control.Category

120116import Control.Monad

121117import Control.Monad.Base

122118import Control.Monad.Trans.Control

123−import Data.Monoid

124119import Generics.SOP (K(..))

125120import Data.Function ((&))

126121import Data.Text (Text)

127−import Prelude hiding (id, (.))

128122

129123import Squeal.PostgreSQL

130124

@@ -137,21 +131,6 @@ data Migration io schema0 schema1 = Migration

137131 , down :: PQ schema1 schema0 io () -- ^ The `down` instruction of a `Migration`.

138132 }

139133

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−

155134-- | Run `Migration`s by creating the `MigrationsTable`

156135-- if it does not exist and then in a transaction, for each each `Migration`

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

5050 , MonadPQ (..)

5151 , PQRun

5252 , pqliftWith

53− -- * Result

53+ -- * Results

5454 , LibPQ.Result

5555 , LibPQ.Row

5656 , ntuples

@@ -62,6 +62,11 @@ module Squeal.PostgreSQL.PQ

6262 , LibPQ.ExecStatus (..)

6363 , resultStatus

6464 , resultErrorMessage

65+ , resultErrorCode

66+ -- * Exceptions

67+ , SquealException (..)

68+ , catchSqueal

69+ , handleSqueal

6570 ) where

6671

6772import Control.Exception.Lifted

@@ -73,9 +78,10 @@ import Data.ByteString (ByteString)

7378import Data.Foldable

7479import Data.Function ((&))

7580import Data.Kind

76−import Data.Monoid

81+import Data.Text (pack, Text)

7782import Data.Traversable

7883import Generics.SOP

84+import PostgreSQL.Binary.Encoding (encodingBytes)

7985

8086import qualified Database.PostgreSQL.LibPQ as LibPQ

8187

@@ -90,7 +96,6 @@ import Control.Monad.Trans.Identity

9096import Control.Monad.Trans.Reader

9197import Control.Monad.Trans.Maybe

9298import Control.Monad.Trans.Cont

93−import Control.Monad.Trans.List

9499

95100import qualified Control.Monad.Trans.State.Lazy as Lazy

96101import qualified Control.Monad.Trans.State.Strict as Strict

@@ -269,7 +274,7 @@ instance IndexedMonadTransPQ PQ where

269274 define (UnsafeDefinition q) = PQ $ \ (K conn) -> do

270275 resultMaybe <- liftBase $ LibPQ.exec conn q

271276 case resultMaybe of

272− Nothing -> error

277+ Nothing -> throw $ ResultException

273278 "define: LibPQ.exec returned no results"

274279 Just result -> return $ K (K result)

275280

@@ -393,14 +398,17 @@ instance (MonadBase IO io, schema0 ~ schema, schema1 ~ schema)

393398 (UnsafeManipulation q :: Manipulation schema ps ys) (params :: x) =

394399 PQ $ \ (K conn) -> do

395400 let

396− toParam' bytes = (LibPQ.invalidOid,bytes,LibPQ.Binary)

401+ toParam' encoding =

402+ (LibPQ.invalidOid, encodingBytes encoding, LibPQ.Binary)

397403 params' = fmap (fmap toParam') (hcollapse (toParams @x @ps params))

398404 q' = q <> ";"

399405 resultMaybe <- liftBase $ LibPQ.execParams conn q' params' LibPQ.Binary

400406 case resultMaybe of

401− Nothing -> error

407+ Nothing -> throw $ ResultException

402408 "manipulateParams: LibPQ.execParams returned no results"

403− Just result -> return $ K (K result)

409+ Just result -> do

410+ tryResult result

411+ return $ K (K result)

404412

405413 traversePrepared

406414 (UnsafeManipulation q :: Manipulation schema xs ys) (list :: list x) =

@@ -408,29 +416,25 @@ instance (MonadBase IO io, schema0 ~ schema, schema1 ~ schema)

408416 let temp = "temporary_statement"

409417 prepResultMaybe <- LibPQ.prepare conn temp q Nothing

410418 case prepResultMaybe of

411− Nothing -> error

419+ Nothing -> throw $ ResultException

412420 "traversePrepared: LibPQ.prepare returned no results"

413− Just prepResult -> do

414− status <- LibPQ.resultStatus prepResult

415− unless (status == LibPQ.CommandOk) . error $

416− "traversePrepared: LibPQ.prepare status " <> show status

421+ Just prepResult -> tryResult prepResult

417422 results <- for list $ \ params -> do

418423 let

419− toParam' bytes = (bytes,LibPQ.Binary)

424+ toParam' encoding = (encodingBytes encoding,LibPQ.Binary)

420425 params' = fmap (fmap toParam') (hcollapse (toParams @x @xs params))

421426 resultMaybe <- LibPQ.execPrepared conn temp params' LibPQ.Binary

422427 case resultMaybe of

423− Nothing -> error

428+ Nothing -> throw $ ResultException

424429 "traversePrepared: LibPQ.execParams returned no results"

425− Just result -> return $ K result

430+ Just result -> do

431+ tryResult result

432+ return $ K result

426433 deallocResultMaybe <- LibPQ.exec conn ("DEALLOCATE " <> temp <> ";")

427434 case deallocResultMaybe of

428− Nothing -> error

435+ Nothing -> throw $ ResultException

429436 "traversePrepared: LibPQ.exec DEALLOCATE returned no results"

430− Just deallocResult -> do

431− status <- LibPQ.resultStatus deallocResult

432− unless (status == LibPQ.CommandOk) . error $

433− "traversePrepared: DEALLOCATE status " <> show status

437+ Just deallocResult -> tryResult deallocResult

434438 return (K results)

435439

436440 traversePrepared_

@@ -439,29 +443,23 @@ instance (MonadBase IO io, schema0 ~ schema, schema1 ~ schema)

439443 let temp = "temporary_statement"

440444 prepResultMaybe <- LibPQ.prepare conn temp q Nothing

441445 case prepResultMaybe of

442− Nothing -> error

446+ Nothing -> throw $ ResultException

443447 "traversePrepared_: LibPQ.prepare returned no results"

444− Just prepResult -> do

445− status <- LibPQ.resultStatus prepResult

446− unless (status == LibPQ.CommandOk) . error $

447− "traversePrepared: LibPQ.prepare status " <> show status

448+ Just prepResult -> tryResult prepResult

448449 for_ list $ \ params -> do

449450 let

450− toParam' bytes = (bytes,LibPQ.Binary)

451+ toParam' encoding = (encodingBytes encoding, LibPQ.Binary)

451452 params' = fmap (fmap toParam') (hcollapse (toParams @x @xs params))

452453 resultMaybe <- LibPQ.execPrepared conn temp params' LibPQ.Binary

453454 case resultMaybe of

454− Nothing -> error

455+ Nothing -> throw $ ResultException

455456 "traversePrepared_: LibPQ.execParams returned no results"

456− Just _result -> return ()

457+ Just result -> tryResult result

457458 deallocResultMaybe <- LibPQ.exec conn ("DEALLOCATE " <> temp <> ";")

458459 case deallocResultMaybe of

459− Nothing -> error

460+ Nothing -> throw $ ResultException

460461 "traversePrepared: LibPQ.exec DEALLOCATE returned no results"

461− Just deallocResult -> do

462− status <- LibPQ.resultStatus deallocResult

463− unless (status == LibPQ.CommandOk) . error $

464− "traversePrepared: DEALLOCATE status " <> show status

462+ Just deallocResult -> tryResult deallocResult

465463 return (K ())

466464

467465 liftPQ pq = PQ $ \ (K conn) -> do

@@ -479,7 +477,6 @@ instance MonadPQ schema m => MonadPQ schema (ExceptT e m)

479477instance (Monoid w, MonadPQ schema m) => MonadPQ schema (Strict.RWST r w s m)

480478instance (Monoid w, MonadPQ schema m) => MonadPQ schema (Lazy.RWST r w s m)

481479instance MonadPQ schema m => MonadPQ schema (ContT r m)

482−instance MonadPQ schema m => MonadPQ schema (ListT m)

483480

484481instance (Monad m, schema0 ~ schema1)

485482 => Applicative (PQ schema0 schema1 m) where

@@ -534,14 +531,16 @@ getRow

534531 -> io y

535532getRow r (K result :: K LibPQ.Result columns) = liftBase $ do

536533 numRows <- LibPQ.ntuples result

537− when (numRows < r) $ error $

538− "getRow: expected at least " <> show r <> "rows but only saw "

539− <> show numRows

534+ when (numRows < r) $ throw $ ResultException $

535+ "getRow: expected at least " <> pack (show r) <> "rows but only saw "

536+ <> pack (show numRows)

540537 let len = fromIntegral (lengthSList (Proxy @columns))

541538 row' <- traverse (LibPQ.getvalue result r) [0 .. len - 1]

542539 case fromList row' of

543− Nothing -> error "getRow: found unexpected length"

544− Just row -> return $ fromRow @columns row

540+ Nothing -> throw $ ResultException "getRow: found unexpected length"

541+ Just row -> case fromRow @columns row of

542+ Left parseError -> throw $ ParseException $ "getRow: " <> parseError

543+ Right y -> return y

545544

546545-- | Intended to be used for unfolding in streaming libraries, `nextRow`

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

558557 let len = fromIntegral (lengthSList (Proxy @columns))

559558 row' <- traverse (LibPQ.getvalue result r) [0 .. len - 1]

560559 case fromList row' of

561− Nothing -> error "nextRow: found unexpected length"

562− Just row -> return $ Just (r+1, fromRow @columns row)

560+ Nothing -> throw $ ResultException "nextRow: found unexpected length"

561+ Just row -> case fromRow @columns row of

562+ Left parseError -> throw $ ParseException $ "nextRow: " <> parseError

563+ Right y -> return $ Just (r+1, y)

563564

564565-- | Get all rows from a `LibPQ.Result`.

565566getRows

@@ -572,8 +573,10 @@ getRows (K result :: K LibPQ.Result columns) = liftBase $ do

572573 for [0 .. numRows - 1] $ \ r -> do

573574 row' <- traverse (LibPQ.getvalue result r) [0 .. len - 1]

574575 case fromList row' of

575− Nothing -> error "getRows: found unexpected length"

576− Just row -> return $ fromRow @columns row

576+ Nothing -> throw $ ResultException "getRows: found unexpected length"

577+ Just row -> case fromRow @columns row of

578+ Left parseError -> throw $ ParseException $ "getRows: " <> parseError

579+ Right y -> return y

577580

578581-- | Get the first row if possible from a `LibPQ.Result`.

579582firstRow

@@ -586,8 +589,10 @@ firstRow (K result :: K LibPQ.Result columns) = liftBase $ do

586589 let len = fromIntegral (lengthSList (Proxy @columns))

587590 row' <- traverse (LibPQ.getvalue result 0) [0 .. len - 1]

588591 case fromList row' of

589− Nothing -> error "firstRow: found unexpected length"

590− Just row -> return . Just $ fromRow @columns row

592+ Nothing -> throw $ ResultException "firstRow: found unexpected length"

593+ Just row -> case fromRow @columns row of

594+ Left parseError -> throw $ ParseException $ "firstRow: " <> parseError

595+ Right y -> return $ Just y

591596

592597-- | Lifts actions on results from @LibPQ@.

593598liftResult

@@ -609,3 +614,55 @@ resultStatus = liftResult LibPQ.resultStatus

609614resultErrorMessage

610615 :: MonadBase IO io => K LibPQ.Result results -> io (Maybe ByteString)

611616resultErrorMessage = 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.

2929module Squeal.PostgreSQL.Query

3030 ( -- * Queries

3131 Query (UnsafeQuery, renderQuery)

32− , union

33− , unionAll

34− , intersect

35− , intersectAll

36− , except

37− , exceptAll

38− -- * Select

32+ -- ** Select

3933 , select

4034 , selectDistinct

4135 , selectStar

4236 , selectDistinctStar

4337 , selectDotStar

4438 , selectDistinctDotStar

39+ -- ** Values

4540 , values

4641 , 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

4769 -- * Table Expressions

4870 , TableExpression (..)

4971 , renderTableExpression

@@ -54,22 +76,7 @@ module Squeal.PostgreSQL.Query

5476 , orderBy

5577 , limit

5678 , 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

7380 , FromClause (..)

7481 , table

7582 , subquery

@@ -89,11 +96,37 @@ module Squeal.PostgreSQL.Query

8996 -- * Sorting

9097 , SortExpression (..)

9198 , 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

92126 ) where

93127

94128import Control.DeepSeq

95129import Data.ByteString (ByteString)

96−import Data.Monoid hiding (All)

97130import Data.String

98131import Data.Word

99132import Generics.SOP hiding (from)

@@ -107,9 +140,7 @@ import Squeal.PostgreSQL.Schema

107140

108141{- |

109142The process of retrieving or the command to retrieve data from a database

110−is called a `Query`. The `select`, `selectStar`, `selectDotStar`,

111−`selectDistinct`, `selectDistinctStar` and `selectDistinctDotStar` commands

112−are used to specify queries.

143+is called a `Query`. Let's see some examples of queries.

113144

114145simple query:

115146

@@ -280,6 +311,16 @@ in printSQL query

280311:}

281312SELECT "t1".* FROM "tab" AS "t1" CROSS JOIN "tab" AS "t2"

282313

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+

283324set operations:

284325

285326>>> :{

@@ -295,11 +336,30 @@ let

295336in printSQL query

296337:}

297338(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"

298358-}

299359newtype Query

300360 (schema :: SchemaType)

301361 (params :: [NullityType])

302− (columns :: RelationType)

362+ (columns :: RowType)

303363 = UnsafeQuery { renderQuery :: ByteString }

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

305365instance RenderSQL (Query schema params columns) where renderSQL = renderQuery

@@ -381,9 +441,9 @@ SELECT queries

381441-- the intermediate table are actually output.

382442select

383443 :: SListI columns

384− => NP (Aliased (Expression schema relations grouping params)) (column ': columns)

444+ => NP (Aliased (Expression schema from grouping params)) (column ': columns)

385445 -- ^ select list

386− -> TableExpression schema params relations grouping

446+ -> TableExpression schema params from grouping

387447 -- ^ intermediate virtual table

388448 -> Query schema params (column ': columns)

389449select list rels = UnsafeQuery $

@@ -395,9 +455,9 @@ select list rels = UnsafeQuery $

395455-- be subject to the elimination of duplicate rows using `selectDistinct`.

396456selectDistinct

397457 :: SListI columns

398− => NP (Aliased (Expression schema relations 'Ungrouped params)) (column ': columns)

458+ => NP (Aliased (Expression schema from 'Ungrouped params)) (column ': columns)

399459 -- ^ select list

400− -> TableExpression schema params relations 'Ungrouped

460+ -> TableExpression schema params from 'Ungrouped

401461 -- ^ intermediate virtual table

402462 -> Query schema params (column ': columns)

403463selectDistinct list rels = UnsafeQuery $

@@ -408,8 +468,8 @@ selectDistinct list rels = UnsafeQuery $

408468-- | The simplest kind of query is `selectStar` which emits all columns

409469-- that the table expression produces.

410470selectStar

411− :: HasUnique relation relations columns

412− => TableExpression schema params relations 'Ungrouped

471+ :: HasUnique table from columns

472+ => TableExpression schema params from 'Ungrouped

413473 -- ^ intermediate virtual table

414474 -> Query schema params columns

415475selectStar rels = UnsafeQuery $ "SELECT" <+> "*" <+> renderTableExpression rels

@@ -417,8 +477,8 @@ selectStar rels = UnsafeQuery $ "SELECT" <+> "*" <+> renderTableExpression rels

417477-- | A `selectDistinctStar` emits all columns that the table expression

418478-- produces and eliminates duplicate rows.

419479selectDistinctStar

420− :: HasUnique relation relations columns

421− => TableExpression schema params relations 'Ungrouped

480+ :: HasUnique table from columns

481+ => TableExpression schema params from 'Ungrouped

422482 -- ^ intermediate virtual table

423483 -> Query schema params columns

424484selectDistinctStar rels = UnsafeQuery $

@@ -427,27 +487,27 @@ selectDistinctStar rels = UnsafeQuery $

427487-- | When working with multiple tables, it can also be useful to ask

428488-- for all the columns of a particular table, using `selectDotStar`.

429489selectDotStar

430− :: Has relation relations columns

431− => Alias relation

490+ :: Has table from columns

491+ => Alias table

432492 -- ^ particular virtual subtable

433− -> TableExpression schema params relations 'Ungrouped

493+ -> TableExpression schema params from 'Ungrouped

434494 -- ^ intermediate virtual table

435495 -> Query schema params columns

436−selectDotStar rel relations = UnsafeQuery $

437− "SELECT" <+> renderAlias rel <> ".*" <+> renderTableExpression relations

496+selectDotStar rel tab = UnsafeQuery $

497+ "SELECT" <+> renderAlias rel <> ".*" <+> renderTableExpression tab

438498

439499-- | A `selectDistinctDotStar` asks for all the columns of a particular table,

440500-- and eliminates duplicate rows.

441501selectDistinctDotStar

442− :: Has relation relations columns

443− => Alias relation

502+ :: Has table from columns

503+ => Alias table

444504 -- ^ particular virtual table

445− -> TableExpression schema params relations 'Ungrouped

505+ -> TableExpression schema params from 'Ungrouped

446506 -- ^ intermediate virtual table

447507 -> Query schema params columns

448−selectDistinctDotStar rel relations = UnsafeQuery $

508+selectDistinctDotStar rel tab = UnsafeQuery $

449509 "SELECT DISTINCT" <+> renderAlias rel <> ".*"

450− <+> renderTableExpression relations

510+ <+> renderTableExpression tab

451511

452512-- | `values` computes a row value or set of row values

453513-- specified by value expressions. It is most commonly used

@@ -501,13 +561,13 @@ Table Expressions

501561data TableExpression

502562 (schema :: SchemaType)

503563 (params :: [NullityType])

504− (relations :: RelationsType)

564+ (from :: FromType)

505565 (grouping :: Grouping)

506566 = TableExpression

507− { fromClause :: FromClause schema params relations

567+ { fromClause :: FromClause schema params from

508568 -- ^ A table reference that can be a table name, or a derived table such

509569 -- 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]

511571 -- ^ optional search coditions, combined with `.&&`. After the processing

512572 -- of the `fromClause` is done, each row of the derived virtual table

513573 -- is checked against the search condition. If the result of the

@@ -516,20 +576,20 @@ data TableExpression

516576 -- at least one column of the table generated in the `fromClause`;

517577 -- this is not required, but otherwise the WHERE clause will

518578 -- be fairly useless.

519− , groupByClause :: GroupByClause relations grouping

579+ , groupByClause :: GroupByClause from grouping

520580 -- ^ The `groupByClause` is used to group together those rows in a table

521581 -- that have the same values in all the columns listed. The order in which

522582 -- the columns are listed does not matter. The effect is to combine each

523583 -- set of rows having common values into one group row that represents all

524584 -- rows in the group. This is done to eliminate redundancy in the output

525585 -- and/or compute aggregates that apply to these groups.

526− , havingClause :: HavingClause schema relations grouping params

586+ , havingClause :: HavingClause schema from grouping params

527587 -- ^ If a table has been grouped using `groupBy`, but only certain groups

528588 -- are of interest, the `havingClause` can be used, much like a

529589 -- `whereClause`, to eliminate groups from the result. Expressions in the

530590 -- `havingClause` can refer both to grouped expressions and to ungrouped

531591 -- expressions (which necessarily involve an aggregate function).

532− , orderByClause :: [SortExpression schema relations grouping params]

592+ , orderByClause :: [SortExpression schema from grouping params]

533593 -- ^ The `orderByClause` is for optional sorting. When more than one

534594 -- `SortExpression` is specified, the later (right) values are used to sort

535595 -- rows that are equal according to the earlier (left) values.

@@ -547,7 +607,7 @@ data TableExpression

547607

548608-- | Render a `TableExpression`

549609renderTableExpression

550− :: TableExpression schema params relations grouping

610+ :: TableExpression schema params from grouping

551611 -> ByteString

552612renderTableExpression

553613 (TableExpression frm' whs' grps' hvs' srts' lims' offs') = mconcat

@@ -581,16 +641,16 @@ renderTableExpression

581641-- `group`, `having`, `orderBy`, `limit` and `offset`, using the `&` operator

582642-- to match the left-to-right sequencing of their placement in SQL.

583643from

584− :: FromClause schema params relations -- ^ table reference

585− -> TableExpression schema params relations 'Ungrouped

644+ :: FromClause schema params from -- ^ table reference

645+ -> TableExpression schema params from 'Ungrouped

586646from rels = TableExpression rels [] NoGroups NoHaving [] [] []

587647

588648-- | A `where_` is an endomorphism of `TableExpression`s which adds a

589649-- search condition to the `whereClause`.

590650where_

591− :: Condition schema relations 'Ungrouped params -- ^ filtering condition

592− -> TableExpression schema params relations grouping

593− -> TableExpression schema params relations grouping

651+ :: Condition schema from 'Ungrouped params -- ^ filtering condition

652+ -> TableExpression schema params from grouping

653+ -> TableExpression schema params from grouping

594654where_ wh rels = rels {whereClause = wh : whereClause rels}

595655

596656-- | A `groupBy` is a transformation of `TableExpression`s which switches

@@ -598,9 +658,9 @@ where_ wh rels = rels {whereClause = wh : whereClause rels}

598658-- a "grand total" aggregation query.

599659groupBy

600660 :: SListI bys

601− => NP (By relations) bys -- ^ grouped columns

602− -> TableExpression schema params relations 'Ungrouped

603− -> TableExpression schema params relations ('Grouped bys)

661+ => NP (By from) bys -- ^ grouped columns

662+ -> TableExpression schema params from 'Ungrouped

663+ -> TableExpression schema params from ('Grouped bys)

604664groupBy bys rels = TableExpression

605665 { fromClause = fromClause rels

606666 , whereClause = whereClause rels

@@ -614,218 +674,176 @@ groupBy bys rels = TableExpression

614674-- | A `having` is an endomorphism of `TableExpression`s which adds a

615675-- search condition to the `havingClause`.

616676having

617− :: Condition schema relations ('Grouped bys) params -- ^ having condition

618− -> TableExpression schema params relations ('Grouped bys)

619− -> TableExpression schema params relations ('Grouped bys)

677+ :: Condition schema from ('Grouped bys) params -- ^ having condition

678+ -> TableExpression schema params from ('Grouped bys)

679+ -> TableExpression schema params from ('Grouped bys)

620680having hv rels = rels

621681 { havingClause = case havingClause rels of Having hvs -> Having (hv:hvs) }

622682

623683-- | An `orderBy` is an endomorphism of `TableExpression`s which appends an

624684-- ordering to the right of the `orderByClause`.

625685orderBy

626− :: [SortExpression schema relations grouping params] -- ^ sort expressions

627− -> TableExpression schema params relations grouping

628− -> TableExpression schema params relations grouping

686+ :: [SortExpression schema from grouping params] -- ^ sort expressions

687+ -> TableExpression schema params from grouping

688+ -> TableExpression schema params from grouping

629689orderBy srts rels = rels {orderByClause = orderByClause rels ++ srts}

630690

631691-- | A `limit` is an endomorphism of `TableExpression`s which adds to the

632692-- `limitClause`.

633693limit

634694 :: Word64 -- ^ limit parameter

635− -> TableExpression schema params relations grouping

636− -> TableExpression schema params relations grouping

695+ -> TableExpression schema params from grouping

696+ -> TableExpression schema params from grouping

637697limit lim rels = rels {limitClause = lim : limitClause rels}

638698

639699-- | An `offset` is an endomorphism of `TableExpression`s which adds to the

640700-- `offsetClause`.

641701offset

642702 :: Word64 -- ^ offset parameter

643− -> TableExpression schema params relations grouping

644− -> TableExpression schema params relations grouping

703+ -> TableExpression schema params from grouping

704+ -> TableExpression schema params from grouping

645705offset off rels = rels {offsetClause = off : offsetClause rels}

646706

647707{-----------------------------------------

648708JSON stuff

649709-----------------------------------------}

650710

651−type PGjson_each_variant val tab =

652− '[ tab ::: '[ "key" ::: 'NotNull 'PGtext, "value" ::: 'NotNull val ] ]

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'

665− -> FromClause schema params relations

666−unsafeAliasedFromClauseExpression aliasedExpr = UnsafeFromClause

667− (renderAliasedAs renderExpression aliasedExpr)

711+unsafeSetOfFunction

712+ :: ByteString

713+ -> Expression schema '[] 'Ungrouped params ty

714+ -> Query schema params row

715+unsafeSetOfFunction fun expr = UnsafeQuery $

716+ "SELECT * FROM " <> fun <> "(" <> renderExpression expr <> ")"

668717

669718-- | Expands the outermost JSON object into a set of key/value pairs.

670719jsonEach

671− :: Aliased (Expression schema '[] 'Ungrouped params) '(tab, nullity 'PGjson)

672− -> FromClause schema params (PGjson_each tab)

673−jsonEach (As jexpr jname) = unsafeAliasedFromClauseExpression

674− (As (unsafeFunction "json_each" jexpr) jname)

720+ :: Expression schema '[] 'Ungrouped params (nullity 'PGjson) -- ^ json object

721+ -> Query schema params

722+ '["key" ::: 'NotNull 'PGtext, "value" ::: 'NotNull 'PGjson]

723+jsonEach = unsafeSetOfFunction "json_each"

675724

676725-- | Expands the outermost binary JSON object into a set of key/value pairs.

677726jsonbEach

678− :: Aliased (Expression schema '[] 'Ungrouped params) '(tab, nullity 'PGjsonb)

679− -> FromClause schema params (PGjsonb_each tab)

680−jsonbEach (As jexpr jname) = unsafeAliasedFromClauseExpression

681− (As (unsafeFunction "jsonb_each" jexpr) jname)

727+ :: Expression schema '[] 'Ungrouped params (nullity 'PGjsonb) -- ^ jsonb object

728+ -> Query schema params

729+ '["key" ::: 'NotNull 'PGtext, "value" ::: 'NotNull 'PGjsonb]

730+jsonbEach = unsafeSetOfFunction "jsonb_each"

682731

683732-- | Expands the outermost JSON object into a set of key/value pairs.

684733jsonEachAsText

685− :: Aliased (Expression schema '[] 'Ungrouped params) '(tab, nullity 'PGjson)

686− -> FromClause schema params (PGjson_each_text tab)

687−jsonEachAsText (As jexpr jname) = unsafeAliasedFromClauseExpression

688− (As (unsafeFunction "json_each" jexpr) jname)

734+ :: Expression schema '[] 'Ungrouped params (nullity 'PGjson) -- ^ json object

735+ -> Query schema params

736+ '["key" ::: 'NotNull 'PGtext, "value" ::: 'NotNull 'PGtext]

737+jsonEachAsText = unsafeSetOfFunction "json_each_text"

689738

690739-- | Expands the outermost binary JSON object into a set of key/value pairs.

691740jsonbEachAsText

692− :: Aliased (Expression schema '[] 'Ungrouped params) '(tab, nullity 'PGjsonb)

693− -> FromClause schema params (PGjsonb_each_text tab)

694−jsonbEachAsText (As jexpr jname) = unsafeAliasedFromClauseExpression

695− (As (unsafeFunction "jsonb_each" jexpr) jname)

696−

697−nullRow

698− :: Has tab schema ('Table table)

699− => Alias tab

700− -> Expression schema relations grouping params

701− (nullity ('PGcomposite (RelationToRowType (TableToRelation table))))

702−nullRow tab = UnsafeExpression ("null::"<+>renderAlias tab)

741+ :: Expression schema '[] 'Ungrouped params (nullity 'PGjsonb) -- ^ jsonb object

742+ -> Query schema params

743+ '["key" ::: 'NotNull 'PGtext, "value" ::: 'NotNull 'PGtext]

744+jsonbEachAsText = unsafeSetOfFunction "jsonb_each_text"

745+

746+-- | Returns set of keys in the outermost JSON object.

747+jsonObjectKeys

748+ :: Expression schema '[] 'Ungrouped params (nullity 'PGjson) -- ^ json object

749+ -> Query schema params '["json_object_keys" ::: 'NotNull 'PGtext]

750+jsonObjectKeys = unsafeSetOfFunction "json_object_keys"

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 <> ")"

703767

704768-- | Expands the JSON expression to a row whose columns match the record

705769-- type defined by the given table.

706−jsonPopulateRecordAs

707− :: (KnownSymbol alias, Has tab schema ('Table table))

708− => Alias tab

709− -> Expression schema '[] 'Ungrouped params (nullity 'PGjson)

710− -> Alias alias

711− -> FromClause schema params '[alias ::: TableToRelation table]

712−jsonPopulateRecordAs tableName expr alias = unsafeAliasedFromClauseExpression

713− (unsafeVariadicFunction "json_populate_record"

714− (nullRow tableName :* expr :* Nil) `As` alias)

770+jsonPopulateRecord

771+ :: TypeExpression schema (nullity ('PGcomposite row)) -- ^ row type

772+ -> Expression schema '[] 'Ungrouped params (nullity 'PGjson) -- ^ json object

773+ -> Query schema params row

774+jsonPopulateRecord = unsafePopulateFunction "json_populate_record"

715775

716776-- | Expands the binary JSON expression to a row whose columns match the record

717777-- type defined by the given table.

718−jsonbPopulateRecordAs

719− :: (KnownSymbol alias, Has tab schema ('Table table))

720− => Alias tab

721− -> Expression schema '[] 'Ungrouped params (nullity 'PGjsonb)

722− -> Alias alias

723− -> FromClause schema params '[alias ::: TableToRelation table]

724−jsonbPopulateRecordAs tableName expr alias = unsafeAliasedFromClauseExpression

725− (unsafeVariadicFunction "jsonb_populate_record"

726− (nullRow tableName :* expr :* Nil) `As` alias)

778+jsonbPopulateRecord

779+ :: TypeExpression schema (nullity ('PGcomposite row)) -- ^ row type

780+ -> Expression schema '[] 'Ungrouped params (nullity 'PGjsonb) -- ^ jsonb object

781+ -> Query schema params row

782+jsonbPopulateRecord = unsafePopulateFunction "jsonb_populate_record"

727783

728784-- | Expands the outermost array of objects in the given JSON expression to a

729785-- set of rows whose columns match the record type defined by the given table.

730−jsonPopulateRecordSetAs

731− :: (KnownSymbol alias, Has tab schema ('Table table))

732− => Alias tab

733− -> Expression schema '[] 'Ungrouped params (nullity 'PGjson)

734− -> Alias alias

735− -> FromClause schema params '[alias ::: TableToRelation table]

736−jsonPopulateRecordSetAs tableName expr alias = unsafeAliasedFromClauseExpression

737− (unsafeVariadicFunction "json_populate_record_set"

738− (nullRow tableName :* expr :* Nil) `As` alias)

786+jsonPopulateRecordSet

787+ :: TypeExpression schema (nullity ('PGcomposite row)) -- ^ row type

788+ -> Expression schema '[] 'Ungrouped params (nullity 'PGjson) -- ^ json array

789+ -> Query schema params row

790+jsonPopulateRecordSet = unsafePopulateFunction "json_populate_record_set"

739791

740792-- | Expands the outermost array of objects in the given binary JSON expression

741793-- to a set of rows whose columns match the record type defined by the given

742794-- table.

743−jsonbPopulateRecordSetAs

744− :: (KnownSymbol alias, Has tab schema ('Table table))

745− => Alias tab

746− -> Expression schema '[] 'Ungrouped params (nullity 'PGjsonb)

747− -> Alias alias

748− -> FromClause schema params '[alias ::: TableToRelation table]

749−jsonbPopulateRecordSetAs tableName expr alias = unsafeAliasedFromClauseExpression

750− (unsafeVariadicFunction "jsonb_populate_record_set"

751− (nullRow tableName :* expr :* Nil) `As` alias)

752−

753−renderTableTypeExpression

754− :: All Top types

755− => Aliased (NP (Aliased (TypeExpression schema))) (tab ::: types)

756− -> ByteString

757−renderTableTypeExpression (hc `As` tab)

758− = (renderAlias tab <>)

759− . parenthesized

760− . commaSeparated

761− . flip appEndo []

762− . hcfoldMap

763− (Proxy :: Proxy Top)

764− (\(ty `As` name) -> Endo

765− ((renderAlias name <+> renderTypeExpression ty):))

766− $ hc

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

779−-- returning record, the caller must explicitly define the structure of the

780−-- record with an AS clause.

781−jsonToRecordAs

782− :: All Top types

783− => Expression schema '[] 'Ungrouped params (nullity 'PGjson)

784− -> Aliased (NP (Aliased (TypeExpression schema))) (tab ::: types)

785− -> FromClause schema params '[tab ::: types]

786−jsonToRecordAs expr types =

787− unsafeTableAliasedFromClauseExpression

788− (unsafeFunction "json_to_record" expr)

789− types

790−

791−-- | Builds an arbitrary record from a binary JSON object. As with all functions

792−-- returning record, the caller must explicitly define the structure of the

793−-- record with an AS clause.

794−jsonbToRecordAs

795− :: All Top types

796− => Expression schema '[] 'Ungrouped params (nullity 'PGjsonb)

797− -> Aliased (NP (Aliased (TypeExpression schema))) (tab ::: types)

798− -> FromClause schema params '[tab ::: types]

799−jsonbToRecordAs expr types =

800− unsafeTableAliasedFromClauseExpression

801− (unsafeFunction "jsonb_to_record" expr)

802− types

803−

804−-- | Builds an arbitrary set of records from a JSON array of objects (see note

805−-- below). As with all functions returning record, the caller must explicitly

806−-- define the structure of the record with an AS clause.

807−jsonToRecordSetAs

808− :: All Top types

809− => Expression schema '[] 'Ungrouped params (nullity 'PGjson)

810− -> Aliased (NP (Aliased (TypeExpression schema))) (tab ::: types)

811− -> FromClause schema params '[tab ::: types]

812−jsonToRecordSetAs expr types =

813− unsafeTableAliasedFromClauseExpression

814− (unsafeFunction "json_to_recordset" expr)

815− types

816−

817−-- | Builds an arbitrary set of records from a binary JSON array of objects (see

818−-- note below). As with all functions returning record, the caller must

819−-- explicitly define the structure of the record with an AS clause.

820−jsonbToRecordSetAs

821− :: All Top types

822− => Expression schema '[] 'Ungrouped params (nullity 'PGjsonb)

823− -> Aliased (NP (Aliased (TypeExpression schema))) (tab ::: types)

824− -> FromClause schema params '[tab ::: types]

825−jsonbToRecordSetAs expr types =

826− unsafeTableAliasedFromClauseExpression

827− (unsafeFunction "jsonb_to_recordset" expr)

828− types

795+jsonbPopulateRecordSet

796+ :: TypeExpression schema (nullity ('PGcomposite row)) -- ^ row type

797+ -> Expression schema '[] 'Ungrouped params (nullity 'PGjsonb) -- ^ jsonb array

798+ -> Query schema params row

799+jsonbPopulateRecordSet = unsafePopulateFunction "jsonb_populate_record_set"

800+

801+unsafeRecordFunction

802+ :: (SListI record, json `In` PGJsonType)

803+ => ByteString

804+ -> Expression schema '[] 'Ungrouped params (nullity json)

805+ -> NP (Aliased (TypeExpression schema)) record

806+ -> Query schema params record

807+unsafeRecordFunction fun expr types = UnsafeQuery $

808+ "SELECT * FROM " <> fun <> "("

809+ <> renderExpression expr <> ")"

810+ <+> "AS" <+> "x" <> parenthesized (renderCommaSeparated renderTy types)

811+ where

812+ renderTy :: Aliased (TypeExpression schema) ty -> ByteString

813+ renderTy (ty `As` alias) =

814+ renderAlias alias <+> renderTypeExpression ty

815+

816+-- | Builds an arbitrary record from a JSON object.

817+jsonToRecord

818+ :: SListI record

819+ => Expression schema '[] 'Ungrouped params (nullity 'PGjson) -- ^ json object

820+ -> NP (Aliased (TypeExpression schema)) record -- ^ record types

821+ -> Query schema params record

822+jsonToRecord = unsafeRecordFunction "json_to_record"

823+

824+-- | Builds an arbitrary record from a binary JSON object.

825+jsonbToRecord

826+ :: SListI record

827+ => Expression schema '[] 'Ungrouped params (nullity 'PGjsonb) -- ^ jsonb object

828+ -> NP (Aliased (TypeExpression schema)) record -- ^ record types

829+ -> Query schema params record

830+jsonbToRecord = unsafeRecordFunction "jsonb_to_record"

831+

832+-- | Builds an arbitrary set of records from a JSON array of objects.

833+jsonToRecordSet

834+ :: SListI record

835+ => Expression schema '[] 'Ungrouped params (nullity 'PGjson) -- ^ json array

836+ -> NP (Aliased (TypeExpression schema)) record -- ^ record types

837+ -> Query schema params record

838+jsonToRecordSet = unsafeRecordFunction "json_to_record_set"

839+

840+-- | Builds an arbitrary set of records from a binary JSON array of objects.

841+jsonbToRecordSet

842+ :: SListI record

843+ => Expression schema '[] 'Ungrouped params (nullity 'PGjsonb) -- ^ jsonb array

844+ -> NP (Aliased (TypeExpression schema)) record -- ^ record types

845+ -> Query schema params record

846+jsonbToRecordSet = unsafeRecordFunction "jsonb_to_record_set"

829847

830848{-----------------------------------------

831849FROM clauses

@@ -835,7 +853,7 @@ FROM clauses

835853A `FromClause` can be a table name, or a derived table such

836854as a subquery, a @JOIN@ construct, or complex combinations of these.

837855-}

838−newtype FromClause schema params relations

856+newtype FromClause schema params from

839857 = UnsafeFromClause { renderFromClause :: ByteString }

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

841859

@@ -843,7 +861,7 @@ newtype FromClause schema params relations

843861table

844862 :: Has tab schema ('Table table)

845863 => Aliased Alias (alias ::: tab)

846− -> FromClause schema params '[alias ::: TableToRelation table]

864+ -> FromClause schema params '[alias ::: TableToRow table]

847865table (tab `As` alias) = UnsafeFromClause $

848866 renderAlias tab <+> "AS" <+> renderAlias alias

849867

@@ -855,9 +873,9 @@ subquery = UnsafeFromClause . renderAliasedAs (parenthesized . renderQuery)

855873

856874-- | `view` derives a table from a `View`.

857875view

858− :: Has view schema ('View rel)

876+ :: Has view schema ('View row)

859877 => Aliased Alias (alias ::: view)

860− -> FromClause schema params '[alias ::: rel]

878+ -> FromClause schema params '[alias ::: row]

861879view (vw `As` alias) = UnsafeFromClause $

862880 renderAlias vw <+> "AS" <+> renderAlias alias

863881

@@ -903,7 +921,7 @@ leftOuterJoin

903921 -- ^ @on@ condition

904922 -> FromClause schema params left

905923 -- ^ left

906− -> FromClause schema params (Join left (NullifyRelations right))

924+ -> FromClause schema params (Join left (NullifyFrom right))

907925leftOuterJoin right on left = UnsafeFromClause $

908926 renderFromClause left <+> "LEFT OUTER JOIN" <+> renderFromClause right

909927 <+> "ON" <+> renderExpression on

@@ -921,7 +939,7 @@ rightOuterJoin

921939 -- ^ @on@ condition

922940 -> FromClause schema params left

923941 -- ^ left

924− -> FromClause schema params (Join (NullifyRelations left) right)

942+ -> FromClause schema params (Join (NullifyFrom left) right)

925943rightOuterJoin right on left = UnsafeFromClause $

926944 renderFromClause left <+> "RIGHT OUTER JOIN" <+> renderFromClause right

927945 <+> "ON" <+> renderExpression on

@@ -941,7 +959,7 @@ fullOuterJoin

941959 -> FromClause schema params left

942960 -- ^ left

943961 -> FromClause schema params

944− (Join (NullifyRelations left) (NullifyRelations right))

962+ (Join (NullifyFrom left) (NullifyFrom right))

945963fullOuterJoin right on left = UnsafeFromClause $

946964 renderFromClause left <+> "FULL OUTER JOIN" <+> renderFromClause right

947965 <+> "ON" <+> renderExpression on

@@ -956,20 +974,20 @@ Grouping

956974-- column @col@; otherwise @By2 (\#tab \! \#col)@ will reference a table

957975-- qualified column @tab.col@.

958976data By

959− (relations :: RelationsType)

977+ (from :: FromType)

960978 (by :: (Symbol,Symbol)) where

961979 By1

962− :: (HasUnique relation relations columns, Has column columns ty)

980+ :: (HasUnique table from columns, Has column columns ty)

963981 => Alias column

964− -> By relations '(relation, column)

982+ -> By from '(table, column)

965983 By2

966− :: (Has relation relations columns, Has column columns ty)

967− => Alias relation

984+ :: (Has table from columns, Has column columns ty)

985+ => Alias table

968986 -> Alias column

969− -> By relations '(relation, column)

970−deriving instance Show (By relations by)

971−deriving instance Eq (By relations by)

972−deriving instance Ord (By relations by)

987+ -> By from '(table, column)

988+deriving instance Show (By from by)

989+deriving instance Eq (By from by)

990+deriving instance Ord (By from by)

973991

974992instance (HasUnique rel rels cols, Has col cols ty, by ~ '(rel, col))

975993 => 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)])

9821000 rel ! col = By2 rel col :* Nil

9831001

9841002-- | Renders a `By`.

985−renderBy :: By relations by -> ByteString

1003+renderBy :: By from by -> ByteString

9861004renderBy = \case

9871005 By1 column -> renderAlias column

9881006 By2 rel column -> renderAlias rel <> "." <> renderAlias column

@@ -993,15 +1011,15 @@ renderBy = \case

9931011-- done on @NoGroups@ while all output `Expression`s must be aggregated

9941012-- in @Group Nil@. In general, all output `Expression`s in the

9951013-- complement of @bys@ must be aggregated in @Group bys@.

996−data GroupByClause relations grouping where

997− NoGroups :: GroupByClause relations 'Ungrouped

1014+data GroupByClause from grouping where

1015+ NoGroups :: GroupByClause from 'Ungrouped

9981016 Group

9991017 :: SListI bys

1000− => NP (By relations) bys

1001− -> GroupByClause relations ('Grouped bys)

1018+ => NP (By from) bys

1019+ -> GroupByClause from ('Grouped bys)

10021020

10031021-- | Renders a `GroupByClause`.

1004−renderGroupByClause :: GroupByClause relations grouping -> ByteString

1022+renderGroupByClause :: GroupByClause from grouping -> ByteString

10051023renderGroupByClause = \case

10061024 NoGroups -> ""

10071025 Group Nil -> ""

@@ -1011,17 +1029,17 @@ renderGroupByClause = \case

10111029-- An `Ungrouped` `TableExpression` may only use `NoHaving` while a `Grouped`

10121030-- `TableExpression` must use `Having` whose conditions are combined with

10131031-- `.&&`.

1014−data HavingClause schema relations grouping params where

1015− NoHaving :: HavingClause schema relations 'Ungrouped params

1032+data HavingClause schema from grouping params where

1033+ NoHaving :: HavingClause schema from 'Ungrouped params

10161034 Having

1017− :: [Condition schema relations ('Grouped bys) params]

1018− -> HavingClause schema relations ('Grouped bys) params

1019−deriving instance Show (HavingClause schema relations grouping params)

1020−deriving instance Eq (HavingClause schema relations grouping params)

1021−deriving instance Ord (HavingClause schema relations grouping params)

1035+ :: [Condition schema from ('Grouped bys) params]

1036+ -> HavingClause schema from ('Grouped bys) params

1037+deriving instance Show (HavingClause schema from grouping params)

1038+deriving instance Eq (HavingClause schema from grouping params)

1039+deriving instance Ord (HavingClause schema from grouping params)

10221040

10231041-- | Render a `HavingClause`.

1024−renderHavingClause :: HavingClause schema relations grouping params -> ByteString

1042+renderHavingClause :: HavingClause schema from grouping params -> ByteString

10251043renderHavingClause = \case

10261044 NoHaving -> ""

10271045 Having [] -> ""

@@ -1040,29 +1058,29 @@ Sorting

10401058-- `AscNullsLast`, `DescNullsFirst` and `DescNullsLast` options are used to

10411059-- determine whether nulls appear before or after non-null values in the sort

10421060-- ordering of a `Null` result column.

1043−data SortExpression schema relations grouping params where

1061+data SortExpression schema from grouping params where

10441062 Asc

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

1046− -> SortExpression schema relations grouping params

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

1064+ -> SortExpression schema from grouping params

10471065 Desc

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

1049− -> SortExpression schema relations grouping params

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

1067+ -> SortExpression schema from grouping params

10501068 AscNullsFirst

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

1052− -> SortExpression schema relations grouping params

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

1070+ -> SortExpression schema from grouping params

10531071 AscNullsLast

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

1055− -> SortExpression schema relations grouping params

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

1073+ -> SortExpression schema from grouping params

10561074 DescNullsFirst

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

1058− -> SortExpression schema relations grouping params

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

1076+ -> SortExpression schema from grouping params

10591077 DescNullsLast

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

1061− -> SortExpression schema relations grouping params

1062−deriving instance Show (SortExpression schema relations grouping params)

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

1079+ -> SortExpression schema from grouping params

1080+deriving instance Show (SortExpression schema from grouping params)

10631081

10641082-- | Render a `SortExpression`.

1065−renderSortExpression :: SortExpression schema relations grouping params -> ByteString

1083+renderSortExpression :: SortExpression schema from grouping params -> ByteString

10661084renderSortExpression = \case

10671085 Asc expression -> renderExpression expression <+> "ASC"

10681086 Desc expression -> renderExpression expression <+> "DESC"

@@ -1072,3 +1090,326 @@ renderSortExpression = \case

10721090 <+> "DESC NULLS FIRST"

10731091 AscNullsLast expression -> renderExpression expression <+> "ASC NULLS LAST"

10741092 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.

99-}

1010

1111{-# LANGUAGE

12− FlexibleContexts

12+ AllowAmbiguousTypes

13+ , FlexibleContexts

1314 , MagicHash

1415 , OverloadedStrings

1516 , PolyKinds

1617 , RankNTypes

1718 , ScopedTypeVariables

19+ , TypeApplications

1820#-}

1921

2022module Squeal.PostgreSQL.Render

@@ -28,6 +30,7 @@ module Squeal.PostgreSQL.Render

2830 , renderCommaSeparated

2931 , renderCommaSeparatedMaybe

3032 , renderNat

33+ , renderSymbol

3134 , RenderSQL (..)

3235 , printSQL

3336 ) where

@@ -51,6 +54,7 @@ parenthesized str = "(" <> str <> ")"

5154

5255-- | Concatenate two `ByteString`s with a space between.

5356(<+>) :: ByteString -> ByteString -> ByteString

57+infixr 7 <+>

5458str1 <+> str2 = str1 <> " " <> str2

5559

5660-- | Comma separate a list of `ByteString`s.

@@ -92,8 +96,12 @@ renderCommaSeparatedMaybe render

9296 . hmap (K . render)

9397

9498-- | Render a promoted `Nat`.

95−renderNat :: KnownNat n => proxy n -> ByteString

96−renderNat (_ :: proxy n) = fromString (show (natVal' (proxy# :: Proxy# n)))

99+renderNat :: forall n. KnownNat n => ByteString

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

97105

98106-- | A class for rendering SQL

99107class 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.

2020 , FlexibleInstances

2121 , FunctionalDependencies

2222 , GADTs

23+ , LambdaCase

2324 , OverloadedStrings

2425 , RankNTypes

2526 , ScopedTypeVariables

@@ -33,18 +34,24 @@ it defines an embedding of Haskell types into Postgres types.

3334#-}

3435

3536module Squeal.PostgreSQL.Schema

36− ( -- * Types

37+ ( -- * Postgres Types

3738 PGType (..)

38− , HasOid (..)

3939 , 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

4052 , ColumnType

41− -- * Tables

4253 , ColumnsType

43− , RelationType

44− , NilRelation

45− , RelationsType

4654 , TableType

47− -- * Schema

4855 , SchemumType (..)

4956 , SchemaType

5057 -- * Constraints

@@ -52,7 +59,6 @@ module Squeal.PostgreSQL.Schema

5259 , ColumnConstraint (..)

5360 , TableConstraint (..)

5461 , TableConstraints

55− , NilTableConstraints

5662 , Uniquely

5763 -- * Aliases

5864 , (:::)

@@ -62,8 +68,6 @@ module Squeal.PostgreSQL.Schema

6268 , Aliased (As)

6369 , Aliasable (as)

6470 , renderAliasedAs

65− , AliasesOf

66− , ZipAliased (..)

6771 , Has

6872 , HasUnique

6973 , HasAll

@@ -75,62 +79,48 @@ module Squeal.PostgreSQL.Schema

7579 , PGlabel (..)

7680 , renderLabel

7781 , renderLabels

82+ , LabelsPG

7883 -- * Grouping

7984 , Grouping (..)

8085 , GroupedBy

81− -- * Type Families

82− , Join

83− , With

86+ -- * Aligned lists

87+ , AlignedList (..)

88+ , single

89+ -- * Data Definitions

8490 , Create

8591 , Drop

8692 , Alter

8793 , Rename

94+ , DropIfConstraintsInvolve

95+ -- * Lists

96+ , Join

8897 , Elem

8998 , In

99+ , Length

100+ -- * Type Classifications

101+ , HasOid (..)

90102 , PGNum

91103 , PGIntegral

92104 , PGFloating

93105 , PGTypeOf

94− , PGarrayOf

95− , PGarray

96− , PGtextArray

97− , SameTypes

106+ , PGArrayOf

107+ , PGArray

108+ , PGTextArray

109+ , PGJsonType

110+ , PGJsonKey

98111 , SamePGType

99112 , AllNotNull

100113 , NotAllNull

114+ -- * Nullifications

101115 , NullifyType

102− , NullifyRelation

103− , NullifyRelations

104− , ColumnsToRelation

116+ , NullifyRow

117+ , NullifyFrom

118+ -- * Table Conversions

105119 , TableToColumns

106− , TableToRelation

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

120+ , TableToRow

132121 ) where

133122

123+import Control.Category

134124import Control.DeepSeq

135125import Data.Aeson (Value)

136126import Data.ByteString (ByteString)

@@ -144,10 +134,13 @@ import Data.Time

144134import Data.Word (Word16, Word32, Word64)

145135import Data.Type.Bool

146136import Data.UUID.Types (UUID)

137+import Data.Vector (Vector)

147138import Generics.SOP

139+import Generics.SOP.Record

148140import GHC.OverloadedLabels

149141import GHC.TypeLits

150142import Network.IP.Addr

143+import Prelude hiding (id, (.))

151144

152145import qualified Data.ByteString.Lazy as Lazy

153146import qualified Data.Text.Lazy as Lazy

@@ -183,10 +176,10 @@ data PGType

183176 | PGinet -- ^ IPv4 or IPv6 host address

184177 | PGjson -- ^ textual JSON data

185178 | PGjsonb -- ^ binary JSON data, decomposed

186− | PGvararray PGType -- ^ variable length array

187− | PGfixarray Nat PGType -- ^ fixed length array

188− | PGenum [Symbol]

189− | PGcomposite [(Symbol, PGType)]

179+ | PGvararray NullityType -- ^ variable length array

180+ | PGfixarray Nat NullityType -- ^ fixed length array

181+ | PGenum [Symbol] -- ^ enumerated (enum) types are data types that comprise a static, ordered set of values.

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.

190183 | UnsafePGType Symbol -- ^ an escape hatch for unsupported PostgreSQL types

191184

192185-- | The object identifier of a `PGType`.

@@ -283,9 +276,6 @@ data TableConstraint

283276

284277-- | A `TableConstraints` is a row of `TableConstraint`s.

285278type TableConstraints = [(Symbol,TableConstraint)]

286−-- | A monokinded empty `TableConstraints`.

287−type family NilTableConstraints :: TableConstraints where

288− NilTableConstraints = '[]

289279

290280-- | A `ForeignKey` must reference columns that either are

291281-- a `PrimaryKey` or form a `Unique` constraint.

@@ -309,36 +299,39 @@ type family Uniquely

309299-- :}

310300type TableType = (TableConstraints,ColumnsType)

311301

312−-- | `RelationType` is a row of `NullityType`

313−--

314−-- >>> :{

315−-- type family PersonRelation :: RelationType where

316−-- PersonRelation =

317−-- '[ "name" ::: 'NotNull 'PGtext

318−-- , "age" ::: 'NotNull 'PGint4

319−-- , "dateOfBirth" ::: 'Null 'PGdate

320−-- ]

321−-- :}

322−type RelationType = [(Symbol,NullityType)]

323−-- | A monokinded empty `RelationType`.

324−type family NilRelation :: RelationType where NilRelation = '[]

302+{- | A `RowType` is a row of `NullityType`. They correspond to Haskell

303+record types by means of `RowPG` and are used in many places.

304+

305+>>> :{

306+type family PersonRow :: RowType where

307+ PersonRow =

308+ '[ "name" ::: 'NotNull 'PGtext

309+ , "age" ::: 'NotNull 'PGint4

310+ , "dateOfBirth" ::: 'Null 'PGdate

311+ ]

312+:}

313+-}

314+type RowType = [(Symbol,NullityType)]

325315

326−-- | `RelationsType` is a row of `RelationType`s, thought of as a product.

327−type RelationsType = [(Symbol,RelationType)]

316+{- | `FromType` is a row of `RowType`s. It can be thought of as

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)]

328321

329−-- | `ColumnsToRelation` removes column constraints.

330−type family ColumnsToRelation (columns :: ColumnsType) :: RelationType where

331− ColumnsToRelation '[] = '[]

332− ColumnsToRelation (column ::: constraint :=> ty ': columns) =

333− column ::: ty ': ColumnsToRelation columns

322+-- | `ColumnsToRow` removes column constraints.

323+type family ColumnsToRow (columns :: ColumnsType) :: RowType where

324+ ColumnsToRow '[] = '[]

325+ ColumnsToRow (column ::: constraint :=> ty ': columns) =

326+ column ::: ty ': ColumnsToRow columns

334327

335328-- | `TableToColumns` removes table constraints.

336329type family TableToColumns (table :: TableType) :: ColumnsType where

337330 TableToColumns (constraints :=> columns) = columns

338331

339−-- | Convert a table to a relation.

340−type family TableToRelation (table :: TableType) :: RelationType where

341− TableToRelation tab = ColumnsToRelation (TableToColumns tab)

332+-- | Convert a table to a row type.

333+type family TableToRow (table :: TableType) :: RowType where

334+ TableToRow tab = ColumnsToRow (TableToColumns tab)

342335

343336-- | `Grouping` is an auxiliary namespace, created by

344337-- @GROUP BY@ clauses (`Squeal.PostgreSQL.Query.group`), and used

@@ -351,15 +344,15 @@ data Grouping

351344a member of the auxiliary namespace created by @GROUP BY@ clauses and thus,

352345may be called in an output `Squeal.PostgreSQL.Expression.Expression` without aggregating.

353346-}

354−class (KnownSymbol relation, KnownSymbol column)

355− => GroupedBy relation column bys where

356−instance {-# OVERLAPPING #-} (KnownSymbol relation, KnownSymbol column)

357− => GroupedBy relation column ('(table,column) ': bys)

347+class (KnownSymbol table, KnownSymbol column)

348+ => GroupedBy table column bys where

349+instance {-# OVERLAPPING #-} (KnownSymbol table, KnownSymbol column)

350+ => GroupedBy table column ('(table,column) ': bys)

358351instance {-# OVERLAPPABLE #-}

359− ( KnownSymbol relation

352+ ( KnownSymbol table

360353 , KnownSymbol column

361− , GroupedBy relation column bys

362− ) => GroupedBy relation column (tabcol ': bys)

354+ , GroupedBy table column bys

355+ ) => GroupedBy table column (tabcol ': bys)

363356

364357-- | `Alias`es are proxies for a type level string or `Symbol`

365358-- and have an `IsLabel` instance so that with @-XOverloadedLabels@

@@ -420,7 +413,7 @@ class KnownSymbol alias => Aliasable alias expression aliased

420413 | aliased -> expression

421414 , aliased -> alias

422415 where as :: expression -> Alias alias -> aliased

423−instance (alias ~ alias1, KnownSymbol alias) => Aliasable alias

416+instance (KnownSymbol alias, alias ~ alias1) => Aliasable alias

424417 (expression ty)

425418 (Aliased expression (alias1 ::: ty))

426419 where

@@ -441,41 +434,6 @@ renderAliasedAs

441434renderAliasedAs render (expression `As` alias) =

442435 render expression <> " AS " <> renderAlias alias

443436

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−

479437-- | @HasUnique alias fields field@ is a constraint that proves that

480438-- @fields@ is a singleton of @alias ::: field@.

481439type HasUnique alias fields field = fields ~ '[alias ::: field]

@@ -522,21 +480,15 @@ type family Elem x xs where

522480-- | @In x xs@ is a constraint that proves that @x@ is in @xs@.

523481type family In x xs :: Constraint where In x xs = Elem x xs ~ 'True

524482

525−-- | `PGNum` is a constraint on `PGType` whose

526−-- `Squeal.PostgreSQL.Expression.Expression`s have a `Num` constraint.

527−type PGNum ty =

528− In ty '[ 'PGint2, 'PGint4, 'PGint8, 'PGnumeric, 'PGfloat4, 'PGfloat8]

483+-- | Numeric Postgres types.

484+type PGNum =

485+ '[ 'PGint2, 'PGint4, 'PGint8, 'PGnumeric, 'PGfloat4, 'PGfloat8]

529486

530−-- | `PGFloating` is a constraint on `PGType` whose

531−-- `Squeal.PostgreSQL.Expression.Expression`s

532−-- have `Fractional` and `Floating` constraints.

533−type PGFloating ty = In ty '[ 'PGfloat4, 'PGfloat8, 'PGnumeric]

487+-- | Floating Postgres types.

488+type PGFloating = '[ 'PGfloat4, 'PGfloat8, 'PGnumeric]

534489

535−-- | `PGIntegral` is a constraint on `PGType` whose

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]

490+-- | Integral Postgres types.

491+type PGIntegral = '[ 'PGint2, 'PGint4, 'PGint8]

540492

541493-- | Error message helper for displaying unavailable\/unknown\/placeholder type

542494-- variables whose kind is known.

@@ -547,40 +499,32 @@ type ErrPGfixarrayOf t = ErrArrayOf ('ShowType 'PGfixarray :<>: 'Text " " :<>: P

547499type ErrPGvararrayOf t = ErrArrayOf ('ShowType 'PGvararray) t

548500

549501-- | Ensure a type is a valid array type.

550−type family PGarray name arr :: Constraint where

551− PGarray name ('PGvararray x) = ()

552− PGarray name ('PGfixarray n x) = ()

553− PGarray name val = TypeError

554− ('Text name :<>: 'Text ": Unsatisfied PGarray constraint. Expected either: "

502+type family PGArray name arr :: Constraint where

503+ PGArray name ('PGvararray x) = ()

504+ PGArray name ('PGfixarray n x) = ()

505+ PGArray name val = TypeError

506+ ('Text name :<>: 'Text ": Unsatisfied PGArray constraint. Expected either: "

555507 :$$: 'Text " • " :<>: ErrPGvararrayOf (Placeholder PGType)

556508 :$$: 'Text " • " :<>: ErrPGfixarrayOf (Placeholder PGType)

557509 :$$: 'Text "But got: " :<>: 'ShowType val)

558510

559511-- | Ensure a type is a valid array type with a specific element type.

560−type family PGarrayOf name arr ty :: Constraint where

561− PGarrayOf name ('PGvararray x) ty = x ~ ty

562− PGarrayOf name ('PGfixarray n x) ty = x ~ ty

563− PGarrayOf name val ty = TypeError

564− ( 'Text name :<>: 'Text "Unsatisfied PGarrayOf constraint. Expected either: "

512+type family PGArrayOf name arr ty :: Constraint where

513+ PGArrayOf name ('PGvararray x) ty = x ~ ty

514+ PGArrayOf name ('PGfixarray n x) ty = x ~ ty

515+ PGArrayOf name val ty = TypeError

516+ ( 'Text name :<>: 'Text "Unsatisfied PGArrayOf constraint. Expected either: "

565517 :$$: 'Text " • " :<>: ErrPGvararrayOf ( 'ShowType ty )

566518 :$$: 'Text " • " :<>: ErrPGfixarrayOf ( 'ShowType ty )

567519 :$$: 'Text "But got: " :<>: 'ShowType val)

568520

569521-- | 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)

571523

572524-- | `PGTypeOf` forgets about @NULL@ and any column constraints.

573525type family PGTypeOf (ty :: NullityType) :: PGType where

574526 PGTypeOf (nullity pg) = pg

575527

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−

584528-- | Equality constraint on the underlying `PGType` of two columns.

585529class SamePGType

586530 (ty0 :: (Symbol,ColumnType)) (ty1 :: (Symbol,ColumnType)) where

@@ -599,34 +543,24 @@ type family NotAllNull (columns :: ColumnsType) :: Constraint where

599543 NotAllNull (column ::: def :=> 'NotNull ty ': columns) = ()

600544 NotAllNull (column ::: def :=> 'Null ty ': columns) = NotAllNull columns

601545

602−-- | `NullifyType` is an idempotent that nullifies a `ColumnType`.

546+-- | `NullifyType` is an idempotent that nullifies a `NullityType`.

603547type family NullifyType (ty :: NullityType) :: NullityType where

604548 NullifyType ('Null ty) = 'Null ty

605549 NullifyType ('NotNull ty) = 'Null ty

606550

607−-- | `NullifyRelation` is an idempotent that nullifies a `ColumnsType`.

608−type family NullifyRelation (columns :: RelationType) :: RelationType where

609− NullifyRelation '[] = '[]

610− NullifyRelation (column ::: ty ': columns) =

611− column ::: NullifyType ty ': NullifyRelation columns

551+-- | `NullifyRow` is an idempotent that nullifies a `RowType`.

552+type family NullifyRow (columns :: RowType) :: RowType where

553+ NullifyRow '[] = '[]

554+ NullifyRow (column ::: ty ': columns) =

555+ column ::: NullifyType ty ': NullifyRow columns

612556

613−-- | `NullifyRelations` is an idempotent that nullifies a `RelationsType`

557+-- | `NullifyFrom` is an idempotent that nullifies a `FromType`

614558-- used to nullify the left or right hand side of an outer join

615559-- in a `Squeal.PostgreSQL.Query.FromClause`.

616−type family NullifyRelations (tables :: RelationsType) :: RelationsType where

617− NullifyRelations '[] = '[]

618− NullifyRelations (table ::: columns ': tables) =

619− table ::: NullifyRelation columns ': NullifyRelations 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 '[] = '[]

560+type family NullifyFrom (tables :: FromType) :: FromType where

561+ NullifyFrom '[] = '[]

562+ NullifyFrom (table ::: columns ': tables) =

563+ table ::: NullifyRow columns ': NullifyFrom tables

630564

631565-- | `Join` is simply promoted `++` and is used in @JOIN@s in

632566-- `Squeal.PostgreSQL.Query.FromClause`s.

@@ -659,19 +593,6 @@ type family Alter alias x xs where

659593 Alter alias x1 (alias ::: x0 ': xs) = alias ::: x1 ': xs

660594 Alter alias x1 (x0 ': xs) = x0 ': Alter alias x1 xs

661595

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−

675596-- | @Rename alias0 alias1 xs@ replaces the alias @alias0@ by @alias1@ in @xs@

676597-- and is used in `Squeal.PostgreSQL.Definition.alterTableRename` and

677598-- `Squeal.PostgreSQL.Definition.renameColumn`.

@@ -679,26 +600,6 @@ type family Rename alias0 alias1 xs where

679600 Rename alias0 alias1 ((alias0 ::: x0) ': xs) = (alias1 ::: x0) ': xs

680601 Rename alias0 alias1 (x ': xs) = x ': Rename alias0 alias1 xs

681602

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−

702603-- | Check if a `TableConstraint` involves a column

703604type family ConstraintInvolves column constraint where

704605 ConstraintInvolves column ('Check columns) = column `Elem` columns

@@ -715,26 +616,47 @@ type family DropIfConstraintsInvolve column constraints where

715616 (DropIfConstraintsInvolve column constraints)

716617 (alias ::: constraint ': DropIfConstraintsInvolve column constraints)

717618

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+

718629-- | A `SchemumType` is a user-defined type, either a `Table`,

719630-- `View` or `Typedef`.

720631data SchemumType

721632 = Table TableType

722− | View RelationType

633+ | View RowType

723634 | Typedef PGType

724635

725−-- | The schema of a database consists of a list of aliased,

726−-- user-defined `SchemumType`s.

636+{- | The schema of a database consists of a list of aliased,

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

727658type SchemaType = [(Symbol,SchemumType)]

728659

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−

738660-- | `IsPGlabel` looks very much like the `IsLabel` class. Whereas

739661-- the overloaded label, `fromLabel` is used for column references,

740662-- `label`s are used for enum terms. A `label` is called with

@@ -749,104 +671,165 @@ data PGlabel (label :: Symbol) = PGlabel

749671-- | Renders a label

750672renderLabel :: KnownSymbol label => proxy label -> ByteString

751673renderLabel (_ :: proxy label) =

752− "\'" <> fromString (symbolVal (Proxy @label)) <> "\'"

674+ "\'" <> renderSymbol @label <> "\'"

753675-- | Renders a list of labels

754676renderLabels

755677 :: All KnownSymbol labels => NP PGlabel labels -> [ByteString]

756678renderLabels = hcollapse

757679 . hcmap (Proxy @KnownSymbol) (K . renderLabel)

758680

759−-- | The `PG` type family embeds a subset of Haskell types

760−-- as Postgres basic types.

761−--

762−-- >>> :kind! PG LocalTime

763−-- PG LocalTime :: PGType

764−-- = 'PGtimestamp

765−type family PG (hask :: Type) :: PGType where

766− PG Bool = 'PGbool

767− PG Int16 = 'PGint2

768− PG Int32 = 'PGint4

769− PG Int64 = 'PGint8

770− PG Word16 = 'PGint2

771− PG Word32 = 'PGint4

772− PG Word64 = 'PGint8

773− PG Scientific = 'PGnumeric

774− PG Float = 'PGfloat4

775− PG Double = 'PGfloat8

776− PG Char = 'PGchar 1

777− PG Text = 'PGtext

778− PG Lazy.Text = 'PGtext

779− PG ByteString = 'PGbytea

780− PG Lazy.ByteString = 'PGbytea

781− PG LocalTime = 'PGtimestamp

782− PG UTCTime = 'PGtimestamptz

783− PG Day = 'PGdate

784− PG TimeOfDay = 'PGtime

785− PG (TimeOfDay, TimeZone) = 'PGtimetz

786− PG DiffTime = 'PGinterval

787− PG UUID = 'PGuuid

788− PG (NetAddr IP) = 'PGinet

789− PG Value = 'PGjson

790− PG ty = TypeError

791− ('Text "There is no Postgres basic type for " ':<>: 'ShowType ty)

792−

793−-- | The `EnumFrom` type family embeds Haskell enum types, ADTs with

794−-- nullary constructors, as Postgres enum types

795−--

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

797−-- >>> instance Generic Schwarma

798−-- >>> instance HasDatatypeInfo Schwarma

799−-- >>> :kind! EnumFrom Schwarma

800−-- EnumFrom Schwarma :: PGType

801−-- = 'PGenum '["Beef", "Lamb", "Chicken"]

802−type family EnumFrom (hask :: Type) :: PGType where

803− EnumFrom hask = 'PGenum (LabelsFrom hask)

804−

805−-- | The `LabelsFrom` type family calculates the constructors of a

806−-- Haskell enum type.

807−--

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

809−-- >>> instance Generic Schwarma

810−-- >>> instance HasDatatypeInfo Schwarma

811−-- >>> :kind! LabelsFrom Schwarma

812−-- LabelsFrom Schwarma :: [Type.ConstructorName]

813−-- = '["Beef", "Lamb", "Chicken"]

814−type family LabelsFrom (hask :: Type) :: [Type.ConstructorName] where

815− LabelsFrom hask =

681+{- | The `PG` type family embeds a subset of Haskell types

682+as Postgres types. As an open type family, `PG` is extensible.

683+

684+>>> :kind! PG LocalTime

685+PG LocalTime :: PGType

686+= 'PGtimestamp

687+

688+>>> newtype MyDouble = My Double

689+>>> type instance PG MyDouble = 'PGfloat8

690+-}

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

692+type instance PG Bool = 'PGbool

693+type instance PG Int16 = 'PGint2

694+type instance PG Int32 = 'PGint4

695+type instance PG Int64 = 'PGint8

696+type instance PG Word16 = 'PGint2

697+type instance PG Word32 = 'PGint4

698+type instance PG Word64 = 'PGint8

699+type instance PG Scientific = 'PGnumeric

700+type instance PG Float = 'PGfloat4

701+type instance PG Double = 'PGfloat8

702+type instance PG Char = 'PGchar 1

703+type instance PG Text = 'PGtext

704+type instance PG Lazy.Text = 'PGtext

705+type instance PG String = 'PGtext

706+type instance PG ByteString = 'PGbytea

707+type instance PG Lazy.ByteString = 'PGbytea

708+type instance PG LocalTime = 'PGtimestamp

709+type instance PG UTCTime = 'PGtimestamptz

710+type instance PG Day = 'PGdate

711+type instance PG TimeOfDay = 'PGtime

712+type instance PG (TimeOfDay, TimeZone) = 'PGtimetz

713+type instance PG DiffTime = 'PGinterval

714+type instance PG UUID = 'PGuuid

715+type instance PG (NetAddr IP) = 'PGinet

716+type instance PG Value = 'PGjson

717+type instance PG (Json hask) = 'PGjson

718+type instance PG (Jsonb hask) = 'PGjsonb

719+type instance PG (Vector hask) = 'PGvararray (NullPG hask)

720+type instance PG (hask, hask) = 'PGfixarray 2 (NullPG hask)

721+type instance PG (hask, hask, hask) = 'PGfixarray 3 (NullPG hask)

722+type instance PG (hask, hask, hask, hask) = 'PGfixarray 4 (NullPG hask)

723+type instance PG (hask, hask, hask, hask, hask) = 'PGfixarray 5 (NullPG hask)

724+type instance PG (hask, hask, hask, hask, hask, hask)

725+ = 'PGfixarray 6 (NullPG hask)

726+type instance PG (hask, hask, hask, hask, hask, hask, hask)

727+ = 'PGfixarray 7 (NullPG hask)

728+type instance PG (hask, hask, hask, hask, hask, hask, hask, hask)

729+ = 'PGfixarray 8 (NullPG hask)

730+type instance PG (hask, hask, hask, hask, hask, hask, hask, hask, hask)

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+

761+{-| The `LabelsPG` type family calculates the constructors of a

762+Haskell enum type.

763+

764+>>> data Schwarma = Beef | Lamb | Chicken deriving GHC.Generic

765+>>> instance Generic Schwarma

766+>>> instance HasDatatypeInfo Schwarma

767+>>> :kind! LabelsPG Schwarma

768+LabelsPG Schwarma :: [Type.ConstructorName]

769+= '["Beef", "Lamb", "Chicken"]

770+-}

771+type family LabelsPG (hask :: Type) :: [Type.ConstructorName] where

772+ LabelsPG hask =

816773 ConstructorNamesOf (ConstructorsOf (DatatypeInfoOf hask))

817774

818−-- | The `CompositeFrom` type family embeds Haskell record types as

819−-- Postgres composite types, as long as the record fields

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

824−-- >>> instance Generic Row

825−-- >>> instance HasDatatypeInfo Row

826−-- >>> :kind! CompositeFrom Row

827−-- CompositeFrom Row :: PGType

828−-- = 'PGcomposite '['("a", 'PGint2), '("b", 'PGtimestamp)]

829−type family CompositeFrom (hask :: Type) :: PGType where

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

849− FieldTypesFrom hask = FieldTypesOf (RecordCodeOf hask (Code hask))

775+{- | `RowPG` turns a Haskell record type into a `RowType`.

776+

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

778+>>> instance Generic Person

779+>>> instance HasDatatypeInfo Person

780+>>> :kind! RowPG Person

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

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

783+-}

784+type family RowPG (hask :: Type) :: RowType where

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

850833

851834-- | Calculates constructors of a datatype.

852835type family ConstructorsOf (datatype :: Type.DatatypeInfo)

@@ -875,47 +858,23 @@ type family ConstructorNamesOf (constructors :: [Type.ConstructorInfo])

875858 ConstructorNamesOf (constructor ': constructors) =

876859 ConstructorNameOf constructor ': ConstructorNamesOf constructors

877860

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−

916861-- | Is a type a valid JSON key?

917−type PGjsonKey key = key `In` '[ 'PGint2, 'PGint4, 'PGtext ]

862+type PGJsonKey = '[ 'PGint2, 'PGint4, 'PGtext ]

918863

919864-- | Is a type a valid JSON type?

920−type PGjson_ json = json `In` '[ 'PGjson, 'PGjsonb ]

921−

865+type PGJsonType = '[ 'PGjson, 'PGjsonb ]

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.

99-}

1010

1111{-# LANGUAGE

12− FlexibleContexts

12+ DataKinds

13+ , FlexibleContexts

1314 , LambdaCase

1415 , OverloadedStrings

16+ , TypeInType

1517#-}

1618

1719module Squeal.PostgreSQL.Transaction

@@ -39,7 +41,6 @@ import Control.Exception.Lifted

3941import Control.Monad.Base

4042import Control.Monad.Trans.Control

4143import Data.ByteString

42−import Data.Monoid

4344import Generics.SOP

4445

4546import qualified Database.PostgreSQL.LibPQ as LibPQ

@@ -69,16 +70,16 @@ transactionally_

6970transactionally_ = transactionally defaultMode

7071

7172-- | @BEGIN@ a transaction.

72−begin :: MonadPQ schema tx => TransactionMode -> tx (K Result NilRelation)

73+begin :: MonadPQ schema tx => TransactionMode -> tx (K Result ('[] :: RowType))

7374begin mode = manipulate . UnsafeManipulation $

7475 "BEGIN" <+> renderTransactionMode mode <> ";"

7576

7677-- | @COMMIT@ a schema invariant transaction.

77−commit :: MonadPQ schema tx => tx (K Result NilRelation)

78+commit :: MonadPQ schema tx => tx (K Result ('[] :: RowType))

7879commit = manipulate $ UnsafeManipulation "COMMIT;"

7980

8081-- | @ROLLBACK@ a schema invariant transaction.

81−rollback :: MonadPQ schema tx => tx (K Result NilRelation)

82+rollback :: MonadPQ schema tx => tx (K Result ('[] :: RowType))

8283rollback = manipulate $ UnsafeManipulation "ROLLBACK;"

8384

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

22packages:

33- squeal-postgresql