dca9667 · squeal · git.iko.soy

git.iko.soy/squeal

Merge branch 'json' of github.com:mikeplus64/squeal into json

commitdca9667a6c8998e42f25bf7dfed1bc0a50ba4bc0 authorMike Ledger <mike@quasimal.com> dateWed 18 Jul 2018, 13:25 (8 years ago) parent0d4e3c8 1831855

12 files changed+258−128

compare with dev

unifiedsplit

RELEASE NOTES.md+9

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

11## RELEASE NOTES

3+### Version 0.3.1 - July 7, 2018

5+Version 0.3.1 of Squeal enables the "Scrap your Nils" trick for

6+heterogeneous lists of `Alias`es, `Aliased` expressions, `PGlabel`s and `By`s

7+with the typeclasses `IsLabel`, `IsQualified`, `IsPGlabel`,

8+and the new `Aliasable` typeclass, to eliminate all need of using `Nil` in a list.

9+There were a couple minor name changes, i.e. the function `group` was renamed to `groupBy`.

10+Please consult the documentation.

11+

312### Version 0.3 - June 26, 2018

413

514Version 0.3 of Squeal adds views as well as composite and enumerated types to Squeal.

scrap-your-nils.mdnew file+60

@@ -0,0 +1,60 @@

1+## Scrap your Nils

3+One of the most useful types I've come across in Haskell is the type of

4+"heterogeneous lists". This is the same as the [Rec](http://hackage.haskell.org/package/vinyl-0.8.1.1/docs/Data-Vinyl-Core.html)

5+datatype from the [vinyl](http://hackage.haskell.org/package/vinyl) library.

6+It's also the same as the [NP](http://hackage.haskell.org/package/generics-sop-0.3.2.0/docs/Generics-SOP-NP.html)

7+datatype from the [generics-sop](http://hackage.haskell.org/package/generics-sop) library.

8+Squeal makes heavy use of this type.

10+```Haskell

11+>>> import Generics.SOP (NP(..))

12+>>> :i NP

13+type role NP representational nominal

14+data NP (a :: k -> *) (b :: [k]) where

15+ Nil :: forall k (a :: k -> *). NP a '[]

16+ (:*) :: forall k (a :: k -> *) (x :: k) (xs :: [k]).

17+ (a x) -> (NP a xs) -> NP a (x : xs)

18+ -- Defined in ‘Generics.SOP.NP’

19+```

20+

21+This type allows us to construct "product" types, where the types of the individual

22+"terms" are hosted at the type level.

23+

24+```Haskell

25+>>> :set -XDataKinds

26+>>> import Generics.SOP (I(..))

27+>>> let example = I "foo" :* I pi :* Nil :: NP I '[String, Double]

28+>>> example

29+I "foo" :* I 3.141592653589793 :* Nil

30+```

31+

32+One thing Squeal uses `NP` for is to form lists of aliases,

33+using GHC's `OverloadedLabels` extension, hosting the names

34+of the aliases themselves at the type level.

35+

36+```Haskell

37+>>> :set -XKindSignatures -XOverloadedLabels -XFlexibleInstances -XMultiParamTypeClasses

38+>>> import GHC.TypeLits

39+>>> import GHC.OverloadedLabels

40+>>> data Alias (alias :: Symbol) = Alias deriving (Eq,Ord,Show)

41+>>> instance IsLabel label (Alias label) where fromLabel = Alias

42+>>> let aliases = #foo :* #bar :* Nil :: NP Alias '["foo", "bar"]

43+```

44+

45+However, it's very ugly to have to end every list with `:* Nil`.

46+When I announced the release of Squeal, people rightly [complained](https://www.reddit.com/r/haskell/comments/6yr5v6/announcing_squeal_a_deep_embedding_of_sql_in/dmq8vvn)

47+about the syntactic noise. Luckily, there's a neat trick we can use to get rid of it.

48+Making an `IsLabel` instance not only for elements of our list

49+but also for lists of length 1, we can ask GHC to interpret

50+the last label as a list.

51+

52+```Haskell

53+>>> instance IsLabel label (NP Alias '[label]) where fromLabel = Alias :* Nil

54+>>> let aliases' = #foo :* #bar :: NP Alias '["foo", "bar"]

55+```

56+

57+Version 0.3.1 of Squeal enables the "Scrap your Nils" trick for

58+heterogeneous lists of `Alias`es, `Aliased` expressions, `PGlabel`s and `By`s

59+with the typeclasses `IsLabel`, `IsQualified`, `IsPGlabel`,

60+and the new `Aliasable` typeclass, to eliminate all need of using `Nil` in a list.

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

@@ -44,18 +44,18 @@ type Schema =

4444setup :: Definition '[] Schema

4545setup =

4646 createTable #users

47− ( serial `As` #id :*

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

49− (vararray int2 & notNullable) `As` #vec :* Nil )

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

47+ ( serial `as` #id :*

48+ (text & notNullable) `as` #name :*

49+ (vararray int2 & notNullable) `as` #vec )

50+ ( primaryKey #id `as` #pk_users )

5151 >>>

5252 createTable #emails

53− ( serial `As` #id :*

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

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

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

53+ ( serial `as` #id :*

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

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

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

5757 foreignKey #user_id #users #id

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

58+ OnDeleteCascade OnUpdateCascade `as` #fk_user_id )

5959

6060teardown :: Definition Schema '[]

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

@@ -63,14 +63,14 @@ teardown = dropTable #emails >>> dropTable #users

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

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

6565insertUser = insertRows #users

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

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

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

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

6868

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

7070insertEmail = insertRows #emails

71− ( Default `As` #id :*

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

73− Set (param @2) `As` #email :* Nil ) []

71+ ( Default `as` #id :*

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

73+ Set (param @2) `as` #email ) []

7474 OnConflictDoNothing (Returning Nil)

7575

7676getUsers :: Query Schema '[]

@@ -78,9 +78,9 @@ getUsers :: Query Schema '[]

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

7979 , "userVec" ::: 'NotNull ('PGvararray 'PGint2)]

8080getUsers = select

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

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

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

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

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

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

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

8585

8686data User = User { userName :: Text, userEmail :: Maybe Text, userVec :: Vector (Maybe Int16) }

squeal-postgresql/squeal-postgresql.cabal+2−1

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

11name: squeal-postgresql

2−version: 0.3.0.0

2+version: 0.3.1.0

33synopsis: Squeal PostgreSQL Library

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

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

@@ -50,6 +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

5354 , resource-pool >= 0.2.3.2

5455 , scientific >= 0.3.5.3

5556 , text >= 1.2.3.0

squeal-postgresql/src/Squeal/PostgreSQL.hs+16−16

@@ -71,16 +71,16 @@ let

7171 setup :: Definition '[] Schema

7272 setup =

7373 createTable #users

74− ( serial `As` #id :*

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

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

74+ ( serial `as` #id :*

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

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

7777 createTable #emails

78− ( serial `As` #id :*

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

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

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

78+ ( serial `as` #id :*

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

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

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

8282 foreignKey #user_id #users #id

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

83+ OnDeleteCascade OnUpdateCascade `as` #fk_user_id )

8484:}

8585

8686We can easily see the generated SQL is unsurprising looking.

@@ -119,17 +119,17 @@ of our inserts.

119119let

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

121121 insertUser = insertRow #users

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

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

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

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

124124:}

125125

126126>>> :{

127127let

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

129129 insertEmail = insertRow #emails

130− ( Default `As` #id :*

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

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

130+ ( Default `as` #id :*

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

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

133133 OnConflictDoNothing (Returning Nil)

134134:}

135135

@@ -149,9 +149,9 @@ let

149149 '[ "userName" ::: 'NotNull 'PGtext

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

151151 getUsers = select

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

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

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

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

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

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

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

156156:}

157157

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

@@ -27,7 +27,7 @@ let

2727 query :: Query '[]

2828 '[ 'NotNull 'PGint2, 'NotNull 'PGtext]

2929 '["col1" ::: 'NotNull 'PGint2, "col2" ::: 'NotNull 'PGtext]

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

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

3131:}

3232

3333>>> :{

@@ -88,7 +88,7 @@ let

8888 querySchwarma :: Query Schema

8989 '[ 'NotNull (EnumFrom Schwarma)]

9090 '["fromOnly" ::: 'NotNull (EnumFrom Schwarma)]

91− querySchwarma = values_ (parameter @1 #schwarma `As` #fromOnly :* Nil)

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

9292:}

9393

9494>>> :{

@@ -96,7 +96,7 @@ let

9696 queryPerson :: Query Schema

9797 '[ 'NotNull (CompositeFrom Person)]

9898 '["fromOnly" ::: 'NotNull (CompositeFrom Person)]

99− queryPerson = values_ (parameter @1 #person `As` #fromOnly :* Nil)

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

100100:}

101101

102102And finally drop the types.

squeal-postgresql/src/Squeal/PostgreSQL/Definition.hs+59−34

@@ -129,8 +129,17 @@ CREATE statements

129129

130130>>> :set -XOverloadedLabels

131131>>> :{

132−printSQL $

133− createTable #tab ((int & nullable) `As` #a :* (real & nullable) `As` #b :* Nil) Nil

132+type Table = '[] :=>

133+ '[ "a" ::: 'NoDef :=> 'Null 'PGint4

134+ , "b" ::: 'NoDef :=> 'Null 'PGfloat4 ]

135+:}

136+

137+>>> :{

138+let

139+ setup :: Definition '[] '["tab" ::: 'Table Table]

140+ setup = createTable #tab

141+ (nullable int `as` #a :* nullable real `as` #b) Nil

142+in printSQL setup

134143:}

135144CREATE TABLE "tab" ("a" int NULL, "b" real NULL);

136145-}

@@ -155,12 +164,19 @@ Instead, the schema already has the table so if the table did not yet exist, the

155164the `Category` of `Definition`s.

156165

157166>>> :set -XOverloadedLabels -XTypeApplications

158−>>> type Table = '[] :=> '["a" ::: 'NoDef :=> 'Null 'PGint4, "b" ::: 'NoDef :=> 'Null 'PGfloat4]

167+>>> :{

168+type Table = '[] :=>

169+ '[ "a" ::: 'NoDef :=> 'Null 'PGint4

170+ , "b" ::: 'NoDef :=> 'Null 'PGfloat4 ]

171+:}

172+

159173>>> type Schema = '["tab" ::: 'Table Table]

174+

160175>>> :{

161176let

162177 setup :: Definition Schema Schema

163− setup = createTableIfNotExists #tab ((int & nullable) `As` #a :* (real & nullable) `As` #b :* Nil) Nil

178+ setup = createTableIfNotExists #tab

179+ (nullable int `as` #a :* nullable real `as` #b) Nil

164180in printSQL setup

165181:}

166182CREATE TABLE IF NOT EXISTS "tab" ("a" int NULL, "b" real NULL);

@@ -244,9 +260,9 @@ type Schema = '[

244260let

245261 definition :: Definition '[] Schema

246262 definition = createTable #tab

247− ( (int & notNullable) `As` #a :*

248− (int & notNullable) `As` #b :* Nil )

249− ( check (#a :* #b :* Nil) (#a .> #b) `As` #inequality :* Nil )

263+ ( (int & notNullable) `as` #a :*

264+ (int & notNullable) `as` #b )

265+ ( check (#a :* #b) (#a .> #b) `as` #inequality )

250266:}

251267

252268>>> printSQL definition

@@ -278,9 +294,9 @@ type Schema = '[

278294let

279295 definition :: Definition '[] Schema

280296 definition = createTable #tab

281− ( (int & nullable) `As` #a :*

282− (int & nullable) `As` #b :* Nil )

283− ( unique (#a :* #b :* Nil) `As` #uq_a_b :* Nil )

297+ ( (int & nullable) `as` #a :*

298+ (int & nullable) `as` #b )

299+ ( unique (#a :* #b) `as` #uq_a_b )

284300:}

285301

286302>>> printSQL definition

@@ -311,9 +327,9 @@ type Schema = '[

311327let

312328 definition :: Definition '[] Schema

313329 definition = createTable #tab

314− ( serial `As` #id :*

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

316− ( primaryKey #id `As` #pk_id :* Nil )

330+ ( serial `as` #id :*

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

332+ ( primaryKey #id `as` #pk_id )

317333:}

318334

319335>>> printSQL definition

@@ -357,16 +373,16 @@ let

357373 setup :: Definition '[] Schema

358374 setup =

359375 createTable #users

360− ( serial `As` #id :*

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

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

376+ ( serial `as` #id :*

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

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

363379 createTable #emails

364− ( serial `As` #id :*

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

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

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

380+ ( serial `as` #id :*

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

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

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

368384 foreignKey #user_id #users #id

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

385+ OnDeleteCascade OnUpdateCascade `as` #fk_user_id )

370386in printSQL setup

371387:}

372388CREATE TABLE "users" ("id" serial, "name" text NOT NULL, CONSTRAINT "pk_users" PRIMARY KEY ("id"));

@@ -392,12 +408,12 @@ let

392408 setup :: Definition '[] Schema

393409 setup =

394410 createTable #employees

395− ( serial `As` #id :*

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

397− (integer & nullable) `As` #employer_id :* Nil )

398− ( primaryKey #id `As` #employees_pk :*

411+ ( serial `as` #id :*

412+ (text & notNullable) `as` #name :*

413+ (integer & nullable) `as` #employer_id )

414+ ( primaryKey #id `as` #employees_pk :*

399415 foreignKey #employer_id #employees #id

400− OnDeleteCascade OnUpdateCascade `As` #employees_employer_fk :* Nil )

416+ OnDeleteCascade OnUpdateCascade `as` #employees_employer_fk )

401417in printSQL setup

402418:}

403419CREATE TABLE "employees" ("id" serial, "name" text NOT NULL, "employer_id" integer NULL, CONSTRAINT "employees_pk" PRIMARY KEY ("id"), CONSTRAINT "employees_employer_fk" FOREIGN KEY ("employer_id") REFERENCES "employees" ("id") ON DELETE CASCADE ON UPDATE CASCADE);

@@ -546,7 +562,7 @@ newtype AlterTable

546562-- definition :: Definition

547563-- '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'NotNull 'PGint4])]

548564-- '["tab" ::: 'Table ('["positive" ::: Check '["col"]] :=> '["col" ::: 'NoDef :=> 'NotNull 'PGint4])]

549−-- definition = alterTable #tab (addConstraint #positive (check (#col :* Nil) (#col .> 0)))

565+-- definition = alterTable #tab (addConstraint #positive (check #col (#col .> 0)))

550566-- in printSQL definition

551567-- :}

552568-- ALTER TABLE "tab" ADD CONSTRAINT "positive" CHECK (("col" > 0));

@@ -784,7 +800,7 @@ alterType ty = UnsafeAlterColumn $ "TYPE" <+> renderColumnTypeExpression ty

784800-- '[ "abc" ::: 'Table ('[] :=> '["a" ::: 'NoDef :=> 'Null 'PGint4, "b" ::: 'NoDef :=> 'Null 'PGint4, "c" ::: 'NoDef :=> 'Null 'PGint4])

785801-- , "bc" ::: 'View ('["b" ::: 'Null 'PGint4, "c" ::: 'Null 'PGint4])]

786802-- definition =

787−-- createView #bc (select (#b :* #c :* Nil) (from (table #abc)))

803+-- createView #bc (select (#b :* #c) (from (table #abc)))

788804-- in printSQL definition

789805-- :}

790806-- CREATE VIEW "bc" AS SELECT "b" AS "b", "c" AS "c" FROM "abc" AS "abc";

@@ -818,7 +834,7 @@ dropView v = UnsafeDefinition $ "DROP VIEW" <+> renderAlias v <> ";"

818834

819835-- | Enumerated types are created using the `createTypeEnum` command, for example

820836--

821−-- >>> printSQL $ createTypeEnum #mood (label @"sad" :* label @"ok" :* label @"happy" :* Nil)

837+-- >>> printSQL $ createTypeEnum #mood (label @"sad" :* label @"ok" :* label @"happy")

822838-- CREATE TYPE "mood" AS ENUM ('sad', 'ok', 'happy');

823839createTypeEnum

824840 :: (KnownSymbol enum, SOP.All KnownSymbol labels)

@@ -850,11 +866,20 @@ createTypeEnumFrom

850866createTypeEnumFrom enum = createTypeEnum enum

851867 (SOP.hpure label :: NP PGlabel (LabelsFrom hask))

852868

853−-- | `createTypeComposite` creates a composite type. The composite type is

854−-- specified by a list of attribute names and data types.

855−--

856−-- >>> printSQL $ createTypeComposite #complex (float8 `As` #real :* float8 `As` #imaginary :* Nil)

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

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

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

871+

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

873+

874+>>> :{

875+let

876+ setup :: Definition '[] '["complex" ::: 'Typedef PGcomplex]

877+ setup = createTypeComposite #complex

878+ (float8 `as` #real :* float8 `as` #imaginary)

879+in printSQL setup

880+:}

881+CREATE TYPE "complex" AS ("real" float8, "imaginary" float8);

882+-}

858883createTypeComposite

859884 :: (KnownSymbol ty, SOP.SListI fields)

860885 => Alias ty

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

@@ -448,7 +448,7 @@ instance (KnownSymbol label, label `In` labels) => IsPGlabel label

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

449449--

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

451−-- >>> let i = row (0 `As` #real :* 1 `As` #imaginary :* Nil) :: Expression '[] '[] 'Ungrouped '[] ('NotNull Complex)

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

452452-- >>> printSQL i

453453-- ROW(0, 1)

454454row

squeal-postgresql/src/Squeal/PostgreSQL/Manipulation.hs+14−14

@@ -72,7 +72,7 @@ let

7272 '[ "col1" ::: 'NoDef :=> 'NotNull 'PGint4

7373 , "col2" ::: 'Def :=> 'NotNull 'PGint4 ])] '[] '[]

7474 manipulation =

75− insertRow_ #tab (Set 2 `As` #col1 :* Default `As` #col2 :* Nil)

75+ insertRow_ #tab (Set 2 `as` #col1 :* Default `as` #col2)

7676in printSQL manipulation

7777:}

7878INSERT INTO "tab" ("col1", "col2") VALUES (2, DEFAULT)

@@ -88,7 +88,7 @@ let

8888 '[ 'NotNull 'PGint4, 'NotNull 'PGint4 ] '[]

8989 manipulation =

9090 insertRow_ #tab

91− (Set (param @1) `As` #col1 :* Set (param @2) `As` #col2 :* Nil)

91+ (Set (param @1) `as` #col1 :* Set (param @2) `as` #col2)

9292in printSQL manipulation

9393:}

9494INSERT INTO "tab" ("col1", "col2") VALUES (($1 :: int4), ($2 :: int4))

@@ -103,8 +103,8 @@ let

103103 , "col2" ::: 'Def :=> 'NotNull 'PGint4 ])] '[]

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

105105 manipulation =

106− insertRow #tab (Set 2 `As` #col1 :* Default `As` #col2 :* Nil)

107− OnConflictDoRaise (Returning (#col1 `As` #fromOnly :* Nil))

106+ insertRow #tab (Set 2 `as` #col1 :* Default `as` #col2)

107+ OnConflictDoRaise (Returning (#col1 `as` #fromOnly))

108108in printSQL manipulation

109109:}

110110INSERT INTO "tab" ("col1", "col2") VALUES (2, DEFAULT) RETURNING "col1" AS "fromOnly"

@@ -120,12 +120,12 @@ let

120120 '[] '[ "sum" ::: 'NotNull 'PGint4]

121121 manipulation =

122122 insertRows #tab

123− (Set 2 `As` #col1 :* Set 4 `As` #col2 :* Nil)

124− [Set 6 `As` #col1 :* Set 8 `As` #col2 :* Nil]

123+ (Set 2 `as` #col1 :* Set 4 `as` #col2)

124+ [Set 6 `as` #col1 :* Set 8 `as` #col2]

125125 (OnConflictDoUpdate

126− (Set 2 `As` #col1 :* Same `As` #col2 :* Nil)

126+ (Set 2 `as` #col1 :* Same `as` #col2)

127127 [#col1 .== #col2])

128− (Returning $ (#col1 + #col2) `As` #sum :* Nil)

128+ (Returning $ (#col1 + #col2) `as` #sum)

129129in printSQL manipulation

130130:}

131131INSERT INTO "tab" ("col1", "col2") VALUES (2, 4), (6, 8) ON CONFLICT DO UPDATE SET "col1" = 2 WHERE ("col1" = "col2") RETURNING ("col1" + "col2") AS "sum"

@@ -146,7 +146,7 @@ let

146146 ] '[] '[]

147147 manipulation =

148148 insertQuery_ #tab

149− (selectStar (from (table (#other_tab `As` #t))))

149+ (selectStar (from (table (#other_tab `as` #t))))

150150in printSQL manipulation

151151:}

152152INSERT INTO "tab" SELECT * FROM "other_tab" AS "t"

@@ -160,7 +160,7 @@ let

160160 '[ "col1" ::: 'NoDef :=> 'NotNull 'PGint4

161161 , "col2" ::: 'NoDef :=> 'NotNull 'PGint4 ])] '[] '[]

162162 manipulation =

163− update_ #tab (Set 2 `As` #col1 :* Same `As` #col2 :* Nil)

163+ update_ #tab (Set 2 `as` #col1 :* Same `as` #col2)

164164 (#col1 ./= #col2)

165165in printSQL manipulation

166166:}

@@ -484,16 +484,16 @@ WITH statements

484484-- let

485485-- manipulation :: Manipulation '["products" ::: 'Table ProductsTable, "products_deleted" ::: 'Table ProductsTable] '[ 'NotNull 'PGdate] '[]

486486-- manipulation = with

487−-- (deleteFrom #products (#date .< param @1) ReturningStar `As` #deleted_rows :* Nil)

488−-- (insertQuery_ #products_deleted (selectStar (from (view (#deleted_rows `As` #t)))))

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

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

489489-- in printSQL manipulation

490490-- :}

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

492492with

493493 :: SOP.SListI commons

494− => NP (Aliased (Manipulation schema params)) commons

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

495495 -- ^ common table expressions

496− -> Manipulation (With commons schema) params results

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

497497 -> Manipulation schema params results

498498with commons manipulation = UnsafeManipulation $

499499 "WITH" <+> renderCommaSeparated renderCommon commons

squeal-postgresql/src/Squeal/PostgreSQL/Migration.hs+16−16

@@ -36,9 +36,9 @@ let

3636 { name = "make users table"

3737 , up = void . define $

3838 createTable #users

39− ( serial `As` #id :*

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

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

39+ ( serial `as` #id :*

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

41+ ( primaryKey #id `as` #pk_users )

4242 , down = void . define $ dropTable #users

4343 }

4444:}

@@ -51,12 +51,12 @@ let

5151 { name = "make emails table"

5252 , up = void . define $

5353 createTable #emails

54− ( serial `As` #id :*

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

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

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

54+ ( serial `as` #id :*

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

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

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

5858 foreignKey #user_id #users #id

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

59+ OnDeleteCascade OnUpdateCascade `as` #fk_user_id )

6060 , down = void . define $ dropTable #emails

6161 }

6262:}

@@ -71,7 +71,7 @@ let

7171 :: Has "schema_migrations" schema ('Table MigrationsTable)

7272 => PQ schema schema IO ()

7373 numMigrations = do

74− result <- runQuery (selectStar (from (table (#schema_migrations `As` #m))))

74+ result <- runQuery (selectStar (from (table (#schema_migrations `as` #m))))

7575 num <- ntuples result

7676 liftBase $ print num

7777:}

@@ -285,18 +285,18 @@ createMigrations

285285 => Definition schema schema

286286createMigrations =

287287 createTableIfNotExists #schema_migrations

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

288+ ( (text & notNullable) `as` #name :*

289289 (timestampWithTimeZone & notNullable & default_ currentTimestamp)

290− `As` #executed_at :* Nil )

291− ( unique (#name :* Nil) `As` #migrations_unique_name :* Nil )

290+ `as` #executed_at )

291+ ( unique #name `as` #migrations_unique_name )

292292

293293-- | Inserts a `Migration` into the `MigrationsTable`

294294insertMigration

295295 :: Has "schema_migrations" schema ('Table MigrationsTable)

296296 => Manipulation schema '[ 'NotNull 'PGtext] '[]

297297insertMigration = insertRow_ #schema_migrations

298− ( Set (param @1) `As` #name :*

299− Default `As` #executed_at :* Nil )

298+ ( Set (param @1) `as` #name :*

299+ Default `as` #executed_at )

300300

301301-- | Deletes a `Migration` from the `MigrationsTable`

302302deleteMigration

@@ -311,6 +311,6 @@ selectMigration

311311 => Query schema '[ 'NotNull 'PGtext ]

312312 '[ "executed_at" ::: 'NotNull 'PGtimestamptz ]

313313selectMigration = select

314− (#executed_at `As` #executed_at :* Nil)

315− ( from (table (#schema_migrations `As` #m))

314+ (#executed_at `as` #executed_at)

315+ ( from (table (#schema_migrations `as` #m))

316316 & where_ (#name .== param @1))

squeal-postgresql/src/Squeal/PostgreSQL/Query.hs+38−23

@@ -12,15 +12,19 @@ Squeal queries.

1212 ConstraintKinds

1313 , DeriveGeneric

1414 , FlexibleContexts

15+ , FlexibleInstances

1516 , GADTs

1617 , GeneralizedNewtypeDeriving

1718 , LambdaCase

19+ , MultiParamTypeClasses

1820 , OverloadedStrings

1921 , StandaloneDeriving

22+ , TypeFamilies

2023 , TypeInType

2124 , TypeOperators

2225 , RankNTypes

23−#-}

26+ , UndecidableInstances

27+ #-}

2428

2529module Squeal.PostgreSQL.Query

2630 ( -- * Queries

@@ -45,7 +49,7 @@ module Squeal.PostgreSQL.Query

4549 , renderTableExpression

4650 , from

4751 , where_

48− , group

52+ , groupBy

4953 , having

5054 , orderBy

5155 , limit

@@ -76,7 +80,7 @@ module Squeal.PostgreSQL.Query

7680 , rightOuterJoin

7781 , fullOuterJoin

7882 -- * Grouping

79− , By (By, By2)

83+ , By (By1, By2)

8084 , renderBy

8185 , GroupByClause (NoGroups, Group)

8286 , renderGroupByClause

@@ -133,7 +137,7 @@ let

133137 , "col1" ::: 'NotNull 'PGint4 ]

134138 query =

135139 select

136− ((#col1 + #col2) `As` #sum :* #col1 :* Nil)

140+ ((#col1 + #col2) `as` #sum :* #col1)

137141 ( from (table #tab)

138142 & where_ (#col1 .> #col2)

139143 & where_ (#col2 .> 0) )

@@ -151,7 +155,7 @@ let

151155 '["col" ::: 'Null 'PGint4]

152156 query =

153157 selectStar

154− (from (subquery (selectStar (from (table #tab)) `As` #sub)))

158+ (from (subquery (selectStar (from (table #tab)) `as` #sub)))

155159in printSQL query

156160:}

157161SELECT * FROM (SELECT * FROM "tab" AS "tab") AS "sub"

@@ -196,9 +200,9 @@ let

196200 '[ "sum" ::: 'NotNull 'PGint4

197201 , "col1" ::: 'NotNull 'PGint4 ]

198202 query =

199− select (sum_ #col2 `As` #sum :* #col1 :* Nil)

200− ( from (table (#tab `As` #table1))

201− & group (By #col1 :* Nil)

203+ select (sum_ #col2 `as` #sum :* #col1)

204+ ( from (table (#tab `as` #table1))

205+ & groupBy #col1

202206 & having (#col1 + sum_ #col2 .> 1) )

203207in printSQL query

204208:}

@@ -250,13 +254,13 @@ let

250254 , "shipper_name" ::: 'NotNull 'PGtext

251255 ]

252256 query = select

253− ( #o ! #price `As` #order_price :*

254− #c ! #name `As` #customer_name :*

255− #s ! #name `As` #shipper_name :* Nil )

256− ( from (table (#orders `As` #o)

257− & innerJoin (table (#customers `As` #c))

257+ ( #o ! #price `as` #order_price :*

258+ #c ! #name `as` #customer_name :*

259+ #s ! #name `as` #shipper_name )

260+ ( from (table (#orders `as` #o)

261+ & innerJoin (table (#customers `as` #c))

258262 (#o ! #customer_id .== #c ! #id)

259− & innerJoin (table (#shippers `As` #s))

263+ & innerJoin (table (#shippers `as` #s))

260264 (#o ! #shipper_id .== #s ! #id)) )

261265in printSQL query

262266:}

@@ -271,7 +275,7 @@ let

271275 '[]

272276 '["col" ::: 'Null 'PGint4]

273277 query = selectDotStar #t1

274− (from (table (#tab `As` #t1) & crossJoin (table (#tab `As` #t2))))

278+ (from (table (#tab `as` #t1) & crossJoin (table (#tab `as` #t2))))

275279in printSQL query

276280:}

277281SELECT "t1".* FROM "tab" AS "t1" CROSS JOIN "tab" AS "t2"

@@ -451,7 +455,7 @@ selectDistinctDotStar rel relations = UnsafeQuery $

451455-- but it can be used on its own.

452456--

453457-- >>> type Row = '["a" ::: 'NotNull 'PGint4, "b" ::: 'NotNull 'PGtext]

454−-- >>> let query = values (1 `As` #a :* "one" `As` #b :* Nil) [] :: Query '[] '[] Row

458+-- >>> let query = values (1 `as` #a :* "one" `as` #b) [] :: Query '[] '[] Row

455459-- >>> printSQL query

456460-- SELECT * FROM (VALUES (1, E'one')) AS t ("a", "b")

457461values

@@ -589,15 +593,15 @@ where_

589593 -> TableExpression schema params relations grouping

590594where_ wh rels = rels {whereClause = wh : whereClause rels}

591595

592−-- | A `group` is a transformation of `TableExpression`s which switches

596+-- | A `groupBy` is a transformation of `TableExpression`s which switches

593597-- its `Grouping` from `Ungrouped` to `Grouped`. Use @group Nil@ to perform

594598-- a "grand total" aggregation query.

595−group

599+groupBy

596600 :: SListI bys

597601 => NP (By relations) bys -- ^ grouped columns

598602 -> TableExpression schema params relations 'Ungrouped

599603 -> TableExpression schema params relations ('Grouped bys)

600−group bys rels = TableExpression

604+groupBy bys rels = TableExpression

601605 { fromClause = fromClause rels

602606 , whereClause = whereClause rels

603607 , groupByClause = Group bys

@@ -950,23 +954,34 @@ Grouping

950954data By

951955 (relations :: RelationsType)

952956 (by :: (Symbol,Symbol)) where

953− By

957+ By1

954958 :: (HasUnique relation relations columns, Has column columns ty)

955959 => Alias column

956960 -> By relations '(relation, column)

957961 By2

958962 :: (Has relation relations columns, Has column columns ty)

959− => (Alias relation, Alias column)

963+ => Alias relation

964+ -> Alias column

960965 -> By relations '(relation, column)

961966deriving instance Show (By relations by)

962967deriving instance Eq (By relations by)

963968deriving instance Ord (By relations by)

964969

970+instance (HasUnique rel rels cols, Has col cols ty, by ~ '(rel, col))

971+ => IsLabel col (By rels by) where fromLabel = By1 fromLabel

972+instance (HasUnique rel rels cols, Has col cols ty, bys ~ '[ '(rel, col)])

973+ => IsLabel col (NP (By rels) bys) where fromLabel = By1 fromLabel :* Nil

974+instance (Has rel rels cols, Has col cols ty, by ~ '(rel, col))

975+ => IsQualified rel col (By rels by) where (!) = By2

976+instance (Has rel rels cols, Has col cols ty, bys ~ '[ '(rel, col)])

977+ => IsQualified rel col (NP (By rels) bys) where

978+ rel ! col = By2 rel col :* Nil

979+

965980-- | Renders a `By`.

966981renderBy :: By relations by -> ByteString

967982renderBy = \case

968− By column -> renderAlias column

969− By2 (rel, column) -> renderAlias rel <> "." <> renderAlias column

983+ By1 column -> renderAlias column

984+ By2 rel column -> renderAlias rel <> "." <> renderAlias column

970985

971986-- | A `GroupByClause` indicates the `Grouping` of a `TableExpression`.

972987-- A `NoGroups` indicates `Ungrouped` while a `Group` indicates `Grouped`.

squeal-postgresql/src/Squeal/PostgreSQL/Schema.hs+23−3

@@ -60,6 +60,7 @@ module Squeal.PostgreSQL.Schema

6060 , renderAlias

6161 , renderAliases

6262 , Aliased (As)

63+ , Aliasable (as)

6364 , renderAliasedAs

6465 , AliasesOf

6566 , ZipAliased (..)

@@ -383,7 +384,7 @@ renderAliasString :: KnownSymbol alias => Alias alias -> ByteString

383384renderAliasString = singleQuotedText . fromString . symbolVal

384385

385386-- | >>> import Generics.SOP (NP(..))

386−-- >>> renderAliases (#jimbob :* #kandi :* Nil)

387+-- >>> renderAliases (#jimbob :* #kandi)

387388-- ["\"jimbob\"","\"kandi\""]

388389renderAliases

389390 :: All KnownSymbol aliases => NP Alias aliases -> [ByteString]

@@ -411,6 +412,23 @@ instance (alias0 ~ alias1, alias0 ~ alias2, KnownSymbol alias2)

411412 => IsLabel alias0 (Aliased Alias (alias1 ::: alias2)) where

412413 fromLabel = fromLabel @alias2 `As` fromLabel @alias1

413414

415+-- | The `Aliasable` class provides a way to scrap your `Nil`s

416+-- in an `NP` list of `Aliased` expressions.

417+class KnownSymbol alias => Aliasable alias expression aliased

418+ | aliased -> expression

419+ , aliased -> alias

420+ where as :: expression -> Alias alias -> aliased

421+instance (alias ~ alias1, KnownSymbol alias) => Aliasable alias

422+ (expression ty)

423+ (Aliased expression (alias1 ::: ty))

424+ where

425+ as = As

426+instance (KnownSymbol alias, tys ~ '[alias ::: ty]) => Aliasable alias

427+ (expression ty)

428+ (NP (Aliased expression) tys)

429+ where

430+ expression `as` alias = expression `As` alias :* Nil

431+

414432-- | >>> let renderMaybe = fromString . maybe "Nothing" (const "Just")

415433-- >>> renderAliasedAs renderMaybe (Just (3::Int) `As` #an_int)

416434-- "Just AS \"an_int\""

@@ -719,8 +737,10 @@ type family With

719737-- `label`s are used for enum terms. A `label` is called with

720738-- type application like `label @"beef"`.

721739class IsPGlabel (label :: Symbol) expr where label :: expr

722−instance label ~ label'

723− => IsPGlabel label (PGlabel label') where label = PGlabel

740+instance label ~ label1

741+ => IsPGlabel label (PGlabel label1) where label = PGlabel

742+instance labels ~ '[label]

743+ => IsPGlabel label (NP PGlabel labels) where label = PGlabel :* Nil

724744-- | A `PGlabel` unit type with an `IsPGlabel` instance

725745data PGlabel (label :: Symbol) = PGlabel

726746-- | Renders a label