git.iko.soy/rowtype-yoga/purescript-yoga-postgres
on main help sign in
swap
c3979539 ahead, 0 behind
15 files changed+1059−152
since splitsnapshots
unifiedsplit
.github/workflows/ci.yml+6−1 .psc-ide-port+1−1 compile-fail-tests/OnConflictBadExcluded.purs+3−2 compile-fail-tests/ReturningWithoutMutation.purs+17 docker-compose.test.yml+1−1 spago.lock+14−14 spago.yaml+5−5 src/Yoga/Postgres.js+42−42 src/Yoga/Postgres.purs+18−8 src/Yoga/Postgres/Schema.purs+382−63 test/Behavioral.js+8 test/Behavioral.purs+540 test/Integration.purs+1−1 test/Main.purs+15−8 test/Schema.purs+6−6
.github/workflows/ci.yml+6−1
@@ -6,4 +6,9 @@ jobs:
66 steps:
77 - uses: actions/checkout@v4
88 - uses: rowtype-yoga/purescript-yoga-actions/.github/actions/setup@main
9− - run: spago build
9+ - run: bun install --frozen-lockfile
10+ - run: docker compose -f docker-compose.test.yml up -d --wait postgres
11+ - run: spago test
12+ - run: bash compile-fail-tests/run.sh
13+ - if: always()
14+ run: docker compose -f docker-compose.test.yml down --volumes
.psc-ide-port+1−1
@@ -1 +1 @@
1−15218
1+15490
compile-fail-tests/OnConflictBadExcluded.purs+3−2
@@ -1,4 +1,4 @@
1−-- EXPECT: Expected
1+-- EXPECT: TypesDoNotUnify
22module Test.CompileFail.OnConflictBadExcluded where
33
44import Prelude
@@ -17,4 +17,5 @@ type UsersTable = Table "users"
1717usersTable :: Proxy UsersTable
1818usersTable = Proxy
1919
20−bad = from usersTable # insert { name: "A", email: "a@b.com" } # onConflict @"email" @"DO UPDATE SET name = EXCLUDED.bogus"
20+-- ON CONFLICT target column must exist in the table
21+bad = from usersTable # insert { name: "A", email: "a@b.com" } # onConflict @"bogus_column" @"DO UPDATE SET name = EXCLUDED.name"
compile-fail-tests/ReturningWithoutMutation.pursnew file+17
@@ -0,0 +1,17 @@
1+-- EXPECT: RETURNING requires a preceding INSERT, UPDATE (set), or DELETE
2+module Test.CompileFail.ReturningWithoutMutation where
3+
4+import Prelude
5+import Type.Function (type (#))
6+import Type.Proxy (Proxy(..))
7+import Yoga.Postgres.Schema
8+
9+type UsersTable = Table "users"
10+ ( id :: Int # PrimaryKey # AutoIncrement
11+ , name :: String
12+ )
13+
14+usersTable :: Proxy UsersTable
15+usersTable = Proxy
16+
17+bad = from usersTable # returning @"id"
docker-compose.test.yml+1−1
@@ -6,7 +6,7 @@ services:
66 POSTGRES_PASSWORD: postgres
77 POSTGRES_DB: test_playground
88 ports:
9− - "5433:5432"
9+ - "5434:5432"
1010 healthcheck:
1111 test: ["CMD-SHELL", "pg_isready -U postgres"]
1212 interval: 2s
spago.lock+14−14
@@ -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"
@@ -33,7 +33,7 @@
3333 "foreign": ">=7.0.0 <8.0.0"
3434 },
3535 {
36− "heterogeneous": ">=0.6.0 <0.7.0"
36+ "heterogeneous": ">=0.7.0 <0.8.0"
3737 },
3838 {
3939 "integers": ">=6.0.0 <7.0.0"
@@ -90,10 +90,10 @@
9090 "uuid": ">=9.0.0 <10.0.0"
9191 },
9292 {
93− "yoga-json": ">=5.2.0 <6.0.0"
93+ "yoga-json": ">=5.2.1 <6.0.0"
9494 },
9595 {
96− "yoga-sql-types": ">=0.1.0 <0.2.0"
96+ "yoga-sql-types": ">=0.2.0 <0.3.0"
9797 }
9898 ]
9999 },
@@ -123,8 +123,8 @@
123123 "packages": {
124124 "aff": {
125125 "type": "registry",
126− "version": "7.1.0",
127− "integrity": "sha256-/nOpDQVnKIoP1pQ1ZZBYpadK0TuMlG4WwufGzJpsfD0=",
126+ "version": "8.0.0",
127+ "integrity": "sha256-9BRIrSdRoYybfiUmBqgKJ66cPqxYHb277bVWQMn/9sg=",
128128 "dependencies": [
129129 "control",
130130 "datetime",
@@ -475,8 +475,8 @@
475475 },
476476 "heterogeneous": {
477477 "type": "registry",
478− "version": "0.6.0",
479− "integrity": "sha256-nQgk2iHYe5LIi6ZzREgWaCU3y8oCwdhDSukT6xVMWdk=",
478+ "version": "0.7.0",
479+ "integrity": "sha256-pQwcFvhWL8noktxaoD7FlLs2F2lYf3QHoyO0VOWO3I0=",
480480 "dependencies": [
481481 "either",
482482 "foldable-traversable",
@@ -983,8 +983,8 @@
983983 },
984984 "yoga-json": {
985985 "type": "registry",
986− "version": "5.2.0",
987− "integrity": "sha256-M+kkz6E1Gf+C4bKnhqoBFIoVcc74loi3rLULePbB204=",
986+ "version": "5.2.1",
987+ "integrity": "sha256-12I7qIf27oKV/D/YRcHtGpN8n7GQ0Bm3uzvI4ZjOQrs=",
988988 "dependencies": [
989989 "arrays",
990990 "bifunctors",
@@ -1022,8 +1022,8 @@
10221022 },
10231023 "yoga-sql-types": {
10241024 "type": "registry",
1025− "version": "0.1.0",
1026− "integrity": "sha256-vxOgnj3HK8F5gRHCNkIPNirORQtCBEKozG+CnrHtB84=",
1025+ "version": "0.2.0",
1026+ "integrity": "sha256-/fiSiEmSQ8UH2N7vp/E02Eo+Krbs6iGcre9haDV34Q8=",
10271027 "dependencies": [
10281028 "arrays",
10291029 "bifunctors",
@@ -1051,8 +1051,8 @@
10511051 },
10521052 "yoga-test-docker": {
10531053 "type": "registry",
1054− "version": "0.1.1",
1055− "integrity": "sha256-BKyHoGahs1D5PbjqSKL+6vvUJQ62mbpXYJOF9UwaGb8=",
1054+ "version": "0.1.2",
1055+ "integrity": "sha256-J/jgHvvwb04ZOhicRGucmrQhaokrYTc9XJ2dutsktq8=",
10561056 "dependencies": [
10571057 "aff",
10581058 "datetime",
spago.yaml+5−5
@@ -3,13 +3,13 @@ workspace: {}
33package:
44 name: yoga-postgres
55 publish:
6− version: 0.2.0
6+ version: 0.3.2
77 license: MIT
88 location:
99 githubOwner: rowtype-yoga
1010 githubRepo: purescript-yoga-postgres
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 - datetime: ">=6.1.0 <7.0.0"
1515 - effect: ">=4.0.0 <5.0.0"
@@ -18,7 +18,7 @@ package:
1818 - exceptions: ">=6.1.0 <7.0.0"
1919 - foldable-traversable: ">=6.0.0 <7.0.0"
2020 - foreign: ">=7.0.0 <8.0.0"
21− - heterogeneous: ">=0.6.0 <0.7.0"
21+ - heterogeneous: ">=0.7.0 <0.8.0"
2222 - integers: ">=6.0.0 <7.0.0"
2323 - js-bigints: ">=2.2.1 <3.0.0"
2424 - js-date: ">=8.0.0 <9.0.0"
@@ -37,8 +37,8 @@ package:
3737 - typelevel-prelude: ">=7.0.0 <8.0.0"
3838 - unsafe-coerce: ">=6.0.0 <7.0.0"
3939 - uuid: ">=9.0.0 <10.0.0"
40− - yoga-json: ">=5.2.0 <6.0.0"
41− - yoga-sql-types: ">=0.1.0 <0.2.0"
40+ - yoga-json: ">=5.2.1 <6.0.0"
41+ - yoga-sql-types: ">=0.2.0 <0.3.0"
4242 test:
4343 main: Test.Postgres.Main
4444 dependencies:
src/Yoga/Postgres.js+42−42
@@ -2,27 +2,20 @@ import postgres from 'postgres';
22
33// Create Postgres connection
44export const postgresImpl = (config) => {
5− // Support both individual config and connection string
6− if (config.connection) {
7− return postgres(config.connection, config);
8− }
9−
10− return postgres({
11− host: config.host,
12− port: config.port,
13− database: config.database,
14− username: config.username,
15− password: config.password,
16− max: config.max,
17− idle_timeout: config.idle_timeout,
18− connect_timeout: config.connect_timeout,
19− ssl: config.ssl,
20− debug: config.debug,
21− onnotice: config.onnotice,
22− onparameter: config.onparameter,
23− // Pass through any other options
24− ...config
25− });
5+ const { connection, ...configOptions } = config;
6+ const options = {
7+ ...configOptions,
8+ onnotice: config.onnotice
9+ ? () => config.onnotice()
10+ : undefined,
11+ onparameter: config.onparameter
12+ ? (key, value) => config.onparameter({ key, value })()
13+ : undefined
14+ };
15+
16+ return connection
17+ ? postgres(connection, options)
18+ : postgres(options);
2619};
2720
2821// Query operations
@@ -92,27 +85,29 @@ export const beginImpl = async (sql) => {
9285};
9386
9487export const commitImpl = async (txn) => {
95− if (txn._reserved) {
96− await txn._reserved`COMMIT`;
97− // Release the connection back to the pool
98− await txn._reserved.release();
88+ if (!txn._reserved) return;
89+
90+ const reserved = txn._reserved;
91+ txn._reserved = null;
92+ try {
93+ await reserved`COMMIT`;
94+ } finally {
95+ await reserved.release();
9996 }
10097};
10198
10299export const rollbackImpl = async (txn) => {
103− if (txn._reserved) {
104− await txn._reserved`ROLLBACK`;
105− // Release the connection back to the pool
106− await txn._reserved.release();
100+ if (!txn._reserved) return;
101+
102+ const reserved = txn._reserved;
103+ txn._reserved = null;
104+ try {
105+ await reserved`ROLLBACK`;
106+ } finally {
107+ await reserved.release();
107108 }
108109};
109110
110−export const transactionImpl = async (sql, handler) => {
111− return sql.begin(async (txn) => {
112− const affAction = handler(txn);
113− return await affAction();
114− });
115−};
116111
117112export const txQueryImpl = async (txn, queryString, params) => {
118113 // Use the underlying SQL connection
@@ -147,19 +142,24 @@ export const endImpl = (sql) => sql.end();
147142
148143// Listen/Notify
149144
145+const listeners = new WeakMap();
146+
150147export const listenImpl = async (sql, channel, handler) => {
151− await sql.listen(channel, (payload) => {
148+ const subscription = await sql.listen(channel, (payload) => {
152149 handler({ channel, payload })();
153150 });
151+ const byChannel = listeners.get(sql) || new Map();
152+ const subscriptions = byChannel.get(channel) || [];
153+ subscriptions.push(subscription);
154+ byChannel.set(channel, subscriptions);
155+ listeners.set(sql, byChannel);
154156};
155157
156158export const unlistenImpl = async (sql, channel) => {
157− // postgres.js uses the same listen method to unlisten
158− if (sql.listen.unlisten) {
159− return sql.listen.unlisten(channel);
160− }
161− // Alternative: just resolve, as postgres.js handles cleanup automatically
162− return Promise.resolve();
159+ const byChannel = listeners.get(sql);
160+ const subscriptions = byChannel?.get(channel) || [];
161+ await Promise.all(subscriptions.map(({ unlisten }) => unlisten()));
162+ byChannel?.delete(channel);
163163};
164164
165165export const notifyImpl = (sql, channel, payload) =>
src/Yoga/Postgres.purs+18−8
@@ -2,18 +2,22 @@ module Yoga.Postgres where
22
33import Prelude
44
5+
6+
57import Data.Maybe (Maybe)
68import Data.Newtype (class Newtype)
79import Data.Nullable (Nullable)
810import Data.Nullable as Nullable
911import Data.Time.Duration (Milliseconds)
12+import Data.UUID (UUID)
13+import Data.UUID as UUID
1014import Effect (Effect)
11−import Effect.Aff (Aff)
15+import Effect.Aff (Aff, generalBracket)
1216import Effect.Uncurried (EffectFn1, EffectFn2, EffectFn3, runEffectFn1, runEffectFn2, runEffectFn3)
1317import Foreign (Foreign)
1418import Prim.Row (class Union)
1519import Promise (Promise)
16−import Promise.Aff (fromAff, toAffE) as Promise
20+import Promise.Aff (toAffE) as Promise
1721import Unsafe.Coerce (unsafeCoerce)
1822
1923-- Opaque Postgres types
@@ -114,6 +118,9 @@ instance ToPGValue Boolean where
114118instance ToPGValue a => ToPGValue (Array a) where
115119 toPGValue arr = unsafeCoerce (map toPGValue arr)
116120
121+instance ToPGValue UUID where
122+ toPGValue = toPGValue <<< UUID.toString
123+
117124instance ToPGValue Foreign where
118125 toPGValue = unsafeCoerce
119126
@@ -219,13 +226,16 @@ foreign import rollbackImpl :: EffectFn1 Transaction (Promise Unit)
219226rollback :: Transaction -> Aff Unit
220227rollback = runEffectFn1 rollbackImpl >>> Promise.toAffE
221228
222−-- Run transaction block (automatic commit/rollback)
223−foreign import transactionImpl :: EffectFn2 Connection (Transaction -> Effect (Promise Unit)) (Promise Unit)
224229
225−transaction :: (Transaction -> Aff Unit) -> Connection -> Aff Unit
226−transaction handler conn =
227− runEffectFn2 transactionImpl conn (\txn -> Promise.fromAff (handler txn))
228− # Promise.toAffE
230+-- Low-level escape hatch for code that needs the raw transaction handle.
231+withTransaction :: forall a. (Transaction -> Aff a) -> Connection -> Aff a
232+withTransaction operation conn =
233+ generalBracket (begin conn)
234+ { killed: \_ -> rollback
235+ , failed: \_ -> rollback
236+ , completed: \_ -> commit
237+ }
238+ operation
229239
230240-- Query within transaction
231241foreign import txQueryImpl :: EffectFn3 Transaction SQL (Array PGValue) (Promise QueryResult)
src/Yoga/Postgres/Schema.purs+382−63
@@ -2,48 +2,47 @@ module Yoga.Postgres.Schema where
22
33import Prelude
44
5−import Data.Array as Array
6−import Data.Array (intercalate, mapWithIndex, foldl)
7−import Data.Date (Date)
8−import Data.Enum (toEnum)
9−import Data.DateTime (DateTime(..), date, time)
10−import Data.JSDate as JSDate
11−import Data.Maybe (Maybe(..), fromMaybe, maybe)
12−import Data.Time (Time(..))
13−import Data.Newtype (class Newtype)
14−import Data.Nullable (toNullable)
15−import Data.UUID (UUID)
16−import JS.BigInt (BigInt)
17−import Unsafe.Coerce (unsafeCoerce)
18−import Data.Reflectable (class Reflectable, reflectType)
19−import Data.String.Regex (regex, replace') as Regex
20−import Data.String.Regex (Regex) as Regex
21−import Data.String.Regex.Flags (global) as Regex
225import Control.Monad.Except (except, runExcept)
6+import Data.Array (intercalate, mapWithIndex, foldl)
7+import Data.Array as Array
8+import Data.Date (Date, day, month, year)
9+import Data.DateTime (DateTime(..))
2310import Data.Either (Either(..), note)
11+import Data.Enum (fromEnum, toEnum)
2412import Data.Int as Int
13+import Data.JSDate as JSDate
2514import Data.List.Types (NonEmptyList)
15+import Data.Map as Map
16+import Data.Maybe (Maybe(..), fromMaybe)
17+import Data.Newtype (class Newtype)
18+import Data.Nullable (toNullable)
2619import Data.Number as Number
20+import Data.Reflectable (class Reflectable, reflectType)
21+import Data.String.CodeUnits as SCU
2722import Data.String.Common as Str
2823import Data.String.Pattern (Pattern(..))
29−import Data.String.CodeUnits as SCU
30−import Data.Traversable (traverse)
31−import Effect.Exception (error) as Exception
32−import Data.Map as Map
24+import Data.String.Regex (Regex, regex, replace') as Regex
25+import Data.String.Regex.Flags (global) as Regex
3326import Data.Symbol (class IsSymbol, reflectSymbol)
34−import Type.Function (type (#))
27+import Data.Time (Time(..))
28+import Data.Traversable (traverse)
29+import Data.UUID (UUID)
30+import Data.UUID as UUID
3531import Effect.Aff (Aff, throwError)
36−import Foreign (Foreign, ForeignError(..), unsafeToForeign)
32+import Effect.Exception (error) as Exception
33+import Foreign (Foreign, ForeignError(..))
34+import JS.BigInt (BigInt)
3735import Prim.Boolean (True, False)
3836import Prim.Row (class Cons, class Lacks, class Union, class Nub) as Row
39−import Prim.RowList as RL
4037import Prim.RowList (class RowToList)
38+import Prim.RowList as RL
4139import Prim.Symbol (class Cons, class Append) as Symbol
4240import Prim.TypeError (class Fail, Beside, Text, Quote)
4341import Record (get) as Record
4442import Type.Proxy (Proxy(..))
4543import Type.RowList (class ListToRow)
46−import Yoga.JSON (class ReadForeign, readImpl)
44+import Unsafe.Coerce (unsafeCoerce)
45+import Yoga.JSON (class ReadForeign, class WriteForeign, readImpl, writeImpl)
4746import Yoga.Postgres as PG
4847
4948-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
@@ -69,15 +68,15 @@ data Unique a
6968
7069data Default :: forall k. k -> Type -> Type
7170data Default val a
71+data DefaultExpr :: Symbol -> Type -> Type
72+data DefaultExpr expression a
73+
7274
7375data References
7476
7577data ForeignKey :: Symbol -> Type -> Symbol -> Type -> Type
7678data ForeignKey table references col a
7779
78−data DefaultExpr :: Symbol -> Type -> Type
79−data DefaultExpr expr a
80−
8180-- Internal: used by LEFT JOIN to mark columns as nullable
8281data Nullable :: Type -> Type
8382data Nullable a
@@ -93,6 +92,9 @@ derive instance Newtype Jsonb _
9392instance ReadForeign Jsonb where
9493 readImpl = pure <<< Jsonb
9594
95+instance WriteForeign Jsonb where
96+ writeImpl (Jsonb value) = value
97+
9698-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
9799-- PGUUID: newtype over Data.UUID.UUID for Postgres integration
98100-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
@@ -109,6 +111,9 @@ instance ReadForeign PGUUID where
109111 s :: String <- readImpl f
110112 pure (unsafeCoerce s)
111113
114+instance WriteForeign PGUUID where
115+ writeImpl (PGUUID uuid) = writeImpl (UUID.toString uuid)
116+
112117-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
113118-- PGDate / PGTime: newtypes for DATE and TIME columns
114119-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
@@ -128,6 +133,33 @@ instance ReadForeign PGDate where
128133 jsDate :: JSDate.JSDate
129134 jsDate = unsafeCoerce f
130135
136+instance WriteForeign PGDate where
137+ writeImpl (PGDate date) =
138+ writeImpl
139+ ( show (fromEnum (year date))
140+ <> "-"
141+ <> pad2 (fromEnum (month date))
142+ <> "-"
143+ <> pad2 (fromEnum (day date))
144+ )
145+ where
146+ pad2 n = if n < 10 then "0" <> show n else show n
147+
148+newtype TimestampTZ = TimestampTZ DateTime
149+
150+derive instance Newtype TimestampTZ _
151+derive instance Eq TimestampTZ
152+derive instance Ord TimestampTZ
153+instance Show TimestampTZ where
154+ show (TimestampTZ dt) = "(TimestampTZ " <> show dt <> ")"
155+
156+instance ReadForeign TimestampTZ where
157+ readImpl f =
158+ except $ note (pure (ForeignError "Invalid timestamp")) (JSDate.toDateTime jsDate <#> TimestampTZ)
159+ where
160+ jsDate :: JSDate.JSDate
161+ jsDate = unsafeCoerce f
162+
131163newtype PGTime = PGTime Time
132164
133165derive instance Newtype PGTime _
@@ -149,10 +181,34 @@ instance ReadForeign PGTime where
149181 mi <- Int.fromString mStr >>= toEnum
150182 let secParts = Str.split (Pattern ".") sStr
151183 s <- Int.fromString (fromMaybe sStr (Array.head secParts)) >>= toEnum
152− let ms = fromMaybe bottom (Array.index secParts 1 >>= Int.fromString >>= toEnum)
184+ let fraction = fromMaybe "" (Array.index secParts 1)
185+ let milliseconds = case SCU.length fraction of
186+ 0 -> "0"
187+ 1 -> fraction <> "00"
188+ 2 -> fraction <> "0"
189+ _ -> SCU.take 3 fraction
190+ let ms = fromMaybe bottom (Int.fromString milliseconds >>= toEnum)
153191 pure (PGTime (Time h mi s ms))
154192 _ -> Nothing
155193
194+instance WriteForeign PGTime where
195+ writeImpl (PGTime (Time hour minute second millisecond)) =
196+ writeImpl
197+ ( pad2 (fromEnum hour)
198+ <> ":"
199+ <> pad2 (fromEnum minute)
200+ <> ":"
201+ <> pad2 (fromEnum second)
202+ <> "."
203+ <> pad3 (fromEnum millisecond)
204+ )
205+ where
206+ pad2 n = if n < 10 then "0" <> show n else show n
207+ pad3 n
208+ | n < 10 = "00" <> show n
209+ | n < 100 = "0" <> show n
210+ | otherwise = show n
211+
156212-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
157213-- Point: geometric point "(x,y)"
158214-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
@@ -231,7 +287,7 @@ instance ExtractType a typ => ExtractType (PrimaryKey a) typ
231287else instance ExtractType a typ => ExtractType (AutoIncrement a) typ
232288else instance ExtractType a typ => ExtractType (Unique a) typ
233289else instance ExtractType a typ => ExtractType (Default val a) typ
234−else instance ExtractType a typ => ExtractType (DefaultExpr expr a) typ
290+else instance ExtractType a typ => ExtractType (DefaultExpr expression a) typ
235291else instance ExtractType a typ => ExtractType (ForeignKey t r c a) typ
236292else instance ExtractType a typ => ExtractType (Nullable a) (Maybe typ)
237293else instance ExtractType a a
@@ -264,6 +320,9 @@ instance PGTypeName BigInt where
264320instance PGTypeName PGUUID where
265321 pgTypeName _ = "UUID"
266322
323+instance PGTypeName TimestampTZ where
324+ pgTypeName _ = "TIMESTAMPTZ"
325+
267326instance PGTypeName PGDate where
268327 pgTypeName _ = "DATE"
269328
@@ -301,8 +360,24 @@ instance Reflectable sym String => RenderDefaultValue sym String where
301360instance Reflectable val Int => RenderDefaultValue val Int where
302361 renderDefaultValue _ _ = "DEFAULT " <> show (reflectType (Proxy :: Proxy val))
303362
304−instance Reflectable val Boolean => RenderDefaultValue val Boolean where
305− renderDefaultValue _ _ = if reflectType (Proxy :: Proxy val) then "DEFAULT true" else "DEFAULT false"
363+instance RenderDefaultValue True Boolean where
364+ renderDefaultValue _ _ = "DEFAULT true"
365+
366+instance RenderDefaultValue False Boolean where
367+ renderDefaultValue _ _ = "DEFAULT false"
368+
369+instance RenderDefaultValue "true" Boolean where
370+ renderDefaultValue _ _ = "DEFAULT true"
371+
372+instance RenderDefaultValue "false" Boolean where
373+ renderDefaultValue _ _ = "DEFAULT false"
374+
375+instance RenderDefaultValue "now()" TimestampTZ where
376+ renderDefaultValue _ _ = "DEFAULT now()"
377+
378+instance RenderDefaultValue "gen_random_uuid()" PGUUID where
379+ renderDefaultValue _ _ = "DEFAULT gen_random_uuid()"
380+
306381
307382class RenderConstraint a where
308383 renderConstraint :: Proxy a -> String
@@ -319,11 +394,10 @@ else instance RenderConstraint a => RenderConstraint (Unique a) where
319394else instance (RenderDefaultValue val a, RenderConstraint a) => RenderConstraint (Default val a) where
320395 renderConstraint _ = joinConstraints (renderDefaultValue (Proxy :: Proxy val) (Proxy :: Proxy a)) (renderConstraint (Proxy :: Proxy a))
321396
322−else instance (IsSymbol expr, RenderConstraint a) => RenderConstraint (DefaultExpr expr a) where
397+else instance (IsSymbol expression, RenderConstraint a) => RenderConstraint (DefaultExpr expression a) where
323398 renderConstraint _ = joinConstraints
324− ("DEFAULT " <> reflectSymbol (Proxy :: Proxy expr))
399+ ("DEFAULT " <> reflectSymbol (Proxy :: Proxy expression))
325400 (renderConstraint (Proxy :: Proxy a))
326−
327401else instance (IsSymbol table, IsSymbol col, RenderConstraint a) => RenderConstraint (ForeignKey table References col a) where
328402 renderConstraint _ = joinConstraints
329403 ("REFERENCES " <> reflectSymbol (Proxy :: Proxy table) <> "(" <> reflectSymbol (Proxy :: Proxy col) <> ")")
@@ -384,6 +458,11 @@ instance
384458 let columns = renderColumnsRL (Proxy :: Proxy rl)
385459 "CREATE TABLE " <> tableName <> " (" <> intercalate ", " columns <> ")"
386460
461+createTableDDLIfNotExists :: forall @a. CreateTableDDL a => String
462+createTableDDLIfNotExists = do
463+ let ddl = createTableDDL @a
464+ "CREATE TABLE IF NOT EXISTS" <> SCU.drop 12 ddl
465+
387466-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
388467-- INSERT SQL generation
389468-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
@@ -395,7 +474,7 @@ instance IsAutoGenerated (AutoIncrement a) where
395474 isAutoGenerated _ = true
396475else instance IsAutoGenerated (Default v a) where
397476 isAutoGenerated _ = true
398−else instance IsAutoGenerated (DefaultExpr expr a) where
477+else instance IsAutoGenerated (DefaultExpr expression a) where
399478 isAutoGenerated _ = true
400479else instance IsAutoGenerated a => IsAutoGenerated (PrimaryKey a) where
401480 isAutoGenerated _ = isAutoGenerated (Proxy :: Proxy a)
@@ -440,15 +519,18 @@ instance
440519 insertSQLFor = do
441520 let tableName = reflectSymbol (Proxy :: Proxy name)
442521 let cols = insertColumnsRL (Proxy :: Proxy rl)
443− let placeholders = cols # mapWithIndex \i _ -> "$" <> show (i + 1)
444− "INSERT INTO " <> tableName
445− <> " ("
446− <> intercalate ", " cols
447− <> ")"
448− <> " VALUES ("
449− <> intercalate ", " placeholders
450− <> ")"
451− <> " RETURNING *"
522+ if Array.null cols then
523+ "INSERT INTO " <> tableName <> " DEFAULT VALUES RETURNING *"
524+ else do
525+ let placeholders = cols # mapWithIndex \i _ -> "$" <> show (i + 1)
526+ "INSERT INTO " <> tableName
527+ <> " ("
528+ <> intercalate ", " cols
529+ <> ")"
530+ <> " VALUES ("
531+ <> intercalate ", " placeholders
532+ <> ")"
533+ <> " RETURNING *"
452534
453535-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
454536-- SELECT SQL generation
@@ -903,6 +985,15 @@ else instance
903985 ) =>
904986 ParseSelectHandleAS "as" afterKeyword colRef tables accRL outRL
905987
988+-- Bare alias (no AS keyword): "name n" means "name AS n"
989+else instance
990+ ( ResolveColumn colRef tables entry
991+ , ExtractType entry typ
992+ , SkipSpaces afterKeyword rest
993+ , ParseSelectExpectEnd rest tables (RL.Cons keyword typ accRL) outRL
994+ ) =>
995+ ParseSelectHandleAS keyword afterKeyword colRef tables accRL outRL
996+
906997class ParseSelectExpectEnd :: Symbol -> Row (Row Type) -> RL.RowList Type -> RL.RowList Type -> Constraint
907998class ParseSelectExpectEnd sym tables accRL outRL | sym tables accRL -> outRL
908999
@@ -1001,11 +1092,66 @@ instance ResolveAggregateArg "*" tables Star
10011092else instance ResolveAggregateArg "" tables Star
10021093else instance
10031094 ( SkipSpaces args trimmedFront
1004− , ExtractWord trimmedFront col _rest
1005− , ResolveAggregateArgCol col tables argType
1095+ , ExtractIdent trimmedFront col rest
1096+ , ResolveAggregateArgDispatch col rest tables argType
10061097 ) =>
10071098 ResolveAggregateArg args tables argType
10081099
1100+-- ExtractIdent: like ExtractWord but also stops at "(" so we can detect nested function calls
1101+class ExtractIdent :: Symbol -> Symbol -> Symbol -> Constraint
1102+class ExtractIdent sym word rest | sym -> word rest
1103+
1104+instance ExtractIdent "" "" ""
1105+else instance
1106+ ( Symbol.Cons h t sym
1107+ , ExtractIdentGo h t "" word rest
1108+ ) =>
1109+ ExtractIdent sym word rest
1110+
1111+class ExtractIdentGo :: Symbol -> Symbol -> Symbol -> Symbol -> Symbol -> Constraint
1112+class ExtractIdentGo head tail acc word rest | head tail acc -> word rest
1113+
1114+instance (SkipSpaces tail rest) => ExtractIdentGo " " tail acc acc rest
1115+else instance Symbol.Cons "," tail rest => ExtractIdentGo "," tail acc acc rest
1116+else instance Symbol.Append "(" tail rest => ExtractIdentGo "(" tail acc acc rest
1117+else instance Symbol.Append acc h word => ExtractIdentGo h "" acc word ""
1118+else instance
1119+ ( Symbol.Append acc h acc'
1120+ , Symbol.Cons nextH nextT tail
1121+ , ExtractIdentGo nextH nextT acc' word rest
1122+ ) =>
1123+ ExtractIdentGo h tail acc word rest
1124+
1125+-- After extracting the identifier, check if followed by "(" (nested function call) or not (column ref)
1126+class ResolveAggregateArgDispatch :: Symbol -> Symbol -> Row (Row Type) -> Type -> Constraint
1127+class ResolveAggregateArgDispatch col rest tables argType | col rest tables -> argType
1128+
1129+instance
1130+ ResolveAggregateArgCol col tables argType =>
1131+ ResolveAggregateArgDispatch col "" tables argType
1132+
1133+else instance
1134+ ( Symbol.Cons h t rest
1135+ , ResolveAggregateArgDispatchByHead h t col tables argType
1136+ ) =>
1137+ ResolveAggregateArgDispatch col rest tables argType
1138+
1139+class ResolveAggregateArgDispatchByHead :: Symbol -> Symbol -> Symbol -> Row (Row Type) -> Type -> Constraint
1140+class ResolveAggregateArgDispatchByHead head tail col tables argType | head tail col tables -> argType
1141+
1142+-- Nested function call: col(...)
1143+instance
1144+ ( ExtractUntilParen tail innerArgs _afterParen
1145+ , ResolveAggregateArg innerArgs tables innerArgType
1146+ , AggregateReturnType col innerArgType argType
1147+ ) =>
1148+ ResolveAggregateArgDispatchByHead "(" tail col tables argType
1149+
1150+-- Not a function call: column reference
1151+else instance
1152+ ResolveAggregateArgCol col tables argType =>
1153+ ResolveAggregateArgDispatchByHead h t col tables argType
1154+
10091155class ResolveAggregateArgCol :: Symbol -> Row (Row Type) -> Type -> Constraint
10101156class ResolveAggregateArgCol col tables argType | col tables -> argType
10111157
@@ -2511,13 +2657,85 @@ else instance
25112657 , SkipSpaces rest1 rest2
25122658 , ExpectChar rest2 "=" rest3
25132659 , SkipSpaces rest3 rest4
2514− , ExtractWord rest4 excRef rest5
2515− , ValidateExcludedRef excRef colName
2516− , SkipSpaces rest5 rest6
2517− , ParseAssignmentsContinue rest6 cols
2660+ , SkipExpression rest4 rest5
2661+ , ParseAssignmentsContinue rest5 cols
25182662 ) =>
25192663 ParseAssignments sym cols
25202664
2665+-- | Skip a SQL expression on the RHS of an assignment.
2666+-- | Handles balanced parentheses so that e.g. now() and
2667+-- | COALESCE(EXCLUDED.value, '') are consumed as a single expression.
2668+-- | Stops at an unparenthesised comma or end-of-string.
2669+class SkipExpression :: Symbol -> Symbol -> Constraint
2670+class SkipExpression sym rest | sym -> rest
2671+
2672+instance SkipExpression "" ""
2673+else instance
2674+ ( Symbol.Cons h t sym
2675+ , SkipExpressionGo h t rest
2676+ ) =>
2677+ SkipExpression sym rest
2678+
2679+class SkipExpressionGo :: Symbol -> Symbol -> Symbol -> Constraint
2680+class SkipExpressionGo head tail rest | head tail -> rest
2681+
2682+-- Comma at depth 0 → stop, keep comma in rest
2683+instance Symbol.Cons "," tail rest => SkipExpressionGo "," tail rest
2684+-- Open paren → enter nested expression
2685+else instance
2686+ ( SkipNested tail rest1
2687+ , SkipExpression rest1 rest
2688+ ) =>
2689+ SkipExpressionGo "(" tail rest
2690+-- Space → skip and continue (expressions can have spaces, e.g. "EXCLUDED.col")
2691+else instance (SkipSpaces tail rest1, SkipExpressionAfterSpace rest1 rest) => SkipExpressionGo " " tail rest
2692+-- End of string after this char
2693+else instance SkipExpressionGo h "" ""
2694+-- Regular char → continue
2695+else instance (Symbol.Cons h2 t2 tail, SkipExpressionGo h2 t2 rest) => SkipExpressionGo h tail rest
2696+
2697+-- | After a space in an expression, check if we've hit a comma or a new assignment (word = ...).
2698+-- | If the next word is a column name followed by '=', this is a new assignment, so stop.
2699+-- | Otherwise, continue the expression.
2700+class SkipExpressionAfterSpace :: Symbol -> Symbol -> Constraint
2701+class SkipExpressionAfterSpace sym rest | sym -> rest
2702+
2703+instance SkipExpressionAfterSpace "" ""
2704+else instance
2705+ ( Symbol.Cons h t sym
2706+ , SkipExpressionAfterSpaceGo h t sym rest
2707+ ) =>
2708+ SkipExpressionAfterSpace sym rest
2709+
2710+class SkipExpressionAfterSpaceGo :: Symbol -> Symbol -> Symbol -> Symbol -> Constraint
2711+class SkipExpressionAfterSpaceGo head tail sym rest | head tail sym -> rest
2712+
2713+-- Comma → stop
2714+instance Symbol.Cons "," tail rest => SkipExpressionAfterSpaceGo "," tail sym rest
2715+-- Otherwise continue the expression
2716+else instance (SkipExpressionGo h tail rest) => SkipExpressionAfterSpaceGo h tail sym rest
2717+
2718+-- | Skip a parenthesised group (after the opening paren has been consumed).
2719+-- | Handles nesting.
2720+class SkipNested :: Symbol -> Symbol -> Constraint
2721+class SkipNested sym rest | sym -> rest
2722+
2723+instance
2724+ ( Symbol.Cons h t sym
2725+ , SkipNestedGo h t rest
2726+ ) =>
2727+ SkipNested sym rest
2728+
2729+class SkipNestedGo :: Symbol -> Symbol -> Symbol -> Constraint
2730+class SkipNestedGo head tail rest | head tail -> rest
2731+
2732+-- Close paren → done
2733+instance SkipNestedGo ")" tail tail
2734+-- Open paren → recurse
2735+else instance (SkipNested tail rest1, SkipNested rest1 rest) => SkipNestedGo "(" tail rest
2736+-- Any other char → continue
2737+else instance (SkipNested tail rest) => SkipNestedGo h tail rest
2738+
25212739class ParseAssignmentsContinue :: Symbol -> Row Type -> Constraint
25222740class ParseAssignmentsContinue sym cols
25232741
@@ -2580,7 +2798,7 @@ class IsAutoGeneratedTC constraints result | constraints -> result
25802798
25812799instance IsAutoGeneratedTC (AutoIncrement a) True
25822800else instance IsAutoGeneratedTC (Default s a) True
2583−else instance IsAutoGeneratedTC (DefaultExpr expr a) True
2801+else instance IsAutoGeneratedTC (DefaultExpr expression a) True
25842802else instance IsAutoGeneratedTC a result => IsAutoGeneratedTC (PrimaryKey a) result
25852803else instance IsAutoGeneratedTC a result => IsAutoGeneratedTC (Unique a) result
25862804else instance IsAutoGeneratedTC a result => IsAutoGeneratedTC (ForeignKey t r c a) result
@@ -2636,13 +2854,19 @@ class FieldToPGValue a where
26362854 fieldToPGValue :: a -> PG.PGValue
26372855
26382856instance FieldToPGValue a => FieldToPGValue (Maybe a) where
2639− fieldToPGValue = toNullable >>> unsafeCoerce
2857+ fieldToPGValue = case _ of
2858+ Nothing -> unsafeCoerce (toNullable Nothing)
2859+ Just value -> fieldToPGValue value
26402860else instance FieldToPGValue DateTime where
26412861 fieldToPGValue = JSDate.fromDateTime >>> unsafeCoerce
2862+else instance FieldToPGValue TimestampTZ where
2863+ fieldToPGValue (TimestampTZ dt) = JSDate.fromDateTime dt # unsafeCoerce
26422864else instance FieldToPGValue PGDate where
2643− fieldToPGValue (PGDate d) = JSDate.fromDateTime (DateTime d bottom) # unsafeCoerce
2644−else instance FieldToPGValue a where
2865+ fieldToPGValue = writeImpl >>> unsafeCoerce
2866+else instance FieldToPGValue PGUUID where
26452867 fieldToPGValue = unsafeCoerce
2868+else instance WriteForeign a => FieldToPGValue a where
2869+ fieldToPGValue = writeImpl >>> unsafeCoerce
26462870
26472871class RecordValuesRL :: RL.RowList Type -> Row Type -> Constraint
26482872class RecordValuesRL rl row where
@@ -2710,6 +2934,20 @@ else instance HasAnyDMLRL (RL.Cons "delete" Unit rest)
27102934else instance HasAnyDMLRL rest => HasAnyDMLRL (RL.Cons label typ rest)
27112935else instance Fail (Text "WHERE requires a preceding SELECT, UPDATE (set), or DELETE") => HasAnyDMLRL RL.Nil
27122936
2937+class HasMutation :: Row Type -> Constraint
2938+class HasMutation stage
2939+
2940+instance (RL.RowToList stage rl, HasMutationRL rl) => HasMutation stage
2941+
2942+class HasMutationRL :: RL.RowList Type -> Constraint
2943+class HasMutationRL rl
2944+
2945+instance HasMutationRL (RL.Cons "insert" Unit rest)
2946+else instance HasMutationRL (RL.Cons "set" Unit rest)
2947+else instance HasMutationRL (RL.Cons "delete" Unit rest)
2948+else instance HasMutationRL rest => HasMutationRL (RL.Cons label typ rest)
2949+else instance Fail (Text "RETURNING requires a preceding INSERT, UPDATE (set), or DELETE") => HasMutationRL RL.Nil
2950+
27132951toSQL :: forall tables result params stage. Q tables result params stage -> String
27142952toSQL (Q q) = q.sql
27152953
@@ -2719,6 +2957,12 @@ from _ = Q { sql: reflectSymbol (Proxy :: Proxy name), values: [] }
27192957fromAs :: forall @alias name cols tables. IsSymbol name => IsSymbol alias => Row.Cons alias cols () tables => Proxy (Table name cols) -> Q tables () () ()
27202958fromAs _ = Q { sql: reflectSymbol (Proxy :: Proxy name) <> " " <> reflectSymbol (Proxy :: Proxy alias), values: [] }
27212959
2960+into :: forall name cols tables. IsSymbol name => Row.Cons name cols () tables => Proxy (Table name cols) -> Q tables () () (into :: Unit)
2961+into _ = Q { sql: reflectSymbol (Proxy :: Proxy name), values: [] }
2962+
2963+update :: forall name cols tables. IsSymbol name => Row.Cons name cols () tables => Proxy (Table name cols) -> Q tables () () (update :: Unit)
2964+update _ = Q { sql: reflectSymbol (Proxy :: Proxy name), values: [] }
2965+
27222966selectAll
27232967 :: forall tables name cols result r p stage stage'
27242968 . SingleTable tables name cols
@@ -2726,6 +2970,7 @@ selectAll
27262970 => StripColumns cols result
27272971 => Row.Lacks "select" stage
27282972 => Row.Lacks "insert" stage
2973+ => Row.Lacks "into" stage
27292974 => Row.Lacks "set" stage
27302975 => Row.Lacks "delete" stage
27312976 => Row.Lacks "where" stage
@@ -2743,6 +2988,7 @@ select
27432988 => ParseSelect sel tables result
27442989 => Row.Lacks "select" stage
27452990 => Row.Lacks "insert" stage
2991+ => Row.Lacks "into" stage
27462992 => Row.Lacks "set" stage
27472993 => Row.Lacks "delete" stage
27482994 => Row.Lacks "where" stage
@@ -2760,6 +3006,7 @@ selectDistinct
27603006 => ParseSelect sel tables result
27613007 => Row.Lacks "select" stage
27623008 => Row.Lacks "insert" stage
3009+ => Row.Lacks "into" stage
27633010 => Row.Lacks "set" stage
27643011 => Row.Lacks "delete" stage
27653012 => Row.Lacks "where" stage
@@ -2780,6 +3027,7 @@ selectDistinctOn
27803027 => ParseSelect sel tables result
27813028 => Row.Lacks "select" stage
27823029 => Row.Lacks "insert" stage
3030+ => Row.Lacks "into" stage
27833031 => Row.Lacks "set" stage
27843032 => Row.Lacks "delete" stage
27853033 => Row.Lacks "where" stage
@@ -2984,13 +3232,17 @@ insert rec _ = Q { sql, values }
29843232 tableName = reflectSymbol (Proxy :: Proxy name)
29853233 colNames = columnNamesRL (Proxy :: Proxy userRowRL)
29863234 placeholders = colNames # mapWithIndex \i _ -> "$" <> show (i + 1)
2987− sql = "INSERT INTO " <> tableName
2988− <> " ("
2989− <> intercalate ", " colNames
2990− <> ")"
2991− <> " VALUES ("
2992− <> intercalate ", " placeholders
2993− <> ")"
3235+ sql =
3236+ if Array.null colNames then
3237+ "INSERT INTO " <> tableName <> " DEFAULT VALUES"
3238+ else
3239+ "INSERT INTO " <> tableName
3240+ <> " ("
3241+ <> intercalate ", " colNames
3242+ <> ")"
3243+ <> " VALUES ("
3244+ <> intercalate ", " placeholders
3245+ <> ")"
29943246 values = recordValuesRL (Proxy :: Proxy userRowRL) rec
29953247
29963248-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
@@ -3002,6 +3254,7 @@ returning
30023254 . SingleTable tables name cols
30033255 => IsSymbol sel
30043256 => ParseSelect sel tables result
3257+ => HasMutation stage
30053258 => Row.Lacks "returning" stage
30063259 => Row.Lacks "select" stage
30073260 => Row.Cons "returning" Unit stage stage'
@@ -3013,6 +3266,7 @@ returningAll
30133266 :: forall tables name cols result p stage stage'
30143267 . SingleTable tables name cols
30153268 => StripColumns cols result
3269+ => HasMutation stage
30163270 => Row.Lacks "returning" stage
30173271 => Row.Lacks "select" stage
30183272 => Row.Cons "returning" Unit stage stage'
@@ -3055,8 +3309,10 @@ set
30553309 => ValidateSetColumnsRL setRL cols
30563310 => SetClauseRL setRL
30573311 => RecordValuesRL setRL setRow
3312+ => HasClause "update" stage
30583313 => Row.Lacks "select" stage
30593314 => Row.Lacks "insert" stage
3315+ => Row.Lacks "into" stage
30603316 => Row.Lacks "set" stage
30613317 => Row.Lacks "delete" stage
30623318 => Row.Cons "set" Unit stage stage'
@@ -3080,6 +3336,7 @@ delete
30803336 => IsSymbol name
30813337 => Row.Lacks "select" stage
30823338 => Row.Lacks "insert" stage
3339+ => Row.Lacks "into" stage
30833340 => Row.Lacks "set" stage
30843341 => Row.Lacks "delete" stage
30853342 => Row.Cons "delete" Unit stage stage'
@@ -3320,6 +3577,66 @@ exceptAll
33203577 -> Q tables1 result params SetOpStage
33213578exceptAll (Q q1) (Q q2) = Q { sql: "(" <> q1.sql <> ") EXCEPT ALL (" <> q2.sql <> ")", values: q1.values <> q2.values }
33223579
3580+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
3581+-- CTE (WITH clause) support
3582+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
3583+
3584+newtype WithCTEs :: Row (Row Type) -> Row Type -> Type
3585+newtype WithCTEs cteTables cteParams = WithCTEs
3586+ { sql :: String, values :: Array PG.PGValue }
3587+
3588+-- Wrap a complete SELECT query as a named CTE
3589+cte
3590+ :: forall @name tables result params stage cteTables
3591+ . IsSymbol name
3592+ => HasClause "select" stage
3593+ => Row.Cons name result () cteTables
3594+ => Q tables result params stage
3595+ -> WithCTEs cteTables params
3596+cte (Q q) = WithCTEs
3597+ { sql: reflectSymbol (Proxy :: Proxy name) <> " AS (" <> q.sql <> ")"
3598+ , values: q.values
3599+ }
3600+
3601+-- Add another named CTE to an accumulator
3602+andCTE
3603+ :: forall @name tables result params stage cteTables cteParams cteTables' cteParams'
3604+ . IsSymbol name
3605+ => HasClause "select" stage
3606+ => Row.Lacks name cteTables
3607+ => Row.Cons name result cteTables cteTables'
3608+ => Row.Union cteParams params cteParams'
3609+ => Row.Nub cteParams' cteParams'
3610+ => Q tables result params stage
3611+ -> WithCTEs cteTables cteParams
3612+ -> WithCTEs cteTables' cteParams'
3613+andCTE (Q q) (WithCTEs w) = WithCTEs
3614+ { sql: w.sql <> ", " <> reflectSymbol (Proxy :: Proxy name) <> " AS (" <> q.sql <> ")"
3615+ , values: w.values <> q.values
3616+ }
3617+
3618+-- Start main query FROM a named CTE; cteTables becomes available as tables
3619+fromCTE
3620+ :: forall @name result restTables cteTables cteParams
3621+ . IsSymbol name
3622+ => Row.Cons name result restTables cteTables
3623+ => WithCTEs cteTables cteParams
3624+ -> Q cteTables () () ()
3625+fromCTE _ = Q { sql: reflectSymbol (Proxy :: Proxy name), values: [] }
3626+
3627+-- Finalize: prepend WITH clause and merge params
3628+with_
3629+ :: forall cteTables cteParams mainParams allParams result stage
3630+ . Row.Union cteParams mainParams allParams
3631+ => Row.Nub allParams allParams
3632+ => WithCTEs cteTables cteParams
3633+ -> Q cteTables result mainParams stage
3634+ -> Q cteTables result allParams stage
3635+with_ (WithCTEs w) (Q q) = Q
3636+ { sql: "WITH " <> w.sql <> " " <> q.sql
3637+ , values: w.values <> q.values
3638+ }
3639+
33233640-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
33243641-- Query execution
33253642-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
@@ -3335,12 +3652,13 @@ instance
33353652 ( IsSymbol name
33363653 , Row.Cons name typ rest row
33373654 , Row.Lacks name rest
3655+ , FieldToPGValue typ
33383656 , ParamsToArray tail row
33393657 ) =>
33403658 ParamsToArray (RL.Cons name typ tail) row where
33413659 paramsToArray _ rec =
33423660 [ { name: reflectSymbol (Proxy :: Proxy name)
3343− , value: unsafeToForeign (Record.get (Proxy :: Proxy name) rec)
3661+ , value: unsafeCoerce (fieldToPGValue (Record.get (Proxy :: Proxy name) rec))
33443662 }
33453663 ]
33463664 <> paramsToArray (Proxy :: Proxy tail) rec
@@ -3454,6 +3772,7 @@ runExecuteTx txn params (Q q) = do
34543772 let allValues = q.values <> values
34553773 PG.txExecute (PG.SQL sql) allValues txn
34563774
3775+
34573776decodeRows :: forall a. ReadForeign a => Array Foreign -> Either (NonEmptyList ForeignError) (Array a)
34583777decodeRows = traverse (readImpl >>> runExcept)
34593778
test/Behavioral.jsnew file+8
@@ -0,0 +1,8 @@
1+export const poisonRollbackImpl = (transaction) => {
2+ const reserved = transaction._reserved;
3+ const rollbackFailure = () => {
4+ throw new Error("rollback finalizer failed");
5+ };
6+ rollbackFailure.release = () => reserved.release();
7+ transaction._reserved = rollbackFailure;
8+};
test/Behavioral.pursnew file+540
@@ -0,0 +1,540 @@
1+module Test.Postgres.Behavioral where
2+
3+import Prelude
4+
5+import Control.Parallel (parTraverse)
6+import Data.Array as Array
7+import Data.Date (canonicalDate)
8+import Data.DateTime (DateTime(..))
9+import Data.Either (Either(..))
10+import Data.Enum (toEnum)
11+import Data.Maybe (Maybe(..), fromJust)
12+import Data.Identity (Identity)
13+import Data.Time (Time(..))
14+import Data.Time.Duration (Milliseconds(..))
15+import Data.UUID as UUID
16+import Effect (Effect)
17+import Effect.Aff (Aff, delay, forkAff, killFiber, throwError, try)
18+import Effect.Class (liftEffect)
19+import Effect.Exception (error, message)
20+import Effect.Ref as Ref
21+import Effect.Uncurried (EffectFn1, runEffectFn1)
22+import Foreign (unsafeToForeign)
23+import JS.BigInt (BigInt)
24+import JS.BigInt as BigInt
25+import Partial.Unsafe (unsafePartial)
26+import Prim.Boolean (True)
27+import Test.Spec (Spec, SpecT, describe, it)
28+import Test.Spec.Assertions (shouldEqual, shouldSatisfy)
29+import Type.Function (type (#))
30+import Type.Proxy (Proxy(..))
31+import Yoga.Postgres as PG
32+import Yoga.Postgres.Schema as Schema
33+import Yoga.Postgres.TypedQuery as Typed
34+import Yoga.SQL.PostgresTypes (SQLQuery, arg, combineBuilders, int, sql, str)
35+
36+isLeft :: forall a b. Either a b -> Boolean
37+isLeft (Left _) = true
38+isLeft _ = false
39+
40+poisonRollback :: PG.Transaction -> Effect Unit
41+poisonRollback = runEffectFn1 poisonRollbackImpl
42+
43+foreign import poisonRollbackImpl :: EffectFn1 PG.Transaction Unit
44+
45+testConnection :: Effect PG.Connection
46+testConnection = PG.postgres
47+ { host: PG.PostgresHost "localhost"
48+ , port: PG.PostgresPort 5434
49+ , database: PG.PostgresDatabase "test_playground"
50+ , username: PG.PostgresUsername "postgres"
51+ , password: PG.PostgresPassword "postgres"
52+ }
53+
54+type BehaviorTable = Schema.Table "behavior_values"
55+ ( id :: Int # Schema.PrimaryKey # Schema.AutoIncrement
56+ , name :: String
57+ , optional_int :: Maybe Int
58+ )
59+
60+behaviorTable :: Proxy BehaviorTable
61+behaviorTable = Proxy
62+
63+type AllDefaultTable = Schema.Table "behavior_defaults"
64+ ( active :: Boolean # Schema.Default True
65+ , id :: Int # Schema.PrimaryKey # Schema.AutoIncrement
66+ )
67+
68+allDefaultTable :: Proxy AllDefaultTable
69+allDefaultTable = Proxy
70+
71+type TxTable = Schema.Table "behavior_tx"
72+ ( id :: Int # Schema.PrimaryKey # Schema.AutoIncrement
73+ , name :: String
74+ )
75+
76+txTable :: Proxy TxTable
77+txTable = Proxy
78+
79+type TemporalParamTable = Schema.Table "behavior_temporal"
80+ ( document :: Schema.Jsonb
81+ , event_at :: Schema.TimestampTZ
82+ , event_date :: Schema.PGDate
83+ , event_time :: Schema.PGTime
84+ , label :: String
85+ , uuid :: Schema.PGUUID
86+ , optional_event_at :: Maybe Schema.TimestampTZ
87+ )
88+
89+temporalParamTable :: Proxy TemporalParamTable
90+temporalParamTable = Proxy
91+
92+typedIntQuery :: SQLQuery (n :: Int)
93+typedIntQuery = sql $ combineBuilders (combineBuilders "SELECT " (int @"n")) "::int AS n"
94+
95+typedMaybeQuery :: SQLQuery (value :: Maybe Int)
96+typedMaybeQuery = sql $ combineBuilders (combineBuilders "SELECT " (arg @(Maybe Int) @"value")) "::int AS value"
97+
98+typedBadDecodeQuery :: SQLQuery ()
99+typedBadDecodeQuery = sql $ combineBuilders "SELECT 'not-an-int' AS n" ""
100+
101+typedMutationQuery :: SQLQuery (name :: String)
102+typedMutationQuery = sql $ combineBuilders (combineBuilders "INSERT INTO behavior_values (name) VALUES (" (str @"name")) ")"
103+
104+expectedDate :: Schema.PGDate
105+expectedDate = unsafePartial do
106+ let year = fromJust (toEnum 2025)
107+ let month = fromJust (toEnum 6)
108+ let day = fromJust (toEnum 15)
109+ Schema.PGDate (canonicalDate year month day)
110+
111+expectedTime :: Schema.PGTime
112+expectedTime = unsafePartial do
113+ let hour = fromJust (toEnum 14)
114+ let minute = fromJust (toEnum 30)
115+ let second = fromJust (toEnum 45)
116+ let millisecond = fromJust (toEnum 125)
117+ Schema.PGTime (Time hour minute second millisecond)
118+
119+expectedHalfSecondTime :: Schema.PGTime
120+expectedHalfSecondTime = unsafePartial do
121+ let hour = fromJust (toEnum 14)
122+ let minute = fromJust (toEnum 30)
123+ let second = fromJust (toEnum 45)
124+ let millisecond = fromJust (toEnum 500)
125+ Schema.PGTime (Time hour minute second millisecond)
126+
127+expectedTimestamp :: Schema.TimestampTZ
128+expectedTimestamp = unsafePartial do
129+ let year = fromJust (toEnum 2025)
130+ let month = fromJust (toEnum 1)
131+ let day = fromJust (toEnum 15)
132+ let hour = fromJust (toEnum 12)
133+ let minute = fromJust (toEnum 0)
134+ let second = fromJust (toEnum 0)
135+ let millisecond = fromJust (toEnum 0)
136+ Schema.TimestampTZ (DateTime (canonicalDate year month day) (Time hour minute second millisecond))
137+
138+setupBehaviorTable :: PG.Connection -> Aff Unit
139+setupBehaviorTable conn = do
140+ _ <- PG.executeSimple (PG.SQL "DROP TABLE IF EXISTS behavior_values") conn
141+ _ <- PG.executeSimple (PG.SQL (Schema.createTableDDL @BehaviorTable)) conn
142+ pure unit
143+
144+setupTxTable :: PG.Connection -> Aff Unit
145+setupTxTable conn = do
146+ _ <- PG.executeSimple (PG.SQL "DROP TABLE IF EXISTS behavior_tx") conn
147+ _ <- PG.executeSimple (PG.SQL (Schema.createTableDDL @TxTable)) conn
148+ pure unit
149+
150+setupTemporalParamTable :: PG.Connection -> Aff Unit
151+setupTemporalParamTable conn = do
152+ _ <- PG.executeSimple (PG.SQL "DROP TABLE IF EXISTS behavior_temporal") conn
153+ _ <- PG.executeSimple (PG.SQL (Schema.createTableDDL @TemporalParamTable)) conn
154+ pure unit
155+
156+pureSpec :: Spec Unit
157+pureSpec = do
158+ describe "Postgres schema metadata and deterministic SQL" do
159+ it "renders every public scalar, array, and nullable type name" do
160+ Schema.pgTypeName (Proxy :: Proxy Int) `shouldEqual` "INTEGER"
161+ Schema.pgTypeName (Proxy :: Proxy String) `shouldEqual` "TEXT"
162+ Schema.pgTypeName (Proxy :: Proxy Boolean) `shouldEqual` "BOOLEAN"
163+ Schema.pgTypeName (Proxy :: Proxy Number) `shouldEqual` "DOUBLE PRECISION"
164+ Schema.pgTypeName (Proxy :: Proxy BigInt) `shouldEqual` "BIGINT"
165+ Schema.pgTypeName (Proxy :: Proxy Schema.PGUUID) `shouldEqual` "UUID"
166+ Schema.pgTypeName (Proxy :: Proxy Schema.PGDate) `shouldEqual` "DATE"
167+ Schema.pgTypeName (Proxy :: Proxy Schema.PGTime) `shouldEqual` "TIME"
168+ Schema.pgTypeName (Proxy :: Proxy Schema.TimestampTZ) `shouldEqual` "TIMESTAMPTZ"
169+ Schema.pgTypeName (Proxy :: Proxy Schema.Point) `shouldEqual` "POINT"
170+ Schema.pgTypeName (Proxy :: Proxy Schema.TSVector) `shouldEqual` "TSVECTOR"
171+ Schema.pgTypeName (Proxy :: Proxy Schema.TSQuery) `shouldEqual` "TSQUERY"
172+ Schema.pgTypeName (Proxy :: Proxy Schema.Jsonb) `shouldEqual` "JSONB"
173+ Schema.pgTypeName (Proxy :: Proxy (Array Int)) `shouldEqual` "INTEGER[]"
174+ Schema.pgTypeName (Proxy :: Proxy (Maybe Int)) `shouldEqual` "INTEGER"
175+
176+ it "reports nullability from Maybe only" do
177+ Schema.isNullable (Proxy :: Proxy (Maybe Int)) `shouldEqual` true
178+ Schema.isNullable (Proxy :: Proxy Int) `shouldEqual` false
179+
180+ it "renders IF NOT EXISTS and DEFAULT VALUES DDL" do
181+ Schema.createTableDDLIfNotExists @BehaviorTable
182+ `shouldEqual` "CREATE TABLE IF NOT EXISTS behavior_values (id INTEGER NOT NULL GENERATED ALWAYS AS IDENTITY PRIMARY KEY, name TEXT NOT NULL, optional_int INTEGER)"
183+ Schema.insertSQLFor @AllDefaultTable
184+ `shouldEqual` "INSERT INTO behavior_defaults DEFAULT VALUES RETURNING *"
185+ (Schema.into allDefaultTable # Schema.insert {} # Schema.toSQL)
186+ `shouldEqual` "INSERT INTO behavior_defaults DEFAULT VALUES"
187+
188+ it "renders update entrypoint and all set-operation variants" do
189+ (Schema.update behaviorTable # Schema.set { name: "updated" } # Schema.where_ @"id = $id" # Schema.toSQL)
190+ `shouldEqual` "UPDATE behavior_values SET name = $1 WHERE id = $id"
191+ let left = Schema.from behaviorTable # Schema.select @"name"
192+ let right = Schema.from behaviorTable # Schema.select @"name"
193+ (left `Schema.intersectAll` right # Schema.toSQL)
194+ `shouldEqual` "(SELECT name FROM behavior_values) INTERSECT ALL (SELECT name FROM behavior_values)"
195+ (left `Schema.exceptAll` right # Schema.toSQL)
196+ `shouldEqual` "(SELECT name FROM behavior_values) EXCEPT ALL (SELECT name FROM behavior_values)"
197+
198+ it "renders CTEs and merges their named parameters" do
199+ let adults = Schema.cte @"adults" (Schema.from behaviorTable # Schema.select @"name" # Schema.where_ @"optional_int > $age")
200+ let mainQuery = Schema.fromCTE @"adults" adults # Schema.select @"name"
201+ (Schema.with_ adults mainQuery # Schema.toSQL)
202+ `shouldEqual` "WITH adults AS (SELECT name FROM behavior_values WHERE optional_int > $age) SELECT name FROM adults"
203+
204+ it "replaces repeated named parameters and preserves casts" do
205+ let replaced = Schema.replaceNamedParams 2
206+ [ { name: "id", value: unsafeToForeign 7 }
207+ , { name: "name", value: unsafeToForeign "Alice" }
208+ ]
209+ "id = $id::int OR parent_id = $id AND name = $name"
210+ replaced.sql `shouldEqual` "id = $3 OR parent_id = $3 AND name = $4"
211+ Array.length replaced.values `shouldEqual` 2
212+ Schema.stripCast "$id::uuid" `shouldEqual` "$id"
213+
214+ it "decodes rows and rejects mismatched result shapes" do
215+ let decoded = Schema.decodeRows
216+ [ unsafeToForeign { id: 1, name: "ok" }
217+ , unsafeToForeign { id: 2, name: "also ok" }
218+ ] :: Either _ (Array { id :: Int, name :: String })
219+ decoded `shouldEqual` Right [ { id: 1, name: "ok" }, { id: 2, name: "also ok" } ]
220+ let bad = Schema.decodeRow (unsafeToForeign { id: "wrong" }) :: Either _ { id :: Int }
221+ bad `shouldSatisfy` isLeft
222+ let fractionalTime = Schema.decodeRow (unsafeToForeign { value: "14:30:45.5" }) :: Either _ { value :: Schema.PGTime }
223+ fractionalTime `shouldEqual` Right { value: expectedHalfSecondTime }
224+
225+integrationSpec :: SpecT Aff PG.Connection Identity Unit
226+integrationSpec = do
227+ describe "How to use the public Postgres API" do
228+ it "reports query metadata and preserves heterogeneous and homogeneous parameters" \conn -> do
229+ result <- PG.query
230+ (PG.SQL "SELECT $1::int AS minimum, $2::int AS maximum, $3::double precision AS huge, $4::text AS first, $5::text AS second, $6::int[] AS integers")
231+ ( PG.param (bottom :: Int)
232+ <> PG.param (top :: Int)
233+ <> PG.param 1.5e200
234+ <> PG.params [ "first", "second" ]
235+ <> PG.param [ bottom :: Int, top :: Int ]
236+ )
237+ conn
238+ result.command `shouldEqual` "SELECT"
239+ result.count `shouldEqual` 1
240+ case Schema.decodeRows result.rows of
241+ Left errs -> throwError (error (show errs))
242+ Right rows -> rows `shouldEqual`
243+ [ { minimum: bottom :: Int
244+ , maximum: top :: Int
245+ , huge: 1.5e200
246+ , first: "first"
247+ , second: "second"
248+ , integers: [ bottom :: Int, top :: Int ]
249+ }
250+ ]
251+
252+ it "round-trips UUID, JSON, date, time, timestamp, arrays, and bigint rows" \conn -> do
253+ uuid <- liftEffect UUID.genUUID
254+ result <- PG.query
255+ (PG.SQL "SELECT $1::uuid AS uuid, $2::jsonb AS document, $3::date AS event_date, $4::time AS event_time, $5::timestamptz AS event_at, $6::text[] AS tags, $7::bigint AS big")
256+ [ PG.toPGValue uuid
257+ , PG.toPGValue (unsafeToForeign { key: "value", nested: { count: 2 } })
258+ , PG.toPGValue "2025-06-15"
259+ , PG.toPGValue "14:30:45.125"
260+ , PG.toPGValue "2025-01-15T12:00:00.000Z"
261+ , PG.toPGValue [ "a", "b" ]
262+ , PG.toPGValue "9223372036854775807"
263+ ]
264+ conn
265+ case Schema.decodeRows result.rows of
266+ Left errs -> throwError (error (show errs))
267+ Right rows -> rows `shouldEqual`
268+ [ { uuid: Schema.PGUUID uuid
269+ , document: { key: "value", nested: { count: 2 } }
270+ , event_date: expectedDate
271+ , event_time: expectedTime
272+ , event_at: expectedTimestamp
273+ , tags: [ "a", "b" ]
274+ , big: BigInt.fromString "9223372036854775807" # unsafePartial fromJust
275+ }
276+ ]
277+
278+ it "distinguishes query-one, unsafe exact-row, and no-row behavior" \conn -> do
279+ one <- PG.queryOneSimple (PG.SQL "SELECT 41::int AS value") conn
280+ case one of
281+ Nothing -> throwError (error "expected queryOneSimple row")
282+ Just row -> Schema.decodeRow row `shouldEqual` Right { value: 41 }
283+ exact <- PG.unsafe (PG.SQL "SELECT $1::int AS value") [ PG.toPGValue 42 ] conn
284+ Schema.decodeRow exact `shouldEqual` Right { value: 42 }
285+ missing <- PG.queryOneSimple (PG.SQL "SELECT 1 WHERE false") conn
286+ case missing of
287+ Nothing -> pure unit
288+ Just _ -> throwError (error "expected queryOneSimple to return Nothing")
289+ unsafeMissing <- try $ PG.unsafe (PG.SQL "SELECT 1 WHERE false") [] conn
290+ case unsafeMissing of
291+ Left _ -> pure unit
292+ Right _ -> throwError (error "expected unsafe to reject an empty result")
293+
294+ it "returns affected rows including zero matches" \conn -> do
295+ setupBehaviorTable conn
296+ inserted <- PG.execute (PG.SQL "INSERT INTO behavior_values (name) VALUES ($1), ($2)") (PG.params [ "a", "b" ]) conn
297+ inserted `shouldEqual` 2
298+ updated <- PG.execute (PG.SQL "UPDATE behavior_values SET name = $1 WHERE name = $2") (PG.params [ "updated", "missing" ]) conn
299+ updated `shouldEqual` 0
300+ deleted <- PG.executeSimple (PG.SQL "DELETE FROM behavior_values") conn
301+ deleted `shouldEqual` 2
302+
303+ it "executes typed queries, Maybe parameters, raw results, mutations, and decode errors" \conn -> do
304+ setupBehaviorTable conn
305+ rows <- (Typed.executeSql typedIntQuery { n: 7 } conn :: Aff (Either String (Array { n :: Int })))
306+ rows `shouldEqual` Right [ { n: 7 } ]
307+ nullable <- (Typed.executeSql typedMaybeQuery { value: Nothing } conn :: Aff (Either String (Array { value :: Maybe Int })))
308+ nullable `shouldEqual` Right [ { value: Nothing } ]
309+ raw <- Typed.executeSqlRaw typedIntQuery { n: 8 } conn
310+ raw.count `shouldEqual` 1
311+ one <- (Typed.executeSqlOne typedIntQuery { n: 9 } conn :: Aff (Either String (Maybe { n :: Int })))
312+ one `shouldEqual` Right (Just { n: 9 })
313+ noRows <- (Typed.executeSqlOne (sql $ combineBuilders "SELECT 1::int AS n WHERE false" "") {} conn :: Aff (Either String (Maybe { n :: Int })))
314+ noRows `shouldEqual` Right (Nothing :: Maybe { n :: Int })
315+ many <- (Typed.executeSqlOne (sql $ combineBuilders "SELECT generate_series(1, 2)::int AS n" "") {} conn :: Aff (Either String (Maybe { n :: Int })))
316+ many `shouldEqual` Right (Nothing :: Maybe { n :: Int })
317+ bad <- (Typed.executeSql typedBadDecodeQuery {} conn :: Aff (Either String (Array { n :: Int })))
318+ bad `shouldSatisfy` isLeft
319+ affected <- Typed.executeMutation typedMutationQuery { name: "typed" } conn
320+ affected `shouldEqual` 1
321+
322+ it "uses schema wrappers as typed query parameters" \conn -> do
323+ setupTemporalParamTable conn
324+ uuid <- liftEffect UUID.genUUID
325+ let pgUuid = Schema.PGUUID uuid
326+ let document = unsafeToForeign { key: "value", nested: { count: 2 } }
327+ _ <- PG.execute
328+ (PG.SQL "INSERT INTO behavior_temporal (document, event_at, event_date, event_time, label, uuid) VALUES ($1, $2, $3, $4, $5, $6)")
329+ [ PG.toPGValue document
330+ , PG.toPGValue "2025-01-15T12:00:00.000Z"
331+ , PG.toPGValue "2025-06-15"
332+ , PG.toPGValue "14:30:45.125"
333+ , PG.toPGValue "matched"
334+ , PG.toPGValue (UUID.toString uuid)
335+ ]
336+ conn
337+ byDate <- Schema.from temporalParamTable
338+ # Schema.select @"label"
339+ # Schema.where_ @"event_date = $date"
340+ # Schema.runQuery conn { date: expectedDate }
341+ byTime <- Schema.from temporalParamTable
342+ # Schema.select @"label"
343+ # Schema.where_ @"event_time = $time"
344+ # Schema.runQuery conn { time: expectedTime }
345+ byTimestamp <- Schema.from temporalParamTable
346+ # Schema.select @"label"
347+ # Schema.where_ @"event_at = $timestamp"
348+ # Schema.runQuery conn { timestamp: expectedTimestamp }
349+ byDocument <- Schema.from temporalParamTable
350+ # Schema.select @"label"
351+ # Schema.where_ @"document @> $document"
352+ # Schema.runQuery conn { document: Schema.Jsonb document }
353+ byDate `shouldEqual` [ { label: "matched" } ]
354+ byTime `shouldEqual` [ { label: "matched" } ]
355+ byTimestamp `shouldEqual` [ { label: "matched" } ]
356+ byDocument `shouldEqual` [ { label: "matched" } ]
357+ inserted <- Schema.into temporalParamTable
358+ # Schema.insert
359+ { document: Schema.Jsonb document
360+ , event_at: expectedTimestamp
361+ , event_date: expectedDate
362+ , event_time: expectedTime
363+ , label: "typed"
364+ , uuid: pgUuid
365+ }
366+ # Schema.runExecute conn {}
367+ inserted `shouldEqual` 1
368+ allRows <- PG.querySimple (PG.SQL "SELECT label FROM behavior_temporal ORDER BY label") conn
369+ decoded <- case Schema.decodeRows allRows.rows of
370+ Left errs -> throwError (error (show errs))
371+ Right values -> pure values
372+ decoded `shouldEqual` [ { label: "matched" }, { label: "typed" } ]
373+
374+ it "converts Just values through the inner field encoder" \conn -> do
375+ setupTemporalParamTable conn
376+ uuid <- liftEffect UUID.genUUID
377+ let document = unsafeToForeign { key: "nullable timestamp" }
378+ inserted <- Schema.into temporalParamTable
379+ # Schema.insert
380+ { document: Schema.Jsonb document
381+ , event_at: expectedTimestamp
382+ , event_date: expectedDate
383+ , event_time: expectedTime
384+ , label: "nullable"
385+ , optional_event_at: Just expectedTimestamp
386+ , uuid: Schema.PGUUID uuid
387+ }
388+ # Schema.runExecute conn {}
389+ inserted `shouldEqual` 1
390+ rows <- Schema.from temporalParamTable
391+ # Schema.select @"optional_event_at"
392+ # Schema.runQuery conn {}
393+ rows `shouldEqual` [ { optional_event_at: Just expectedTimestamp } ]
394+
395+ it "use begin/commit/rollback when transaction boundaries are explicit" \conn -> do
396+ setupTxTable conn
397+ committed <- PG.begin conn
398+ _ <- PG.txExecute (PG.SQL "INSERT INTO behavior_tx (name) VALUES ($1)") [ PG.toPGValue "committed" ] committed
399+ inTransaction <- PG.txQuery (PG.SQL "SELECT name FROM behavior_tx WHERE name = $1") [ PG.toPGValue "committed" ] committed
400+ inTransaction.count `shouldEqual` 1
401+ PG.commit committed
402+ afterCommit <- PG.querySimple (PG.SQL "SELECT name FROM behavior_tx") conn
403+ afterCommit.count `shouldEqual` 1
404+
405+ rolledBack <- PG.begin conn
406+ _ <- PG.txExecute (PG.SQL "INSERT INTO behavior_tx (name) VALUES ($1)") [ PG.toPGValue "rolled back" ] rolledBack
407+ PG.rollback rolledBack
408+ afterRollback <- PG.querySimple (PG.SQL "SELECT name FROM behavior_tx") conn
409+ afterRollback.count `shouldEqual` 1
410+
411+
412+ it "let transaction roll back SQL errors and return the connection to the pool" \conn -> do
413+ setupTxTable conn
414+ result <- try $ PG.withTransaction (\txn -> do
415+ _ <- PG.txExecute (PG.SQL "INSERT INTO behavior_tx (name) VALUES ($1)") [ PG.toPGValue "before error" ] txn
416+ _ <- PG.txExecute (PG.SQL "INSERT INTO missing_behavior_table VALUES ($1)") [ PG.toPGValue 1 ] txn
417+ pure unit
418+ ) conn
419+ result `shouldSatisfy` isLeft
420+ rows <- PG.querySimple (PG.SQL "SELECT * FROM behavior_tx") conn
421+ rows.count `shouldEqual` 0
422+ PG.ping conn >>= (_ `shouldEqual` true)
423+
424+ it "preserves the action failure when rollback also fails" \conn -> do
425+ result <- try $ PG.withTransaction
426+ (\txn -> do
427+ liftEffect $ poisonRollback txn
428+ throwError (error "action failed")
429+ )
430+ conn
431+ case result of
432+ Left cause -> message cause `shouldEqual` "action failed"
433+ Right _ -> throwError (error "expected transaction to fail")
434+ PG.ping conn >>= (_ `shouldEqual` true)
435+
436+ it "let transaction roll back cancellation and return the connection to the pool" \conn -> do
437+ setupTxTable conn
438+ wrote <- liftEffect $ Ref.new false
439+ fiber <- forkAff $ PG.withTransaction
440+ (\txn -> do
441+ _ <- PG.txExecute
442+ (PG.SQL "INSERT INTO behavior_tx (name) VALUES ($1)")
443+ [ PG.toPGValue "cancelled" ]
444+ txn
445+ liftEffect $ Ref.write true wrote
446+ delay (Milliseconds 10000.0)
447+ )
448+ conn
449+ delay (Milliseconds 50.0)
450+ didWrite <- liftEffect $ Ref.read wrote
451+ didWrite `shouldEqual` true
452+ killFiber (error "cancel transaction") fiber
453+ rows <- PG.querySimple (PG.SQL "SELECT * FROM behavior_tx") conn
454+ rows.count `shouldEqual` 0
455+ PG.ping conn >>= (_ `shouldEqual` true)
456+
457+ it "releases the reserved connection when commit itself fails" \_ -> do
458+ own <- liftEffect $ PG.postgres
459+ { host: PG.PostgresHost "localhost"
460+ , port: PG.PostgresPort 5434
461+ , database: PG.PostgresDatabase "test_playground"
462+ , username: PG.PostgresUsername "postgres"
463+ , password: PG.PostgresPassword "postgres"
464+ , max: PG.MaxConnections 1
465+ }
466+ _ <- PG.executeSimple (PG.SQL "DROP TABLE IF EXISTS behavior_commit_failure") own
467+ _ <- PG.executeSimple
468+ (PG.SQL "CREATE TABLE behavior_commit_failure (name TEXT UNIQUE DEFERRABLE INITIALLY DEFERRED)")
469+ own
470+ txn <- PG.begin own
471+ _ <- PG.txExecute
472+ (PG.SQL "INSERT INTO behavior_commit_failure (name) VALUES ($1), ($2)")
473+ [ PG.toPGValue "duplicate", PG.toPGValue "duplicate" ]
474+ txn
475+ commitResult <- try $ PG.commit txn
476+ commitResult `shouldSatisfy` isLeft
477+ PG.ping own >>= (_ `shouldEqual` true)
478+ PG.end own
479+
480+
481+ it "supports deterministic concurrent pool queries" \conn -> do
482+ setupBehaviorTable conn
483+ counts <- parTraverse
484+ (\n -> PG.execute (PG.SQL "INSERT INTO behavior_values (name) VALUES ($1)") [ PG.toPGValue ("worker-" <> show n) ] conn)
485+ (Array.range 1 8)
486+ counts `shouldEqual` Array.replicate 8 1
487+ rows <- PG.querySimple (PG.SQL "SELECT * FROM behavior_values") conn
488+ rows.count `shouldEqual` 8
489+
490+ it "delivers notifications and actually unsubscribes" \conn -> do
491+ received <- liftEffect $ Ref.new ([] :: Array String)
492+ let channel = PG.Channel "behavior_notifications"
493+ PG.listen channel (\notification -> Ref.modify_ (_ <> [ notification.payload ]) received) conn
494+ PG.notify channel "before-unlisten" conn
495+ delay (Milliseconds 100.0)
496+ liftEffect (Ref.read received) >>= (_ `shouldEqual` [ "before-unlisten" ])
497+ PG.unlisten channel conn
498+ PG.notify channel "after-unlisten" conn
499+ delay (Milliseconds 100.0)
500+ liftEffect (Ref.read received) >>= (_ `shouldEqual` [ "before-unlisten" ])
501+
502+ it "rejects missing and deallocated prepared statements" \conn -> do
503+ setupBehaviorTable conn
504+ let name = PG.StatementName "behavior_insert"
505+ missing <- try $ PG.executePrepared name [ PG.toPGValue "x" ] conn
506+ case missing of
507+ Left _ -> pure unit
508+ Right _ -> throwError (error "expected missing prepared statement to fail")
509+ PG.prepare name (PG.SQL "INSERT INTO behavior_values (name) VALUES ($1)") conn
510+ PG.executePrepared name [ PG.toPGValue "prepared" ] conn >>= (_.count >>> (_ `shouldEqual` 1))
511+ PG.deallocate name conn
512+ deallocated <- try $ PG.executePrepared name [ PG.toPGValue "again" ] conn
513+ case deallocated of
514+ Left _ -> pure unit
515+ Right _ -> throwError (error "expected deallocated prepared statement to fail")
516+
517+ it "invokes notice and parameter callbacks as PureScript Effects" \_ -> do
518+ noticeSeen <- liftEffect $ Ref.new false
519+ parameterSeen <- liftEffect $ Ref.new false
520+ callbackConn <- liftEffect $ PG.postgres
521+ { host: PG.PostgresHost "localhost"
522+ , port: PG.PostgresPort 5434
523+ , database: PG.PostgresDatabase "test_playground"
524+ , username: PG.PostgresUsername "postgres"
525+ , password: PG.PostgresPassword "postgres"
526+ , onnotice: Ref.write true noticeSeen
527+ , onparameter: \_ -> Ref.write true parameterSeen
528+ }
529+ _ <- PG.executeSimple (PG.SQL "DO $$ BEGIN RAISE NOTICE 'behavior callback'; END $$") callbackConn
530+ _ <- PG.executeSimple (PG.SQL "SET application_name TO 'yoga-postgres-callback-test'") callbackConn
531+ liftEffect (Ref.read noticeSeen) >>= (_ `shouldEqual` true)
532+ liftEffect (Ref.read parameterSeen) >>= (_ `shouldEqual` true)
533+ PG.end callbackConn
534+
535+ it "connects via connection string and end closes the pool" \_ -> do
536+ own <- liftEffect $ PG.postgres
537+ { connection: PG.ConnectionString "postgres://postgres:postgres@localhost:5434/test_playground" }
538+ PG.ping own >>= (_ `shouldEqual` true)
539+ PG.end own
540+ PG.ping own >>= (_ `shouldEqual` false)
test/Integration.purs+1−1
@@ -15,7 +15,7 @@ main :: Effect Unit
1515main = launchAff_ do
1616 conn <- liftEffect $ PG.postgres
1717 { host: PG.PostgresHost "localhost"
18− , port: PG.PostgresPort 5433
18+ , port: PG.PostgresPort 5434
1919 , database: PG.PostgresDatabase "test_playground"
2020 , username: PG.PostgresUsername "postgres"
2121 , password: PG.PostgresPassword "postgres"
test/Main.purs+15−8
@@ -4,6 +4,7 @@ import Prelude
44
55import Data.Either (Either(..))
66import Data.Maybe (Maybe(..))
7+import Data.Time.Duration (Milliseconds(..))
78import Effect (Effect)
89import Effect.Aff (Aff, bracket, launchAff_, throwError, try)
910import Effect.Class (liftEffect)
@@ -11,6 +12,7 @@ import Effect.Console (log)
1112import Effect.Exception (error)
1213import Test.Spec (Spec, around, describe, it)
1314import Test.Spec.Assertions (shouldEqual, shouldSatisfy)
15+import Test.Postgres.Behavioral as Behavioral
1416import Test.Spec.Reporter.Console (consoleReporter)
1517import Test.Spec.Runner (runSpec)
1618import Yoga.Test.Docker as Docker
@@ -22,7 +24,7 @@ testHost :: PG.PostgresHost
2224testHost = PG.PostgresHost "localhost"
2325
2426testPort :: PG.PostgresPort
25−testPort = PG.PostgresPort 5433 -- Test port from docker-compose.test.yml
27+testPort = PG.PostgresPort 5434 -- Test port from docker-compose.test.yml
2628
2729testDatabase :: PG.PostgresDatabase
2830testDatabase = PG.PostgresDatabase "test_playground"
@@ -93,6 +95,11 @@ setupTableWithConstraints conn = do
9395spec :: Spec Unit
9496spec = do
9597 Schema.spec
98+ Behavioral.pureSpec
99+
100+ around withPostgres do
101+ Behavioral.integrationSpec
102+
96103
97104 describe "Yoga.Postgres Integration Tests" do
98105
@@ -106,7 +113,7 @@ spec = do
106113 it "retrieves connection options" \conn -> do
107114 opts <- liftEffect $ PG.options conn
108115 opts.host `shouldSatisfy` (_ /= "")
109− opts.port `shouldEqual` 5433
116+ opts.port `shouldEqual` 5434
110117 opts.database `shouldEqual` "test_playground"
111118
112119 describe "Connection Errors" do
@@ -233,7 +240,7 @@ spec = do
233240 it "commits transactions successfully" \conn -> do
234241 setupTestTable conn
235242
236− _ <- PG.transaction
243+ _ <- PG.withTransaction
237244 ( \txn -> do
238245 _ <- PG.txExecute (PG.SQL "INSERT INTO test_users (name) VALUES ($1)")
239246 [ PG.toPGValue "Henry" ]
@@ -251,12 +258,12 @@ spec = do
251258 it "rolls back on errors" \conn -> do
252259 setupTestTable conn
253260
254− result <- try $ PG.transaction
261+ result <- try $ PG.withTransaction
255262 ( \txn -> do
256263 _ <- PG.txExecute (PG.SQL "INSERT INTO test_users (name) VALUES ($1)")
257264 [ PG.toPGValue "Jack" ]
258265 txn
259− throwError (error "Intentional error")
266+ (throwError (error "Intentional error") :: Aff Unit)
260267 )
261268 conn
262269
@@ -268,7 +275,7 @@ spec = do
268275 it "queries within transaction" \conn -> do
269276 setupTestTable conn
270277
271− _ <- PG.transaction
278+ _ <- PG.withTransaction
272279 ( \txn -> do
273280 _ <- PG.txExecute (PG.SQL "INSERT INTO test_users (name) VALUES ($1)")
274281 [ PG.toPGValue "Leo" ]
@@ -433,11 +440,11 @@ main = launchAff_ do
433440 bracket
434441 ( do
435442 liftEffect $ log "Starting Postgres and waiting for it to be ready..."
436− Docker.startService "docker-compose.test.yml" 30
443+ Docker.startService (Docker.ComposeFile "docker-compose.test.yml") (Docker.Timeout (Milliseconds 30000.0))
437444 liftEffect $ log "Postgres is ready!\n"
438445 )
439446 ( \_ -> do
440− Docker.stopService "docker-compose.test.yml"
447+ Docker.stopService (Docker.ComposeFile "docker-compose.test.yml")
441448 liftEffect $ log "Cleanup complete\n"
442449 )
443450 (\_ -> runSpec [ consoleReporter ] spec)
test/Schema.purs+6−6
@@ -232,15 +232,15 @@ typedInsertReturning = from usersTable
232232
233233typedSet
234234 :: Q _ () () _
235−typedSet = from usersTable # set { name: "Bob" }
235+typedSet = update usersTable # set { name: "Bob" }
236236
237237typedSetWhere
238238 :: Q _ () (id :: Int) _
239−typedSetWhere = from usersTable # set { name: "Bob" } # where_ @"id = $id"
239+typedSetWhere = update usersTable # set { name: "Bob" } # where_ @"id = $id"
240240
241241typedSetReturning
242242 :: Q _ (id :: Int, name :: String, email :: String) (id :: Int) _
243−typedSetReturning = from usersTable
243+typedSetReturning = update usersTable
244244 # set { name: "Bob" }
245245 # where_ @"id = $id"
246246 # returning @"id, name, email"
@@ -771,7 +771,7 @@ spec = do
771771 it "renders DEFAULT in DDL" do
772772 configDDL `shouldEqual` "CREATE TABLE config (active BOOLEAN NOT NULL DEFAULT true, id INTEGER NOT NULL GENERATED ALWAYS AS IDENTITY PRIMARY KEY, role TEXT NOT NULL DEFAULT 'user', score INTEGER NOT NULL DEFAULT 0)"
773773 it "skips Default columns in INSERT" do
774− configInsertSQL `shouldEqual` "INSERT INTO config () VALUES () RETURNING *"
774+ configInsertSQL `shouldEqual` "INSERT INTO config DEFAULT VALUES RETURNING *"
775775
776776 describe "UUID + DefaultExpr" do
777777 it "renders UUID and DefaultExpr in DDL" do
@@ -1070,7 +1070,7 @@ integrationSpec conn = do
10701070 describe "Builder update execution" do
10711071 it "updates a row" do
10721072 resetUsers conn
1073− count <- from usersTable
1073+ count <- update usersTable
10741074 # set { email: "alice-updated@example.com" }
10751075 # where_ @"name = $name"
10761076 # runExecute conn { name: "Alice" }
@@ -1082,7 +1082,7 @@ integrationSpec conn = do
10821082 result `shouldEqual` Just { email: "alice-updated@example.com" }
10831083
10841084 it "updates with RETURNING" do
1085− rows <- from usersTable
1085+ rows <- update usersTable
10861086 # set { age: Just 99 }
10871087 # where_ @"name = $name"
10881088 # returning @"name, age"