git.iko.soy/rowtype-yoga/purescript-yoga-postgres-om
on main help sign in
9 files changed+1042−502
since splitsnapshots
unifiedsplit
.psc-ide-port+1−1 README.md+1 spago.lock+34−21 spago.yaml+11−8 src/Yoga/Postgres/ClientOm.js+21−1 src/Yoga/Postgres/ClientOm.purs+47−19 test/Test/.psc-ide-port−1 test/Test/ClientOm.purs+349−358 test/Test/SchemaQ.purs+578−93
.psc-ide-port+1−1
@@ -1 +1 @@
1−15396
1+15453
README.md+1
@@ -25,3 +25,4 @@ See [yoga-postgres](../yoga-postgres) for raw bindings.
2525## License
2626
2727MIT
28+
spago.lock+34−21
@@ -6,7 +6,7 @@
66 "core": {
77 "dependencies": [
88 {
9− "aff": ">=7.1.0 <8.0.0"
9+ "aff": ">=8.0.0 <9.0.0"
1010 },
1111 {
1212 "arrays": ">=7.3.0 <8.0.0"
@@ -20,6 +20,9 @@
2020 {
2121 "either": ">=6.1.0 <7.0.0"
2222 },
23+ {
24+ "exceptions": ">=6.1.0 <7.0.0"
25+ },
2326 {
2427 "foldable-traversable": ">=6.0.0 <7.0.0"
2528 },
@@ -27,11 +30,14 @@
2730 "foreign": ">=7.0.0 <8.0.0"
2831 },
2932 {
30− "heterogeneous": ">=0.6.0 <0.7.0"
33+ "heterogeneous": ">=0.7.0 <0.8.0"
3134 },
3235 {
3336 "maybe": ">=6.0.0 <7.0.0"
3437 },
38+ {
39+ "nullable": ">=6.0.0 <7.0.0"
40+ },
3541 {
3642 "ordered-collections": ">=3.2.0 <4.0.0"
3743 },
@@ -54,24 +60,27 @@
5460 "unsafe-coerce": ">=6.0.0 <7.0.0"
5561 },
5662 {
57− "yoga-json": ">=5.2.0 <6.0.0"
63+ "yoga-json": ">=5.2.1 <6.0.0"
5864 },
5965 {
60− "yoga-om": ">=1.4.0 <2.0.0"
66+ "yoga-om": ">=2.2.1 <3.0.0"
6167 },
6268 {
63− "yoga-om-layer": ">=1.1.1 <2.0.0"
69+ "yoga-om-layer": ">=2.1.0 <3.0.0"
6470 },
6571 {
66− "yoga-postgres": ">=0.2.0 <0.3.0"
72+ "yoga-postgres": ">=0.3.2 <0.4.0"
6773 },
6874 {
69− "yoga-sql-types": ">=0.1.0 <0.2.0"
75+ "yoga-sql-types": ">=0.2.0 <0.3.0"
7076 }
7177 ]
7278 },
7379 "test": {
7480 "dependencies": [
81+ {
82+ "avar": ">=5.0.1 <6.0.0"
83+ },
7584 {
7685 "console": ">=6.0.0 <7.0.0"
7786 },
@@ -90,8 +99,8 @@
9099 "packages": {
91100 "aff": {
92101 "type": "registry",
93− "version": "7.1.0",
94− "integrity": "sha256-/nOpDQVnKIoP1pQ1ZZBYpadK0TuMlG4WwufGzJpsfD0=",
102+ "version": "8.0.0",
103+ "integrity": "sha256-9BRIrSdRoYybfiUmBqgKJ66cPqxYHb277bVWQMn/9sg=",
95104 "dependencies": [
96105 "control",
97106 "datetime",
@@ -462,8 +471,8 @@
462471 },
463472 "heterogeneous": {
464473 "type": "registry",
465− "version": "0.6.0",
466− "integrity": "sha256-nQgk2iHYe5LIi6ZzREgWaCU3y8oCwdhDSukT6xVMWdk=",
474+ "version": "0.7.0",
475+ "integrity": "sha256-pQwcFvhWL8noktxaoD7FlLs2F2lYf3QHoyO0VOWO3I0=",
467476 "dependencies": [
468477 "either",
469478 "foldable-traversable",
@@ -1010,8 +1019,8 @@
10101019 },
10111020 "yoga-json": {
10121021 "type": "registry",
1013− "version": "5.2.0",
1014− "integrity": "sha256-M+kkz6E1Gf+C4bKnhqoBFIoVcc74loi3rLULePbB204=",
1022+ "version": "5.2.1",
1023+ "integrity": "sha256-12I7qIf27oKV/D/YRcHtGpN8n7GQ0Bm3uzvI4ZjOQrs=",
10151024 "dependencies": [
10161025 "arrays",
10171026 "bifunctors",
@@ -1049,8 +1058,8 @@
10491058 },
10501059 "yoga-om": {
10511060 "type": "registry",
1052− "version": "1.4.0",
1053− "integrity": "sha256-gTpW2XABBZbD3FtDR4gX1ktB1EtQUibIvGUuOhUuXRU=",
1061+ "version": "2.2.1",
1062+ "integrity": "sha256-nahYX6UD7/7chFM5hxGGVITSbiLXKb0gbP3PV8CvsXY=",
10541063 "dependencies": [
10551064 "aff",
10561065 "aff-retry",
@@ -1062,6 +1071,7 @@
10621071 "either",
10631072 "exceptions",
10641073 "functions",
1074+ "heterogeneous",
10651075 "maybe",
10661076 "newtype",
10671077 "parallel",
@@ -1080,12 +1090,13 @@
10801090 },
10811091 "yoga-om-layer": {
10821092 "type": "registry",
1083− "version": "1.1.1",
1084− "integrity": "sha256-9Hl4M0p/+6X98slJAv/Zg5oitWQBYb9ndD7rQlkfXTo=",
1093+ "version": "2.1.0",
1094+ "integrity": "sha256-4XxwLT/1JJQovIkH/qog5YRa4WcP8SbfKFrWs214/sQ=",
10851095 "dependencies": [
10861096 "aff",
10871097 "aff-retry",
10881098 "arrays",
1099+ "control",
10891100 "effect",
10901101 "exceptions",
10911102 "foldable-traversable",
@@ -1097,8 +1108,10 @@
10971108 "record",
10981109 "record-studio",
10991110 "refs",
1111+ "tailrec",
11001112 "transformers",
11011113 "type-equality",
1114+ "typelevel-prelude",
11021115 "unsafe-coerce",
11031116 "variant",
11041117 "yoga-om"
@@ -1106,8 +1119,8 @@
11061119 },
11071120 "yoga-postgres": {
11081121 "type": "registry",
1109− "version": "0.2.0",
1110− "integrity": "sha256-63pzEyMW6OrvCiDYD/RTk+T0LBmsMDtgZWeLYefNH/c=",
1122+ "version": "0.3.2",
1123+ "integrity": "sha256-3xDBcPLrIRYbrj2k7Y+V6WcxD+I7yls90AjBCQS1NCk=",
11111124 "dependencies": [
11121125 "aff",
11131126 "arrays",
@@ -1143,8 +1156,8 @@
11431156 },
11441157 "yoga-sql-types": {
11451158 "type": "registry",
1146− "version": "0.1.0",
1147− "integrity": "sha256-vxOgnj3HK8F5gRHCNkIPNirORQtCBEKozG+CnrHtB84=",
1159+ "version": "0.2.0",
1160+ "integrity": "sha256-/fiSiEmSQ8UH2N7vp/E02Eo+Krbs6iGcre9haDV34Q8=",
11481161 "dependencies": [
11491162 "arrays",
11501163 "bifunctors",
spago.yaml+11−8
@@ -3,21 +3,23 @@ workspace: {}
33package:
44 name: yoga-postgres-om
55 publish:
6− version: 0.1.0
6+ version: 0.1.1
77 license: MIT
88 location:
99 githubOwner: rowtype-yoga
1010 githubRepo: purescript-yoga-postgres-om
1111 dependencies:
12− - aff: ">=7.1.0 <8.0.0"
12+ - aff: ">=8.0.0 <9.0.0"
1313 - arrays: ">=7.3.0 <8.0.0"
1414 - console: ">=6.1.0 <7.0.0"
1515 - effect: ">=4.0.0 <5.0.0"
1616 - either: ">=6.1.0 <7.0.0"
17+ - exceptions: ">=6.1.0 <7.0.0"
1718 - foldable-traversable: ">=6.0.0 <7.0.0"
1819 - foreign: ">=7.0.0 <8.0.0"
19− - heterogeneous: ">=0.6.0 <0.7.0"
20+ - heterogeneous: ">=0.7.0 <0.8.0"
2021 - maybe: ">=6.0.0 <7.0.0"
22+ - nullable: ">=6.0.0 <7.0.0"
2123 - ordered-collections: ">=3.2.0 <4.0.0"
2224 - prelude: ">=6.0.2 <7.0.0"
2325 - record: ">=4.0.0 <5.0.0"
@@ -25,14 +27,15 @@ package:
2527 - tuples: ">=7.0.0 <8.0.0"
2628 - typelevel-prelude: ">=7.0.0 <8.0.0"
2729 - unsafe-coerce: ">=6.0.0 <7.0.0"
28− - yoga-json: ">=5.2.0 <6.0.0"
29− - yoga-om: ">=1.4.0 <2.0.0"
30− - yoga-om-layer: ">=1.1.1 <2.0.0"
31− - yoga-postgres: ">=0.2.0 <0.3.0"
32− - yoga-sql-types: ">=0.1.0 <0.2.0"
30+ - yoga-json: ">=5.2.1 <6.0.0"
31+ - yoga-om: ">=2.2.1 <3.0.0"
32+ - yoga-om-layer: ">=2.1.0 <3.0.0"
33+ - yoga-postgres: ">=0.3.2 <0.4.0"
34+ - yoga-sql-types: ">=0.2.0 <0.3.0"
3335 test:
3436 main: Test.Main
3537 dependencies:
38+ - avar: ">=5.0.1 <6.0.0"
3639 - console: ">=6.0.0 <7.0.0"
3740 - exceptions: ">=6.0.0 <7.0.0"
3841 - spec: ">=7.0.0 <8.0.0"
src/Yoga/Postgres/ClientOm.js+21−1
@@ -1 +1,21 @@
1−export const txToConnection = (tx) => tx._sql || tx._reserved || tx;
1+const transactionConnections = new WeakSet();
2+
3+const transactionFailure = Symbol("Yoga.Postgres.transactionFailure");
4+
5+export const transactionErrorImpl = (failure) => {
6+ const error = new Error("Yoga.Postgres transaction aborted");
7+ error[transactionFailure] = failure;
8+ return error;
9+};
10+
11+export const transactionFailureImpl = (error) =>
12+ error?.[transactionFailure] ?? null;
13+
14+export const txToConnection = (transaction) => {
15+ const connection = transaction._sql ?? transaction;
16+ transactionConnections.add(connection);
17+ return connection;
18+};
19+
20+export const isTransactionConnection = (connection) =>
21+ transactionConnections.has(connection);
src/Yoga/Postgres/ClientOm.purs+47−19
@@ -5,13 +5,15 @@ import Prelude
55import Data.Array (filter, intercalate, length, mapWithIndex, take)
66import Data.Tuple.Nested (type (/\), (/\))
77import Data.Either (Either(..))
8−import Data.Maybe (Maybe)
8+import Data.Maybe (Maybe(..))
9+import Data.Nullable as Nullable
910import Record (get) as Record
1011import Data.Symbol (class IsSymbol, reflectSymbol)
1112import Data.Traversable (traverse)
12−import Control.Monad.Reader.Class (local)
13+import Control.Monad.Error.Class (throwError, try)
1314import Effect.Aff.Class (liftAff)
14−import Foreign (Foreign, MultipleErrors)
15+import Effect.Exception (Error, error)
16+import Foreign (Foreign, MultipleErrors, unsafeFromForeign, unsafeToForeign)
1517import Prim.Boolean (True, False)
1618import Prim.Row (class Cons, class Lacks, class Union) as Row
1719import Prim.RowList as RL
@@ -30,14 +32,42 @@ import Yoga.Postgres.Schema
3032 , class FieldToPGValue, class InsertableColumnsRL, class RecordValuesRL
3133 , class RequiredColumnsRL, class SetClauseRL, class StripColumnsRL
3234 , class ValidateSetColumnsRL
33− , Table, PrimaryKey, AutoIncrement, Unique, Default, DefaultExpr
35+ , Table, PrimaryKey, AutoIncrement, Unique, Default
3436 , ForeignKey, References, Nullable
3537 , columnCountRL, columnNamesRL, fieldToPGValue, recordValuesRL, setClauseRL
36− , class ExtractWord, class SkipSpaces, class SplitOnDot
38+ , class ExtractWord, class SkipSpaces
3739 )
3840import Yoga.Postgres.Schema as Schema
3941
4042
43+
44+foreign import transactionErrorImpl :: Foreign -> Error
45+foreign import transactionFailureImpl :: Error -> Nullable.Nullable Foreign
46+foreign import isTransactionConnection :: PG.Connection -> Boolean
47+
48+transactionally
49+ :: forall r err a
50+ . Om.Om { postgresConnection :: PG.Connection | r } err a
51+ -> Om.Om { postgresConnection :: PG.Connection | r } err a
52+transactionally action = do
53+ context@{ postgresConnection } <- Om.ask
54+ Om.throwWhen
55+ { exception: error "Yoga.Postgres does not support nested transactions" }
56+ (isTransactionConnection postgresConnection)
57+ outcome <- liftAff $ try $ PG.withTransaction
58+ (\transaction -> do
59+ let transactionContext = context { postgresConnection = txToConnection transaction }
60+ Om.runReader transactionContext action >>= case _ of
61+ Left failure -> throwError (transactionErrorImpl (unsafeToForeign failure))
62+ Right value -> pure value
63+ )
64+ postgresConnection
65+ case outcome of
66+ Right value -> pure value
67+ Left cause -> case Nullable.toMaybe (transactionFailureImpl cause) of
68+ Just failure -> throwError (unsafeFromForeign failure)
69+ Nothing -> Om.throw { exception: cause }
70+
4171-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
4272-- Query builder bridge (Schema.Q -> Om)
4373-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
@@ -66,17 +96,27 @@ runOne params q = do
6696 { postgresConnection } <- Om.ask
6797 Schema.runQueryOne postgresConnection params q # liftAff
6898
69−runExec
99+exec
100+ :: forall tables params paramsRL stage r err
101+ . RowToList params paramsRL
102+ => Schema.ParamsToArray paramsRL params
103+ => { | params }
104+ -> Schema.Q tables () params stage
105+ -> Om.Om { postgresConnection :: PG.Connection | r } err Unit
106+exec params q = void (execCount params q)
107+
108+execCount
70109 :: forall tables params paramsRL stage r err
71110 . RowToList params paramsRL
72111 => Schema.ParamsToArray paramsRL params
73112 => { | params }
74113 -> Schema.Q tables () params stage
75114 -> Om.Om { postgresConnection :: PG.Connection | r } err Int
76−runExec params q = do
115+execCount params q = do
77116 { postgresConnection } <- Om.ask
78117 Schema.runExecute postgresConnection params q # liftAff
79118
119+
80120-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
81121-- WHERE operators
82122-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
@@ -299,7 +339,6 @@ instance HasPrimaryKeyConstraint (PrimaryKey a) True
299339else instance HasPrimaryKeyConstraint a result => HasPrimaryKeyConstraint (AutoIncrement a) result
300340else instance HasPrimaryKeyConstraint a result => HasPrimaryKeyConstraint (Unique a) result
301341else instance HasPrimaryKeyConstraint a result => HasPrimaryKeyConstraint (Default s a) result
302−else instance HasPrimaryKeyConstraint a result => HasPrimaryKeyConstraint (DefaultExpr s a) result
303342else instance HasPrimaryKeyConstraint a result => HasPrimaryKeyConstraint (ForeignKey t r c a) result
304343else instance HasPrimaryKeyConstraint a result => HasPrimaryKeyConstraint (Nullable a) result
305344else instance HasPrimaryKeyConstraint a False
@@ -1823,17 +1862,6 @@ deleteWhereReturning whereRec _ = do
18231862-- Transaction
18241863-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
18251864
1826−withTransaction
1827− :: forall r err a
1828− . Om.Om { postgresConnection :: PG.Connection | r } err a
1829− -> Om.Om { postgresConnection :: PG.Connection | r } err a
1830−withTransaction action = do
1831− { postgresConnection } <- Om.ask
1832− tx <- PG.begin postgresConnection # liftAff
1833− let txConn = txToConnection tx
1834− result <- local (_ { postgresConnection = txConn }) action
1835− PG.commit tx # liftAff
1836− pure result
18371865
18381866foreign import txToConnection :: PG.Transaction -> PG.Connection
18391867
test/Test/.psc-ide-portdeleted−1
@@ -1 +0,0 @@
1−15143
test/Test/ClientOm.purs+349−358
@@ -6,11 +6,10 @@ import Control.Monad.Error.Class (throwError)
66import Data.Array as Array
77import Data.Maybe (Maybe(..), isNothing)
88import Effect.Aff (Aff)
9−import Effect.Class (liftEffect)
10−import Effect.Exception (error)
9+import Effect.Class (class MonadEffect, liftEffect)
10+import Effect.Exception as Exception
1111import Foreign (MultipleErrors)
1212import Test.Spec (Spec, describe, it)
13−import Test.Spec.Assertions (shouldEqual)
1413import Type.Function (type (#))
1514import Type.Proxy (Proxy(..))
1615import Yoga.Om as Om
@@ -32,422 +31,400 @@ import Yoga.Postgres.ClientOm
3231 , gt, gte, ilike, inArray, join, like_, lt, lte
3332 , maxOf, minOf, minOfWhere, ne, not_, or_
3433 , selectFrom, selectFromWhere, selectOneFrom, selectOneFromWhere
35− , sumOf, sumOfWhere, updateWhere, upsert, upsertMany, withTransaction
34+ , sumOf, sumOfWhere, transactionally, updateWhere, upsert, upsertMany
3635 )
37−import Yoga.Postgres.Schema (Table, PrimaryKey, AutoIncrement, Unique, Default, DefaultExpr, ForeignKey, References, PGUUID)
36+import Yoga.Postgres.Schema (Table, PrimaryKey, AutoIncrement, Unique, Default, ForeignKey, References, PGUUID)
3837
3938spec :: Spec Unit
4039spec = describe "ClientOm" do
4140
4241 describe "Creating records" do
43− it "inserts a record and returns it with generated fields" $ withUsersTable \conn -> do
44− created <- conn # run do usersTable # create { name: "Alice", email: "a@t.com", role: "admin" }
42+ it "inserts a record and returns it with generated fields" $ withUsersTable do
43+ created <- usersTable # create { name: "Alice", email: "a@t.com", role: "admin" }
4544 alice <- shouldBeJust created
4645 alice.name `shouldEqual` "Alice"
4746 (alice.id > 0) `shouldEqual` true
4847
49− it "lets the database fill in defaults" $ withUsersTable \conn -> do
50− created <- conn # run do usersTable # create { name: "Alice", email: "a@t.com", role: "admin" }
48+ it "lets the database fill in defaults" $ withUsersTable do
49+ created <- usersTable # create { name: "Alice", email: "a@t.com", role: "admin" }
5150 alice <- shouldBeJust created
5251 alice.active `shouldEqual` true
5352
54− it "inserts many records at once" $ withUsersTable \conn -> do
53+ it "inserts many records at once" $ withUsersTable do
5554 let noUsers = [] :: Array { name :: String, email :: String, role :: String }
56− empty <- conn # run do usersTable # createMany noUsers
55+ empty <- usersTable # createMany noUsers
5756 Array.length empty `shouldEqual` 0
58− users <- conn # run do
59− usersTable # createMany
60− [ { name: "Alice", email: "a@t.com", role: "admin" }
61− , { name: "Bob", email: "b@t.com", role: "user" }
62− , { name: "Carol", email: "c@t.com", role: "user" }
63− ]
57+ users <- usersTable # createMany
58+ [ { name: "Alice", email: "a@t.com", role: "admin" }
59+ , { name: "Bob", email: "b@t.com", role: "user" }
60+ , { name: "Carol", email: "c@t.com", role: "user" }
61+ ]
6462 Array.length users `shouldEqual` 3
65− n <- conn # runNoErr do usersTable # count
63+ n <- usersTable # count
6664 n `shouldEqual` 3
6765
68− it "skips insert when a conflict would occur" $ withSettingsTable \conn -> do
69− inserted <- conn # run do settingsTable # createIfNotExists { key: "theme", value: "dark" }
66+ it "skips insert when a conflict would occur" $ withSettingsTable do
67+ inserted <- settingsTable # createIfNotExists { key: "theme", value: "dark" }
7068 r1 <- shouldBeJust inserted
7169 r1.value `shouldEqual` "dark"
72− skipped <- conn # run do settingsTable # createIfNotExists { key: "theme", value: "light" }
70+ skipped <- settingsTable # createIfNotExists { key: "theme", value: "light" }
7371 isNothing skipped `shouldEqual` true
74− found <- conn # run do settingsTable # findOneBy @"key" "theme"
72+ found <- settingsTable # findOneBy @"key" "theme"
7573 existing <- shouldBeJust found
7674 existing.value `shouldEqual` "dark"
7775
78− it "upserts: inserts or updates on conflict" $ withSettingsTable \conn -> do
79− inserted <- conn # run do settingsTable # upsert { key: "theme", value: "dark" }
76+ it "upserts: inserts or updates on conflict" $ withSettingsTable do
77+ inserted <- settingsTable # upsert { key: "theme", value: "dark" }
8078 r1 <- shouldBeJust inserted
8179 r1.value `shouldEqual` "dark"
82− updated <- conn # run do settingsTable # upsert { key: "theme", value: "light" }
80+ updated <- settingsTable # upsert { key: "theme", value: "light" }
8381 r2 <- shouldBeJust updated
8482 r2.value `shouldEqual` "light"
85− n <- conn # runNoErr do settingsTable # count
83+ n <- settingsTable # count
8684 n `shouldEqual` 1
8785
88− it "bulk upserts a batch" $ withSettingsTable \conn -> do
89− _ <- conn # run do
90− settingsTable # upsertMany
91− [ { key: "theme", value: "dark" }
92− , { key: "lang", value: "en" }
93− ]
94− n1 <- conn # runNoErr do settingsTable # count
86+ it "bulk upserts a batch" $ withSettingsTable do
87+ _ <- settingsTable # upsertMany
88+ [ { key: "theme", value: "dark" }
89+ , { key: "lang", value: "en" }
90+ ]
91+ n1 <- settingsTable # count
9592 n1 `shouldEqual` 2
96− updated <- conn # run do
97− settingsTable # upsertMany
98− [ { key: "theme", value: "light" }
99− , { key: "lang", value: "de" }
100− , { key: "tz", value: "UTC" }
101− ]
93+ updated <- settingsTable # upsertMany
94+ [ { key: "theme", value: "light" }
95+ , { key: "lang", value: "de" }
96+ , { key: "tz", value: "UTC" }
97+ ]
10298 Array.length updated `shouldEqual` 3
103− n2 <- conn # runNoErr do settingsTable # count
99+ n2 <- settingsTable # count
104100 n2 `shouldEqual` 3
105− found <- conn # run do settingsTable # findOneBy @"key" "theme"
101+ found <- settingsTable # findOneBy @"key" "theme"
106102 setting <- shouldBeJust found
107103 setting.value `shouldEqual` "light"
108104
109105 describe "Finding records" do
110− it "finds a single record by primary key" $ withUsersTable \conn -> do
111− created <- conn # run do usersTable # create { name: "Alice", email: "a@t.com", role: "admin" }
106+ it "finds a single record by primary key" $ withUsersTable do
107+ created <- usersTable # create { name: "Alice", email: "a@t.com", role: "admin" }
112108 alice <- shouldBeJust created
113− found <- conn # run do usersTable # findById alice.id
109+ found <- usersTable # findById alice.id
114110 r <- shouldBeJust found
115111 r.name `shouldEqual` "Alice"
116112
117− it "finds a single record by any unique column" $ withUsersTable \conn -> do
118− _ <- conn # run do usersTable # create { name: "Alice", email: "a@t.com", role: "admin" }
119− found <- conn # run do usersTable # findOneBy @"email" "a@t.com"
113+ it "finds a single record by any unique column" $ withUsersTable do
114+ _ <- usersTable # create { name: "Alice", email: "a@t.com", role: "admin" }
115+ found <- usersTable # findOneBy @"email" "a@t.com"
120116 alice <- shouldBeJust found
121117 alice.name `shouldEqual` "Alice"
122118
123− it "finds all records matching a column value" $ withUsersTable \conn -> do
124− _ <- conn # run do usersTable # create { name: "Alice", email: "a@t.com", role: "admin" }
125− _ <- conn # run do usersTable # create { name: "Bob", email: "b@t.com", role: "admin" }
126− _ <- conn # run do usersTable # create { name: "Carol", email: "c@t.com", role: "user" }
127− admins <- conn # run do usersTable # findBy @"role" "admin"
119+ it "finds all records matching a column value" $ withUsersTable do
120+ _ <- usersTable # create { name: "Alice", email: "a@t.com", role: "admin" }
121+ _ <- usersTable # create { name: "Bob", email: "b@t.com", role: "admin" }
122+ _ <- usersTable # create { name: "Carol", email: "c@t.com", role: "user" }
123+ admins <- usersTable # findBy @"role" "admin"
128124 Array.length admins `shouldEqual` 2
129125
130− it "finds all records matching multiple conditions" $ withUsersTable \conn -> do
131− _ <- conn # run do usersTable # create { name: "Alice", email: "a@t.com", role: "admin" }
132− _ <- conn # run do usersTable # create { name: "Bob", email: "b@t.com", role: "admin" }
133− _ <- conn # run do usersTable # create { name: "Carol", email: "c@t.com", role: "user" }
134− alices <- conn # run do usersTable # findAllWhere { name: "Alice", role: "admin" }
126+ it "finds all records matching multiple conditions" $ withUsersTable do
127+ _ <- usersTable # create { name: "Alice", email: "a@t.com", role: "admin" }
128+ _ <- usersTable # create { name: "Bob", email: "b@t.com", role: "admin" }
129+ _ <- usersTable # create { name: "Carol", email: "c@t.com", role: "user" }
130+ alices <- usersTable # findAllWhere { name: "Alice", role: "admin" }
135131 Array.length alices `shouldEqual` 1
136132 alice <- shouldBeJust (Array.head alices)
137133 alice.email `shouldEqual` "a@t.com"
138134
139− it "returns Nothing when no record matches" $ withUsersTable \conn -> do
140− _ <- conn # run do usersTable # create { name: "Alice", email: "a@t.com", role: "admin" }
141− missing <- conn # run do usersTable # findOneBy @"email" "nobody@t.com"
135+ it "returns Nothing when no record matches" $ withUsersTable do
136+ _ <- usersTable # create { name: "Alice", email: "a@t.com", role: "admin" }
137+ missing <- usersTable # findOneBy @"email" "nobody@t.com"
142138 isNothing missing `shouldEqual` true
143− alsoMissing <- conn # run do usersTable # findOneWhere { name: "Alice", role: "user" }
139+ alsoMissing <- usersTable # findOneWhere { name: "Alice", role: "user" }
144140 isNothing alsoMissing `shouldEqual` true
145141
146− it "finds records by a list of primary keys" $ withUsersTable \conn -> do
147− created1 <- conn # run do usersTable # create { name: "Alice", email: "a@t.com", role: "admin" }
142+ it "finds records by a list of primary keys" $ withUsersTable do
143+ created1 <- usersTable # create { name: "Alice", email: "a@t.com", role: "admin" }
148144 u1 <- shouldBeJust created1
149− created2 <- conn # run do usersTable # create { name: "Bob", email: "b@t.com", role: "user" }
145+ created2 <- usersTable # create { name: "Bob", email: "b@t.com", role: "user" }
150146 u2 <- shouldBeJust created2
151− _ <- conn # run do usersTable # create { name: "Carol", email: "c@t.com", role: "user" }
152− found <- conn # run do usersTable # findByIdIn [ u1.id, u2.id ]
147+ _ <- usersTable # create { name: "Carol", email: "c@t.com", role: "user" }
148+ found <- usersTable # findByIdIn [ u1.id, u2.id ]
153149 Array.length found `shouldEqual` 2
154− empty <- conn # run do usersTable # findByIdIn ([] :: Array Int)
150+ empty <- usersTable # findByIdIn ([] :: Array Int)
155151 Array.length empty `shouldEqual` 0
156152
157− it "returns all records in the table" $ withUsersTable \conn -> do
158− _ <- conn # run do
159− usersTable # createMany
160− [ { name: "Alice", email: "a@t.com", role: "admin" }
161− , { name: "Bob", email: "b@t.com", role: "user" }
162− ]
163− all <- conn # run do usersTable # findAll
153+ it "returns all records in the table" $ withUsersTable do
154+ _ <- usersTable # createMany
155+ [ { name: "Alice", email: "a@t.com", role: "admin" }
156+ , { name: "Bob", email: "b@t.com", role: "user" }
157+ ]
158+ all <- usersTable # findAll
164159 Array.length all `shouldEqual` 2
165160
166161 describe "Filtering with operators" do
167− it "compares with gt, gte, lt, lte" $ withUsersTable \conn -> do
168− _ <- conn # run do
169− usersTable # createMany
170− [ { name: "Alice", email: "a@t.com", role: "admin" }
171− , { name: "Bob", email: "b@t.com", role: "user" }
172− , { name: "Carol", email: "c@t.com", role: "user" }
173− ]
174− all <- conn # run do usersTable # findAll
162+ it "compares with gt, gte, lt, lte" $ withUsersTable do
163+ _ <- usersTable # createMany
164+ [ { name: "Alice", email: "a@t.com", role: "admin" }
165+ , { name: "Bob", email: "b@t.com", role: "user" }
166+ , { name: "Carol", email: "c@t.com", role: "user" }
167+ ]
168+ all <- usersTable # findAll
175169 let
176170 id1 = case Array.head all of
177171 Just u -> u.id
178172 Nothing -> 0
179− gtRows <- conn # run do usersTable # findAllWhere { id: gt id1 }
173+ gtRows <- usersTable # findAllWhere { id: gt id1 }
180174 Array.length gtRows `shouldEqual` 2
181− gteRows <- conn # run do usersTable # findAllWhere { id: gte id1 }
175+ gteRows <- usersTable # findAllWhere { id: gte id1 }
182176 Array.length gteRows `shouldEqual` 3
183− ltRows <- conn # run do usersTable # findAllWhere { id: lt (id1 + 3) }
177+ ltRows <- usersTable # findAllWhere { id: lt (id1 + 3) }
184178 Array.length ltRows `shouldEqual` 3
185− lteRows <- conn # run do usersTable # findAllWhere { id: lte id1 }
179+ lteRows <- usersTable # findAllWhere { id: lte id1 }
186180 Array.length lteRows `shouldEqual` 1
187181
188− it "excludes with ne" $ withUsersTable \conn -> do
189− _ <- conn # run do
190− usersTable # createMany
191− [ { name: "Alice", email: "a@t.com", role: "admin" }
192− , { name: "Bob", email: "b@t.com", role: "user" }
193− , { name: "Carol", email: "c@t.com", role: "user" }
194− ]
195− rows <- conn # run do usersTable # findAllWhere { role: ne "admin" }
182+ it "excludes with ne" $ withUsersTable do
183+ _ <- usersTable # createMany
184+ [ { name: "Alice", email: "a@t.com", role: "admin" }
185+ , { name: "Bob", email: "b@t.com", role: "user" }
186+ , { name: "Carol", email: "c@t.com", role: "user" }
187+ ]
188+ rows <- usersTable # findAllWhere { role: ne "admin" }
196189 Array.length rows `shouldEqual` 2
197190
198− it "pattern-matches with like_ and ilike" $ withUsersTable \conn -> do
199− _ <- conn # run do
200− usersTable # createMany
201− [ { name: "Alice", email: "a@t.com", role: "admin" }
202− , { name: "Bob", email: "b@t.com", role: "user" }
203− , { name: "Carol", email: "c@t.com", role: "user" }
204− ]
205− likeRows <- conn # run do usersTable # findAllWhere { name: like_ "A%" }
191+ it "pattern-matches with like_ and ilike" $ withUsersTable do
192+ _ <- usersTable # createMany
193+ [ { name: "Alice", email: "a@t.com", role: "admin" }
194+ , { name: "Bob", email: "b@t.com", role: "user" }
195+ , { name: "Carol", email: "c@t.com", role: "user" }
196+ ]
197+ likeRows <- usersTable # findAllWhere { name: like_ "A%" }
206198 Array.length likeRows `shouldEqual` 1
207− ilikeRows <- conn # run do usersTable # findAllWhere { name: ilike "a%" }
199+ ilikeRows <- usersTable # findAllWhere { name: ilike "a%" }
208200 Array.length ilikeRows `shouldEqual` 1
209201
210− it "checks membership with inArray" $ withUsersTable \conn -> do
211− _ <- conn # run do
212− usersTable # createMany
213− [ { name: "Alice", email: "a@t.com", role: "admin" }
214− , { name: "Bob", email: "b@t.com", role: "user" }
215− , { name: "Carol", email: "c@t.com", role: "mod" }
216− ]
217− rows <- conn # run do usersTable # findAllWhere { role: inArray [ "admin", "mod" ] }
202+ it "checks membership with inArray" $ withUsersTable do
203+ _ <- usersTable # createMany
204+ [ { name: "Alice", email: "a@t.com", role: "admin" }
205+ , { name: "Bob", email: "b@t.com", role: "user" }
206+ , { name: "Carol", email: "c@t.com", role: "mod" }
207+ ]
208+ rows <- usersTable # findAllWhere { role: inArray [ "admin", "mod" ] }
218209 Array.length rows `shouldEqual` 2
219210
220− it "combines conditions with or_" $ withUsersTable \conn -> do
221− _ <- conn # run do
222− usersTable # createMany
223− [ { name: "Alice", email: "a@t.com", role: "admin" }
224− , { name: "Bob", email: "b@t.com", role: "user" }
225− , { name: "Carol", email: "c@t.com", role: "mod" }
226− ]
227− rows <- conn # run do usersTable # findAllWhere { role: or_ (eq_ "admin") (eq_ "mod") }
211+ it "combines conditions with or_" $ withUsersTable do
212+ _ <- usersTable # createMany
213+ [ { name: "Alice", email: "a@t.com", role: "admin" }
214+ , { name: "Bob", email: "b@t.com", role: "user" }
215+ , { name: "Carol", email: "c@t.com", role: "mod" }
216+ ]
217+ rows <- usersTable # findAllWhere { role: or_ (eq_ "admin") (eq_ "mod") }
228218 Array.length rows `shouldEqual` 2
229219
230− it "negates conditions with not_" $ withUsersTable \conn -> do
231− _ <- conn # run do
232− usersTable # createMany
233− [ { name: "Alice", email: "a@t.com", role: "admin" }
234− , { name: "Bob", email: "b@t.com", role: "user" }
235− , { name: "Carol", email: "c@t.com", role: "user" }
236− ]
237− rows <- conn # run do usersTable # findAllWhere { role: not_ (eq_ "admin") }
220+ it "negates conditions with not_" $ withUsersTable do
221+ _ <- usersTable # createMany
222+ [ { name: "Alice", email: "a@t.com", role: "admin" }
223+ , { name: "Bob", email: "b@t.com", role: "user" }
224+ , { name: "Carol", email: "c@t.com", role: "user" }
225+ ]
226+ rows <- usersTable # findAllWhere { role: not_ (eq_ "admin") }
238227 Array.length rows `shouldEqual` 2
239228
240229 describe "Updating and deleting" do
241− it "updates rows matching a condition" $ withUsersTable \conn -> do
242− _ <- conn # run do
243− usersTable # createMany
244− [ { name: "Alice", email: "a@t.com", role: "admin" }
245− , { name: "Bob", email: "b@t.com", role: "user" }
246− , { name: "Carol", email: "c@t.com", role: "user" }
247− ]
248− updated <- conn # run do usersTable # updateWhere { role: "user" } { role: "member" }
230+ it "updates rows matching a condition" $ withUsersTable do
231+ _ <- usersTable # createMany
232+ [ { name: "Alice", email: "a@t.com", role: "admin" }
233+ , { name: "Bob", email: "b@t.com", role: "user" }
234+ , { name: "Carol", email: "c@t.com", role: "user" }
235+ ]
236+ updated <- usersTable # updateWhere { role: "user" } { role: "member" }
249237 Array.length updated `shouldEqual` 2
250− members <- conn # run do usersTable # findBy @"role" "member"
238+ members <- usersTable # findBy @"role" "member"
251239 Array.length members `shouldEqual` 2
252240
253− it "deletes rows matching a condition" $ withUsersTable \conn -> do
254− _ <- conn # run do
255− usersTable # createMany
256− [ { name: "Alice", email: "a@t.com", role: "admin" }
257− , { name: "Bob", email: "b@t.com", role: "user" }
258− , { name: "Carol", email: "c@t.com", role: "user" }
259− ]
260− deleted <- conn # runNoErr do usersTable # deleteWhere { role: "user" }
241+ it "deletes rows matching a condition" $ withUsersTable do
242+ _ <- usersTable # createMany
243+ [ { name: "Alice", email: "a@t.com", role: "admin" }
244+ , { name: "Bob", email: "b@t.com", role: "user" }
245+ , { name: "Carol", email: "c@t.com", role: "user" }
246+ ]
247+ deleted <- usersTable # deleteWhere { role: "user" }
261248 deleted `shouldEqual` 2
262− remaining <- conn # runNoErr do usersTable # count
249+ remaining <- usersTable # count
263250 remaining `shouldEqual` 1
264251
265− it "deletes and returns the deleted rows" $ withUsersTable \conn -> do
266− _ <- conn # run do
267− usersTable # createMany
268− [ { name: "Alice", email: "a@t.com", role: "admin" }
269− , { name: "Bob", email: "b@t.com", role: "user" }
270− , { name: "Carol", email: "c@t.com", role: "user" }
271− ]
272− deleted <- conn # run do usersTable # deleteWhereReturning { role: "user" }
252+ it "deletes and returns the deleted rows" $ withUsersTable do
253+ _ <- usersTable # createMany
254+ [ { name: "Alice", email: "a@t.com", role: "admin" }
255+ , { name: "Bob", email: "b@t.com", role: "user" }
256+ , { name: "Carol", email: "c@t.com", role: "user" }
257+ ]
258+ deleted <- usersTable # deleteWhereReturning { role: "user" }
273259 Array.length deleted `shouldEqual` 2
274260 Array.sort (map _.name deleted) `shouldEqual` [ "Bob", "Carol" ]
275− remaining <- conn # runNoErr do usersTable # count
261+ remaining <- usersTable # count
276262 remaining `shouldEqual` 1
277263
278− it "deletes everything" $ withUsersTable \conn -> do
279− _ <- conn # run do usersTable # create { name: "Alice", email: "a@t.com", role: "admin" }
280− _ <- conn # run do usersTable # create { name: "Bob", email: "b@t.com", role: "user" }
281− deleted <- conn # runNoErr do usersTable # deleteAll
264+ it "deletes everything" $ withUsersTable do
265+ _ <- usersTable # create { name: "Alice", email: "a@t.com", role: "admin" }
266+ _ <- usersTable # create { name: "Bob", email: "b@t.com", role: "user" }
267+ deleted <- usersTable # deleteAll
282268 deleted `shouldEqual` 2
283− n <- conn # runNoErr do usersTable # count
269+ n <- usersTable # count
284270 n `shouldEqual` 0
285271
286272 describe "Ordering and pagination" do
287− it "orders results by a column" $ withUsersTable \conn -> do
288− _ <- conn # run do
289− usersTable # createMany
290− [ { name: "Carol", email: "c@t.com", role: "user" }
291− , { name: "Alice", email: "a@t.com", role: "admin" }
292− , { name: "Bob", email: "b@t.com", role: "user" }
293− ]
294− asc <- conn # run do usersTable # findOrdered @"name" Asc
273+ it "orders results by a column" $ withUsersTable do
274+ _ <- usersTable # createMany
275+ [ { name: "Carol", email: "c@t.com", role: "user" }
276+ , { name: "Alice", email: "a@t.com", role: "admin" }
277+ , { name: "Bob", email: "b@t.com", role: "user" }
278+ ]
279+ asc <- usersTable # findOrdered @"name" Asc
295280 (map _.name asc) `shouldEqual` [ "Alice", "Bob", "Carol" ]
296− desc <- conn # run do usersTable # findOrdered @"name" Desc
281+ desc <- usersTable # findOrdered @"name" Desc
297282 (map _.name desc) `shouldEqual` [ "Carol", "Bob", "Alice" ]
298283
299− it "filters, orders, and limits in one call" $ withUsersTable \conn -> do
300− _ <- conn # run do
301− usersTable # createMany
302− [ { name: "Alice", email: "a@t.com", role: "user" }
303− , { name: "Bob", email: "b@t.com", role: "user" }
304− , { name: "Carol", email: "c@t.com", role: "user" }
305− , { name: "Dave", email: "d@t.com", role: "user" }
306− ]
307− page1 <- conn # run do usersTable # findWhereLimited @"name" { role: "user" } Asc { limit: 2, offset: 0 }
284+ it "filters, orders, and limits in one call" $ withUsersTable do
285+ _ <- usersTable # createMany
286+ [ { name: "Alice", email: "a@t.com", role: "user" }
287+ , { name: "Bob", email: "b@t.com", role: "user" }
288+ , { name: "Carol", email: "c@t.com", role: "user" }
289+ , { name: "Dave", email: "d@t.com", role: "user" }
290+ ]
291+ page1 <- usersTable # findWhereLimited @"name" { role: "user" } Asc { limit: 2, offset: 0 }
308292 (map _.name page1) `shouldEqual` [ "Alice", "Bob" ]
309− page2 <- conn # run do usersTable # findWhereLimited @"name" { role: "user" } Asc { limit: 2, offset: 2 }
293+ page2 <- usersTable # findWhereLimited @"name" { role: "user" } Asc { limit: 2, offset: 2 }
310294 (map _.name page2) `shouldEqual` [ "Carol", "Dave" ]
311295
312− it "paginates forward with cursors" $ withUsersTable \conn -> do
313− _ <- conn # run do
314− usersTable # createMany
315− [ { name: "Alice", email: "a@t.com", role: "admin" }
316− , { name: "Bob", email: "b@t.com", role: "user" }
317− , { name: "Carol", email: "c@t.com", role: "user" }
318− , { name: "Dave", email: "d@t.com", role: "user" }
319− , { name: "Eve", email: "e@t.com", role: "admin" }
320− ]
321− page1 <- conn # run do usersTable # findFirst @"id" 2
296+ it "paginates forward with cursors" $ withUsersTable do
297+ _ <- usersTable # createMany
298+ [ { name: "Alice", email: "a@t.com", role: "admin" }
299+ , { name: "Bob", email: "b@t.com", role: "user" }
300+ , { name: "Carol", email: "c@t.com", role: "user" }
301+ , { name: "Dave", email: "d@t.com", role: "user" }
302+ , { name: "Eve", email: "e@t.com", role: "admin" }
303+ ]
304+ page1 <- usersTable # findFirst @"id" 2
322305 Array.length page1.items `shouldEqual` 2
323306 page1.hasMore `shouldEqual` true
324307 let
325308 lastId = case Array.last page1.items of
326309 Just u -> u.id
327310 Nothing -> 0
328− page2 <- conn # run do usersTable # findAfter @"id" lastId 2
311+ page2 <- usersTable # findAfter @"id" lastId 2
329312 Array.length page2.items `shouldEqual` 2
330313 page2.hasMore `shouldEqual` true
331314 let
332315 lastId2 = case Array.last page2.items of
333316 Just u -> u.id
334317 Nothing -> 0
335− page3 <- conn # run do usersTable # findAfter @"id" lastId2 2
318+ page3 <- usersTable # findAfter @"id" lastId2 2
336319 Array.length page3.items `shouldEqual` 1
337320 page3.hasMore `shouldEqual` false
338321
339− it "paginates backward with cursors" $ withUsersTable \conn -> do
340− _ <- conn # run do
341− usersTable # createMany
342− [ { name: "Alice", email: "a@t.com", role: "admin" }
343− , { name: "Bob", email: "b@t.com", role: "user" }
344− , { name: "Carol", email: "c@t.com", role: "user" }
345− , { name: "Dave", email: "d@t.com", role: "user" }
346− , { name: "Eve", email: "e@t.com", role: "admin" }
347− ]
348− all <- conn # run do usersTable # findAll
322+ it "paginates backward with cursors" $ withUsersTable do
323+ _ <- usersTable # createMany
324+ [ { name: "Alice", email: "a@t.com", role: "admin" }
325+ , { name: "Bob", email: "b@t.com", role: "user" }
326+ , { name: "Carol", email: "c@t.com", role: "user" }
327+ , { name: "Dave", email: "d@t.com", role: "user" }
328+ , { name: "Eve", email: "e@t.com", role: "admin" }
329+ ]
330+ all <- usersTable # findAll
349331 let
350332 lastUser = case Array.last all of
351333 Just u -> u
352334 Nothing -> { id: 0, name: "", email: "", active: true, role: "" }
353− page <- conn # run do usersTable # findBefore @"id" lastUser.id 2
335+ page <- usersTable # findBefore @"id" lastUser.id 2
354336 Array.length page.items `shouldEqual` 2
355337 page.hasMore `shouldEqual` true
356338
357− it "paginates with a filter applied" $ withUsersTable \conn -> do
358− _ <- conn # run do
359− usersTable # createMany
360− [ { name: "Alice", email: "a@t.com", role: "admin" }
361− , { name: "Bob", email: "b@t.com", role: "user" }
362− , { name: "Carol", email: "c@t.com", role: "user" }
363− , { name: "Dave", email: "d@t.com", role: "user" }
364− , { name: "Eve", email: "e@t.com", role: "admin" }
365− ]
366− page1 <- conn # run do usersTable # findFirstWhere @"id" { role: "user" } 2
339+ it "paginates with a filter applied" $ withUsersTable do
340+ _ <- usersTable # createMany
341+ [ { name: "Alice", email: "a@t.com", role: "admin" }
342+ , { name: "Bob", email: "b@t.com", role: "user" }
343+ , { name: "Carol", email: "c@t.com", role: "user" }
344+ , { name: "Dave", email: "d@t.com", role: "user" }
345+ , { name: "Eve", email: "e@t.com", role: "admin" }
346+ ]
347+ page1 <- usersTable # findFirstWhere @"id" { role: "user" } 2
367348 Array.length page1.items `shouldEqual` 2
368349 page1.hasMore `shouldEqual` true
369350 let
370351 lastId = case Array.last page1.items of
371352 Just u -> u.id
372353 Nothing -> 0
373− page2 <- conn # run do usersTable # findAfterWhere @"id" { role: "user" } lastId 2
354+ page2 <- usersTable # findAfterWhere @"id" { role: "user" } lastId 2
374355 Array.length page2.items `shouldEqual` 1
375356 page2.hasMore `shouldEqual` false
376357
377358 describe "Aggregations and checks" do
378− it "counts rows, optionally with a filter" $ withUsersTable \conn -> do
379− n0 <- conn # runNoErr do usersTable # count
359+ it "counts rows, optionally with a filter" $ withUsersTable do
360+ n0 <- usersTable # count
380361 n0 `shouldEqual` 0
381− _ <- conn # run do
382− usersTable # createMany
383− [ { name: "Alice", email: "a@t.com", role: "admin" }
384− , { name: "Bob", email: "b@t.com", role: "user" }
385− , { name: "Carol", email: "c@t.com", role: "admin" }
386− ]
387− n3 <- conn # runNoErr do usersTable # count
362+ _ <- usersTable # createMany
363+ [ { name: "Alice", email: "a@t.com", role: "admin" }
364+ , { name: "Bob", email: "b@t.com", role: "user" }
365+ , { name: "Carol", email: "c@t.com", role: "admin" }
366+ ]
367+ n3 <- usersTable # count
388368 n3 `shouldEqual` 3
389− nAdmins <- conn # runNoErr do usersTable # countWhere { role: "admin" }
369+ nAdmins <- usersTable # countWhere { role: "admin" }
390370 nAdmins `shouldEqual` 2
391371
392− it "checks whether a record exists" $ withUsersTable \conn -> do
393− created <- conn # run do usersTable # create { name: "Alice", email: "a@t.com", role: "admin" }
372+ it "checks whether a record exists" $ withUsersTable do
373+ created <- usersTable # create { name: "Alice", email: "a@t.com", role: "admin" }
394374 alice <- shouldBeJust created
395− yes <- conn # runNoErr do usersTable # exists alice.id
375+ yes <- usersTable # exists alice.id
396376 yes `shouldEqual` true
397− no <- conn # runNoErr do usersTable # exists 99999
377+ no <- usersTable # exists 99999
398378 no `shouldEqual` false
399− yesWhere <- conn # runNoErr do usersTable # existsWhere { name: "Alice", role: "admin" }
379+ yesWhere <- usersTable # existsWhere { name: "Alice", role: "admin" }
400380 yesWhere `shouldEqual` true
401− noWhere <- conn # runNoErr do usersTable # existsWhere { name: "Alice", role: "user" }
381+ noWhere <- usersTable # existsWhere { name: "Alice", role: "user" }
402382 noWhere `shouldEqual` false
403383
404− it "sums and averages a numeric column" $ withUsersTable \conn -> do
405− _ <- conn # run do
406− usersTable # createMany
407− [ { name: "Alice", email: "a@t.com", role: "admin" }
408− , { name: "Bob", email: "b@t.com", role: "user" }
409− ]
410− total <- conn # runNoErr do usersTable # sumOf @"id"
384+ it "sums and averages a numeric column" $ withUsersTable do
385+ _ <- usersTable # createMany
386+ [ { name: "Alice", email: "a@t.com", role: "admin" }
387+ , { name: "Bob", email: "b@t.com", role: "user" }
388+ ]
389+ total <- usersTable # sumOf @"id"
411390 (total > 0.0) `shouldEqual` true
412− emptySum <- conn # runNoErr do usersTable # sumOfWhere @"id" { role: "nobody" }
391+ emptySum <- usersTable # sumOfWhere @"id" { role: "nobody" }
413392 emptySum `shouldEqual` 0.0
414− avg <- conn # runNoErr do usersTable # avgOf @"id"
393+ avg <- usersTable # avgOf @"id"
415394 isNothing avg `shouldEqual` false
416− emptyAvg <- conn # runNoErr do usersTable # avgOfWhere @"id" { role: "nobody" }
395+ emptyAvg <- usersTable # avgOfWhere @"id" { role: "nobody" }
417396 isNothing emptyAvg `shouldEqual` true
418397
419− it "finds the min and max of a column" $ withUsersTable \conn -> do
420− _ <- conn # run do
421− usersTable # createMany
422− [ { name: "Alice", email: "a@t.com", role: "admin" }
423− , { name: "Bob", email: "b@t.com", role: "user" }
424− , { name: "Carol", email: "c@t.com", role: "user" }
425− ]
426− minName <- conn # run do usersTable # minOf @"name"
398+ it "finds the min and max of a column" $ withUsersTable do
399+ _ <- usersTable # createMany
400+ [ { name: "Alice", email: "a@t.com", role: "admin" }
401+ , { name: "Bob", email: "b@t.com", role: "user" }
402+ , { name: "Carol", email: "c@t.com", role: "user" }
403+ ]
404+ minName <- usersTable # minOf @"name"
427405 minName `shouldEqual` (Just "Alice")
428− maxName <- conn # run do usersTable # maxOf @"name"
406+ maxName <- usersTable # maxOf @"name"
429407 maxName `shouldEqual` (Just "Carol")
430− noMin <- conn # run do usersTable # minOfWhere @"name" { role: "nobody" }
408+ noMin <- usersTable # minOfWhere @"name" { role: "nobody" }
431409 isNothing noMin `shouldEqual` true
432410
433− it "lists distinct values of a column" $ withUsersTable \conn -> do
434− _ <- conn # run do
435− usersTable # createMany
436− [ { name: "Alice", email: "a@t.com", role: "admin" }
437− , { name: "Bob", email: "b@t.com", role: "user" }
438− , { name: "Carol", email: "c@t.com", role: "user" }
439− ]
440− roles <- conn # run do usersTable # findDistinct @"role"
411+ it "lists distinct values of a column" $ withUsersTable do
412+ _ <- usersTable # createMany
413+ [ { name: "Alice", email: "a@t.com", role: "admin" }
414+ , { name: "Bob", email: "b@t.com", role: "user" }
415+ , { name: "Carol", email: "c@t.com", role: "user" }
416+ ]
417+ roles <- usersTable # findDistinct @"role"
441418 Array.sort roles `shouldEqual` [ "admin", "user" ]
442− activeRoles <- conn # run do usersTable # findDistinctWhere @"role" { active: true }
419+ activeRoles <- usersTable # findDistinctWhere @"role" { active: true }
443420 Array.sort activeRoles `shouldEqual` [ "admin", "user" ]
444421
445422 describe "Selecting specific columns" do
446− it "fetches only the columns you need" $ withUsersTable \conn -> do
447− _ <- conn # run do usersTable # create { name: "Alice", email: "a@t.com", role: "admin" }
448− _ <- conn # run do usersTable # create { name: "Bob", email: "b@t.com", role: "user" }
449− _ <- conn # run do usersTable # create { name: "Carol", email: "c@t.com", role: "user" }
450− rows <- conn # run do usersTable # selectFrom @"name, email"
423+ it "fetches only the columns you need" $ withUsersTable do
424+ _ <- usersTable # create { name: "Alice", email: "a@t.com", role: "admin" }
425+ _ <- usersTable # create { name: "Bob", email: "b@t.com", role: "user" }
426+ _ <- usersTable # create { name: "Carol", email: "c@t.com", role: "user" }
427+ rows <- usersTable # selectFrom @"name, email"
451428 Array.length rows `shouldEqual` 3
452429 let
453430 first = case Array.head rows of
@@ -455,31 +432,31 @@ spec = describe "ClientOm" do
455432 Nothing -> { name: "", email: "" }
456433 first.name `shouldEqual` "Alice"
457434 first.email `shouldEqual` "a@t.com"
458− filtered <- conn # run do usersTable # selectFromWhere @"name" { role: "user" }
435+ filtered <- usersTable # selectFromWhere @"name" { role: "user" }
459436 Array.length filtered `shouldEqual` 2
460437 Array.sort (map _.name filtered) `shouldEqual` [ "Bob", "Carol" ]
461438
462− it "fetches one row with specific columns and a filter" $ withUsersTable \conn -> do
463− _ <- conn # run do usersTable # create { name: "Alice", email: "a@t.com", role: "admin" }
464− _ <- conn # run do usersTable # create { name: "Bob", email: "b@t.com", role: "user" }
465− found <- conn # run do usersTable # selectOneFrom @"name, role"
439+ it "fetches one row with specific columns and a filter" $ withUsersTable do
440+ _ <- usersTable # create { name: "Alice", email: "a@t.com", role: "admin" }
441+ _ <- usersTable # create { name: "Bob", email: "b@t.com", role: "user" }
442+ found <- usersTable # selectOneFrom @"name, role"
466443 r <- shouldBeJust found
467444 r.name `shouldEqual` "Alice"
468445 r.role `shouldEqual` "admin"
469− byName <- conn # run do usersTable # selectOneFromWhere @"email" { name: "Bob" }
446+ byName <- usersTable # selectOneFromWhere @"email" { name: "Bob" }
470447 r2 <- shouldBeJust byName
471448 r2.email `shouldEqual` "b@t.com"
472− missing <- conn # run do usersTable # selectOneFromWhere @"email" { name: "Nobody" }
449+ missing <- usersTable # selectOneFromWhere @"email" { name: "Nobody" }
473450 isNothing missing `shouldEqual` true
474451
475452 describe "Relationships" do
476− it "joins a child table to its parent (flat)" $ withPostsTable \conn -> do
477− _ <- conn # run do usersTable # create { name: "Alice", email: "a@t.com", role: "admin" }
478− _ <- conn # run do usersTable # create { name: "Bob", email: "b@t.com", role: "user" }
479− _ <- conn # run do postsTable # create { title: "First Post", body: "Hello", user_id: 1 }
480− _ <- conn # run do postsTable # create { title: "Second Post", body: "World", user_id: 1 }
481− _ <- conn # run do postsTable # create { title: "Bob's Post", body: "Hi", user_id: 2 }
482− rows <- conn # run do findWith postsTable usersTable
453+ it "joins a child table to its parent (flat)" $ withPostsTable do
454+ _ <- usersTable # create { name: "Alice", email: "a@t.com", role: "admin" }
455+ _ <- usersTable # create { name: "Bob", email: "b@t.com", role: "user" }
456+ _ <- postsTable # create { title: "First Post", body: "Hello", user_id: 1 }
457+ _ <- postsTable # create { title: "Second Post", body: "World", user_id: 1 }
458+ _ <- postsTable # create { title: "Bob's Post", body: "Hi", user_id: 2 }
459+ rows <- findWith postsTable usersTable
483460 Array.length rows `shouldEqual` 3
484461 let
485462 r = case Array.head rows of
@@ -488,20 +465,20 @@ spec = describe "ClientOm" do
488465 r.test_om_posts.title `shouldEqual` "First Post"
489466 r.test_om_users.name `shouldEqual` "Alice"
490467
491− it "finds a joined record by primary key" $ withPostsTable \conn -> do
492− _ <- conn # run do usersTable # create { name: "Alice", email: "a@t.com", role: "admin" }
493− _ <- conn # run do postsTable # create { title: "My Post", body: "Content", user_id: 1 }
494− found <- conn # run do findByIdWith 1 postsTable usersTable
468+ it "finds a joined record by primary key" $ withPostsTable do
469+ _ <- usersTable # create { name: "Alice", email: "a@t.com", role: "admin" }
470+ _ <- postsTable # create { title: "My Post", body: "Content", user_id: 1 }
471+ found <- findByIdWith 1 postsTable usersTable
495472 r <- shouldBeJust found
496473 r.test_om_posts.title `shouldEqual` "My Post"
497474 r.test_om_users.name `shouldEqual` "Alice"
498475
499− it "joins with a filter" $ withPostsTable \conn -> do
500− _ <- conn # run do usersTable # create { name: "Alice", email: "a@t.com", role: "admin" }
501− _ <- conn # run do usersTable # create { name: "Bob", email: "b@t.com", role: "user" }
502− _ <- conn # run do postsTable # create { title: "Post A", body: "A", user_id: 1 }
503− _ <- conn # run do postsTable # create { title: "Post B", body: "B", user_id: 2 }
504− rows <- conn # run do findWithWhere { user_id: 1 } postsTable usersTable
476+ it "joins with a filter" $ withPostsTable do
477+ _ <- usersTable # create { name: "Alice", email: "a@t.com", role: "admin" }
478+ _ <- usersTable # create { name: "Bob", email: "b@t.com", role: "user" }
479+ _ <- postsTable # create { title: "Post A", body: "A", user_id: 1 }
480+ _ <- postsTable # create { title: "Post B", body: "B", user_id: 2 }
481+ rows <- findWithWhere { user_id: 1 } postsTable usersTable
505482 Array.length rows `shouldEqual` 1
506483 let
507484 r = case Array.head rows of
@@ -509,12 +486,12 @@ spec = describe "ClientOm" do
509486 Nothing -> { test_om_posts: { id: 0, title: "", body: "", user_id: 0 }, test_om_users: { id: 0, name: "", email: "", active: false, role: "" } }
510487 r.test_om_posts.title `shouldEqual` "Post A"
511488
512− it "nests children under their parent" $ withPostsTable \conn -> do
513− _ <- conn # run do usersTable # create { name: "Alice", email: "a@t.com", role: "admin" }
514− _ <- conn # run do usersTable # create { name: "Bob", email: "b@t.com", role: "user" }
515− _ <- conn # run do postsTable # create { title: "Post 1", body: "A", user_id: 1 }
516− _ <- conn # run do postsTable # create { title: "Post 2", body: "B", user_id: 1 }
517− rows <- conn # run do findIncluding @"posts" usersTable postsTable
489+ it "nests children under their parent" $ withPostsTable do
490+ _ <- usersTable # create { name: "Alice", email: "a@t.com", role: "admin" }
491+ _ <- usersTable # create { name: "Bob", email: "b@t.com", role: "user" }
492+ _ <- postsTable # create { title: "Post 1", body: "A", user_id: 1 }
493+ _ <- postsTable # create { title: "Post 2", body: "B", user_id: 1 }
494+ rows <- findIncluding @"posts" usersTable postsTable
518495 Array.length rows `shouldEqual` 2
519496 let
520497 alice = case Array.head rows of
@@ -523,22 +500,22 @@ spec = describe "ClientOm" do
523500 alice.name `shouldEqual` "Alice"
524501 Array.length alice.posts `shouldEqual` 2
525502
526− it "nests children for a single parent by id" $ withPostsTable \conn -> do
527− _ <- conn # run do usersTable # create { name: "Alice", email: "a@t.com", role: "admin" }
528− _ <- conn # run do postsTable # create { title: "Post 1", body: "A", user_id: 1 }
529− _ <- conn # run do postsTable # create { title: "Post 2", body: "B", user_id: 1 }
530− found <- conn # run do findByIdIncluding @"posts" 1 usersTable postsTable
503+ it "nests children for a single parent by id" $ withPostsTable do
504+ _ <- usersTable # create { name: "Alice", email: "a@t.com", role: "admin" }
505+ _ <- postsTable # create { title: "Post 1", body: "A", user_id: 1 }
506+ _ <- postsTable # create { title: "Post 2", body: "B", user_id: 1 }
507+ found <- findByIdIncluding @"posts" 1 usersTable postsTable
531508 r <- shouldBeJust found
532509 r.name `shouldEqual` "Alice"
533510 Array.length r.posts `shouldEqual` 2
534511
535− it "uses the join combinator to compose tables" $ withPostsTable \conn -> do
536− _ <- conn # run do usersTable # create { name: "Alice", email: "a@t.com", role: "admin" }
537− _ <- conn # run do usersTable # create { name: "Bob", email: "b@t.com", role: "user" }
538− _ <- conn # run do postsTable # create { title: "Post 1", body: "A", user_id: 1 }
539− _ <- conn # run do postsTable # create { title: "Post 2", body: "B", user_id: 1 }
540− _ <- conn # run do postsTable # create { title: "Post 3", body: "C", user_id: 2 }
541− rows <- conn # run do (usersTable # join postsTable) # findAll
512+ it "uses the join combinator to compose tables" $ withPostsTable do
513+ _ <- usersTable # create { name: "Alice", email: "a@t.com", role: "admin" }
514+ _ <- usersTable # create { name: "Bob", email: "b@t.com", role: "user" }
515+ _ <- postsTable # create { title: "Post 1", body: "A", user_id: 1 }
516+ _ <- postsTable # create { title: "Post 2", body: "B", user_id: 1 }
517+ _ <- postsTable # create { title: "Post 3", body: "C", user_id: 2 }
518+ rows <- (usersTable # join postsTable) # findAll
542519 Array.length rows `shouldEqual` 2
543520 let
544521 alice = case Array.head rows of
@@ -547,12 +524,12 @@ spec = describe "ClientOm" do
547524 alice.name `shouldEqual` "Alice"
548525 Array.length alice.test_om_posts `shouldEqual` 2
549526
550− it "joins multiple child tables at once" $ withPostsAndCommentsTable \conn -> do
551− _ <- conn # run do usersTable # create { name: "Alice", email: "a@t.com", role: "admin" }
552− _ <- conn # run do postsTable # create { title: "Post 1", body: "A", user_id: 1 }
553− _ <- conn # run do postsTable # create { title: "Post 2", body: "B", user_id: 1 }
554− _ <- conn # run do commentsTable # create { text: "Nice!", user_id: 1 }
555− rows <- conn # run do (usersTable # join postsTable # join commentsTable) # findAll
527+ it "joins multiple child tables at once" $ withPostsAndCommentsTable do
528+ _ <- usersTable # create { name: "Alice", email: "a@t.com", role: "admin" }
529+ _ <- postsTable # create { title: "Post 1", body: "A", user_id: 1 }
530+ _ <- postsTable # create { title: "Post 2", body: "B", user_id: 1 }
531+ _ <- commentsTable # create { text: "Nice!", user_id: 1 }
532+ rows <- (usersTable # join postsTable # join commentsTable) # findAll
556533 Array.length rows `shouldEqual` 1
557534 let
558535 r = case Array.head rows of
@@ -563,29 +540,28 @@ spec = describe "ClientOm" do
563540 Array.length r.test_om_comments `shouldEqual` 1
564541
565542 describe "Transactions" do
566− it "commits multiple inserts atomically" $ withUsersTable \conn -> do
567− conn # run do
568− withTransaction do
569− _ <- usersTable # create { name: "Alice", email: "a@t.com", role: "admin" }
570− _ <- usersTable # create { name: "Bob", email: "b@t.com", role: "user" }
571− pure unit
572− n <- conn # runNoErr do usersTable # count
543+ it "commits multiple inserts atomically" $ withUsersTable do
544+ transactionally do
545+ _ <- usersTable # create { name: "Alice", email: "a@t.com", role: "admin" }
546+ _ <- usersTable # create { name: "Bob", email: "b@t.com", role: "user" }
547+ pure unit
548+ n <- usersTable # count
573549 n `shouldEqual` 2
574550
575551 describe "UUIDs and newtypes" do
576− it "round-trips a UUID primary key through create/find/exists" $ withUuidTable \conn -> do
577− created <- conn # run do uuidTable # create { label: "first" }
552+ it "round-trips a UUID primary key through create/find/exists" $ withUuidTable do
553+ created <- uuidTable # create { label: "first" }
578554 row <- shouldBeJust created
579555 row.label `shouldEqual` "first"
580− found <- conn # run do uuidTable # findById row.id
556+ found <- uuidTable # findById row.id
581557 r2 <- shouldBeJust found
582558 r2.label `shouldEqual` "first"
583− byCol <- conn # run do uuidTable # findBy @"label" "first"
559+ byCol <- uuidTable # findBy @"label" "first"
584560 Array.length byCol `shouldEqual` 1
585− byId <- conn # run do uuidTable # findOneBy @"id" row.id
561+ byId <- uuidTable # findOneBy @"id" row.id
586562 r3 <- shouldBeJust byId
587563 r3.label `shouldEqual` "first"
588− yes <- conn # runNoErr do uuidTable # exists row.id
564+ yes <- uuidTable # exists row.id
589565 yes `shouldEqual` true
590566
591567-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
@@ -612,7 +588,7 @@ settingsTable :: Proxy SettingsTable
612588settingsTable = Proxy
613589
614590type UuidTable = Table "test_om_uuid_things"
615− ( id :: PGUUID # PrimaryKey # DefaultExpr "gen_random_uuid()"
591+ ( id :: PGUUID # PrimaryKey # Default "gen_random_uuid()"
616592 , label :: String
617593 )
618594
@@ -642,6 +618,15 @@ commentsTable = Proxy
642618-- Helpers
643619-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
644620
621+type TestOm = Om.Om { postgresConnection :: PG.Connection } (parseError :: MultipleErrors) Unit
622+
623+shouldEqual :: forall m t. MonadEffect m => Show t => Eq t => t -> t -> m Unit
624+shouldEqual v1 v2 = when (v1 /= v2) $ liftEffect $ Exception.throwException $ Exception.error $ show v1 <> " ≠ " <> show v2
625+
626+shouldBeJust :: forall m a. MonadEffect m => Maybe a -> m a
627+shouldBeJust (Just a) = pure a
628+shouldBeJust Nothing = liftEffect $ Exception.throwException $ Exception.error "Expected Just but got Nothing"
629+
645630testConnection :: Aff PG.Connection
646631testConnection =
647632 PG.postgres
@@ -652,31 +637,25 @@ testConnection =
652637 , password: PG.PostgresPassword "postgres"
653638 } # liftEffect
654639
655−run
656− :: forall a
657− . Om.Om { postgresConnection :: PG.Connection } (parseError :: MultipleErrors) a
658− -> PG.Connection
659− -> Aff a
660−run om conn = Om.runOm { postgresConnection: conn }
661− { exception: \e -> throwError e
662− , parseError: \errs -> throwError (error ("Parse error: " <> show errs))
663− }
664− om
665−
666−runNoErr
667− :: forall a
668− . Om.Om { postgresConnection :: PG.Connection } () a
669− -> PG.Connection
670− -> Aff a
671−runNoErr om conn = Om.runOm { postgresConnection: conn }
672− { exception: \e -> throwError e }
673− om
674−
675−withUsersTable :: (PG.Connection -> Aff Unit) -> Aff Unit
640+runOm :: TestOm -> Aff Unit
641+runOm om = do
642+ conn <- testConnection
643+ Om.runOm { postgresConnection: conn }
644+ { exception: \e -> throwError e
645+ , parseError: \errs -> throwError (Exception.error ("Parse error: " <> show errs))
646+ }
647+ om
648+ PG.end conn
649+
650+withUsersTable :: TestOm -> Aff Unit
676651withUsersTable test = do
677652 conn <- testConnection
678653 _ <- PG.executeSimple createDDL conn
679− test conn
654+ Om.runOm { postgresConnection: conn }
655+ { exception: \e -> throwError e
656+ , parseError: \errs -> throwError (Exception.error ("Parse error: " <> show errs))
657+ }
658+ test
680659 _ <- PG.executeSimple dropDDL conn
681660 PG.end conn
682661 where
@@ -691,11 +670,15 @@ withUsersTable test = do
691670 role TEXT NOT NULL
692671 )"""
693672
694−withSettingsTable :: (PG.Connection -> Aff Unit) -> Aff Unit
673+withSettingsTable :: TestOm -> Aff Unit
695674withSettingsTable test = do
696675 conn <- testConnection
697676 _ <- PG.executeSimple createDDL conn
698− test conn
677+ Om.runOm { postgresConnection: conn }
678+ { exception: \e -> throwError e
679+ , parseError: \errs -> throwError (Exception.error ("Parse error: " <> show errs))
680+ }
681+ test
699682 _ <- PG.executeSimple dropDDL conn
700683 PG.end conn
701684 where
@@ -707,11 +690,15 @@ withSettingsTable test = do
707690 value TEXT NOT NULL
708691 )"""
709692
710−withUuidTable :: (PG.Connection -> Aff Unit) -> Aff Unit
693+withUuidTable :: TestOm -> Aff Unit
711694withUuidTable test = do
712695 conn <- testConnection
713696 _ <- PG.executeSimple createDDL conn
714− test conn
697+ Om.runOm { postgresConnection: conn }
698+ { exception: \e -> throwError e
699+ , parseError: \errs -> throwError (Exception.error ("Parse error: " <> show errs))
700+ }
701+ test
715702 _ <- PG.executeSimple dropDDL conn
716703 PG.end conn
717704 where
@@ -723,11 +710,15 @@ withUuidTable test = do
723710 label TEXT NOT NULL
724711 )"""
725712
726−withPostsTable :: (PG.Connection -> Aff Unit) -> Aff Unit
713+withPostsTable :: TestOm -> Aff Unit
727714withPostsTable test = do
728715 conn <- testConnection
729716 _ <- PG.executeSimple createDDL conn
730− test conn
717+ Om.runOm { postgresConnection: conn }
718+ { exception: \e -> throwError e
719+ , parseError: \errs -> throwError (Exception.error ("Parse error: " <> show errs))
720+ }
721+ test
731722 _ <- PG.executeSimple (PG.SQL "DROP TABLE IF EXISTS test_om_posts CASCADE") conn
732723 _ <- PG.executeSimple (PG.SQL "DROP TABLE IF EXISTS test_om_users CASCADE") conn
733724 PG.end conn
@@ -749,11 +740,15 @@ withPostsTable test = do
749740 user_id INTEGER NOT NULL REFERENCES test_om_users(id)
750741 )"""
751742
752−withPostsAndCommentsTable :: (PG.Connection -> Aff Unit) -> Aff Unit
743+withPostsAndCommentsTable :: TestOm -> Aff Unit
753744withPostsAndCommentsTable test = do
754745 conn <- testConnection
755746 _ <- PG.executeSimple createDDL conn
756− test conn
747+ Om.runOm { postgresConnection: conn }
748+ { exception: \e -> throwError e
749+ , parseError: \errs -> throwError (Exception.error ("Parse error: " <> show errs))
750+ }
751+ test
757752 _ <- PG.executeSimple (PG.SQL "DROP TABLE IF EXISTS test_om_comments CASCADE") conn
758753 _ <- PG.executeSimple (PG.SQL "DROP TABLE IF EXISTS test_om_posts CASCADE") conn
759754 _ <- PG.executeSimple (PG.SQL "DROP TABLE IF EXISTS test_om_users CASCADE") conn
@@ -781,7 +776,3 @@ withPostsAndCommentsTable test = do
781776 text TEXT NOT NULL,
782777 user_id INTEGER NOT NULL REFERENCES test_om_users(id)
783778 )"""
784−
785−shouldBeJust :: forall a. Maybe a -> Aff a
786−shouldBeJust (Just a) = pure a
787−shouldBeJust Nothing = throwError $ error "Expected Just but got Nothing"
test/Test/SchemaQ.purs+578−93
@@ -2,105 +2,564 @@ module Test.SchemaQ where
22
33import Prelude
44
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)
68import Data.Array as Array
79import Data.Maybe (Maybe(..))
8−import Effect.Aff (Aff)
9−import Effect.Class (liftEffect)
10−import Effect.Exception (error)
11−import Foreign (MultipleErrors)
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
16+import Effect.Class (class MonadEffect, liftEffect)
17+import Effect.Exception as Exception
18+import Effect.Ref as Ref
19+import Foreign (ForeignError(..), MultipleErrors)
1220import Test.Spec (Spec, describe, it)
13−import Test.Spec.Assertions (shouldEqual)
1421import Type.Proxy (Proxy(..))
22+import Yoga.JSON (class ReadForeign, class WriteForeign, readImpl, writeImpl)
1523import Yoga.Om as Om
1624import Yoga.Postgres as PG
17−import Yoga.Postgres.ClientOm (run, runOne, create) as Q
18−import Yoga.Postgres.Schema (Table, PrimaryKey, AutoIncrement, Unique, Default, from, select, where_, orderBy, limit, groupBy, insert, delete, returning, returningAll, union)
25+import Yoga.Postgres.ClientOm (create, exec, run, runOne, transactionally)
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_)
1927
2028spec :: Spec Unit
2129spec = describe "Query builder" do
2230
23− it "selects columns with a WHERE clause" $ withUsersTable \conn -> do
24− _ <- conn # exec do usersTable # Q.create { name: "Alice", email: "a@t.com", role: "admin" }
25− _ <- conn # exec do usersTable # Q.create { name: "Bob", email: "b@t.com", role: "user" }
26− rows <- conn # exec do Q.run { role: "admin" } (from usersTable # select @"name, email" # where_ @"role = $role")
27− Array.length rows `shouldEqual` 1
28− let
29− r = case Array.head rows of
30− Just x -> x
31− Nothing -> { name: "", email: "" }
32− r.name `shouldEqual` "Alice"
31+ -- ── SELECT ──────────────────────────────────────────────────
32+
33+ it "selects columns with a WHERE clause" $ withUsersTable do
34+ _ <- into usersTable # insert { name: "Alice", email: Email "a@t.com", role: Admin } # exec {}
35+ _ <- into usersTable # insert { name: "Bob", email: Email "b@t.com", role: User } # exec {}
36+ rows <- from usersTable
37+ # select @"name, email"
38+ # where_ @"role = $role"
39+ # run { role: Admin }
40+ rows `shouldEqual` [ { name: "Alice", email: Email "a@t.com" } ]
41+
42+ it "orders and limits results" $ withUsersTable do
43+ _ <- into usersTable # insert { name: "Alice", email: Email "a@t.com", role: Admin } # exec {}
44+ _ <- into usersTable # insert { name: "Bob", email: Email "b@t.com", role: User } # exec {}
45+ _ <- into usersTable # insert { name: "Carol", email: Email "c@t.com", role: User } # exec {}
46+ rows <- from usersTable # select @"name" # orderBy @"name" # limit @"2" # run {}
47+ rows `shouldEqual` [ { name: "Alice" }, { name: "Bob" } ]
48+
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 {}
54+ rows `shouldEqual` [ { name: "Bob" }, { name: "Carol" } ]
55+
56+ it "groups results" $ withUsersTable do
57+ _ <- into usersTable # insert { name: "Alice", email: Email "a@t.com", role: Admin } # exec {}
58+ _ <- into usersTable # insert { name: "Bob", email: Email "b@t.com", role: User } # exec {}
59+ _ <- into usersTable # insert { name: "Carol", email: Email "c@t.com", role: User } # exec {}
60+ rows <- from usersTable # select @"role" # groupBy @"role" # orderBy @"role" # run {}
61+ rows `shouldEqual` [ { role: Admin }, { role: User } ]
62+
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"
69+ # groupBy @"role"
70+ # having @"COUNT(*) > $min"
71+ # orderBy @"role"
72+ # run { min: 1 }
73+ rows `shouldEqual` [ { role: User, count: BigInt.fromInt 2 } ]
74+
75+ it "filters with a BETWEEN range" $ withUsersTable do
76+ _ <- into usersTable # insert { name: "Alice", email: Email "a@t.com", role: Admin } # exec {}
77+ _ <- into usersTable # insert { name: "Bob", email: Email "b@t.com", role: User } # exec {}
78+ _ <- into usersTable # insert { name: "Carol", email: Email "c@t.com", role: Mod } # exec {}
79+ rows <- from usersTable # select @"name" # where_ @"id BETWEEN $lo AND $hi" # orderBy @"id" # run { lo: 2, hi: 3 }
80+ rows `shouldEqual` [ { name: "Bob" }, { name: "Carol" } ]
3381
34− it "orders and limits results" $ withUsersTable \conn -> do
35− _ <- conn # exec do usersTable # Q.create { name: "Alice", email: "a@t.com", role: "admin" }
36− _ <- conn # exec do usersTable # Q.create { name: "Bob", email: "b@t.com", role: "user" }
37− _ <- conn # exec do usersTable # Q.create { name: "Carol", email: "c@t.com", role: "user" }
38− rows <- conn # exec do Q.run {} (from usersTable # select @"name" # orderBy @"name" # limit @"2")
39− Array.length rows `shouldEqual` 2
40− (map _.name rows) `shouldEqual` [ "Alice", "Bob" ]
41−
42− it "groups results" $ withUsersTable \conn -> do
43− _ <- conn # exec do usersTable # Q.create { name: "Alice", email: "a@t.com", role: "admin" }
44− _ <- conn # exec do usersTable # Q.create { name: "Bob", email: "b@t.com", role: "user" }
45− _ <- conn # exec do usersTable # Q.create { name: "Carol", email: "c@t.com", role: "user" }
46− rows <- conn # exec do Q.run {} (from usersTable # select @"role" # groupBy @"role" # orderBy @"role")
47− (map _.role rows) `shouldEqual` [ "admin", "user" ]
48−
49− it "filters with a BETWEEN range" $ withUsersTable \conn -> do
50− _ <- conn # exec do usersTable # Q.create { name: "Alice", email: "a@t.com", role: "admin" }
51− _ <- conn # exec do usersTable # Q.create { name: "Bob", email: "b@t.com", role: "user" }
52− _ <- conn # exec do usersTable # Q.create { name: "Carol", email: "c@t.com", role: "mod" }
53− rows <- conn # exec do Q.run { lo: 2, hi: 3 } (from usersTable # select @"name" # where_ @"id BETWEEN $lo AND $hi" # orderBy @"id")
54− (map _.name rows) `shouldEqual` [ "Bob", "Carol" ]
55−
56− it "inserts a row and returns specific columns" $ withUsersTable \conn -> do
57− row <- conn # exec do Q.runOne {} (from usersTable # insert { name: "Alice", email: "a@t.com", role: "admin" } # returning @"id, name")
82+ -- ── INSERT ──────────────────────────────────────────────────
83+
84+ it "inserts a row and returns specific columns" $ withUsersTable do
85+ rows <- into usersTable # insert { name: "Alice", email: Email "a@t.com", role: Admin } # returning @"name" # run {}
86+ rows `shouldEqual` [ { name: "Alice" } ]
87+
88+ it "inserts a row with default created_at and updated_at" $ withUsersTable do
89+ row <- into usersTable # insert { name: "Alice", email: Email "a@t.com", role: Admin } # returning @"created_at, updated_at" # runOne {}
90+ r <- shouldBeJust row
91+ r.created_at `shouldEqual` r.updated_at
92+
93+ it "returns all columns with returningAll" $ withUsersTable do
94+ rows <- into usersTable # insert { name: "Alice", email: Email "a@t.com", role: Admin } # returningAll # run {}
95+ let row = Array.head rows
5896 r <- shouldBeJust row
5997 r.name `shouldEqual` "Alice"
60− (r.id > 0) `shouldEqual` true
61−
62− it "deletes with a condition and returns the deleted rows" $ withUsersTable \conn -> do
63− _ <- conn # exec do usersTable # Q.create { name: "Alice", email: "a@t.com", role: "admin" }
64− _ <- conn # exec do usersTable # Q.create { name: "Bob", email: "b@t.com", role: "user" }
65− rows <- conn # exec do Q.run { role: "admin" } (from usersTable # delete # where_ @"role = $role" # returningAll)
66− Array.length rows `shouldEqual` 1
67− let
68− r = case Array.head rows of
69− Just x -> x
70− Nothing -> { id: 0, name: "", email: "", active: false, role: "" }
71− r.name `shouldEqual` "Alice"
98+ r.email `shouldEqual` Email "a@t.com"
99+ r.role `shouldEqual` Admin
100+
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" } ]
106+
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"
111+ # exec {}
112+ rows <- from usersTable # select @"name" # run {}
113+ rows `shouldEqual` [ { name: "Alice2" } ]
114+
115+ describe "transactionally" do
116+ it "runs ordinary schema operations against the transaction and commits" $ withUsersTable do
117+ transactionally do
118+ into usersTable
119+ # insert { name: "Alice", email: Email "a@t.com", role: Admin }
120+ # exec {}
121+
122+ rows <- from usersTable # select @"name" # run {}
123+ rows `shouldEqual` [ { name: "Alice" } ]
124+
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 }
129+ # exec {}
130+ from usersTable
131+ # select @"name, role"
132+ # where_ @"email = $email"
133+ # run { email: Email "a@t.com" }
134+
135+ rows `shouldEqual` [ { name: "Alice", role: Admin } ]
136+
137+ it "shares one transaction across ClientOm and schema operations" $ withUsersTable do
138+ rows <- transactionally do
139+ _ <- usersTable
140+ # create { name: "Alice", email: Email "a@t.com", role: Admin }
141+ from usersTable
142+ # select @"name, role"
143+ # where_ @"email = $email"
144+ # run { email: Email "a@t.com" }
145+
146+ rows `shouldEqual` [ { name: "Alice", role: Admin } ]
147+
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 }
152+ # exec {}
153+ pure { status: "created", count: 1 }
154+
155+ result `shouldEqual` { status: "created", count: 1 }
156+ rows <- from usersTable # select @"name" # run {}
157+ rows `shouldEqual` [ { name: "Alice" } ]
158+
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 }
163+ # exec {}
164+ Om.fatal "abort transaction"
165+
166+ isLeft result `shouldEqual` true
167+ rows <- from usersTable # select @"name" # run {}
168+ rows `shouldEqual` []
169+
170+ it "rolls back writes made by composed helpers" $ withUsersTable do
171+ let
172+ createUser name email role =
173+ into usersTable
174+ # insert { name, email, role }
175+ # exec {}
176+ rejectBatch = Om.fatal "inventory unavailable"
177+
178+ result <- try $ transactionally do
179+ createUser "Alice" (Email "a@t.com") Admin
180+ createUser "Bob" (Email "b@t.com") User
181+ rejectBatch
72182
73− it "combines two queries with UNION" $ withUsersTable \conn -> do
74− _ <- conn # exec do usersTable # Q.create { name: "Alice", email: "a@t.com", role: "admin" }
75− _ <- conn # exec do usersTable # Q.create { name: "Bob", email: "b@t.com", role: "user" }
76− _ <- conn # exec do usersTable # Q.create { name: "Carol", email: "c@t.com", role: "mod" }
77− rows <- conn # exec do
78− Q.run { a: "admin", b: "mod" }
79− ( (from usersTable # select @"name" # where_ @"role = $a")
80− `union`
81− (from usersTable # select @"name" # where_ @"role = $b")
183+ isLeft result `shouldEqual` true
184+ rows <- from usersTable # select @"name" # run {}
185+ rows `shouldEqual` []
186+
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 }
192+ # exec {}
193+ liftEffect $ Ref.write true wrote
194+ liftAff $ delay (Milliseconds 10000.0)
195+
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
201+
202+ rows <- from usersTable # select @"name" # run {}
203+ rows `shouldEqual` []
204+
205+ it "reuses a one-connection pool after commit and rollback" $ withSingleConnectionUsersTable do
206+ transactionally do
207+ _ <- into usersTable
208+ # insert { name: "Alice", email: Email "a@t.com", role: Admin }
209+ # exec {}
210+ pure unit
211+
212+ failed <- try $ transactionally do
213+ _ <- into usersTable
214+ # insert { name: "Bob", email: Email "b@t.com", role: User }
215+ # exec {}
216+ Om.fatal "roll back Bob"
217+ isLeft failed `shouldEqual` true
218+
219+ transactionally do
220+ _ <- into usersTable
221+ # insert { name: "Carol", email: Email "c@t.com", role: User }
222+ # exec {}
223+ pure unit
224+
225+ rows <- from usersTable # select @"name" # orderBy @"name" # run {}
226+ rows `shouldEqual` [ { name: "Alice" }, { name: "Carol" } ]
227+
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
233+ let
234+ isolatedInsert name email role = transactionally do
235+ _ <- into usersTable
236+ # insert { name, email, role }
237+ # exec {}
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)
244+
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
249+
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
256+
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 ]
262+ _, _ ->
263+ liftEffect $ Exception.throwException $ Exception.error "concurrent transaction failed"
264+
265+ rows <- from usersTable # select @"name" # orderBy @"name" # run {}
266+ rows `shouldEqual` [ { name: "Alice" }, { name: "Bob" } ]
267+
268+ it "rejects nested transactions and rolls back the outer transaction" $ withUsersTable do
269+ failure <- transactionally
270+ (do
271+ _ <- into usersTable
272+ # insert { name: "Alice", email: Email "a@t.com", role: Admin }
273+ # exec {}
274+ transactionally do
275+ _ <- into usersTable
276+ # insert { name: "Bob", email: Email "b@t.com", role: User }
277+ # exec {}
278+ pure "nested transaction unexpectedly succeeded"
279+ )
280+ # Om.handleErrors
281+ { exception: \cause -> pure (Exception.message cause)
282+ , parseError: \_ -> pure "unexpected parse error"
283+ }
284+
285+ failure `shouldEqual` "Yoga.Postgres does not support nested transactions"
286+ rows <- from usersTable # select @"name" # run {}
287+ rows `shouldEqual` []
288+
289+ it "routes begin failures through the exception channel without running the action" do
290+ conn <- testConnection
291+ PG.end conn
292+ ran <- liftEffect $ Ref.new false
293+ result <- try $ Om.runOm { postgresConnection: conn }
294+ { exception: throwError }
295+ (transactionally do
296+ liftEffect $ Ref.write true ran
82297 )
83− Array.sort (map _.name rows) `shouldEqual` [ "Alice", "Carol" ]
298+
299+ isLeft result `shouldEqual` true
300+ liftEffect (Ref.read ran) >>= (_ `shouldEqual` false)
301+
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 })
306+ # Om.handleErrors
307+ { insufficientFunds: pure
308+ }
309+ actual `shouldEqual` expected
310+
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 }
315+ # exec {}
316+ { postgresConnection } <- Om.ask
317+ _ <- PG.executeSimple
318+ (PG.SQL "INSERT INTO missing_transaction_table VALUES (1)")
319+ postgresConnection
320+ # liftAff
321+ pure unit
322+
323+ isLeft result `shouldEqual` true
324+ rows <- from usersTable # select @"name" # run {}
325+ rows `shouldEqual` []
326+
327+ -- ── DELETE ──────────────────────────────────────────────────
328+
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" } ]
334+
335+ -- ── UPDATE ──────────────────────────────────────────────────
336+
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 } ]
343+
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 } ]
349+
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
353+ # set { role: Mod }
354+ # where_ @"email = $email"
355+ # returning @"name, role"
356+ # run { email: Email "a@t.com" }
357+ rows `shouldEqual` [ { name: "Alice", role: Mod } ]
358+
359+ -- ── SET OPERATIONS ──────────────────────────────────────────
360+
361+ it "combines two queries with UNION" $ withUsersTable do
362+ _ <- into usersTable # insert { name: "Alice", email: Email "a@t.com", role: Admin } # exec {}
363+ _ <- into usersTable # insert { name: "Bob", email: Email "b@t.com", role: User } # exec {}
364+ _ <- into usersTable # insert { name: "Carol", email: Email "c@t.com", role: Mod } # exec {}
365+ rows <- from usersTable # select @"name" # where_ @"role = $a"
366+ # union (from usersTable # select @"name" # where_ @"role = $b")
367+ # run { a: Admin, b: Mod }
368+ Array.sort rows `shouldEqual` [ { name: "Alice" }, { name: "Carol" } ]
369+
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" } ]
377+
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" } ]
385+
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")
392+ # run { r: User }
393+ Array.sort rows `shouldEqual` [ { name: "Alice" }, { name: "Carol" } ]
394+
395+ -- ── JOINs ───────────────────────────────────────────────────
396+
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"
404+ # run {}
405+ rows `shouldEqual` [ { name: "Alice", title: "Hello" } ]
406+
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"
415+ # run {}
416+ rows `shouldEqual` [ { name: "Alice" } ]
417+
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"
427+ # run {}
428+ rows `shouldEqual`
429+ [ { name: "Alice", title: Just "Hello" }
430+ , { name: "Bob", title: Nothing }
431+ ]
432+
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"
440+ # run {}
441+ rows `shouldEqual` [ { name: "Alice", title: "Hello" } ]
442+
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"
448+ # run {}
449+ rows `shouldEqual` [ { name: "Alice", title: Nothing } ]
450+
451+ -- ── CTEs ────────────────────────────────────────────────────
452+
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"
457+ rows <- with_ ctes
458+ (fromCTE @"active_users" ctes # select @"active_users.name")
459+ # run { role: Admin }
460+ rows `shouldEqual` [ { name: "Alice" } ]
461+
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"
466+ rows <- with_ ctes
467+ (fromCTE @"admins" ctes # select @"admins.name" # where_ @"admins.name = $name")
468+ # run { role: Admin, name: "Alice" }
469+ rows `shouldEqual` [ { name: "Alice" } ]
470+
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
477+ rows <- with_ ctes
478+ (fromCTE @"admins" ctes # select @"admins.name")
479+ # run { role: Admin }
480+ rows `shouldEqual` [ { name: "Alice" } ]
84481
85482-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
86483-- Test schema
87484-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
88485
486+newtype Email = Email String
487+
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
494+
495+data Role = Admin | User | Mod
496+
497+derive instance Eq Role
498+derive instance Ord Role
499+
500+instance Show Role where
501+ show = roleToString
502+
503+instance WriteForeign Role where
504+ writeImpl = roleToString >>> writeImpl
505+
506+instance ReadForeign Role where
507+ readImpl f = do
508+ s :: String <- readImpl f
509+ case s of
510+ "admin" -> pure Admin
511+ "user" -> pure User
512+ "mod" -> pure Mod
513+ _ -> Except.throwError $ pure $ ForeignError $ "Unknown role: " <> s
514+
515+roleToString :: Role -> String
516+roleToString = case _ of
517+ Admin -> "admin"
518+ User -> "user"
519+ Mod -> "mod"
520+
521+instance PGTypeName Email where
522+ pgTypeName _ = "TEXT"
523+
524+instance PGTypeName Role where
525+ pgTypeName _ = "TEXT"
526+
89527type UsersTable = Table "test_om_users"
90528 ( id :: PrimaryKey (AutoIncrement Int)
91529 , name :: String
92− , email :: Unique String
530+ , email :: Unique Email
93531 , active :: Default "true" Boolean
94− , role :: String
532+ , role :: Role
533+ , created_at :: Default "now()" TimestampTZ
534+ , updated_at :: Default "now()" TimestampTZ
95535 )
96536
97537usersTable :: Proxy UsersTable
98538usersTable = Proxy
99539
540+type PostsTable = Table "test_om_posts"
541+ ( id :: PrimaryKey (AutoIncrement Int)
542+ , user_id :: ForeignKey "test_om_users" References "id" Int
543+ , title :: String
544+ )
545+
546+postsTable :: Proxy PostsTable
547+postsTable = Proxy
548+
100549-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
101550-- Helpers
102551-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
103552
553+type TestOm = Om.Om { postgresConnection :: PG.Connection } (parseError :: MultipleErrors) Unit
554+
555+shouldEqual :: forall m t. MonadEffect m => Show t => Eq t => t -> t -> m Unit
556+shouldEqual v1 v2 = liftEffect $ when (v1 /= v2) do
557+ Exception.throwException $ Exception.error $ show v1 <> " ≠ " <> show v2
558+
559+shouldBeJust :: forall m a. MonadEffect m => Maybe a -> m a
560+shouldBeJust (Just a) = pure a
561+shouldBeJust Nothing = liftEffect $ Exception.throwException $ Exception.error "Expected Just but got Nothing"
562+
104563testConnection :: Aff PG.Connection
105564testConnection =
106565 PG.postgres
@@ -111,36 +570,62 @@ testConnection =
111570 , password: PG.PostgresPassword "postgres"
112571 } # liftEffect
113572
114−exec
115− :: forall a
116− . Om.Om { postgresConnection :: PG.Connection } (parseError :: MultipleErrors) a
117− -> PG.Connection
118− -> Aff a
119−exec om conn = Om.runOm { postgresConnection: conn }
120− { exception: \e -> throwError e
121− , parseError: \errs -> throwError (error ("Parse error: " <> show errs))
122− }
123− om
124−
125−shouldBeJust :: forall a. Maybe a -> Aff a
126−shouldBeJust (Just a) = pure a
127−shouldBeJust Nothing = throwError $ error "Expected Just but got Nothing"
128−
129−withUsersTable :: (PG.Connection -> Aff Unit) -> Aff Unit
573+withUsersTable :: TestOm -> Aff Unit
130574withUsersTable test = do
131575 conn <- testConnection
132576 _ <- PG.executeSimple createDDL conn
133− test conn
577+ Om.runOm { postgresConnection: conn }
578+ { exception: throwError
579+ , parseError: \errs -> throwError (Exception.error ("Parse error: " <> show errs))
580+ }
581+ test
134582 _ <- PG.executeSimple dropDDL conn
135583 PG.end conn
136584 where
137− dropDDL = PG.SQL "DROP TABLE IF EXISTS test_om_users CASCADE"
138− createDDL = PG.SQL
139− """DROP TABLE IF EXISTS test_om_users CASCADE;
140− CREATE TABLE test_om_users (
141− id SERIAL PRIMARY KEY,
142− name TEXT NOT NULL,
143− email TEXT UNIQUE NOT NULL,
144− active BOOLEAN DEFAULT true NOT NULL,
145− role TEXT NOT NULL
146− )"""
585+ dropStr = "DROP TABLE IF EXISTS test_om_users CASCADE"
586+ dropDDL = PG.SQL dropStr
587+ createDDL = PG.SQL (dropStr <> "; " <> createTableDDL @UsersTable)
588+
589+withSingleConnectionUsersTable :: TestOm -> Aff Unit
590+withSingleConnectionUsersTable test = do
591+ conn <- PG.postgres
592+ { host: PG.PostgresHost "localhost"
593+ , port: PG.PostgresPort 5433
594+ , database: PG.PostgresDatabase "test_playground"
595+ , username: PG.PostgresUsername "postgres"
596+ , password: PG.PostgresPassword "postgres"
597+ , max: PG.MaxConnections 1
598+ } # liftEffect
599+ _ <- PG.executeSimple createDDL conn
600+ Om.runOm { postgresConnection: conn }
601+ { exception: throwError
602+ , parseError: \errs -> throwError (Exception.error ("Parse error: " <> show errs))
603+ }
604+ test
605+ _ <- PG.executeSimple dropDDL conn
606+ PG.end conn
607+ where
608+ dropStr = "DROP TABLE IF EXISTS test_om_users CASCADE"
609+ dropDDL = PG.SQL dropStr
610+ createDDL = PG.SQL (dropStr <> "; " <> createTableDDL @UsersTable)
611+
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))
619+ }
620+ test
621+ _ <- PG.executeSimple teardownDDL conn
622+ PG.end conn
623+ where
624+ teardownDDL = PG.SQL "DROP TABLE IF EXISTS test_om_posts CASCADE; DROP TABLE IF EXISTS test_om_users CASCADE"
625+ setupDDL = PG.SQL
626+ ( "DROP TABLE IF EXISTS test_om_posts CASCADE; "
627+ <> "DROP TABLE IF EXISTS test_om_users CASCADE; "
628+ <> createTableDDL @UsersTable
629+ <> "; "
630+ <> createTableDDL @PostsTable
631+ )