c4bbae5...main · rowtype-yoga/purescript-yoga-postgres

git.iko.soy/rowtype-yoga/purescript-yoga-postgres

on main help sign in

.github/workflows/ci.yml+6−1

since splitsnapshots

unifiedsplit

@@ -6,4 +6,9 @@ jobs:

6 steps:

7 - uses: actions/checkout@v4

8 - uses: rowtype-yoga/purescript-yoga-actions/.github/actions/setup@main

9+ - run: bun install --frozen-lockfile

10+ - run: docker compose -f docker-compose.test.yml up -d --wait postgres

9− - run: spago build

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

.gitignore+1

@@ -3,3 +3,4 @@ node_modules/

3output/

4output-*/

5.DS_Store

6+.psc-ide-port

.psc-ide-port+1−1

@@ -1 +1 @@

1−15245

1+15490

bun.lock+3

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

6 "dependencies": {

7 "pg": "^8.11.0",

8 "postgres": "^3.4.8",

9+ "uuid": "^13.0.0",

9 },

10 },

11 },

12 },

@@ -38,6 +39,8 @@

39 "split2": ["split2@4.2.0", "", {}, "sha512-UcjcJOWknrNkF6PLX83qcHM6KHgVKNkV62Y8a5uYDVv9ydGQVwAHMKqHdJje1VTWpljG0WYpCDhrCdAOYH4TWg=="],

40 "split2": ["split2@4.2.0", "", {}, "sha512-UcjcJOWknrNkF6PLX83qcHM6KHgVKNkV62Y8a5uYDVv9ydGQVwAHMKqHdJje1VTWpljG0WYpCDhrCdAOYH4TWg=="],

42+ "uuid": ["uuid@13.0.0", "", { "bin": { "uuid": "dist-node/bin/uuid" } }, "sha512-XQegIaBTVUjSHliKqcnFqYypAd4S+WCYt5NIeRs6w/UAry7z8Y9j5ZwRRL4kzq9U3sD6v+85er9FvkEaBpji2w=="],

43+

41 "xtend": ["xtend@4.0.2", "", {}, "sha512-LKYU1iAXJXUgAXn9URjiu+MWhyUXHsvfp7mcuYm9dSUKK0/CjtrUwFAxD82/mCWbtLsGjFIad0wIsod4zrTAEQ=="],

44 "xtend": ["xtend@4.0.2", "", {}, "sha512-LKYU1iAXJXUgAXn9URjiu+MWhyUXHsvfp7mcuYm9dSUKK0/CjtrUwFAxD82/mCWbtLsGjFIad0wIsod4zrTAEQ=="],

42 }

45 }

43}

46}

compile-fail-tests/OnConflictBadExcluded.purs+3−2

@@ -1,4 +1,4 @@

1−-- EXPECT: Expected

1+-- EXPECT: TypesDoNotUnify

2module Test.CompileFail.OnConflictBadExcluded where

4import Prelude

@@ -17,4 +17,5 @@ type UsersTable = Table "users"

17usersTable :: Proxy UsersTable

18usersTable = Proxy

20+-- ON CONFLICT target column must exist in the table

20−bad = from usersTable # insert { name: "A", email: "a@b.com" } # onConflict @"email" @"DO UPDATE SET name = EXCLUDED.bogus"

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

4+import Prelude

5+import Type.Function (type (#))

6+import Type.Proxy (Proxy(..))

7+import Yoga.Postgres.Schema

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.ymlnew file+14

@@ -0,0 +1,14 @@

1+services:

2+ postgres:

3+ image: postgres:17

4+ environment:

5+ POSTGRES_USER: postgres

6+ POSTGRES_PASSWORD: postgres

7+ POSTGRES_DB: test_playground

8+ ports:

9+ - "5434:5432"

10+ healthcheck:

11+ test: ["CMD-SHELL", "pg_isready -U postgres"]

12+ interval: 2s

13+ timeout: 5s

14+ retries: 10

package.json+2−1

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

25 },

26 "dependencies": {

27 "pg": "^8.11.0",

28− "postgres": "^3.4.8"

28+ "postgres": "^3.4.8",

29+ "uuid": "^13.0.0"

29 }

30 }

30}

31}

spago.lock+64−15

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

6 "core": {

7 "dependencies": [

8 {

9+ "aff": ">=8.0.0 <9.0.0"

10+ },

11+ {

9− "aff": ">=7.1.0 <8.0.0"

12+ "arrays": ">=7.3.0 <8.0.0"

10 },

13 },

11 {

14 {

12 "datetime": ">=6.1.0 <7.0.0"

15 "datetime": ">=6.1.0 <7.0.0"

@@ -17,6 +20,12 @@

17 {

20 {

18 "either": ">=6.1.0 <7.0.0"

21 "either": ">=6.1.0 <7.0.0"

19 },

22 },

23+ {

24+ "enums": ">=6.0.1 <7.0.0"

25+ },

26+ {

27+ "exceptions": ">=6.1.0 <7.0.0"

28+ },

20 {

29 {

21 "foldable-traversable": ">=6.0.0 <7.0.0"

30 "foldable-traversable": ">=6.0.0 <7.0.0"

22 },

31 },

@@ -24,7 +33,16 @@

24 "foreign": ">=7.0.0 <8.0.0"

33 "foreign": ">=7.0.0 <8.0.0"

25 },

34 },

26 {

35 {

27− "heterogeneous": ">=0.6.0 <0.7.0"

36+ "heterogeneous": ">=0.7.0 <0.8.0"

37+ },

38+ {

39+ "integers": ">=6.0.0 <7.0.0"

40+ },

41+ {

42+ "js-bigints": ">=2.2.1 <3.0.0"

43+ },

44+ {

45+ "js-date": ">=8.0.0 <9.0.0"

28 },

46 },

29 {

47 {

30 "js-promise": ">=1.0.0 <2.0.0"

48 "js-promise": ">=1.0.0 <2.0.0"

@@ -32,6 +50,9 @@

32 {

50 {

33 "js-promise-aff": ">=1.0.0 <2.0.0"

51 "js-promise-aff": ">=1.0.0 <2.0.0"

34 },

52 },

53+ {

54+ "lists": ">=7.0.0 <8.0.0"

55+ },

35 {

56 {

36 "maybe": ">=6.0.0 <7.0.0"

57 "maybe": ">=6.0.0 <7.0.0"

37 },

58 },

@@ -41,20 +62,38 @@

41 {

62 {

42 "nullable": ">=6.0.0 <7.0.0"

63 "nullable": ">=6.0.0 <7.0.0"

43 },

64 },

65+ {

66+ "numbers": ">=9.0.1 <10.0.0"

67+ },

44 {

68 {

45 "ordered-collections": ">=3.2.0 <4.0.0"

69 "ordered-collections": ">=3.2.0 <4.0.0"

46 },

70 },

47 {

71 {

48 "prelude": ">=6.0.2 <7.0.0"

72 "prelude": ">=6.0.2 <7.0.0"

49 },

73 },

74+ {

75+ "record": ">=4.0.0 <5.0.0"

76+ },

77+ {

78+ "strings": ">=6.0.1 <7.0.0"

79+ },

80+ {

81+ "transformers": ">=6.1.0 <7.0.0"

82+ },

83+ {

84+ "typelevel-prelude": ">=7.0.0 <8.0.0"

85+ },

50 {

86 {

51 "unsafe-coerce": ">=6.0.0 <7.0.0"

87 "unsafe-coerce": ">=6.0.0 <7.0.0"

52 },

88 },

53 {

89 {

54− "yoga-json": ">=5.2.0 <6.0.0"

90+ "uuid": ">=9.0.0 <10.0.0"

55 },

91 },

56 {

92 {

93+ "yoga-json": ">=5.2.1 <6.0.0"

94+ },

95+ {

57− "yoga-sql-types": ">=0.1.0 <0.2.0"

96+ "yoga-sql-types": ">=0.2.0 <0.3.0"

58 }

97 }

59 ]

98 ]

60 },

99 },

@@ -84,8 +123,8 @@

84 "packages": {

123 "packages": {

85 "aff": {

124 "aff": {

86 "type": "registry",

125 "type": "registry",

87− "version": "7.1.0",

126+ "version": "8.0.0",

88− "integrity": "sha256-/nOpDQVnKIoP1pQ1ZZBYpadK0TuMlG4WwufGzJpsfD0=",

127+ "integrity": "sha256-9BRIrSdRoYybfiUmBqgKJ66cPqxYHb277bVWQMn/9sg=",

89 "dependencies": [

128 "dependencies": [

90 "control",

129 "control",

91 "datetime",

130 "datetime",

@@ -436,8 +475,8 @@

436 },

475 },

437 "heterogeneous": {

476 "heterogeneous": {

438 "type": "registry",

477 "type": "registry",

439− "version": "0.6.0",

478+ "version": "0.7.0",

440− "integrity": "sha256-nQgk2iHYe5LIi6ZzREgWaCU3y8oCwdhDSukT6xVMWdk=",

479+ "integrity": "sha256-pQwcFvhWL8noktxaoD7FlLs2F2lYf3QHoyO0VOWO3I0=",

441 "dependencies": [

480 "dependencies": [

442 "either",

481 "either",

443 "foldable-traversable",

482 "foldable-traversable",

@@ -916,6 +955,16 @@

916 "integrity": "sha256-0L1QsaY20OILjfU5TV72d3U/tSjhmL9hJ32WMp857Lk=",

955 "integrity": "sha256-0L1QsaY20OILjfU5TV72d3U/tSjhmL9hJ32WMp857Lk=",

917 "dependencies": []

956 "dependencies": []

918 },

957 },

958+ "uuid": {

959+ "type": "registry",

960+ "version": "9.0.0",

961+ "integrity": "sha256-aM/9+7xlHs5UDdtRfoEQosPpYOruwowa3sezIodJ3vk=",

962+ "dependencies": [

963+ "effect",

964+ "maybe",

965+ "prelude"

966+ ]

967+ },

919 "variant": {

968 "variant": {

920 "type": "registry",

969 "type": "registry",

921 "version": "8.0.0",

970 "version": "8.0.0",

@@ -934,8 +983,8 @@

934 },

983 },

935 "yoga-json": {

984 "yoga-json": {

936 "type": "registry",

985 "type": "registry",

937− "version": "5.2.0",

986+ "version": "5.2.1",

938− "integrity": "sha256-M+kkz6E1Gf+C4bKnhqoBFIoVcc74loi3rLULePbB204=",

987+ "integrity": "sha256-12I7qIf27oKV/D/YRcHtGpN8n7GQ0Bm3uzvI4ZjOQrs=",

939 "dependencies": [

988 "dependencies": [

940 "arrays",

989 "arrays",

941 "bifunctors",

990 "bifunctors",

@@ -973,8 +1022,8 @@

973 },

1022 },

974 "yoga-sql-types": {

1023 "yoga-sql-types": {

975 "type": "registry",

1024 "type": "registry",

976− "version": "0.1.0",

1025+ "version": "0.2.0",

977− "integrity": "sha256-vxOgnj3HK8F5gRHCNkIPNirORQtCBEKozG+CnrHtB84=",

1026+ "integrity": "sha256-/fiSiEmSQ8UH2N7vp/E02Eo+Krbs6iGcre9haDV34Q8=",

978 "dependencies": [

1027 "dependencies": [

979 "arrays",

1028 "arrays",

980 "bifunctors",

1029 "bifunctors",

@@ -1002,13 +1051,13 @@

1002 },

1051 },

1003 "yoga-test-docker": {

1052 "yoga-test-docker": {

1004 "type": "registry",

1053 "type": "registry",

1005− "version": "0.1.0",

1054+ "version": "0.1.2",

1006− "integrity": "sha256-fTd7UZ1W4w3R7sY2OJhoiFqf6Ma6ycQM/4lq9dQnkgs=",

1055+ "integrity": "sha256-J/jgHvvwb04ZOhicRGucmrQhaokrYTc9XJ2dutsktq8=",

1007 "dependencies": [

1056 "dependencies": [

1008 "aff",

1057 "aff",

1009 "datetime",

1058 "datetime",

1010− "effect",

1011 "exceptions",

1059 "exceptions",

1060+ "newtype",

1012 "prelude"

1061 "prelude"

1013 ]

1062 ]

1014 },

1063 },

spago.yaml+18−5

@@ -3,29 +3,42 @@ workspace: {}

3package:

4 name: yoga-postgres

5 publish:

6− version: 0.1.0

6+ version: 0.3.2

7 license: MIT

8 location:

9 githubOwner: rowtype-yoga

10 githubRepo: purescript-yoga-postgres

11 dependencies:

12+ - aff: ">=8.0.0 <9.0.0"

12− - aff: ">=7.1.0 <8.0.0"

13+ - arrays: ">=7.3.0 <8.0.0"

13 - datetime: ">=6.1.0 <7.0.0"

14 - datetime: ">=6.1.0 <7.0.0"

14 - effect: ">=4.0.0 <5.0.0"

15 - effect: ">=4.0.0 <5.0.0"

15 - either: ">=6.1.0 <7.0.0"

16 - either: ">=6.1.0 <7.0.0"

17+ - enums: ">=6.0.1 <7.0.0"

18+ - exceptions: ">=6.1.0 <7.0.0"

16 - foldable-traversable: ">=6.0.0 <7.0.0"

19 - foldable-traversable: ">=6.0.0 <7.0.0"

17 - foreign: ">=7.0.0 <8.0.0"

20 - foreign: ">=7.0.0 <8.0.0"

18− - heterogeneous: ">=0.6.0 <0.7.0"

21+ - heterogeneous: ">=0.7.0 <0.8.0"

22+ - integers: ">=6.0.0 <7.0.0"

23+ - js-bigints: ">=2.2.1 <3.0.0"

24+ - js-date: ">=8.0.0 <9.0.0"

19 - js-promise: ">=1.0.0 <2.0.0"

25 - js-promise: ">=1.0.0 <2.0.0"

20 - js-promise-aff: ">=1.0.0 <2.0.0"

26 - js-promise-aff: ">=1.0.0 <2.0.0"

27+ - lists: ">=7.0.0 <8.0.0"

21 - maybe: ">=6.0.0 <7.0.0"

28 - maybe: ">=6.0.0 <7.0.0"

22 - newtype: ">=5.0.0 <6.0.0"

29 - newtype: ">=5.0.0 <6.0.0"

23 - nullable: ">=6.0.0 <7.0.0"

30 - nullable: ">=6.0.0 <7.0.0"

31+ - numbers: ">=9.0.1 <10.0.0"

24 - ordered-collections: ">=3.2.0 <4.0.0"

32 - ordered-collections: ">=3.2.0 <4.0.0"

25 - prelude: ">=6.0.2 <7.0.0"

33 - prelude: ">=6.0.2 <7.0.0"

34+ - record: ">=4.0.0 <5.0.0"

35+ - strings: ">=6.0.1 <7.0.0"

36+ - transformers: ">=6.1.0 <7.0.0"

37+ - typelevel-prelude: ">=7.0.0 <8.0.0"

26 - unsafe-coerce: ">=6.0.0 <7.0.0"

38 - unsafe-coerce: ">=6.0.0 <7.0.0"

39+ - uuid: ">=9.0.0 <10.0.0"

27− - yoga-json: ">=5.2.0 <6.0.0"

40+ - yoga-json: ">=5.2.1 <6.0.0"

28− - yoga-sql-types: ">=0.1.0 <0.2.0"

41+ - yoga-sql-types: ">=0.2.0 <0.3.0"

29 test:

42 test:

30 main: Test.Postgres.Main

43 main: Test.Postgres.Main

31 dependencies:

44 dependencies:

src/Yoga/Postgres.js+42−42

@@ -2,27 +2,20 @@ import postgres from 'postgres';

3// Create Postgres connection

4export const postgresImpl = (config) => {

5− // Support both individual config and connection string

5+ const { connection, ...configOptions } = config;

6− if (config.connection) {

6+ const options = {

7− return postgres(config.connection, config);

7+ ...configOptions,

8− }

8+ onnotice: config.onnotice

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,

9+ ? () => config.onnotice()

17− idle_timeout: config.idle_timeout,

10+ : undefined,

18− connect_timeout: config.connect_timeout,

11+ onparameter: config.onparameter

19− ssl: config.ssl,

12+ ? (key, value) => config.onparameter({ key, value })()

20− debug: config.debug,

13+ : undefined

21− onnotice: config.onnotice,

14+ };

22− onparameter: config.onparameter,

15+

23− // Pass through any other options

16+ return connection

24− ...config

17+ ? postgres(connection, options)

25− });

18+ : postgres(options);

26};

19};

28// Query operations

21// Query operations

@@ -92,27 +85,29 @@ export const beginImpl = async (sql) => {

92};

85};

94export const commitImpl = async (txn) => {

87export const commitImpl = async (txn) => {

95− if (txn._reserved) {

88+ if (!txn._reserved) return;

89+

90+ const reserved = txn._reserved;

91+ txn._reserved = null;

92+ try {

96− await txn._reserved`COMMIT`;

93+ await reserved`COMMIT`;

97− // Release the connection back to the pool

94+ } finally {

98− await txn._reserved.release();

95+ await reserved.release();

99 }

96 }

100};

97};

101

102export const rollbackImpl = async (txn) => {

99export const rollbackImpl = async (txn) => {

103− if (txn._reserved) {

100+ if (!txn._reserved) return;

101+

102+ const reserved = txn._reserved;

103+ txn._reserved = null;

104+ try {

104− await txn._reserved`ROLLBACK`;

105+ await reserved`ROLLBACK`;

105− // Release the connection back to the pool

106+ } finally {

106− await txn._reserved.release();

107+ await reserved.release();

107 }

108 }

108};

109};

109

110

110−export const transactionImpl = async (sql, handler) => {

111− return sql.begin(async (txn) => {

112− const affAction = handler(txn);

113− return await affAction();

114− });

115−};

116

111

117export const txQueryImpl = async (txn, queryString, params) => {

112export const txQueryImpl = async (txn, queryString, params) => {

118 // Use the underlying SQL connection

113 // Use the underlying SQL connection

@@ -147,19 +142,24 @@ export const endImpl = (sql) => sql.end();

147

142

148// Listen/Notify

143// Listen/Notify

149

144

145+const listeners = new WeakMap();

146+

150export const listenImpl = async (sql, channel, handler) => {

147export const listenImpl = async (sql, channel, handler) => {

151− await sql.listen(channel, (payload) => {

148+ const subscription = await sql.listen(channel, (payload) => {

152 handler({ channel, payload })();

149 handler({ channel, payload })();

153 });

150 });

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);

154};

156};

155

157

156export const unlistenImpl = async (sql, channel) => {

158export const unlistenImpl = async (sql, channel) => {

157− // postgres.js uses the same listen method to unlisten

159+ const byChannel = listeners.get(sql);

158− if (sql.listen.unlisten) {

160+ const subscriptions = byChannel?.get(channel) || [];

159− return sql.listen.unlisten(channel);

161+ await Promise.all(subscriptions.map(({ unlisten }) => unlisten()));

160− }

162+ byChannel?.delete(channel);

161− // Alternative: just resolve, as postgres.js handles cleanup automatically

162− return Promise.resolve();

163};

164

165export const notifyImpl = (sql, channel, payload) =>

src/Yoga/Postgres.purs+18−8

@@ -2,18 +2,22 @@ module Yoga.Postgres where

3import Prelude

5import Data.Maybe (Maybe)

7import Data.Maybe (Maybe)

6import Data.Newtype (class Newtype)

8import Data.Newtype (class Newtype)

7import Data.Nullable (Nullable)

9import Data.Nullable (Nullable)

8import Data.Nullable as Nullable

10import Data.Nullable as Nullable

9import Data.Time.Duration (Milliseconds)

11import Data.Time.Duration (Milliseconds)

12+import Data.UUID (UUID)

13+import Data.UUID as UUID

10import Effect (Effect)

14import Effect (Effect)

11−import Effect.Aff (Aff)

15+import Effect.Aff (Aff, generalBracket)

12import Effect.Uncurried (EffectFn1, EffectFn2, EffectFn3, runEffectFn1, runEffectFn2, runEffectFn3)

16import Effect.Uncurried (EffectFn1, EffectFn2, EffectFn3, runEffectFn1, runEffectFn2, runEffectFn3)

13import Foreign (Foreign)

17import Foreign (Foreign)

14import Prim.Row (class Union)

18import Prim.Row (class Union)

15import Promise (Promise)

19import Promise (Promise)

16−import Promise.Aff (fromAff, toAffE) as Promise

20+import Promise.Aff (toAffE) as Promise

17import Unsafe.Coerce (unsafeCoerce)

21import Unsafe.Coerce (unsafeCoerce)

19-- Opaque Postgres types

23-- Opaque Postgres types

@@ -114,6 +118,9 @@ instance ToPGValue Boolean where

114instance ToPGValue a => ToPGValue (Array a) where

118instance ToPGValue a => ToPGValue (Array a) where

115 toPGValue arr = unsafeCoerce (map toPGValue arr)

119 toPGValue arr = unsafeCoerce (map toPGValue arr)

116

120

121+instance ToPGValue UUID where

122+ toPGValue = toPGValue <<< UUID.toString

123+

117instance ToPGValue Foreign where

124instance ToPGValue Foreign where

118 toPGValue = unsafeCoerce

125 toPGValue = unsafeCoerce

119

126

@@ -219,13 +226,16 @@ foreign import rollbackImpl :: EffectFn1 Transaction (Promise Unit)

219rollback :: Transaction -> Aff Unit

226rollback :: Transaction -> Aff Unit

220rollback = runEffectFn1 rollbackImpl >>> Promise.toAffE

227rollback = runEffectFn1 rollbackImpl >>> Promise.toAffE

221

228

222−-- Run transaction block (automatic commit/rollback)

223−foreign import transactionImpl :: EffectFn2 Connection (Transaction -> Effect (Promise Unit)) (Promise Unit)

224

229

230+-- Low-level escape hatch for code that needs the raw transaction handle.

225−transaction :: (Transaction -> Aff Unit) -> Connection -> Aff Unit

231+withTransaction :: forall a. (Transaction -> Aff a) -> Connection -> Aff a

226−transaction handler conn =

232+withTransaction operation conn =

227− runEffectFn2 transactionImpl conn (\txn -> Promise.fromAff (handler txn))

233+ generalBracket (begin conn)

228− # Promise.toAffE

234+ { killed: \_ -> rollback

235+ , failed: \_ -> rollback

236+ , completed: \_ -> commit

237+ }

238+ operation

229

239

230-- Query within transaction

240-- Query within transaction

231foreign import txQueryImpl :: EffectFn3 Transaction SQL (Array PGValue) (Promise QueryResult)

241foreign import txQueryImpl :: EffectFn3 Transaction SQL (Array PGValue) (Promise QueryResult)

src/Yoga/Postgres/Schema.purs+590−58

@@ -2,36 +2,47 @@ module Yoga.Postgres.Schema where

3import Prelude

5−import Data.Array as Array

5+import Control.Monad.Except (except, runExcept)

6import Data.Array (intercalate, mapWithIndex, foldl)

7+import Data.Array as Array

8+import Data.Date (Date, day, month, year)

7−import Data.DateTime (DateTime)

9+import Data.DateTime (DateTime(..))

10+import Data.Either (Either(..), note)

11+import Data.Enum (fromEnum, toEnum)

12+import Data.Int as Int

8import Data.JSDate as JSDate

13import Data.JSDate as JSDate

14+import Data.List.Types (NonEmptyList)

15+import Data.Map as Map

9−import Data.Maybe (Maybe(..))

16+import Data.Maybe (Maybe(..), fromMaybe)

10import Data.Newtype (class Newtype)

17import Data.Newtype (class Newtype)

11import Data.Nullable (toNullable)

18import Data.Nullable (toNullable)

12−import JS.BigInt (BigInt)

19+import Data.Number as Number

13−import Unsafe.Coerce (unsafeCoerce)

14import Data.Reflectable (class Reflectable, reflectType)

20import Data.Reflectable (class Reflectable, reflectType)

21+import Data.String.CodeUnits as SCU

22+import Data.String.Common as Str

23+import Data.String.Pattern (Pattern(..))

15−import Data.String.Regex (regex, replace') as Regex

24+import Data.String.Regex (Regex, regex, replace') as Regex

16−import Data.String.Regex (Regex) as Regex

17import Data.String.Regex.Flags (global) as Regex

25import Data.String.Regex.Flags (global) as Regex

18−import Control.Monad.Except (runExcept)

19−import Data.Either (Either(..))

20−import Data.Map as Map

21import Data.Symbol (class IsSymbol, reflectSymbol)

26import Data.Symbol (class IsSymbol, reflectSymbol)

22−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

23−import Effect.Aff (Aff)

31+import Effect.Aff (Aff, throwError)

32+import Effect.Exception (error) as Exception

24−import Foreign (Foreign, unsafeToForeign)

33+import Foreign (Foreign, ForeignError(..))

34+import JS.BigInt (BigInt)

25import Prim.Boolean (True, False)

35import Prim.Boolean (True, False)

26import Prim.Row (class Cons, class Lacks, class Union, class Nub) as Row

36import Prim.Row (class Cons, class Lacks, class Union, class Nub) as Row

27−import Prim.RowList as RL

28import Prim.RowList (class RowToList)

37import Prim.RowList (class RowToList)

38+import Prim.RowList as RL

29import Prim.Symbol (class Cons, class Append) as Symbol

39import Prim.Symbol (class Cons, class Append) as Symbol

30import Prim.TypeError (class Fail, Beside, Text, Quote)

40import Prim.TypeError (class Fail, Beside, Text, Quote)

31import Record (get) as Record

41import Record (get) as Record

32import Type.Proxy (Proxy(..))

42import Type.Proxy (Proxy(..))

33import Type.RowList (class ListToRow)

43import Type.RowList (class ListToRow)

44+import Unsafe.Coerce (unsafeCoerce)

34−import Yoga.JSON (class ReadForeign, readImpl)

45+import Yoga.JSON (class ReadForeign, class WriteForeign, readImpl, writeImpl)

35import Yoga.Postgres as PG

46import Yoga.Postgres as PG

37-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

48-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

@@ -57,6 +68,9 @@ data Unique a

58data Default :: forall k. k -> Type -> Type

69data Default :: forall k. k -> Type -> Type

59data Default val a

70data Default val a

71+data DefaultExpr :: Symbol -> Type -> Type

72+data DefaultExpr expression a

73+

61data References

75data References

@@ -78,6 +92,178 @@ derive instance Newtype Jsonb _

78instance ReadForeign Jsonb where

92instance ReadForeign Jsonb where

79 readImpl = pure <<< Jsonb

93 readImpl = pure <<< Jsonb

95+instance WriteForeign Jsonb where

96+ writeImpl (Jsonb value) = value

97+

98+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

99+-- PGUUID: newtype over Data.UUID.UUID for Postgres integration

100+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

101+

102+newtype PGUUID = PGUUID UUID

103+

104+derive instance Newtype PGUUID _

105+derive newtype instance Eq PGUUID

106+derive newtype instance Ord PGUUID

107+derive newtype instance Show PGUUID

108+

109+instance ReadForeign PGUUID where

110+ readImpl f = do

111+ s :: String <- readImpl f

112+ pure (unsafeCoerce s)

113+

114+instance WriteForeign PGUUID where

115+ writeImpl (PGUUID uuid) = writeImpl (UUID.toString uuid)

116+

117+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

118+-- PGDate / PGTime: newtypes for DATE and TIME columns

119+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

120+

121+newtype PGDate = PGDate Date

122+

123+derive instance Newtype PGDate _

124+derive instance Eq PGDate

125+derive instance Ord PGDate

126+instance Show PGDate where

127+ show (PGDate d) = "(PGDate " <> show d <> ")"

128+

129+instance ReadForeign PGDate where

130+ readImpl f =

131+ except $ note (pure (ForeignError "Invalid date")) (JSDate.toDate jsDate <#> PGDate)

132+ where

133+ jsDate :: JSDate.JSDate

134+ jsDate = unsafeCoerce f

135+

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+

163+newtype PGTime = PGTime Time

164+

165+derive instance Newtype PGTime _

166+derive instance Eq PGTime

167+derive instance Ord PGTime

168+instance Show PGTime where

169+ show (PGTime t) = "(PGTime " <> show t <> ")"

170+

171+instance ReadForeign PGTime where

172+ readImpl f = do

173+ s :: String <- readImpl f

174+ except $ note (pure (ForeignError ("Invalid time: " <> s))) (parseTime s)

175+ where

176+ parseTime str = do

177+ let parts = Str.split (Pattern ":") str

178+ case parts of

179+ [ hStr, mStr, sStr ] -> do

180+ h <- Int.fromString hStr >>= toEnum

181+ mi <- Int.fromString mStr >>= toEnum

182+ let secParts = Str.split (Pattern ".") sStr

183+ s <- Int.fromString (fromMaybe sStr (Array.head secParts)) >>= 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)

191+ pure (PGTime (Time h mi s ms))

192+ _ -> Nothing

193+

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+

212+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

213+-- Point: geometric point "(x,y)"

214+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

215+

216+newtype Point = Point { x :: Number, y :: Number }

217+

218+derive instance Newtype Point _

219+derive instance Eq Point

220+

221+instance Show Point where

222+ show (Point { x, y }) = "(Point " <> show x <> " " <> show y <> ")"

223+

224+instance ReadForeign Point where

225+ readImpl f = do

226+ s :: String <- readImpl f

227+ except $ note (pure (ForeignError ("Invalid point: " <> s))) (parsePoint s)

228+ where

229+ parsePoint str = do

230+ let inner = SCU.drop 1 (SCU.dropRight 1 str)

231+ let parts = Str.split (Pattern ",") inner

232+ case parts of

233+ [ xStr, yStr ] -> do

234+ x <- Number.fromString xStr

235+ y <- Number.fromString yStr

236+ pure (Point { x, y })

237+ _ -> Nothing

238+

239+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

240+-- TSVector / TSQuery: full-text search types

241+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

242+

243+newtype TSVector = TSVector String

244+

245+derive instance Newtype TSVector _

246+derive newtype instance Eq TSVector

247+derive newtype instance Ord TSVector

248+derive newtype instance Show TSVector

249+

250+instance ReadForeign TSVector where

251+ readImpl f = do

252+ s :: String <- readImpl f

253+ pure (TSVector s)

254+

255+newtype TSQuery = TSQuery String

256+

257+derive instance Newtype TSQuery _

258+derive newtype instance Eq TSQuery

259+derive newtype instance Ord TSQuery

260+derive newtype instance Show TSQuery

261+

262+instance ReadForeign TSQuery where

263+ readImpl f = do

264+ s :: String <- readImpl f

265+ pure (TSQuery s)

266+

81-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

267-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

82-- Nullability: inferred from Maybe

268-- Nullability: inferred from Maybe

83-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

269-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

@@ -101,6 +287,7 @@ instance ExtractType a typ => ExtractType (PrimaryKey a) typ

101else instance ExtractType a typ => ExtractType (AutoIncrement a) typ

287else instance ExtractType a typ => ExtractType (AutoIncrement a) typ

102else instance ExtractType a typ => ExtractType (Unique a) typ

288else instance ExtractType a typ => ExtractType (Unique a) typ

103else instance ExtractType a typ => ExtractType (Default val a) typ

289else instance ExtractType a typ => ExtractType (Default val a) typ

290+else instance ExtractType a typ => ExtractType (DefaultExpr expression a) typ

104else instance ExtractType a typ => ExtractType (ForeignKey t r c a) typ

291else instance ExtractType a typ => ExtractType (ForeignKey t r c a) typ

105else instance ExtractType a typ => ExtractType (Nullable a) (Maybe typ)

292else instance ExtractType a typ => ExtractType (Nullable a) (Maybe typ)

106else instance ExtractType a a

293else instance ExtractType a a

@@ -130,6 +317,27 @@ instance PGTypeName DateTime where

130instance PGTypeName BigInt where

317instance PGTypeName BigInt where

131 pgTypeName _ = "BIGINT"

318 pgTypeName _ = "BIGINT"

132

319

320+instance PGTypeName PGUUID where

321+ pgTypeName _ = "UUID"

322+

323+instance PGTypeName TimestampTZ where

324+ pgTypeName _ = "TIMESTAMPTZ"

325+

326+instance PGTypeName PGDate where

327+ pgTypeName _ = "DATE"

328+

329+instance PGTypeName PGTime where

330+ pgTypeName _ = "TIME"

331+

332+instance PGTypeName Point where

333+ pgTypeName _ = "POINT"

334+

335+instance PGTypeName TSVector where

336+ pgTypeName _ = "TSVECTOR"

337+

338+instance PGTypeName TSQuery where

339+ pgTypeName _ = "TSQUERY"

340+

133instance PGTypeName Jsonb where

341instance PGTypeName Jsonb where

134 pgTypeName _ = "JSONB"

342 pgTypeName _ = "JSONB"

135

343

@@ -152,8 +360,24 @@ instance Reflectable sym String => RenderDefaultValue sym String where

152instance Reflectable val Int => RenderDefaultValue val Int where

360instance Reflectable val Int => RenderDefaultValue val Int where

153 renderDefaultValue _ _ = "DEFAULT " <> show (reflectType (Proxy :: Proxy val))

361 renderDefaultValue _ _ = "DEFAULT " <> show (reflectType (Proxy :: Proxy val))

154

362

363+instance RenderDefaultValue True Boolean where

364+ renderDefaultValue _ _ = "DEFAULT true"

365+

155−instance Reflectable val Boolean => RenderDefaultValue val Boolean where

366+instance RenderDefaultValue False Boolean where

156− renderDefaultValue _ _ = if reflectType (Proxy :: Proxy val) then "DEFAULT true" else "DEFAULT false"

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+

157

381

158class RenderConstraint a where

382class RenderConstraint a where

159 renderConstraint :: Proxy a -> String

383 renderConstraint :: Proxy a -> String

@@ -170,6 +394,10 @@ else instance RenderConstraint a => RenderConstraint (Unique a) where

170else instance (RenderDefaultValue val a, RenderConstraint a) => RenderConstraint (Default val a) where

394else instance (RenderDefaultValue val a, RenderConstraint a) => RenderConstraint (Default val a) where

171 renderConstraint _ = joinConstraints (renderDefaultValue (Proxy :: Proxy val) (Proxy :: Proxy a)) (renderConstraint (Proxy :: Proxy a))

395 renderConstraint _ = joinConstraints (renderDefaultValue (Proxy :: Proxy val) (Proxy :: Proxy a)) (renderConstraint (Proxy :: Proxy a))

172

396

397+else instance (IsSymbol expression, RenderConstraint a) => RenderConstraint (DefaultExpr expression a) where

398+ renderConstraint _ = joinConstraints

399+ ("DEFAULT " <> reflectSymbol (Proxy :: Proxy expression))

400+ (renderConstraint (Proxy :: Proxy a))

173else instance (IsSymbol table, IsSymbol col, RenderConstraint a) => RenderConstraint (ForeignKey table References col a) where

401else instance (IsSymbol table, IsSymbol col, RenderConstraint a) => RenderConstraint (ForeignKey table References col a) where

174 renderConstraint _ = joinConstraints

402 renderConstraint _ = joinConstraints

175 ("REFERENCES " <> reflectSymbol (Proxy :: Proxy table) <> "(" <> reflectSymbol (Proxy :: Proxy col) <> ")")

403 ("REFERENCES " <> reflectSymbol (Proxy :: Proxy table) <> "(" <> reflectSymbol (Proxy :: Proxy col) <> ")")

@@ -230,6 +458,11 @@ instance

230 let columns = renderColumnsRL (Proxy :: Proxy rl)

458 let columns = renderColumnsRL (Proxy :: Proxy rl)

231 "CREATE TABLE " <> tableName <> " (" <> intercalate ", " columns <> ")"

459 "CREATE TABLE " <> tableName <> " (" <> intercalate ", " columns <> ")"

232

460

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+

233-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

466-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

234-- INSERT SQL generation

467-- INSERT SQL generation

235-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

468-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

@@ -241,6 +474,8 @@ instance IsAutoGenerated (AutoIncrement a) where

241 isAutoGenerated _ = true

474 isAutoGenerated _ = true

242else instance IsAutoGenerated (Default v a) where

475else instance IsAutoGenerated (Default v a) where

243 isAutoGenerated _ = true

476 isAutoGenerated _ = true

477+else instance IsAutoGenerated (DefaultExpr expression a) where

478+ isAutoGenerated _ = true

244else instance IsAutoGenerated a => IsAutoGenerated (PrimaryKey a) where

479else instance IsAutoGenerated a => IsAutoGenerated (PrimaryKey a) where

245 isAutoGenerated _ = isAutoGenerated (Proxy :: Proxy a)

480 isAutoGenerated _ = isAutoGenerated (Proxy :: Proxy a)

246else instance IsAutoGenerated a => IsAutoGenerated (Unique a) where

481else instance IsAutoGenerated a => IsAutoGenerated (Unique a) where

@@ -284,15 +519,18 @@ instance

284 insertSQLFor = do

519 insertSQLFor = do

285 let tableName = reflectSymbol (Proxy :: Proxy name)

520 let tableName = reflectSymbol (Proxy :: Proxy name)

286 let cols = insertColumnsRL (Proxy :: Proxy rl)

521 let cols = insertColumnsRL (Proxy :: Proxy rl)

522+ if Array.null cols then

523+ "INSERT INTO " <> tableName <> " DEFAULT VALUES RETURNING *"

524+ else do

287− let placeholders = cols # mapWithIndex \i _ -> "$" <> show (i + 1)

525+ let placeholders = cols # mapWithIndex \i _ -> "$" <> show (i + 1)

288− "INSERT INTO " <> tableName

526+ "INSERT INTO " <> tableName

289− <> " ("

527+ <> " ("

290− <> intercalate ", " cols

528+ <> intercalate ", " cols

291− <> ")"

529+ <> ")"

292− <> " VALUES ("

530+ <> " VALUES ("

293− <> intercalate ", " placeholders

531+ <> intercalate ", " placeholders

294− <> ")"

532+ <> ")"

295− <> " RETURNING *"

533+ <> " RETURNING *"

296

534

297-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

535-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

298-- SELECT SQL generation

536-- SELECT SQL generation

@@ -747,6 +985,15 @@ else instance

747 ) =>

985 ) =>

748 ParseSelectHandleAS "as" afterKeyword colRef tables accRL outRL

986 ParseSelectHandleAS "as" afterKeyword colRef tables accRL outRL

749

987

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+

750class ParseSelectExpectEnd :: Symbol -> Row (Row Type) -> RL.RowList Type -> RL.RowList Type -> Constraint

997class ParseSelectExpectEnd :: Symbol -> Row (Row Type) -> RL.RowList Type -> RL.RowList Type -> Constraint

751class ParseSelectExpectEnd sym tables accRL outRL | sym tables accRL -> outRL

998class ParseSelectExpectEnd sym tables accRL outRL | sym tables accRL -> outRL

752

999

@@ -845,11 +1092,66 @@ instance ResolveAggregateArg "*" tables Star

845else instance ResolveAggregateArg "" tables Star

1092else instance ResolveAggregateArg "" tables Star

846else instance

1093else instance

847 ( SkipSpaces args trimmedFront

1094 ( SkipSpaces args trimmedFront

848− , ExtractWord trimmedFront col _rest

1095+ , ExtractIdent trimmedFront col rest

849− , ResolveAggregateArgCol col tables argType

1096+ , ResolveAggregateArgDispatch col rest tables argType

850 ) =>

1097 ) =>

851 ResolveAggregateArg args tables argType

1098 ResolveAggregateArg args tables argType

852

1099

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+

853class ResolveAggregateArgCol :: Symbol -> Row (Row Type) -> Type -> Constraint

1155class ResolveAggregateArgCol :: Symbol -> Row (Row Type) -> Type -> Constraint

854class ResolveAggregateArgCol col tables argType | col tables -> argType

1156class ResolveAggregateArgCol col tables argType | col tables -> argType

855

1157

@@ -934,8 +1236,8 @@ else instance

934class AggregateReturnTypeC :: Symbol -> Type -> Type -> Constraint

1236class AggregateReturnTypeC :: Symbol -> Type -> Type -> Constraint

935class AggregateReturnTypeC funcName argType returnType | funcName argType -> returnType

1237class AggregateReturnTypeC funcName argType returnType | funcName argType -> returnType

936

1238

937−instance AggregateReturnTypeC "COUNT" argType Int

1239+instance AggregateReturnTypeC "COUNT" argType BigInt

938−else instance AggregateReturnTypeC "count" argType Int

1240+else instance AggregateReturnTypeC "count" argType BigInt

939else instance AggregateReturnTypeC "COALESCE" argType argType

1241else instance AggregateReturnTypeC "COALESCE" argType argType

940else instance AggregateReturnTypeC "coalesce" argType argType

1242else instance AggregateReturnTypeC "coalesce" argType argType

941else instance

1243else instance

@@ -1418,8 +1720,12 @@ else instance FlushWhereWordU word currentType tables paramsIn currentTypeOut pa

1418else instance FlushWhereWordU word currentType tables paramsIn currentTypeOut paramsOut => FlushWhereWordByHead "u" word currentType tables paramsIn currentTypeOut paramsOut

1720else instance FlushWhereWordU word currentType tables paramsIn currentTypeOut paramsOut => FlushWhereWordByHead "u" word currentType tables paramsIn currentTypeOut paramsOut

1419else instance FlushWhereWordV word currentType tables paramsIn currentTypeOut paramsOut => FlushWhereWordByHead "V" word currentType tables paramsIn currentTypeOut paramsOut

1721else instance FlushWhereWordV word currentType tables paramsIn currentTypeOut paramsOut => FlushWhereWordByHead "V" word currentType tables paramsIn currentTypeOut paramsOut

1420else instance FlushWhereWordV word currentType tables paramsIn currentTypeOut paramsOut => FlushWhereWordByHead "v" word currentType tables paramsIn currentTypeOut paramsOut

1722else instance FlushWhereWordV word currentType tables paramsIn currentTypeOut paramsOut => FlushWhereWordByHead "v" word currentType tables paramsIn currentTypeOut paramsOut

1723+else instance FlushWhereWordP word currentType tables paramsIn currentTypeOut paramsOut => FlushWhereWordByHead "P" word currentType tables paramsIn currentTypeOut paramsOut

1724+else instance FlushWhereWordP word currentType tables paramsIn currentTypeOut paramsOut => FlushWhereWordByHead "p" word currentType tables paramsIn currentTypeOut paramsOut

1725+else instance FlushWhereWordR word currentType tables paramsIn currentTypeOut paramsOut => FlushWhereWordByHead "R" word currentType tables paramsIn currentTypeOut paramsOut

1726+else instance FlushWhereWordR word currentType tables paramsIn currentTypeOut paramsOut => FlushWhereWordByHead "r" word currentType tables paramsIn currentTypeOut paramsOut

1421

1727

1422−-- Catch-all: column reference (letters without keywords like g, h, p, q, r, w, x, y, z)

1728+-- Catch-all: column reference (letters without keywords like g, h, q, w, x, y, z)

1423else instance

1729else instance

1424 ( ResolveColumn word tables entry

1730 ( ResolveColumn word tables entry

1425 , ExtractType entry typ

1731 , ExtractType entry typ

@@ -1492,7 +1798,8 @@ else instance

1492class FlushWhereWordD :: Symbol -> Type -> Row (Row Type) -> RL.RowList Type -> Type -> RL.RowList Type -> Constraint

1798class FlushWhereWordD :: Symbol -> Type -> Row (Row Type) -> RL.RowList Type -> Type -> RL.RowList Type -> Constraint

1493class FlushWhereWordD word currentType tables paramsIn currentTypeOut paramsOut | word currentType tables paramsIn -> currentTypeOut paramsOut

1799class FlushWhereWordD word currentType tables paramsIn currentTypeOut paramsOut | word currentType tables paramsIn -> currentTypeOut paramsOut

1494

1800

1801+instance FlushWhereWordD "DATE" currentType tables paramsIn currentType paramsIn

1495−instance FlushWhereWordD "date" currentType tables paramsIn currentType paramsIn

1802+else instance FlushWhereWordD "date" currentType tables paramsIn currentType paramsIn

1496else instance

1803else instance

1497 ( ResolveColumn word tables entry

1804 ( ResolveColumn word tables entry

1498 , ExtractType entry typ

1805 , ExtractType entry typ

@@ -1607,7 +1914,9 @@ else instance

1607class FlushWhereWordS :: Symbol -> Type -> Row (Row Type) -> RL.RowList Type -> Type -> RL.RowList Type -> Constraint

1914class FlushWhereWordS :: Symbol -> Type -> Row (Row Type) -> RL.RowList Type -> Type -> RL.RowList Type -> Constraint

1608class FlushWhereWordS word currentType tables paramsIn currentTypeOut paramsOut | word currentType tables paramsIn -> currentTypeOut paramsOut

1915class FlushWhereWordS word currentType tables paramsIn currentTypeOut paramsOut | word currentType tables paramsIn -> currentTypeOut paramsOut

1609

1916

1917+instance FlushWhereWordS "SMALLINT" currentType tables paramsIn currentType paramsIn

1918+else instance FlushWhereWordS "smallint" currentType tables paramsIn currentType paramsIn

1610−instance FlushWhereWordS "SUM" currentType tables paramsIn currentType paramsIn

1919+else instance FlushWhereWordS "SUM" currentType tables paramsIn currentType paramsIn

1611else instance FlushWhereWordS "sum" currentType tables paramsIn currentType paramsIn

1920else instance FlushWhereWordS "sum" currentType tables paramsIn currentType paramsIn

1612else instance FlushWhereWordS "STRING_AGG" currentType tables paramsIn String paramsIn

1921else instance FlushWhereWordS "STRING_AGG" currentType tables paramsIn String paramsIn

1613else instance FlushWhereWordS "string_agg" currentType tables paramsIn String paramsIn

1922else instance FlushWhereWordS "string_agg" currentType tables paramsIn String paramsIn

@@ -1628,6 +1937,16 @@ else instance FlushWhereWordT "true" currentType tables paramsIn currentType par

1628else instance FlushWhereWordT "text" currentType tables paramsIn currentType paramsIn

1937else instance FlushWhereWordT "text" currentType tables paramsIn currentType paramsIn

1629else instance FlushWhereWordT "timestamptz" currentType tables paramsIn currentType paramsIn

1938else instance FlushWhereWordT "timestamptz" currentType tables paramsIn currentType paramsIn

1630else instance FlushWhereWordT "timestamp" currentType tables paramsIn currentType paramsIn

1939else instance FlushWhereWordT "timestamp" currentType tables paramsIn currentType paramsIn

1940+else instance FlushWhereWordT "TIME" currentType tables paramsIn currentType paramsIn

1941+else instance FlushWhereWordT "time" currentType tables paramsIn currentType paramsIn

1942+else instance FlushWhereWordT "tsvector" currentType tables paramsIn currentType paramsIn

1943+else instance FlushWhereWordT "TSVECTOR" currentType tables paramsIn currentType paramsIn

1944+else instance FlushWhereWordT "tsquery" currentType tables paramsIn currentType paramsIn

1945+else instance FlushWhereWordT "TSQUERY" currentType tables paramsIn currentType paramsIn

1946+else instance FlushWhereWordT "to_tsvector" currentType tables paramsIn String paramsIn

1947+else instance FlushWhereWordT "TO_TSVECTOR" currentType tables paramsIn String paramsIn

1948+else instance FlushWhereWordT "to_tsquery" currentType tables paramsIn String paramsIn

1949+else instance FlushWhereWordT "TO_TSQUERY" currentType tables paramsIn String paramsIn

1631else instance

1950else instance

1632 ( ResolveColumn word tables entry

1951 ( ResolveColumn word tables entry

1633 , ExtractType entry typ

1952 , ExtractType entry typ

@@ -1659,6 +1978,32 @@ else instance

1659 ) =>

1978 ) =>

1660 FlushWhereWordV word currentType tables paramsIn unwrapped paramsIn

1979 FlushWhereWordV word currentType tables paramsIn unwrapped paramsIn

1661

1980

1981+class FlushWhereWordP :: Symbol -> Type -> Row (Row Type) -> RL.RowList Type -> Type -> RL.RowList Type -> Constraint

1982+class FlushWhereWordP word currentType tables paramsIn currentTypeOut paramsOut | word currentType tables paramsIn -> currentTypeOut paramsOut

1983+

1984+instance FlushWhereWordP "point" currentType tables paramsIn currentType paramsIn

1985+else instance FlushWhereWordP "POINT" currentType tables paramsIn currentType paramsIn

1986+else instance FlushWhereWordP "plainto_tsquery" currentType tables paramsIn currentType paramsIn

1987+else instance FlushWhereWordP "PLAINTO_TSQUERY" currentType tables paramsIn currentType paramsIn

1988+else instance

1989+ ( ResolveColumn word tables entry

1990+ , ExtractType entry typ

1991+ , UnwrapMaybe typ unwrapped

1992+ ) =>

1993+ FlushWhereWordP word currentType tables paramsIn unwrapped paramsIn

1994+

1995+class FlushWhereWordR :: Symbol -> Type -> Row (Row Type) -> RL.RowList Type -> Type -> RL.RowList Type -> Constraint

1996+class FlushWhereWordR word currentType tables paramsIn currentTypeOut paramsOut | word currentType tables paramsIn -> currentTypeOut paramsOut

1997+

1998+instance FlushWhereWordR "real" currentType tables paramsIn currentType paramsIn

1999+else instance FlushWhereWordR "REAL" currentType tables paramsIn currentType paramsIn

2000+else instance

2001+ ( ResolveColumn word tables entry

2002+ , ExtractType entry typ

2003+ , UnwrapMaybe typ unwrapped

2004+ ) =>

2005+ FlushWhereWordR word currentType tables paramsIn unwrapped paramsIn

2006+

1662-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

2007-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

1663-- ValidateColumnList: comma-separated column references

2008-- ValidateColumnList: comma-separated column references

1664-- Used by GROUP BY, DISTINCT ON, ON CONFLICT target

2009-- Used by GROUP BY, DISTINCT ON, ON CONFLICT target

@@ -2312,13 +2657,85 @@ else instance

2312 , SkipSpaces rest1 rest2

2657 , SkipSpaces rest1 rest2

2313 , ExpectChar rest2 "=" rest3

2658 , ExpectChar rest2 "=" rest3

2314 , SkipSpaces rest3 rest4

2659 , SkipSpaces rest3 rest4

2315− , ExtractWord rest4 excRef rest5

2660+ , SkipExpression rest4 rest5

2316− , ValidateExcludedRef excRef colName

2317− , SkipSpaces rest5 rest6

2318− , ParseAssignmentsContinue rest6 cols

2661+ , ParseAssignmentsContinue rest5 cols

2319 ) =>

2662 ) =>

2320 ParseAssignments sym cols

2663 ParseAssignments sym cols

2321

2664

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+

2322class ParseAssignmentsContinue :: Symbol -> Row Type -> Constraint

2739class ParseAssignmentsContinue :: Symbol -> Row Type -> Constraint

2323class ParseAssignmentsContinue sym cols

2740class ParseAssignmentsContinue sym cols

2324

2741

@@ -2381,6 +2798,7 @@ class IsAutoGeneratedTC constraints result | constraints -> result

2381

2798

2382instance IsAutoGeneratedTC (AutoIncrement a) True

2799instance IsAutoGeneratedTC (AutoIncrement a) True

2383else instance IsAutoGeneratedTC (Default s a) True

2800else instance IsAutoGeneratedTC (Default s a) True

2801+else instance IsAutoGeneratedTC (DefaultExpr expression a) True

2384else instance IsAutoGeneratedTC a result => IsAutoGeneratedTC (PrimaryKey a) result

2802else instance IsAutoGeneratedTC a result => IsAutoGeneratedTC (PrimaryKey a) result

2385else instance IsAutoGeneratedTC a result => IsAutoGeneratedTC (Unique a) result

2803else instance IsAutoGeneratedTC a result => IsAutoGeneratedTC (Unique a) result

2386else instance IsAutoGeneratedTC a result => IsAutoGeneratedTC (ForeignKey t r c a) result

2804else instance IsAutoGeneratedTC a result => IsAutoGeneratedTC (ForeignKey t r c a) result

@@ -2436,11 +2854,19 @@ class FieldToPGValue a where

2436 fieldToPGValue :: a -> PG.PGValue

2854 fieldToPGValue :: a -> PG.PGValue

2437

2855

2438instance FieldToPGValue a => FieldToPGValue (Maybe a) where

2856instance FieldToPGValue a => FieldToPGValue (Maybe a) where

2439− fieldToPGValue = toNullable >>> unsafeCoerce

2857+ fieldToPGValue = case _ of

2858+ Nothing -> unsafeCoerce (toNullable Nothing)

2859+ Just value -> fieldToPGValue value

2440else instance FieldToPGValue DateTime where

2860else instance FieldToPGValue DateTime where

2441 fieldToPGValue = JSDate.fromDateTime >>> unsafeCoerce

2861 fieldToPGValue = JSDate.fromDateTime >>> unsafeCoerce

2442−else instance FieldToPGValue a where

2862+else instance FieldToPGValue TimestampTZ where

2863+ fieldToPGValue (TimestampTZ dt) = JSDate.fromDateTime dt # unsafeCoerce

2864+else instance FieldToPGValue PGDate where

2865+ fieldToPGValue = writeImpl >>> unsafeCoerce

2866+else instance FieldToPGValue PGUUID where

2443 fieldToPGValue = unsafeCoerce

2867 fieldToPGValue = unsafeCoerce

2868+else instance WriteForeign a => FieldToPGValue a where

2869+ fieldToPGValue = writeImpl >>> unsafeCoerce

2444

2870

2445class RecordValuesRL :: RL.RowList Type -> Row Type -> Constraint

2871class RecordValuesRL :: RL.RowList Type -> Row Type -> Constraint

2446class RecordValuesRL rl row where

2872class RecordValuesRL rl row where

@@ -2508,6 +2934,20 @@ else instance HasAnyDMLRL (RL.Cons "delete" Unit rest)

2508else instance HasAnyDMLRL rest => HasAnyDMLRL (RL.Cons label typ rest)

2934else instance HasAnyDMLRL rest => HasAnyDMLRL (RL.Cons label typ rest)

2509else instance Fail (Text "WHERE requires a preceding SELECT, UPDATE (set), or DELETE") => HasAnyDMLRL RL.Nil

2935else instance Fail (Text "WHERE requires a preceding SELECT, UPDATE (set), or DELETE") => HasAnyDMLRL RL.Nil

2510

2936

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+

2511toSQL :: forall tables result params stage. Q tables result params stage -> String

2951toSQL :: forall tables result params stage. Q tables result params stage -> String

2512toSQL (Q q) = q.sql

2952toSQL (Q q) = q.sql

2513

2953

@@ -2517,6 +2957,12 @@ from _ = Q { sql: reflectSymbol (Proxy :: Proxy name), values: [] }

2517fromAs :: forall @alias name cols tables. IsSymbol name => IsSymbol alias => Row.Cons alias cols () tables => Proxy (Table name cols) -> Q tables () () ()

2957fromAs :: forall @alias name cols tables. IsSymbol name => IsSymbol alias => Row.Cons alias cols () tables => Proxy (Table name cols) -> Q tables () () ()

2518fromAs _ = Q { sql: reflectSymbol (Proxy :: Proxy name) <> " " <> reflectSymbol (Proxy :: Proxy alias), values: [] }

2958fromAs _ = Q { sql: reflectSymbol (Proxy :: Proxy name) <> " " <> reflectSymbol (Proxy :: Proxy alias), values: [] }

2519

2959

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+

2520selectAll

2966selectAll

2521 :: forall tables name cols result r p stage stage'

2967 :: forall tables name cols result r p stage stage'

2522 . SingleTable tables name cols

2968 . SingleTable tables name cols

@@ -2524,6 +2970,7 @@ selectAll

2524 => StripColumns cols result

2970 => StripColumns cols result

2525 => Row.Lacks "select" stage

2971 => Row.Lacks "select" stage

2526 => Row.Lacks "insert" stage

2972 => Row.Lacks "insert" stage

2973+ => Row.Lacks "into" stage

2527 => Row.Lacks "set" stage

2974 => Row.Lacks "set" stage

2528 => Row.Lacks "delete" stage

2975 => Row.Lacks "delete" stage

2529 => Row.Lacks "where" stage

2976 => Row.Lacks "where" stage

@@ -2541,6 +2988,7 @@ select

2541 => ParseSelect sel tables result

2988 => ParseSelect sel tables result

2542 => Row.Lacks "select" stage

2989 => Row.Lacks "select" stage

2543 => Row.Lacks "insert" stage

2990 => Row.Lacks "insert" stage

2991+ => Row.Lacks "into" stage

2544 => Row.Lacks "set" stage

2992 => Row.Lacks "set" stage

2545 => Row.Lacks "delete" stage

2993 => Row.Lacks "delete" stage

2546 => Row.Lacks "where" stage

2994 => Row.Lacks "where" stage

@@ -2558,6 +3006,7 @@ selectDistinct

2558 => ParseSelect sel tables result

3006 => ParseSelect sel tables result

2559 => Row.Lacks "select" stage

3007 => Row.Lacks "select" stage

2560 => Row.Lacks "insert" stage

3008 => Row.Lacks "insert" stage

3009+ => Row.Lacks "into" stage

2561 => Row.Lacks "set" stage

3010 => Row.Lacks "set" stage

2562 => Row.Lacks "delete" stage

3011 => Row.Lacks "delete" stage

2563 => Row.Lacks "where" stage

3012 => Row.Lacks "where" stage

@@ -2578,6 +3027,7 @@ selectDistinctOn

2578 => ParseSelect sel tables result

3027 => ParseSelect sel tables result

2579 => Row.Lacks "select" stage

3028 => Row.Lacks "select" stage

2580 => Row.Lacks "insert" stage

3029 => Row.Lacks "insert" stage

3030+ => Row.Lacks "into" stage

2581 => Row.Lacks "set" stage

3031 => Row.Lacks "set" stage

2582 => Row.Lacks "delete" stage

3032 => Row.Lacks "delete" stage

2583 => Row.Lacks "where" stage

3033 => Row.Lacks "where" stage

@@ -2782,13 +3232,17 @@ insert rec _ = Q { sql, values }

2782 tableName = reflectSymbol (Proxy :: Proxy name)

3232 tableName = reflectSymbol (Proxy :: Proxy name)

2783 colNames = columnNamesRL (Proxy :: Proxy userRowRL)

3233 colNames = columnNamesRL (Proxy :: Proxy userRowRL)

2784 placeholders = colNames # mapWithIndex \i _ -> "$" <> show (i + 1)

3234 placeholders = colNames # mapWithIndex \i _ -> "$" <> show (i + 1)

3235+ sql =

3236+ if Array.null colNames then

2785− sql = "INSERT INTO " <> tableName

3237+ "INSERT INTO " <> tableName <> " DEFAULT VALUES"

3238+ else

3239+ "INSERT INTO " <> tableName

2786− <> " ("

3240+ <> " ("

2787− <> intercalate ", " colNames

3241+ <> intercalate ", " colNames

2788− <> ")"

3242+ <> ")"

2789− <> " VALUES ("

3243+ <> " VALUES ("

2790− <> intercalate ", " placeholders

3244+ <> intercalate ", " placeholders

2791− <> ")"

3245+ <> ")"

2792 values = recordValuesRL (Proxy :: Proxy userRowRL) rec

3246 values = recordValuesRL (Proxy :: Proxy userRowRL) rec

2793

3247

2794-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

3248-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

@@ -2800,6 +3254,7 @@ returning

2800 . SingleTable tables name cols

3254 . SingleTable tables name cols

2801 => IsSymbol sel

3255 => IsSymbol sel

2802 => ParseSelect sel tables result

3256 => ParseSelect sel tables result

3257+ => HasMutation stage

2803 => Row.Lacks "returning" stage

3258 => Row.Lacks "returning" stage

2804 => Row.Lacks "select" stage

3259 => Row.Lacks "select" stage

2805 => Row.Cons "returning" Unit stage stage'

3260 => Row.Cons "returning" Unit stage stage'

@@ -2811,6 +3266,7 @@ returningAll

2811 :: forall tables name cols result p stage stage'

3266 :: forall tables name cols result p stage stage'

2812 . SingleTable tables name cols

3267 . SingleTable tables name cols

2813 => StripColumns cols result

3268 => StripColumns cols result

3269+ => HasMutation stage

2814 => Row.Lacks "returning" stage

3270 => Row.Lacks "returning" stage

2815 => Row.Lacks "select" stage

3271 => Row.Lacks "select" stage

2816 => Row.Cons "returning" Unit stage stage'

3272 => Row.Cons "returning" Unit stage stage'

@@ -2853,8 +3309,10 @@ set

2853 => ValidateSetColumnsRL setRL cols

3309 => ValidateSetColumnsRL setRL cols

2854 => SetClauseRL setRL

3310 => SetClauseRL setRL

2855 => RecordValuesRL setRL setRow

3311 => RecordValuesRL setRL setRow

3312+ => HasClause "update" stage

2856 => Row.Lacks "select" stage

3313 => Row.Lacks "select" stage

2857 => Row.Lacks "insert" stage

3314 => Row.Lacks "insert" stage

3315+ => Row.Lacks "into" stage

2858 => Row.Lacks "set" stage

3316 => Row.Lacks "set" stage

2859 => Row.Lacks "delete" stage

3317 => Row.Lacks "delete" stage

2860 => Row.Cons "set" Unit stage stage'

3318 => Row.Cons "set" Unit stage stage'

@@ -2878,6 +3336,7 @@ delete

2878 => IsSymbol name

3336 => IsSymbol name

2879 => Row.Lacks "select" stage

3337 => Row.Lacks "select" stage

2880 => Row.Lacks "insert" stage

3338 => Row.Lacks "insert" stage

3339+ => Row.Lacks "into" stage

2881 => Row.Lacks "set" stage

3340 => Row.Lacks "set" stage

2882 => Row.Lacks "delete" stage

3341 => Row.Lacks "delete" stage

2883 => Row.Cons "delete" Unit stage stage'

3342 => Row.Cons "delete" Unit stage stage'

@@ -3118,6 +3577,66 @@ exceptAll

3118 -> Q tables1 result params SetOpStage

3577 -> Q tables1 result params SetOpStage

3119exceptAll (Q q1) (Q q2) = Q { sql: "(" <> q1.sql <> ") EXCEPT ALL (" <> q2.sql <> ")", values: q1.values <> q2.values }

3578exceptAll (Q q1) (Q q2) = Q { sql: "(" <> q1.sql <> ") EXCEPT ALL (" <> q2.sql <> ")", values: q1.values <> q2.values }

3120

3579

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+

3121-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

3640-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

3122-- Query execution

3641-- Query execution

3123-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

3642-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

@@ -3133,28 +3652,34 @@ instance

3133 ( IsSymbol name

3652 ( IsSymbol name

3134 , Row.Cons name typ rest row

3653 , Row.Cons name typ rest row

3135 , Row.Lacks name rest

3654 , Row.Lacks name rest

3655+ , FieldToPGValue typ

3136 , ParamsToArray tail row

3656 , ParamsToArray tail row

3137 ) =>

3657 ) =>

3138 ParamsToArray (RL.Cons name typ tail) row where

3658 ParamsToArray (RL.Cons name typ tail) row where

3139 paramsToArray _ rec =

3659 paramsToArray _ rec =

3140 [ { name: reflectSymbol (Proxy :: Proxy name)

3660 [ { name: reflectSymbol (Proxy :: Proxy name)

3141− , value: unsafeToForeign (Record.get (Proxy :: Proxy name) rec)

3661+ , value: unsafeCoerce (fieldToPGValue (Record.get (Proxy :: Proxy name) rec))

3142 }

3662 }

3143 ]

3663 ]

3144 <> paramsToArray (Proxy :: Proxy tail) rec

3664 <> paramsToArray (Proxy :: Proxy tail) rec

3145

3665

3146namedParamRegex :: Regex.Regex

3666namedParamRegex :: Regex.Regex

3147−namedParamRegex = case Regex.regex "\\$[a-zA-Z_][a-zA-Z0-9_]*" Regex.global of

3667+namedParamRegex = case Regex.regex "\\$[a-zA-Z_][a-zA-Z0-9_]*(::[a-zA-Z_]+)?" Regex.global of

3148 Right r -> r

3668 Right r -> r

3149 Left _ -> unsafeCoerce unit

3669 Left _ -> unsafeCoerce unit

3150

3670

3671+stripCast :: String -> String

3672+stripCast s = case SCU.indexOf (Pattern "::") s of

3673+ Nothing -> s

3674+ Just i -> SCU.take i s

3675+

3151replaceNamedParams :: Int -> Array { name :: String, value :: Foreign } -> String -> { sql :: String, values :: Array PG.PGValue }

3676replaceNamedParams :: Int -> Array { name :: String, value :: Foreign } -> String -> { sql :: String, values :: Array PG.PGValue }

3152replaceNamedParams offset entries sql = do

3677replaceNamedParams offset entries sql = do

3153 let indexed = entries # mapWithIndex \i e -> { idx: offset + i + 1, name: e.name, value: e.value }

3678 let indexed = entries # mapWithIndex \i e -> { idx: offset + i + 1, name: e.name, value: e.value }

3154 let replacements = indexed # foldl (\m e -> Map.insert ("$" <> e.name) ("$" <> show e.idx) m) Map.empty

3679 let replacements = indexed # foldl (\m e -> Map.insert ("$" <> e.name) ("$" <> show e.idx) m) Map.empty

3155 let

3680 let

3156 sql' = Regex.replace' namedParamRegex

3681 sql' = Regex.replace' namedParamRegex

3157− ( \match _ -> case Map.lookup match replacements of

3682+ ( \match _ -> case Map.lookup (stripCast match) replacements of

3158 Nothing -> match

3683 Nothing -> match

3159 Just v -> v

3684 Just v -> v

3160 )

3685 )

@@ -3175,7 +3700,9 @@ runQuery conn params (Q q) = do

3175 let { sql, values } = replaceNamedParams (Array.length q.values) entries q.sql

3700 let { sql, values } = replaceNamedParams (Array.length q.values) entries q.sql

3176 let allValues = q.values <> values

3701 let allValues = q.values <> values

3177 result <- PG.query (PG.SQL sql) allValues conn

3702 result <- PG.query (PG.SQL sql) allValues conn

3178− pure (unsafeDecodeRows result.rows)

3703+ case decodeRows result.rows of

3704+ Left errs -> throwError (Exception.error ("Row decode failed: " <> show errs))

3705+ Right rows -> pure rows

3179

3706

3180runQueryOne

3707runQueryOne

3181 :: forall tables result params paramsRL stage

3708 :: forall tables result params paramsRL stage

@@ -3191,7 +3718,11 @@ runQueryOne conn params (Q q) = do

3191 let { sql, values } = replaceNamedParams (Array.length q.values) entries q.sql

3718 let { sql, values } = replaceNamedParams (Array.length q.values) entries q.sql

3192 let allValues = q.values <> values

3719 let allValues = q.values <> values

3193 result <- PG.queryOne (PG.SQL sql) allValues conn

3720 result <- PG.queryOne (PG.SQL sql) allValues conn

3194− pure (result <#> unsafeDecodeRow)

3721+ case result of

3722+ Nothing -> pure Nothing

3723+ Just row -> case decodeRow row of

3724+ Left errs -> throwError (Exception.error ("Row decode failed: " <> show errs))

3725+ Right a -> pure (Just a)

3195

3726

3196runExecute

3727runExecute

3197 :: forall tables params paramsRL stage

3728 :: forall tables params paramsRL stage

@@ -3223,7 +3754,9 @@ runQueryTx txn params (Q q) = do

3223 let { sql, values } = replaceNamedParams (Array.length q.values) entries q.sql

3754 let { sql, values } = replaceNamedParams (Array.length q.values) entries q.sql

3224 let allValues = q.values <> values

3755 let allValues = q.values <> values

3225 result <- PG.txQuery (PG.SQL sql) allValues txn

3756 result <- PG.txQuery (PG.SQL sql) allValues txn

3226− pure (unsafeDecodeRows result.rows)

3757+ case decodeRows result.rows of

3758+ Left errs -> throwError (Exception.error ("Row decode failed: " <> show errs))

3759+ Right rows -> pure rows

3227

3760

3228runExecuteTx

3761runExecuteTx

3229 :: forall tables params paramsRL stage

3762 :: forall tables params paramsRL stage

@@ -3239,10 +3772,9 @@ runExecuteTx txn params (Q q) = do

3239 let allValues = q.values <> values

3772 let allValues = q.values <> values

3240 PG.txExecute (PG.SQL sql) allValues txn

3773 PG.txExecute (PG.SQL sql) allValues txn

3241

3774

3242−unsafeDecodeRows :: forall a. ReadForeign a => Array Foreign -> Array a

3243−unsafeDecodeRows = map unsafeDecodeRow

3244

3775

3245−unsafeDecodeRow :: forall a. ReadForeign a => Foreign -> a

3776+decodeRows :: forall a. ReadForeign a => Array Foreign -> Either (NonEmptyList ForeignError) (Array a)

3246−unsafeDecodeRow f = case runExcept (readImpl f) of

3777+decodeRows = traverse (readImpl >>> runExcept)

3247− Left _ -> unsafeCoerce unit

3778+

3248− Right a -> a

3779+decodeRow :: forall a. ReadForeign a => Foreign -> Either (NonEmptyList ForeignError) a

3780+decodeRow = readImpl >>> runExcept

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

3+import Prelude

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/EdgeCases.purs+2−1

@@ -3,6 +3,7 @@ module Test.Postgres.EdgeCases where

3import Prelude

5import Data.Maybe (Maybe)

6+import JS.BigInt (BigInt)

6import Prim.Boolean (True)

7import Prim.Boolean (True)

7import Type.Function (type (#))

8import Type.Function (type (#))

8import Type.Proxy (Proxy(..))

9import Type.Proxy (Proxy(..))

@@ -34,7 +35,7 @@ postsTable = Proxy

34-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

35-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

36havingMergesWhereParams

37havingMergesWhereParams

37− :: Q _ (name :: String, cnt :: Int) (age :: Int, minCount :: Int) _

38+ :: Q _ (name :: String, cnt :: BigInt) (age :: Int, minCount :: Int) _

38havingMergesWhereParams = from usersTable

39havingMergesWhereParams = from usersTable

39 # select @"name, COUNT(*) AS cnt"

40 # select @"name, COUNT(*) AS cnt"

40 # where_ @"age > $age"

41 # where_ @"age > $age"

test/Integration.purs+12−4

@@ -15,17 +15,25 @@ main :: Effect Unit

15main = launchAff_ do

16 conn <- liftEffect $ PG.postgres

17 { host: PG.PostgresHost "localhost"

18− , port: PG.PostgresPort 5433

18+ , port: PG.PostgresPort 5434

19 , database: PG.PostgresDatabase "test_playground"

20 , username: PG.PostgresUsername "postgres"

21 , password: PG.PostgresPassword "postgres"

22 }

23− _ <- PG.executeSimple (PG.SQL "DROP TABLE IF EXISTS posts") conn

23+ _ <- PG.executeSimple (PG.SQL "DROP TABLE IF EXISTS sessions CASCADE") conn

24+ _ <- PG.executeSimple (PG.SQL "DROP TABLE IF EXISTS articles CASCADE") conn

25+ _ <- PG.executeSimple (PG.SQL "DROP TABLE IF EXISTS locations CASCADE") conn

26+ _ <- PG.executeSimple (PG.SQL "DROP TABLE IF EXISTS schedule CASCADE") conn

27+ _ <- PG.executeSimple (PG.SQL "DROP TABLE IF EXISTS posts CASCADE") conn

24− _ <- PG.executeSimple (PG.SQL "DROP TABLE IF EXISTS users") conn

28+ _ <- PG.executeSimple (PG.SQL "DROP TABLE IF EXISTS users CASCADE") conn

25− _ <- PG.executeSimple (PG.SQL "DROP TABLE IF EXISTS events") conn

29+ _ <- PG.executeSimple (PG.SQL "DROP TABLE IF EXISTS events CASCADE") conn

26 _ <- PG.executeSimple (PG.SQL (createTableDDL @Schema.UsersTable)) conn

30 _ <- PG.executeSimple (PG.SQL (createTableDDL @Schema.UsersTable)) conn

27 _ <- PG.executeSimple (PG.SQL (createTableDDL @Schema.EventsTable)) conn

31 _ <- PG.executeSimple (PG.SQL (createTableDDL @Schema.EventsTable)) conn

28 _ <- PG.executeSimple (PG.SQL (createTableDDL @Schema.PostsTable)) conn

32 _ <- PG.executeSimple (PG.SQL (createTableDDL @Schema.PostsTable)) conn

33+ _ <- PG.executeSimple (PG.SQL (createTableDDL @Schema.SessionsTable)) conn

34+ _ <- PG.executeSimple (PG.SQL (createTableDDL @Schema.ScheduleTable)) conn

35+ _ <- PG.executeSimple (PG.SQL (createTableDDL @Schema.LocationsTable)) conn

36+ _ <- PG.executeSimple (PG.SQL (createTableDDL @Schema.ArticlesTable)) conn

29 _ <- PG.execute (PG.SQL "INSERT INTO users (name, email, age) VALUES ($1, $2, $3)")

37 _ <- PG.execute (PG.SQL "INSERT INTO users (name, email, age) VALUES ($1, $2, $3)")

30 [ PG.toPGValue "Alice", PG.toPGValue "alice@example.com", PG.toPGValue 22 ]

38 [ PG.toPGValue "Alice", PG.toPGValue "alice@example.com", PG.toPGValue 22 ]

31 conn

39 conn

test/Main.purs+15−8

@@ -4,6 +4,7 @@ import Prelude

5import Data.Either (Either(..))

6import Data.Maybe (Maybe(..))

7+import Data.Time.Duration (Milliseconds(..))

7import Effect (Effect)

8import Effect (Effect)

8import Effect.Aff (Aff, bracket, launchAff_, throwError, try)

9import Effect.Aff (Aff, bracket, launchAff_, throwError, try)

9import Effect.Class (liftEffect)

10import Effect.Class (liftEffect)

@@ -11,6 +12,7 @@ import Effect.Console (log)

11import Effect.Exception (error)

12import Effect.Exception (error)

12import Test.Spec (Spec, around, describe, it)

13import Test.Spec (Spec, around, describe, it)

13import Test.Spec.Assertions (shouldEqual, shouldSatisfy)

14import Test.Spec.Assertions (shouldEqual, shouldSatisfy)

15+import Test.Postgres.Behavioral as Behavioral

14import Test.Spec.Reporter.Console (consoleReporter)

16import Test.Spec.Reporter.Console (consoleReporter)

15import Test.Spec.Runner (runSpec)

17import Test.Spec.Runner (runSpec)

16import Yoga.Test.Docker as Docker

18import Yoga.Test.Docker as Docker

@@ -22,7 +24,7 @@ testHost :: PG.PostgresHost

22testHost = PG.PostgresHost "localhost"

24testHost = PG.PostgresHost "localhost"

24testPort :: PG.PostgresPort

26testPort :: 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

27testDatabase :: PG.PostgresDatabase

29testDatabase :: PG.PostgresDatabase

28testDatabase = PG.PostgresDatabase "test_playground"

30testDatabase = PG.PostgresDatabase "test_playground"

@@ -93,6 +95,11 @@ setupTableWithConstraints conn = do

93spec :: Spec Unit

95spec :: Spec Unit

94spec = do

96spec = do

95 Schema.spec

97 Schema.spec

98+ Behavioral.pureSpec

99+

100+ around withPostgres do

101+ Behavioral.integrationSpec

102+

103

97 describe "Yoga.Postgres Integration Tests" do

104 describe "Yoga.Postgres Integration Tests" do

105

@@ -106,7 +113,7 @@ spec = do

106 it "retrieves connection options" \conn -> do

113 it "retrieves connection options" \conn -> do

107 opts <- liftEffect $ PG.options conn

114 opts <- liftEffect $ PG.options conn

108 opts.host `shouldSatisfy` (_ /= "")

115 opts.host `shouldSatisfy` (_ /= "")

109− opts.port `shouldEqual` 5433

116+ opts.port `shouldEqual` 5434

110 opts.database `shouldEqual` "test_playground"

117 opts.database `shouldEqual` "test_playground"

111

118

112 describe "Connection Errors" do

119 describe "Connection Errors" do

@@ -233,7 +240,7 @@ spec = do

233 it "commits transactions successfully" \conn -> do

240 it "commits transactions successfully" \conn -> do

234 setupTestTable conn

241 setupTestTable conn

235

242

236− _ <- PG.transaction

243+ _ <- PG.withTransaction

237 ( \txn -> do

244 ( \txn -> do

238 _ <- PG.txExecute (PG.SQL "INSERT INTO test_users (name) VALUES ($1)")

245 _ <- PG.txExecute (PG.SQL "INSERT INTO test_users (name) VALUES ($1)")

239 [ PG.toPGValue "Henry" ]

246 [ PG.toPGValue "Henry" ]

@@ -251,12 +258,12 @@ spec = do

251 it "rolls back on errors" \conn -> do

258 it "rolls back on errors" \conn -> do

252 setupTestTable conn

259 setupTestTable conn

253

260

254− result <- try $ PG.transaction

261+ result <- try $ PG.withTransaction

255 ( \txn -> do

262 ( \txn -> do

256 _ <- PG.txExecute (PG.SQL "INSERT INTO test_users (name) VALUES ($1)")

263 _ <- PG.txExecute (PG.SQL "INSERT INTO test_users (name) VALUES ($1)")

257 [ PG.toPGValue "Jack" ]

264 [ PG.toPGValue "Jack" ]

258 txn

265 txn

259− throwError (error "Intentional error")

266+ (throwError (error "Intentional error") :: Aff Unit)

260 )

267 )

261 conn

268 conn

262

269

@@ -268,7 +275,7 @@ spec = do

268 it "queries within transaction" \conn -> do

275 it "queries within transaction" \conn -> do

269 setupTestTable conn

276 setupTestTable conn

270

277

271− _ <- PG.transaction

278+ _ <- PG.withTransaction

272 ( \txn -> do

279 ( \txn -> do

273 _ <- PG.txExecute (PG.SQL "INSERT INTO test_users (name) VALUES ($1)")

280 _ <- PG.txExecute (PG.SQL "INSERT INTO test_users (name) VALUES ($1)")

274 [ PG.toPGValue "Leo" ]

281 [ PG.toPGValue "Leo" ]

@@ -433,11 +440,11 @@ main = launchAff_ do

433 bracket

440 bracket

434 ( do

441 ( do

435 liftEffect $ log "Starting Postgres and waiting for it to be ready..."

442 liftEffect $ log "Starting Postgres and waiting for it to be ready..."

436− Docker.startService "packages/yoga-postgres/docker-compose.test.yml" 30

443+ Docker.startService (Docker.ComposeFile "docker-compose.test.yml") (Docker.Timeout (Milliseconds 30000.0))

437 liftEffect $ log "Postgres is ready!\n"

444 liftEffect $ log "Postgres is ready!\n"

438 )

445 )

439 ( \_ -> do

446 ( \_ -> do

440− Docker.stopService "packages/yoga-postgres/docker-compose.test.yml"

447+ Docker.stopService (Docker.ComposeFile "docker-compose.test.yml")

441 liftEffect $ log "Cleanup complete\n"

448 liftEffect $ log "Cleanup complete\n"

442 )

449 )

443 (\_ -> runSpec [ consoleReporter ] spec)

450 (\_ -> runSpec [ consoleReporter ] spec)

test/Schema.purs+213−10

@@ -2,11 +2,15 @@ module Test.Postgres.Schema where

3import Prelude

5+import Data.Array as Array

5import Data.Date (canonicalDate)

6import Data.Date (canonicalDate)

6import Data.DateTime (DateTime(..))

7import Data.DateTime (DateTime(..))

7import Data.Enum (toEnum)

8import Data.Enum (toEnum)

8import Data.Maybe (Maybe(..), fromJust)

9import Data.Maybe (Maybe(..), fromJust)

10+import Data.Newtype (un)

11+import Data.String as String

9import Data.Time (Time(..))

12import Data.Time (Time(..))

13+import Data.UUID as UUID

10import Partial.Unsafe (unsafePartial)

14import Partial.Unsafe (unsafePartial)

12import Type.Function (type (#))

16import Type.Function (type (#))

@@ -228,15 +232,15 @@ typedInsertReturning = from usersTable

228

232

229typedSet

233typedSet

230 :: Q _ () () _

234 :: Q _ () () _

231−typedSet = from usersTable # set { name: "Bob" }

235+typedSet = update usersTable # set { name: "Bob" }

232

236

233typedSetWhere

237typedSetWhere

234 :: Q _ () (id :: Int) _

238 :: Q _ () (id :: Int) _

235−typedSetWhere = from usersTable # set { name: "Bob" } # where_ @"id = $id"

239+typedSetWhere = update usersTable # set { name: "Bob" } # where_ @"id = $id"

236

240

237typedSetReturning

241typedSetReturning

238 :: Q _ (id :: Int, name :: String, email :: String) (id :: Int) _

242 :: Q _ (id :: Int, name :: String, email :: String) (id :: Int) _

239−typedSetReturning = from usersTable

243+typedSetReturning = update usersTable

240 # set { name: "Bob" }

244 # set { name: "Bob" }

241 # where_ @"id = $id"

245 # where_ @"id = $id"

242 # returning @"id, name, email"

246 # returning @"id, name, email"

@@ -436,7 +440,7 @@ typedGroupBy

436typedGroupBy = from usersTable # select @"name" # groupBy @"name"

440typedGroupBy = from usersTable # select @"name" # groupBy @"name"

437

441

438typedCountStar

442typedCountStar

439− :: Q _ (name :: String, cnt :: Int) () _

443+ :: Q _ (name :: String, cnt :: BigInt) () _

440typedCountStar = from usersTable

444typedCountStar = from usersTable

441 # select @"name, COUNT(*) AS cnt"

445 # select @"name, COUNT(*) AS cnt"

442 # groupBy @"name"

446 # groupBy @"name"

@@ -460,14 +464,14 @@ typedMinMax = from usersTable

460 # groupBy @"name"

464 # groupBy @"name"

461

465

462typedHaving

466typedHaving

463− :: Q _ (name :: String, cnt :: Int) (minCount :: Int) _

467+ :: Q _ (name :: String, cnt :: BigInt) (minCount :: Int) _

464typedHaving = from usersTable

468typedHaving = from usersTable

465 # select @"name, COUNT(*) AS cnt"

469 # select @"name, COUNT(*) AS cnt"

466 # groupBy @"name"

470 # groupBy @"name"

467 # having @"COUNT(*) > $minCount"

471 # having @"COUNT(*) > $minCount"

468

472

469typedFullAggregate

473typedFullAggregate

470− :: Q _ (name :: String, cnt :: Int) (min :: Int) _

474+ :: Q _ (name :: String, cnt :: BigInt) (min :: Int) _

471typedFullAggregate = from usersTable

475typedFullAggregate = from usersTable

472 # select @"name, COUNT(*) AS cnt"

476 # select @"name, COUNT(*) AS cnt"

473 # groupBy @"name"

477 # groupBy @"name"

@@ -476,7 +480,7 @@ typedFullAggregate = from usersTable

476 # limit @"10"

480 # limit @"10"

477

481

478typedWhereGroupByHaving

482typedWhereGroupByHaving

479− :: Q _ (name :: String, cnt :: Int) (age :: Int, minCount :: Int) _

483+ :: Q _ (name :: String, cnt :: BigInt) (age :: Int, minCount :: Int) _

480typedWhereGroupByHaving = from usersTable

484typedWhereGroupByHaving = from usersTable

481 # select @"name, COUNT(*) AS cnt"

485 # select @"name, COUNT(*) AS cnt"

482 # where_ @"age > $age"

486 # where_ @"age > $age"

@@ -643,6 +647,101 @@ typedCoalesceSelect

643typedCoalesceSelect = from usersTable

647typedCoalesceSelect = from usersTable

644 # select @"name, COALESCE(age, 0) AS val"

648 # select @"name, COALESCE(age, 0) AS val"

645

649

650+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

651+-- UUID + DefaultExpr

652+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

653+

654+type SessionsTable = Table "sessions"

655+ ( id :: PGUUID # PrimaryKey # DefaultExpr "gen_random_uuid()"

656+ , user_id :: Int # ForeignKey "users" References "id"

657+ , token :: String # Unique

658+ , created_at :: DateTime # DefaultExpr "now()"

659+ )

660+

661+sessionsTable :: Proxy SessionsTable

662+sessionsTable = Proxy

663+

664+sessionsDDL :: String

665+sessionsDDL = createTableDDL @SessionsTable

666+

667+sessionsInsertSQL :: String

668+sessionsInsertSQL = insertSQLFor @SessionsTable

669+

670+typedSessionSelect

671+ :: Q _ (id :: PGUUID, token :: String) () _

672+typedSessionSelect = from sessionsTable # select @"id, token"

673+

674+typedSessionWhere

675+ :: Q _ (id :: PGUUID, token :: String, user_id :: Int, created_at :: DateTime) (userId :: Int) _

676+typedSessionWhere = from sessionsTable # selectAll # where_ @"user_id = $userId"

677+

678+typedSessionInsert

679+ :: Q _ () () _

680+typedSessionInsert = from sessionsTable # insert { user_id: 42, token: "abc" }

681+

682+builderSessionSelect :: String

683+builderSessionSelect = typedSessionSelect # toSQL

684+

685+builderSessionInsert :: String

686+builderSessionInsert = typedSessionInsert # toSQL

687+

688+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

689+-- PGDate + PGTime

690+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

691+

692+type ScheduleTable = Table "schedule"

693+ ( id :: Int # PrimaryKey # AutoIncrement

694+ , event_date :: PGDate

695+ , start_time :: PGTime

696+ , title :: String

697+ )

698+

699+scheduleTable :: Proxy ScheduleTable

700+scheduleTable = Proxy

701+

702+scheduleDDL :: String

703+scheduleDDL = createTableDDL @ScheduleTable

704+

705+typedScheduleSelect

706+ :: Q _ (event_date :: PGDate, start_time :: PGTime, title :: String) () _

707+typedScheduleSelect = from scheduleTable # select @"event_date, start_time, title"

708+

709+typedScheduleWhere

710+ :: Q _ _ (d :: PGDate) _

711+typedScheduleWhere = from scheduleTable # selectAll # where_ @"event_date = $d"

712+

713+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

714+-- Point + TSVector + TSQuery

715+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

716+

717+type LocationsTable = Table "locations"

718+ ( id :: Int # PrimaryKey # AutoIncrement

719+ , name :: String

720+ , coords :: Point

721+ )

722+

723+locationsTable :: Proxy LocationsTable

724+locationsTable = Proxy

725+

726+locationsDDL :: String

727+locationsDDL = createTableDDL @LocationsTable

728+

729+type ArticlesTable = Table "articles"

730+ ( id :: Int # PrimaryKey # AutoIncrement

731+ , title :: String

732+ , body_vector :: TSVector

733+ )

734+

735+articlesTable :: Proxy ArticlesTable

736+articlesTable = Proxy

737+

738+articlesDDL :: String

739+articlesDDL = createTableDDL @ArticlesTable

740+

741+typedFTSWhere

742+ :: Q _ _ (q :: String) _

743+typedFTSWhere = from articlesTable # selectAll # where_ @"body_vector @@ to_tsquery($q)"

744+

646-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

745-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

647-- Spec

746-- Spec

648-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

747-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

@@ -672,7 +771,27 @@ spec = do

672 it "renders DEFAULT in DDL" do

771 it "renders DEFAULT in DDL" do

673 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)"

772 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)"

674 it "skips Default columns in INSERT" do

773 it "skips Default columns in INSERT" do

675− configInsertSQL `shouldEqual` "INSERT INTO config () VALUES () RETURNING *"

774+ configInsertSQL `shouldEqual` "INSERT INTO config DEFAULT VALUES RETURNING *"

775+

776+ describe "UUID + DefaultExpr" do

777+ it "renders UUID and DefaultExpr in DDL" do

778+ sessionsDDL `shouldEqual` "CREATE TABLE sessions (created_at TIMESTAMPTZ NOT NULL DEFAULT now(), id UUID NOT NULL DEFAULT gen_random_uuid() PRIMARY KEY, token TEXT NOT NULL UNIQUE, user_id INTEGER NOT NULL REFERENCES users(id))"

779+ it "skips DefaultExpr columns in INSERT" do

780+ sessionsInsertSQL `shouldEqual` "INSERT INTO sessions (token, user_id) VALUES ($1, $2) RETURNING *"

781+ it "builds SELECT with UUID column" do

782+ builderSessionSelect `shouldEqual` "SELECT id, token FROM sessions"

783+ it "builds INSERT skipping DefaultExpr columns" do

784+ builderSessionInsert `shouldEqual` "INSERT INTO sessions (token, user_id) VALUES ($1, $2)"

785+

786+ describe "PGDate + PGTime" do

787+ it "renders DATE and TIME in DDL" do

788+ scheduleDDL `shouldEqual` "CREATE TABLE schedule (event_date DATE NOT NULL, id INTEGER NOT NULL GENERATED ALWAYS AS IDENTITY PRIMARY KEY, start_time TIME NOT NULL, title TEXT NOT NULL)"

789+

790+ describe "Point + TSVector + TSQuery" do

791+ it "renders POINT in DDL" do

792+ locationsDDL `shouldEqual` "CREATE TABLE locations (coords POINT NOT NULL, id INTEGER NOT NULL GENERATED ALWAYS AS IDENTITY PRIMARY KEY, name TEXT NOT NULL)"

793+ it "renders TSVECTOR in DDL" do

794+ articlesDDL `shouldEqual` "CREATE TABLE articles (body_vector TSVECTOR NOT NULL, id INTEGER NOT NULL GENERATED ALWAYS AS IDENTITY PRIMARY KEY, title TEXT NOT NULL)"

676

795

677 describe "UPDATE SQL" do

796 describe "UPDATE SQL" do

678 it "generates UPDATE with SET and WHERE" do

797 it "generates UPDATE with SET and WHERE" do

@@ -951,7 +1070,7 @@ integrationSpec conn = do

951 describe "Builder update execution" do

1070 describe "Builder update execution" do

952 it "updates a row" do

1071 it "updates a row" do

953 resetUsers conn

1072 resetUsers conn

954− count <- from usersTable

1073+ count <- update usersTable

955 # set { email: "alice-updated@example.com" }

1074 # set { email: "alice-updated@example.com" }

956 # where_ @"name = $name"

1075 # where_ @"name = $name"

957 # runExecute conn { name: "Alice" }

1076 # runExecute conn { name: "Alice" }

@@ -963,7 +1082,7 @@ integrationSpec conn = do

963 result `shouldEqual` Just { email: "alice-updated@example.com" }

1082 result `shouldEqual` Just { email: "alice-updated@example.com" }

964

1083

965 it "updates with RETURNING" do

1084 it "updates with RETURNING" do

966− rows <- from usersTable

1085+ rows <- update usersTable

967 # set { age: Just 99 }

1086 # set { age: Just 99 }

968 # where_ @"name = $name"

1087 # where_ @"name = $name"

969 # returning @"name, age"

1088 # returning @"name, age"

@@ -1228,3 +1347,87 @@ integrationSpec conn = do

1228 # orderBy @"name"

1347 # orderBy @"name"

1229 # runQuery conn { age: 10, minCount: 0 }

1348 # runQuery conn { age: 10, minCount: 0 }

1230 rows `shouldEqual` [ { name: "Alice" }, { name: "Bob" } ]

1349 rows `shouldEqual` [ { name: "Alice" }, { name: "Bob" } ]

1350+

1351+ describe "UUID + DefaultExpr execution" do

1352+ it "creates sessions table from DDL" do

1353+ _ <- PG.executeSimple (PG.SQL "DELETE FROM sessions") conn

1354+ pure unit

1355+

1356+ it "inserts with server-generated UUID and timestamp" do

1357+ _ <- PG.executeSimple (PG.SQL "DELETE FROM sessions") conn

1358+ count <- from sessionsTable

1359+ # insert { user_id: 1, token: "sess-abc" }

1360+ # runExecute conn {}

1361+ count `shouldEqual` 1

1362+

1363+ it "selects back UUID column" do

1364+ rows <- from sessionsTable

1365+ # select @"id, token"

1366+ # where_ @"token = $token"

1367+ # runQuery conn { token: "sess-abc" }

1368+ let len = Array.length rows

1369+ len `shouldEqual` 1

1370+ do

1371+ let row = unsafePartial fromJust (Array.head rows)

1372+ let uuidStr = UUID.toString (un PGUUID row.id)

1373+ String.length uuidStr `shouldEqual` 36

1374+ row.token `shouldEqual` "sess-abc"

1375+

1376+ describe "PGDate + PGTime execution" do

1377+ it "round-trips date and time values" do

1378+ _ <- PG.executeSimple (PG.SQL "DELETE FROM schedule") conn

1379+ _ <- PG.executeSimple (PG.SQL "ALTER SEQUENCE schedule_id_seq RESTART WITH 1") conn

1380+ _ <- PG.execute

1381+ (PG.SQL "INSERT INTO schedule (event_date, start_time, title) VALUES ($1::date, $2::time, $3)")

1382+ [ PG.toPGValue "2025-06-15", PG.toPGValue "14:30:00", PG.toPGValue "Meeting" ]

1383+ conn

1384+ rows <- from scheduleTable

1385+ # select @"event_date, start_time, title"

1386+ # where_ @"title = $title"

1387+ # runQuery conn { title: "Meeting" }

1388+ let

1389+ expectedDate = unsafePartial do

1390+ let y = fromJust (toEnum 2025)

1391+ let m = fromJust (toEnum 6)

1392+ let d = fromJust (toEnum 15)

1393+ PGDate (canonicalDate y m d)

1394+ let

1395+ expectedTime = unsafePartial do

1396+ let h = fromJust (toEnum 14)

1397+ let mi = fromJust (toEnum 30)

1398+ let s = fromJust (toEnum 0)

1399+ let ms = fromJust (toEnum 0)

1400+ PGTime (Time h mi s ms)

1401+ rows `shouldEqual` [ { event_date: expectedDate, start_time: expectedTime, title: "Meeting" } ]

1402+

1403+ describe "Point execution" do

1404+ it "round-trips point values" do

1405+ _ <- PG.executeSimple (PG.SQL "DELETE FROM locations") conn

1406+ _ <- PG.executeSimple (PG.SQL "ALTER SEQUENCE locations_id_seq RESTART WITH 1") conn

1407+ _ <- PG.execute

1408+ (PG.SQL "INSERT INTO locations (name, coords) VALUES ($1, point($2, $3))")

1409+ [ PG.toPGValue "HQ", PG.toPGValue 40.7, PG.toPGValue (-74.0) ]

1410+ conn

1411+ rows <- from locationsTable

1412+ # select @"name, coords"

1413+ # where_ @"name = $name"

1414+ # runQuery conn { name: "HQ" }

1415+ rows `shouldEqual` [ { name: "HQ", coords: Point { x: 40.7, y: -74.0 } } ]

1416+

1417+ describe "TSVector + TSQuery execution" do

1418+ it "inserts and queries with full-text search" do

1419+ _ <- PG.executeSimple (PG.SQL "DELETE FROM articles") conn

1420+ _ <- PG.executeSimple (PG.SQL "ALTER SEQUENCE articles_id_seq RESTART WITH 1") conn

1421+ _ <- PG.execute

1422+ (PG.SQL "INSERT INTO articles (title, body_vector) VALUES ($1, to_tsvector($2))")

1423+ [ PG.toPGValue "PureScript Rocks", PG.toPGValue "purescript is a strongly typed functional language" ]

1424+ conn

1425+ _ <- PG.execute

1426+ (PG.SQL "INSERT INTO articles (title, body_vector) VALUES ($1, to_tsvector($2))")

1427+ [ PG.toPGValue "Haskell Guide", PG.toPGValue "haskell is a lazy functional language" ]

1428+ conn

1429+ rows <- from articlesTable

1430+ # select @"title"

1431+ # where_ @"body_vector @@ to_tsquery($q)"

1432+ # runQuery conn { q: "purescript" }

1433+ rows `shouldEqual` [ { title: "PureScript Rocks" } ]