1831855 · squeal · git.iko.soy

git.iko.soy/squeal

on dev help sign in

Merge branch 'master' into json

1831855Mike Ledger8 years ago

RELEASE NOTES.md+9

compare with dev

unifiedsplit

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

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

3### Version 0.3 - June 26, 2018

12### Version 0.3 - June 26, 2018

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

14Version 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 =

44setup :: Definition '[] Schema

45setup =

46 createTable #users

47− ( serial `As` #id :*

47+ ( serial `as` #id :*

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

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

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

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

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

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

51 >>>

52 createTable #emails

53− ( serial `As` #id :*

53+ ( serial `as` #id :*

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

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

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

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

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

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

57 foreignKey #user_id #users #id

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

58+ OnDeleteCascade OnUpdateCascade `as` #fk_user_id )

60teardown :: Definition Schema '[]

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

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

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

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

65insertUser = insertRows #users

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

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

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

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

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

70insertEmail = insertRows #emails

71− ( Default `As` #id :*

71+ ( Default `as` #id :*

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

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

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

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

74 OnConflictDoNothing (Returning Nil)

76getUsers :: Query Schema '[]

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

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

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

80getUsers = select

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

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

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

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

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

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

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

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

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

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

1name: squeal-postgresql

2−version: 0.3.0.0

2+version: 0.3.1.0

3synopsis: Squeal PostgreSQL Library

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

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

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

50 , network-ip >= 0.3.0.2

51 , postgresql-binary >= 0.12.1

52 , postgresql-libpq >= 0.9.4.1

53+ , profunctors >= 5.2.2

53 , resource-pool >= 0.2.3.2

54 , resource-pool >= 0.2.3.2

54 , scientific >= 0.3.5.3

55 , scientific >= 0.3.5.3

55 , text >= 1.2.3.0

56 , text >= 1.2.3.0

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

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

71 setup :: Definition '[] Schema

72 setup =

73 createTable #users

74− ( serial `As` #id :*

74+ ( serial `as` #id :*

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

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

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

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

77 createTable #emails

78− ( serial `As` #id :*

78+ ( serial `as` #id :*

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

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

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

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

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

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

82 foreignKey #user_id #users #id

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

83+ OnDeleteCascade OnUpdateCascade `as` #fk_user_id )

84:}

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

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

119let

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

121 insertUser = insertRow #users

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

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

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

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

124:}

125

126>>> :{

127let

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

129 insertEmail = insertRow #emails

130− ( Default `As` #id :*

130+ ( Default `as` #id :*

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

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

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

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

133 OnConflictDoNothing (Returning Nil)

134:}

135

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

149 '[ "userName" ::: 'NotNull 'PGtext

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

151 getUsers = select

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

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

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

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

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

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

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

156:}

157

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

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

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 :* Nil)

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

31:}

33>>> :{

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

88 querySchwarma :: Query Schema

89 '[ 'NotNull (EnumFrom Schwarma)]

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

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

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

92:}

94>>> :{

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

96 queryPerson :: Query Schema

97 '[ 'NotNull (CompositeFrom Person)]

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

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

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

100:}

101

102And finally drop the types.

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

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

129

130>>> :set -XOverloadedLabels

131>>> :{

132−printSQL $

132+type Table = '[] :=>

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

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

135+:}

136+

137+>>> :{

138+let

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

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

140+ setup = createTable #tab

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

142+in printSQL setup

134:}

143:}

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

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

136-}

145-}

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

155the `Category` of `Definition`s.

164the `Category` of `Definition`s.

156

165

157>>> :set -XOverloadedLabels -XTypeApplications

166>>> :set -XOverloadedLabels -XTypeApplications

167+>>> :{

168+type Table = '[] :=>

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

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

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

171+:}

172+

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

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

174+

160>>> :{

175>>> :{

161let

176let

162 setup :: Definition Schema Schema

177 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

164in printSQL setup

180in printSQL setup

165:}

181:}

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

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

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

244let

260let

245 definition :: Definition '[] Schema

261 definition :: Definition '[] Schema

246 definition = createTable #tab

262 definition = createTable #tab

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

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

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

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

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

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

250:}

266:}

251

267

252>>> printSQL definition

268>>> printSQL definition

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

278let

294let

279 definition :: Definition '[] Schema

295 definition :: Definition '[] Schema

280 definition = createTable #tab

296 definition = createTable #tab

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

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

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

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

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

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

284:}

300:}

285

301

286>>> printSQL definition

302>>> printSQL definition

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

311let

327let

312 definition :: Definition '[] Schema

328 definition :: Definition '[] Schema

313 definition = createTable #tab

329 definition = createTable #tab

314− ( serial `As` #id :*

330+ ( serial `as` #id :*

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

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

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

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

317:}

333:}

318

334

319>>> printSQL definition

335>>> printSQL definition

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

357 setup :: Definition '[] Schema

373 setup :: Definition '[] Schema

358 setup =

374 setup =

359 createTable #users

375 createTable #users

360− ( serial `As` #id :*

376+ ( serial `as` #id :*

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

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

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

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

363 createTable #emails

379 createTable #emails

364− ( serial `As` #id :*

380+ ( serial `as` #id :*

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

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

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

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

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

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

368 foreignKey #user_id #users #id

384 foreignKey #user_id #users #id

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

385+ OnDeleteCascade OnUpdateCascade `as` #fk_user_id )

370in printSQL setup

386in printSQL setup

371:}

387:}

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

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

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

392 setup :: Definition '[] Schema

408 setup :: Definition '[] Schema

393 setup =

409 setup =

394 createTable #employees

410 createTable #employees

395− ( serial `As` #id :*

411+ ( serial `as` #id :*

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

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

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

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

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

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

399 foreignKey #employer_id #employees #id

415 foreignKey #employer_id #employees #id

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

416+ OnDeleteCascade OnUpdateCascade `as` #employees_employer_fk )

401in printSQL setup

417in printSQL setup

402:}

418:}

403CREATE 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);

419CREATE 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

546-- definition :: Definition

562-- definition :: Definition

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

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

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

564-- '["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)))

550-- in printSQL definition

566-- in printSQL definition

551-- :}

567-- :}

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

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

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

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

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

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

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

786-- definition =

802-- definition =

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

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

788-- in printSQL definition

804-- in printSQL definition

789-- :}

805-- :}

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

806-- 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 <> ";"

818

834

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

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

820--

836--

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

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

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

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

823createTypeEnum

839createTypeEnum

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

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

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

850createTypeEnumFrom enum = createTypeEnum enum

866createTypeEnumFrom enum = createTypeEnum enum

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

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

852

868

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

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

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

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

855−--

871+

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

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

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

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

882+-}

858createTypeComposite

883createTypeComposite

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

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

860 => Alias ty

885 => Alias ty

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

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

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

449--

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

452-- >>> printSQL i

453-- ROW(0, 1)

454row

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

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

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

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

74 manipulation =

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

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

76in printSQL manipulation

77:}

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

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

88 '[ 'NotNull 'PGint4, 'NotNull 'PGint4 ] '[]

89 manipulation =

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

92in printSQL manipulation

93:}

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

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

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

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

105 manipulation =

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

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

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

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

108in printSQL manipulation

109:}

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

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

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

121 manipulation =

122 insertRows #tab

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

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

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

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

125 (OnConflictDoUpdate

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

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

127 [#col1 .== #col2])

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

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

129in printSQL manipulation

130:}

131INSERT 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

146 ] '[] '[]

147 manipulation =

148 insertQuery_ #tab

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

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

150in printSQL manipulation

151:}

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

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

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

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

162 manipulation =

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

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

164 (#col1 ./= #col2)

165in printSQL manipulation

166:}

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

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 :* Nil)

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

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

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"

492with

493 :: SOP.SListI commons

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

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

495 -- ^ common table expressions

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

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

497 -> Manipulation schema params results

498with commons manipulation = UnsafeManipulation $

499 "WITH" <+> renderCommaSeparated renderCommon commons

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

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

36 { name = "make users table"

37 , up = void . define $

38 createTable #users

39− ( serial `As` #id :*

39+ ( serial `as` #id :*

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

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

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

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

42 , down = void . define $ dropTable #users

43 }

44:}

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

51 { name = "make emails table"

52 , up = void . define $

53 createTable #emails

54− ( serial `As` #id :*

54+ ( serial `as` #id :*

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

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

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

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

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

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

58 foreignKey #user_id #users #id

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

59+ OnDeleteCascade OnUpdateCascade `as` #fk_user_id )

60 , down = void . define $ dropTable #emails

61 }

62:}

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

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

72 => PQ schema schema IO ()

73 numMigrations = do

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

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

75 num <- ntuples result

76 liftBase $ print num

77:}

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

285 => Definition schema schema

286createMigrations =

287 createTableIfNotExists #schema_migrations

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

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

289 (timestampWithTimeZone & notNullable & default_ currentTimestamp)

290− `As` #executed_at :* Nil )

290+ `as` #executed_at )

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

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

292

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

294insertMigration

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

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

297insertMigration = insertRow_ #schema_migrations

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

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

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

299+ Default `as` #executed_at )

300

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

302deleteMigration

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

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

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

313selectMigration = select

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

314+ (#executed_at `as` #executed_at)

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

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

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

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

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

12 ConstraintKinds

13 , DeriveGeneric

14 , FlexibleContexts

15+ , FlexibleInstances

15 , GADTs

16 , GADTs

16 , GeneralizedNewtypeDeriving

17 , GeneralizedNewtypeDeriving

17 , LambdaCase

18 , LambdaCase

19+ , MultiParamTypeClasses

18 , OverloadedStrings

20 , OverloadedStrings

19 , StandaloneDeriving

21 , StandaloneDeriving

22+ , TypeFamilies

20 , TypeInType

23 , TypeInType

21 , TypeOperators

24 , TypeOperators

22 , RankNTypes

25 , RankNTypes

26+ , UndecidableInstances

23−#-}

27+ #-}

25module Squeal.PostgreSQL.Query

29module Squeal.PostgreSQL.Query

26 ( -- * Queries

30 ( -- * Queries

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

45 , renderTableExpression

49 , renderTableExpression

46 , from

50 , from

47 , where_

51 , where_

48− , group

52+ , groupBy

49 , having

53 , having

50 , orderBy

54 , orderBy

51 , limit

55 , limit

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

76 , rightOuterJoin

80 , rightOuterJoin

77 , fullOuterJoin

81 , fullOuterJoin

78 -- * Grouping

82 -- * Grouping

79− , By (By, By2)

83+ , By (By1, By2)

80 , renderBy

84 , renderBy

81 , GroupByClause (NoGroups, Group)

85 , GroupByClause (NoGroups, Group)

82 , renderGroupByClause

86 , renderGroupByClause

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

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

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

134 query =

138 query =

135 select

139 select

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

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

137 ( from (table #tab)

141 ( from (table #tab)

138 & where_ (#col1 .> #col2)

142 & where_ (#col1 .> #col2)

139 & where_ (#col2 .> 0) )

143 & where_ (#col2 .> 0) )

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

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

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

152 query =

156 query =

153 selectStar

157 selectStar

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

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

155in printSQL query

159in printSQL query

156:}

160:}

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

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

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

196 '[ "sum" ::: 'NotNull 'PGint4

200 '[ "sum" ::: 'NotNull 'PGint4

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

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

198 query =

202 query =

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

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

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

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

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

205+ & groupBy #col1

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

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

203in printSQL query

207in printSQL query

204:}

208:}

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

250 , "shipper_name" ::: 'NotNull 'PGtext

254 , "shipper_name" ::: 'NotNull 'PGtext

251 ]

255 ]

252 query = select

256 query = select

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

261in printSQL query

265in printSQL query

262:}

266:}

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

271 '[]

275 '[]

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

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

273 query = selectDotStar #t1

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

275in printSQL query

279in printSQL query

276:}

280:}

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

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

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

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

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

452--

456--

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

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

455-- >>> printSQL query

459-- >>> printSQL query

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

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

457values

461values

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

589 -> TableExpression schema params relations grouping

593 -> TableExpression schema params relations grouping

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

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

591

595

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

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

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

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

594-- a "grand total" aggregation query.

598-- a "grand total" aggregation query.

595−group

599+groupBy

596 :: SListI bys

600 :: SListI bys

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

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

598 -> TableExpression schema params relations 'Ungrouped

602 -> TableExpression schema params relations 'Ungrouped

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

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

600−group bys rels = TableExpression

604+groupBy bys rels = TableExpression

601 { fromClause = fromClause rels

605 { fromClause = fromClause rels

602 , whereClause = whereClause rels

606 , whereClause = whereClause rels

603 , groupByClause = Group bys

607 , groupByClause = Group bys

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

950data By

954data By

951 (relations :: RelationsType)

955 (relations :: RelationsType)

952 (by :: (Symbol,Symbol)) where

956 (by :: (Symbol,Symbol)) where

953− By

957+ By1

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

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

955 => Alias column

959 => Alias column

956 -> By relations '(relation, column)

960 -> By relations '(relation, column)

957 By2

961 By2

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

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

959− => (Alias relation, Alias column)

963+ => Alias relation

964+ -> Alias column

960 -> By relations '(relation, column)

965 -> By relations '(relation, column)

961deriving instance Show (By relations by)

966deriving instance Show (By relations by)

962deriving instance Eq (By relations by)

967deriving instance Eq (By relations by)

963deriving instance Ord (By relations by)

968deriving instance Ord (By relations by)

964

969

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+

965-- | Renders a `By`.

980-- | Renders a `By`.

966renderBy :: By relations by -> ByteString

981renderBy :: By relations by -> ByteString

967renderBy = \case

982renderBy = \case

968− By column -> renderAlias column

983+ By1 column -> renderAlias column

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

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

970

985

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

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

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

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

60 , renderAlias

61 , renderAliases

62 , Aliased (As)

63+ , Aliasable (as)

63 , renderAliasedAs

64 , renderAliasedAs

64 , AliasesOf

65 , AliasesOf

65 , ZipAliased (..)

66 , ZipAliased (..)

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

383renderAliasString = singleQuotedText . fromString . symbolVal

384renderAliasString = singleQuotedText . fromString . symbolVal

384

385

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

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

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

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

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

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

388renderAliases

389renderAliases

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

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

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

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

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

412 fromLabel = fromLabel @alias2 `As` fromLabel @alias1

413 fromLabel = fromLabel @alias2 `As` fromLabel @alias1

413

414

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+

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

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

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

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

416-- "Just AS \"an_int\""

434-- "Just AS \"an_int\""

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

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

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

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

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

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

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

722−instance label ~ label'

740+instance label ~ label1

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

742+instance labels ~ '[label]

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

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

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

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

725data PGlabel (label :: Symbol) = PGlabel

745data PGlabel (label :: Symbol) = PGlabel

726-- | Renders a label

746-- | Renders a label