@@ -2,102 +2,550 @@ module Test.SchemaQ where
3import Prelude
3import Prelude
5−import Control.Monad.Error.Class (throwError)
5+import Control.Monad.Error.Class (throwError, try)
6+import Control.Monad.Except (throwError) as Except
7+import Data.Either (Either(..), isLeft)
6import Data.Array as Array
8import Data.Array as Array
7import Data.Maybe (Maybe(..))
9import Data.Maybe (Maybe(..))
8−import Effect.Aff (Aff)
10+import JS.BigInt as BigInt
11+import Data.Time.Duration (Milliseconds(..))
12+import Data.Newtype (class Newtype)
13+import Effect.Aff (Aff, delay, forkAff, joinFiber, killFiber)
14+import Effect.Aff.Class (liftAff)
15+import Effect.Aff.AVar as AVar
9import Effect.Class (class MonadEffect, liftEffect)
16import Effect.Class (class MonadEffect, liftEffect)
10import Effect.Exception as Exception
17import Effect.Exception as Exception
18+import Effect.Ref as Ref
11−import Foreign (MultipleErrors)
19+import Foreign (ForeignError(..), MultipleErrors)
12import Test.Spec (Spec, describe, it)
20import Test.Spec (Spec, describe, it)
13import Type.Proxy (Proxy(..))
21import Type.Proxy (Proxy(..))
22+import Yoga.JSON (class ReadForeign, class WriteForeign, readImpl, writeImpl)
14import Yoga.Om as Om
23import Yoga.Om as Om
15import Yoga.Postgres as PG
24import Yoga.Postgres as PG
16−import Yoga.Postgres.ClientOm (run, runOne, runExec)
25+import Yoga.Postgres.ClientOm (create, exec, run, runOne, transactionally)
17−import Yoga.Postgres.Schema (Table, PrimaryKey, AutoIncrement, Unique, Default, DefaultExpr, TimestampTZ, from, into, select, where_, orderBy, limit, groupBy, insert, delete, returning, union)
26+import Yoga.Postgres.Schema (class PGTypeName, AutoIncrement, Default, ForeignKey, PrimaryKey, References, Table, TimestampTZ, Unique, andCTE, cte, createTableDDL, delete, except_, from, fromCTE, groupBy, having, innerJoin, innerJoinAs, insert, intersect, into, leftJoin, leftJoinAs, limit, offset, onConflict, onConflictDoNothing, orderBy, returning, returningAll, select, set, union, unionAll, update, where_, with_)
19spec :: Spec Unit
28spec :: Spec Unit
20spec = describe "Query builder" do
29spec = describe "Query builder" do
31+ -- ── SELECT ──────────────────────────────────────────────────
22 it "selects columns with a WHERE clause" $ withUsersTable do
33 it "selects columns with a WHERE clause" $ withUsersTable do
23− _ <- into usersTable # insert { name: "Alice", email: "a@t.com", role: "admin" } # runExec {}
34+ _ <- into usersTable # insert { name: "Alice", email: Email "a@t.com", role: Admin } # exec {}
24− _ <- into usersTable # insert { name: "Bob", email: "b@t.com", role: "user" } # runExec {}
35+ _ <- into usersTable # insert { name: "Bob", email: Email "b@t.com", role: User } # exec {}
25− rows <- from usersTable # select @"name, email" # where_ @"role = $role" # run { role: "admin" }
36+ rows <- from usersTable
37+ # select @"name, email"
38+ # where_ @"role = $role"
39+ # run { role: Admin }
26− Array.length rows `shouldEqual` 1
40+ rows `shouldEqual` [ { name: "Alice", email: Email "a@t.com" } ]
28− r = case Array.head rows of
30− Nothing -> { name: "", email: "" }
31− r.name `shouldEqual` "Alice"
33 it "orders and limits results" $ withUsersTable do
42 it "orders and limits results" $ withUsersTable do
34− _ <- into usersTable # insert { name: "Alice", email: "a@t.com", role: "admin" } # runExec {}
43+ _ <- into usersTable # insert { name: "Alice", email: Email "a@t.com", role: Admin } # exec {}
35− _ <- into usersTable # insert { name: "Bob", email: "b@t.com", role: "user" } # runExec {}
44+ _ <- into usersTable # insert { name: "Bob", email: Email "b@t.com", role: User } # exec {}
36− _ <- into usersTable # insert { name: "Carol", email: "c@t.com", role: "user" } # runExec {}
45+ _ <- into usersTable # insert { name: "Carol", email: Email "c@t.com", role: User } # exec {}
37 rows <- from usersTable # select @"name" # orderBy @"name" # limit @"2" # run {}
46 rows <- from usersTable # select @"name" # orderBy @"name" # limit @"2" # run {}
38− Array.length rows `shouldEqual` 2
47+ rows `shouldEqual` [ { name: "Alice" }, { name: "Bob" } ]
49+ it "skips rows with offset" $ withUsersTable do
50+ _ <- into usersTable # insert { name: "Alice", email: Email "a@t.com", role: Admin } # exec {}
51+ _ <- into usersTable # insert { name: "Bob", email: Email "b@t.com", role: User } # exec {}
52+ _ <- into usersTable # insert { name: "Carol", email: Email "c@t.com", role: Mod } # exec {}
53+ rows <- from usersTable # select @"name" # orderBy @"name" # limit @"10" # offset @"1" # run {}
39− (map _.name rows) `shouldEqual` [ "Alice", "Bob" ]
54+ rows `shouldEqual` [ { name: "Bob" }, { name: "Carol" } ]
41 it "groups results" $ withUsersTable do
56 it "groups results" $ withUsersTable do
42− _ <- into usersTable # insert { name: "Alice", email: "a@t.com", role: "admin" } # runExec {}
57+ _ <- into usersTable # insert { name: "Alice", email: Email "a@t.com", role: Admin } # exec {}
43− _ <- into usersTable # insert { name: "Bob", email: "b@t.com", role: "user" } # runExec {}
58+ _ <- into usersTable # insert { name: "Bob", email: Email "b@t.com", role: User } # exec {}
44− _ <- into usersTable # insert { name: "Carol", email: "c@t.com", role: "user" } # runExec {}
59+ _ <- into usersTable # insert { name: "Carol", email: Email "c@t.com", role: User } # exec {}
45 rows <- from usersTable # select @"role" # groupBy @"role" # orderBy @"role" # run {}
60 rows <- from usersTable # select @"role" # groupBy @"role" # orderBy @"role" # run {}
46− (rows <#> _.role) `shouldEqual` [ "admin", "user" ]
61+ rows `shouldEqual` [ { role: Admin }, { role: User } ]
63+ it "filters with HAVING after GROUP BY" $ withUsersTable do
64+ _ <- into usersTable # insert { name: "Alice", email: Email "a@t.com", role: Admin } # exec {}
65+ _ <- into usersTable # insert { name: "Bob", email: Email "b@t.com", role: User } # exec {}
66+ _ <- into usersTable # insert { name: "Carol", email: Email "c@t.com", role: User } # exec {}
67+ rows <- from usersTable
68+ # select @"role, COUNT(*) AS count"
70+ # having @"COUNT(*) > $min"
73+ rows `shouldEqual` [ { role: User, count: BigInt.fromInt 2 } ]
48 it "filters with a BETWEEN range" $ withUsersTable do
75 it "filters with a BETWEEN range" $ withUsersTable do
49− _ <- into usersTable # insert { name: "Alice", email: "a@t.com", role: "admin" } # runExec {}
76+ _ <- into usersTable # insert { name: "Alice", email: Email "a@t.com", role: Admin } # exec {}
50− _ <- into usersTable # insert { name: "Bob", email: "b@t.com", role: "user" } # runExec {}
77+ _ <- into usersTable # insert { name: "Bob", email: Email "b@t.com", role: User } # exec {}
51− _ <- into usersTable # insert { name: "Carol", email: "c@t.com", role: "mod" } # runExec {}
78+ _ <- into usersTable # insert { name: "Carol", email: Email "c@t.com", role: Mod } # exec {}
52 rows <- from usersTable # select @"name" # where_ @"id BETWEEN $lo AND $hi" # orderBy @"id" # run { lo: 2, hi: 3 }
79 rows <- from usersTable # select @"name" # where_ @"id BETWEEN $lo AND $hi" # orderBy @"id" # run { lo: 2, hi: 3 }
53 rows `shouldEqual` [ { name: "Bob" }, { name: "Carol" } ]
80 rows `shouldEqual` [ { name: "Bob" }, { name: "Carol" } ]
82+ -- ── INSERT ──────────────────────────────────────────────────
55 it "inserts a row and returns specific columns" $ withUsersTable do
84 it "inserts a row and returns specific columns" $ withUsersTable do
56− row <- into usersTable # insert { name: "Alice", email: "a@t.com", role: "admin" } # returning @"id, name" # runOne {}
85+ rows <- into usersTable # insert { name: "Alice", email: Email "a@t.com", role: Admin } # returning @"name" # run {}
57− r <- shouldBeJust row
58− r.name `shouldEqual` "Alice"
86+ rows `shouldEqual` [ { name: "Alice" } ]
59− (r.id > 0) `shouldEqual` true
61 it "inserts a row with default created_at and updated_at" $ withUsersTable do
88 it "inserts a row with default created_at and updated_at" $ withUsersTable do
62− row <- into usersTable # insert { name: "Alice", email: "a@t.com", role: "admin" } # returning @"created_at, updated_at" # runOne {}
89+ row <- into usersTable # insert { name: "Alice", email: Email "a@t.com", role: Admin } # returning @"created_at, updated_at" # runOne {}
63 r <- shouldBeJust row
90 r <- shouldBeJust row
64 r.created_at `shouldEqual` r.updated_at
91 r.created_at `shouldEqual` r.updated_at
66− it "deletes with a condition and returns the deleted rows" $ withUsersTable do
93+ it "returns all columns with returningAll" $ withUsersTable do
67− _ <- into usersTable # insert { name: "Alice", email: "a@t.com", role: "admin" } # runExec {}
94+ rows <- into usersTable # insert { name: "Alice", email: Email "a@t.com", role: Admin } # returningAll # run {}
68− _ <- into usersTable # insert { name: "Bob", email: "b@t.com", role: "user" } # runExec {}
95+ let row = Array.head rows
69− rows <- from usersTable # delete # where_ @"role = $role" # returning @"name" # run { role: "admin" }
70− Array.length rows `shouldEqual` 1
71− r <- shouldBeJust (Array.head rows)
96+ r <- shouldBeJust row
72 r.name `shouldEqual` "Alice"
97 r.name `shouldEqual` "Alice"
98+ r.email `shouldEqual` Email "a@t.com"
99+ r.role `shouldEqual` Admin
101+ it "skips duplicate on ON CONFLICT DO NOTHING" $ withUsersTable do
102+ _ <- into usersTable # insert { name: "Alice", email: Email "a@t.com", role: Admin } # exec {}
103+ _ <- into usersTable # insert { name: "Alice2", email: Email "a@t.com", role: User } # onConflictDoNothing @"email" # exec {}
104+ rows <- from usersTable # select @"name" # run {}
105+ rows `shouldEqual` [ { name: "Alice" } ]
107+ it "upserts with ON CONFLICT DO UPDATE" $ withUsersTable do
108+ _ <- into usersTable # insert { name: "Alice", email: Email "a@t.com", role: Admin } # exec {}
109+ _ <- into usersTable # insert { name: "Alice2", email: Email "a@t.com", role: User }
110+ # onConflict @"email" @"DO UPDATE SET name = EXCLUDED.name"
112+ rows <- from usersTable # select @"name" # run {}
113+ rows `shouldEqual` [ { name: "Alice2" } ]
115+ describe "transactionally" do
116+ it "runs ordinary schema operations against the transaction and commits" $ withUsersTable do
119+ # insert { name: "Alice", email: Email "a@t.com", role: Admin }
122+ rows <- from usersTable # select @"name" # run {}
123+ rows `shouldEqual` [ { name: "Alice" } ]
125+ it "reads its own writes before commit" $ withUsersTable do
126+ rows <- transactionally do
127+ _ <- into usersTable
128+ # insert { name: "Alice", email: Email "a@t.com", role: Admin }
131+ # select @"name, role"
132+ # where_ @"email = $email"
133+ # run { email: Email "a@t.com" }
135+ rows `shouldEqual` [ { name: "Alice", role: Admin } ]
137+ it "shares one transaction across ClientOm and schema operations" $ withUsersTable do
138+ rows <- transactionally do
140+ # create { name: "Alice", email: Email "a@t.com", role: Admin }
142+ # select @"name, role"
143+ # where_ @"email = $email"
144+ # run { email: Email "a@t.com" }
146+ rows `shouldEqual` [ { name: "Alice", role: Admin } ]
148+ it "returns the application value after commit" $ withUsersTable do
149+ result <- transactionally do
150+ _ <- into usersTable
151+ # insert { name: "Alice", email: Email "a@t.com", role: Admin }
153+ pure { status: "created", count: 1 }
155+ result `shouldEqual` { status: "created", count: 1 }
156+ rows <- from usersTable # select @"name" # run {}
157+ rows `shouldEqual` [ { name: "Alice" } ]
159+ it "rolls back typed Om failures" $ withUsersTable do
160+ result <- try $ transactionally do
161+ _ <- into usersTable
162+ # insert { name: "Alice", email: Email "a@t.com", role: Admin }
164+ Om.fatal "abort transaction"
166+ isLeft result `shouldEqual` true
167+ rows <- from usersTable # select @"name" # run {}
168+ rows `shouldEqual` []
170+ it "rolls back writes made by composed helpers" $ withUsersTable do
172+ createUser name email role =
174+ # insert { name, email, role }
176+ rejectBatch = Om.fatal "inventory unavailable"
178+ result <- try $ transactionally do
179+ createUser "Alice" (Email "a@t.com") Admin
180+ createUser "Bob" (Email "b@t.com") User
183+ isLeft result `shouldEqual` true
184+ rows <- from usersTable # select @"name" # run {}
185+ rows `shouldEqual` []
187+ it "rolls back when an Om transaction fiber is cancelled" $ withUsersTable do
188+ wrote <- liftEffect $ Ref.new false
189+ transaction <- Om.unliftAff $ transactionally do
190+ _ <- into usersTable
191+ # insert { name: "Alice", email: Email "a@t.com", role: Admin }
193+ liftEffect $ Ref.write true wrote
194+ liftAff $ delay (Milliseconds 10000.0)
196+ fiber <- liftAff $ forkAff transaction
197+ liftAff $ delay (Milliseconds 50.0)
198+ didWrite <- liftEffect $ Ref.read wrote
199+ didWrite `shouldEqual` true
200+ liftAff $ killFiber (Exception.error "cancel transaction") fiber
202+ rows <- from usersTable # select @"name" # run {}
203+ rows `shouldEqual` []
205+ it "reuses a one-connection pool after commit and rollback" $ withSingleConnectionUsersTable do
207+ _ <- into usersTable
208+ # insert { name: "Alice", email: Email "a@t.com", role: Admin }
212+ failed <- try $ transactionally do
213+ _ <- into usersTable
214+ # insert { name: "Bob", email: Email "b@t.com", role: User }
216+ Om.fatal "roll back Bob"
217+ isLeft failed `shouldEqual` true
220+ _ <- into usersTable
221+ # insert { name: "Carol", email: Email "c@t.com", role: User }
225+ rows <- from usersTable # select @"name" # orderBy @"name" # run {}
226+ rows `shouldEqual` [ { name: "Alice" }, { name: "Carol" } ]
228+ it "isolates concurrent transactions until each commits" $ withUsersTable do
229+ inserted <- liftAff AVar.empty
230+ readRows <- liftAff AVar.empty
231+ allowRead <- liftAff AVar.empty
232+ allowCommit <- liftAff AVar.empty
234+ isolatedInsert name email role = transactionally do
235+ _ <- into usersTable
236+ # insert { name, email, role }
238+ liftAff $ AVar.put unit inserted
239+ liftAff $ AVar.read allowRead
240+ rows <- from usersTable # select @"name" # run {}
241+ liftAff $ AVar.put unit readRows
242+ liftAff $ AVar.read allowCommit
243+ pure (Array.length rows)
245+ alice <- Om.unliftAff $ isolatedInsert "Alice" (Email "a@t.com") Admin
246+ bob <- Om.unliftAff $ isolatedInsert "Bob" (Email "b@t.com") User
247+ aliceFiber <- liftAff $ forkAff alice
248+ bobFiber <- liftAff $ forkAff bob
250+ liftAff $ AVar.take inserted
251+ liftAff $ AVar.take inserted
252+ liftAff $ AVar.put unit allowRead
253+ liftAff $ AVar.take readRows
254+ liftAff $ AVar.take readRows
255+ liftAff $ AVar.put unit allowCommit
257+ aliceResult <- liftAff $ joinFiber aliceFiber
258+ bobResult <- liftAff $ joinFiber bobFiber
259+ case aliceResult, bobResult of
260+ Right aliceCount, Right bobCount ->
261+ [ aliceCount, bobCount ] `shouldEqual` [ 1, 1 ]
263+ liftEffect $ Exception.throwException $ Exception.error "concurrent transaction failed"
265+ rows <- from usersTable # select @"name" # orderBy @"name" # run {}
266+ rows `shouldEqual` [ { name: "Alice" }, { name: "Bob" } ]
268+ it "rejects nested transactions and rolls back the outer transaction" $ withUsersTable do
269+ failure <- transactionally
271+ _ <- into usersTable
272+ # insert { name: "Alice", email: Email "a@t.com", role: Admin }
275+ _ <- into usersTable
276+ # insert { name: "Bob", email: Email "b@t.com", role: User }
278+ pure "nested transaction unexpectedly succeeded"
281+ { exception: \cause -> pure (Exception.message cause)
282+ , parseError: \_ -> pure "unexpected parse error"
285+ failure `shouldEqual` "Yoga.Postgres does not support nested transactions"
286+ rows <- from usersTable # select @"name" # run {}
287+ rows `shouldEqual` []
289+ it "routes begin failures through the exception channel without running the action" do
290+ conn <- testConnection
292+ ran <- liftEffect $ Ref.new false
293+ result <- try $ Om.runOm { postgresConnection: conn }
294+ { exception: throwError }
296+ liftEffect $ Ref.write true ran
299+ isLeft result `shouldEqual` true
300+ liftEffect (Ref.read ran) >>= (_ `shouldEqual` false)
302+ it "preserves the exact typed Om error payload" $ withUsersTable do
303+ let expected = { available: 10, requested: 20 }
304+ actual <- transactionally
305+ (Om.throw { insufficientFunds: expected })
307+ { insufficientFunds: pure
309+ actual `shouldEqual` expected
311+ it "rolls back SQL exceptions and keeps the connection usable" $ withUsersTable do
312+ result <- try $ transactionally do
313+ _ <- into usersTable
314+ # insert { name: "Alice", email: Email "a@t.com", role: Admin }
316+ { postgresConnection } <- Om.ask
317+ _ <- PG.executeSimple
318+ (PG.SQL "INSERT INTO missing_transaction_table VALUES (1)")
323+ isLeft result `shouldEqual` true
324+ rows <- from usersTable # select @"name" # run {}
325+ rows `shouldEqual` []
327+ -- ── DELETE ──────────────────────────────────────────────────
329+ it "deletes with a condition and returns the deleted rows" $ withUsersTable do
330+ _ <- into usersTable # insert { name: "Alice", email: Email "a@t.com", role: Admin } # exec {}
331+ _ <- into usersTable # insert { name: "Bob", email: Email "b@t.com", role: User } # exec {}
332+ rows <- from usersTable # delete # where_ @"role = $role" # returning @"name" # run { role: Admin }
333+ rows `shouldEqual` [ { name: "Alice" } ]
335+ -- ── UPDATE ──────────────────────────────────────────────────
337+ it "updates a row with SET and WHERE" $ withUsersTable do
338+ _ <- into usersTable # insert { name: "Alice", email: Email "a@t.com", role: Admin } # exec {}
339+ _ <- into usersTable # insert { name: "Bob", email: Email "b@t.com", role: User } # exec {}
340+ _ <- update usersTable # set { role: Mod } # where_ @"name = $name" # exec { name: "Bob" }
341+ rows <- from usersTable # select @"name, role" # orderBy @"name" # run {}
342+ rows `shouldEqual` [ { name: "Alice", role: Admin }, { name: "Bob", role: Mod } ]
344+ it "updates multiple columns" $ withUsersTable do
345+ _ <- into usersTable # insert { name: "Alice", email: Email "a@t.com", role: Admin } # exec {}
346+ _ <- update usersTable # set { name: "Alicia", role: Mod } # where_ @"email = $email" # exec { email: Email "a@t.com" }
347+ rows <- from usersTable # select @"name, role" # run {}
348+ rows `shouldEqual` [ { name: "Alicia", role: Mod } ]
350+ it "updates and returns the modified row" $ withUsersTable do
351+ _ <- into usersTable # insert { name: "Alice", email: Email "a@t.com", role: Admin } # exec {}
352+ rows <- update usersTable
354+ # where_ @"email = $email"
355+ # returning @"name, role"
356+ # run { email: Email "a@t.com" }
357+ rows `shouldEqual` [ { name: "Alice", role: Mod } ]
359+ -- ── SET OPERATIONS ──────────────────────────────────────────
74 it "combines two queries with UNION" $ withUsersTable do
361 it "combines two queries with UNION" $ withUsersTable do
75− _ <- into usersTable # insert { name: "Alice", email: "a@t.com", role: "admin" } # runExec {}
362+ _ <- into usersTable # insert { name: "Alice", email: Email "a@t.com", role: Admin } # exec {}
76− _ <- into usersTable # insert { name: "Bob", email: "b@t.com", role: "user" } # runExec {}
363+ _ <- into usersTable # insert { name: "Bob", email: Email "b@t.com", role: User } # exec {}
77− _ <- into usersTable # insert { name: "Carol", email: "c@t.com", role: "mod" } # runExec {}
364+ _ <- into usersTable # insert { name: "Carol", email: Email "c@t.com", role: Mod } # exec {}
79− from usersTable # select @"name" # where_ @"role = $a"
365+ rows <- from usersTable # select @"name" # where_ @"role = $a"
80− # union (from usersTable # select @"name" # where_ @"role = $b")
366+ # union (from usersTable # select @"name" # where_ @"role = $b")
81− # run { a: "admin", b: "mod" }
367+ # run { a: Admin, b: Mod }
368+ Array.sort rows `shouldEqual` [ { name: "Alice" }, { name: "Carol" } ]
370+ it "combines with UNION ALL including duplicates" $ withUsersTable do
371+ _ <- into usersTable # insert { name: "Alice", email: Email "a@t.com", role: Admin } # exec {}
372+ _ <- into usersTable # insert { name: "Bob", email: Email "b@t.com", role: User } # exec {}
373+ rows <- from usersTable # select @"name" # where_ @"role = $r"
374+ # unionAll (from usersTable # select @"name" # where_ @"role = $r2")
375+ # run { r: Admin, r2: Admin }
376+ Array.sort rows `shouldEqual` [ { name: "Alice" }, { name: "Alice" } ]
378+ it "returns common rows with INTERSECT" $ withUsersTable do
379+ _ <- into usersTable # insert { name: "Alice", email: Email "a@t.com", role: Admin } # exec {}
380+ _ <- into usersTable # insert { name: "Bob", email: Email "b@t.com", role: User } # exec {}
381+ rows <- from usersTable # select @"name" # where_ @"role = $a"
382+ # intersect (from usersTable # select @"name" # where_ @"name = $n")
383+ # run { a: Admin, n: "Alice" }
384+ rows `shouldEqual` [ { name: "Alice" } ]
386+ it "excludes rows with EXCEPT" $ withUsersTable do
387+ _ <- into usersTable # insert { name: "Alice", email: Email "a@t.com", role: Admin } # exec {}
388+ _ <- into usersTable # insert { name: "Bob", email: Email "b@t.com", role: User } # exec {}
389+ _ <- into usersTable # insert { name: "Carol", email: Email "c@t.com", role: Mod } # exec {}
390+ rows <- (from usersTable # select @"name")
391+ `except_` (from usersTable # select @"name" # where_ @"role = $r")
82− Array.sort (rows <#> _.name) `shouldEqual` [ "Alice", "Carol" ]
393+ Array.sort rows `shouldEqual` [ { name: "Alice" }, { name: "Carol" } ]
395+ -- ── JOINs ───────────────────────────────────────────────────
397+ it "inner joins posts to users" $ withUsersAndPostsTable do
398+ alice <- into usersTable # insert { name: "Alice", email: Email "a@t.com", role: Admin } # returning @"id" # runOne {}
399+ { id: aliceId } <- shouldBeJust alice
400+ _ <- into postsTable # insert { user_id: aliceId, title: "Hello" } # exec {}
401+ rows <- from usersTable
402+ # innerJoin @"test_om_users.id = test_om_posts.user_id" postsTable
403+ # select @"test_om_users.name, test_om_posts.title"
405+ rows `shouldEqual` [ { name: "Alice", title: "Hello" } ]
407+ it "inner join excludes users without posts" $ withUsersAndPostsTable do
408+ alice <- into usersTable # insert { name: "Alice", email: Email "a@t.com", role: Admin } # returning @"id" # runOne {}
409+ { id: aliceId } <- shouldBeJust alice
410+ _ <- into usersTable # insert { name: "Bob", email: Email "b@t.com", role: User } # exec {}
411+ _ <- into postsTable # insert { user_id: aliceId, title: "Hello" } # exec {}
412+ rows <- from usersTable
413+ # innerJoin @"test_om_users.id = test_om_posts.user_id" postsTable
414+ # select @"test_om_users.name"
416+ rows `shouldEqual` [ { name: "Alice" } ]
418+ it "left join includes users without posts as Nothing" $ withUsersAndPostsTable do
419+ alice <- into usersTable # insert { name: "Alice", email: Email "a@t.com", role: Admin } # returning @"id" # runOne {}
420+ { id: aliceId } <- shouldBeJust alice
421+ _ <- into usersTable # insert { name: "Bob", email: Email "b@t.com", role: User } # exec {}
422+ _ <- into postsTable # insert { user_id: aliceId, title: "Hello" } # exec {}
423+ rows <- from usersTable
424+ # leftJoin @"test_om_users.id = test_om_posts.user_id" postsTable
425+ # select @"test_om_users.name, test_om_posts.title"
426+ # orderBy @"test_om_users.name"
429+ [ { name: "Alice", title: Just "Hello" }
430+ , { name: "Bob", title: Nothing }
433+ it "inner join with alias" $ withUsersAndPostsTable do
434+ alice <- into usersTable # insert { name: "Alice", email: Email "a@t.com", role: Admin } # returning @"id" # runOne {}
435+ { id: aliceId } <- shouldBeJust alice
436+ _ <- into postsTable # insert { user_id: aliceId, title: "Hello" } # exec {}
437+ rows <- from usersTable
438+ # innerJoinAs @"p" @"test_om_users.id = p.user_id" postsTable
439+ # select @"test_om_users.name, p.title"
441+ rows `shouldEqual` [ { name: "Alice", title: "Hello" } ]
443+ it "left join with alias yields Nothing for unmatched" $ withUsersAndPostsTable do
444+ _ <- into usersTable # insert { name: "Alice", email: Email "a@t.com", role: Admin } # exec {}
445+ rows <- from usersTable
446+ # leftJoinAs @"p" @"test_om_users.id = p.user_id" postsTable
447+ # select @"test_om_users.name, p.title"
449+ rows `shouldEqual` [ { name: "Alice", title: Nothing } ]
451+ -- ── CTEs ────────────────────────────────────────────────────
453+ it "selects from a CTE" $ withUsersTable do
454+ _ <- into usersTable # insert { name: "Alice", email: Email "a@t.com", role: Admin } # exec {}
455+ _ <- into usersTable # insert { name: "Bob", email: Email "b@t.com", role: User } # exec {}
456+ let ctes = from usersTable # select @"name" # where_ @"role = $role" # cte @"active_users"
458+ (fromCTE @"active_users" ctes # select @"active_users.name")
459+ # run { role: Admin }
460+ rows `shouldEqual` [ { name: "Alice" } ]
462+ it "CTE can be further filtered in the main query" $ withUsersTable do
463+ _ <- into usersTable # insert { name: "Alice", email: Email "a@t.com", role: Admin } # exec {}
464+ _ <- into usersTable # insert { name: "Bob", email: Email "b@t.com", role: Admin } # exec {}
465+ let ctes = from usersTable # select @"name" # where_ @"role = $role" # cte @"admins"
467+ (fromCTE @"admins" ctes # select @"admins.name" # where_ @"admins.name = $name")
468+ # run { role: Admin, name: "Alice" }
469+ rows `shouldEqual` [ { name: "Alice" } ]
471+ it "two CTEs with andCTE" $ withUsersAndPostsTable do
472+ alice <- into usersTable # insert { name: "Alice", email: Email "a@t.com", role: Admin } # returning @"id" # runOne {}
473+ { id: aliceId } <- shouldBeJust alice
474+ _ <- into postsTable # insert { user_id: aliceId, title: "Hello" } # exec {}
475+ let adminsCTE = from usersTable # select @"name" # where_ @"role = $role" # cte @"admins"
476+ let ctes = andCTE @"posts" (from postsTable # select @"title") adminsCTE
478+ (fromCTE @"admins" ctes # select @"admins.name")
479+ # run { role: Admin }
480+ rows `shouldEqual` [ { name: "Alice" } ]
84-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
482-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
85-- Test schema
483-- Test schema
86-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
484-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
486+newtype Email = Email String
488+derive instance Newtype Email _
489+derive instance Eq Email
490+derive instance Ord Email
491+derive newtype instance Show Email
492+derive newtype instance ReadForeign Email
493+derive newtype instance WriteForeign Email
495+data Role = Admin | User | Mod
497+derive instance Eq Role
498+derive instance Ord Role
500+instance Show Role where
503+instance WriteForeign Role where
504+ writeImpl = roleToString >>> writeImpl
506+instance ReadForeign Role where
508+ s :: String <- readImpl f
510+ "admin" -> pure Admin
513+ _ -> Except.throwError $ pure $ ForeignError $ "Unknown role: " <> s
515+roleToString :: Role -> String
516+roleToString = case _ of
521+instance PGTypeName Email where
522+ pgTypeName _ = "TEXT"
524+instance PGTypeName Role where
525+ pgTypeName _ = "TEXT"
88type UsersTable = Table "test_om_users"
527type UsersTable = Table "test_om_users"
89 ( id :: PrimaryKey (AutoIncrement Int)
528 ( id :: PrimaryKey (AutoIncrement Int)
90 , name :: String
529 , name :: String
91− , email :: Unique String
530+ , email :: Unique Email
92 , active :: Default "true" Boolean
531 , active :: Default "true" Boolean
93− , role :: String
532+ , role :: Role
94− , created_at :: DefaultExpr "now()" TimestampTZ
533+ , created_at :: Default "now()" TimestampTZ
95− , updated_at :: DefaultExpr "now()" TimestampTZ
534+ , updated_at :: Default "now()" TimestampTZ
98usersTable :: Proxy UsersTable
537usersTable :: Proxy UsersTable
99usersTable = Proxy
538usersTable = Proxy
540+type PostsTable = Table "test_om_posts"
541+ ( id :: PrimaryKey (AutoIncrement Int)
542+ , user_id :: ForeignKey "test_om_users" References "id" Int
546+postsTable :: Proxy PostsTable
101-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
549-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
102-- Helpers
550-- Helpers
103-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
551-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
@@ -105,7 +553,8 @@ usersTable = Proxy
105type TestOm = Om.Om { postgresConnection :: PG.Connection } (parseError :: MultipleErrors) Unit
553type TestOm = Om.Om { postgresConnection :: PG.Connection } (parseError :: MultipleErrors) Unit
107shouldEqual :: forall m t. MonadEffect m => Show t => Eq t => t -> t -> m Unit
555shouldEqual :: forall m t. MonadEffect m => Show t => Eq t => t -> t -> m Unit
556+shouldEqual v1 v2 = liftEffect $ when (v1 /= v2) do
108−shouldEqual v1 v2 = when (v1 /= v2) $ liftEffect $ Exception.throwException $ Exception.error $ show v1 <> " ≠ " <> show v2
557+ Exception.throwException $ Exception.error $ show v1 <> " ≠ " <> show v2
110shouldBeJust :: forall m a. MonadEffect m => Maybe a -> m a
559shouldBeJust :: forall m a. MonadEffect m => Maybe a -> m a
111shouldBeJust (Just a) = pure a
560shouldBeJust (Just a) = pure a
@@ -133,15 +582,50 @@ withUsersTable test = do
133 _ <- PG.executeSimple dropDDL conn
582 _ <- PG.executeSimple dropDDL conn
134 PG.end conn
583 PG.end conn
136− dropDDL = PG.SQL "DROP TABLE IF EXISTS test_om_users CASCADE"
585+ dropStr = "DROP TABLE IF EXISTS test_om_users CASCADE"
586+ dropDDL = PG.SQL dropStr
137− createDDL = PG.SQL
587+ createDDL = PG.SQL (dropStr <> "; " <> createTableDDL @UsersTable)
138− """DROP TABLE IF EXISTS test_om_users CASCADE;
588+
139− CREATE TABLE test_om_users (
589+withSingleConnectionUsersTable :: TestOm -> Aff Unit
140− id SERIAL PRIMARY KEY,
590+withSingleConnectionUsersTable test = do
141− name TEXT NOT NULL,
591+ conn <- PG.postgres
142− email TEXT UNIQUE NOT NULL,
592+ { host: PG.PostgresHost "localhost"
143− active BOOLEAN DEFAULT true NOT NULL,
593+ , port: PG.PostgresPort 5433
144− role TEXT NOT NULL,
594+ , database: PG.PostgresDatabase "test_playground"
145− created_at TIMESTAMPTZ DEFAULT now() NOT NULL,
595+ , username: PG.PostgresUsername "postgres"
146− updated_at TIMESTAMPTZ DEFAULT now() NOT NULL
596+ , password: PG.PostgresPassword "postgres"
147− )"""
597+ , max: PG.MaxConnections 1
599+ _ <- PG.executeSimple createDDL conn
600+ Om.runOm { postgresConnection: conn }
601+ { exception: throwError
602+ , parseError: \errs -> throwError (Exception.error ("Parse error: " <> show errs))
605+ _ <- PG.executeSimple dropDDL conn
608+ dropStr = "DROP TABLE IF EXISTS test_om_users CASCADE"
609+ dropDDL = PG.SQL dropStr
610+ createDDL = PG.SQL (dropStr <> "; " <> createTableDDL @UsersTable)
612+withUsersAndPostsTable :: TestOm -> Aff Unit
613+withUsersAndPostsTable test = do
614+ conn <- testConnection
615+ _ <- PG.executeSimple setupDDL conn
616+ Om.runOm { postgresConnection: conn }
617+ { exception: throwError
618+ , parseError: \errs -> throwError (Exception.error ("Parse error: " <> show errs))
621+ _ <- PG.executeSimple teardownDDL conn
624+ teardownDDL = PG.SQL "DROP TABLE IF EXISTS test_om_posts CASCADE; DROP TABLE IF EXISTS test_om_users CASCADE"
626+ ( "DROP TABLE IF EXISTS test_om_posts CASCADE; "
627+ <> "DROP TABLE IF EXISTS test_om_users CASCADE; "
628+ <> createTableDDL @UsersTable
630+ <> createTableDDL @PostsTable