git.iko.soy/squeal
on dev help sign in
try to fix test errors
commitdd96a8b83accc1246ed9ea0a051d3f5dba9e3f6e authorEitan Chatav <eitan.chatav@gmail.com> dateSat 24 Nov 2018, 16:08 (8 years ago) parent5a3598e
5 files changed+59−50
compare with dev
unifiedsplit
squeal-postgresql/src/Squeal/PostgreSQL.hs+21−22 squeal-postgresql/src/Squeal/PostgreSQL/Expression.hs+8−6 squeal-postgresql/src/Squeal/PostgreSQL/Query.hs+16−16 squeal-postgresql/src/Squeal/PostgreSQL/Schema.hs+6 squeal-postgresql/test/Specs/ExceptionHandling.hs+8−6
squeal-postgresql/src/Squeal/PostgreSQL.hs+21−22
@@ -32,26 +32,25 @@ The first step is to define the schema of our database. This is where
3232we use @DataKinds@ and @TypeOperators@.
3333
3434>>> :{
35+type UsersColumns =
36+ '[ "id" ::: 'Def :=> 'NotNull 'PGint4
37+ , "name" ::: 'NoDef :=> 'NotNull 'PGtext ]
38+type UsersConstraints = '[ "pk_users" ::: 'PrimaryKey '["id"] ]
39+type EmailsColumns =
40+ '[ "pk_emails" ::: 'PrimaryKey '["id"]
41+ , "fk_user_id" ::: 'ForeignKey '["user_id"] "users" '["id"] ]
42+type EmailsConstraints =
43+ '[ "pk_emails" ::: 'PrimaryKey '["id"]
44+ , "fk_user_id" ::: 'ForeignKey '["user_id"] "users" '["id"] ]
3545type Schema =
36− '[ "users" ::: 'Table (
37− '[ "pk_users" ::: 'PrimaryKey '["id"] ] :=>
38− '[ "id" ::: 'Def :=> 'NotNull 'PGint4
39− , "name" ::: 'NoDef :=> 'NotNull 'PGtext
40− ])
41− , "emails" ::: 'Table (
42− '[ "pk_emails" ::: 'PrimaryKey '["id"]
43− , "fk_user_id" ::: 'ForeignKey '["user_id"] "users" '["id"]
44− ] :=>
45− '[ "id" ::: 'Def :=> 'NotNull 'PGint4
46− , "user_id" ::: 'NoDef :=> 'NotNull 'PGint4
47− , "email" ::: 'NoDef :=> 'Null 'PGtext
48− ])
49− ]
46+ '[ "users" ::: 'Table (UsersConstraints :=> UsersColumns)
47+ , "emails" ::: 'Table (EmailsConstraints :=> EmailsColumns) ]
48+type DB = '[ "public" ::: Schema ]
5049:}
5150
5251Notice the use of type operators.
5352
54−`:::` is used to pair an alias `GHC.TypeLits.Symbol` with a `SchemumType`,
53+`:::` is used to pair an alias `GHC.TypeLits.Symbol` with a `DBType`, a `SchemumType`,
5554a `TableConstraint` or a `ColumnType`. It is intended to connote Haskell's @::@
5655operator.
5756
@@ -68,7 +67,7 @@ labels to refer to named tables and columns in our schema.
6867
6968>>> :{
7069let
71− setup :: Definition '[] Schema
70+ setup :: Definition '["public" ::: '[]] DB
7271 setup =
7372 createTable #users
7473 ( serial `as` #id :*
@@ -89,14 +88,14 @@ We can easily see the generated SQL is unsurprising looking.
8988CREATE TABLE "users" ("id" serial, "name" text NOT NULL, CONSTRAINT "pk_users" PRIMARY KEY ("id"));
9089CREATE 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);
9190
92−Notice that @setup@ starts with an empty schema @'[]@ and produces @Schema@.
91+Notice that @setup@ starts with an empty public schema @'["public" ::: '[]]@ and produces @DB@.
9392In our `createTable` commands we included `TableConstraint`s to define
9493primary and foreign keys, making them somewhat complex. Our @teardown@
9594`Definition` is simpler.
9695
9796>>> :{
9897let
99− teardown :: Definition Schema '[]
98+ teardown :: Definition DB '["public" ::: '[]]
10099 teardown = dropTable #emails >>> dropTable #users
101100:}
102101
@@ -117,7 +116,7 @@ of our inserts.
117116
118117>>> :{
119118let
120− insertUser :: Manipulation Schema '[ 'NotNull 'PGtext ] '[ "fromOnly" ::: 'NotNull 'PGint4 ]
119+ insertUser :: Manipulation DB '[ 'NotNull 'PGtext ] '[ "fromOnly" ::: 'NotNull 'PGint4 ]
121120 insertUser = insertRow #users
122121 (Default `as` #id :* Set (param @1) `as` #name)
123122 OnConflictDoNothing (Returning (#id `as` #fromOnly))
@@ -125,7 +124,7 @@ let
125124
126125>>> :{
127126let
128− insertEmail :: Manipulation Schema '[ 'NotNull 'PGint4, 'Null 'PGtext] '[]
127+ insertEmail :: Manipulation DB '[ 'NotNull 'PGint4, 'Null 'PGtext] '[]
129128 insertEmail = insertRow #emails
130129 ( Default `as` #id :*
131130 Set (param @1) `as` #user_id :*
@@ -145,7 +144,7 @@ need to use an inner join to get the right result. A `Query` is like a
145144
146145>>> :{
147146let
148− getUsers :: Query Schema '[]
147+ getUsers :: Query DB '[]
149148 '[ "userName" ::: 'NotNull 'PGtext
150149 , "userEmail" ::: 'Null 'PGtext ]
151150 getUsers = select
@@ -190,7 +189,7 @@ transformer and when the schema doesn't change we can use `Monad` and
190189
191190>>> :{
192191let
193− session :: PQ Schema Schema IO ()
192+ session :: PQ DB DB IO ()
194193 session = do
195194 idResults <- traversePrepared insertUser (Only . userName <$> users)
196195 ids <- traverse (fmap fromOnly . getRow 0) idResults
squeal-postgresql/src/Squeal/PostgreSQL/Expression.hs+8−6
@@ -244,7 +244,7 @@ class KnownNat n => HasParameter
244244 | n params -> ty where
245245 -- | `parameter` takes a `Nat` using type application and a `TypeExpression`.
246246 --
247− -- >>> let expr = parameter @1 int4 :: Expression sch rels grp '[ 'Null 'PGint4] ('Null 'PGint4)
247+ -- >>> let expr = parameter @1 int4 :: Expression db from grp '[ 'Null 'PGint4] ('Null 'PGint4)
248248 -- >>> printSQL expr
249249 -- ($1 :: int4)
250250 parameter
@@ -260,7 +260,7 @@ instance {-# OVERLAPPABLE #-} (KnownNat n, HasParameter (n-1) db params ty)
260260-- | `param` takes a `Nat` using type application and for basic types,
261261-- infers a `TypeExpression`.
262262--
263−-- >>> let expr = param @1 :: Expression sch rels grp '[ 'Null 'PGint4] ('Null 'PGint4)
263+-- >>> let expr = param @1 :: Expression db from grp '[ 'Null 'PGint4] ('Null 'PGint4)
264264-- >>> printSQL expr
265265-- ($1 :: int4)
266266param
@@ -419,7 +419,7 @@ matchNull y f x = ifThenElse (isNull x) y
419419`nullIf` gives @NULL@.
420420
421421>>> :set -XTypeApplications -XDataKinds
422−>>> let expr = nullIf false (param @1) :: Expression db rels grp '[ 'NotNull 'PGbool] ('Null 'PGbool)
422+>>> let expr = nullIf false (param @1) :: Expression db from grp '[ 'NotNull 'PGbool] ('Null 'PGbool)
423423>>> printSQL expr
424424NULL IF (FALSE, ($1 :: bool))
425425-}
@@ -463,7 +463,7 @@ instance (KnownSymbol label, label `In` labels) => IsPGlabel label
463463-- , "imaginary" ::: 'NotNull 'PGfloat8 ]
464464-- :}
465465--
466−-- >>> let i = row (0 `as` #real :* 1 `as` #imaginary) :: Expression '[] '[] 'Ungrouped '[] ('NotNull Complex)
466+-- >>> let i = row (0 `as` #real :* 1 `as` #imaginary) :: Expression db from grp params ('NotNull Complex)
467467-- >>> printSQL i
468468-- ROW(0, 1)
469469row
@@ -478,11 +478,13 @@ row exprs = UnsafeExpression $ "ROW" <> parenthesized
478478-- type Complex = 'PGcomposite
479479-- '[ "real" ::: 'NotNull 'PGfloat8
480480-- , "imaginary" ::: 'NotNull 'PGfloat8 ]
481+-- type Schema = '["complex" ::: 'Typedef Complex]
482+-- type DB = '["public" ::: Schema]
481483-- :}
482484--
483−-- >>> let i = row (0 `as` #real :* 1 `as` #imaginary) :: Expression '["complex" ::: 'Typedef Complex] '[] 'Ungrouped '[] ('NotNull Complex)
485+-- >>> let i = row (0 `as` #real :* 1 `as` #imaginary) :: Expression DB from grp params ('NotNull Complex)
484486-- >>> printSQL $ i & field #complex #imaginary
485−-- (ROW(0, 1)::"complex")."imaginary"
487+-- (ROW(0, 1)::"public"."complex")."imaginary"
486488field
487489 :: ( Has sch db schema
488490 , Has tydef schema ('Typedef ('PGcomposite row))
squeal-postgresql/src/Squeal/PostgreSQL/Query.hs+16−16
@@ -147,7 +147,7 @@ simple query:
147147>>> :{
148148let
149149 query :: Query
150− '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'Null 'PGint4])]
150+ '["public" ::: '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'Null 'PGint4])]]
151151 '[]
152152 '["col" ::: 'Null 'PGint4]
153153 query = selectStar (from (table #tab))
@@ -160,9 +160,9 @@ restricted query:
160160>>> :{
161161let
162162 query :: Query
163− '[ "tab" ::: 'Table ('[] :=>
163+ '[ "public" ::: '[ "tab" ::: 'Table ('[] :=>
164164 '[ "col1" ::: 'NoDef :=> 'NotNull 'PGint4
165− , "col2" ::: 'NoDef :=> 'NotNull 'PGint4 ])]
165+ , "col2" ::: 'NoDef :=> 'NotNull 'PGint4 ])]]
166166 '[]
167167 '[ "sum" ::: 'NotNull 'PGint4
168168 , "col1" ::: 'NotNull 'PGint4 ]
@@ -181,7 +181,7 @@ subquery:
181181>>> :{
182182let
183183 query :: Query
184− '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'Null 'PGint4])]
184+ '["public" ::: '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'Null 'PGint4])]]
185185 '[]
186186 '["col" ::: 'Null 'PGint4]
187187 query =
@@ -196,7 +196,7 @@ limits and offsets:
196196>>> :{
197197let
198198 query :: Query
199− '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'Null 'PGint4])]
199+ '["public" ::: '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'Null 'PGint4])]]
200200 '[]
201201 '["col" ::: 'Null 'PGint4]
202202 query = selectStar
@@ -210,7 +210,7 @@ parameterized query:
210210>>> :{
211211let
212212 query :: Query
213− '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'NotNull 'PGfloat8])]
213+ '["public" ::: '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'NotNull 'PGfloat8])]]
214214 '[ 'NotNull 'PGfloat8]
215215 '["col" ::: 'NotNull 'PGfloat8]
216216 query = selectStar
@@ -224,9 +224,9 @@ aggregation query:
224224>>> :{
225225let
226226 query :: Query
227− '[ "tab" ::: 'Table ('[] :=>
227+ '["public" ::: '[ "tab" ::: 'Table ('[] :=>
228228 '[ "col1" ::: 'NoDef :=> 'NotNull 'PGint4
229− , "col2" ::: 'NoDef :=> 'NotNull 'PGint4 ])]
229+ , "col2" ::: 'NoDef :=> 'NotNull 'PGint4 ])]]
230230 '[]
231231 '[ "sum" ::: 'NotNull 'PGint4
232232 , "col1" ::: 'NotNull 'PGint4 ]
@@ -244,7 +244,7 @@ sorted query:
244244>>> :{
245245let
246246 query :: Query
247− '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'Null 'PGint4])]
247+ '["public" ::: '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'Null 'PGint4])]]
248248 '[]
249249 '["col" ::: 'Null 'PGint4]
250250 query = selectStar
@@ -259,7 +259,7 @@ joins:
259259>>> :{
260260let
261261 query :: Query
262− '[ "orders" ::: 'Table (
262+ '["public" ::: '[ "orders" ::: 'Table (
263263 '["pk_orders" ::: PrimaryKey '["id"]
264264 ,"fk_customers" ::: ForeignKey '["customer_id"] "customers" '["id"]
265265 ,"fk_shippers" ::: ForeignKey '["shipper_id"] "shippers" '["id"]] :=>
@@ -278,7 +278,7 @@ let
278278 '[ "id" ::: 'NoDef :=> 'NotNull 'PGint4
279279 , "name" ::: 'NoDef :=> 'NotNull 'PGtext
280280 ])
281− ]
281+ ]]
282282 '[]
283283 '[ "order_price" ::: 'NotNull 'PGfloat4
284284 , "customer_name" ::: 'NotNull 'PGtext
@@ -302,7 +302,7 @@ self-join:
302302>>> :{
303303let
304304 query :: Query
305− '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'Null 'PGint4])]
305+ '["public" ::: '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'Null 'PGint4])]]
306306 '[]
307307 '["col" ::: 'Null 'PGint4]
308308 query = selectDotStar #t1
@@ -315,7 +315,7 @@ value queries:
315315
316316>>> :{
317317let
318− query :: Query '[] '[] '["foo" ::: 'NotNull 'PGint2, "bar" ::: 'NotNull 'PGbool]
318+ query :: Query db '[] '["foo" ::: 'NotNull 'PGint2, "bar" ::: 'NotNull 'PGbool]
319319 query = values (1 `as` #foo :* true `as` #bar) [2 `as` #foo :* false `as` #bar]
320320in printSQL query
321321:}
@@ -326,7 +326,7 @@ set operations:
326326>>> :{
327327let
328328 query :: Query
329− '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'Null 'PGint4])]
329+ '["public" ::: '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'Null 'PGint4])]]
330330 '[]
331331 '["col" ::: 'Null 'PGint4]
332332 query =
@@ -342,9 +342,9 @@ with queries:
342342>>> :{
343343let
344344 query :: Query
345− '[ "t1" ::: 'View
345+ '["public" ::: '[ "t1" ::: 'View
346346 '[ "c1" ::: 'NotNull 'PGtext
347− , "c2" ::: 'NotNull 'PGtext] ]
347+ , "c2" ::: 'NotNull 'PGtext] ]]
348348 '[]
349349 '[ "c1" ::: 'NotNull 'PGtext
350350 , "c2" ::: 'NotNull 'PGtext ]
squeal-postgresql/src/Squeal/PostgreSQL/Schema.hs+6
@@ -480,6 +480,12 @@ instance (q ~ q', a ~ a') => IsQualified q a (QualifiedAlias q' a') where
480480 _!_ = QualifiedAlias
481481instance (q' ~ "public", a ~ a') => IsLabel a (QualifiedAlias q' a') where
482482 fromLabel = QualifiedAlias
483+instance (q ~ q', a ~ a', KnownSymbol a') =>
484+ IsQualified q a (Aliased (QualifiedAlias q') (a' ::: a')) where
485+ _!_ = QualifiedAlias `As` Alias
486+instance (q' ~ "public", a ~ a', KnownSymbol a') =>
487+ IsLabel a (Aliased (QualifiedAlias q') (a' ::: a')) where
488+ fromLabel = QualifiedAlias `As` Alias
483489
484490renderQualifiedAlias
485491 :: forall q a. (KnownSymbol q, KnownSymbol a)
squeal-postgresql/test/Specs/ExceptionHandling.hs+8−6
@@ -45,6 +45,8 @@ type Schema =
4545 ])
4646 ]
4747
48+type DB = '["public" ::: Schema]
49+
4850data User =
4951 User { userName :: Text
5052 , userEmail :: Maybe Text
@@ -53,13 +55,13 @@ data User =
5355instance SOP.Generic User
5456instance SOP.HasDatatypeInfo User
5557
56−insertUser :: Manipulation Schema '[ 'NotNull 'PGtext, 'NotNull ('PGvararray ('Null 'PGint2))]
58+insertUser :: Manipulation DB '[ 'NotNull 'PGtext, 'NotNull ('PGvararray ('Null 'PGint2))]
5759 '[ "fromOnly" ::: 'NotNull 'PGint4 ]
5860insertUser = insertRows #users
5961 (Default `as` #id :* Set (param @1) `as` #name :* Set (param @2) `as` #vec) []
6062 OnConflictDoRaise (Returning (#id `as` #fromOnly))
6163
62−setup :: Definition '[] Schema
64+setup :: Definition '["public" ::: '[]] DB
6365setup =
6466 createTable #users
6567 ( serial `as` #id :*
@@ -76,10 +78,10 @@ setup =
7678 foreignKey #user_id #users #id
7779 OnDeleteCascade OnUpdateCascade `as` #fk_user_id )
7880
79−teardown :: Definition Schema '[]
81+teardown :: Definition DB '["public" ::: '[]]
8082teardown = dropTable #emails >>> dropTable #users
8183
82−migration :: Migration IO '[] Schema
84+migration :: Migration IO '["public" ::: '[]] DB
8385migration = Migration { name = "test"
8486 , up = void $ define setup
8587 , down = void $ define teardown }
@@ -98,10 +100,10 @@ connectionString = "host=localhost port=5432 dbname=exampledb"
98100testUser :: User
99101testUser = User "TestUser" Nothing []
100102
101−newUser :: (MonadBase IO m, MonadPQ Schema m) => User -> m ()
103+newUser :: (MonadBase IO m, MonadPQ DB m) => User -> m ()
102104newUser u = void $ manipulateParams insertUser (userName u, userVec u)
103105
104−insertUserTwice :: (MonadBase IO m, MonadPQ Schema m) => m ()
106+insertUserTwice :: (MonadBase IO m, MonadPQ DB m) => m ()
105107insertUserTwice = newUser testUser >> newUser testUser
106108
107109specs :: SpecWith ()