ca38686 · squeal · git.iko.soy

git.iko.soy/squeal

on dev help sign in

fix tests

ca38686Eitan Chatav8 years ago

squeal-postgresql/exe/Example.hs+5−7

compare with dev

unifiedsplit

@@ -6,8 +6,6 @@

6 , OverloadedStrings

7 , OverloadedLists

8 , TypeApplications

9− , TypeFamilies

10− , TypeInType

11 , TypeOperators

9 , TypeOperators

12#-}

10#-}

@@ -43,11 +41,11 @@ type Schema =

43 ])

41 ])

44 ]

42 ]

46−type family Schemas0 :: SchemasType where Schemas0 = '["public" ::: '[]]

44+type Schemas = Public Schema

47−type family Schemas :: SchemasType where Schemas = '["public" ::: Schema]

48−type DB = '[] :=> Schemas

46+type DB = DBof Schemas

47+

50−setup :: Definition Schemas0 Schemas

48+setup :: Definition (Public '[]) Schemas

51setup =

49setup =

52 createTable #users

50 createTable #users

53 ( serial `as` #id :*

51 ( serial `as` #id :*

@@ -63,7 +61,7 @@ setup =

63 foreignKey #user_id #users #id

61 foreignKey #user_id #users #id

64 OnDeleteCascade OnUpdateCascade `as` #fk_user_id )

62 OnDeleteCascade OnUpdateCascade `as` #fk_user_id )

66−teardown :: Definition Schemas Schemas0

64+teardown :: Definition Schemas (Public '[])

67teardown = dropTable #emails >>> dropTable #users

65teardown = dropTable #emails >>> dropTable #users

69insertUser :: Manipulation DB '[ 'NotNull 'PGtext, 'NotNull ('PGvararray ('Null 'PGint2))]

67insertUser :: Manipulation DB '[ 'NotNull 'PGtext, 'NotNull ('PGvararray ('Null 'PGint2))]

squeal-postgresql/src/Squeal/PostgreSQL.hs+6−5

@@ -46,7 +46,8 @@ type EmailsConstraints =

46type Schema =

47 '[ "users" ::: 'Table (UsersConstraints :=> UsersColumns)

48 , "emails" ::: 'Table (EmailsConstraints :=> EmailsColumns) ]

49−type DB = '[ "public" ::: Schema ]

49+type Schemas = Public Schema

50+type DB = DBof Schemas

50:}

51:}

52Notice the use of type operators.

53Notice the use of type operators.

@@ -68,7 +69,7 @@ labels to refer to named tables and columns in our schema.

69>>> :{

70>>> :{

70let

71let

71− setup :: Definition '["public" ::: '[]] DB

72+ setup :: Definition (Public '[]) Schemas

72 setup =

73 setup =

73 createTable #users

74 createTable #users

74 ( serial `as` #id :*

75 ( serial `as` #id :*

@@ -89,14 +90,14 @@ We can easily see the generated SQL is unsurprising looking.

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

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

90CREATE TABLE "emails" ("id" serial, "user_id" int NOT NULL, "email" text NULL, CONSTRAINT "pk_emails" PRIMARY KEY ("id"), CONSTRAINT "fk_user_id" FOREIGN KEY ("user_id") REFERENCES "users" ("id") ON DELETE CASCADE ON UPDATE CASCADE);

91CREATE TABLE "emails" ("id" serial, "user_id" int NOT NULL, "email" text NULL, CONSTRAINT "pk_emails" PRIMARY KEY ("id"), CONSTRAINT "fk_user_id" FOREIGN KEY ("user_id") REFERENCES "users" ("id") ON DELETE CASCADE ON UPDATE CASCADE);

92−Notice that @setup@ starts with an empty public schema @'["public" ::: '[]]@ and produces @DB@.

93+Notice that @setup@ starts with an empty public schema @(Public '[])@ and produces @Schemas@.

93In our `createTable` commands we included `TableConstraint`s to define

94In our `createTable` commands we included `TableConstraint`s to define

94primary and foreign keys, making them somewhat complex. Our @teardown@

95primary and foreign keys, making them somewhat complex. Our @teardown@

95`Definition` is simpler.

96`Definition` is simpler.

97>>> :{

98>>> :{

98let

99let

99− teardown :: Definition DB '["public" ::: '[]]

100+ teardown :: Definition Schemas (Public '[])

100 teardown = dropTable #emails >>> dropTable #users

101 teardown = dropTable #emails >>> dropTable #users

101:}

102:}

102

103

@@ -190,7 +191,7 @@ transformer and when the schema doesn't change we can use `Monad` and

190

191

191>>> :{

192>>> :{

192let

193let

193− session :: PQ DB DB IO ()

194+ session :: PQ Schemas Schemas IO ()

194 session = do

195 session = do

195 idResults <- traversePrepared insertUser (Only . userName <$> users)

196 idResults <- traversePrepared insertUser (Only . userName <$> users)

196 ids <- traverse (fmap fromOnly . getRow 0) idResults

197 ids <- traverse (fmap fromOnly . getRow 0) idResults

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

@@ -27,7 +27,7 @@ round trip query.

27>>> instance HasDatatypeInfo Row

28>>> :{

29let

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

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

31 roundTrip = values_ $

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

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

@@ -68,7 +68,7 @@ Once again, we define a simple round trip query.

69>>> :{

70let

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

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

72 roundTrip = values_ $

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

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

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

114

115>>> :{

116let

117− setup :: Definition '["public" ::: '[]] '["public" ::: Schema]

117+ setup :: Definition (Public '[]) (Public Schema)

118 setup =

119 createTypeEnumFrom @Schwarma #schwarma >>>

120 createTypeCompositeFrom @Person #person

@@ -146,7 +146,7 @@ Once again, define a round trip query.

146

147>>> :{

148let

149− roundTrip :: Query '["public" ::: Schema] (TuplePG Row) (RowPG Row)

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

150 roundTrip = values_ $

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

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

@@ -157,7 +157,7 @@ Finally, we can drop our type definitions.

157

158>>> :{

159let

160− teardown :: Definition '["public" ::: Schema] '["public" ::: '[]]

160+ teardown :: Definition (Public Schema) (Public '[])

161 teardown = dropType #schwarma >>> dropType #person

162:}

163

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

@@ -153,7 +153,7 @@ type Table = '[] :=>

153

154>>> :{

155let

156− setup :: Definition '["public" ::: '[]] '["public" ::: '["tab" ::: 'Table Table]]

156+ setup :: Definition (Public '[]) (Public '["tab" ::: 'Table Table])

157 setup = createTable #tab

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

159in printSQL setup

@@ -189,11 +189,11 @@ type Table = '[] :=>

189 , "b" ::: 'NoDef :=> 'Null 'PGfloat4 ]

190:}

191

192−>>> type DB = '["public" ::: '["tab" ::: 'Table Table]]

192+>>> type Schemas = Public '["tab" ::: 'Table Table]

193

194>>> :{

195let

196− setup :: Definition DB DB

196+ setup :: Definition Schemas Schemas

197 setup = createTableIfNotExists #tab

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

199in printSQL setup

@@ -280,7 +280,7 @@ type Schema = '[

280

281>>> :{

282let

283− definition :: Definition '["public" ::: '[]] '["public" ::: Schema]

283+ definition :: Definition (Public '[]) (Public Schema)

284 definition = createTable #tab

285 ( (int & notNullable) `as` #a :*

286 (int & notNullable) `as` #b )

@@ -315,7 +315,7 @@ type Schema = '[

315

316>>> :{

317let

318− definition :: Definition '["public" ::: '[]] '["public" ::: Schema]

318+ definition :: Definition (Public '[]) (Public Schema)

319 definition = createTable #tab

320 ( (int & nullable) `as` #a :*

321 (int & nullable) `as` #b )

@@ -345,12 +345,11 @@ type Schema = '[

345 "id" ::: 'Def :=> 'NotNull 'PGint4,

346 "name" ::: 'NoDef :=> 'NotNull 'PGtext

347 ])]

348−type DB = '["public" ::: Schema]

349:}

348:}

350

349

351>>> :{

350>>> :{

352let

351let

353− definition :: Definition '["public" ::: '[]] DB

352+ definition :: Definition (Public '[]) (Public Schema)

354 definition = createTable #tab

353 definition = createTable #tab

355 ( serial `as` #id :*

354 ( serial `as` #id :*

356 (text & notNullable) `as` #name )

355 (text & notNullable) `as` #name )

@@ -396,7 +395,7 @@ type Schema =

396

395

397>>> :{

396>>> :{

398let

397let

399− setup :: Definition '["public" ::: '[]] '["public" ::: Schema]

398+ setup :: Definition (Public '[]) (Public Schema)

400 setup =

399 setup =

401 createTable #users

400 createTable #users

402 ( serial `as` #id :*

401 ( serial `as` #id :*

@@ -431,7 +430,7 @@ type Schema =

431

430

432>>> :{

431>>> :{

433let

432let

434− setup :: Definition '["public" ::: '[]] '["public" ::: Schema]

433+ setup :: Definition (Public '[]) (Public Schema)

435 setup =

434 setup =

436 createTable #employees

435 createTable #employees

437 ( serial `as` #id :*

436 ( serial `as` #id :*

@@ -534,7 +533,7 @@ DROP statements

534--

533--

535-- >>> :{

534-- >>> :{

536-- let

535-- let

537−-- definition :: Definition '["public" ::: '["muh_table" ::: 'Table t]] '["public" ::: '[]]

536+-- definition :: Definition '["public" ::: '["muh_table" ::: 'Table t]] (Public '[])

538-- definition = dropTable #muh_table

537-- definition = dropTable #muh_table

539-- :}

538-- :}

540--

539--

@@ -870,7 +869,7 @@ dropView vw = UnsafeDefinition $ "DROP VIEW" <+> renderQualifiedAlias vw <> ";"

870

869

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

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

872--

871--

873−-- >>> printSQL $ (createTypeEnum #mood (label @"sad" :* label @"ok" :* label @"happy") :: Definition '["public" ::: '[]] '["public" ::: '["mood" ::: 'Typedef ('PGenum '["sad","ok","happy"])]])

872+-- >>> printSQL $ (createTypeEnum #mood (label @"sad" :* label @"ok" :* label @"happy") :: Definition (Public '[]) '["public" ::: '["mood" ::: 'Typedef ('PGenum '["sad","ok","happy"])]])

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

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

875createTypeEnum

874createTypeEnum

876 :: (KnownSymbol enum, Has sch schemas schema, SOP.All KnownSymbol labels)

875 :: (KnownSymbol enum, Has sch schemas schema, SOP.All KnownSymbol labels)

@@ -890,7 +889,7 @@ createTypeEnum enum labels = UnsafeDefinition $

890-- >>> instance SOP.HasDatatypeInfo Schwarma

889-- >>> instance SOP.HasDatatypeInfo Schwarma

891-- >>> :{

890-- >>> :{

892-- let

891-- let

893−-- createSchwarma :: Definition '["public" ::: '[]] '["public" ::: '["schwarma" ::: 'Typedef (PG (Enumerated Schwarma))]]

892+-- createSchwarma :: Definition (Public '[]) '["public" ::: '["schwarma" ::: 'Typedef (PG (Enumerated Schwarma))]]

894-- createSchwarma = createTypeEnumFrom @Schwarma #schwarma

893-- createSchwarma = createTypeEnumFrom @Schwarma #schwarma

895-- in

894-- in

896-- printSQL createSchwarma

895-- printSQL createSchwarma

@@ -919,7 +918,7 @@ type PGcomplex = 'PGcomposite

919

918

920>>> :{

919>>> :{

921let

920let

922− setup :: Definition '["public" ::: '[]] '["public" ::: '["complex" ::: 'Typedef PGcomplex]]

921+ setup :: Definition (Public '[]) '["public" ::: '["complex" ::: 'Typedef PGcomplex]]

923 setup = createTypeComposite #complex

922 setup = createTypeComposite #complex

924 (float8 `as` #real :* float8 `as` #imaginary)

923 (float8 `as` #real :* float8 `as` #imaginary)

925in printSQL setup

924in printSQL setup

@@ -946,10 +945,10 @@ createTypeComposite ty fields = UnsafeDefinition $

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

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

947-- >>> instance SOP.Generic Complex

946-- >>> instance SOP.Generic Complex

948-- >>> instance SOP.HasDatatypeInfo Complex

947-- >>> instance SOP.HasDatatypeInfo Complex

949−-- >>> type DB = '["public" ::: '["complex" ::: 'Typedef (PG (Composite Complex))]]

948+-- >>> type Schema = '["complex" ::: 'Typedef (PG (Composite Complex))]

950-- >>> :{

949-- >>> :{

951-- let

950-- let

952−-- createComplex :: Definition '["public" ::: '[]] DB

951+-- createComplex :: Definition (Public '[]) (Public Schema)

953-- createComplex = createTypeCompositeFrom @Complex #complex

952-- createComplex = createTypeCompositeFrom @Complex #complex

954-- in

953-- in

955-- printSQL createComplex

954-- printSQL createComplex

@@ -978,7 +977,7 @@ instance (KnownSymbol alias, PGTyped schemas ty)

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

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

979-- >>> instance SOP.Generic Schwarma

978-- >>> instance SOP.Generic Schwarma

980-- >>> instance SOP.HasDatatypeInfo Schwarma

979-- >>> instance SOP.HasDatatypeInfo Schwarma

981−-- >>> printSQL (dropType #schwarma :: Definition '["public" ::: '["schwarma" ::: 'Typedef (PG (Enumerated Schwarma))]] '["public" ::: '[]])

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

982-- DROP TYPE "schwarma";

981-- DROP TYPE "schwarma";

983dropType

982dropType

984 :: (Has sch schemas schema, Has td schema ('Typedef ty))

983 :: (Has sch schemas schema, Has td schema ('Typedef ty))

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

@@ -243,7 +243,7 @@ class KnownNat n => HasParameter

243 | n params -> ty where

244 -- | `parameter` takes a `Nat` using type application and a `TypeExpression`.

245 --

246− -- >>> let expr = parameter @1 int4 :: Expression db from grp '[ 'Null 'PGint4] ('Null 'PGint4)

246+ -- >>> let expr = parameter @1 int4 :: Expression (DBof schemas) from grp '[ 'Null 'PGint4] ('Null 'PGint4)

247 -- >>> printSQL expr

248 -- ($1 :: int4)

249 parameter

@@ -259,14 +259,14 @@ instance {-# OVERLAPPABLE #-} (KnownNat n, HasParameter (n-1) params ty)

259-- | `param` takes a `Nat` using type application and for basic types,

260-- infers a `TypeExpression`.

261--

262−-- >>> let expr = param @1 :: Expression db from grp '[ 'Null 'PGint4] ('Null 'PGint4)

262+-- >>> let expr = param @1 :: Expression (commons :=> schemas) from grp '[ 'Null 'PGint4] ('Null 'PGint4)

263-- >>> printSQL expr

264-- ($1 :: int4)

265param

266− :: forall n commons schemas params from grouping ty

266+ :: forall n db commons schemas params from grouping ty

267− . (PGTyped schemas ty, HasParameter n params ty)

267+ . (db ~ (commons :=> schemas), PGTyped schemas ty, HasParameter n params ty)

268− => Expression (commons :=> schemas) from grouping params ty -- ^ param

268+ => Expression db from grouping params ty -- ^ param

269−param = parameter @n pgtype

269+param = parameter @n (pgtype @schemas)

270

271instance (HasUnique table from columns, Has column columns ty)

272 => IsLabel column (Expression db from 'Ungrouped params ty) where

@@ -418,7 +418,7 @@ matchNull y f x = ifThenElse (isNull x) y

418`nullIf` gives @NULL@.

419

420>>> :set -XTypeApplications -XDataKinds

421−>>> let expr = nullIf false (param @1) :: Expression db from grp '[ 'NotNull 'PGbool] ('Null 'PGbool)

421+>>> let expr = nullIf false (param @1) :: Expression (commons :=> schema) from grp '[ 'NotNull 'PGbool] ('Null 'PGbool)

422>>> printSQL expr

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

424-}

@@ -478,7 +478,7 @@ row exprs = UnsafeExpression $ "ROW" <> parenthesized

478-- '[ "real" ::: 'NotNull 'PGfloat8

479-- , "imaginary" ::: 'NotNull 'PGfloat8 ]

480-- type Schema = '["complex" ::: 'Typedef Complex]

481−-- type DB = '["public" ::: Schema]

481+-- type DB = DBof (Public Schema)

482-- :}

483--

484-- >>> let i = row (0 `as` #real :* 1 `as` #imaginary) :: Expression DB from grp params ('NotNull Complex)

@@ -505,7 +505,7 @@ instance Monoid

505 mempty = array []

506 mappend = (<>)

507

508−-- | >>> let expr = greatest currentTimestamp [param @1] :: Expression sch rels grp '[ 'NotNull 'PGtimestamptz] ('NotNull 'PGtimestamptz)

508+-- | >>> let expr = greatest currentTimestamp [param @1] :: Expression (commons :=> schemas) rels grp '[ 'NotNull 'PGtimestamptz] ('NotNull 'PGtimestamptz)

509-- >>> printSQL expr

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

511greatest

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

@@ -62,12 +62,12 @@ A `Query` is also considered a `Manipulation` even though it does not modify dat

63simple insert:

65+>>> type Columns = '["col1" ::: 'NoDef :=> 'Null 'PGint4, "col2" ::: 'Def :=> 'NotNull 'PGint4]

66+>>> type Schema = '["tab" ::: 'Table ('[] :=> Columns)]

67+>>> type Schemas = (Public Schema)

65>>> :{

68>>> :{

66let

69let

67− manipulation :: Manipulation

70+ manipulation :: Manipulation (DBof Schemas) '[] '[]

68− '[ "public" ::: '["tab" ::: 'Table ('[] :=>

69− '[ "col1" ::: 'NoDef :=> 'NotNull 'PGint4

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

71 manipulation =

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

73in printSQL manipulation

@@ -76,13 +76,11 @@ INSERT INTO "tab" ("col1", "col2") VALUES (2, DEFAULT)

77parameterized insert:

79+>>> type Columns = '["col1" ::: 'NoDef :=> 'NotNull 'PGint4, "col2" ::: 'NoDef :=> 'NotNull 'PGint4]

80+>>> type Schema = '["tab" ::: 'Table ('[] :=> Columns)]

79>>> :{

81>>> :{

80let

82let

81− manipulation :: Manipulation

82− '[ "public" ::: '["tab" ::: 'Table ('[] :=>

83− '[ "col1" ::: 'NoDef :=> 'NotNull 'PGint4

84− , "col2" ::: 'NoDef :=> 'NotNull 'PGint4 ])]]

85− '[ 'NotNull 'PGint4, 'NotNull 'PGint4 ] '[]

83+ manipulation :: Manipulation (DBof (Public Schema)) '[ 'NotNull 'PGint4, 'NotNull 'PGint4 ] '[]

86 manipulation =

84 manipulation =

87 insertRow_ #tab

85 insertRow_ #tab

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

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

@@ -94,27 +92,21 @@ returning insert:

95>>> :{

93>>> :{

96let

94let

97− manipulation :: Manipulation

95+ manipulation :: Manipulation (DBof (Public Schema)) '[] '["fromOnly" ::: 'NotNull 'PGint4]

98− '[ "public" ::: '["tab" ::: 'Table ('[] :=>

99− '[ "col1" ::: 'NoDef :=> 'NotNull 'PGint4

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

101− '["fromOnly" ::: 'NotNull 'PGint4]

102 manipulation =

96 manipulation =

103− insertRow #tab (Set 2 `as` #col1 :* Default `as` #col2)

97+ insertRow #tab (Set 2 `as` #col1 :* Set 3 `as` #col2)

104 OnConflictDoRaise (Returning (#col1 `as` #fromOnly))

98 OnConflictDoRaise (Returning (#col1 `as` #fromOnly))

105in printSQL manipulation

99in printSQL manipulation

106:}

100:}

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

101+INSERT INTO "tab" ("col1", "col2") VALUES (2, 3) RETURNING "col1" AS "fromOnly"

108

102

109upsert:

103upsert:

110

104

105+>>> type Columns = '["col1" ::: 'NoDef :=> 'NotNull 'PGint4, "col2" ::: 'NoDef :=> 'NotNull 'PGint4]

106+>>> type Schema = '["tab" ::: 'Table ('[] :=> Columns)]

111>>> :{

107>>> :{

112let

108let

113− manipulation :: Manipulation

109+ manipulation :: Manipulation (DBof (Public Schema)) '[] '[ "sum" ::: 'NotNull 'PGint4]

114− '[ "public" ::: '["tab" ::: 'Table ('[] :=>

115− '[ "col1" ::: 'NoDef :=> 'NotNull 'PGint4

116− , "col2" ::: 'NoDef :=> 'NotNull 'PGint4 ])]]

117− '[] '[ "sum" ::: 'NotNull 'PGint4]

118 manipulation =

110 manipulation =

119 insertRows #tab

111 insertRows #tab

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

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

@@ -131,31 +123,17 @@ query insert:

131

123

132>>> :{

124>>> :{

133let

125let

134− manipulation :: Manipulation

126+ manipulation :: Manipulation (DBof (Public Schema)) '[] '[]

135− '[ "public" ::: '["tab" ::: 'Table ('[] :=>

136− '[ "col1" ::: 'NoDef :=> 'NotNull 'PGint4

137− , "col2" ::: 'NoDef :=> 'NotNull 'PGint4

138− ])

139− , "other_tab" ::: 'Table ('[] :=>

140− '[ "col1" ::: 'NoDef :=> 'NotNull 'PGint4

141− , "col2" ::: 'NoDef :=> 'NotNull 'PGint4

142− ])

143− ]] '[] '[]

144− manipulation =

145− insertQuery_ #tab

146− (selectStar (from (table (#other_tab `as` #t))))

127+ manipulation = insertQuery_ #tab (selectStar (from (table #tab)))

147in printSQL manipulation

128in printSQL manipulation

148:}

129:}

149−INSERT INTO "tab" SELECT * FROM "other_tab" AS "t"

130+INSERT INTO "tab" SELECT * FROM "tab" AS "tab"

150

131

151update:

132update:

152

133

153>>> :{

134>>> :{

154let

135let

155− manipulation :: Manipulation

136+ manipulation :: Manipulation (DBof (Public Schema)) '[] '[]

156− '[ "public" ::: '["tab" ::: 'Table ('[] :=>

157− '[ "col1" ::: 'NoDef :=> 'NotNull 'PGint4

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

159 manipulation =

137 manipulation =

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

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

161 (#col1 ./= #col2)

139 (#col1 ./= #col2)

@@ -167,10 +145,7 @@ delete:

167

145

168>>> :{

146>>> :{

169let

147let

170− manipulation :: Manipulation

148+ manipulation :: Manipulation (DBof (Public Schema)) '[]

171− '[ "public" ::: '["tab" ::: 'Table ('[] :=>

172− '[ "col1" ::: 'NoDef :=> 'NotNull 'PGint4

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

174 '[ "col1" ::: 'NotNull 'PGint4

149 '[ "col1" ::: 'NotNull 'PGint4

175 , "col2" ::: 'NotNull 'PGint4 ]

150 , "col2" ::: 'NotNull 'PGint4 ]

176 manipulation = deleteFrom #tab (#col1 .== #col2) ReturningStar

151 manipulation = deleteFrom #tab (#col1 .== #col2) ReturningStar

@@ -180,20 +155,17 @@ DELETE FROM "tab" WHERE ("col1" = "col2") RETURNING *

180

155

181with manipulation:

156with manipulation:

182

157

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

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

184−

159+>>> type ProductsSchema = '["products" ::: 'Table ('[] :=> ProductsColumns), "products_deleted" ::: 'Table ('[] :=> ProductsColumns)]

185>>> :{

160>>> :{

186let

161let

187− manipulation :: Manipulation

162+ manipulation :: Manipulation (DBof (Public ProductsSchema)) '[ 'NotNull 'PGdate] '[]

188− '[ "public" ::: '["products" ::: 'Table ProductsTable

189− , "products_deleted" ::: 'Table ProductsTable

190− ]] '[ 'NotNull 'PGdate] '[]

191 manipulation = with

163 manipulation = with

192− (CommonTableExpression (deleteFrom #products (#date .< param @1) ReturningStar `as` #deleted_rows) :>> Done)

164+ (deleteFrom #products (#date .< param @1) ReturningStar `as` #del)

193− (insertQuery_ #products_deleted (selectStar (from (view (#deleted_rows `as` #t)))))

165+ (insertQuery_ #products_deleted (selectStar (from (common (#del)))))

194in printSQL manipulation

166in printSQL manipulation

195:}

167:}

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

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

197-}

169-}

198

170

199newtype Manipulation

171newtype Manipulation

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

@@ -31,7 +31,7 @@ type EmailsTable =

32>>> :{

33let

34− makeUsers :: Migration IO '["public" ::: '[]] '["public" ::: '["users" ::: 'Table UsersTable]]

34+ makeUsers :: Migration IO (Public '[]) '["public" ::: '["users" ::: 'Table UsersTable]]

35 makeUsers = Migration

36 { name = "make users table"

37 , up = void . define $

@@ -77,7 +77,7 @@ let

77:}

79>>> :{

80−withConnection "host=localhost port=5432 schemasname=exampleschemas" $

80+withConnection "host=localhost port=5432 dbname=exampledb" $

81 manipulate (UnsafeManipulation "SET client_min_messages TO WARNING;")

82 -- suppress notices

83 & pqThen (migrateUp migrations)

squeal-postgresql/src/Squeal/PostgreSQL/PQ.hs+2−2

@@ -124,7 +124,7 @@ To specify the schema you wish to connect with, use type application.

124>>> type Schema = '["tab" ::: '[] :=> '["col" ::: 'NoDef :=> 'Null 'PGint2]]

125>>> :set -XTypeApplications

126>>> :set -XOverloadedStrings

127−>>> conn <- connectdbs @Schema "host=localhost port=5432 schemasname=exampleschemas"

127+>>> conn <- connectdb @Schema "host=localhost port=5432 dbname=exampledb"

128

129Note that, for now, squeal doesn't offer any protection from connecting

130with the wrong schema!

@@ -140,7 +140,7 @@ connectdb = fmap K . liftBase . LibPQ.connectdb

140finish :: MonadBase IO io => K LibPQ.Connection schemas -> io ()

141finish = liftBase . LibPQ.finish . unK

142

143−-- | Do `connectdbs` and `finish` before and after a computation.

143+-- | Do `connectdb` and `finish` before and after a computation.

144withConnection

145 :: forall schemas0 schemas1 io x

146 . MonadBaseControl IO io

squeal-postgresql/test/Specs/ExceptionHandling.hs+9−6

@@ -7,6 +7,7 @@

7{-# LANGUAGE OverloadedStrings #-}

8{-# LANGUAGE TypeApplications #-}

9{-# LANGUAGE TypeFamilies #-}

10+{-# LANGUAGE TypeInType #-}

10{-# LANGUAGE TypeOperators #-}

11{-# LANGUAGE TypeOperators #-}

11module ExceptionHandling

12module ExceptionHandling

12 ( specs

13 ( specs

@@ -45,7 +46,9 @@ type Schema =

45 ])

46 ])

46 ]

47 ]

48−type DB = '["public" ::: Schema]

49+type Schemas = Public Schema

50+

51+type DB = DBof Schemas

50data User =

53data User =

51 User { userName :: Text

54 User { userName :: Text

@@ -61,7 +64,7 @@ insertUser = insertRows #users

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

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

62 OnConflictDoRaise (Returning (#id `as` #fromOnly))

65 OnConflictDoRaise (Returning (#id `as` #fromOnly))

64−setup :: Definition '["public" ::: '[]] DB

67+setup :: Definition (Public '[]) Schemas

65setup =

68setup =

66 createTable #users

69 createTable #users

67 ( serial `as` #id :*

70 ( serial `as` #id :*

@@ -78,10 +81,10 @@ setup =

78 foreignKey #user_id #users #id

81 foreignKey #user_id #users #id

79 OnDeleteCascade OnUpdateCascade `as` #fk_user_id )

82 OnDeleteCascade OnUpdateCascade `as` #fk_user_id )

81−teardown :: Definition DB '["public" ::: '[]]

84+teardown :: Definition Schemas (Public '[])

82teardown = dropTable #emails >>> dropTable #users

85teardown = dropTable #emails >>> dropTable #users

84−migration :: Migration IO '["public" ::: '[]] DB

87+migration :: Migration IO (Public '[]) Schemas

85migration = Migration { name = "test"

88migration = Migration { name = "test"

86 , up = void $ define setup

89 , up = void $ define setup

87 , down = void $ define teardown }

90 , down = void $ define teardown }

@@ -100,10 +103,10 @@ connectionString = "host=localhost port=5432 dbname=exampledb"

100testUser :: User

103testUser :: User

101testUser = User "TestUser" Nothing []

104testUser = User "TestUser" Nothing []

102

105

103−newUser :: (MonadBase IO m, MonadPQ DB m) => User -> m ()

106+newUser :: (MonadBase IO m, MonadPQ Schemas m) => User -> m ()

104newUser u = void $ manipulateParams insertUser (userName u, userVec u)

107newUser u = void $ manipulateParams insertUser (userName u, userVec u)

105

108

106−insertUserTwice :: (MonadBase IO m, MonadPQ DB m) => m ()

109+insertUserTwice :: (MonadBase IO m, MonadPQ Schemas m) => m ()

107insertUserTwice = newUser testUser >> newUser testUser

110insertUserTwice = newUser testUser >> newUser testUser

108

111

109specs :: SpecWith ()

112specs :: SpecWith ()