60ed26c...main · rowtype-yoga/purescript-yoga-postgres

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

34 files changed+2891−886

since splitsnapshots

unifiedsplit

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

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

66 steps:

77 - uses: actions/checkout@v4

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

9− - run: spago build

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

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

11+ - run: spago test

12+ - run: bash compile-fail-tests/run.sh

13+ - if: always()

14+ run: docker compose -f docker-compose.test.yml down --volumes

.gitignore+1

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

33output/

44output-*/

55.DS_Store

6+.psc-ide-port

.psc-ide-port+1−1

@@ -1 +1 @@

1−15556

1+15490

bun.lock+3

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

66 "dependencies": {

77 "pg": "^8.11.0",

88 "postgres": "^3.4.8",

9+ "uuid": "^13.0.0",

910 },

1011 },

1112 },

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

3839

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

4041

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

43+

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

4245 }

4346}

compile-fail-tests/DistinctOrderByNonSelected.pursnew file+20

@@ -0,0 +1,20 @@

1+-- EXPECT: ORDER BY column "age" must appear in the SELECT list when using DISTINCT

2+module Test.CompileFail.DistinctOrderByNonSelected where

4+import Prelude

5+import Data.Maybe (Maybe)

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

7+import Type.Proxy (Proxy(..))

8+import Yoga.Postgres.Schema

10+type UsersTable = Table "users"

11+ ( id :: Int # PrimaryKey # AutoIncrement

12+ , name :: String

13+ , email :: String # Unique

14+ , age :: Maybe Int

15+ )

16+

17+usersTable :: Proxy UsersTable

18+usersTable = Proxy

19+

20+bad = from usersTable # selectDistinct @"name" # orderBy @"age"

compile-fail-tests/EmptyWhere.pursnew file+20

@@ -0,0 +1,20 @@

1+-- EXPECT: Empty WHERE clause

2+module Test.CompileFail.EmptyWhere where

4+import Prelude

5+import Data.Maybe (Maybe(..))

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

7+import Type.Proxy (Proxy(..))

8+import Yoga.Postgres.Schema

10+type UsersTable = Table "users"

11+ ( id :: Int # PrimaryKey # AutoIncrement

12+ , name :: String

13+ , email :: String # Unique

14+ , age :: Maybe Int

15+ )

16+

17+usersTable :: Proxy UsersTable

18+usersTable = Proxy

19+

20+bad = from usersTable # selectAll # where_ @""

compile-fail-tests/InvalidLimitDecimal.pursnew file+20

@@ -0,0 +1,20 @@

1+-- EXPECT: LIMIT/OFFSET must be a non-negative integer or $parameter

2+module Test.CompileFail.InvalidLimitDecimal where

4+import Prelude

5+import Data.Maybe (Maybe(..))

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

7+import Type.Proxy (Proxy(..))

8+import Yoga.Postgres.Schema

10+type UsersTable = Table "users"

11+ ( id :: Int # PrimaryKey # AutoIncrement

12+ , name :: String

13+ , email :: String # Unique

14+ , age :: Maybe Int

15+ )

16+

17+usersTable :: Proxy UsersTable

18+usersTable = Proxy

19+

20+bad = from usersTable # selectAll # limit @"10.5"

compile-fail-tests/InvalidLimitNegative.pursnew file+20

@@ -0,0 +1,20 @@

1+-- EXPECT: LIMIT/OFFSET must be a non-negative integer or $parameter

2+module Test.CompileFail.InvalidLimitNegative where

4+import Prelude

5+import Data.Maybe (Maybe(..))

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

7+import Type.Proxy (Proxy(..))

8+import Yoga.Postgres.Schema

10+type UsersTable = Table "users"

11+ ( id :: Int # PrimaryKey # AutoIncrement

12+ , name :: String

13+ , email :: String # Unique

14+ , age :: Maybe Int

15+ )

16+

17+usersTable :: Proxy UsersTable

18+usersTable = Proxy

19+

20+bad = from usersTable # selectAll # limit @"-5"

compile-fail-tests/InvalidLimitNonNumeric.pursnew file+20

@@ -0,0 +1,20 @@

1+-- EXPECT: LIMIT/OFFSET must be a non-negative integer or $parameter

2+module Test.CompileFail.InvalidLimitNonNumeric where

4+import Prelude

5+import Data.Maybe (Maybe(..))

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

7+import Type.Proxy (Proxy(..))

8+import Yoga.Postgres.Schema

10+type UsersTable = Table "users"

11+ ( id :: Int # PrimaryKey # AutoIncrement

12+ , name :: String

13+ , email :: String # Unique

14+ , age :: Maybe Int

15+ )

16+

17+usersTable :: Proxy UsersTable

18+usersTable = Proxy

19+

20+bad = from usersTable # selectAll # limit @"abc"

compile-fail-tests/LeadingCommaInOrderBy.pursnew file+20

@@ -0,0 +1,20 @@

1+-- EXPECT: Unexpected comma in ORDER BY clause

2+module Test.CompileFail.LeadingCommaInOrderBy where

4+import Prelude

5+import Data.Maybe (Maybe(..))

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

7+import Type.Proxy (Proxy(..))

8+import Yoga.Postgres.Schema

10+type UsersTable = Table "users"

11+ ( id :: Int # PrimaryKey # AutoIncrement

12+ , name :: String

13+ , email :: String # Unique

14+ , age :: Maybe Int

15+ )

16+

17+usersTable :: Proxy UsersTable

18+usersTable = Proxy

19+

20+bad = from usersTable # selectAll # orderBy @",name"

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

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

1−-- EXPECT: Expected

1+-- EXPECT: TypesDoNotUnify

22module Test.CompileFail.OnConflictBadExcluded where

44import Prelude

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

1717usersTable :: Proxy UsersTable

1818usersTable = Proxy

1919

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

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

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

compile-fail-tests/OrderByOnlyModifier.pursnew file+20

@@ -0,0 +1,20 @@

1+-- EXPECT: ORDER BY requires a column name before ASC/DESC

2+module Test.CompileFail.OrderByOnlyModifier where

4+import Prelude

5+import Data.Maybe (Maybe(..))

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

7+import Type.Proxy (Proxy(..))

8+import Yoga.Postgres.Schema

10+type UsersTable = Table "users"

11+ ( id :: Int # PrimaryKey # AutoIncrement

12+ , name :: String

13+ , email :: String # Unique

14+ , age :: Maybe Int

15+ )

16+

17+usersTable :: Proxy UsersTable

18+usersTable = Proxy

19+

20+bad = from usersTable # selectAll # orderBy @"ASC"

compile-fail-tests/OverClauseInvalidContent.pursnew file+20

@@ -0,0 +1,20 @@

1+-- EXPECT: Expected PARTITION BY or ORDER BY inside OVER clause

2+module Test.CompileFail.OverClauseInvalidContent where

4+import Prelude

5+import Data.Maybe (Maybe)

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

7+import Type.Proxy (Proxy(..))

8+import Yoga.Postgres.Schema

10+type UsersTable = Table "users"

11+ ( id :: Int # PrimaryKey # AutoIncrement

12+ , name :: String

13+ , email :: String # Unique

14+ , age :: Maybe Int

15+ )

16+

17+usersTable :: Proxy UsersTable

18+usersTable = Proxy

19+

20+bad = from usersTable # select @"name, ROW_NUMBER() OVER (THIS IS TOTALLY INVALID) AS rn"

compile-fail-tests/OverClauseNonexistentColumn.pursnew file+20

@@ -0,0 +1,20 @@

1+-- EXPECT: not found in any table

2+module Test.CompileFail.OverClauseNonexistentColumn where

4+import Prelude

5+import Data.Maybe (Maybe)

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

7+import Type.Proxy (Proxy(..))

8+import Yoga.Postgres.Schema

10+type UsersTable = Table "users"

11+ ( id :: Int # PrimaryKey # AutoIncrement

12+ , name :: String

13+ , email :: String # Unique

14+ , age :: Maybe Int

15+ )

16+

17+usersTable :: Proxy UsersTable

18+usersTable = Proxy

19+

20+bad = from usersTable # select @"name, ROW_NUMBER() OVER (ORDER BY nonexistent_column) AS rn"

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"

compile-fail-tests/TrailingCommaInOrderBy.pursnew file+20

@@ -0,0 +1,20 @@

1+-- EXPECT: Trailing comma in ORDER BY clause

2+module Test.CompileFail.TrailingCommaInOrderBy where

4+import Prelude

5+import Data.Maybe (Maybe(..))

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

7+import Type.Proxy (Proxy(..))

8+import Yoga.Postgres.Schema

10+type UsersTable = Table "users"

11+ ( id :: Int # PrimaryKey # AutoIncrement

12+ , name :: String

13+ , email :: String # Unique

14+ , age :: Maybe Int

15+ )

16+

17+usersTable :: Proxy UsersTable

18+usersTable = Proxy

19+

20+bad = from usersTable # selectAll # orderBy @"name,"

compile-fail-tests/UnclosedStringLiteral.pursnew file+20

@@ -0,0 +1,20 @@

1+-- EXPECT: Unclosed string literal

2+module Test.CompileFail.UnclosedStringLiteral where

4+import Prelude

5+import Data.Maybe (Maybe(..))

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

7+import Type.Proxy (Proxy(..))

8+import Yoga.Postgres.Schema

10+type UsersTable = Table "users"

11+ ( id :: Int # PrimaryKey # AutoIncrement

12+ , name :: String

13+ , email :: String # Unique

14+ , age :: Maybe Int

15+ )

16+

17+usersTable :: Proxy UsersTable

18+usersTable = Proxy

19+

20+bad = from usersTable # selectAll # where_ @"name = 'unclosed"

compile-fail-tests/UnclosedStringLiteralJoin.pursnew file+29

@@ -0,0 +1,29 @@

1+-- EXPECT: Unclosed string literal

2+module Test.CompileFail.UnclosedStringLiteralJoin where

4+import Prelude

5+import Data.Maybe (Maybe(..))

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

7+import Type.Proxy (Proxy(..))

8+import Yoga.Postgres.Schema

10+type UsersTable = Table "users"

11+ ( id :: Int # PrimaryKey # AutoIncrement

12+ , name :: String

13+ , email :: String # Unique

14+ , age :: Maybe Int

15+ )

16+

17+type PostsTable = Table "posts"

18+ ( id :: Int # PrimaryKey # AutoIncrement

19+ , user_id :: Int

20+ , title :: String

21+ )

22+

23+usersTable :: Proxy UsersTable

24+usersTable = Proxy

25+

26+postsTable :: Proxy PostsTable

27+postsTable = Proxy

28+

29+bad = from usersTable # select @"users.name" # innerJoin @"users.id = 'unclosed" postsTable

compile-fail-tests/WhereWithoutDML.pursnew file+20

@@ -0,0 +1,20 @@

1+-- EXPECT: WHERE requires a preceding SELECT, UPDATE (set), or DELETE

2+module Test.CompileFail.WhereWithoutDML where

4+import Prelude

5+import Data.Maybe (Maybe(..))

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

7+import Type.Proxy (Proxy(..))

8+import Yoga.Postgres.Schema

10+type UsersTable = Table "users"

11+ ( id :: Int # PrimaryKey # AutoIncrement

12+ , name :: String

13+ , email :: String # Unique

14+ , age :: Maybe Int

15+ )

16+

17+usersTable :: Proxy UsersTable

18+usersTable = Proxy

19+

20+bad = from usersTable # where_ @"id = $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 @@

2525 },

2626 "dependencies": {

2727 "pg": "^8.11.0",

28− "postgres": "^3.4.8"

28+ "postgres": "^3.4.8",

29+ "uuid": "^13.0.0"

2930 }

3031}

spago.lock+64−15

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

66 "core": {

77 "dependencies": [

88 {

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

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

10+ },

11+ {

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

1013 },

1114 {

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

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

1720 {

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

1922 },

23+ {

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

25+ },

26+ {

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

28+ },

2029 {

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

2231 },

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

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

2534 },

2635 {

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"

2846 },

2947 {

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

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

3250 {

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

3452 },

53+ {

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

55+ },

3556 {

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

3758 },

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

4162 {

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

4364 },

65+ {

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

67+ },

4468 {

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

4670 },

4771 {

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

4973 },

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+ },

5086 {

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

5288 },

5389 {

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

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

5591 },

5692 {

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

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

94+ },

95+ {

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

5897 }

5998 ]

6099 },

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

84123 "packages": {

85124 "aff": {

86125 "type": "registry",

87− "version": "7.1.0",

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

126+ "version": "8.0.0",

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

89128 "dependencies": [

90129 "control",

91130 "datetime",

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

436475 },

437476 "heterogeneous": {

438477 "type": "registry",

439− "version": "0.6.0",

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

478+ "version": "0.7.0",

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

441480 "dependencies": [

442481 "either",

443482 "foldable-traversable",

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

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

917956 "dependencies": []

918957 },

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+ },

919968 "variant": {

920969 "type": "registry",

921970 "version": "8.0.0",

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

934983 },

935984 "yoga-json": {

936985 "type": "registry",

937− "version": "5.2.0",

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

986+ "version": "5.2.1",

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

939988 "dependencies": [

940989 "arrays",

941990 "bifunctors",

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

9731022 },

9741023 "yoga-sql-types": {

9751024 "type": "registry",

976− "version": "0.1.0",

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

1025+ "version": "0.2.0",

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

9781027 "dependencies": [

9791028 "arrays",

9801029 "bifunctors",

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

10021051 },

10031052 "yoga-test-docker": {

10041053 "type": "registry",

1005− "version": "0.1.0",

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

1054+ "version": "0.1.2",

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

10071056 "dependencies": [

10081057 "aff",

10091058 "datetime",

1010− "effect",

10111059 "exceptions",

1060+ "newtype",

10121061 "prelude"

10131062 ]

10141063 },

spago.yaml+18−5

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

33package:

44 name: yoga-postgres

55 publish:

6− version: 0.1.0

6+ version: 0.3.2

77 license: MIT

88 location:

99 githubOwner: rowtype-yoga

1010 githubRepo: purescript-yoga-postgres

1111 dependencies:

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

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

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

1314 - datetime: ">=6.1.0 <7.0.0"

1415 - effect: ">=4.0.0 <5.0.0"

1516 - either: ">=6.1.0 <7.0.0"

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

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

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

1720 - 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"

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

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

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

2128 - maybe: ">=6.0.0 <7.0.0"

2229 - newtype: ">=5.0.0 <6.0.0"

2330 - nullable: ">=6.0.0 <7.0.0"

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

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

2533 - 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"

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

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

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

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

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

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

2942 test:

3043 main: Test.Postgres.Main

3144 dependencies:

src/Yoga/Postgres.js+42−42

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

33// Create Postgres connection

44export const postgresImpl = (config) => {

5− // Support both individual config and connection string

6− if (config.connection) {

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

8− }

9−

10− return postgres({

11− host: config.host,

12− port: config.port,

13− database: config.database,

14− username: config.username,

15− password: config.password,

16− max: config.max,

17− idle_timeout: config.idle_timeout,

18− connect_timeout: config.connect_timeout,

19− ssl: config.ssl,

20− debug: config.debug,

21− onnotice: config.onnotice,

22− onparameter: config.onparameter,

23− // Pass through any other options

24− ...config

25− });

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

6+ const options = {

7+ ...configOptions,

8+ onnotice: config.onnotice

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

10+ : undefined,

11+ onparameter: config.onparameter

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

13+ : undefined

14+ };

15+

16+ return connection

17+ ? postgres(connection, options)

18+ : postgres(options);

2619};

2720

2821// Query operations

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

9285};

9386

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

95− if (txn._reserved) {

96− await txn._reserved`COMMIT`;

97− // Release the connection back to the pool

98− await txn._reserved.release();

88+ if (!txn._reserved) return;

89+

90+ const reserved = txn._reserved;

91+ txn._reserved = null;

92+ try {

93+ await reserved`COMMIT`;

94+ } finally {

95+ await reserved.release();

9996 }

10097};

10198

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

103− if (txn._reserved) {

104− await txn._reserved`ROLLBACK`;

105− // Release the connection back to the pool

106− await txn._reserved.release();

100+ if (!txn._reserved) return;

101+

102+ const reserved = txn._reserved;

103+ txn._reserved = null;

104+ try {

105+ await reserved`ROLLBACK`;

106+ } finally {

107+ await reserved.release();

107108 }

108109};

109110

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

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

112− const affAction = handler(txn);

113− return await affAction();

114− });

115−};

116111

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

118113 // Use the underlying SQL connection

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

147142

148143// Listen/Notify

149144

145+const listeners = new WeakMap();

146+

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

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

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

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

153150 });

151+ const byChannel = listeners.get(sql) || new Map();

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

153+ subscriptions.push(subscription);

154+ byChannel.set(channel, subscriptions);

155+ listeners.set(sql, byChannel);

154156};

155157

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

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

158− if (sql.listen.unlisten) {

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

160− }

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

162− return Promise.resolve();

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

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

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

162+ byChannel?.delete(channel);

163163};

164164

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

src/Yoga/Postgres.purs+18−8

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

33import Prelude

57import Data.Maybe (Maybe)

68import Data.Newtype (class Newtype)

79import Data.Nullable (Nullable)

810import Data.Nullable as Nullable

911import Data.Time.Duration (Milliseconds)

12+import Data.UUID (UUID)

13+import Data.UUID as UUID

1014import Effect (Effect)

11−import Effect.Aff (Aff)

15+import Effect.Aff (Aff, generalBracket)

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

1317import Foreign (Foreign)

1418import Prim.Row (class Union)

1519import Promise (Promise)

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

20+import Promise.Aff (toAffE) as Promise

1721import Unsafe.Coerce (unsafeCoerce)

1822

1923-- Opaque Postgres types

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

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

115119 toPGValue arr = unsafeCoerce (map toPGValue arr)

116120

121+instance ToPGValue UUID where

122+ toPGValue = toPGValue <<< UUID.toString

123+

117124instance ToPGValue Foreign where

118125 toPGValue = unsafeCoerce

119126

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

219226rollback :: Transaction -> Aff Unit

220227rollback = runEffectFn1 rollbackImpl >>> Promise.toAffE

221228

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

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

224229

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

226−transaction handler conn =

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

228− # Promise.toAffE

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

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

232+withTransaction operation conn =

233+ generalBracket (begin conn)

234+ { killed: \_ -> rollback

235+ , failed: \_ -> rollback

236+ , completed: \_ -> commit

237+ }

238+ operation

229239

230240-- Query within transaction

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

src/Yoga/Postgres/Client.pursdeleted−411

@@ -1,411 +0,0 @@

1−module Yoga.Postgres.Client where

2−

3−import Prelude

4−

5−import Data.Array (intercalate, mapWithIndex)

6−import Data.Maybe (Maybe)

7−import Data.Symbol (class IsSymbol, reflectSymbol)

8−import Effect.Aff (Aff)

9−import Prim.Boolean (True, False)

10−import Prim.Row (class Cons, class Lacks, class Union) as Row

11−import Prim.RowList as RL

12−import Prim.RowList (class RowToList)

13−import Prim.TypeError (class Fail, Text)

14−import Type.Proxy (Proxy(..))

15−import Type.RowList (class ListToRow)

16−import Yoga.JSON (class ReadForeign)

17−import Yoga.Postgres as PG

18−import Yoga.Postgres.Schema

19− ( class ColumnCountRL, class ColumnNamesRL, class ExtractType

20− , class FieldToPGValue, class InsertableColumnsRL, class RecordValuesRL

21− , class RequiredColumnsRL, class SetClauseRL, class StripColumnsRL

22− , class ValidateSetColumnsRL

23− , Table, PrimaryKey, AutoIncrement, Unique, Default

24− , ForeignKey, References, Nullable

25− , columnCountRL, columnNamesRL, fieldToPGValue, recordValuesRL, setClauseRL

26− , unsafeDecodeRow, unsafeDecodeRows

27− )

28−

29−-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

30−-- Type extraction from tables

31−-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

32−

33−class TableRow :: Type -> Row Type -> Constraint

34−class TableRow table row | table -> row

35−

36−instance

37− ( RowToList cols rl

38− , StripColumnsRL rl outRL

39− , ListToRow outRL row

40− ) =>

41− TableRow (Table name cols) row

42−

43−class InsertableRow :: Type -> Row Type -> Constraint

44−class InsertableRow table row | table -> row

45−

46−instance

47− ( RowToList cols rl

48− , InsertableColumnsRL rl insertRL

49− , ListToRow insertRL row

50− ) =>

51− InsertableRow (Table name cols) row

52−

53−-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

54−-- Primary key extraction

55−-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

56−

57−class HasPrimaryKeyConstraint :: Type -> Boolean -> Constraint

58−class HasPrimaryKeyConstraint a result | a -> result

59−

60−instance HasPrimaryKeyConstraint (PrimaryKey a) True

61−else instance HasPrimaryKeyConstraint a result => HasPrimaryKeyConstraint (AutoIncrement a) result

62−else instance HasPrimaryKeyConstraint a result => HasPrimaryKeyConstraint (Unique a) result

63−else instance HasPrimaryKeyConstraint a result => HasPrimaryKeyConstraint (Default s a) result

64−else instance HasPrimaryKeyConstraint a result => HasPrimaryKeyConstraint (ForeignKey t r c a) result

65−else instance HasPrimaryKeyConstraint a result => HasPrimaryKeyConstraint (Nullable a) result

66−else instance HasPrimaryKeyConstraint a False

67−

68−class FindPrimaryKeyRL :: RL.RowList Type -> Symbol -> Type -> Constraint

69−class FindPrimaryKeyRL rl colName colType | rl -> colName colType

70−

71−instance Fail (Text "Table has no primary key column") => FindPrimaryKeyRL RL.Nil "" Unit

72−

73−instance

74− ( HasPrimaryKeyConstraint entry isPK

75− , FindPrimaryKeyDecide isPK name entry tail colName colType

76− ) =>

77− FindPrimaryKeyRL (RL.Cons name entry tail) colName colType

78−

79−class FindPrimaryKeyDecide :: Boolean -> Symbol -> Type -> RL.RowList Type -> Symbol -> Type -> Constraint

80−class FindPrimaryKeyDecide isPK name entry tail colName colType | isPK name entry tail -> colName colType

81−

82−instance ExtractType entry colType => FindPrimaryKeyDecide True name entry tail name colType

83−instance FindPrimaryKeyRL tail colName colType => FindPrimaryKeyDecide False name entry tail colName colType

84−

85−class FindPrimaryKey :: Type -> Symbol -> Type -> Constraint

86−class FindPrimaryKey table colName colType | table -> colName colType

87−

88−instance

89− ( RowToList cols rl

90− , FindPrimaryKeyRL rl colName colType

91− ) =>

92− FindPrimaryKey (Table name cols) colName colType

93−

94−-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

95−-- Foreign key detection for auto-joins

96−-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

97−

98−class HasForeignKeyTo :: Type -> Symbol -> Boolean -> Constraint

99−class HasForeignKeyTo colType tableName result | colType tableName -> result

100−

101−instance HasForeignKeyTo (ForeignKey table References col a) table True

102−else instance HasForeignKeyTo a tn result => HasForeignKeyTo (PrimaryKey a) tn result

103−else instance HasForeignKeyTo a tn result => HasForeignKeyTo (AutoIncrement a) tn result

104−else instance HasForeignKeyTo a tn result => HasForeignKeyTo (Unique a) tn result

105−else instance HasForeignKeyTo a tn result => HasForeignKeyTo (Default s a) tn result

106−else instance HasForeignKeyTo a tn result => HasForeignKeyTo (Nullable a) tn result

107−else instance HasForeignKeyTo a tn False

108−

109−class ExtractForeignKeyCol :: Type -> Symbol -> Symbol -> Constraint

110−class ExtractForeignKeyCol colType tableName refCol | colType tableName -> refCol

111−

112−instance ExtractForeignKeyCol (ForeignKey table References col a) table col

113−else instance ExtractForeignKeyCol a tn col => ExtractForeignKeyCol (PrimaryKey a) tn col

114−else instance ExtractForeignKeyCol a tn col => ExtractForeignKeyCol (AutoIncrement a) tn col

115−else instance ExtractForeignKeyCol a tn col => ExtractForeignKeyCol (Unique a) tn col

116−else instance ExtractForeignKeyCol a tn col => ExtractForeignKeyCol (Default s a) tn col

117−else instance ExtractForeignKeyCol a tn col => ExtractForeignKeyCol (Nullable a) tn col

118−

119−class FindForeignKeyToRL :: RL.RowList Type -> Symbol -> Symbol -> Symbol -> Constraint

120−class FindForeignKeyToRL childRL parentName localCol parentCol | childRL parentName -> localCol parentCol

121−

122−instance

123− Fail (Text "No foreign key found referencing the target table")

124− => FindForeignKeyToRL RL.Nil parentName "" ""

125−

126−instance

127− ( HasForeignKeyTo entry parentName hasFK

128− , FindForeignKeyToDecide hasFK name entry tail parentName localCol parentCol

129− ) =>

130− FindForeignKeyToRL (RL.Cons name entry tail) parentName localCol parentCol

131−

132−class FindForeignKeyToDecide :: Boolean -> Symbol -> Type -> RL.RowList Type -> Symbol -> Symbol -> Symbol -> Constraint

133−class FindForeignKeyToDecide hasFK name entry tail parentName localCol parentCol

134− | hasFK name entry tail parentName -> localCol parentCol

135−

136−instance

137− ExtractForeignKeyCol entry parentName parentCol

138− => FindForeignKeyToDecide True name entry tail parentName name parentCol

139−

140−instance

141− FindForeignKeyToRL tail parentName localCol parentCol

142− => FindForeignKeyToDecide False name entry tail parentName localCol parentCol

143−

144−class FindForeignKeyTo :: Type -> Symbol -> Symbol -> Symbol -> Constraint

145−class FindForeignKeyTo childTable parentTableName localCol parentCol

146− | childTable parentTableName -> localCol parentCol

147−

148−instance

149− ( RowToList cols rl

150− , FindForeignKeyToRL rl parentName localCol parentCol

151− ) =>

152− FindForeignKeyTo (Table name cols) parentName localCol parentCol

153−

154−-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

155−-- CRUD operations

156−-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

157−

158−findAll

159− :: forall name cols row

160− . IsSymbol name

161− => TableRow (Table name cols) row

162− => ReadForeign { | row }

163− => Proxy (Table name cols)

164− -> PG.Connection

165− -> Aff (Array { | row })

166−findAll _ conn = do

167− result <- PG.query (PG.SQL sql) [] conn

168− pure (unsafeDecodeRows result.rows)

169− where

170− sql = "SELECT * FROM " <> reflectSymbol (Proxy :: Proxy name)

171−

172−findById

173− :: forall name cols row pkCol pkType

174− . IsSymbol name

175− => IsSymbol pkCol

176− => TableRow (Table name cols) row

177− => FindPrimaryKey (Table name cols) pkCol pkType

178− => FieldToPGValue pkType

179− => ReadForeign { | row }

180− => Proxy (Table name cols)

181− -> PG.Connection

182− -> pkType

183− -> Aff (Maybe { | row })

184−findById _ conn pk = do

185− result <- PG.queryOne (PG.SQL sql) [ fieldToPGValue pk ] conn

186− pure (result <#> unsafeDecodeRow)

187− where

188− sql = "SELECT * FROM " <> reflectSymbol (Proxy :: Proxy name)

189− <> " WHERE " <> reflectSymbol (Proxy :: Proxy pkCol) <> " = $1"

190−

191−create

192− :: forall name cols colsRL insertableRL insertable requiredRL required

193− optionalProvided missing userRow userRowRL row

194− . IsSymbol name

195− => RowToList cols colsRL

196− => InsertableColumnsRL colsRL insertableRL

197− => ListToRow insertableRL insertable

198− => RequiredColumnsRL insertableRL requiredRL

199− => ListToRow requiredRL required

200− => Row.Union required optionalProvided userRow

201− => Row.Union userRow missing insertable

202− => RowToList userRow userRowRL

203− => ColumnNamesRL userRowRL

204− => RecordValuesRL userRowRL userRow

205− => TableRow (Table name cols) row

206− => ReadForeign { | row }

207− => Proxy (Table name cols)

208− -> PG.Connection

209− -> { | userRow }

210− -> Aff (Maybe { | row })

211−create _ conn rec = do

212− result <- PG.queryOne (PG.SQL sql) values conn

213− pure (result <#> unsafeDecodeRow)

214− where

215− colNames = columnNamesRL (Proxy :: Proxy userRowRL)

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

217− sql = "INSERT INTO " <> reflectSymbol (Proxy :: Proxy name)

218− <> " (" <> intercalate ", " colNames <> ")"

219− <> " VALUES (" <> intercalate ", " placeholders <> ")"

220− <> " RETURNING *"

221− values = recordValuesRL (Proxy :: Proxy userRowRL) rec

222−

223−updateById

224− :: forall name cols row pkCol pkType setRow setRL

225− . IsSymbol name

226− => IsSymbol pkCol

227− => TableRow (Table name cols) row

228− => FindPrimaryKey (Table name cols) pkCol pkType

229− => RowToList setRow setRL

230− => ValidateSetColumnsRL setRL cols

231− => SetClauseRL setRL

232− => ColumnCountRL setRL

233− => RecordValuesRL setRL setRow

234− => FieldToPGValue pkType

235− => ReadForeign { | row }

236− => Proxy (Table name cols)

237− -> PG.Connection

238− -> pkType

239− -> { | setRow }

240− -> Aff (Maybe { | row })

241−updateById _ conn pk rec = do

242− result <- PG.queryOne (PG.SQL sql) values conn

243− pure (result <#> unsafeDecodeRow)

244− where

245− setClauses = setClauseRL (Proxy :: Proxy setRL) 1

246− setCount = columnCountRL (Proxy :: Proxy setRL)

247− sql = "UPDATE " <> reflectSymbol (Proxy :: Proxy name)

248− <> " SET " <> intercalate ", " setClauses

249− <> " WHERE " <> reflectSymbol (Proxy :: Proxy pkCol) <> " = $" <> show (setCount + 1)

250− <> " RETURNING *"

251− values = recordValuesRL (Proxy :: Proxy setRL) rec <> [ fieldToPGValue pk ]

252−

253−deleteById

254− :: forall name cols pkCol pkType

255− . IsSymbol name

256− => IsSymbol pkCol

257− => FindPrimaryKey (Table name cols) pkCol pkType

258− => FieldToPGValue pkType

259− => Proxy (Table name cols)

260− -> PG.Connection

261− -> pkType

262− -> Aff Int

263−deleteById _ conn pk =

264− PG.execute (PG.SQL sql) [ fieldToPGValue pk ] conn

265− where

266− sql = "DELETE FROM " <> reflectSymbol (Proxy :: Proxy name)

267− <> " WHERE " <> reflectSymbol (Proxy :: Proxy pkCol) <> " = $1"

268−

269−-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

270−-- Belongs-to join (many-to-one via row_to_json)

271−-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

272−

273−findWith

274− :: forall childName childCols parentName parentCols

275− childRow parentRow localCol parentCol rest result

276− . IsSymbol childName

277− => IsSymbol parentName

278− => IsSymbol localCol

279− => IsSymbol parentCol

280− => TableRow (Table childName childCols) childRow

281− => TableRow (Table parentName parentCols) parentRow

282− => FindForeignKeyTo (Table childName childCols) parentName localCol parentCol

283− => Row.Cons parentName { | parentRow } () rest

284− => Row.Cons childName { | childRow } rest result

285− => ReadForeign { | result }

286− => Proxy (Table childName childCols)

287− -> Proxy (Table parentName parentCols)

288− -> PG.Connection

289− -> Aff (Array { | result })

290−findWith _ _ conn = do

291− result <- PG.query (PG.SQL sql) [] conn

292− pure (unsafeDecodeRows result.rows)

293− where

294− childTbl = reflectSymbol (Proxy :: Proxy childName)

295− parentTbl = reflectSymbol (Proxy :: Proxy parentName)

296− localC = reflectSymbol (Proxy :: Proxy localCol)

297− parentC = reflectSymbol (Proxy :: Proxy parentCol)

298− sql = "SELECT row_to_json(c.*) AS \"" <> childTbl

299− <> "\", row_to_json(p.*) AS \"" <> parentTbl <> "\""

300− <> " FROM " <> childTbl <> " c"

301− <> " INNER JOIN " <> parentTbl <> " p ON c." <> localC <> " = p." <> parentC

302−

303−findByIdWith

304− :: forall childName childCols parentName parentCols

305− childRow parentRow localCol parentCol pkCol pkType rest result

306− . IsSymbol childName

307− => IsSymbol parentName

308− => IsSymbol localCol

309− => IsSymbol parentCol

310− => IsSymbol pkCol

311− => TableRow (Table childName childCols) childRow

312− => TableRow (Table parentName parentCols) parentRow

313− => FindForeignKeyTo (Table childName childCols) parentName localCol parentCol

314− => FindPrimaryKey (Table childName childCols) pkCol pkType

315− => FieldToPGValue pkType

316− => Row.Cons parentName { | parentRow } () rest

317− => Row.Cons childName { | childRow } rest result

318− => ReadForeign { | result }

319− => Proxy (Table childName childCols)

320− -> Proxy (Table parentName parentCols)

321− -> PG.Connection

322− -> pkType

323− -> Aff (Maybe { | result })

324−findByIdWith _ _ conn pk = do

325− result <- PG.queryOne (PG.SQL sql) [ fieldToPGValue pk ] conn

326− pure (result <#> unsafeDecodeRow)

327− where

328− childTbl = reflectSymbol (Proxy :: Proxy childName)

329− parentTbl = reflectSymbol (Proxy :: Proxy parentName)

330− localC = reflectSymbol (Proxy :: Proxy localCol)

331− parentC = reflectSymbol (Proxy :: Proxy parentCol)

332− pkColName = reflectSymbol (Proxy :: Proxy pkCol)

333− sql = "SELECT row_to_json(c.*) AS \"" <> childTbl

334− <> "\", row_to_json(p.*) AS \"" <> parentTbl <> "\""

335− <> " FROM " <> childTbl <> " c"

336− <> " INNER JOIN " <> parentTbl <> " p ON c." <> localC <> " = p." <> parentC

337− <> " WHERE c." <> pkColName <> " = $1"

338−

339−-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

340−-- Has-many include (one-to-many via json_agg subquery)

341−-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

342−

343−findIncluding

344− :: forall @label parentName parentCols childName childCols

345− parentRow childRow localCol parentCol result

346− . IsSymbol label

347− => IsSymbol parentName

348− => IsSymbol childName

349− => IsSymbol localCol

350− => IsSymbol parentCol

351− => TableRow (Table parentName parentCols) parentRow

352− => TableRow (Table childName childCols) childRow

353− => FindForeignKeyTo (Table childName childCols) parentName localCol parentCol

354− => Row.Cons label (Array { | childRow }) parentRow result

355− => Row.Lacks label parentRow

356− => ReadForeign { | result }

357− => Proxy (Table parentName parentCols)

358− -> Proxy (Table childName childCols)

359− -> PG.Connection

360− -> Aff (Array { | result })

361−findIncluding _ _ conn = do

362− result <- PG.query (PG.SQL sql) [] conn

363− pure (unsafeDecodeRows result.rows)

364− where

365− parentTbl = reflectSymbol (Proxy :: Proxy parentName)

366− childTbl = reflectSymbol (Proxy :: Proxy childName)

367− localC = reflectSymbol (Proxy :: Proxy localCol)

368− parentC = reflectSymbol (Proxy :: Proxy parentCol)

369− lbl = reflectSymbol (Proxy :: Proxy label)

370− sql = "SELECT p.*, COALESCE((SELECT json_agg(to_jsonb(c.*)) FROM "

371− <> childTbl <> " c WHERE c." <> localC <> " = p." <> parentC

372− <> "), '[]'::json) AS \"" <> lbl <> "\""

373− <> " FROM " <> parentTbl <> " p"

374−

375−findByIdIncluding

376− :: forall @label parentName parentCols childName childCols

377− parentRow childRow localCol parentCol pkCol pkType result

378− . IsSymbol label

379− => IsSymbol parentName

380− => IsSymbol childName

381− => IsSymbol localCol

382− => IsSymbol parentCol

383− => IsSymbol pkCol

384− => TableRow (Table parentName parentCols) parentRow

385− => TableRow (Table childName childCols) childRow

386− => FindForeignKeyTo (Table childName childCols) parentName localCol parentCol

387− => FindPrimaryKey (Table parentName parentCols) pkCol pkType

388− => FieldToPGValue pkType

389− => Row.Cons label (Array { | childRow }) parentRow result

390− => Row.Lacks label parentRow

391− => ReadForeign { | result }

392− => Proxy (Table parentName parentCols)

393− -> Proxy (Table childName childCols)

394− -> PG.Connection

395− -> pkType

396− -> Aff (Maybe { | result })

397−findByIdIncluding _ _ conn pk = do

398− result <- PG.queryOne (PG.SQL sql) [ fieldToPGValue pk ] conn

399− pure (result <#> unsafeDecodeRow)

400− where

401− parentTbl = reflectSymbol (Proxy :: Proxy parentName)

402− childTbl = reflectSymbol (Proxy :: Proxy childName)

403− localC = reflectSymbol (Proxy :: Proxy localCol)

404− parentC = reflectSymbol (Proxy :: Proxy parentCol)

405− pkColName = reflectSymbol (Proxy :: Proxy pkCol)

406− lbl = reflectSymbol (Proxy :: Proxy label)

407− sql = "SELECT p.*, COALESCE((SELECT json_agg(to_jsonb(c.*)) FROM "

408− <> childTbl <> " c WHERE c." <> localC <> " = p." <> parentC

409− <> "), '[]'::json) AS \"" <> lbl <> "\""

410− <> " FROM " <> parentTbl <> " p"

411− <> " WHERE p." <> pkColName <> " = $1"

src/Yoga/Postgres/Schema.purs+1550−199

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

33import Prelude

5−import Data.Array as Array

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

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

7−import Data.DateTime (DateTime)

7+import Data.Array as Array

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

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

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

11+import Data.Enum (fromEnum, toEnum)

12+import Data.Int as Int

813import Data.JSDate as JSDate

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

14+import Data.List.Types (NonEmptyList)

15+import Data.Map as Map

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

1017import Data.Newtype (class Newtype)

1118import Data.Nullable (toNullable)

12−import JS.BigInt (BigInt)

13−import Unsafe.Coerce (unsafeCoerce)

19+import Data.Number as Number

1420import Data.Reflectable (class Reflectable, reflectType)

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

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

21+import Data.String.CodeUnits as SCU

22+import Data.String.Common as Str

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

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

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

18−import Control.Monad.Except (runExcept)

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

20−import Data.Map as Map

2126import Data.Symbol (class IsSymbol, reflectSymbol)

22−import Type.Function (type (#))

23−import Effect.Aff (Aff)

24−import Foreign (Foreign, unsafeToForeign)

27+import Data.Time (Time(..))

28+import Data.Traversable (traverse)

29+import Data.UUID (UUID)

30+import Data.UUID as UUID

31+import Effect.Aff (Aff, throwError)

32+import Effect.Exception (error) as Exception

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

34+import JS.BigInt (BigInt)

2535import Prim.Boolean (True, False)

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

27−import Prim.RowList as RL

2837import Prim.RowList (class RowToList)

38+import Prim.RowList as RL

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

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

3141import Record (get) as Record

3242import Type.Proxy (Proxy(..))

3343import Type.RowList (class ListToRow)

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

44+import Unsafe.Coerce (unsafeCoerce)

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

3546import Yoga.Postgres as PG

3647

3748-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

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

5768

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

5970data Default val a

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

72+data DefaultExpr expression a

73+

6074

6175data References

6276

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

7892instance ReadForeign Jsonb where

7993 readImpl = pure <<< Jsonb

8094

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+

81267-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

82268-- Nullability: inferred from Maybe

83269-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

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

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

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

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

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

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

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

106293else instance ExtractType a a

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

130317instance PGTypeName BigInt where

131318 pgTypeName _ = "BIGINT"

132319

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+

133341instance PGTypeName Jsonb where

134342 pgTypeName _ = "JSONB"

135343

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

152360instance Reflectable val Int => RenderDefaultValue val Int where

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

154362

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

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

363+instance RenderDefaultValue True Boolean where

364+ renderDefaultValue _ _ = "DEFAULT true"

365+

366+instance RenderDefaultValue False Boolean where

367+ renderDefaultValue _ _ = "DEFAULT false"

368+

369+instance RenderDefaultValue "true" Boolean where

370+ renderDefaultValue _ _ = "DEFAULT true"

371+

372+instance RenderDefaultValue "false" Boolean where

373+ renderDefaultValue _ _ = "DEFAULT false"

374+

375+instance RenderDefaultValue "now()" TimestampTZ where

376+ renderDefaultValue _ _ = "DEFAULT now()"

377+

378+instance RenderDefaultValue "gen_random_uuid()" PGUUID where

379+ renderDefaultValue _ _ = "DEFAULT gen_random_uuid()"

380+

157381

158382class RenderConstraint a where

159383 renderConstraint :: Proxy a -> String

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

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

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

172396

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

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

174402 renderConstraint _ = joinConstraints

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

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

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

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

232460

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+

233466-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

234467-- INSERT SQL generation

235468-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

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

241474 isAutoGenerated _ = true

242475else instance IsAutoGenerated (Default v a) where

243476 isAutoGenerated _ = true

477+else instance IsAutoGenerated (DefaultExpr expression a) where

478+ isAutoGenerated _ = true

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

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

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

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

284519 insertSQLFor = do

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

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

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

288− "INSERT INTO " <> tableName

289− <> " ("

290− <> intercalate ", " cols

291− <> ")"

292− <> " VALUES ("

293− <> intercalate ", " placeholders

294− <> ")"

295− <> " RETURNING *"

522+ if Array.null cols then

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

524+ else do

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

526+ "INSERT INTO " <> tableName

527+ <> " ("

528+ <> intercalate ", " cols

529+ <> ")"

530+ <> " VALUES ("

531+ <> intercalate ", " placeholders

532+ <> ")"

533+ <> " RETURNING *"

296534

297535-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

298536-- SELECT SQL generation

@@ -415,6 +653,31 @@ class SkipSpacesGo head tail result | head tail -> result

415653instance SkipSpaces tail result => SkipSpacesGo " " tail result

416654else instance Symbol.Cons head tail result => SkipSpacesGo head tail result

417655

656+-- Skip a string literal: consume chars until closing single quote

657+class SkipStringLiteral :: Symbol -> Symbol -> Constraint

658+class SkipStringLiteral sym rest | sym -> rest

659+

660+instance Fail (Text "Unclosed string literal") => SkipStringLiteral "" rest

661+else instance

662+ ( Symbol.Cons h t sym

663+ , SkipStringLiteralGo h t rest

664+ ) =>

665+ SkipStringLiteral sym rest

666+

667+class SkipStringLiteralGo :: Symbol -> Symbol -> Symbol -> Constraint

668+class SkipStringLiteralGo head tail rest | head tail -> rest

669+

670+-- Closing quote: done

671+instance SkipStringLiteralGo "'" tail tail

672+-- End of string without closing quote

673+else instance Fail (Text "Unclosed string literal") => SkipStringLiteralGo h "" rest

674+-- Any other char: skip and continue

675+else instance

676+ ( Symbol.Cons nextH nextT tail

677+ , SkipStringLiteralGo nextH nextT rest

678+ ) =>

679+ SkipStringLiteralGo h tail rest

680+

418681-- Extract the first word from a Symbol (up to space or end)

419682class ExtractWord :: Symbol -> Symbol -> Symbol -> Constraint

420683class ExtractWord sym word rest | sym -> word rest

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

722985 ) =>

723986 ParseSelectHandleAS "as" afterKeyword colRef tables accRL outRL

724987

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+

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

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

727999

@@ -765,25 +1037,50 @@ instance

7651037

7661038else instance

7671039 ( Symbol.Cons h t tail

768− , ExtractUntilParenGo h t "" args afterParen

1040+ , ExtractUntilParenGo h t "" Z args afterParen

7691041 ) =>

7701042 ExtractUntilParen tail args afterParen

7711043

772−class ExtractUntilParenGo :: Symbol -> Symbol -> Symbol -> Symbol -> Symbol -> Constraint

773−class ExtractUntilParenGo head tail acc args afterParen | head tail acc -> args afterParen

1044+-- Peano depth counter for nested parentheses

1045+data Z

1046+

1047+data S :: Type -> Type

1048+data S n

1049+

1050+class ExtractUntilParenGo :: Symbol -> Symbol -> Symbol -> Type -> Symbol -> Symbol -> Constraint

1051+class ExtractUntilParenGo head tail acc depth args afterParen | head tail acc depth -> args afterParen

7741052

775−instance ExtractUntilParenGo ")" tail acc acc tail

1053+-- ) at depth zero: done

1054+instance ExtractUntilParenGo ")" tail acc Z acc tail

7761055

1056+-- ) at depth > 0: decrement depth, keep going

1057+else instance

1058+ ( Symbol.Append acc ")" acc'

1059+ , Symbol.Cons nextH nextT tail

1060+ , ExtractUntilParenGo nextH nextT acc' n args afterParen

1061+ ) =>

1062+ ExtractUntilParenGo ")" tail acc (S n) args afterParen

1063+

1064+-- ( : increment depth, keep going

1065+else instance

1066+ ( Symbol.Append acc "(" acc'

1067+ , Symbol.Cons nextH nextT tail

1068+ , ExtractUntilParenGo nextH nextT acc' (S depth) args afterParen

1069+ ) =>

1070+ ExtractUntilParenGo "(" tail acc depth args afterParen

1071+

1072+-- Unclosed paren at end of input

7771073else instance

7781074 Fail (Text "Unclosed parenthesis in SELECT clause") =>

779− ExtractUntilParenGo h "" acc args afterParen

1075+ ExtractUntilParenGo h "" acc depth args afterParen

7801076

1077+-- Any other char: accumulate

7811078else instance

7821079 ( Symbol.Append acc h acc'

7831080 , Symbol.Cons nextH nextT tail

784− , ExtractUntilParenGo nextH nextT acc' args afterParen

1081+ , ExtractUntilParenGo nextH nextT acc' depth args afterParen

7851082 ) =>

786− ExtractUntilParenGo h tail acc args afterParen

1083+ ExtractUntilParenGo h tail acc depth args afterParen

7871084

7881085-- Resolve aggregate argument: "*" -> Star, column ref -> unwrapped type

7891086data Star

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

7951092else instance ResolveAggregateArg "" tables Star

7961093else instance

7971094 ( SkipSpaces args trimmedFront

798− , ExtractWord trimmedFront col _rest

799− , ResolveAggregateArgCol col tables argType

1095+ , ExtractIdent trimmedFront col rest

1096+ , ResolveAggregateArgDispatch col rest tables argType

8001097 ) =>

8011098 ResolveAggregateArg args tables argType

8021099

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+

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

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

8051157

@@ -833,47 +1185,146 @@ else instance

8331185 ResolveAggregateArgColByHead head col tables unwrapped

8341186

8351187-- Map (funcName, argType) -> returnType

1188+-- Dispatches on first character to avoid linear search

8361189class AggregateReturnType :: Symbol -> Type -> Type -> Constraint

8371190class AggregateReturnType funcName argType returnType | funcName argType -> returnType

8381191

839−instance AggregateReturnType "COUNT" argType Int

840−else instance AggregateReturnType "count" argType Int

841−else instance AggregateReturnType "SUM" argType argType

842−else instance AggregateReturnType "sum" argType argType

843−else instance AggregateReturnType "AVG" argType Number

844−else instance AggregateReturnType "avg" argType Number

845−else instance AggregateReturnType "MIN" argType argType

846−else instance AggregateReturnType "min" argType argType

847−else instance AggregateReturnType "MAX" argType argType

848−else instance AggregateReturnType "max" argType argType

849−else instance AggregateReturnType "ARRAY_AGG" argType (Array argType)

850−else instance AggregateReturnType "array_agg" argType (Array argType)

851−else instance AggregateReturnType "STRING_AGG" argType String

852−else instance AggregateReturnType "string_agg" argType String

853−else instance AggregateReturnType "COALESCE" argType argType

854−else instance AggregateReturnType "coalesce" argType argType

855−-- Window functions

856−else instance AggregateReturnType "ROW_NUMBER" argType Int

857−else instance AggregateReturnType "row_number" argType Int

858−else instance AggregateReturnType "RANK" argType Int

859−else instance AggregateReturnType "rank" argType Int

860−else instance AggregateReturnType "DENSE_RANK" argType Int

861−else instance AggregateReturnType "dense_rank" argType Int

862−else instance AggregateReturnType "NTILE" argType Int

863−else instance AggregateReturnType "ntile" argType Int

864−else instance AggregateReturnType "LAG" argType argType

865−else instance AggregateReturnType "lag" argType argType

866−else instance AggregateReturnType "LEAD" argType argType

867−else instance AggregateReturnType "lead" argType argType

868−else instance AggregateReturnType "FIRST_VALUE" argType argType

869−else instance AggregateReturnType "first_value" argType argType

870−else instance AggregateReturnType "LAST_VALUE" argType argType

871−else instance AggregateReturnType "last_value" argType argType

872−else instance AggregateReturnType "NTH_VALUE" argType argType

873−else instance AggregateReturnType "nth_value" argType argType

1192+instance

1193+ ( Symbol.Cons head rest funcName

1194+ , AggregateReturnTypeByHead head funcName argType returnType

1195+ ) =>

1196+ AggregateReturnType funcName argType returnType

1197+

1198+class AggregateReturnTypeByHead :: Symbol -> Symbol -> Type -> Type -> Constraint

1199+class AggregateReturnTypeByHead head funcName argType returnType | head funcName argType -> returnType

1200+

1201+instance AggregateReturnTypeA funcName argType returnType => AggregateReturnTypeByHead "A" funcName argType returnType

1202+else instance AggregateReturnTypeA funcName argType returnType => AggregateReturnTypeByHead "a" funcName argType returnType

1203+else instance AggregateReturnTypeC funcName argType returnType => AggregateReturnTypeByHead "C" funcName argType returnType

1204+else instance AggregateReturnTypeC funcName argType returnType => AggregateReturnTypeByHead "c" funcName argType returnType

1205+else instance AggregateReturnTypeD funcName argType returnType => AggregateReturnTypeByHead "D" funcName argType returnType

1206+else instance AggregateReturnTypeD funcName argType returnType => AggregateReturnTypeByHead "d" funcName argType returnType

1207+else instance AggregateReturnTypeF funcName argType returnType => AggregateReturnTypeByHead "F" funcName argType returnType

1208+else instance AggregateReturnTypeF funcName argType returnType => AggregateReturnTypeByHead "f" funcName argType returnType

1209+else instance AggregateReturnTypeL funcName argType returnType => AggregateReturnTypeByHead "L" funcName argType returnType

1210+else instance AggregateReturnTypeL funcName argType returnType => AggregateReturnTypeByHead "l" funcName argType returnType

1211+else instance AggregateReturnTypeM funcName argType returnType => AggregateReturnTypeByHead "M" funcName argType returnType

1212+else instance AggregateReturnTypeM funcName argType returnType => AggregateReturnTypeByHead "m" funcName argType returnType

1213+else instance AggregateReturnTypeN funcName argType returnType => AggregateReturnTypeByHead "N" funcName argType returnType

1214+else instance AggregateReturnTypeN funcName argType returnType => AggregateReturnTypeByHead "n" funcName argType returnType

1215+else instance AggregateReturnTypeR funcName argType returnType => AggregateReturnTypeByHead "R" funcName argType returnType

1216+else instance AggregateReturnTypeR funcName argType returnType => AggregateReturnTypeByHead "r" funcName argType returnType

1217+else instance AggregateReturnTypeS funcName argType returnType => AggregateReturnTypeByHead "S" funcName argType returnType

1218+else instance AggregateReturnTypeS funcName argType returnType => AggregateReturnTypeByHead "s" funcName argType returnType

8741219else instance

8751220 Fail (Beside (Text "Unknown function: ") (Quote funcName)) =>

876− AggregateReturnType funcName argType returnType

1221+ AggregateReturnTypeByHead head funcName argType returnType

1222+

1223+-- A: AVG, ARRAY_AGG

1224+class AggregateReturnTypeA :: Symbol -> Type -> Type -> Constraint

1225+class AggregateReturnTypeA funcName argType returnType | funcName argType -> returnType

1226+

1227+instance AggregateReturnTypeA "AVG" argType Number

1228+else instance AggregateReturnTypeA "avg" argType Number

1229+else instance AggregateReturnTypeA "ARRAY_AGG" argType (Array argType)

1230+else instance AggregateReturnTypeA "array_agg" argType (Array argType)

1231+else instance

1232+ Fail (Beside (Text "Unknown function: ") (Quote funcName)) =>

1233+ AggregateReturnTypeA funcName argType returnType

1234+

1235+-- C: COUNT, COALESCE

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

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

1238+

1239+instance AggregateReturnTypeC "COUNT" argType BigInt

1240+else instance AggregateReturnTypeC "count" argType BigInt

1241+else instance AggregateReturnTypeC "COALESCE" argType argType

1242+else instance AggregateReturnTypeC "coalesce" argType argType

1243+else instance

1244+ Fail (Beside (Text "Unknown function: ") (Quote funcName)) =>

1245+ AggregateReturnTypeC funcName argType returnType

1246+

1247+-- D: DENSE_RANK

1248+class AggregateReturnTypeD :: Symbol -> Type -> Type -> Constraint

1249+class AggregateReturnTypeD funcName argType returnType | funcName argType -> returnType

1250+

1251+instance AggregateReturnTypeD "DENSE_RANK" argType Int

1252+else instance AggregateReturnTypeD "dense_rank" argType Int

1253+else instance

1254+ Fail (Beside (Text "Unknown function: ") (Quote funcName)) =>

1255+ AggregateReturnTypeD funcName argType returnType

1256+

1257+-- F: FIRST_VALUE

1258+class AggregateReturnTypeF :: Symbol -> Type -> Type -> Constraint

1259+class AggregateReturnTypeF funcName argType returnType | funcName argType -> returnType

1260+

1261+instance AggregateReturnTypeF "FIRST_VALUE" argType argType

1262+else instance AggregateReturnTypeF "first_value" argType argType

1263+else instance

1264+ Fail (Beside (Text "Unknown function: ") (Quote funcName)) =>

1265+ AggregateReturnTypeF funcName argType returnType

1266+

1267+-- L: LAG, LEAD, LAST_VALUE

1268+class AggregateReturnTypeL :: Symbol -> Type -> Type -> Constraint

1269+class AggregateReturnTypeL funcName argType returnType | funcName argType -> returnType

1270+

1271+instance AggregateReturnTypeL "LAG" argType argType

1272+else instance AggregateReturnTypeL "lag" argType argType

1273+else instance AggregateReturnTypeL "LEAD" argType argType

1274+else instance AggregateReturnTypeL "lead" argType argType

1275+else instance AggregateReturnTypeL "LAST_VALUE" argType argType

1276+else instance AggregateReturnTypeL "last_value" argType argType

1277+else instance

1278+ Fail (Beside (Text "Unknown function: ") (Quote funcName)) =>

1279+ AggregateReturnTypeL funcName argType returnType

1280+

1281+-- M: MIN, MAX

1282+class AggregateReturnTypeM :: Symbol -> Type -> Type -> Constraint

1283+class AggregateReturnTypeM funcName argType returnType | funcName argType -> returnType

1284+

1285+instance AggregateReturnTypeM "MIN" argType argType

1286+else instance AggregateReturnTypeM "min" argType argType

1287+else instance AggregateReturnTypeM "MAX" argType argType

1288+else instance AggregateReturnTypeM "max" argType argType

1289+else instance

1290+ Fail (Beside (Text "Unknown function: ") (Quote funcName)) =>

1291+ AggregateReturnTypeM funcName argType returnType

1292+

1293+-- N: NTILE, NTH_VALUE

1294+class AggregateReturnTypeN :: Symbol -> Type -> Type -> Constraint

1295+class AggregateReturnTypeN funcName argType returnType | funcName argType -> returnType

1296+

1297+instance AggregateReturnTypeN "NTILE" argType Int

1298+else instance AggregateReturnTypeN "ntile" argType Int

1299+else instance AggregateReturnTypeN "NTH_VALUE" argType argType

1300+else instance AggregateReturnTypeN "nth_value" argType argType

1301+else instance

1302+ Fail (Beside (Text "Unknown function: ") (Quote funcName)) =>

1303+ AggregateReturnTypeN funcName argType returnType

1304+

1305+-- R: ROW_NUMBER, RANK

1306+class AggregateReturnTypeR :: Symbol -> Type -> Type -> Constraint

1307+class AggregateReturnTypeR funcName argType returnType | funcName argType -> returnType

1308+

1309+instance AggregateReturnTypeR "ROW_NUMBER" argType Int

1310+else instance AggregateReturnTypeR "row_number" argType Int

1311+else instance AggregateReturnTypeR "RANK" argType Int

1312+else instance AggregateReturnTypeR "rank" argType Int

1313+else instance

1314+ Fail (Beside (Text "Unknown function: ") (Quote funcName)) =>

1315+ AggregateReturnTypeR funcName argType returnType

1316+

1317+-- S: SUM, STRING_AGG

1318+class AggregateReturnTypeS :: Symbol -> Type -> Type -> Constraint

1319+class AggregateReturnTypeS funcName argType returnType | funcName argType -> returnType

1320+

1321+instance AggregateReturnTypeS "SUM" argType argType

1322+else instance AggregateReturnTypeS "sum" argType argType

1323+else instance AggregateReturnTypeS "STRING_AGG" argType String

1324+else instance AggregateReturnTypeS "string_agg" argType String

1325+else instance

1326+ Fail (Beside (Text "Unknown function: ") (Quote funcName)) =>

1327+ AggregateReturnTypeS funcName argType returnType

8771328

8781329-- After aggregate ): require AS alias, then continue

8791330class ParseAfterAggregate :: Symbol -> Row (Row Type) -> Type -> RL.RowList Type -> RL.RowList Type -> Constraint

@@ -958,9 +1409,10 @@ else instance

9581409class ParseOverClauseByHead :: Symbol -> Symbol -> Row (Row Type) -> Type -> RL.RowList Type -> RL.RowList Type -> Constraint

9591410class ParseOverClauseByHead head tail tables returnType accRL outRL | head tail tables returnType accRL -> outRL

9601411

961−-- Open paren: extract until close paren, skip content, continue to AS

1412+-- Open paren: extract until close paren, validate content, continue to AS

9621413instance

963− ( ExtractUntilParen tail _overContent afterParen

1414+ ( ExtractUntilParen tail overContent afterParen

1415+ , ValidateOverContent overContent tables

9641416 , SkipSpaces afterParen rest

9651417 , ParseAfterAggregate rest tables returnType accRL outRL

9661418 ) =>

@@ -970,6 +1422,153 @@ else instance

9701422 Fail (Text "Expected ( after OVER") =>

9711423 ParseOverClauseByHead h t tables returnType accRL outRL

9721424

1425+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

1426+-- ValidateOverContent: validates PARTITION BY / ORDER BY inside OVER(...)

1427+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

1428+

1429+class ValidateOverContent :: Symbol -> Row (Row Type) -> Constraint

1430+class ValidateOverContent content tables

1431+

1432+instance ValidateOverContent "" tables

1433+

1434+else instance

1435+ ( SkipSpaces content content'

1436+ , ValidateOverContentTrimmed content' tables

1437+ ) =>

1438+ ValidateOverContent content tables

1439+

1440+class ValidateOverContentTrimmed :: Symbol -> Row (Row Type) -> Constraint

1441+class ValidateOverContentTrimmed content tables

1442+

1443+instance ValidateOverContentTrimmed "" tables

1444+

1445+else instance

1446+ ( ExtractWord content keyword rest

1447+ , ValidateOverKeyword keyword rest tables

1448+ ) =>

1449+ ValidateOverContentTrimmed content tables

1450+

1451+class ValidateOverKeyword :: Symbol -> Symbol -> Row (Row Type) -> Constraint

1452+class ValidateOverKeyword keyword rest tables

1453+

1454+instance

1455+ ( ExtractWord rest byWord afterBy

1456+ , AssertIsBy byWord

1457+ , ValidatePartitionByColumns afterBy tables

1458+ ) =>

1459+ ValidateOverKeyword "PARTITION" rest tables

1460+

1461+else instance

1462+ ( ExtractWord rest byWord afterBy

1463+ , AssertIsBy byWord

1464+ , ValidatePartitionByColumns afterBy tables

1465+ ) =>

1466+ ValidateOverKeyword "partition" rest tables

1467+

1468+else instance

1469+ ( ExtractWord rest byWord afterBy

1470+ , AssertIsBy byWord

1471+ , ValidateOrderBy afterBy tables

1472+ ) =>

1473+ ValidateOverKeyword "ORDER" rest tables

1474+

1475+else instance

1476+ ( ExtractWord rest byWord afterBy

1477+ , AssertIsBy byWord

1478+ , ValidateOrderBy afterBy tables

1479+ ) =>

1480+ ValidateOverKeyword "order" rest tables

1481+

1482+else instance

1483+ Fail (Text "Expected PARTITION BY or ORDER BY inside OVER clause") =>

1484+ ValidateOverKeyword keyword rest tables

1485+

1486+class AssertIsBy :: Symbol -> Constraint

1487+class AssertIsBy sym

1488+

1489+instance AssertIsBy "BY"

1490+else instance AssertIsBy "by"

1491+else instance Fail (Text "Expected BY after PARTITION or ORDER") => AssertIsBy sym

1492+

1493+-- ValidatePartitionByColumns: column list that terminates at ORDER keyword

1494+class ValidatePartitionByColumns :: Symbol -> Row (Row Type) -> Constraint

1495+class ValidatePartitionByColumns sym tables

1496+

1497+instance ValidatePartitionByColumns "" tables

1498+

1499+else instance

1500+ ( SkipSpaces sym sym'

1501+ , ValidatePartitionByColumnsTrimmed sym' tables

1502+ ) =>

1503+ ValidatePartitionByColumns sym tables

1504+

1505+class ValidatePartitionByColumnsTrimmed :: Symbol -> Row (Row Type) -> Constraint

1506+class ValidatePartitionByColumnsTrimmed sym tables

1507+

1508+instance ValidatePartitionByColumnsTrimmed "" tables

1509+

1510+else instance

1511+ ( Symbol.Cons h t sym

1512+ , ValidatePartitionByColumnsGo h t "" tables

1513+ ) =>

1514+ ValidatePartitionByColumnsTrimmed sym tables

1515+

1516+class ValidatePartitionByColumnsGo :: Symbol -> Symbol -> Symbol -> Row (Row Type) -> Constraint

1517+class ValidatePartitionByColumnsGo head tail acc tables

1518+

1519+-- Comma: flush column, continue

1520+instance

1521+ ( ResolveColumn acc tables typ

1522+ , SkipSpaces tail rest

1523+ , ValidatePartitionByColumnsTrimmed rest tables

1524+ ) =>

1525+ ValidatePartitionByColumnsGo "," tail acc tables

1526+

1527+-- Space: flush word, check if ORDER keyword or column

1528+else instance

1529+ ( SkipSpaces tail rest

1530+ , FlushPartitionWord acc rest tables

1531+ ) =>

1532+ ValidatePartitionByColumnsGo " " tail acc tables

1533+

1534+-- End of string: flush final column

1535+else instance

1536+ ( Symbol.Append acc h acc'

1537+ , ResolveColumn acc' tables typ

1538+ ) =>

1539+ ValidatePartitionByColumnsGo h "" acc tables

1540+

1541+-- Regular char: accumulate

1542+else instance

1543+ ( Symbol.Append acc h acc'

1544+ , Symbol.Cons nextH nextT tail

1545+ , ValidatePartitionByColumnsGo nextH nextT acc' tables

1546+ ) =>

1547+ ValidatePartitionByColumnsGo h tail acc tables

1548+

1549+class FlushPartitionWord :: Symbol -> Symbol -> Row (Row Type) -> Constraint

1550+class FlushPartitionWord word rest tables

1551+

1552+instance

1553+ ( ExtractWord rest byWord afterBy

1554+ , AssertIsBy byWord

1555+ , ValidateOrderBy afterBy tables

1556+ ) =>

1557+ FlushPartitionWord "ORDER" rest tables

1558+

1559+else instance

1560+ ( ExtractWord rest byWord afterBy

1561+ , AssertIsBy byWord

1562+ , ValidateOrderBy afterBy tables

1563+ ) =>

1564+ FlushPartitionWord "order" rest tables

1565+

1566+else instance

1567+ ( ResolveColumn word tables typ

1568+ , ValidatePartitionByColumnsTrimmed rest tables

1569+ ) =>

1570+ FlushPartitionWord word rest tables

1571+

9731572-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

9741573-- ParseWhere: parse "id = $id AND age > $age" -> params

9751574-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

@@ -979,7 +1578,7 @@ data NoType

9791578class ParseWhere :: Symbol -> Row (Row Type) -> Row Type -> Constraint

9801579class ParseWhere sym tables params | sym tables -> params

9811580

982−instance ParseWhere "" tables ()

1581+instance Fail (Text "Empty WHERE clause") => ParseWhere "" tables params

9831582else instance

9841583 ( Symbol.Cons h t sym

9851584 , ParseWhereGo h t "" NoType tables RL.Nil outRL

@@ -996,125 +1595,414 @@ instance

9961595 , SkipSpaces tail rest

9971596 , ParseWhereContinue rest currentType' tables paramsOut' paramsOut

9981597 ) =>

999− ParseWhereGo " " tail acc currentType tables paramsIn paramsOut

1598+ ParseWhereGo " " tail acc currentType tables paramsIn paramsOut

1599+

1600+-- Operators

1601+else instance (FlushWhereWord acc currentType tables paramsIn currentType' paramsOut', ParseWhereContinue tail currentType' tables paramsOut' paramsOut) => ParseWhereGo "=" tail acc currentType tables paramsIn paramsOut

1602+else instance (FlushWhereWord acc currentType tables paramsIn currentType' paramsOut', ParseWhereContinue tail currentType' tables paramsOut' paramsOut) => ParseWhereGo ">" tail acc currentType tables paramsIn paramsOut

1603+else instance (FlushWhereWord acc currentType tables paramsIn currentType' paramsOut', ParseWhereContinue tail currentType' tables paramsOut' paramsOut) => ParseWhereGo "<" tail acc currentType tables paramsIn paramsOut

1604+else instance (FlushWhereWord acc currentType tables paramsIn currentType' paramsOut', ParseWhereContinue tail currentType' tables paramsOut' paramsOut) => ParseWhereGo "!" tail acc currentType tables paramsIn paramsOut

1605+else instance (FlushWhereWord acc currentType tables paramsIn currentType' paramsOut', ParseWhereContinue tail currentType' tables paramsOut' paramsOut) => ParseWhereGo "(" tail acc currentType tables paramsIn paramsOut

1606+else instance (FlushWhereWord acc currentType tables paramsIn currentType' paramsOut', ParseWhereContinue tail currentType' tables paramsOut' paramsOut) => ParseWhereGo ")" tail acc currentType tables paramsIn paramsOut

1607+-- String literal: flush word, skip until closing quote

1608+else instance

1609+ ( FlushWhereWord acc currentType tables paramsIn currentType' paramsOut'

1610+ , SkipStringLiteral tail rest

1611+ , ParseWhereContinue rest currentType' tables paramsOut' paramsOut

1612+ ) =>

1613+ ParseWhereGo "'" tail acc currentType tables paramsIn paramsOut

1614+else instance (FlushWhereWord acc currentType tables paramsIn currentType' paramsOut', ParseWhereContinue tail currentType' tables paramsOut' paramsOut) => ParseWhereGo "@" tail acc currentType tables paramsIn paramsOut

1615+else instance (FlushWhereWord acc currentType tables paramsIn currentType' paramsOut', ParseWhereContinue tail currentType' tables paramsOut' paramsOut) => ParseWhereGo "?" tail acc currentType tables paramsIn paramsOut

1616+else instance (FlushWhereWord acc currentType tables paramsIn currentType' paramsOut', ParseWhereContinue tail currentType' tables paramsOut' paramsOut) => ParseWhereGo ":" tail acc currentType tables paramsIn paramsOut

1617+else instance (FlushWhereWord acc currentType tables paramsIn currentType' paramsOut', ParseWhereContinue tail currentType' tables paramsOut' paramsOut) => ParseWhereGo "~" tail acc currentType tables paramsIn paramsOut

1618+else instance (FlushWhereWord acc currentType tables paramsIn currentType' paramsOut', ParseWhereContinue tail currentType' tables paramsOut' paramsOut) => ParseWhereGo "#" tail acc currentType tables paramsIn paramsOut

1619+else instance (FlushWhereWord acc currentType tables paramsIn currentType' paramsOut', ParseWhereContinue tail currentType' tables paramsOut' paramsOut) => ParseWhereGo "," tail acc currentType tables paramsIn paramsOut

1620+

1621+-- End of string: flush final word

1622+else instance

1623+ ( Symbol.Append acc h acc'

1624+ , FlushWhereWord acc' currentType tables paramsIn _ct paramsOut

1625+ ) =>

1626+ ParseWhereGo h "" acc currentType tables paramsIn paramsOut

1627+

1628+-- Regular char (including dot): accumulate

1629+else instance

1630+ ( Symbol.Append acc h acc'

1631+ , Symbol.Cons nextH nextT tail

1632+ , ParseWhereGo nextH nextT acc' currentType tables paramsIn paramsOut

1633+ ) =>

1634+ ParseWhereGo h tail acc currentType tables paramsIn paramsOut

1635+

1636+class ParseWhereContinue :: Symbol -> Type -> Row (Row Type) -> RL.RowList Type -> RL.RowList Type -> Constraint

1637+class ParseWhereContinue sym currentType tables paramsIn paramsOut | sym currentType tables paramsIn -> paramsOut

1638+

1639+instance ParseWhereContinue "" currentType tables paramsIn paramsIn

1640+else instance

1641+ ( Symbol.Cons h t sym

1642+ , ParseWhereGo h t "" currentType tables paramsIn paramsOut

1643+ ) =>

1644+ ParseWhereContinue sym currentType tables paramsIn paramsOut

1645+

1646+-- Flush a word in WHERE context

1647+-- Dispatches on first character to avoid linear search through all keywords

1648+class FlushWhereWord :: Symbol -> Type -> Row (Row Type) -> RL.RowList Type -> Type -> RL.RowList Type -> Constraint

1649+class FlushWhereWord word currentType tables paramsIn currentTypeOut paramsOut | word currentType tables paramsIn -> currentTypeOut paramsOut

1650+

1651+instance FlushWhereWord "" currentType tables paramsIn currentType paramsIn

1652+-- Most common SQL keywords matched directly for fast resolution

1653+else instance FlushWhereWord "AND" currentType tables paramsIn currentType paramsIn

1654+else instance FlushWhereWord "and" currentType tables paramsIn currentType paramsIn

1655+else instance FlushWhereWord "OR" currentType tables paramsIn currentType paramsIn

1656+else instance FlushWhereWord "or" currentType tables paramsIn currentType paramsIn

1657+else instance FlushWhereWord "NOT" currentType tables paramsIn currentType paramsIn

1658+else instance FlushWhereWord "not" currentType tables paramsIn currentType paramsIn

1659+else instance FlushWhereWord "IS" currentType tables paramsIn currentType paramsIn

1660+else instance FlushWhereWord "is" currentType tables paramsIn currentType paramsIn

1661+else instance FlushWhereWord "NULL" currentType tables paramsIn currentType paramsIn

1662+else instance FlushWhereWord "null" currentType tables paramsIn currentType paramsIn

1663+-- Everything else: dispatch on first character

1664+else instance

1665+ ( Symbol.Cons head rest word

1666+ , FlushWhereWordByHead head word currentType tables paramsIn currentTypeOut paramsOut

1667+ ) =>

1668+ FlushWhereWord word currentType tables paramsIn currentTypeOut paramsOut

1669+

1670+class FlushWhereWordByHead :: Symbol -> Symbol -> Type -> Row (Row Type) -> RL.RowList Type -> Type -> RL.RowList Type -> Constraint

1671+class FlushWhereWordByHead head word currentType tables paramsIn currentTypeOut paramsOut | head word currentType tables paramsIn -> currentTypeOut paramsOut

1672+

1673+-- $param: emit with currentType

1674+instance

1675+ ( Symbol.Cons "$" paramName word

1676+ ) =>

1677+ FlushWhereWordByHead "$" word currentType tables paramsIn currentType (RL.Cons paramName currentType paramsIn)

1678+

1679+-- Digit: number literal, pass through

1680+else instance FlushWhereWordByHead "0" word currentType tables paramsIn currentType paramsIn

1681+else instance FlushWhereWordByHead "1" word currentType tables paramsIn currentType paramsIn

1682+else instance FlushWhereWordByHead "2" word currentType tables paramsIn currentType paramsIn

1683+else instance FlushWhereWordByHead "3" word currentType tables paramsIn currentType paramsIn

1684+else instance FlushWhereWordByHead "4" word currentType tables paramsIn currentType paramsIn

1685+else instance FlushWhereWordByHead "5" word currentType tables paramsIn currentType paramsIn

1686+else instance FlushWhereWordByHead "6" word currentType tables paramsIn currentType paramsIn

1687+else instance FlushWhereWordByHead "7" word currentType tables paramsIn currentType paramsIn

1688+else instance FlushWhereWordByHead "8" word currentType tables paramsIn currentType paramsIn

1689+else instance FlushWhereWordByHead "9" word currentType tables paramsIn currentType paramsIn

1690+else instance FlushWhereWordByHead "*" word currentType tables paramsIn currentType paramsIn

1691+

1692+-- Letters with keywords: dispatch to per-letter helpers

1693+else instance FlushWhereWordA word currentType tables paramsIn currentTypeOut paramsOut => FlushWhereWordByHead "A" word currentType tables paramsIn currentTypeOut paramsOut

1694+else instance FlushWhereWordA word currentType tables paramsIn currentTypeOut paramsOut => FlushWhereWordByHead "a" word currentType tables paramsIn currentTypeOut paramsOut

1695+else instance FlushWhereWordB word currentType tables paramsIn currentTypeOut paramsOut => FlushWhereWordByHead "B" word currentType tables paramsIn currentTypeOut paramsOut

1696+else instance FlushWhereWordB word currentType tables paramsIn currentTypeOut paramsOut => FlushWhereWordByHead "b" word currentType tables paramsIn currentTypeOut paramsOut

1697+else instance FlushWhereWordC word currentType tables paramsIn currentTypeOut paramsOut => FlushWhereWordByHead "C" word currentType tables paramsIn currentTypeOut paramsOut

1698+else instance FlushWhereWordC word currentType tables paramsIn currentTypeOut paramsOut => FlushWhereWordByHead "c" word currentType tables paramsIn currentTypeOut paramsOut

1699+else instance FlushWhereWordD word currentType tables paramsIn currentTypeOut paramsOut => FlushWhereWordByHead "D" word currentType tables paramsIn currentTypeOut paramsOut

1700+else instance FlushWhereWordD word currentType tables paramsIn currentTypeOut paramsOut => FlushWhereWordByHead "d" word currentType tables paramsIn currentTypeOut paramsOut

1701+else instance FlushWhereWordE word currentType tables paramsIn currentTypeOut paramsOut => FlushWhereWordByHead "E" word currentType tables paramsIn currentTypeOut paramsOut

1702+else instance FlushWhereWordE word currentType tables paramsIn currentTypeOut paramsOut => FlushWhereWordByHead "e" word currentType tables paramsIn currentTypeOut paramsOut

1703+else instance FlushWhereWordF word currentType tables paramsIn currentTypeOut paramsOut => FlushWhereWordByHead "F" word currentType tables paramsIn currentTypeOut paramsOut

1704+else instance FlushWhereWordF word currentType tables paramsIn currentTypeOut paramsOut => FlushWhereWordByHead "f" word currentType tables paramsIn currentTypeOut paramsOut

1705+else instance FlushWhereWordI word currentType tables paramsIn currentTypeOut paramsOut => FlushWhereWordByHead "I" word currentType tables paramsIn currentTypeOut paramsOut

1706+else instance FlushWhereWordI word currentType tables paramsIn currentTypeOut paramsOut => FlushWhereWordByHead "i" word currentType tables paramsIn currentTypeOut paramsOut

1707+else instance FlushWhereWordJ word currentType tables paramsIn currentTypeOut paramsOut => FlushWhereWordByHead "J" word currentType tables paramsIn currentTypeOut paramsOut

1708+else instance FlushWhereWordJ word currentType tables paramsIn currentTypeOut paramsOut => FlushWhereWordByHead "j" word currentType tables paramsIn currentTypeOut paramsOut

1709+else instance FlushWhereWordL word currentType tables paramsIn currentTypeOut paramsOut => FlushWhereWordByHead "L" word currentType tables paramsIn currentTypeOut paramsOut

1710+else instance FlushWhereWordL word currentType tables paramsIn currentTypeOut paramsOut => FlushWhereWordByHead "l" word currentType tables paramsIn currentTypeOut paramsOut

1711+else instance FlushWhereWordM word currentType tables paramsIn currentTypeOut paramsOut => FlushWhereWordByHead "M" word currentType tables paramsIn currentTypeOut paramsOut

1712+else instance FlushWhereWordM word currentType tables paramsIn currentTypeOut paramsOut => FlushWhereWordByHead "m" word currentType tables paramsIn currentTypeOut paramsOut

1713+else instance FlushWhereWordN word currentType tables paramsIn currentTypeOut paramsOut => FlushWhereWordByHead "N" word currentType tables paramsIn currentTypeOut paramsOut

1714+else instance FlushWhereWordN word currentType tables paramsIn currentTypeOut paramsOut => FlushWhereWordByHead "n" word currentType tables paramsIn currentTypeOut paramsOut

1715+else instance FlushWhereWordS word currentType tables paramsIn currentTypeOut paramsOut => FlushWhereWordByHead "S" word currentType tables paramsIn currentTypeOut paramsOut

1716+else instance FlushWhereWordS word currentType tables paramsIn currentTypeOut paramsOut => FlushWhereWordByHead "s" word currentType tables paramsIn currentTypeOut paramsOut

1717+else instance FlushWhereWordT word currentType tables paramsIn currentTypeOut paramsOut => FlushWhereWordByHead "T" word currentType tables paramsIn currentTypeOut paramsOut

1718+else instance FlushWhereWordT word currentType tables paramsIn currentTypeOut paramsOut => FlushWhereWordByHead "t" word currentType tables paramsIn currentTypeOut paramsOut

1719+else instance FlushWhereWordU word currentType tables paramsIn currentTypeOut paramsOut => FlushWhereWordByHead "U" word currentType tables paramsIn currentTypeOut paramsOut

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

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

1722+else 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

1727+

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

1729+else instance

1730+ ( ResolveColumn word tables entry

1731+ , ExtractType entry typ

1732+ , UnwrapMaybe typ unwrapped

1733+ ) =>

1734+ FlushWhereWordByHead head word currentType tables paramsIn unwrapped paramsIn

1735+

1736+-- Per-letter keyword helpers

1737+

1738+class FlushWhereWordA :: Symbol -> Type -> Row (Row Type) -> RL.RowList Type -> Type -> RL.RowList Type -> Constraint

1739+class FlushWhereWordA word currentType tables paramsIn currentTypeOut paramsOut | word currentType tables paramsIn -> currentTypeOut paramsOut

1740+

1741+instance FlushWhereWordA "ABS" currentType tables paramsIn currentType paramsIn

1742+else instance FlushWhereWordA "abs" currentType tables paramsIn currentType paramsIn

1743+else instance FlushWhereWordA "ANY" currentType tables paramsIn (Array currentType) paramsIn

1744+else instance FlushWhereWordA "any" currentType tables paramsIn (Array currentType) paramsIn

1745+else instance FlushWhereWordA "ALL" currentType tables paramsIn (Array currentType) paramsIn

1746+else instance FlushWhereWordA "all" currentType tables paramsIn (Array currentType) paramsIn

1747+else instance FlushWhereWordA "AS" currentType tables paramsIn currentType paramsIn

1748+else instance FlushWhereWordA "as" currentType tables paramsIn currentType paramsIn

1749+else instance FlushWhereWordA "AVG" currentType tables paramsIn Number paramsIn

1750+else instance FlushWhereWordA "avg" currentType tables paramsIn Number paramsIn

1751+else instance FlushWhereWordA "ARRAY_AGG" currentType tables paramsIn currentType paramsIn

1752+else instance FlushWhereWordA "array_agg" currentType tables paramsIn currentType paramsIn

1753+else instance

1754+ ( ResolveColumn word tables entry

1755+ , ExtractType entry typ

1756+ , UnwrapMaybe typ unwrapped

1757+ ) =>

1758+ FlushWhereWordA word currentType tables paramsIn unwrapped paramsIn

1759+

1760+class FlushWhereWordB :: Symbol -> Type -> Row (Row Type) -> RL.RowList Type -> Type -> RL.RowList Type -> Constraint

1761+class FlushWhereWordB word currentType tables paramsIn currentTypeOut paramsOut | word currentType tables paramsIn -> currentTypeOut paramsOut

1762+

1763+instance FlushWhereWordB "BETWEEN" currentType tables paramsIn currentType paramsIn

1764+else instance FlushWhereWordB "between" currentType tables paramsIn currentType paramsIn

1765+else instance FlushWhereWordB "bigint" currentType tables paramsIn currentType paramsIn

1766+else instance FlushWhereWordB "boolean" currentType tables paramsIn currentType paramsIn

1767+else instance

1768+ ( ResolveColumn word tables entry

1769+ , ExtractType entry typ

1770+ , UnwrapMaybe typ unwrapped

1771+ ) =>

1772+ FlushWhereWordB word currentType tables paramsIn unwrapped paramsIn

1773+

1774+class FlushWhereWordC :: Symbol -> Type -> Row (Row Type) -> RL.RowList Type -> Type -> RL.RowList Type -> Constraint

1775+class FlushWhereWordC word currentType tables paramsIn currentTypeOut paramsOut | word currentType tables paramsIn -> currentTypeOut paramsOut

1776+

1777+instance FlushWhereWordC "CAST" currentType tables paramsIn currentType paramsIn

1778+else instance FlushWhereWordC "cast" currentType tables paramsIn currentType paramsIn

1779+else instance FlushWhereWordC "CEIL" currentType tables paramsIn currentType paramsIn

1780+else instance FlushWhereWordC "ceil" currentType tables paramsIn currentType paramsIn

1781+else instance FlushWhereWordC "COALESCE" currentType tables paramsIn currentType paramsIn

1782+else instance FlushWhereWordC "coalesce" currentType tables paramsIn currentType paramsIn

1783+else instance FlushWhereWordC "CONCAT" currentType tables paramsIn currentType paramsIn

1784+else instance FlushWhereWordC "concat" currentType tables paramsIn currentType paramsIn

1785+else instance FlushWhereWordC "COUNT" currentType tables paramsIn Int paramsIn

1786+else instance FlushWhereWordC "count" currentType tables paramsIn Int paramsIn

1787+else instance FlushWhereWordC "CURRENT_DATE" currentType tables paramsIn currentType paramsIn

1788+else instance FlushWhereWordC "current_date" currentType tables paramsIn currentType paramsIn

1789+else instance FlushWhereWordC "CURRENT_TIMESTAMP" currentType tables paramsIn currentType paramsIn

1790+else instance FlushWhereWordC "current_timestamp" currentType tables paramsIn currentType paramsIn

1791+else instance

1792+ ( ResolveColumn word tables entry

1793+ , ExtractType entry typ

1794+ , UnwrapMaybe typ unwrapped

1795+ ) =>

1796+ FlushWhereWordC word currentType tables paramsIn unwrapped paramsIn

1797+

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

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

1800+

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

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

1803+else instance

1804+ ( ResolveColumn word tables entry

1805+ , ExtractType entry typ

1806+ , UnwrapMaybe typ unwrapped

1807+ ) =>

1808+ FlushWhereWordD word currentType tables paramsIn unwrapped paramsIn

1809+

1810+class FlushWhereWordE :: Symbol -> Type -> Row (Row Type) -> RL.RowList Type -> Type -> RL.RowList Type -> Constraint

1811+class FlushWhereWordE word currentType tables paramsIn currentTypeOut paramsOut | word currentType tables paramsIn -> currentTypeOut paramsOut

1812+

1813+instance FlushWhereWordE "EXISTS" currentType tables paramsIn currentType paramsIn

1814+else instance FlushWhereWordE "exists" currentType tables paramsIn currentType paramsIn

1815+else instance

1816+ ( ResolveColumn word tables entry

1817+ , ExtractType entry typ

1818+ , UnwrapMaybe typ unwrapped

1819+ ) =>

1820+ FlushWhereWordE word currentType tables paramsIn unwrapped paramsIn

1821+

1822+class FlushWhereWordF :: Symbol -> Type -> Row (Row Type) -> RL.RowList Type -> Type -> RL.RowList Type -> Constraint

1823+class FlushWhereWordF word currentType tables paramsIn currentTypeOut paramsOut | word currentType tables paramsIn -> currentTypeOut paramsOut

1824+

1825+instance FlushWhereWordF "FALSE" currentType tables paramsIn currentType paramsIn

1826+else instance FlushWhereWordF "false" currentType tables paramsIn currentType paramsIn

1827+else instance FlushWhereWordF "FLOOR" currentType tables paramsIn currentType paramsIn

1828+else instance FlushWhereWordF "floor" currentType tables paramsIn currentType paramsIn

1829+else instance

1830+ ( ResolveColumn word tables entry

1831+ , ExtractType entry typ

1832+ , UnwrapMaybe typ unwrapped

1833+ ) =>

1834+ FlushWhereWordF word currentType tables paramsIn unwrapped paramsIn

1835+

1836+class FlushWhereWordI :: Symbol -> Type -> Row (Row Type) -> RL.RowList Type -> Type -> RL.RowList Type -> Constraint

1837+class FlushWhereWordI word currentType tables paramsIn currentTypeOut paramsOut | word currentType tables paramsIn -> currentTypeOut paramsOut

1838+

1839+instance FlushWhereWordI "IN" currentType tables paramsIn (Array currentType) paramsIn

1840+else instance FlushWhereWordI "in" currentType tables paramsIn (Array currentType) paramsIn

1841+else instance FlushWhereWordI "ILIKE" currentType tables paramsIn currentType paramsIn

1842+else instance FlushWhereWordI "ilike" currentType tables paramsIn currentType paramsIn

1843+else instance FlushWhereWordI "integer" currentType tables paramsIn currentType paramsIn

1844+else instance FlushWhereWordI "int" currentType tables paramsIn currentType paramsIn

1845+else instance

1846+ ( ResolveColumn word tables entry

1847+ , ExtractType entry typ

1848+ , UnwrapMaybe typ unwrapped

1849+ ) =>

1850+ FlushWhereWordI word currentType tables paramsIn unwrapped paramsIn

1851+

1852+class FlushWhereWordJ :: Symbol -> Type -> Row (Row Type) -> RL.RowList Type -> Type -> RL.RowList Type -> Constraint

1853+class FlushWhereWordJ word currentType tables paramsIn currentTypeOut paramsOut | word currentType tables paramsIn -> currentTypeOut paramsOut

1854+

1855+instance FlushWhereWordJ "jsonb" currentType tables paramsIn currentType paramsIn

1856+else instance FlushWhereWordJ "json" currentType tables paramsIn currentType paramsIn

1857+else instance

1858+ ( ResolveColumn word tables entry

1859+ , ExtractType entry typ

1860+ , UnwrapMaybe typ unwrapped

1861+ ) =>

1862+ FlushWhereWordJ word currentType tables paramsIn unwrapped paramsIn

1863+

1864+class FlushWhereWordL :: Symbol -> Type -> Row (Row Type) -> RL.RowList Type -> Type -> RL.RowList Type -> Constraint

1865+class FlushWhereWordL word currentType tables paramsIn currentTypeOut paramsOut | word currentType tables paramsIn -> currentTypeOut paramsOut

1866+

1867+instance FlushWhereWordL "LEAST" currentType tables paramsIn currentType paramsIn

1868+else instance FlushWhereWordL "least" currentType tables paramsIn currentType paramsIn

1869+else instance FlushWhereWordL "LENGTH" currentType tables paramsIn Int paramsIn

1870+else instance FlushWhereWordL "length" currentType tables paramsIn Int paramsIn

1871+else instance FlushWhereWordL "LIKE" currentType tables paramsIn currentType paramsIn

1872+else instance FlushWhereWordL "like" currentType tables paramsIn currentType paramsIn

1873+else instance FlushWhereWordL "LOWER" currentType tables paramsIn String paramsIn

1874+else instance FlushWhereWordL "lower" currentType tables paramsIn String paramsIn

1875+else instance

1876+ ( ResolveColumn word tables entry

1877+ , ExtractType entry typ

1878+ , UnwrapMaybe typ unwrapped

1879+ ) =>

1880+ FlushWhereWordL word currentType tables paramsIn unwrapped paramsIn

1881+

1882+class FlushWhereWordM :: Symbol -> Type -> Row (Row Type) -> RL.RowList Type -> Type -> RL.RowList Type -> Constraint

1883+class FlushWhereWordM word currentType tables paramsIn currentTypeOut paramsOut | word currentType tables paramsIn -> currentTypeOut paramsOut

1884+

1885+instance FlushWhereWordM "MIN" currentType tables paramsIn currentType paramsIn

1886+else instance FlushWhereWordM "min" currentType tables paramsIn currentType paramsIn

1887+else instance FlushWhereWordM "MAX" currentType tables paramsIn currentType paramsIn

1888+else instance FlushWhereWordM "max" currentType tables paramsIn currentType paramsIn

1889+else instance

1890+ ( ResolveColumn word tables entry

1891+ , ExtractType entry typ

1892+ , UnwrapMaybe typ unwrapped

1893+ ) =>

1894+ FlushWhereWordM word currentType tables paramsIn unwrapped paramsIn

10001895

1001−-- Operators

1002−else instance (FlushWhereWord acc currentType tables paramsIn currentType' paramsOut', ParseWhereContinue tail currentType' tables paramsOut' paramsOut) => ParseWhereGo "=" tail acc currentType tables paramsIn paramsOut

1003−else instance (FlushWhereWord acc currentType tables paramsIn currentType' paramsOut', ParseWhereContinue tail currentType' tables paramsOut' paramsOut) => ParseWhereGo ">" tail acc currentType tables paramsIn paramsOut

1004−else instance (FlushWhereWord acc currentType tables paramsIn currentType' paramsOut', ParseWhereContinue tail currentType' tables paramsOut' paramsOut) => ParseWhereGo "<" tail acc currentType tables paramsIn paramsOut

1005−else instance (FlushWhereWord acc currentType tables paramsIn currentType' paramsOut', ParseWhereContinue tail currentType' tables paramsOut' paramsOut) => ParseWhereGo "!" tail acc currentType tables paramsIn paramsOut

1006−else instance (FlushWhereWord acc currentType tables paramsIn currentType' paramsOut', ParseWhereContinue tail currentType' tables paramsOut' paramsOut) => ParseWhereGo "(" tail acc currentType tables paramsIn paramsOut

1007−else instance (FlushWhereWord acc currentType tables paramsIn currentType' paramsOut', ParseWhereContinue tail currentType' tables paramsOut' paramsOut) => ParseWhereGo ")" tail acc currentType tables paramsIn paramsOut

1008−else instance (FlushWhereWord acc currentType tables paramsIn currentType' paramsOut', ParseWhereContinue tail currentType' tables paramsOut' paramsOut) => ParseWhereGo "'" tail acc currentType tables paramsIn paramsOut

1009−else instance (FlushWhereWord acc currentType tables paramsIn currentType' paramsOut', ParseWhereContinue tail currentType' tables paramsOut' paramsOut) => ParseWhereGo "@" tail acc currentType tables paramsIn paramsOut

1010−else instance (FlushWhereWord acc currentType tables paramsIn currentType' paramsOut', ParseWhereContinue tail currentType' tables paramsOut' paramsOut) => ParseWhereGo "?" tail acc currentType tables paramsIn paramsOut

1011−else instance (FlushWhereWord acc currentType tables paramsIn currentType' paramsOut', ParseWhereContinue tail currentType' tables paramsOut' paramsOut) => ParseWhereGo ":" tail acc currentType tables paramsIn paramsOut

1012−else instance (FlushWhereWord acc currentType tables paramsIn currentType' paramsOut', ParseWhereContinue tail currentType' tables paramsOut' paramsOut) => ParseWhereGo "~" tail acc currentType tables paramsIn paramsOut

1013−else instance (FlushWhereWord acc currentType tables paramsIn currentType' paramsOut', ParseWhereContinue tail currentType' tables paramsOut' paramsOut) => ParseWhereGo "#" tail acc currentType tables paramsIn paramsOut

1896+class FlushWhereWordN :: Symbol -> Type -> Row (Row Type) -> RL.RowList Type -> Type -> RL.RowList Type -> Constraint

1897+class FlushWhereWordN word currentType tables paramsIn currentTypeOut paramsOut | word currentType tables paramsIn -> currentTypeOut paramsOut

10141898

1015−-- End of string: flush final word

1899+instance FlushWhereWordN "NOT" currentType tables paramsIn currentType paramsIn -- unreachable (caught by FlushWhereWord directly) but included for self-containedness

1900+else instance FlushWhereWordN "not" currentType tables paramsIn currentType paramsIn

1901+else instance FlushWhereWordN "NOW" currentType tables paramsIn currentType paramsIn

1902+else instance FlushWhereWordN "now" currentType tables paramsIn currentType paramsIn

1903+else instance FlushWhereWordN "NULL" currentType tables paramsIn currentType paramsIn

1904+else instance FlushWhereWordN "null" currentType tables paramsIn currentType paramsIn

1905+else instance FlushWhereWordN "NULLIF" currentType tables paramsIn currentType paramsIn

1906+else instance FlushWhereWordN "nullif" currentType tables paramsIn currentType paramsIn

10161907else instance

1017− ( Symbol.Append acc h acc'

1018− , FlushWhereWord acc' currentType tables paramsIn _ct paramsOut

1908+ ( ResolveColumn word tables entry

1909+ , ExtractType entry typ

1910+ , UnwrapMaybe typ unwrapped

10191911 ) =>

1020− ParseWhereGo h "" acc currentType tables paramsIn paramsOut

1912+ FlushWhereWordN word currentType tables paramsIn unwrapped paramsIn

10211913

1022−-- Regular char (including dot): accumulate

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

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

1916+

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

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

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

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

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

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

10231923else instance

1024− ( Symbol.Append acc h acc'

1025− , Symbol.Cons nextH nextT tail

1026− , ParseWhereGo nextH nextT acc' currentType tables paramsIn paramsOut

1924+ ( ResolveColumn word tables entry

1925+ , ExtractType entry typ

1926+ , UnwrapMaybe typ unwrapped

10271927 ) =>

1028− ParseWhereGo h tail acc currentType tables paramsIn paramsOut

1928+ FlushWhereWordS word currentType tables paramsIn unwrapped paramsIn

1929+

1930+class FlushWhereWordT :: Symbol -> Type -> Row (Row Type) -> RL.RowList Type -> Type -> RL.RowList Type -> Constraint

1931+class FlushWhereWordT word currentType tables paramsIn currentTypeOut paramsOut | word currentType tables paramsIn -> currentTypeOut paramsOut

1932+

1933+instance FlushWhereWordT "TRIM" currentType tables paramsIn String paramsIn

1934+else instance FlushWhereWordT "trim" currentType tables paramsIn String paramsIn

1935+else instance FlushWhereWordT "TRUE" currentType tables paramsIn currentType paramsIn

1936+else instance FlushWhereWordT "true" currentType tables paramsIn currentType paramsIn

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

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

1939+else 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

1950+else instance

1951+ ( ResolveColumn word tables entry

1952+ , ExtractType entry typ

1953+ , UnwrapMaybe typ unwrapped

1954+ ) =>

1955+ FlushWhereWordT word currentType tables paramsIn unwrapped paramsIn

10291956

1030−class ParseWhereContinue :: Symbol -> Type -> Row (Row Type) -> RL.RowList Type -> RL.RowList Type -> Constraint

1031−class ParseWhereContinue sym currentType tables paramsIn paramsOut | sym currentType tables paramsIn -> paramsOut

1957+class FlushWhereWordU :: Symbol -> Type -> Row (Row Type) -> RL.RowList Type -> Type -> RL.RowList Type -> Constraint

1958+class FlushWhereWordU word currentType tables paramsIn currentTypeOut paramsOut | word currentType tables paramsIn -> currentTypeOut paramsOut

10321959

1033−instance ParseWhereContinue "" currentType tables paramsIn paramsIn

1960+instance FlushWhereWordU "UPPER" currentType tables paramsIn String paramsIn

1961+else instance FlushWhereWordU "upper" currentType tables paramsIn String paramsIn

1962+else instance FlushWhereWordU "uuid" currentType tables paramsIn currentType paramsIn

10341963else instance

1035− ( Symbol.Cons h t sym

1036− , ParseWhereGo h t "" currentType tables paramsIn paramsOut

1964+ ( ResolveColumn word tables entry

1965+ , ExtractType entry typ

1966+ , UnwrapMaybe typ unwrapped

10371967 ) =>

1038− ParseWhereContinue sym currentType tables paramsIn paramsOut

1968+ FlushWhereWordU word currentType tables paramsIn unwrapped paramsIn

10391969

1040−-- Flush a word in WHERE context

1041−class FlushWhereWord :: Symbol -> Type -> Row (Row Type) -> RL.RowList Type -> Type -> RL.RowList Type -> Constraint

1042−class FlushWhereWord word currentType tables paramsIn currentTypeOut paramsOut | word currentType tables paramsIn -> currentTypeOut paramsOut

1970+class FlushWhereWordV :: Symbol -> Type -> Row (Row Type) -> RL.RowList Type -> Type -> RL.RowList Type -> Constraint

1971+class FlushWhereWordV word currentType tables paramsIn currentTypeOut paramsOut | word currentType tables paramsIn -> currentTypeOut paramsOut

10431972

1044−instance FlushWhereWord "" currentType tables paramsIn currentType paramsIn

1045−else instance FlushWhereWord "AND" currentType tables paramsIn currentType paramsIn

1046−else instance FlushWhereWord "OR" currentType tables paramsIn currentType paramsIn

1047−else instance FlushWhereWord "NOT" currentType tables paramsIn currentType paramsIn

1048−else instance FlushWhereWord "IS" currentType tables paramsIn currentType paramsIn

1049−else instance FlushWhereWord "NULL" currentType tables paramsIn currentType paramsIn

1050−else instance FlushWhereWord "LIKE" currentType tables paramsIn currentType paramsIn

1051−else instance FlushWhereWord "ILIKE" currentType tables paramsIn currentType paramsIn

1052−else instance FlushWhereWord "IN" currentType tables paramsIn (Array currentType) paramsIn

1053−else instance FlushWhereWord "TRUE" currentType tables paramsIn currentType paramsIn

1054−else instance FlushWhereWord "FALSE" currentType tables paramsIn currentType paramsIn

1055−else instance FlushWhereWord "BETWEEN" currentType tables paramsIn currentType paramsIn

1056−else instance FlushWhereWord "ANY" currentType tables paramsIn (Array currentType) paramsIn

1057−else instance FlushWhereWord "ALL" currentType tables paramsIn (Array currentType) paramsIn

1058−else instance FlushWhereWord "CAST" currentType tables paramsIn currentType paramsIn

1059−else instance FlushWhereWord "AS" currentType tables paramsIn currentType paramsIn

1060−else instance FlushWhereWord "EXISTS" currentType tables paramsIn currentType paramsIn

1061−-- Aggregate functions (for HAVING support)

1062−else instance FlushWhereWord "COUNT" currentType tables paramsIn Int paramsIn

1063−else instance FlushWhereWord "SUM" currentType tables paramsIn currentType paramsIn

1064−else instance FlushWhereWord "AVG" currentType tables paramsIn Number paramsIn

1065−else instance FlushWhereWord "MIN" currentType tables paramsIn currentType paramsIn

1066−else instance FlushWhereWord "MAX" currentType tables paramsIn currentType paramsIn

1067−else instance FlushWhereWord "ARRAY_AGG" currentType tables paramsIn currentType paramsIn

1068−else instance FlushWhereWord "STRING_AGG" currentType tables paramsIn String paramsIn

1069−else instance FlushWhereWord "*" currentType tables paramsIn currentType paramsIn

1070−-- Postgres type names (for ::type casts)

1071−else instance FlushWhereWord "text" currentType tables paramsIn currentType paramsIn

1072−else instance FlushWhereWord "integer" currentType tables paramsIn currentType paramsIn

1073−else instance FlushWhereWord "bigint" currentType tables paramsIn currentType paramsIn

1074−else instance FlushWhereWord "boolean" currentType tables paramsIn currentType paramsIn

1075−else instance FlushWhereWord "jsonb" currentType tables paramsIn currentType paramsIn

1076−else instance FlushWhereWord "json" currentType tables paramsIn currentType paramsIn

1077−else instance FlushWhereWord "timestamptz" currentType tables paramsIn currentType paramsIn

1078−else instance FlushWhereWord "timestamp" currentType tables paramsIn currentType paramsIn

1079−else instance FlushWhereWord "date" currentType tables paramsIn currentType paramsIn

1080−else instance FlushWhereWord "int" currentType tables paramsIn currentType paramsIn

1081−else instance FlushWhereWord "varchar" currentType tables paramsIn currentType paramsIn

1082−else instance FlushWhereWord "uuid" currentType tables paramsIn currentType paramsIn

1083−-- Non-keyword: check first char

1973+instance FlushWhereWordV "varchar" currentType tables paramsIn currentType paramsIn

10841974else instance

1085− ( Symbol.Cons head rest word

1086− , FlushWhereWordByHead head word currentType tables paramsIn currentTypeOut paramsOut

1975+ ( ResolveColumn word tables entry

1976+ , ExtractType entry typ

1977+ , UnwrapMaybe typ unwrapped

10871978 ) =>

1088− FlushWhereWord word currentType tables paramsIn currentTypeOut paramsOut

1979+ FlushWhereWordV word currentType tables paramsIn unwrapped paramsIn

10891980

1090−class FlushWhereWordByHead :: Symbol -> Symbol -> Type -> Row (Row Type) -> RL.RowList Type -> Type -> RL.RowList Type -> Constraint

1091−class FlushWhereWordByHead head word currentType tables paramsIn currentTypeOut paramsOut | head word currentType tables paramsIn -> currentTypeOut paramsOut

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

10921983

1093−-- $param: emit with currentType

1094−instance

1095− ( Symbol.Cons "$" paramName word

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

10961992 ) =>

1097− FlushWhereWordByHead "$" word currentType tables paramsIn currentType (RL.Cons paramName currentType paramsIn)

1993+ FlushWhereWordP word currentType tables paramsIn unwrapped paramsIn

10981994

1099−-- Digit: number literal, pass through

1100−else instance FlushWhereWordByHead "0" word currentType tables paramsIn currentType paramsIn

1101−else instance FlushWhereWordByHead "1" word currentType tables paramsIn currentType paramsIn

1102−else instance FlushWhereWordByHead "2" word currentType tables paramsIn currentType paramsIn

1103−else instance FlushWhereWordByHead "3" word currentType tables paramsIn currentType paramsIn

1104−else instance FlushWhereWordByHead "4" word currentType tables paramsIn currentType paramsIn

1105−else instance FlushWhereWordByHead "5" word currentType tables paramsIn currentType paramsIn

1106−else instance FlushWhereWordByHead "6" word currentType tables paramsIn currentType paramsIn

1107−else instance FlushWhereWordByHead "7" word currentType tables paramsIn currentType paramsIn

1108−else instance FlushWhereWordByHead "8" word currentType tables paramsIn currentType paramsIn

1109−else instance FlushWhereWordByHead "9" word currentType tables paramsIn currentType paramsIn

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

11101997

1111−-- Column reference: resolve and set as currentType

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

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

11122000else instance

11132001 ( ResolveColumn word tables entry

11142002 , ExtractType entry typ

11152003 , UnwrapMaybe typ unwrapped

11162004 ) =>

1117− FlushWhereWordByHead head word currentType tables paramsIn unwrapped paramsIn

2005+ FlushWhereWordR word currentType tables paramsIn unwrapped paramsIn

11182006

11192007-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

11202008-- ValidateColumnList: comma-separated column references

@@ -1188,11 +2076,16 @@ else instance

11882076class ValidateOrderByGo :: Symbol -> Symbol -> Symbol -> Row (Row Type) -> Constraint

11892077class ValidateOrderByGo head tail acc tables

11902078

1191−-- Comma: flush column, continue

2079+-- Leading/double comma: no column before comma

11922080instance

2081+ Fail (Text "Unexpected comma in ORDER BY clause (missing column name)") =>

2082+ ValidateOrderByGo "," tail "" tables

2083+

2084+-- Comma: flush column, continue (non-empty acc)

2085+else instance

11932086 ( FlushOrderByWord acc tables

11942087 , SkipSpaces tail rest

1195− , ValidateOrderBy rest tables

2088+ , ValidateOrderByContinueNonEmpty rest tables

11962089 ) =>

11972090 ValidateOrderByGo "," tail acc tables

11982091

@@ -1206,7 +2099,7 @@ else instance

12062099-- End of string: flush final column

12072100else instance

12082101 ( Symbol.Append acc h acc'

1209− , FlushOrderByWord acc' tables

2102+ , FlushOrderByFinalWord acc' tables

12102103 ) =>

12112104 ValidateOrderByGo h "" acc tables

12122105

@@ -1218,6 +2111,31 @@ else instance

12182111 ) =>

12192112 ValidateOrderByGo h tail acc tables

12202113

2114+-- After comma: reject empty (trailing comma)

2115+class ValidateOrderByContinueNonEmpty :: Symbol -> Row (Row Type) -> Constraint

2116+class ValidateOrderByContinueNonEmpty sym tables

2117+

2118+instance Fail (Text "Trailing comma in ORDER BY clause") => ValidateOrderByContinueNonEmpty "" tables

2119+else instance

2120+ ( Symbol.Cons h t sym

2121+ , ValidateOrderByGo h t "" tables

2122+ ) =>

2123+ ValidateOrderByContinueNonEmpty sym tables

2124+

2125+-- End of string: reject bare modifiers (ASC/DESC without column)

2126+class FlushOrderByFinalWord :: Symbol -> Row (Row Type) -> Constraint

2127+class FlushOrderByFinalWord word tables

2128+

2129+instance Fail (Text "ORDER BY requires at least one column") => FlushOrderByFinalWord "" tables

2130+else instance Fail (Text "ORDER BY requires a column name before ASC/DESC") => FlushOrderByFinalWord "ASC" tables

2131+else instance Fail (Text "ORDER BY requires a column name before ASC/DESC") => FlushOrderByFinalWord "asc" tables

2132+else instance Fail (Text "ORDER BY requires a column name before ASC/DESC") => FlushOrderByFinalWord "DESC" tables

2133+else instance Fail (Text "ORDER BY requires a column name before ASC/DESC") => FlushOrderByFinalWord "desc" tables

2134+else instance Fail (Text "ORDER BY requires a column name before ASC/DESC") => FlushOrderByFinalWord "NULLS" tables

2135+else instance Fail (Text "ORDER BY requires a column name before ASC/DESC") => FlushOrderByFinalWord "FIRST" tables

2136+else instance Fail (Text "ORDER BY requires a column name before ASC/DESC") => FlushOrderByFinalWord "LAST" tables

2137+else instance ResolveColumn word tables typ => FlushOrderByFinalWord word tables

2138+

12212139class FlushOrderByWord :: Symbol -> Row (Row Type) -> Constraint

12222140class FlushOrderByWord word tables

12232141

@@ -1290,6 +2208,177 @@ else instance

12902208 ) =>

12912209 ValidateOrderByContinueByHead h t tables

12922210

2211+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

2212+-- RowListHas: check if a label exists in a RowList

2213+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

2214+

2215+class RowListHas :: Symbol -> RL.RowList Type -> Boolean -> Constraint

2216+class RowListHas label rl has | label rl -> has

2217+

2218+instance RowListHas label RL.Nil False

2219+instance RowListHas label (RL.Cons label typ rest) True

2220+else instance RowListHas label rest has => RowListHas label (RL.Cons other typ rest) has

2221+

2222+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

2223+-- CheckDistinctOrderBy: when DISTINCT is in stage, ORDER BY

2224+-- columns must appear in the SELECT result list

2225+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

2226+

2227+class CheckDistinctOrderBy :: Row Type -> Symbol -> Row Type -> Constraint

2228+class CheckDistinctOrderBy stage cols result

2229+

2230+instance

2231+ ( RowToList stage stageRL

2232+ , RowListHas "distinct" stageRL isDistinct

2233+ , CheckDistinctOrderByBranch isDistinct cols result

2234+ ) =>

2235+ CheckDistinctOrderBy stage cols result

2236+

2237+class CheckDistinctOrderByBranch :: Boolean -> Symbol -> Row Type -> Constraint

2238+class CheckDistinctOrderByBranch isDistinct cols result

2239+

2240+instance OrderByColumnsInResult cols result => CheckDistinctOrderByBranch True cols result

2241+instance CheckDistinctOrderByBranch False cols result

2242+

2243+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

2244+-- OrderByColumnsInResult: validate ORDER BY column refs exist in result row

2245+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

2246+

2247+class OrderByColumnsInResult :: Symbol -> Row Type -> Constraint

2248+class OrderByColumnsInResult sym result

2249+

2250+instance OrderByColumnsInResult "" result

2251+else instance

2252+ ( Symbol.Cons h t sym

2253+ , OrderByColumnsInResultGo h t "" result

2254+ ) =>

2255+ OrderByColumnsInResult sym result

2256+

2257+class OrderByColumnsInResultGo :: Symbol -> Symbol -> Symbol -> Row Type -> Constraint

2258+class OrderByColumnsInResultGo head tail acc result

2259+

2260+-- Comma: flush column, continue

2261+instance

2262+ ( FlushOrderByWordInResult acc result

2263+ , SkipSpaces tail rest

2264+ , OrderByColumnsInResult rest result

2265+ ) =>

2266+ OrderByColumnsInResultGo "," tail acc result

2267+

2268+-- Space: flush word, skip modifiers

2269+else instance

2270+ ( SkipSpaces tail rest

2271+ , FlushOrderByThenSkipInResult acc rest result

2272+ ) =>

2273+ OrderByColumnsInResultGo " " tail acc result

2274+

2275+-- End of string: flush final column

2276+else instance

2277+ ( Symbol.Append acc h acc'

2278+ , FlushOrderByWordInResult acc' result

2279+ ) =>

2280+ OrderByColumnsInResultGo h "" acc result

2281+

2282+-- Regular char: accumulate

2283+else instance

2284+ ( Symbol.Append acc h acc'

2285+ , Symbol.Cons nextH nextT tail

2286+ , OrderByColumnsInResultGo nextH nextT acc' result

2287+ ) =>

2288+ OrderByColumnsInResultGo h tail acc result

2289+

2290+class FlushOrderByWordInResult :: Symbol -> Row Type -> Constraint

2291+class FlushOrderByWordInResult word result

2292+

2293+instance FlushOrderByWordInResult "" result

2294+else instance FlushOrderByWordInResult "ASC" result

2295+else instance FlushOrderByWordInResult "asc" result

2296+else instance FlushOrderByWordInResult "DESC" result

2297+else instance FlushOrderByWordInResult "desc" result

2298+else instance FlushOrderByWordInResult "NULLS" result

2299+else instance FlushOrderByWordInResult "FIRST" result

2300+else instance FlushOrderByWordInResult "LAST" result

2301+else instance CheckColumnInResult word result => FlushOrderByWordInResult word result

2302+

2303+class CheckColumnInResult :: Symbol -> Row Type -> Constraint

2304+class CheckColumnInResult col result

2305+

2306+instance

2307+ ( RowToList result rl

2308+ , CheckColumnInResultRL col rl

2309+ ) =>

2310+ CheckColumnInResult col result

2311+

2312+class CheckColumnInResultRL :: Symbol -> RL.RowList Type -> Constraint

2313+class CheckColumnInResultRL col rl

2314+

2315+instance

2316+ Fail (Beside (Text "ORDER BY column ") (Beside (Quote col) (Text " must appear in the SELECT list when using DISTINCT"))) =>

2317+ CheckColumnInResultRL col RL.Nil

2318+

2319+instance CheckColumnInResultRL col (RL.Cons col typ tail)

2320+

2321+else instance CheckColumnInResultRL col tail => CheckColumnInResultRL col (RL.Cons name typ tail)

2322+

2323+class FlushOrderByThenSkipInResult :: Symbol -> Symbol -> Row Type -> Constraint

2324+class FlushOrderByThenSkipInResult colName rest result

2325+

2326+instance FlushOrderByWordInResult colName result => FlushOrderByThenSkipInResult colName "" result

2327+else instance

2328+ ( FlushOrderByWordInResult colName result

2329+ , Symbol.Cons h t rest

2330+ , FlushOrderByThenSkipByHeadInResult h t result

2331+ ) =>

2332+ FlushOrderByThenSkipInResult colName rest result

2333+

2334+class FlushOrderByThenSkipByHeadInResult :: Symbol -> Symbol -> Row Type -> Constraint

2335+class FlushOrderByThenSkipByHeadInResult head tail result

2336+

2337+-- Comma: continue with next column

2338+instance

2339+ ( SkipSpaces tail rest

2340+ , OrderByColumnsInResult rest result

2341+ ) =>

2342+ FlushOrderByThenSkipByHeadInResult "," tail result

2343+

2344+-- Modifier word: consume it, continue

2345+else instance

2346+ ( Symbol.Append h t rest

2347+ , ExtractWord rest word afterWord

2348+ , FlushOrderByWordInResult word result

2349+ , SkipSpaces afterWord rest'

2350+ , OrderByColumnsInResultContinue rest' result

2351+ ) =>

2352+ FlushOrderByThenSkipByHeadInResult h t result

2353+

2354+class OrderByColumnsInResultContinue :: Symbol -> Row Type -> Constraint

2355+class OrderByColumnsInResultContinue sym result

2356+

2357+instance OrderByColumnsInResultContinue "" result

2358+else instance

2359+ ( Symbol.Cons h t sym

2360+ , OrderByColumnsInResultContinueByHead h t result

2361+ ) =>

2362+ OrderByColumnsInResultContinue sym result

2363+

2364+class OrderByColumnsInResultContinueByHead :: Symbol -> Symbol -> Row Type -> Constraint

2365+class OrderByColumnsInResultContinueByHead head tail result

2366+

2367+instance

2368+ ( SkipSpaces tail rest

2369+ , OrderByColumnsInResult rest result

2370+ ) =>

2371+ OrderByColumnsInResultContinueByHead "," tail result

2372+

2373+else instance

2374+ ( Symbol.Append h t rest

2375+ , ExtractWord rest word afterWord

2376+ , FlushOrderByWordInResult word result

2377+ , SkipSpaces afterWord rest'

2378+ , OrderByColumnsInResultContinue rest' result

2379+ ) =>

2380+ OrderByColumnsInResultContinueByHead h t result

2381+

12932382-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

12942383-- ValidateColumns: comma-separated column names (for ON CONFLICT target)

12952384-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

@@ -1476,6 +2565,14 @@ else instance (FlushJoinWord acc tables, ValidateJoinCondition tail tables) => V

14762565else instance (FlushJoinWord acc tables, ValidateJoinCondition tail tables) => ValidateJoinCondGo "(" tail acc tables

14772566else instance (FlushJoinWord acc tables, ValidateJoinCondition tail tables) => ValidateJoinCondGo ")" tail acc tables

14782567

2568+-- String literal: skip content between quotes

2569+else instance

2570+ ( FlushJoinWord acc tables

2571+ , SkipStringLiteral tail rest

2572+ , ValidateJoinCondition rest tables

2573+ ) =>

2574+ ValidateJoinCondGo "'" tail acc tables

2575+

14792576-- End of string: flush final word

14802577else instance

14812578 ( Symbol.Append acc h acc'

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

15602657 , SkipSpaces rest1 rest2

15612658 , ExpectChar rest2 "=" rest3

15622659 , SkipSpaces rest3 rest4

1563− , ExtractWord rest4 excRef rest5

1564− , ValidateExcludedRef excRef colName

1565− , SkipSpaces rest5 rest6

1566− , ParseAssignmentsContinue rest6 cols

2660+ , SkipExpression rest4 rest5

2661+ , ParseAssignmentsContinue rest5 cols

15672662 ) =>

15682663 ParseAssignments sym cols

15692664

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+

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

15712740class ParseAssignmentsContinue sym cols

15722741

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

16292798

16302799instance IsAutoGeneratedTC (AutoIncrement a) True

16312800else instance IsAutoGeneratedTC (Default s a) True

2801+else instance IsAutoGeneratedTC (DefaultExpr expression a) True

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

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

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

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

16842854 fieldToPGValue :: a -> PG.PGValue

16852855

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

1687− fieldToPGValue = toNullable >>> unsafeCoerce

2857+ fieldToPGValue = case _ of

2858+ Nothing -> unsafeCoerce (toNullable Nothing)

2859+ Just value -> fieldToPGValue value

16882860else instance FieldToPGValue DateTime where

16892861 fieldToPGValue = JSDate.fromDateTime >>> unsafeCoerce

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

16912867 fieldToPGValue = unsafeCoerce

2868+else instance WriteForeign a => FieldToPGValue a where

2869+ fieldToPGValue = writeImpl >>> unsafeCoerce

16922870

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

16942872class RecordValuesRL rl row where

@@ -1742,6 +2920,34 @@ class HasClause label row

17422920

17432921instance Row.Cons label Unit rest row => HasClause label row

17442922

2923+class HasAnyDML :: Row Type -> Constraint

2924+class HasAnyDML stage

2925+

2926+instance (RL.RowToList stage rl, HasAnyDMLRL rl) => HasAnyDML stage

2927+

2928+class HasAnyDMLRL :: RL.RowList Type -> Constraint

2929+class HasAnyDMLRL rl

2930+

2931+instance HasAnyDMLRL (RL.Cons "select" Unit rest)

2932+else instance HasAnyDMLRL (RL.Cons "set" Unit rest)

2933+else instance HasAnyDMLRL (RL.Cons "delete" Unit rest)

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

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

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+

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

17462952toSQL (Q q) = q.sql

17472953

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

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

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

17532959

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+

17542966selectAll

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

17562968 . SingleTable tables name cols

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

17582970 => StripColumns cols result

17592971 => Row.Lacks "select" stage

17602972 => Row.Lacks "insert" stage

2973+ => Row.Lacks "into" stage

17612974 => Row.Lacks "set" stage

17622975 => Row.Lacks "delete" stage

17632976 => Row.Lacks "where" stage

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

17752988 => ParseSelect sel tables result

17762989 => Row.Lacks "select" stage

17772990 => Row.Lacks "insert" stage

2991+ => Row.Lacks "into" stage

17782992 => Row.Lacks "set" stage

17792993 => Row.Lacks "delete" stage

17802994 => Row.Lacks "where" stage

@@ -1787,11 +3001,12 @@ select

17873001select (Q q) = Q (q { sql = "SELECT " <> reflectSymbol (Proxy :: Proxy sel) <> " FROM " <> q.sql })

17883002

17893003selectDistinct

1790− :: forall @sel tables result r p stage stage'

3004+ :: forall @sel tables result r p stage stage' stage''

17913005 . IsSymbol sel

17923006 => ParseSelect sel tables result

17933007 => Row.Lacks "select" stage

17943008 => Row.Lacks "insert" stage

3009+ => Row.Lacks "into" stage

17953010 => Row.Lacks "set" stage

17963011 => Row.Lacks "delete" stage

17973012 => Row.Lacks "where" stage

@@ -1799,8 +3014,9 @@ selectDistinct

17993014 => Row.Lacks "limit" stage

18003015 => Row.Lacks "offset" stage

18013016 => Row.Cons "select" Unit stage stage'

3017+ => Row.Cons "distinct" Unit stage' stage''

18023018 => Q tables r p stage

1803− -> Q tables result p stage'

3019+ -> Q tables result p stage''

18043020selectDistinct (Q q) = Q (q { sql = "SELECT DISTINCT " <> reflectSymbol (Proxy :: Proxy sel) <> " FROM " <> q.sql })

18053021

18063022selectDistinctOn

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

18113027 => ParseSelect sel tables result

18123028 => Row.Lacks "select" stage

18133029 => Row.Lacks "insert" stage

3030+ => Row.Lacks "into" stage

18143031 => Row.Lacks "set" stage

18153032 => Row.Lacks "delete" stage

18163033 => Row.Lacks "where" stage

@@ -1826,6 +3043,7 @@ where_

18263043 :: forall @whr tables result params p stage stage'

18273044 . IsSymbol whr

18283045 => ParseWhere whr tables params

3046+ => HasAnyDML stage

18293047 => Row.Lacks "where" stage

18303048 => Row.Lacks "insert" stage

18313049 => Row.Lacks "groupBy" stage

@@ -1842,6 +3060,7 @@ orderBy

18423060 :: forall @cols tables result params stage stage'

18433061 . IsSymbol cols

18443062 => ValidateOrderBy cols tables

3063+ => CheckDistinctOrderBy stage cols result

18453064 => HasClause "select" stage

18463065 => Row.Lacks "orderBy" stage

18473066 => Row.Lacks "limit" stage

@@ -1899,16 +3118,66 @@ instance

18993118

19003119instance ParseLimitOffsetParams False name params params

19013120

3121+-- Validate that a Symbol is a non-negative integer (all digits, non-empty)

3122+class ValidateNumericLiteral :: Symbol -> Constraint

3123+class ValidateNumericLiteral sym

3124+

3125+instance

3126+ ( Symbol.Cons h t sym

3127+ , ValidateAllDigits h t

3128+ ) =>

3129+ ValidateNumericLiteral sym

3130+

3131+class ValidateAllDigits :: Symbol -> Symbol -> Constraint

3132+class ValidateAllDigits head tail

3133+

3134+instance ValidateAllDigits "0" ""

3135+else instance ValidateAllDigits "1" ""

3136+else instance ValidateAllDigits "2" ""

3137+else instance ValidateAllDigits "3" ""

3138+else instance ValidateAllDigits "4" ""

3139+else instance ValidateAllDigits "5" ""

3140+else instance ValidateAllDigits "6" ""

3141+else instance ValidateAllDigits "7" ""

3142+else instance ValidateAllDigits "8" ""

3143+else instance ValidateAllDigits "9" ""

3144+else instance (Symbol.Cons h2 t2 tail, ValidateAllDigits h2 t2) => ValidateAllDigits "0" tail

3145+else instance (Symbol.Cons h2 t2 tail, ValidateAllDigits h2 t2) => ValidateAllDigits "1" tail

3146+else instance (Symbol.Cons h2 t2 tail, ValidateAllDigits h2 t2) => ValidateAllDigits "2" tail

3147+else instance (Symbol.Cons h2 t2 tail, ValidateAllDigits h2 t2) => ValidateAllDigits "3" tail

3148+else instance (Symbol.Cons h2 t2 tail, ValidateAllDigits h2 t2) => ValidateAllDigits "4" tail

3149+else instance (Symbol.Cons h2 t2 tail, ValidateAllDigits h2 t2) => ValidateAllDigits "5" tail

3150+else instance (Symbol.Cons h2 t2 tail, ValidateAllDigits h2 t2) => ValidateAllDigits "6" tail

3151+else instance (Symbol.Cons h2 t2 tail, ValidateAllDigits h2 t2) => ValidateAllDigits "7" tail

3152+else instance (Symbol.Cons h2 t2 tail, ValidateAllDigits h2 t2) => ValidateAllDigits "8" tail

3153+else instance (Symbol.Cons h2 t2 tail, ValidateAllDigits h2 t2) => ValidateAllDigits "9" tail

3154+else instance

3155+ Fail (Beside (Text "LIMIT/OFFSET must be a non-negative integer or $parameter, got: ") (Quote sym)) =>

3156+ ValidateAllDigits head tail

3157+

19023158class ParseLimitOffset :: Symbol -> Row Type -> Row Type -> Constraint

19033159class ParseLimitOffset sym params params' | sym params -> params'

19043160

19053161instance

19063162 ( Symbol.Cons head tail sym

19073163 , IsLimitParam head tail isParam

1908− , ParseLimitOffsetParams isParam tail params params'

3164+ , ParseLimitOffsetBranch isParam sym tail params params'

19093165 ) =>

19103166 ParseLimitOffset sym params params'

19113167

3168+class ParseLimitOffsetBranch :: Boolean -> Symbol -> Symbol -> Row Type -> Row Type -> Constraint

3169+class ParseLimitOffsetBranch isParam sym paramName params params' | isParam sym paramName params -> params'

3170+

3171+instance

3172+ ( Row.Lacks paramName params

3173+ , Row.Cons paramName Int params params'

3174+ ) =>

3175+ ParseLimitOffsetBranch True sym paramName params params'

3176+

3177+instance

3178+ ValidateNumericLiteral sym =>

3179+ ParseLimitOffsetBranch False sym paramName params params

3180+

19123181limit

19133182 :: forall @sym tables result params params' stage stage'

19143183 . ParseLimitOffset sym params params'

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

19633232 tableName = reflectSymbol (Proxy :: Proxy name)

19643233 colNames = columnNamesRL (Proxy :: Proxy userRowRL)

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

1966− sql = "INSERT INTO " <> tableName

1967− <> " ("

1968− <> intercalate ", " colNames

1969− <> ")"

1970− <> " VALUES ("

1971− <> intercalate ", " placeholders

1972− <> ")"

3235+ sql =

3236+ if Array.null colNames then

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

3238+ else

3239+ "INSERT INTO " <> tableName

3240+ <> " ("

3241+ <> intercalate ", " colNames

3242+ <> ")"

3243+ <> " VALUES ("

3244+ <> intercalate ", " placeholders

3245+ <> ")"

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

19743247

19753248-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

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

19813254 . SingleTable tables name cols

19823255 => IsSymbol sel

19833256 => ParseSelect sel tables result

3257+ => HasMutation stage

19843258 => Row.Lacks "returning" stage

19853259 => Row.Lacks "select" stage

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

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

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

19933267 . SingleTable tables name cols

19943268 => StripColumns cols result

3269+ => HasMutation stage

19953270 => Row.Lacks "returning" stage

19963271 => Row.Lacks "select" stage

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

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

20343309 => ValidateSetColumnsRL setRL cols

20353310 => SetClauseRL setRL

20363311 => RecordValuesRL setRL setRow

3312+ => HasClause "update" stage

20373313 => Row.Lacks "select" stage

20383314 => Row.Lacks "insert" stage

3315+ => Row.Lacks "into" stage

20393316 => Row.Lacks "set" stage

20403317 => Row.Lacks "delete" stage

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

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

20593336 => IsSymbol name

20603337 => Row.Lacks "select" stage

20613338 => Row.Lacks "insert" stage

3339+ => Row.Lacks "into" stage

20623340 => Row.Lacks "set" stage

20633341 => Row.Lacks "delete" stage

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

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

22993577 -> Q tables1 result params SetOpStage

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

23013579

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+

23023640-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

23033641-- Query execution

23043642-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

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

23143652 ( IsSymbol name

23153653 , Row.Cons name typ rest row

23163654 , Row.Lacks name rest

3655+ , FieldToPGValue typ

23173656 , ParamsToArray tail row

23183657 ) =>

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

23203659 paramsToArray _ rec =

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

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

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

23233662 }

23243663 ]

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

23263665

23273666namedParamRegex :: Regex.Regex

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

23293668 Right r -> r

23303669 Left _ -> unsafeCoerce unit

23313670

3671+stripCast :: String -> String

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

3673+ Nothing -> s

3674+ Just i -> SCU.take i s

3675+

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

23333677replaceNamedParams offset entries sql = do

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

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

23363680 let

23373681 sql' = Regex.replace' namedParamRegex

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

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

23393683 Nothing -> match

23403684 Just v -> v

23413685 )

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

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

23573701 let allValues = q.values <> values

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

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

23603706

23613707runQueryOne

23623708 :: forall tables result params paramsRL stage

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

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

23733719 let allValues = q.values <> values

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

2375− 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)

23763726

23773727runExecute

23783728 :: forall tables params paramsRL stage

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

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

24053755 let allValues = q.values <> values

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

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

24083760

24093761runExecuteTx

24103762 :: forall tables params paramsRL stage

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

24203772 let allValues = q.values <> values

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

24223774

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

2424−unsafeDecodeRows = map unsafeDecodeRow

24253775

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

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

2428− Left _ -> unsafeCoerce unit

2429− Right a -> a

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

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

3778+

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/Client.pursdeleted−138

@@ -1,138 +0,0 @@

1−module Test.Postgres.Client where

2−

3−import Prelude

4−

5−import Data.Maybe (Maybe(..))

6−import Effect.Aff (Aff)

7−import Type.Function (type (#))

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

9−import Yoga.Postgres as PG

10−import Yoga.Postgres.Client

11−import Yoga.Postgres.Schema (Table, PrimaryKey, AutoIncrement, Unique, ForeignKey, References)

12−

13−-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

14−-- Table definitions with ForeignKey constraints

15−-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

16−

17−type UsersTable = Table "users"

18− ( id :: Int # PrimaryKey # AutoIncrement

19− , name :: String

20− , email :: String # Unique

21− , age :: Maybe Int

22− )

23−

24−usersTable :: Proxy UsersTable

25−usersTable = Proxy

26−

27−type PostsTable = Table "posts"

28− ( id :: Int # PrimaryKey # AutoIncrement

29− , title :: String

30− , body :: String

31− , user_id :: Int # ForeignKey "users" References "id"

32− )

33−

34−postsTable :: Proxy PostsTable

35−postsTable = Proxy

36−

37−type CommentsTable = Table "comments"

38− ( id :: Int # PrimaryKey # AutoIncrement

39− , text :: String

40− , post_id :: Int # ForeignKey "posts" References "id"

41− , user_id :: Int # ForeignKey "users" References "id"

42− )

43−

44−commentsTable :: Proxy CommentsTable

45−commentsTable = Proxy

46−

47−-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

48−-- Type-level tests: type annotations prove correctness

49−-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

50−

51−typedFindAll

52− :: PG.Connection

53− -> Aff (Array { id :: Int, name :: String, email :: String, age :: Maybe Int })

54−typedFindAll conn = findAll usersTable conn

55−

56−typedFindById

57− :: PG.Connection

58− -> Aff (Maybe { id :: Int, name :: String, email :: String, age :: Maybe Int })

59−typedFindById conn = findById usersTable conn 42

60−

61−typedCreate

62− :: PG.Connection

63− -> Aff (Maybe { id :: Int, name :: String, email :: String, age :: Maybe Int })

64−typedCreate conn = create usersTable conn { name: "Alice", email: "alice@example.com" }

65−

66−typedCreateWithOptional

67− :: PG.Connection

68− -> Aff (Maybe { id :: Int, name :: String, email :: String, age :: Maybe Int })

69−typedCreateWithOptional conn =

70− create usersTable conn { name: "Alice", email: "alice@example.com", age: Just 25 }

71−

72−typedUpdateById

73− :: PG.Connection

74− -> Aff (Maybe { id :: Int, name :: String, email :: String, age :: Maybe Int })

75−typedUpdateById conn = updateById usersTable conn 1 { name: "Bob" }

76−

77−typedUpdateByIdMultiple

78− :: PG.Connection

79− -> Aff (Maybe { id :: Int, name :: String, email :: String, age :: Maybe Int })

80−typedUpdateByIdMultiple conn =

81− updateById usersTable conn 1 { name: "Bob", age: Just 30 }

82−

83−typedDeleteById

84− :: PG.Connection

85− -> Aff Int

86−typedDeleteById conn = deleteById usersTable conn 1

87−

88−-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

89−-- Belongs-to join: type annotations prove nested result shape

90−-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

91−

92−typedFindWith

93− :: PG.Connection

94− -> Aff (Array { posts :: { id :: Int, title :: String, body :: String, user_id :: Int }

95− , users :: { id :: Int, name :: String, email :: String, age :: Maybe Int }

96− })

97−typedFindWith conn = findWith postsTable usersTable conn

98−

99−typedFindByIdWith

100− :: PG.Connection

101− -> Aff (Maybe { posts :: { id :: Int, title :: String, body :: String, user_id :: Int }

102− , users :: { id :: Int, name :: String, email :: String, age :: Maybe Int }

103− })

104−typedFindByIdWith conn = findByIdWith postsTable usersTable conn 1

105−

106−-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

107−-- Has-many include: parent row extended with nested children

108−-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

109−

110−typedFindIncluding

111− :: PG.Connection

112− -> Aff (Array { id :: Int, name :: String, email :: String, age :: Maybe Int

113− , posts :: Array { id :: Int, title :: String, body :: String, user_id :: Int }

114− })

115−typedFindIncluding conn = findIncluding @"posts" usersTable postsTable conn

116−

117−typedFindByIdIncluding

118− :: PG.Connection

119− -> Aff (Maybe { id :: Int, name :: String, email :: String, age :: Maybe Int

120− , posts :: Array { id :: Int, title :: String, body :: String, user_id :: Int }

121− })

122−typedFindByIdIncluding conn = findByIdIncluding @"posts" usersTable postsTable conn 42

123−

124−-- Comments belong to posts

125−typedCommentsWithPost

126− :: PG.Connection

127− -> Aff (Array { comments :: { id :: Int, text :: String, post_id :: Int, user_id :: Int }

128− , posts :: { id :: Int, title :: String, body :: String, user_id :: Int }

129− })

130−typedCommentsWithPost conn = findWith commentsTable postsTable conn

131−

132−-- Posts including comments

133−typedPostsIncludingComments

134− :: PG.Connection

135− -> Aff (Array { id :: Int, title :: String, body :: String, user_id :: Int

136− , comments :: Array { id :: Int, text :: String, post_id :: Int, user_id :: Int }

137− })

138−typedPostsIncludingComments conn = findIncluding @"comments" postsTable commentsTable conn

test/EdgeCases.purs+59−41

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

33import Prelude

55import Data.Maybe (Maybe)

6+import JS.BigInt (BigInt)

67import Prim.Boolean (True)

78import Type.Function (type (#))

89import Type.Proxy (Proxy(..))

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

3435-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

3536

3637havingMergesWhereParams

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

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

3839havingMergesWhereParams = from usersTable

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

4041 # where_ @"age > $age"

@@ -42,14 +43,10 @@ havingMergesWhereParams = from usersTable

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

4344

4445-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

45−-- EDGE CASE 2: WHERE without any DML operation

46−-- from table # where_ compiles, producing invalid SQL like

47−-- "users WHERE id = $id" (missing SELECT/DELETE/UPDATE)

46+-- EDGE CASE 2: WHERE without any DML operation (FIXED)

47+-- from table # where_ now fails to compile (see WhereWithoutDML.purs)

4848-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

4949

50−whereWithoutOperation :: Q _ _ (id :: Int) _

51−whereWithoutOperation = from usersTable # where_ @"id = $id"

52−

5350-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

5451-- EDGE CASE 3: GROUP BY doesn't enforce aggregation rules

5552-- Non-aggregated, non-grouped columns in SELECT should be

@@ -66,65 +63,86 @@ groupByMissingColumn = from usersTable

6663 # groupBy @"name"

6764

6865-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

69−-- EDGE CASE 4: OVER clause content is not validated

70−-- Invalid SQL inside OVER() parens is silently accepted.

66+-- EDGE CASE 4: OVER clause content validated (FIXED)

67+-- Invalid OVER content now fails to compile

68+-- (see OverClauseInvalidContent.purs, OverClauseNonexistentColumn.purs)

7169-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

7270

73−-- OVER clause content is completely skipped by ExtractUntilParen

74−-- "INVALID SQL HERE" is not validated at all

75−overClauseNotValidated

71+overClauseValid

72+ :: Q _ (name :: String, rn :: Int) () _

73+overClauseValid = from usersTable

74+ # select @"name, ROW_NUMBER() OVER (ORDER BY age) AS rn"

75+

76+overClausePartitionBy

77+ :: Q _ (name :: String, rnk :: Int) () _

78+overClausePartitionBy = from usersTable

79+ # select @"name, RANK() OVER (PARTITION BY name ORDER BY age DESC) AS rnk"

80+

81+overClausePartitionByOnly

7682 :: Q _ (name :: String, rn :: Int) () _

77−overClauseNotValidated = from usersTable

78− # select @"name, ROW_NUMBER() OVER (THIS IS TOTALLY INVALID) AS rn"

83+overClausePartitionByOnly = from usersTable

84+ # select @"name, ROW_NUMBER() OVER (PARTITION BY name) AS rn"

85+

86+overClauseEmpty

87+ :: Q _ (name :: String, rn :: Int) () _

88+overClauseEmpty = from usersTable

89+ # select @"name, ROW_NUMBER() OVER () AS rn"

7990

8091-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

8192-- EDGE CASE 5: WHERE keywords are case-sensitive (uppercase only)

8293-- "IS NULL" works but "is null" would fail (tries to resolve "is" as column)

8394-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

8495

85−-- This works:

8696uppercaseIsNull :: Q _ _ () _

8797uppercaseIsNull = from usersTable # selectAll # where_ @"age IS NULL"

8898

89−-- This would FAIL to compile (uncomment to verify):

90−-- lowercaseIsNull :: Q _ _ () _

91−-- lowercaseIsNull = from usersTable # selectAll # where_ @"age is null"

99+lowercaseIsNull :: Q _ _ () _

100+lowercaseIsNull = from usersTable # selectAll # where_ @"age is null"

101+

102+lowercaseNotIn :: Q _ _ (ids :: Array Int) _

103+lowercaseNotIn = from usersTable # selectAll # where_ @"id not in $ids"

104+

105+lowercaseLike :: Q _ _ (pat :: String) _

106+lowercaseLike = from usersTable # selectAll # where_ @"name like $pat"

107+

108+lowercaseBetween :: Q _ _ (lo :: Int, hi :: Int) _

109+lowercaseBetween = from usersTable # selectAll # where_ @"age between $lo and $hi"

110+

111+lowercaseAndOr :: Q _ _ (minAge :: Int, namePat :: String) _

112+lowercaseAndOr = from usersTable # selectAll # where_ @"age > $minAge or name like $namePat"

92113

93114-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

94−-- EDGE CASE 6: DISTINCT ORDER BY on non-selected column

95−-- PostgreSQL: "ORDER BY items must appear in the select list"

96−-- when using SELECT DISTINCT

115+-- EDGE CASE 6: DISTINCT ORDER BY validated (FIXED)

116+-- ORDER BY columns must appear in SELECT list when using DISTINCT

117+-- (see DistinctOrderByNonSelected.purs)

97118-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

98119

99−-- Produces: SELECT DISTINCT name FROM users ORDER BY age

100−-- PostgreSQL rejects this but it compiles

101−distinctOrderByNonSelected

120+distinctOrderByValid

102121 :: Q _ (name :: String) () _

103−distinctOrderByNonSelected = from usersTable

122+distinctOrderByValid = from usersTable

104123 # selectDistinct @"name"

105− # orderBy @"age"

124+ # orderBy @"name"

125+

126+distinctOrderByMultiple

127+ :: Q _ (name :: String, age :: Maybe Int) () _

128+distinctOrderByMultiple = from usersTable

129+ # selectDistinct @"name, age"

130+ # orderBy @"name, age DESC"

106131

107132-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

108−-- EDGE CASE 7: Aggregate function on nonexistent column in OVER

109−-- OVER content is skipped so "ORDER BY nonexistent" compiles

133+-- EDGE CASE 7: Nonexistent column in OVER (FIXED)

134+-- OVER content is now validated (see OverClauseNonexistentColumn.purs)

110135-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

111136

112−overNonexistentColumn

113− :: Q _ (name :: String, rn :: Int) () _

114−overNonexistentColumn = from usersTable

115− # select @"name, ROW_NUMBER() OVER (ORDER BY nonexistent_column) AS rn"

116−

117137-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

118−-- EDGE CASE 8: Nested parens in aggregate args

119−-- ExtractUntilParen stops at the FIRST ), not matching brackets

120−-- COALESCE(NULLIF(x, 0), 1) would break parsing

138+-- EDGE CASE 8: Nested parens in aggregate args (FIXED)

139+-- ExtractUntilParen now uses Peano depth counter for nesting

121140-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

122141

123−-- Uncomment to test:

124−-- nestedParensInAggregate

125−-- :: Q _ (name :: String, val :: Int) () _

126−-- nestedParensInAggregate = from usersTable

127−-- # select @"name, COALESCE(age, 0) AS val"

142+coalesceSimple

143+ :: Q _ (name :: String, val :: Int) () _

144+coalesceSimple = from usersTable

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

128146

129147-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

130148-- EDGE CASE 9: INSERT on table with all auto-generated columns

test/Integration.purs+12−4

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

1515main = launchAff_ do

1616 conn <- liftEffect $ PG.postgres

1717 { host: PG.PostgresHost "localhost"

18− , port: PG.PostgresPort 5433

18+ , port: PG.PostgresPort 5434

1919 , database: PG.PostgresDatabase "test_playground"

2020 , username: PG.PostgresUsername "postgres"

2121 , password: PG.PostgresPassword "postgres"

2222 }

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

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

25− _ <- PG.executeSimple (PG.SQL "DROP TABLE IF EXISTS events") 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

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

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

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

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

2832 _ <- 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

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

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

3139 conn

test/Main.purs+15−8

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

55import Data.Either (Either(..))

66import Data.Maybe (Maybe(..))

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

78import Effect (Effect)

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

910import Effect.Class (liftEffect)

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

1112import Effect.Exception (error)

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

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

15+import Test.Postgres.Behavioral as Behavioral

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

1517import Test.Spec.Runner (runSpec)

1618import Yoga.Test.Docker as Docker

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

2224testHost = PG.PostgresHost "localhost"

2325

2426testPort :: PG.PostgresPort

25−testPort = PG.PostgresPort 5433 -- Test port from docker-compose.test.yml

27+testPort = PG.PostgresPort 5434 -- Test port from docker-compose.test.yml

2628

2729testDatabase :: PG.PostgresDatabase

2830testDatabase = PG.PostgresDatabase "test_playground"

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

9395spec :: Spec Unit

9496spec = do

9597 Schema.spec

98+ Behavioral.pureSpec

99+

100+ around withPostgres do

101+ Behavioral.integrationSpec

102+

96103

97104 describe "Yoga.Postgres Integration Tests" do

98105

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

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

107114 opts <- liftEffect $ PG.options conn

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

109− opts.port `shouldEqual` 5433

116+ opts.port `shouldEqual` 5434

110117 opts.database `shouldEqual` "test_playground"

111118

112119 describe "Connection Errors" do

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

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

234241 setupTestTable conn

235242

236− _ <- PG.transaction

243+ _ <- PG.withTransaction

237244 ( \txn -> do

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

239246 [ PG.toPGValue "Henry" ]

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

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

252259 setupTestTable conn

253260

254− result <- try $ PG.transaction

261+ result <- try $ PG.withTransaction

255262 ( \txn -> do

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

257264 [ PG.toPGValue "Jack" ]

258265 txn

259− throwError (error "Intentional error")

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

260267 )

261268 conn

262269

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

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

269276 setupTestTable conn

270277

271− _ <- PG.transaction

278+ _ <- PG.withTransaction

272279 ( \txn -> do

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

274281 [ PG.toPGValue "Leo" ]

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

433440 bracket

434441 ( do

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

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

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

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

438445 )

439446 ( \_ -> do

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

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

441448 liftEffect $ log "Cleanup complete\n"

442449 )

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

test/Schema.purs+249−10

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

33import Prelude

5+import Data.Array as Array

56import Data.Date (canonicalDate)

67import Data.DateTime (DateTime(..))

78import Data.Enum (toEnum)

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

10+import Data.Newtype (un)

11+import Data.String as String

912import Data.Time (Time(..))

13+import Data.UUID as UUID

1014import Partial.Unsafe (unsafePartial)

1115

1216import Type.Function (type (#))

@@ -97,6 +101,10 @@ typedJsonbWhere

97101 :: Q _ _ (metadata :: Jsonb) _

98102typedJsonbWhere = from eventsTable # selectAll # where_ @"metadata @> $metadata"

99103

104+typedJsonbInvalid

105+ :: Q _ _ (metadata :: Jsonb) _

106+typedJsonbInvalid = from eventsTable # selectAll # where_ @"metadata !* $metadata"

107+

100108typedTitleLike

101109 :: Q _ _ (title :: String) _

102110typedTitleLike = from eventsTable # selectAll # where_ @"title LIKE $title"

@@ -172,6 +180,13 @@ typedWhereComplex

172180 _

173181typedWhereComplex = from usersTable # selectAll # where_ @"name = $name AND age > $age"

174182

183+typedWhereStringLiteral

184+ :: Q _

185+ (age :: Maybe Int, email :: String, id :: Int, name :: String)

186+ (status :: String)

187+ _

188+typedWhereStringLiteral = from usersTable # selectAll # where_ @"name = $status AND email != 'test@example.com'"

189+

175190typedSelectColsWhere

176191 :: Q _

177192 (name :: String)

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

217232

218233typedSet

219234 :: Q _ () () _

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

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

221236

222237typedSetWhere

223238 :: Q _ () (id :: Int) _

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

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

225240

226241typedSetReturning

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

228−typedSetReturning = from usersTable

243+typedSetReturning = update usersTable

229244 # set { name: "Bob" }

230245 # where_ @"id = $id"

231246 # returning @"id, name, email"

@@ -425,7 +440,7 @@ typedGroupBy

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

426441

427442typedCountStar

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

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

429444typedCountStar = from usersTable

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

431446 # groupBy @"name"

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

449464 # groupBy @"name"

450465

451466typedHaving

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

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

453468typedHaving = from usersTable

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

455470 # groupBy @"name"

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

457472

458473typedFullAggregate

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

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

460475typedFullAggregate = from usersTable

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

462477 # groupBy @"name"

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

465480 # limit @"10"

466481

467482typedWhereGroupByHaving

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

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

469484typedWhereGroupByHaving = from usersTable

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

471486 # where_ @"age > $age"

@@ -610,11 +625,123 @@ typedIsNotNull

610625 :: Q _ _ () _

611626typedIsNotNull = from usersTable # selectAll # where_ @"age IS NOT NULL"

612627

628+typedIsNullLowercase

629+ :: Q _ _ () _

630+typedIsNullLowercase = from usersTable # selectAll # where_ @"age is null"

631+

632+typedBetweenLowercase

633+ :: Q _ _ (lo :: Int, hi :: Int) _

634+typedBetweenLowercase = from usersTable # selectAll # where_ @"age between $lo and $hi"

635+

636+typedLikeLowercase

637+ :: Q _ _ (pat :: String) _

638+typedLikeLowercase = from usersTable # selectAll # where_ @"name like $pat"

639+

613640typedNestedParens

614641 :: Q _ _ (a :: Int, b :: Int, name :: String) _

615642typedNestedParens = from usersTable # selectAll

616643 # where_ @"(age > $a OR age < $b) AND name = $name"

617644

645+typedCoalesceSelect

646+ :: Q _ (name :: String, val :: Int) () _

647+typedCoalesceSelect = from usersTable

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

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+

618745-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

619746-- Spec

620747-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

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

644771 it "renders DEFAULT in DDL" do

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

646773 it "skips Default columns in INSERT" do

647− 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)"

648795

649796 describe "UPDATE SQL" do

650797 it "generates UPDATE with SET and WHERE" do

@@ -741,6 +888,8 @@ spec = do

741888 (typedFullAggregate # toSQL) `shouldEqual` "SELECT name, COUNT(*) AS cnt FROM users GROUP BY name HAVING COUNT(*) > $min ORDER BY name LIMIT 10"

742889 it "builds WHERE + GROUP BY + HAVING" do

743890 (typedWhereGroupByHaving # toSQL) `shouldEqual` "SELECT name, COUNT(*) AS cnt FROM users WHERE age > $age GROUP BY name HAVING COUNT(*) > $minCount"

891+ it "builds COALESCE with nested parens" do

892+ (typedCoalesceSelect # toSQL) `shouldEqual` "SELECT name, COALESCE(age, 0) AS val FROM users"

744893

745894 describe "Builder window functions" do

746895 it "builds ROW_NUMBER() OVER" do

@@ -787,6 +936,12 @@ spec = do

787936 (typedIsNull # toSQL) `shouldEqual` "SELECT * FROM users WHERE age IS NULL"

788937 it "builds IS NOT NULL" do

789938 (typedIsNotNull # toSQL) `shouldEqual` "SELECT * FROM users WHERE age IS NOT NULL"

939+ it "builds lowercase is null" do

940+ (typedIsNullLowercase # toSQL) `shouldEqual` "SELECT * FROM users WHERE age is null"

941+ it "builds lowercase between" do

942+ (typedBetweenLowercase # toSQL) `shouldEqual` "SELECT * FROM users WHERE age between $lo and $hi"

943+ it "builds lowercase like" do

944+ (typedLikeLowercase # toSQL) `shouldEqual` "SELECT * FROM users WHERE name like $pat"

790945 it "builds nested parentheses" do

791946 (typedNestedParens # toSQL) `shouldEqual` "SELECT * FROM users WHERE (age > $a OR age < $b) AND name = $name"

792947

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

9151070 describe "Builder update execution" do

9161071 it "updates a row" do

9171072 resetUsers conn

918− count <- from usersTable

1073+ count <- update usersTable

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

9201075 # where_ @"name = $name"

9211076 # runExecute conn { name: "Alice" }

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

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

9281083

9291084 it "updates with RETURNING" do

930− rows <- from usersTable

1085+ rows <- update usersTable

9311086 # set { age: Just 99 }

9321087 # where_ @"name = $name"

9331088 # returning @"name, age"

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

11921347 # orderBy @"name"

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

11941349 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" } ]