git.iko.soy/rowtype-yoga/purescript-yoga-postgres
on main help sign in
swap
c39795386 ahead, 0 behind
.github/workflows/ci.yml+6−1
since splitsnapshots
unifiedsplit
@@ -6,4 +6,9 @@ jobs:
6 steps:
6 steps:
7 - uses: actions/checkout@v4
7 - uses: actions/checkout@v4
8 - uses: rowtype-yoga/purescript-yoga-actions/.github/actions/setup@main
8 - uses: rowtype-yoga/purescript-yoga-actions/.github/actions/setup@main
9+ - run: bun install --frozen-lockfile
10+ - run: docker compose -f docker-compose.test.yml up -d --wait postgres
9− - run: spago build
11+ - run: spago test
12+ - run: bash compile-fail-tests/run.sh
13+ - if: always()
14+ run: docker compose -f docker-compose.test.yml down --volumes
.gitignore+1
@@ -3,3 +3,4 @@ node_modules/
3output/
3output/
4output-*/
4output-*/
5.DS_Store
5.DS_Store
6+.psc-ide-port
.psc-ide-portnew file+1
@@ -0,0 +1 @@
1+15490
.psci_modules/Data.Boolean/externs.cbornew file

Binary file not shown.

.psci_modules/Data.Boolean/index.jsnew file+11
@@ -0,0 +1,11 @@
1+
2+// | An alias for `true`, which can be useful in guard clauses:
3+// |
4+// | ```purescript
5+// | max x y | x >= y = x
6+// | | otherwise = y
7+// | ```
8+var otherwise = true;
9+export {
10+ otherwise
11+};
.psci_modules/Data.Int.Bits/externs.cbornew file

Binary file not shown.

.psci_modules/Data.Int.Bits/foreign.jsnew file+48
@@ -0,0 +1,48 @@
1+// module Data.Int.Bits
2+
3+export const and = function (n1) {
4+ return function (n2) {
5+ /* jshint bitwise: false */
6+ return n1 & n2;
7+ };
8+};
9+
10+export const or = function (n1) {
11+ return function (n2) {
12+ /* jshint bitwise: false */
13+ return n1 | n2;
14+ };
15+};
16+
17+export const xor = function (n1) {
18+ return function (n2) {
19+ /* jshint bitwise: false */
20+ return n1 ^ n2;
21+ };
22+};
23+
24+export const shl = function (n1) {
25+ return function (n2) {
26+ /* jshint bitwise: false */
27+ return n1 << n2;
28+ };
29+};
30+
31+export const shr = function (n1) {
32+ return function (n2) {
33+ /* jshint bitwise: false */
34+ return n1 >> n2;
35+ };
36+};
37+
38+export const zshr = function (n1) {
39+ return function (n2) {
40+ /* jshint bitwise: false */
41+ return n1 >>> n2;
42+ };
43+};
44+
45+export const complement = function (n) {
46+ /* jshint bitwise: false */
47+ return ~n;
48+};
.psci_modules/Data.Int.Bits/index.jsnew file+12
@@ -0,0 +1,12 @@
1+// | This module defines bitwise operations for the `Int` type.
2+import * as $foreign from "./foreign.js";
3+
4+export {
5+ and,
6+ or,
7+ xor,
8+ shl,
9+ shr,
10+ zshr,
11+ complement
12+} from "./foreign.js";
.psci_modules/Data.NaturalTransformation/externs.cbornew file

Binary file not shown.

.psci_modules/Data.NaturalTransformation/index.jsnew file+1
@@ -0,0 +1 @@
1+
.psci_modules/Data.String.Unsafe/externs.cbornew file

Binary file not shown.

.psci_modules/Data.String.Unsafe/foreign.jsnew file+11
@@ -0,0 +1,11 @@
1+export const charAt = function (i) {
2+ return function (s) {
3+ if (i >= 0 && i < s.length) return s.charAt(i);
4+ throw new Error("Data.String.Unsafe.charAt: Invalid index.");
5+ };
6+};
7+
8+export const char = function (s) {
9+ if (s.length === 1) return s.charAt(0);
10+ throw new Error("Data.String.Unsafe.char: Expected string of length 1.");
11+};
.psci_modules/Data.String.Unsafe/index.jsnew file+7
@@ -0,0 +1,7 @@
1+// | Unsafe string and character functions.
2+import * as $foreign from "./foreign.js";
3+
4+export {
5+ char,
6+ charAt
7+} from "./foreign.js";
.psci_modules/Data.Traversable.Accum/externs.cbornew file

Binary file not shown.

.psci_modules/Data.Traversable.Accum/index.jsnew file+1
@@ -0,0 +1 @@
1+
.psci_modules/Data.Unit/externs.cbornew file

Binary file not shown.

.psci_modules/Data.Unit/foreign.jsnew file+1
@@ -0,0 +1 @@
1+export const unit = undefined;
.psci_modules/Data.Unit/index.jsnew file+5
@@ -0,0 +1,5 @@
1+import * as $foreign from "./foreign.js";
2+
3+export {
4+ unit
5+} from "./foreign.js";
.psci_modules/Data.Void/externs.cbornew file

Binary file not shown.

.psci_modules/Data.Void/index.jsnew file+48
@@ -0,0 +1,48 @@
1+
2+// | An uninhabited data type. In other words, one can never create
3+// | a runtime value of type `Void` because no such value exists.
4+// |
5+// | `Void` is useful to eliminate the possibility of a value being created.
6+// | For example, a value of type `Either Void Boolean` can never have
7+// | a Left value created in PureScript.
8+// |
9+// | This should not be confused with the keyword `void` that commonly appears in
10+// | C-family languages, such as Java:
11+// | ```
12+// | public class Foo {
13+// | void doSomething() { System.out.println("hello world!"); }
14+// | }
15+// | ```
16+// |
17+// | In PureScript, one often uses `Unit` to achieve similar effects as
18+// | the `void` of C-family languages above.
19+var Void = function (x) {
20+ return x;
21+};
22+
23+// | Eliminator for the `Void` type.
24+// | Useful for stating that some code branch is impossible because you've
25+// | "acquired" a value of type `Void` (which you can't).
26+// |
27+// | ```purescript
28+// | rightOnly :: forall t . Either Void t -> t
29+// | rightOnly (Left v) = absurd v
30+// | rightOnly (Right t) = t
31+// | ```
32+var absurd = function (a) {
33+ var spin = function ($copy_v) {
34+ var $tco_result;
35+ function $tco_loop(v) {
36+ $copy_v = v;
37+ return;
38+ };
39+ while (!false) {
40+ $tco_result = $tco_loop($copy_v);
41+ };
42+ return $tco_result;
43+ };
44+ return spin(a);
45+};
46+export {
47+ absurd
48+};
.psci_modules/Partial/externs.cbornew file

Binary file not shown.

.psci_modules/Partial/foreign.jsnew file+5
@@ -0,0 +1,5 @@
1+// module Partial
2+
3+export const _crashWith = function (msg) {
4+ throw new Error(msg);
5+};
.psci_modules/Partial/index.jsnew file+17
@@ -0,0 +1,17 @@
1+// | Some partial helper functions. See the README for more documentation.
2+import * as $foreign from "./foreign.js";
3+
4+// | A partial function which crashes on any input with the specified message.
5+var crashWith = function () {
6+ return $foreign["_crashWith"];
7+};
8+var crashWith1 = /* #__PURE__ */ crashWith();
9+
10+// | A partial function which crashes on any input with a default message.
11+var crash = function () {
12+ return crashWith1("Partial.crash: partial function");
13+};
14+export {
15+ crash,
16+ crashWith
17+};
.psci_modules/Record.Unsafe/externs.cbornew file

Binary file not shown.

.psci_modules/Record.Unsafe/foreign.jsnew file+38
@@ -0,0 +1,38 @@
1+export const unsafeHas = function (label) {
2+ return function (rec) {
3+ return {}.hasOwnProperty.call(rec, label);
4+ };
5+};
6+
7+export const unsafeGet = function (label) {
8+ return function (rec) {
9+ return rec[label];
10+ };
11+};
12+
13+export const unsafeSet = function (label) {
14+ return function (value) {
15+ return function (rec) {
16+ var copy = {};
17+ for (var key in rec) {
18+ if ({}.hasOwnProperty.call(rec, key)) {
19+ copy[key] = rec[key];
20+ }
21+ }
22+ copy[label] = value;
23+ return copy;
24+ };
25+ };
26+};
27+
28+export const unsafeDelete = function (label) {
29+ return function (rec) {
30+ var copy = {};
31+ for (var key in rec) {
32+ if (key !== label && {}.hasOwnProperty.call(rec, key)) {
33+ copy[key] = rec[key];
34+ }
35+ }
36+ return copy;
37+ };
38+};
.psci_modules/Record.Unsafe/index.jsnew file+14
@@ -0,0 +1,14 @@
1+// | The functions in this module are highly unsafe as they treat records like
2+// | stringly-keyed maps and can coerce the row of labels that a record has.
3+// |
4+// | These function are intended for situations where there is some other way of
5+// | proving things about the structure of the record - for example, when using
6+// | `RowToList`. **They should never be used for general record manipulation.**
7+import * as $foreign from "./foreign.js";
8+
9+export {
10+ unsafeHas,
11+ unsafeGet,
12+ unsafeSet,
13+ unsafeDelete
14+} from "./foreign.js";
.psci_modules/Spago.Generated.BuildInfo/externs.cbornew file

Binary file not shown.

.psci_modules/Spago.Generated.BuildInfo/index.jsnew file+13
@@ -0,0 +1,13 @@
1+// @inline export packages always
2+// @inline export pursVersion always
3+// @inline export spagoVersion always
4+var spagoVersion = "1.0.3";
5+var pursVersion = "0.15.15";
6+var packages = {
7+ "yoga-postgres": "0.1.0"
8+};
9+export {
10+ packages,
11+ pursVersion,
12+ spagoVersion
13+};
.psci_modules/Type.Equality/externs.cbornew file

Binary file not shown.

.psci_modules/Type.Equality/index.jsnew file+35
@@ -0,0 +1,35 @@
1+var To = function (x) {
2+ return x;
3+};
4+var From = function (x) {
5+ return x;
6+};
7+var refl = {
8+ proof: function (a) {
9+ return a;
10+ },
11+ Coercible0: function () {
12+ return undefined;
13+ }
14+};
15+var proof = function (dict) {
16+ return dict.proof;
17+};
18+var to = function (dictTypeEquals) {
19+ var v = proof(dictTypeEquals)(function (a) {
20+ return a;
21+ });
22+ return v;
23+};
24+var from = function (dictTypeEquals) {
25+ var v = proof(dictTypeEquals)(function (a) {
26+ return a;
27+ });
28+ return v;
29+};
30+export {
31+ proof,
32+ to,
33+ from,
34+ refl
35+};
.psci_modules/Type.Function/externs.cbornew file

Binary file not shown.

.psci_modules/Type.Function/index.jsnew file+1
@@ -0,0 +1 @@
1+
.psci_modules/Type.Proxy/externs.cbornew file

Binary file not shown.

.psci_modules/Type.Proxy/index.jsnew file+58
@@ -0,0 +1,58 @@
1+// | The `Proxy` type and values are for situations where type information is
2+// | required for an input to determine the type of an output, but where it is
3+// | not possible or convenient to provide a _value_ for the input.
4+// |
5+// | A hypothetical example: if you have a class that is used to handle the
6+// | result of an AJAX request, you may want to use this information to set the
7+// | expected content type of the request, so you might have a class something
8+// | like this:
9+// |
10+// | ``` purescript
11+// | class AjaxResponse a where
12+// | responseType :: a -> ResponseType
13+// | fromResponse :: Foreign -> a
14+// | ```
15+// |
16+// | The problem here is `responseType` requires a value of type `a`, but we
17+// | won't have a value of that type until the request has been completed. The
18+// | solution is to use a `Proxy` type instead:
19+// |
20+// | ``` purescript
21+// | class AjaxResponse a where
22+// | responseType :: Proxy a -> ResponseType
23+// | fromResponse :: Foreign -> a
24+// | ```
25+// |
26+// | We can now call `responseType (Proxy :: Proxy SomeContentType)` to produce
27+// | a `ResponseType` for `SomeContentType` without having to construct some
28+// | empty version of `SomeContentType` first. In situations like this where
29+// | the `Proxy` type can be statically determined, it is recommended to pull
30+// | out the definition to the top level and make a declaration like:
31+// |
32+// | ``` purescript
33+// | _SomeContentType :: Proxy SomeContentType
34+// | _SomeContentType = Proxy
35+// | ```
36+// |
37+// | That way the proxy value can be used as `responseType _SomeContentType`
38+// | for improved readability. However, this is not always possible, sometimes
39+// | the type required will be determined by a type variable. As PureScript has
40+// | scoped type variables, we can do things like this:
41+// |
42+// | ``` purescript
43+// | makeRequest :: URL -> ResponseType -> Aff _ Foreign
44+// | makeRequest = ...
45+// |
46+// | fetchData :: forall a. (AjaxResponse a) => URL -> Aff _ a
47+// | fetchData url = fromResponse <$> makeRequest url (responseType (Proxy :: Proxy a))
48+// | ```
49+var $$Proxy = /* #__PURE__ */ (function () {
50+ function $$Proxy() {
51+
52+ };
53+ $$Proxy.value = new $$Proxy();
54+ return $$Proxy;
55+})();
56+export {
57+ $$Proxy as Proxy
58+};
.psci_modules/Type.Row/externs.cbornew file

Binary file not shown.

.psci_modules/Type.Row/index.jsnew file+1
@@ -0,0 +1 @@
1+
.psci_modules/Unsafe.Coerce/externs.cbornew file

Binary file not shown.

.psci_modules/Unsafe.Coerce/foreign.jsnew file+5
@@ -0,0 +1,5 @@
1+// module Unsafe.Coerce
2+
3+export const unsafeCoerce = function (x) {
4+ return x;
5+};
.psci_modules/Unsafe.Coerce/index.jsnew file+5
@@ -0,0 +1,5 @@
1+import * as $foreign from "./foreign.js";
2+
3+export {
4+ unsafeCoerce
5+} from "./foreign.js";
.psci_modules/cache-db.jsonnew file+1
@@ -0,0 +1 @@
1+{"Data.Boolean":{".spago/p/prelude-6.0.2/src/Data/Boolean.purs":["1970-01-01T00:00:00Z","aa81cf83948d1c45051dcfb835b0caef7a8ed8a39c58d8126f4efde1973880dbcd169d36bbe8c82a62586c386810bf0824f018674a93c606e43bc451fb6c3819"]},"Data.Int.Bits":{".spago/p/integers-6.0.0/src/Data/Int/Bits.js":["1970-01-01T06:00:00Z","bdbabdb4bf0d318a750d7ff7e1542735731877a33803a87011e670bafa8d59c8c3ef42107be1ca1b86dc7b8222c11008895341e36760cf7989a0da098d848100"],".spago/p/integers-6.0.0/src/Data/Int/Bits.purs":["1970-01-01T06:00:00Z","61f10b047f013a5b4505df8cc49e566ce827bce1272b471cdcc2a2b849e39db49f0850613e036931a4d2efd7a2cc727bbd8a8a310498ea28552cc4d6547fc800"]},"Data.NaturalTransformation":{".spago/p/prelude-6.0.2/src/Data/NaturalTransformation.purs":["1970-01-01T00:00:00Z","6b9fc42ec524a517d464dea99867c64345cdbcbada4260a772373a956961ad1c9a4a3a4f8ed4a0c7c7f3e36120068954141841c5d6bdc4e5898ea06435104bb7"]},"Data.String.Unsafe":{".spago/p/strings-6.0.1/src/Data/String/Unsafe.js":["1970-01-01T06:00:00Z","81c79d607f04aaa23089d717e10d358971deec3254ee25837a9d14e947c4d28444e4057abd2cdc1c114327a43584c3cef2cbec957b011ab4ed412e1a25596812"],".spago/p/strings-6.0.1/src/Data/String/Unsafe.purs":["1970-01-01T06:00:00Z","c3bddfdcefc7c46316a573e2af253df77fae08a64ad096f692391d33266d0f77623c0a6c8008a15bcae0d440670734399edd547ed335f5beecf9042b49fa2d9b"]},"Data.Traversable.Accum":{".spago/p/foldable-traversable-6.0.0/src/Data/Traversable/Accum.purs":["1970-01-01T06:00:00Z","7ed0b4dd42144ce367aadd2e05d85ef408bc4ad53047245459a452b4afc5063eed7a29c4de0f8811fbb4aa1c3a725b38caa41d2adef39570f56da625a649f475"]},"Data.Unit":{".spago/p/prelude-6.0.2/src/Data/Unit.js":["1970-01-01T00:00:00Z","d7185d75aa1f2fe353e4e200ab4181472e354d6295cb2e6587a56636b1bc733be77b2f5616b20275fe7be0138a6442b2979864b1b234a813f8d9237baa4cd5f3"],".spago/p/prelude-6.0.2/src/Data/Unit.purs":["1970-01-01T00:00:00Z","425d50d748941435bf7f4d6b61769e2b0931973280ba6dd91dcca3f963cc9223b2a7ccd5827611182348041c0813b3be828e2dacc54933ddc152d6e50f7f2f3d"]},"Data.Void":{".spago/p/prelude-6.0.2/src/Data/Void.purs":["1970-01-01T00:00:00Z","28ae6f4ecd4ee9a07dc5c034f189a8740a9e14bef332d6bab73b8e3b2ea51ed2bec88d84862ff4cd989e671be324b019282a2678a6d73e59f05af414705bd47e"]},"Partial":{".spago/p/partial-4.0.0/src/Partial.js":["1970-01-01T05:00:00Z","d45c8f3617d1d79196c1d8973444e721a70932e76c1755cf0cbce746bc56310ede97437260d3198b7ceb0f435bf747749c4ba014d8203ce9268a2eff015cd04d"],".spago/p/partial-4.0.0/src/Partial.purs":["1970-01-01T05:00:00Z","03782c3fed740d0eca8fd83e3832b448f1e62531cf926703f7d0a2ad19a0031a1dc11eb1206543b68ce7a8161fd24b6d9aa177e4475fa4fdc2b4d91444385037"]},"Record.Unsafe":{".spago/p/prelude-6.0.2/src/Record/Unsafe.js":["1970-01-01T00:00:00Z","667d613a0e1265a710e98c9f6e64ff791b9e9b7227cdf699c3a25724077c02e42726c807c0387ca4484454fd853d5b41522bf2e048887f22a894413ef80cbb92"],".spago/p/prelude-6.0.2/src/Record/Unsafe.purs":["1970-01-01T00:00:00Z","af8a7c83127f5e61853ad0e572be799c04e321562a375d51ab133706ac6a6777e169b057f01a709ad7aae2d8c7a5ae8daa28eae8793c4fe92e2e8f0cfaecf870"]},"Spago.Generated.BuildInfo":{".spago/BuildInfo.purs":["2026-02-05T16:50:58.182704219Z","3cb3ce01c96271be44a63fd2517f9f07a206187b8879a7c991d8630056847d6cf4d782027bce1e1ac9a99a2a1f9be1e7f1a5461b5119f5c554aa1e30136e05e9"]},"Type.Equality":{".spago/p/type-equality-4.0.1/src/Type/Equality.purs":["1970-01-01T05:00:00Z","2713b8d5621912fe0dad9cd588cf4579181566459fe200f5089de472d00e29ab4a1c020f73a8e89f04f3ef02b94ec28082d17d395b89349d6c5f8016426a009e"]},"Type.Function":{".spago/p/typelevel-prelude-7.0.0/src/Type/Function.purs":["1970-01-01T06:00:00Z","d1b8eb136c5e23ded6dcd622ef352200ea9a323dd4f3dec0328fe0dbcf673ee4c959a495efecc5605fedcb7824bb086faaf8684fa30afe0625b1d03fc921b149"]},"Type.Proxy":{".spago/p/prelude-6.0.2/src/Type/Proxy.purs":["1970-01-01T00:00:00Z","333d0ae90b05098eada860ad476ed9e1eacd67d969dc1573c74375610cf8de22e85a358a7783a0a461d7ffa6fe322d8c3e90696be02555a02793ac99aba687f2"]},"Type.Row":{".spago/p/typelevel-prelude-7.0.0/src/Type/Row.purs":["1970-01-01T06:00:00Z","cee5ad6bca731f76da8388f32d1e2f644b0dd976734261a01d2a5dd1671924e4534168e085f843f1576c754c917ccdf7fb0e68925fd23a2e121a1bed33d9a4c0"]},"Unsafe.Coerce":{".spago/p/unsafe-coerce-6.0.0/src/Unsafe/Coerce.js":["1970-01-01T05:00:00Z","031c3187f7ce65110a359260041309506e1ff39a97b6eb22c9a8f2e5c14b35db87d509bb5929f245c5d80df6ccd6dadf83579ebe4ac46650acdfa34a493cfc0d"],".spago/p/unsafe-coerce-6.0.0/src/Unsafe/Coerce.purs":["1970-01-01T05:00:00Z","04b214d9cbbf0c438bb2af4b25f8db5d04f247059241982f718c6d83322c3180f0eced0eb5c410860dcdb35650e9129a1cffe87f7279308cc4cf6c6570bba74f"]}}
.psci_modules/package.jsonnew file+1
@@ -0,0 +1 @@
1+{"type":"module"}
.purs-replnew file+1
@@ -0,0 +1 @@
1+import Prelude
bun.locknew file+46
@@ -0,0 +1,46 @@
1+{
2+ "lockfileVersion": 1,
3+ "workspaces": {
4+ "": {
5+ "name": "purescript-yoga-postgres",
6+ "dependencies": {
7+ "pg": "^8.11.0",
8+ "postgres": "^3.4.8",
9+ "uuid": "^13.0.0",
10+ },
11+ },
12+ },
13+ "packages": {
14+ "pg": ["pg@8.18.0", "", { "dependencies": { "pg-connection-string": "^2.11.0", "pg-pool": "^3.11.0", "pg-protocol": "^1.11.0", "pg-types": "2.2.0", "pgpass": "1.0.5" }, "optionalDependencies": { "pg-cloudflare": "^1.3.0" }, "peerDependencies": { "pg-native": ">=3.0.1" }, "optionalPeers": ["pg-native"] }, "sha512-xqrUDL1b9MbkydY/s+VZ6v+xiMUmOUk7SS9d/1kpyQxoJ6U9AO1oIJyUWVZojbfe5Cc/oluutcgFG4L9RDP1iQ=="],
15+
16+ "pg-cloudflare": ["pg-cloudflare@1.3.0", "", {}, "sha512-6lswVVSztmHiRtD6I8hw4qP/nDm1EJbKMRhf3HCYaqud7frGysPv7FYJ5noZQdhQtN2xJnimfMtvQq21pdbzyQ=="],
17+
18+ "pg-connection-string": ["pg-connection-string@2.11.0", "", {}, "sha512-kecgoJwhOpxYU21rZjULrmrBJ698U2RxXofKVzOn5UDj61BPj/qMb7diYUR1nLScCDbrztQFl1TaQZT0t1EtzQ=="],
19+
20+ "pg-int8": ["pg-int8@1.0.1", "", {}, "sha512-WCtabS6t3c8SkpDBUlb1kjOs7l66xsGdKpIPZsg4wR+B3+u9UAum2odSsF9tnvxg80h4ZxLWMy4pRjOsFIqQpw=="],
21+
22+ "pg-pool": ["pg-pool@3.11.0", "", { "peerDependencies": { "pg": ">=8.0" } }, "sha512-MJYfvHwtGp870aeusDh+hg9apvOe2zmpZJpyt+BMtzUWlVqbhFmMK6bOBXLBUPd7iRtIF9fZplDc7KrPN3PN7w=="],
23+
24+ "pg-protocol": ["pg-protocol@1.11.0", "", {}, "sha512-pfsxk2M9M3BuGgDOfuy37VNRRX3jmKgMjcvAcWqNDpZSf4cUmv8HSOl5ViRQFsfARFn0KuUQTgLxVMbNq5NW3g=="],
25+
26+ "pg-types": ["pg-types@2.2.0", "", { "dependencies": { "pg-int8": "1.0.1", "postgres-array": "~2.0.0", "postgres-bytea": "~1.0.0", "postgres-date": "~1.0.4", "postgres-interval": "^1.1.0" } }, "sha512-qTAAlrEsl8s4OiEQY69wDvcMIdQN6wdz5ojQiOy6YRMuynxenON0O5oCpJI6lshc6scgAY8qvJ2On/p+CXY0GA=="],
27+
28+ "pgpass": ["pgpass@1.0.5", "", { "dependencies": { "split2": "^4.1.0" } }, "sha512-FdW9r/jQZhSeohs1Z3sI1yxFQNFvMcnmfuj4WBMUTxOrAyLMaTcE1aAMBiTlbMNaXvBCQuVi0R7hd8udDSP7ug=="],
29+
30+ "postgres": ["postgres@3.4.8", "", {}, "sha512-d+JFcLM17njZaOLkv6SCev7uoLaBtfK86vMUXhW1Z4glPWh4jozno9APvW/XKFJ3CCxVoC7OL38BqRydtu5nGg=="],
31+
32+ "postgres-array": ["postgres-array@2.0.0", "", {}, "sha512-VpZrUqU5A69eQyW2c5CA1jtLecCsN2U/bD6VilrFDWq5+5UIEVO7nazS3TEcHf1zuPYO/sqGvUvW62g86RXZuA=="],
33+
34+ "postgres-bytea": ["postgres-bytea@1.0.1", "", {}, "sha512-5+5HqXnsZPE65IJZSMkZtURARZelel2oXUEO8rH83VS/hxH5vv1uHquPg5wZs8yMAfdv971IU+kcPUczi7NVBQ=="],
35+
36+ "postgres-date": ["postgres-date@1.0.7", "", {}, "sha512-suDmjLVQg78nMK2UZ454hAG+OAW+HQPZ6n++TNDUX+L0+uUlLywnoxJKDou51Zm+zTCjrCl0Nq6J9C5hP9vK/Q=="],
37+
38+ "postgres-interval": ["postgres-interval@1.2.0", "", { "dependencies": { "xtend": "^4.0.0" } }, "sha512-9ZhXKM/rw350N1ovuWHbGxnGh/SNJ4cnxHiM0rxE4VN41wsg8P8zWn9hv/buK00RP4WvlOyr/RBDiptyxVbkZQ=="],
39+
40+ "split2": ["split2@4.2.0", "", {}, "sha512-UcjcJOWknrNkF6PLX83qcHM6KHgVKNkV62Y8a5uYDVv9ydGQVwAHMKqHdJje1VTWpljG0WYpCDhrCdAOYH4TWg=="],
41+
42+ "uuid": ["uuid@13.0.0", "", { "bin": { "uuid": "dist-node/bin/uuid" } }, "sha512-XQegIaBTVUjSHliKqcnFqYypAd4S+WCYt5NIeRs6w/UAry7z8Y9j5ZwRRL4kzq9U3sD6v+85er9FvkEaBpji2w=="],
43+
44+ "xtend": ["xtend@4.0.2", "", {}, "sha512-LKYU1iAXJXUgAXn9URjiu+MWhyUXHsvfp7mcuYm9dSUKK0/CjtrUwFAxD82/mCWbtLsGjFIad0wIsod4zrTAEQ=="],
45+ }
46+}
compile-fail-tests/AggregateWithoutAlias.pursnew file+20
@@ -0,0 +1,20 @@
1+-- EXPECT: Aggregate function requires AS alias
2+module Test.CompileFail.AggregateWithoutAlias where
3+
4+import Prelude
5+import Data.Maybe (Maybe(..))
6+import Type.Function (type (#))
7+import Type.Proxy (Proxy(..))
8+import Yoga.Postgres.Schema
9+
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 @"COUNT(*)"
compile-fail-tests/DeleteAfterSelect.pursnew file+20
@@ -0,0 +1,20 @@
1+-- EXPECT: Lacks
2+module Test.CompileFail.DeleteAfterSelect where
3+
4+import Prelude
5+import Data.Maybe (Maybe(..))
6+import Type.Function (type (#))
7+import Type.Proxy (Proxy(..))
8+import Yoga.Postgres.Schema
9+
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 # delete
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
3+
4+import Prelude
5+import Data.Maybe (Maybe)
6+import Type.Function (type (#))
7+import Type.Proxy (Proxy(..))
8+import Yoga.Postgres.Schema
9+
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/DoubleGroupBy.pursnew file+20
@@ -0,0 +1,20 @@
1+-- EXPECT: Lacks
2+module Test.CompileFail.DoubleGroupBy where
3+
4+import Prelude
5+import Data.Maybe (Maybe(..))
6+import Type.Function (type (#))
7+import Type.Proxy (Proxy(..))
8+import Yoga.Postgres.Schema
9+
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" # groupBy @"name" # groupBy @"name"
compile-fail-tests/DoubleHaving.pursnew file+20
@@ -0,0 +1,20 @@
1+-- EXPECT: Lacks
2+module Test.CompileFail.DoubleHaving where
3+
4+import Prelude
5+import Data.Maybe (Maybe(..))
6+import Type.Function (type (#))
7+import Type.Proxy (Proxy(..))
8+import Yoga.Postgres.Schema
9+
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" # groupBy @"name" # having @"COUNT(*) > 5" # having @"COUNT(*) > 3"
compile-fail-tests/DoubleInsert.pursnew file+20
@@ -0,0 +1,20 @@
1+-- EXPECT: Lacks
2+module Test.CompileFail.DoubleInsert where
3+
4+import Prelude
5+import Data.Maybe (Maybe(..))
6+import Type.Function (type (#))
7+import Type.Proxy (Proxy(..))
8+import Yoga.Postgres.Schema
9+
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 # insert { name: "A", email: "a@b.com" } # insert { name: "B", email: "b@c.com" }
compile-fail-tests/DoubleLimit.pursnew file+20
@@ -0,0 +1,20 @@
1+-- EXPECT: Lacks
2+module Test.CompileFail.DoubleLimit where
3+
4+import Prelude
5+import Data.Maybe (Maybe(..))
6+import Type.Function (type (#))
7+import Type.Proxy (Proxy(..))
8+import Yoga.Postgres.Schema
9+
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" # limit @"5"
compile-fail-tests/DoubleOffset.pursnew file+20
@@ -0,0 +1,20 @@
1+-- EXPECT: Lacks
2+module Test.CompileFail.DoubleOffset where
3+
4+import Prelude
5+import Data.Maybe (Maybe(..))
6+import Type.Function (type (#))
7+import Type.Proxy (Proxy(..))
8+import Yoga.Postgres.Schema
9+
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 # offset @"10" # offset @"5"
compile-fail-tests/DoubleOnConflict.pursnew file+20
@@ -0,0 +1,20 @@
1+-- EXPECT: Lacks
2+module Test.CompileFail.DoubleOnConflict where
3+
4+import Prelude
5+import Data.Maybe (Maybe(..))
6+import Type.Function (type (#))
7+import Type.Proxy (Proxy(..))
8+import Yoga.Postgres.Schema
9+
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 # insert { name: "A", email: "a@b.com" } # onConflictDoNothing @"email" # onConflictDoNothing @"email"
compile-fail-tests/DoubleOrderBy.pursnew file+20
@@ -0,0 +1,20 @@
1+-- EXPECT: Lacks
2+module Test.CompileFail.DoubleOrderBy where
3+
4+import Prelude
5+import Data.Maybe (Maybe(..))
6+import Type.Function (type (#))
7+import Type.Proxy (Proxy(..))
8+import Yoga.Postgres.Schema
9+
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" # orderBy @"id"
compile-fail-tests/DoubleReturning.pursnew file+20
@@ -0,0 +1,20 @@
1+-- EXPECT: Lacks
2+module Test.CompileFail.DoubleReturning where
3+
4+import Prelude
5+import Data.Maybe (Maybe(..))
6+import Type.Function (type (#))
7+import Type.Proxy (Proxy(..))
8+import Yoga.Postgres.Schema
9+
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 # insert { name: "A", email: "a@b.com" } # returning @"id" # returning @"name"
compile-fail-tests/DoubleSelect.pursnew file+20
@@ -0,0 +1,20 @@
1+-- EXPECT: Lacks
2+module Test.CompileFail.DoubleSelect where
3+
4+import Prelude
5+import Data.Maybe (Maybe(..))
6+import Type.Function (type (#))
7+import Type.Proxy (Proxy(..))
8+import Yoga.Postgres.Schema
9+
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 # selectAll
compile-fail-tests/DoubleSet.pursnew file+20
@@ -0,0 +1,20 @@
1+-- EXPECT: Lacks
2+module Test.CompileFail.DoubleSet where
3+
4+import Prelude
5+import Data.Maybe (Maybe(..))
6+import Type.Function (type (#))
7+import Type.Proxy (Proxy(..))
8+import Yoga.Postgres.Schema
9+
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 # set { name: "A" } # set { name: "B" }
compile-fail-tests/DoubleWhere.pursnew file+20
@@ -0,0 +1,20 @@
1+-- EXPECT: Lacks
2+module Test.CompileFail.DoubleWhere where
3+
4+import Prelude
5+import Data.Maybe (Maybe(..))
6+import Type.Function (type (#))
7+import Type.Proxy (Proxy(..))
8+import Yoga.Postgres.Schema
9+
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_ @"id = $id" # where_ @"name = $name"
compile-fail-tests/EmptyDistinctOn.pursnew file+20
@@ -0,0 +1,20 @@
1+-- EXPECT: Empty column list
2+module Test.CompileFail.EmptyDistinctOn where
3+
4+import Prelude
5+import Data.Maybe (Maybe(..))
6+import Type.Function (type (#))
7+import Type.Proxy (Proxy(..))
8+import Yoga.Postgres.Schema
9+
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 # selectDistinctOn @"" @"name"
compile-fail-tests/EmptyGroupBy.pursnew file+20
@@ -0,0 +1,20 @@
1+-- EXPECT: Empty column list
2+module Test.CompileFail.EmptyGroupBy where
3+
4+import Prelude
5+import Data.Maybe (Maybe(..))
6+import Type.Function (type (#))
7+import Type.Proxy (Proxy(..))
8+import Yoga.Postgres.Schema
9+
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" # groupBy @""
compile-fail-tests/EmptyWhere.pursnew file+20
@@ -0,0 +1,20 @@
1+-- EXPECT: Empty WHERE clause
2+module Test.CompileFail.EmptyWhere where
3+
4+import Prelude
5+import Data.Maybe (Maybe(..))
6+import Type.Function (type (#))
7+import Type.Proxy (Proxy(..))
8+import Yoga.Postgres.Schema
9+
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/GroupByAfterUnion.pursnew file+20
@@ -0,0 +1,20 @@
1+-- EXPECT: Lacks
2+module Test.CompileFail.GroupByAfterUnion where
3+
4+import Prelude
5+import Data.Maybe (Maybe(..))
6+import Type.Function (type (#))
7+import Type.Proxy (Proxy(..))
8+import Yoga.Postgres.Schema
9+
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") `union` (from usersTable # select @"name") # groupBy @"name"
compile-fail-tests/GroupByBeforeSelect.pursnew file+20
@@ -0,0 +1,20 @@
1+-- EXPECT: Cons
2+module Test.CompileFail.GroupByBeforeSelect where
3+
4+import Prelude
5+import Data.Maybe (Maybe(..))
6+import Type.Function (type (#))
7+import Type.Proxy (Proxy(..))
8+import Yoga.Postgres.Schema
9+
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 # groupBy @"name"
compile-fail-tests/HavingBeforeGroupBy.pursnew file+20
@@ -0,0 +1,20 @@
1+-- EXPECT: Cons
2+module Test.CompileFail.HavingBeforeGroupBy where
3+
4+import Prelude
5+import Data.Maybe (Maybe(..))
6+import Type.Function (type (#))
7+import Type.Proxy (Proxy(..))
8+import Yoga.Postgres.Schema
9+
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" # having @"COUNT(*) > 5"
compile-fail-tests/HavingParamDuplicateName.pursnew file+24
@@ -0,0 +1,24 @@
1+-- EXPECT: Nub
2+module Test.CompileFail.HavingParamDuplicateName where
3+
4+import Prelude
5+import Data.Maybe (Maybe(..))
6+import Type.Function (type (#))
7+import Type.Proxy (Proxy(..))
8+import Yoga.Postgres.Schema
9+
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
21+ # select @"name, COUNT(*) AS cnt"
22+ # where_ @"name = $x"
23+ # groupBy @"name"
24+ # having @"COUNT(*) > $x"
compile-fail-tests/InsertAfterSelect.pursnew file+20
@@ -0,0 +1,20 @@
1+-- EXPECT: Lacks
2+module Test.CompileFail.InsertAfterSelect where
3+
4+import Prelude
5+import Data.Maybe (Maybe(..))
6+import Type.Function (type (#))
7+import Type.Proxy (Proxy(..))
8+import Yoga.Postgres.Schema
9+
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 # insert { name: "A", email: "a@b.com" }
compile-fail-tests/InsertExtraColumn.pursnew file+20
@@ -0,0 +1,20 @@
1+-- EXPECT: Union
2+module Test.CompileFail.InsertExtraColumn where
3+
4+import Prelude
5+import Data.Maybe (Maybe(..))
6+import Type.Function (type (#))
7+import Type.Proxy (Proxy(..))
8+import Yoga.Postgres.Schema
9+
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 # insert { name: "A", email: "a@b.com", bogus: 42 }
compile-fail-tests/InvalidColumnInDistinctOn.pursnew file+20
@@ -0,0 +1,20 @@
1+-- EXPECT: NoInstanceFound
2+module Test.CompileFail.InvalidColumnInDistinctOn where
3+
4+import Prelude
5+import Data.Maybe (Maybe(..))
6+import Type.Function (type (#))
7+import Type.Proxy (Proxy(..))
8+import Yoga.Postgres.Schema
9+
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 # selectDistinctOn @"nonexistent" @"name"
compile-fail-tests/InvalidColumnInGroupBy.pursnew file+20
@@ -0,0 +1,20 @@
1+-- EXPECT: NoInstanceFound
2+module Test.CompileFail.InvalidColumnInGroupBy where
3+
4+import Prelude
5+import Data.Maybe (Maybe(..))
6+import Type.Function (type (#))
7+import Type.Proxy (Proxy(..))
8+import Yoga.Postgres.Schema
9+
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" # groupBy @"nonexistent"
compile-fail-tests/InvalidColumnInOnConflict.pursnew file+20
@@ -0,0 +1,20 @@
1+-- EXPECT: TypesDoNotUnify
2+module Test.CompileFail.InvalidColumnInOnConflict where
3+
4+import Prelude
5+import Data.Maybe (Maybe(..))
6+import Type.Function (type (#))
7+import Type.Proxy (Proxy(..))
8+import Yoga.Postgres.Schema
9+
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 # insert { name: "A", email: "a@b.com" } # onConflictDoNothing @"nonexistent"
compile-fail-tests/InvalidColumnInOrderBy.pursnew file+20
@@ -0,0 +1,20 @@
1+-- EXPECT: NoInstanceFound
2+module Test.CompileFail.InvalidColumnInOrderBy where
3+
4+import Prelude
5+import Data.Maybe (Maybe(..))
6+import Type.Function (type (#))
7+import Type.Proxy (Proxy(..))
8+import Yoga.Postgres.Schema
9+
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 @"nonexistent"
compile-fail-tests/InvalidColumnInSelect.pursnew file+20
@@ -0,0 +1,20 @@
1+-- EXPECT: NoInstanceFound
2+module Test.CompileFail.InvalidColumnInSelect where
3+
4+import Prelude
5+import Data.Maybe (Maybe(..))
6+import Type.Function (type (#))
7+import Type.Proxy (Proxy(..))
8+import Yoga.Postgres.Schema
9+
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 @"nonexistent"
compile-fail-tests/InvalidColumnInSet.pursnew file+20
@@ -0,0 +1,20 @@
1+-- EXPECT: TypesDoNotUnify
2+module Test.CompileFail.InvalidColumnInSet where
3+
4+import Prelude
5+import Data.Maybe (Maybe(..))
6+import Type.Function (type (#))
7+import Type.Proxy (Proxy(..))
8+import Yoga.Postgres.Schema
9+
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 # set { nonexistent: "B" }
compile-fail-tests/InvalidColumnInWhere.pursnew file+20
@@ -0,0 +1,20 @@
1+-- EXPECT: NoInstanceFound
2+module Test.CompileFail.InvalidColumnInWhere where
3+
4+import Prelude
5+import Data.Maybe (Maybe(..))
6+import Type.Function (type (#))
7+import Type.Proxy (Proxy(..))
8+import Yoga.Postgres.Schema
9+
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_ @"nonexistent = $x"
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
3+
4+import Prelude
5+import Data.Maybe (Maybe(..))
6+import Type.Function (type (#))
7+import Type.Proxy (Proxy(..))
8+import Yoga.Postgres.Schema
9+
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
3+
4+import Prelude
5+import Data.Maybe (Maybe(..))
6+import Type.Function (type (#))
7+import Type.Proxy (Proxy(..))
8+import Yoga.Postgres.Schema
9+
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
3+
4+import Prelude
5+import Data.Maybe (Maybe(..))
6+import Type.Function (type (#))
7+import Type.Proxy (Proxy(..))
8+import Yoga.Postgres.Schema
9+
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/JoinAmbiguousColumn.pursnew file+29
@@ -0,0 +1,29 @@
1+-- EXPECT: NoInstanceFound
2+module Test.CompileFail.JoinAmbiguousColumn where
3+
4+import Prelude
5+import Data.Maybe (Maybe(..))
6+import Type.Function (type (#))
7+import Type.Proxy (Proxy(..))
8+import Yoga.Postgres.Schema
9+
10+type UsersTable = Table "users"
11+ ( id :: Int # PrimaryKey # AutoIncrement
12+ , name :: String
13+ )
14+
15+type PostsTable = Table "posts"
16+ ( id :: Int # PrimaryKey # AutoIncrement
17+ , title :: String
18+ , user_id :: Int
19+ )
20+
21+usersTable :: Proxy UsersTable
22+usersTable = Proxy
23+
24+postsTable :: Proxy PostsTable
25+postsTable = Proxy
26+
27+bad = from usersTable
28+ # innerJoin @"users.id = posts.user_id" postsTable
29+ # select @"id"
compile-fail-tests/JoinInvalidColumn.pursnew file+29
@@ -0,0 +1,29 @@
1+-- EXPECT: TypesDoNotUnify
2+module Test.CompileFail.JoinInvalidColumn where
3+
4+import Prelude
5+import Data.Maybe (Maybe(..))
6+import Type.Function (type (#))
7+import Type.Proxy (Proxy(..))
8+import Yoga.Postgres.Schema
9+
10+type UsersTable = Table "users"
11+ ( id :: Int # PrimaryKey # AutoIncrement
12+ , name :: String
13+ )
14+
15+type PostsTable = Table "posts"
16+ ( id :: Int # PrimaryKey # AutoIncrement
17+ , title :: String
18+ , user_id :: Int
19+ )
20+
21+usersTable :: Proxy UsersTable
22+usersTable = Proxy
23+
24+postsTable :: Proxy PostsTable
25+postsTable = Proxy
26+
27+bad = from usersTable
28+ # innerJoin @"users.id = posts.user_id" postsTable
29+ # select @"users.nonexistent"
compile-fail-tests/JoinInvalidTable.pursnew file+29
@@ -0,0 +1,29 @@
1+-- EXPECT: TypesDoNotUnify
2+module Test.CompileFail.JoinInvalidTable where
3+
4+import Prelude
5+import Data.Maybe (Maybe(..))
6+import Type.Function (type (#))
7+import Type.Proxy (Proxy(..))
8+import Yoga.Postgres.Schema
9+
10+type UsersTable = Table "users"
11+ ( id :: Int # PrimaryKey # AutoIncrement
12+ , name :: String
13+ )
14+
15+type PostsTable = Table "posts"
16+ ( id :: Int # PrimaryKey # AutoIncrement
17+ , title :: String
18+ , user_id :: Int
19+ )
20+
21+usersTable :: Proxy UsersTable
22+usersTable = Proxy
23+
24+postsTable :: Proxy PostsTable
25+postsTable = Proxy
26+
27+bad = from usersTable
28+ # innerJoin @"users.id = posts.user_id" postsTable
29+ # select @"nonexistent_table.name"
compile-fail-tests/JoinSelectBeforeJoin.pursnew file+29
@@ -0,0 +1,29 @@
1+-- EXPECT: NoInstanceFound
2+module Test.CompileFail.JoinSelectBeforeJoin where
3+
4+import Prelude
5+import Data.Maybe (Maybe(..))
6+import Type.Function (type (#))
7+import Type.Proxy (Proxy(..))
8+import Yoga.Postgres.Schema
9+
10+type UsersTable = Table "users"
11+ ( id :: Int # PrimaryKey # AutoIncrement
12+ , name :: String
13+ )
14+
15+type PostsTable = Table "posts"
16+ ( id :: Int # PrimaryKey # AutoIncrement
17+ , title :: String
18+ , user_id :: Int
19+ )
20+
21+usersTable :: Proxy UsersTable
22+usersTable = Proxy
23+
24+postsTable :: Proxy PostsTable
25+postsTable = Proxy
26+
27+bad = from usersTable
28+ # selectAll
29+ # innerJoin @"users.id = posts.user_id" postsTable
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
3+
4+import Prelude
5+import Data.Maybe (Maybe(..))
6+import Type.Function (type (#))
7+import Type.Proxy (Proxy(..))
8+import Yoga.Postgres.Schema
9+
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/LeadingCommaInSelect.pursnew file+20
@@ -0,0 +1,20 @@
1+-- EXPECT: Unexpected comma in SELECT clause (missing column name)
2+module Test.CompileFail.LeadingCommaInSelect where
3+
4+import Prelude
5+import Data.Maybe (Maybe(..))
6+import Type.Function (type (#))
7+import Type.Proxy (Proxy(..))
8+import Yoga.Postgres.Schema
9+
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"
compile-fail-tests/LimitBeforeSelect.pursnew file+20
@@ -0,0 +1,20 @@
1+-- EXPECT: Cons
2+module Test.CompileFail.LimitBeforeSelect where
3+
4+import Prelude
5+import Data.Maybe (Maybe(..))
6+import Type.Function (type (#))
7+import Type.Proxy (Proxy(..))
8+import Yoga.Postgres.Schema
9+
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 # limit @"10"
compile-fail-tests/LimitOnInsert.pursnew file+20
@@ -0,0 +1,20 @@
1+-- EXPECT: Cons
2+module Test.CompileFail.LimitOnInsert where
3+
4+import Prelude
5+import Data.Maybe (Maybe(..))
6+import Type.Function (type (#))
7+import Type.Proxy (Proxy(..))
8+import Yoga.Postgres.Schema
9+
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 # insert { name: "A", email: "a@b.com" } # limit @"10"
compile-fail-tests/LimitParamDuplicateName.pursnew file+20
@@ -0,0 +1,20 @@
1+-- EXPECT: Lacks
2+module Test.CompileFail.LimitParamDuplicateName where
3+
4+import Prelude
5+import Data.Maybe (Maybe(..))
6+import Type.Function (type (#))
7+import Type.Proxy (Proxy(..))
8+import Yoga.Postgres.Schema
9+
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_ @"age > $n" # limit @"$n"
compile-fail-tests/OffsetBeforeSelect.pursnew file+20
@@ -0,0 +1,20 @@
1+-- EXPECT: Cons
2+module Test.CompileFail.OffsetBeforeSelect where
3+
4+import Prelude
5+import Data.Maybe (Maybe(..))
6+import Type.Function (type (#))
7+import Type.Proxy (Proxy(..))
8+import Yoga.Postgres.Schema
9+
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 # offset @"5"
compile-fail-tests/OnConflictBadColumn.pursnew file+20
@@ -0,0 +1,20 @@
1+-- EXPECT: TypesDoNotUnify
2+module Test.CompileFail.OnConflictBadColumn where
3+
4+import Prelude
5+import Data.Maybe (Maybe(..))
6+import Type.Function (type (#))
7+import Type.Proxy (Proxy(..))
8+import Yoga.Postgres.Schema
9+
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 # insert { name: "A", email: "a@b.com" } # onConflict @"email" @"DO UPDATE SET bogus = EXCLUDED.bogus"
compile-fail-tests/OnConflictBadExcluded.pursnew file+21
@@ -0,0 +1,21 @@
1+-- EXPECT: TypesDoNotUnify
2+module Test.CompileFail.OnConflictBadExcluded where
3+
4+import Prelude
5+import Data.Maybe (Maybe(..))
6+import Type.Function (type (#))
7+import Type.Proxy (Proxy(..))
8+import Yoga.Postgres.Schema
9+
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+-- 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/OnConflictOnUpdate.pursnew file+20
@@ -0,0 +1,20 @@
1+-- EXPECT: Cons
2+module Test.CompileFail.OnConflictOnUpdate where
3+
4+import Prelude
5+import Data.Maybe (Maybe(..))
6+import Type.Function (type (#))
7+import Type.Proxy (Proxy(..))
8+import Yoga.Postgres.Schema
9+
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 # set { name: "B" } # onConflictDoNothing @"email"
compile-fail-tests/OnConflictWithoutInsert.pursnew file+20
@@ -0,0 +1,20 @@
1+-- EXPECT: Cons
2+module Test.CompileFail.OnConflictWithoutInsert where
3+
4+import Prelude
5+import Data.Maybe (Maybe(..))
6+import Type.Function (type (#))
7+import Type.Proxy (Proxy(..))
8+import Yoga.Postgres.Schema
9+
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 # onConflictDoNothing @"email"
compile-fail-tests/OrderByAfterLimit.pursnew file+20
@@ -0,0 +1,20 @@
1+-- EXPECT: Lacks
2+module Test.CompileFail.OrderByAfterLimit where
3+
4+import Prelude
5+import Data.Maybe (Maybe(..))
6+import Type.Function (type (#))
7+import Type.Proxy (Proxy(..))
8+import Yoga.Postgres.Schema
9+
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" # orderBy @"name"
compile-fail-tests/OrderByBeforeSelect.pursnew file+20
@@ -0,0 +1,20 @@
1+-- EXPECT: Cons
2+module Test.CompileFail.OrderByBeforeSelect where
3+
4+import Prelude
5+import Data.Maybe (Maybe(..))
6+import Type.Function (type (#))
7+import Type.Proxy (Proxy(..))
8+import Yoga.Postgres.Schema
9+
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 # orderBy @"name"
compile-fail-tests/OrderByOnUpdate.pursnew file+20
@@ -0,0 +1,20 @@
1+-- EXPECT: Cons
2+module Test.CompileFail.OrderByOnUpdate where
3+
4+import Prelude
5+import Data.Maybe (Maybe(..))
6+import Type.Function (type (#))
7+import Type.Proxy (Proxy(..))
8+import Yoga.Postgres.Schema
9+
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 # set { name: "B" } # orderBy @"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
3+
4+import Prelude
5+import Data.Maybe (Maybe(..))
6+import Type.Function (type (#))
7+import Type.Proxy (Proxy(..))
8+import Yoga.Postgres.Schema
9+
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
3+
4+import Prelude
5+import Data.Maybe (Maybe)
6+import Type.Function (type (#))
7+import Type.Proxy (Proxy(..))
8+import Yoga.Postgres.Schema
9+
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
3+
4+import Prelude
5+import Data.Maybe (Maybe)
6+import Type.Function (type (#))
7+import Type.Proxy (Proxy(..))
8+import Yoga.Postgres.Schema
9+
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/ReturningOnSelect.pursnew file+20
@@ -0,0 +1,20 @@
1+-- EXPECT: Lacks
2+module Test.CompileFail.ReturningOnSelect where
3+
4+import Prelude
5+import Data.Maybe (Maybe(..))
6+import Type.Function (type (#))
7+import Type.Proxy (Proxy(..))
8+import Yoga.Postgres.Schema
9+
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 # returning @"id"
compile-fail-tests/ReturningWithoutMutation.pursnew file+17
@@ -0,0 +1,17 @@
1+-- EXPECT: RETURNING requires a preceding INSERT, UPDATE (set), or DELETE
2+module Test.CompileFail.ReturningWithoutMutation where
3+
4+import Prelude
5+import Type.Function (type (#))
6+import Type.Proxy (Proxy(..))
7+import Yoga.Postgres.Schema
8+
9+type UsersTable = Table "users"
10+ ( id :: Int # PrimaryKey # AutoIncrement
11+ , name :: String
12+ )
13+
14+usersTable :: Proxy UsersTable
15+usersTable = Proxy
16+
17+bad = from usersTable # returning @"id"
compile-fail-tests/SelectAfterInsert.pursnew file+20
@@ -0,0 +1,20 @@
1+-- EXPECT: Lacks
2+module Test.CompileFail.SelectAfterInsert where
3+
4+import Prelude
5+import Data.Maybe (Maybe(..))
6+import Type.Function (type (#))
7+import Type.Proxy (Proxy(..))
8+import Yoga.Postgres.Schema
9+
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 # insert { name: "A", email: "a@b.com" } # selectAll
compile-fail-tests/SelectAfterLimit.pursnew file+20
@@ -0,0 +1,20 @@
1+-- EXPECT: Lacks
2+module Test.CompileFail.SelectAfterLimit where
3+
4+import Prelude
5+import Data.Maybe (Maybe(..))
6+import Type.Function (type (#))
7+import Type.Proxy (Proxy(..))
8+import Yoga.Postgres.Schema
9+
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" # select @"name"
compile-fail-tests/SelectAfterOrderBy.pursnew file+20
@@ -0,0 +1,20 @@
1+-- EXPECT: Lacks
2+module Test.CompileFail.SelectAfterOrderBy where
3+
4+import Prelude
5+import Data.Maybe (Maybe(..))
6+import Type.Function (type (#))
7+import Type.Proxy (Proxy(..))
8+import Yoga.Postgres.Schema
9+
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" # select @"name"
compile-fail-tests/SelectAfterWhere.pursnew file+20
@@ -0,0 +1,20 @@
1+-- EXPECT: Lacks
2+module Test.CompileFail.SelectAfterWhere where
3+
4+import Prelude
5+import Data.Maybe (Maybe(..))
6+import Type.Function (type (#))
7+import Type.Proxy (Proxy(..))
8+import Yoga.Postgres.Schema
9+
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_ @"id = $id" # select @"name"
compile-fail-tests/SetAfterSelect.pursnew file+20
@@ -0,0 +1,20 @@
1+-- EXPECT: Lacks
2+module Test.CompileFail.SetAfterSelect where
3+
4+import Prelude
5+import Data.Maybe (Maybe(..))
6+import Type.Function (type (#))
7+import Type.Proxy (Proxy(..))
8+import Yoga.Postgres.Schema
9+
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 # set { name: "B" }
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
3+
4+import Prelude
5+import Data.Maybe (Maybe(..))
6+import Type.Function (type (#))
7+import Type.Proxy (Proxy(..))
8+import Yoga.Postgres.Schema
9+
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/TrailingCommaInSelect.pursnew file+20
@@ -0,0 +1,20 @@
1+-- EXPECT: Trailing comma in SELECT clause
2+module Test.CompileFail.TrailingCommaInSelect where
3+
4+import Prelude
5+import Data.Maybe (Maybe(..))
6+import Type.Function (type (#))
7+import Type.Proxy (Proxy(..))
8+import Yoga.Postgres.Schema
9+
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, email,"
compile-fail-tests/UnclosedStringLiteral.pursnew file+20
@@ -0,0 +1,20 @@
1+-- EXPECT: Unclosed string literal
2+module Test.CompileFail.UnclosedStringLiteral where
3+
4+import Prelude
5+import Data.Maybe (Maybe(..))
6+import Type.Function (type (#))
7+import Type.Proxy (Proxy(..))
8+import Yoga.Postgres.Schema
9+
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
3+
4+import Prelude
5+import Data.Maybe (Maybe(..))
6+import Type.Function (type (#))
7+import Type.Proxy (Proxy(..))
8+import Yoga.Postgres.Schema
9+
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/UnionWithoutSelect.pursnew file+20
@@ -0,0 +1,20 @@
1+-- EXPECT: Cons
2+module Test.CompileFail.UnionWithoutSelect where
3+
4+import Prelude
5+import Data.Maybe (Maybe(..))
6+import Type.Function (type (#))
7+import Type.Proxy (Proxy(..))
8+import Yoga.Postgres.Schema
9+
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) `union` (from usersTable)
compile-fail-tests/WhereAfterGroupBy.pursnew file+20
@@ -0,0 +1,20 @@
1+-- EXPECT: Lacks
2+module Test.CompileFail.WhereAfterGroupBy where
3+
4+import Prelude
5+import Data.Maybe (Maybe(..))
6+import Type.Function (type (#))
7+import Type.Proxy (Proxy(..))
8+import Yoga.Postgres.Schema
9+
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" # groupBy @"name" # where_ @"age > $age"
compile-fail-tests/WhereAfterLimit.pursnew file+20
@@ -0,0 +1,20 @@
1+-- EXPECT: Lacks
2+module Test.CompileFail.WhereAfterLimit where
3+
4+import Prelude
5+import Data.Maybe (Maybe(..))
6+import Type.Function (type (#))
7+import Type.Proxy (Proxy(..))
8+import Yoga.Postgres.Schema
9+
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" # where_ @"id = $id"
compile-fail-tests/WhereAfterOrderBy.pursnew file+20
@@ -0,0 +1,20 @@
1+-- EXPECT: Lacks
2+module Test.CompileFail.WhereAfterOrderBy where
3+
4+import Prelude
5+import Data.Maybe (Maybe(..))
6+import Type.Function (type (#))
7+import Type.Proxy (Proxy(..))
8+import Yoga.Postgres.Schema
9+
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" # where_ @"id = $id"
compile-fail-tests/WhereAfterUnion.pursnew file+20
@@ -0,0 +1,20 @@
1+-- EXPECT: Lacks
2+module Test.CompileFail.WhereAfterUnion where
3+
4+import Prelude
5+import Data.Maybe (Maybe(..))
6+import Type.Function (type (#))
7+import Type.Proxy (Proxy(..))
8+import Yoga.Postgres.Schema
9+
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") `union` (from usersTable # select @"name") # where_ @"name = $name"
compile-fail-tests/WhereOnInsert.pursnew file+20
@@ -0,0 +1,20 @@
1+-- EXPECT: Lacks
2+module Test.CompileFail.WhereOnInsert where
3+
4+import Prelude
5+import Data.Maybe (Maybe(..))
6+import Type.Function (type (#))
7+import Type.Proxy (Proxy(..))
8+import Yoga.Postgres.Schema
9+
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 # insert { name: "A", email: "a@b.com" } # where_ @"id = $id"
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
3+
4+import Prelude
5+import Data.Maybe (Maybe(..))
6+import Type.Function (type (#))
7+import Type.Proxy (Proxy(..))
8+import Yoga.Postgres.Schema
9+
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"
compile-fail-tests/WindowFunctionNoAlias.pursnew file+20
@@ -0,0 +1,20 @@
1+-- EXPECT: Aggregate function requires AS alias
2+module Test.CompileFail.WindowFunctionNoAlias where
3+
4+import Prelude
5+import Data.Maybe (Maybe)
6+import Type.Function (type (#))
7+import Type.Proxy (Proxy(..))
8+import Yoga.Postgres.Schema
9+
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 @"ROW_NUMBER() OVER (ORDER BY age)"
compile-fail-tests/WindowOverWithoutParen.pursnew file+20
@@ -0,0 +1,20 @@
1+-- EXPECT: Expected ( after OVER
2+module Test.CompileFail.WindowOverWithoutParen where
3+
4+import Prelude
5+import Data.Maybe (Maybe)
6+import Type.Function (type (#))
7+import Type.Proxy (Proxy(..))
8+import Yoga.Postgres.Schema
9+
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 @"ROW_NUMBER() OVER ORDER BY age AS rn"
compile-fail-tests/run.shnew file+39
@@ -0,0 +1,39 @@
1+#!/bin/bash
2+cd "$(dirname "$0")/.."
3+
4+# Build the library first
5+bunx spago build > /dev/null 2>&1
6+
7+PASS=0
8+FAIL=0
9+TOTAL=0
10+
11+for f in compile-fail-tests/*.purs; do
12+ EXPECT=$(head -1 "$f" | sed 's/-- EXPECT: //')
13+ NAME=$(basename "$f" .purs)
14+ TOTAL=$((TOTAL + 1))
15+
16+ # Rewrite module name and copy into src/ temporarily
17+ sed "s/^module .*/module Yoga.Postgres.CompileFailTest where/" "$f" > "src/_CompileFailTest.purs"
18+ OUTPUT=$(bunx spago build 2>&1) || true
19+ rm -f "src/_CompileFailTest.purs"
20+
21+ if echo "$OUTPUT" | grep -q "Build succeeded"; then
22+ echo "FAIL $NAME — compiled successfully (should have failed)"
23+ FAIL=$((FAIL + 1))
24+ elif echo "$OUTPUT" | grep -q "$EXPECT"; then
25+ echo "PASS $NAME — failed with expected: $EXPECT"
26+ PASS=$((PASS + 1))
27+ else
28+ echo "FAIL $NAME — failed but without expected '$EXPECT'"
29+ echo " Got: $(echo "$OUTPUT" | grep "ERROR" | head -3)"
30+ FAIL=$((FAIL + 1))
31+ fi
32+done
33+
34+echo ""
35+echo "$PASS passed, $FAIL failed out of $TOTAL compile-fail tests"
36+
37+if [ "$FAIL" -ne 0 ]; then
38+ exit 1
39+fi
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+3−1
@@ -24,6 +24,8 @@
24 "test:ts": "bun run test-with-docker.ts"
24 "test:ts": "bun run test-with-docker.ts"
25 },
25 },
26 "dependencies": {
26 "dependencies": {
27− "pg": "^8.11.0"
27+ "pg": "^8.11.0",
28+ "postgres": "^3.4.8",
29+ "uuid": "^13.0.0"
28 }
30 }
29}
31}
spago.lock+64−15
@@ -6,7 +6,10 @@
6 "core": {
6 "core": {
7 "dependencies": [
7 "dependencies": [
8 {
8 {
9+ "aff": ">=8.0.0 <9.0.0"
10+ },
11+ {
9− "aff": ">=7.1.0 <8.0.0"
12+ "arrays": ">=7.3.0 <8.0.0"
10 },
13 },
11 {
14 {
12 "datetime": ">=6.1.0 <7.0.0"
15 "datetime": ">=6.1.0 <7.0.0"
@@ -17,6 +20,12 @@
17 {
20 {
18 "either": ">=6.1.0 <7.0.0"
21 "either": ">=6.1.0 <7.0.0"
19 },
22 },
23+ {
24+ "enums": ">=6.0.1 <7.0.0"
25+ },
26+ {
27+ "exceptions": ">=6.1.0 <7.0.0"
28+ },
20 {
29 {
21 "foldable-traversable": ">=6.0.0 <7.0.0"
30 "foldable-traversable": ">=6.0.0 <7.0.0"
22 },
31 },
@@ -24,7 +33,16 @@
24 "foreign": ">=7.0.0 <8.0.0"
33 "foreign": ">=7.0.0 <8.0.0"
25 },
34 },
26 {
35 {
27− "heterogeneous": ">=0.6.0 <0.7.0"
36+ "heterogeneous": ">=0.7.0 <0.8.0"
37+ },
38+ {
39+ "integers": ">=6.0.0 <7.0.0"
40+ },
41+ {
42+ "js-bigints": ">=2.2.1 <3.0.0"
43+ },
44+ {
45+ "js-date": ">=8.0.0 <9.0.0"
28 },
46 },
29 {
47 {
30 "js-promise": ">=1.0.0 <2.0.0"
48 "js-promise": ">=1.0.0 <2.0.0"
@@ -32,6 +50,9 @@
32 {
50 {
33 "js-promise-aff": ">=1.0.0 <2.0.0"
51 "js-promise-aff": ">=1.0.0 <2.0.0"
34 },
52 },
53+ {
54+ "lists": ">=7.0.0 <8.0.0"
55+ },
35 {
56 {
36 "maybe": ">=6.0.0 <7.0.0"
57 "maybe": ">=6.0.0 <7.0.0"
37 },
58 },
@@ -41,20 +62,38 @@
41 {
62 {
42 "nullable": ">=6.0.0 <7.0.0"
63 "nullable": ">=6.0.0 <7.0.0"
43 },
64 },
65+ {
66+ "numbers": ">=9.0.1 <10.0.0"
67+ },
44 {
68 {
45 "ordered-collections": ">=3.2.0 <4.0.0"
69 "ordered-collections": ">=3.2.0 <4.0.0"
46 },
70 },
47 {
71 {
48 "prelude": ">=6.0.2 <7.0.0"
72 "prelude": ">=6.0.2 <7.0.0"
49 },
73 },
74+ {
75+ "record": ">=4.0.0 <5.0.0"
76+ },
77+ {
78+ "strings": ">=6.0.1 <7.0.0"
79+ },
80+ {
81+ "transformers": ">=6.1.0 <7.0.0"
82+ },
83+ {
84+ "typelevel-prelude": ">=7.0.0 <8.0.0"
85+ },
50 {
86 {
51 "unsafe-coerce": ">=6.0.0 <7.0.0"
87 "unsafe-coerce": ">=6.0.0 <7.0.0"
52 },
88 },
53 {
89 {
54− "yoga-json": ">=5.2.0 <6.0.0"
90+ "uuid": ">=9.0.0 <10.0.0"
55 },
91 },
56 {
92 {
93+ "yoga-json": ">=5.2.1 <6.0.0"
94+ },
95+ {
57− "yoga-sql-types": ">=0.1.0 <0.2.0"
96+ "yoga-sql-types": ">=0.2.0 <0.3.0"
58 }
97 }
59 ]
98 ]
60 },
99 },
@@ -84,8 +123,8 @@
84 "packages": {
123 "packages": {
85 "aff": {
124 "aff": {
86 "type": "registry",
125 "type": "registry",
87− "version": "7.1.0",
126+ "version": "8.0.0",
88− "integrity": "sha256-/nOpDQVnKIoP1pQ1ZZBYpadK0TuMlG4WwufGzJpsfD0=",
127+ "integrity": "sha256-9BRIrSdRoYybfiUmBqgKJ66cPqxYHb277bVWQMn/9sg=",
89 "dependencies": [
128 "dependencies": [
90 "control",
129 "control",
91 "datetime",
130 "datetime",
@@ -436,8 +475,8 @@
436 },
475 },
437 "heterogeneous": {
476 "heterogeneous": {
438 "type": "registry",
477 "type": "registry",
439− "version": "0.6.0",
478+ "version": "0.7.0",
440− "integrity": "sha256-nQgk2iHYe5LIi6ZzREgWaCU3y8oCwdhDSukT6xVMWdk=",
479+ "integrity": "sha256-pQwcFvhWL8noktxaoD7FlLs2F2lYf3QHoyO0VOWO3I0=",
441 "dependencies": [
480 "dependencies": [
442 "either",
481 "either",
443 "foldable-traversable",
482 "foldable-traversable",
@@ -916,6 +955,16 @@
916 "integrity": "sha256-0L1QsaY20OILjfU5TV72d3U/tSjhmL9hJ32WMp857Lk=",
955 "integrity": "sha256-0L1QsaY20OILjfU5TV72d3U/tSjhmL9hJ32WMp857Lk=",
917 "dependencies": []
956 "dependencies": []
918 },
957 },
958+ "uuid": {
959+ "type": "registry",
960+ "version": "9.0.0",
961+ "integrity": "sha256-aM/9+7xlHs5UDdtRfoEQosPpYOruwowa3sezIodJ3vk=",
962+ "dependencies": [
963+ "effect",
964+ "maybe",
965+ "prelude"
966+ ]
967+ },
919 "variant": {
968 "variant": {
920 "type": "registry",
969 "type": "registry",
921 "version": "8.0.0",
970 "version": "8.0.0",
@@ -934,8 +983,8 @@
934 },
983 },
935 "yoga-json": {
984 "yoga-json": {
936 "type": "registry",
985 "type": "registry",
937− "version": "5.2.0",
986+ "version": "5.2.1",
938− "integrity": "sha256-M+kkz6E1Gf+C4bKnhqoBFIoVcc74loi3rLULePbB204=",
987+ "integrity": "sha256-12I7qIf27oKV/D/YRcHtGpN8n7GQ0Bm3uzvI4ZjOQrs=",
939 "dependencies": [
988 "dependencies": [
940 "arrays",
989 "arrays",
941 "bifunctors",
990 "bifunctors",
@@ -973,8 +1022,8 @@
973 },
1022 },
974 "yoga-sql-types": {
1023 "yoga-sql-types": {
975 "type": "registry",
1024 "type": "registry",
976− "version": "0.1.0",
1025+ "version": "0.2.0",
977− "integrity": "sha256-vxOgnj3HK8F5gRHCNkIPNirORQtCBEKozG+CnrHtB84=",
1026+ "integrity": "sha256-/fiSiEmSQ8UH2N7vp/E02Eo+Krbs6iGcre9haDV34Q8=",
978 "dependencies": [
1027 "dependencies": [
979 "arrays",
1028 "arrays",
980 "bifunctors",
1029 "bifunctors",
@@ -1002,13 +1051,13 @@
1002 },
1051 },
1003 "yoga-test-docker": {
1052 "yoga-test-docker": {
1004 "type": "registry",
1053 "type": "registry",
1005− "version": "0.1.0",
1054+ "version": "0.1.2",
1006− "integrity": "sha256-fTd7UZ1W4w3R7sY2OJhoiFqf6Ma6ycQM/4lq9dQnkgs=",
1055+ "integrity": "sha256-J/jgHvvwb04ZOhicRGucmrQhaokrYTc9XJ2dutsktq8=",
1007 "dependencies": [
1056 "dependencies": [
1008 "aff",
1057 "aff",
1009 "datetime",
1058 "datetime",
1010− "effect",
1011 "exceptions",
1059 "exceptions",
1060+ "newtype",
1012 "prelude"
1061 "prelude"
1013 ]
1062 ]
1014 },
1063 },
spago.yaml+18−5
@@ -3,29 +3,42 @@ workspace: {}
3package:
3package:
4 name: yoga-postgres
4 name: yoga-postgres
5 publish:
5 publish:
6− version: 0.1.0
6+ version: 0.3.2
7 license: MIT
7 license: MIT
8 location:
8 location:
9 githubOwner: rowtype-yoga
9 githubOwner: rowtype-yoga
10 githubRepo: purescript-yoga-postgres
10 githubRepo: purescript-yoga-postgres
11 dependencies:
11 dependencies:
12+ - aff: ">=8.0.0 <9.0.0"
12− - aff: ">=7.1.0 <8.0.0"
13+ - arrays: ">=7.3.0 <8.0.0"
13 - datetime: ">=6.1.0 <7.0.0"
14 - datetime: ">=6.1.0 <7.0.0"
14 - effect: ">=4.0.0 <5.0.0"
15 - effect: ">=4.0.0 <5.0.0"
15 - either: ">=6.1.0 <7.0.0"
16 - either: ">=6.1.0 <7.0.0"
17+ - enums: ">=6.0.1 <7.0.0"
18+ - exceptions: ">=6.1.0 <7.0.0"
16 - foldable-traversable: ">=6.0.0 <7.0.0"
19 - foldable-traversable: ">=6.0.0 <7.0.0"
17 - foreign: ">=7.0.0 <8.0.0"
20 - foreign: ">=7.0.0 <8.0.0"
18− - heterogeneous: ">=0.6.0 <0.7.0"
21+ - heterogeneous: ">=0.7.0 <0.8.0"
22+ - integers: ">=6.0.0 <7.0.0"
23+ - js-bigints: ">=2.2.1 <3.0.0"
24+ - js-date: ">=8.0.0 <9.0.0"
19 - js-promise: ">=1.0.0 <2.0.0"
25 - js-promise: ">=1.0.0 <2.0.0"
20 - js-promise-aff: ">=1.0.0 <2.0.0"
26 - js-promise-aff: ">=1.0.0 <2.0.0"
27+ - lists: ">=7.0.0 <8.0.0"
21 - maybe: ">=6.0.0 <7.0.0"
28 - maybe: ">=6.0.0 <7.0.0"
22 - newtype: ">=5.0.0 <6.0.0"
29 - newtype: ">=5.0.0 <6.0.0"
23 - nullable: ">=6.0.0 <7.0.0"
30 - nullable: ">=6.0.0 <7.0.0"
31+ - numbers: ">=9.0.1 <10.0.0"
24 - ordered-collections: ">=3.2.0 <4.0.0"
32 - ordered-collections: ">=3.2.0 <4.0.0"
25 - prelude: ">=6.0.2 <7.0.0"
33 - prelude: ">=6.0.2 <7.0.0"
34+ - record: ">=4.0.0 <5.0.0"
35+ - strings: ">=6.0.1 <7.0.0"
36+ - transformers: ">=6.1.0 <7.0.0"
37+ - typelevel-prelude: ">=7.0.0 <8.0.0"
26 - unsafe-coerce: ">=6.0.0 <7.0.0"
38 - unsafe-coerce: ">=6.0.0 <7.0.0"
39+ - uuid: ">=9.0.0 <10.0.0"
27− - yoga-json: ">=5.2.0 <6.0.0"
40+ - yoga-json: ">=5.2.1 <6.0.0"
28− - yoga-sql-types: ">=0.1.0 <0.2.0"
41+ - yoga-sql-types: ">=0.2.0 <0.3.0"
29 test:
42 test:
30 main: Test.Postgres.Main
43 main: Test.Postgres.Main
31 dependencies:
44 dependencies:
src/Yoga/Postgres.js+42−42
@@ -2,27 +2,20 @@ import postgres from 'postgres';
2
2
3// Create Postgres connection
3// Create Postgres connection
4export const postgresImpl = (config) => {
4export const postgresImpl = (config) => {
5− // Support both individual config and connection string
5+ const { connection, ...configOptions } = config;
6− if (config.connection) {
6+ const options = {
7− return postgres(config.connection, config);
7+ ...configOptions,
8− }
8+ onnotice: config.onnotice
9−
10− return postgres({
11− host: config.host,
12− port: config.port,
13− database: config.database,
14− username: config.username,
15− password: config.password,
16− max: config.max,
9+ ? () => config.onnotice()
17− idle_timeout: config.idle_timeout,
10+ : undefined,
18− connect_timeout: config.connect_timeout,
11+ onparameter: config.onparameter
19− ssl: config.ssl,
12+ ? (key, value) => config.onparameter({ key, value })()
20− debug: config.debug,
13+ : undefined
21− onnotice: config.onnotice,
14+ };
22− onparameter: config.onparameter,
15+
23− // Pass through any other options
16+ return connection
24− ...config
17+ ? postgres(connection, options)
25− });
18+ : postgres(options);
26};
19};
27
20
28// Query operations
21// Query operations
@@ -92,27 +85,29 @@ export const beginImpl = async (sql) => {
92};
85};
93
86
94export const commitImpl = async (txn) => {
87export const commitImpl = async (txn) => {
95− if (txn._reserved) {
88+ if (!txn._reserved) return;
89+
90+ const reserved = txn._reserved;
91+ txn._reserved = null;
92+ try {
96− await txn._reserved`COMMIT`;
93+ await reserved`COMMIT`;
97− // Release the connection back to the pool
94+ } finally {
98− await txn._reserved.release();
95+ await reserved.release();
99 }
96 }
100};
97};
101
98
102export const rollbackImpl = async (txn) => {
99export const rollbackImpl = async (txn) => {
103− if (txn._reserved) {
100+ if (!txn._reserved) return;
101+
102+ const reserved = txn._reserved;
103+ txn._reserved = null;
104+ try {
104− await txn._reserved`ROLLBACK`;
105+ await reserved`ROLLBACK`;
105− // Release the connection back to the pool
106+ } finally {
106− await txn._reserved.release();
107+ await reserved.release();
107 }
108 }
108};
109};
109
110
110−export const transactionImpl = async (sql, handler) => {
111− return sql.begin(async (txn) => {
112− const affAction = handler(txn);
113− return await affAction();
114− });
115−};
116
111
117export const txQueryImpl = async (txn, queryString, params) => {
112export const txQueryImpl = async (txn, queryString, params) => {
118 // Use the underlying SQL connection
113 // Use the underlying SQL connection
@@ -147,19 +142,24 @@ export const endImpl = (sql) => sql.end();
147
142
148// Listen/Notify
143// Listen/Notify
149
144
145+const listeners = new WeakMap();
146+
150export const listenImpl = async (sql, channel, handler) => {
147export const listenImpl = async (sql, channel, handler) => {
151− await sql.listen(channel, (payload) => {
148+ const subscription = await sql.listen(channel, (payload) => {
152 handler({ channel, payload })();
149 handler({ channel, payload })();
153 });
150 });
151+ const byChannel = listeners.get(sql) || new Map();
152+ const subscriptions = byChannel.get(channel) || [];
153+ subscriptions.push(subscription);
154+ byChannel.set(channel, subscriptions);
155+ listeners.set(sql, byChannel);
154};
156};
155
157
156export const unlistenImpl = async (sql, channel) => {
158export const unlistenImpl = async (sql, channel) => {
157− // postgres.js uses the same listen method to unlisten
159+ const byChannel = listeners.get(sql);
158− if (sql.listen.unlisten) {
160+ const subscriptions = byChannel?.get(channel) || [];
159− return sql.listen.unlisten(channel);
161+ await Promise.all(subscriptions.map(({ unlisten }) => unlisten()));
160− }
162+ byChannel?.delete(channel);
161− // Alternative: just resolve, as postgres.js handles cleanup automatically
162− return Promise.resolve();
163};
163};
164
164
165export const notifyImpl = (sql, channel, payload) =>
165export const notifyImpl = (sql, channel, payload) =>
src/Yoga/Postgres.purs+18−8
@@ -2,18 +2,22 @@ module Yoga.Postgres where
2
2
3import Prelude
3import Prelude
4
4
5+
6+
5import Data.Maybe (Maybe)
7import Data.Maybe (Maybe)
6import Data.Newtype (class Newtype)
8import Data.Newtype (class Newtype)
7import Data.Nullable (Nullable)
9import Data.Nullable (Nullable)
8import Data.Nullable as Nullable
10import Data.Nullable as Nullable
9import Data.Time.Duration (Milliseconds)
11import Data.Time.Duration (Milliseconds)
12+import Data.UUID (UUID)
13+import Data.UUID as UUID
10import Effect (Effect)
14import Effect (Effect)
11−import Effect.Aff (Aff)
15+import Effect.Aff (Aff, generalBracket)
12import Effect.Uncurried (EffectFn1, EffectFn2, EffectFn3, runEffectFn1, runEffectFn2, runEffectFn3)
16import Effect.Uncurried (EffectFn1, EffectFn2, EffectFn3, runEffectFn1, runEffectFn2, runEffectFn3)
13import Foreign (Foreign)
17import Foreign (Foreign)
14import Prim.Row (class Union)
18import Prim.Row (class Union)
15import Promise (Promise)
19import Promise (Promise)
16−import Promise.Aff (fromAff, toAffE) as Promise
20+import Promise.Aff (toAffE) as Promise
17import Unsafe.Coerce (unsafeCoerce)
21import Unsafe.Coerce (unsafeCoerce)
18
22
19-- Opaque Postgres types
23-- Opaque Postgres types
@@ -114,6 +118,9 @@ instance ToPGValue Boolean where
114instance ToPGValue a => ToPGValue (Array a) where
118instance ToPGValue a => ToPGValue (Array a) where
115 toPGValue arr = unsafeCoerce (map toPGValue arr)
119 toPGValue arr = unsafeCoerce (map toPGValue arr)
116
120
121+instance ToPGValue UUID where
122+ toPGValue = toPGValue <<< UUID.toString
123+
117instance ToPGValue Foreign where
124instance ToPGValue Foreign where
118 toPGValue = unsafeCoerce
125 toPGValue = unsafeCoerce
119
126
@@ -219,13 +226,16 @@ foreign import rollbackImpl :: EffectFn1 Transaction (Promise Unit)
219rollback :: Transaction -> Aff Unit
226rollback :: Transaction -> Aff Unit
220rollback = runEffectFn1 rollbackImpl >>> Promise.toAffE
227rollback = runEffectFn1 rollbackImpl >>> Promise.toAffE
221
228
222−-- Run transaction block (automatic commit/rollback)
223−foreign import transactionImpl :: EffectFn2 Connection (Transaction -> Effect (Promise Unit)) (Promise Unit)
224
229
230+-- Low-level escape hatch for code that needs the raw transaction handle.
225−transaction :: (Transaction -> Aff Unit) -> Connection -> Aff Unit
231+withTransaction :: forall a. (Transaction -> Aff a) -> Connection -> Aff a
226−transaction handler conn =
232+withTransaction operation conn =
227− runEffectFn2 transactionImpl conn (\txn -> Promise.fromAff (handler txn))
233+ generalBracket (begin conn)
228− # Promise.toAffE
234+ { killed: \_ -> rollback
235+ , failed: \_ -> rollback
236+ , completed: \_ -> commit
237+ }
238+ operation
229
239
230-- Query within transaction
240-- Query within transaction
231foreign import txQueryImpl :: EffectFn3 Transaction SQL (Array PGValue) (Promise QueryResult)
241foreign import txQueryImpl :: EffectFn3 Transaction SQL (Array PGValue) (Promise QueryResult)
src/Yoga/Postgres/Schema.pursnew file+3780
@@ -0,0 +1,3780 @@
1+module Yoga.Postgres.Schema where
2+
3+import Prelude
4+
5+import Control.Monad.Except (except, runExcept)
6+import Data.Array (intercalate, mapWithIndex, foldl)
7+import Data.Array as Array
8+import Data.Date (Date, day, month, year)
9+import Data.DateTime (DateTime(..))
10+import Data.Either (Either(..), note)
11+import Data.Enum (fromEnum, toEnum)
12+import Data.Int as Int
13+import Data.JSDate as JSDate
14+import Data.List.Types (NonEmptyList)
15+import Data.Map as Map
16+import Data.Maybe (Maybe(..), fromMaybe)
17+import Data.Newtype (class Newtype)
18+import Data.Nullable (toNullable)
19+import Data.Number as Number
20+import Data.Reflectable (class Reflectable, reflectType)
21+import Data.String.CodeUnits as SCU
22+import Data.String.Common as Str
23+import Data.String.Pattern (Pattern(..))
24+import Data.String.Regex (Regex, regex, replace') as Regex
25+import Data.String.Regex.Flags (global) as Regex
26+import Data.Symbol (class IsSymbol, reflectSymbol)
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)
35+import Prim.Boolean (True, False)
36+import Prim.Row (class Cons, class Lacks, class Union, class Nub) as Row
37+import Prim.RowList (class RowToList)
38+import Prim.RowList as RL
39+import Prim.Symbol (class Cons, class Append) as Symbol
40+import Prim.TypeError (class Fail, Beside, Text, Quote)
41+import Record (get) as Record
42+import Type.Proxy (Proxy(..))
43+import Type.RowList (class ListToRow)
44+import Unsafe.Coerce (unsafeCoerce)
45+import Yoga.JSON (class ReadForeign, class WriteForeign, readImpl, writeImpl)
46+import Yoga.Postgres as PG
47+
48+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
49+-- Core phantom types
50+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
51+
52+data Table :: Symbol -> Row Type -> Type
53+data Table name columns = Table
54+
55+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
56+-- Constraint wrappers (used with # operator from Type.Function)
57+-- Int # PrimaryKey # AutoIncrement = AutoIncrement (PrimaryKey Int)
58+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
59+
60+data PrimaryKey :: Type -> Type
61+data PrimaryKey a
62+
63+data AutoIncrement :: Type -> Type
64+data AutoIncrement a
65+
66+data Unique :: Type -> Type
67+data Unique a
68+
69+data Default :: forall k. k -> Type -> Type
70+data Default val a
71+data DefaultExpr :: Symbol -> Type -> Type
72+data DefaultExpr expression a
73+
74+
75+data References
76+
77+data ForeignKey :: Symbol -> Type -> Symbol -> Type -> Type
78+data ForeignKey table references col a
79+
80+-- Internal: used by LEFT JOIN to mark columns as nullable
81+data Nullable :: Type -> Type
82+data Nullable a
83+
84+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
85+-- JSONB type wrapper
86+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
87+
88+newtype Jsonb = Jsonb Foreign
89+
90+derive instance Newtype Jsonb _
91+
92+instance ReadForeign Jsonb where
93+ readImpl = pure <<< Jsonb
94+
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+
267+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
268+-- Nullability: inferred from Maybe
269+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
270+
271+class IsNullable a where
272+ isNullable :: Proxy a -> Boolean
273+
274+instance IsNullable (Maybe a) where
275+ isNullable _ = true
276+else instance IsNullable a where
277+ isNullable _ = false
278+
279+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
280+-- ExtractType: recursively unwrap constraint wrappers to get base type
281+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
282+
283+class ExtractType :: Type -> Type -> Constraint
284+class ExtractType wrapped typ | wrapped -> typ
285+
286+instance ExtractType a typ => ExtractType (PrimaryKey a) typ
287+else instance ExtractType a typ => ExtractType (AutoIncrement a) typ
288+else instance ExtractType a typ => ExtractType (Unique a) typ
289+else instance ExtractType a typ => ExtractType (Default val a) typ
290+else instance ExtractType a typ => ExtractType (DefaultExpr expression a) typ
291+else instance ExtractType a typ => ExtractType (ForeignKey t r c a) typ
292+else instance ExtractType a typ => ExtractType (Nullable a) (Maybe typ)
293+else instance ExtractType a a
294+
295+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
296+-- PureScript type -> Postgres type name
297+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
298+
299+class PGTypeName a where
300+ pgTypeName :: Proxy a -> String
301+
302+instance PGTypeName Int where
303+ pgTypeName _ = "INTEGER"
304+
305+instance PGTypeName String where
306+ pgTypeName _ = "TEXT"
307+
308+instance PGTypeName Boolean where
309+ pgTypeName _ = "BOOLEAN"
310+
311+instance PGTypeName Number where
312+ pgTypeName _ = "DOUBLE PRECISION"
313+
314+instance PGTypeName DateTime where
315+ pgTypeName _ = "TIMESTAMPTZ"
316+
317+instance PGTypeName BigInt where
318+ pgTypeName _ = "BIGINT"
319+
320+instance PGTypeName PGUUID where
321+ pgTypeName _ = "UUID"
322+
323+instance PGTypeName TimestampTZ where
324+ pgTypeName _ = "TIMESTAMPTZ"
325+
326+instance PGTypeName PGDate where
327+ pgTypeName _ = "DATE"
328+
329+instance PGTypeName PGTime where
330+ pgTypeName _ = "TIME"
331+
332+instance PGTypeName Point where
333+ pgTypeName _ = "POINT"
334+
335+instance PGTypeName TSVector where
336+ pgTypeName _ = "TSVECTOR"
337+
338+instance PGTypeName TSQuery where
339+ pgTypeName _ = "TSQUERY"
340+
341+instance PGTypeName Jsonb where
342+ pgTypeName _ = "JSONB"
343+
344+instance PGTypeName a => PGTypeName (Array a) where
345+ pgTypeName _ = pgTypeName (Proxy :: Proxy a) <> "[]"
346+
347+instance PGTypeName a => PGTypeName (Maybe a) where
348+ pgTypeName _ = pgTypeName (Proxy :: Proxy a)
349+
350+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
351+-- Constraint -> DDL fragment
352+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
353+
354+class RenderDefaultValue val typ where
355+ renderDefaultValue :: Proxy val -> Proxy typ -> String
356+
357+instance Reflectable sym String => RenderDefaultValue sym String where
358+ renderDefaultValue _ _ = "DEFAULT '" <> reflectType (Proxy :: Proxy sym) <> "'"
359+
360+instance Reflectable val Int => RenderDefaultValue val Int where
361+ renderDefaultValue _ _ = "DEFAULT " <> show (reflectType (Proxy :: Proxy val))
362+
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+
381+
382+class RenderConstraint a where
383+ renderConstraint :: Proxy a -> String
384+
385+instance RenderConstraint a => RenderConstraint (PrimaryKey a) where
386+ renderConstraint _ = joinConstraints "PRIMARY KEY" (renderConstraint (Proxy :: Proxy a))
387+
388+else instance RenderConstraint a => RenderConstraint (AutoIncrement a) where
389+ renderConstraint _ = joinConstraints "GENERATED ALWAYS AS IDENTITY" (renderConstraint (Proxy :: Proxy a))
390+
391+else instance RenderConstraint a => RenderConstraint (Unique a) where
392+ renderConstraint _ = joinConstraints "UNIQUE" (renderConstraint (Proxy :: Proxy a))
393+
394+else instance (RenderDefaultValue val a, RenderConstraint a) => RenderConstraint (Default val a) where
395+ renderConstraint _ = joinConstraints (renderDefaultValue (Proxy :: Proxy val) (Proxy :: Proxy a)) (renderConstraint (Proxy :: Proxy a))
396+
397+else instance (IsSymbol expression, RenderConstraint a) => RenderConstraint (DefaultExpr expression a) where
398+ renderConstraint _ = joinConstraints
399+ ("DEFAULT " <> reflectSymbol (Proxy :: Proxy expression))
400+ (renderConstraint (Proxy :: Proxy a))
401+else instance (IsSymbol table, IsSymbol col, RenderConstraint a) => RenderConstraint (ForeignKey table References col a) where
402+ renderConstraint _ = joinConstraints
403+ ("REFERENCES " <> reflectSymbol (Proxy :: Proxy table) <> "(" <> reflectSymbol (Proxy :: Proxy col) <> ")")
404+ (renderConstraint (Proxy :: Proxy a))
405+
406+else instance RenderConstraint a => RenderConstraint (Nullable a) where
407+ renderConstraint _ = renderConstraint (Proxy :: Proxy a)
408+
409+else instance RenderConstraint a where
410+ renderConstraint _ = ""
411+
412+joinConstraints :: String -> String -> String
413+joinConstraints a b = case a, b of
414+ "", s -> s
415+ s, "" -> s
416+ s1, s2 -> s1 <> " " <> s2
417+
418+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
419+-- DDL generation
420+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
421+
422+class CreateTableDDL a where
423+ createTableDDL :: String
424+
425+class RenderColumnsRL :: RL.RowList Type -> Constraint
426+class RenderColumnsRL rl where
427+ renderColumnsRL :: Proxy rl -> Array String
428+
429+instance RenderColumnsRL RL.Nil where
430+ renderColumnsRL _ = []
431+
432+instance
433+ ( IsSymbol name
434+ , ExtractType entry typ
435+ , PGTypeName typ
436+ , IsNullable typ
437+ , RenderConstraint entry
438+ , RenderColumnsRL tail
439+ ) =>
440+ RenderColumnsRL (RL.Cons name entry tail) where
441+ renderColumnsRL _ = do
442+ let colName = reflectSymbol (Proxy :: Proxy name)
443+ let colType = pgTypeName (Proxy :: Proxy typ)
444+ let nullable = isNullable (Proxy :: Proxy typ)
445+ let notNull = if nullable then "" else " NOT NULL"
446+ let constraints = renderConstraint (Proxy :: Proxy entry)
447+ let constraintsSuffix = if constraints == "" then "" else " " <> constraints
448+ [ colName <> " " <> colType <> notNull <> constraintsSuffix ] <> renderColumnsRL (Proxy :: Proxy tail)
449+
450+instance
451+ ( IsSymbol name
452+ , RowToList cols rl
453+ , RenderColumnsRL rl
454+ ) =>
455+ CreateTableDDL (Table name cols) where
456+ createTableDDL = do
457+ let tableName = reflectSymbol (Proxy :: Proxy name)
458+ let columns = renderColumnsRL (Proxy :: Proxy rl)
459+ "CREATE TABLE " <> tableName <> " (" <> intercalate ", " columns <> ")"
460+
461+createTableDDLIfNotExists :: forall @a. CreateTableDDL a => String
462+createTableDDLIfNotExists = do
463+ let ddl = createTableDDL @a
464+ "CREATE TABLE IF NOT EXISTS" <> SCU.drop 12 ddl
465+
466+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
467+-- INSERT SQL generation
468+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
469+
470+class IsAutoGenerated a where
471+ isAutoGenerated :: Proxy a -> Boolean
472+
473+instance IsAutoGenerated (AutoIncrement a) where
474+ isAutoGenerated _ = true
475+else instance IsAutoGenerated (Default v a) where
476+ isAutoGenerated _ = true
477+else instance IsAutoGenerated (DefaultExpr expression a) where
478+ isAutoGenerated _ = true
479+else instance IsAutoGenerated a => IsAutoGenerated (PrimaryKey a) where
480+ isAutoGenerated _ = isAutoGenerated (Proxy :: Proxy a)
481+else instance IsAutoGenerated a => IsAutoGenerated (Unique a) where
482+ isAutoGenerated _ = isAutoGenerated (Proxy :: Proxy a)
483+else instance IsAutoGenerated a => IsAutoGenerated (ForeignKey t r c a) where
484+ isAutoGenerated _ = isAutoGenerated (Proxy :: Proxy a)
485+else instance IsAutoGenerated a => IsAutoGenerated (Nullable a) where
486+ isAutoGenerated _ = isAutoGenerated (Proxy :: Proxy a)
487+else instance IsAutoGenerated a where
488+ isAutoGenerated _ = false
489+
490+class InsertColumnsRL :: RL.RowList Type -> Constraint
491+class InsertColumnsRL rl where
492+ insertColumnsRL :: Proxy rl -> Array String
493+
494+instance InsertColumnsRL RL.Nil where
495+ insertColumnsRL _ = []
496+
497+instance
498+ ( IsSymbol name
499+ , IsAutoGenerated entry
500+ , InsertColumnsRL tail
501+ ) =>
502+ InsertColumnsRL (RL.Cons name entry tail) where
503+ insertColumnsRL _ =
504+ let
505+ rest = insertColumnsRL (Proxy :: Proxy tail)
506+ in
507+ if isAutoGenerated (Proxy :: Proxy entry) then rest
508+ else [ reflectSymbol (Proxy :: Proxy name) ] <> rest
509+
510+class InsertSQLFor a where
511+ insertSQLFor :: String
512+
513+instance
514+ ( IsSymbol name
515+ , RowToList cols rl
516+ , InsertColumnsRL rl
517+ ) =>
518+ InsertSQLFor (Table name cols) where
519+ insertSQLFor = do
520+ let tableName = reflectSymbol (Proxy :: Proxy name)
521+ let cols = insertColumnsRL (Proxy :: Proxy rl)
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 *"
534+
535+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
536+-- SELECT SQL generation
537+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
538+
539+class SelectAllSQLFor a where
540+ selectAllSQLFor :: String
541+
542+instance
543+ ( IsSymbol name
544+ ) =>
545+ SelectAllSQLFor (Table name cols) where
546+ selectAllSQLFor = "SELECT * FROM " <> reflectSymbol (Proxy :: Proxy name)
547+
548+class WhereClauseRL :: RL.RowList Type -> Constraint
549+class WhereClauseRL rl where
550+ whereClauseRL :: Proxy rl -> Int -> Array String
551+
552+instance WhereClauseRL RL.Nil where
553+ whereClauseRL _ _ = []
554+
555+instance (IsSymbol name, WhereClauseRL tail) => WhereClauseRL (RL.Cons name typ tail) where
556+ whereClauseRL _ idx =
557+ [ reflectSymbol (Proxy :: Proxy name) <> " = $" <> show idx ]
558+ <> whereClauseRL (Proxy :: Proxy tail) (idx + 1)
559+
560+class SelectWhereSQLFor a whereRow where
561+ selectWhereSQLFor :: String
562+
563+instance
564+ ( IsSymbol name
565+ , RowToList whereRow whereRL
566+ , WhereClauseRL whereRL
567+ ) =>
568+ SelectWhereSQLFor (Table name cols) whereRow where
569+ selectWhereSQLFor = do
570+ let tableName = reflectSymbol (Proxy :: Proxy name)
571+ let conditions = whereClauseRL (Proxy :: Proxy whereRL) 1
572+ "SELECT * FROM " <> tableName <> " WHERE " <> intercalate " AND " conditions
573+
574+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
575+-- UPDATE SQL generation
576+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
577+
578+class ColumnCountRL :: RL.RowList Type -> Constraint
579+class ColumnCountRL rl where
580+ columnCountRL :: Proxy rl -> Int
581+
582+instance ColumnCountRL RL.Nil where
583+ columnCountRL _ = 0
584+
585+instance ColumnCountRL tail => ColumnCountRL (RL.Cons name typ tail) where
586+ columnCountRL _ = 1 + columnCountRL (Proxy :: Proxy tail)
587+
588+class UpdateSQLFor table setRow whereRow where
589+ updateSQLFor :: String
590+
591+instance
592+ ( IsSymbol name
593+ , RowToList setRow setRL
594+ , RowToList whereRow whereRL
595+ , WhereClauseRL setRL
596+ , WhereClauseRL whereRL
597+ , ColumnCountRL setRL
598+ ) =>
599+ UpdateSQLFor (Table name cols) setRow whereRow where
600+ updateSQLFor = do
601+ let tableName = reflectSymbol (Proxy :: Proxy name)
602+ let setClauses = whereClauseRL (Proxy :: Proxy setRL) 1
603+ let setCount = columnCountRL (Proxy :: Proxy setRL)
604+ let whereClauses = whereClauseRL (Proxy :: Proxy whereRL) (setCount + 1)
605+ "UPDATE " <> tableName
606+ <> " SET "
607+ <> intercalate ", " setClauses
608+ <> " WHERE "
609+ <> intercalate " AND " whereClauses
610+
611+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
612+-- DELETE SQL generation
613+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
614+
615+class DeleteSQLFor table whereRow where
616+ deleteSQLFor :: String
617+
618+instance
619+ ( IsSymbol name
620+ , RowToList whereRow whereRL
621+ , WhereClauseRL whereRL
622+ ) =>
623+ DeleteSQLFor (Table name cols) whereRow where
624+ deleteSQLFor = do
625+ let tableName = reflectSymbol (Proxy :: Proxy name)
626+ let conditions = whereClauseRL (Proxy :: Proxy whereRL) 1
627+ "DELETE FROM " <> tableName <> " WHERE " <> intercalate " AND " conditions
628+
629+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
630+-- Utility type classes
631+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
632+
633+class UnwrapMaybe :: Type -> Type -> Constraint
634+class UnwrapMaybe a b | a -> b
635+
636+instance UnwrapMaybe (Maybe a) a
637+else instance UnwrapMaybe a a
638+
639+-- Skip leading spaces
640+class SkipSpaces :: Symbol -> Symbol -> Constraint
641+class SkipSpaces sym result | sym -> result
642+
643+instance SkipSpaces "" ""
644+else instance
645+ ( Symbol.Cons head tail sym
646+ , SkipSpacesGo head tail result
647+ ) =>
648+ SkipSpaces sym result
649+
650+class SkipSpacesGo :: Symbol -> Symbol -> Symbol -> Constraint
651+class SkipSpacesGo head tail result | head tail -> result
652+
653+instance SkipSpaces tail result => SkipSpacesGo " " tail result
654+else instance Symbol.Cons head tail result => SkipSpacesGo head tail result
655+
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+
681+-- Extract the first word from a Symbol (up to space or end)
682+class ExtractWord :: Symbol -> Symbol -> Symbol -> Constraint
683+class ExtractWord sym word rest | sym -> word rest
684+
685+instance ExtractWord "" "" ""
686+else instance
687+ ( Symbol.Cons h t sym
688+ , ExtractWordGo h t "" word rest
689+ ) =>
690+ ExtractWord sym word rest
691+
692+class ExtractWordGo :: Symbol -> Symbol -> Symbol -> Symbol -> Symbol -> Constraint
693+class ExtractWordGo head tail acc word rest | head tail acc -> word rest
694+
695+-- Stop on space
696+instance (SkipSpaces tail rest) => ExtractWordGo " " tail acc acc rest
697+-- Stop on comma (keep comma in rest)
698+else instance Symbol.Cons "," tail rest => ExtractWordGo "," tail acc acc rest
699+-- End of string
700+else instance Symbol.Append acc h word => ExtractWordGo h "" acc word ""
701+-- Regular char: accumulate
702+else instance
703+ ( Symbol.Append acc h acc'
704+ , Symbol.Cons nextH nextT tail
705+ , ExtractWordGo nextH nextT acc' word rest
706+ ) =>
707+ ExtractWordGo h tail acc word rest
708+
709+-- StripColumns: (name :: String # Unique, ...) -> (name :: String, ...)
710+class StripColumnsRL :: RL.RowList Type -> RL.RowList Type -> Constraint
711+class StripColumnsRL rl out | rl -> out
712+
713+instance StripColumnsRL RL.Nil RL.Nil
714+instance (ExtractType entry typ, StripColumnsRL tail out') => StripColumnsRL (RL.Cons name entry tail) (RL.Cons name typ out')
715+
716+class StripColumns :: Row Type -> Row Type -> Constraint
717+class StripColumns cols result | cols -> result
718+
719+instance (RowToList cols rl, StripColumnsRL rl outRL, ListToRow outRL result) => StripColumns cols result
720+
721+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
722+-- SingleTable: extract name and cols from a single-entry tables row
723+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
724+
725+class SingleTable :: Row (Row Type) -> Symbol -> Row Type -> Constraint
726+class SingleTable tables name cols | tables -> name cols
727+
728+instance
729+ ( RowToList tables (RL.Cons name cols RL.Nil)
730+ , IsSymbol name
731+ ) =>
732+ SingleTable tables name cols
733+
734+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
735+-- SplitOnDot: "users.id" -> ("users", "id"); "name" -> unqualified
736+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
737+
738+class SplitOnDot :: Symbol -> Boolean -> Symbol -> Symbol -> Constraint
739+class SplitOnDot sym hasDot table col | sym -> hasDot table col
740+
741+instance
742+ ( Symbol.Cons h t sym
743+ , SplitOnDotGo h t "" hasDot table col
744+ ) =>
745+ SplitOnDot sym hasDot table col
746+
747+class SplitOnDotGo :: Symbol -> Symbol -> Symbol -> Boolean -> Symbol -> Symbol -> Constraint
748+class SplitOnDotGo head tail acc hasDot table col | head tail acc -> hasDot table col
749+
750+-- Found dot: acc is table, rest is column
751+instance SplitOnDotGo "." tail acc True acc tail
752+
753+-- End of string without dot: unqualified
754+else instance
755+ ( Symbol.Append acc h col
756+ ) =>
757+ SplitOnDotGo h "" acc False "" col
758+
759+-- Regular char: accumulate
760+else instance
761+ ( Symbol.Append acc h acc'
762+ , Symbol.Cons nextH nextT tail
763+ , SplitOnDotGo nextH nextT acc' hasDot table col
764+ ) =>
765+ SplitOnDotGo h tail acc hasDot table col
766+
767+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
768+-- ResolveColumn: look up a column (qualified or unqualified) in tables
769+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
770+
771+class ResolveColumn :: Symbol -> Row (Row Type) -> Type -> Constraint
772+class ResolveColumn word tables typ | word tables -> typ
773+
774+instance
775+ ( SplitOnDot word hasDot table col
776+ , ResolveColumnBranch hasDot table col tables typ
777+ ) =>
778+ ResolveColumn word tables typ
779+
780+class ResolveColumnBranch :: Boolean -> Symbol -> Symbol -> Row (Row Type) -> Type -> Constraint
781+class ResolveColumnBranch hasDot table col tables typ | hasDot table col tables -> typ
782+
783+-- Qualified: has dot
784+instance
785+ ( Row.Cons table tableCols restTables tables
786+ , Row.Cons col typ restCols tableCols
787+ ) =>
788+ ResolveColumnBranch True table col tables typ
789+
790+-- Unqualified: no dot
791+else instance
792+ ( RowToList tables tablesRL
793+ , FindUnqualifiedColumn col tablesRL typ
794+ ) =>
795+ ResolveColumnBranch False table col tables typ
796+
797+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
798+-- FindUnqualifiedColumn: search all tables for a column name
799+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
800+
801+class FindUnqualifiedColumn :: Symbol -> RL.RowList (Row Type) -> Type -> Constraint
802+class FindUnqualifiedColumn col tablesRL typ | col tablesRL -> typ
803+
804+instance
805+ ( Fail (Beside (Text "Column ") (Beside (Quote col) (Text " not found in any table")))
806+ ) =>
807+ FindUnqualifiedColumn col RL.Nil typ
808+
809+instance
810+ ( RowToList tableCols colsRL
811+ , HasColumnRL col colsRL found
812+ , FindUnqualifiedColumnDecide found col tableName tableCols tailTables typ
813+ ) =>
814+ FindUnqualifiedColumn col (RL.Cons tableName tableCols tailTables) typ
815+
816+class HasColumnRL :: Symbol -> RL.RowList Type -> Boolean -> Constraint
817+class HasColumnRL col rl found | col rl -> found
818+
819+instance HasColumnRL col RL.Nil False
820+instance HasColumnRL col (RL.Cons col typ tail) True
821+else instance HasColumnRL col tail found => HasColumnRL col (RL.Cons name typ tail) found
822+
823+class FindUnqualifiedColumnDecide :: Boolean -> Symbol -> Symbol -> Row Type -> RL.RowList (Row Type) -> Type -> Constraint
824+class FindUnqualifiedColumnDecide found col tableName tableCols restTables typ | found col tableName tableCols restTables -> typ
825+
826+-- Found in this table: verify it's not in remaining tables
827+instance
828+ ( Row.Cons col typ restCols tableCols
829+ , AssertNotInRemainingTables col restTables
830+ ) =>
831+ FindUnqualifiedColumnDecide True col tableName tableCols restTables typ
832+
833+-- Not found in this table: keep searching
834+instance
835+ FindUnqualifiedColumn col restTables typ =>
836+ FindUnqualifiedColumnDecide False col tableName tableCols restTables typ
837+
838+class AssertNotInRemainingTables :: Symbol -> RL.RowList (Row Type) -> Constraint
839+class AssertNotInRemainingTables col tablesRL
840+
841+instance AssertNotInRemainingTables col RL.Nil
842+instance
843+ ( RowToList tableCols colsRL
844+ , HasColumnRL col colsRL found
845+ , AssertNotAmbiguous found col tableName
846+ , AssertNotInRemainingTables col tail
847+ ) =>
848+ AssertNotInRemainingTables col (RL.Cons tableName tableCols tail)
849+
850+class AssertNotAmbiguous :: Boolean -> Symbol -> Symbol -> Constraint
851+class AssertNotAmbiguous found col tableName
852+
853+instance AssertNotAmbiguous False col tableName
854+instance
855+ ( Fail (Beside (Text "Column ") (Beside (Quote col) (Text " is ambiguous - qualify with table name")))
856+ ) =>
857+ AssertNotAmbiguous True col tableName
858+
859+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
860+-- ParseSelect: parse "users.name, posts.title AS t" against tables
861+-- Result labels: column name (after dot) or explicit AS alias
862+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
863+
864+class ParseSelect :: Symbol -> Row (Row Type) -> Row Type -> Constraint
865+class ParseSelect sym tables result | sym tables -> result
866+
867+instance ParseSelect "" tables ()
868+else instance
869+ ( Symbol.Cons h t sym
870+ , ParseSelectGo h t "" tables RL.Nil outRL
871+ , ListToRow outRL result
872+ ) =>
873+ ParseSelect sym tables result
874+
875+class ParseSelectGo :: Symbol -> Symbol -> Symbol -> Row (Row Type) -> RL.RowList Type -> RL.RowList Type -> Constraint
876+class ParseSelectGo head tail acc tables accRL outRL | head tail acc tables accRL -> outRL
877+
878+-- Leading/double comma: no column name before comma
879+instance
880+ Fail (Text "Unexpected comma in SELECT clause (missing column name)") =>
881+ ParseSelectGo "," tail "" tables accRL outRL
882+
883+-- Comma: emit column, continue
884+else instance
885+ ( ResolveColumn acc tables entry
886+ , ExtractType entry typ
887+ , SplitOnDot acc _hasDot _table colName
888+ , SkipSpaces tail rest
889+ , ParseSelectContinue rest tables (RL.Cons colName typ accRL) outRL
890+ ) =>
891+ ParseSelectGo "," tail acc tables accRL outRL
892+
893+-- Space: column reference done, check for AS or comma
894+else instance
895+ ( SkipSpaces tail rest
896+ , ParseSelectAfterCol acc rest tables accRL outRL
897+ ) =>
898+ ParseSelectGo " " tail acc tables accRL outRL
899+
900+-- Open paren: aggregate function call
901+else instance
902+ ( ExtractUntilParen tail args afterParen
903+ , ResolveAggregateArg args tables argType
904+ , AggregateReturnType acc argType returnType
905+ , SkipSpaces afterParen rest
906+ , ParseAfterAggregate rest tables returnType accRL outRL
907+ ) =>
908+ ParseSelectGo "(" tail acc tables accRL outRL
909+
910+-- End of string: emit final column
911+else instance
912+ ( Symbol.Append acc h acc'
913+ , ResolveColumn acc' tables entry
914+ , ExtractType entry typ
915+ , SplitOnDot acc' _hasDot _table colName
916+ ) =>
917+ ParseSelectGo h "" acc tables accRL (RL.Cons colName typ accRL)
918+
919+-- Regular char (including dot): accumulate
920+else instance
921+ ( Symbol.Append acc h acc'
922+ , Symbol.Cons nextH nextT tail
923+ , ParseSelectGo nextH nextT acc' tables accRL outRL
924+ ) =>
925+ ParseSelectGo h tail acc tables accRL outRL
926+
927+-- After column name + space: AS alias, comma, or end
928+class ParseSelectAfterCol :: Symbol -> Symbol -> Row (Row Type) -> RL.RowList Type -> RL.RowList Type -> Constraint
929+class ParseSelectAfterCol colRef rest tables accRL outRL | colRef rest tables accRL -> outRL
930+
931+-- End: emit column with default label (column name after dot)
932+instance
933+ ( ResolveColumn colRef tables entry
934+ , ExtractType entry typ
935+ , SplitOnDot colRef _hasDot _table colName
936+ ) =>
937+ ParseSelectAfterCol colRef "" tables accRL (RL.Cons colName typ accRL)
938+
939+-- Non-empty: branch on first char
940+else instance
941+ ( Symbol.Cons h t rest
942+ , ParseSelectAfterColByHead h t colRef tables accRL outRL
943+ ) =>
944+ ParseSelectAfterCol colRef rest tables accRL outRL
945+
946+class ParseSelectAfterColByHead :: Symbol -> Symbol -> Symbol -> Row (Row Type) -> RL.RowList Type -> RL.RowList Type -> Constraint
947+class ParseSelectAfterColByHead head tail colRef tables accRL outRL | head tail colRef tables accRL -> outRL
948+
949+-- Comma: emit column with default label, continue
950+instance
951+ ( ResolveColumn colRef tables entry
952+ , ExtractType entry typ
953+ , SplitOnDot colRef _hasDot _table colName
954+ , SkipSpaces tail rest
955+ , ParseSelectContinue rest tables (RL.Cons colName typ accRL) outRL
956+ ) =>
957+ ParseSelectAfterColByHead "," tail colRef tables accRL outRL
958+
959+-- Otherwise (AS ...): extract word
960+else instance
961+ ( Symbol.Append h t rest
962+ , ExtractWord rest keyword afterKeyword
963+ , ParseSelectHandleAS keyword afterKeyword colRef tables accRL outRL
964+ ) =>
965+ ParseSelectAfterColByHead h t colRef tables accRL outRL
966+
967+class ParseSelectHandleAS :: Symbol -> Symbol -> Symbol -> Row (Row Type) -> RL.RowList Type -> RL.RowList Type -> Constraint
968+class ParseSelectHandleAS keyword afterKeyword colRef tables accRL outRL | keyword afterKeyword colRef tables accRL -> outRL
969+
970+instance
971+ ( ExtractWord afterKeyword alias afterAlias
972+ , ResolveColumn colRef tables entry
973+ , ExtractType entry typ
974+ , SkipSpaces afterAlias rest
975+ , ParseSelectExpectEnd rest tables (RL.Cons alias typ accRL) outRL
976+ ) =>
977+ ParseSelectHandleAS "AS" afterKeyword colRef tables accRL outRL
978+
979+else instance
980+ ( ExtractWord afterKeyword alias afterAlias
981+ , ResolveColumn colRef tables entry
982+ , ExtractType entry typ
983+ , SkipSpaces afterAlias rest
984+ , ParseSelectExpectEnd rest tables (RL.Cons alias typ accRL) outRL
985+ ) =>
986+ ParseSelectHandleAS "as" afterKeyword colRef tables accRL outRL
987+
988+-- Bare alias (no AS keyword): "name n" means "name AS n"
989+else instance
990+ ( ResolveColumn colRef tables entry
991+ , ExtractType entry typ
992+ , SkipSpaces afterKeyword rest
993+ , ParseSelectExpectEnd rest tables (RL.Cons keyword typ accRL) outRL
994+ ) =>
995+ ParseSelectHandleAS keyword afterKeyword colRef tables accRL outRL
996+
997+class ParseSelectExpectEnd :: Symbol -> Row (Row Type) -> RL.RowList Type -> RL.RowList Type -> Constraint
998+class ParseSelectExpectEnd sym tables accRL outRL | sym tables accRL -> outRL
999+
1000+instance ParseSelectExpectEnd "" tables accRL accRL
1001+else instance
1002+ ( Symbol.Cons h t sym
1003+ , ParseSelectExpectEndByHead h t tables accRL outRL
1004+ ) =>
1005+ ParseSelectExpectEnd sym tables accRL outRL
1006+
1007+class ParseSelectExpectEndByHead :: Symbol -> Symbol -> Row (Row Type) -> RL.RowList Type -> RL.RowList Type -> Constraint
1008+class ParseSelectExpectEndByHead head tail tables accRL outRL | head tail tables accRL -> outRL
1009+
1010+instance
1011+ ( SkipSpaces tail rest
1012+ , ParseSelectContinue rest tables accRL outRL
1013+ ) =>
1014+ ParseSelectExpectEndByHead "," tail tables accRL outRL
1015+
1016+class ParseSelectContinue :: Symbol -> Row (Row Type) -> RL.RowList Type -> RL.RowList Type -> Constraint
1017+class ParseSelectContinue sym tables accRL outRL | sym tables accRL -> outRL
1018+
1019+instance Fail (Text "Trailing comma in SELECT clause") => ParseSelectContinue "" tables accRL outRL
1020+else instance
1021+ ( Symbol.Cons h t sym
1022+ , ParseSelectGo h t "" tables accRL outRL
1023+ ) =>
1024+ ParseSelectContinue sym tables accRL outRL
1025+
1026+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
1027+-- Aggregate functions in SELECT: COUNT(*), SUM(col), etc.
1028+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
1029+
1030+-- Extract characters until closing paren
1031+class ExtractUntilParen :: Symbol -> Symbol -> Symbol -> Constraint
1032+class ExtractUntilParen tail args afterParen | tail -> args afterParen
1033+
1034+instance
1035+ Fail (Text "Unclosed parenthesis in SELECT clause") =>
1036+ ExtractUntilParen "" args afterParen
1037+
1038+else instance
1039+ ( Symbol.Cons h t tail
1040+ , ExtractUntilParenGo h t "" Z args afterParen
1041+ ) =>
1042+ ExtractUntilParen tail args afterParen
1043+
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
1052+
1053+-- ) at depth zero: done
1054+instance ExtractUntilParenGo ")" tail acc Z acc tail
1055+
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
1073+else instance
1074+ Fail (Text "Unclosed parenthesis in SELECT clause") =>
1075+ ExtractUntilParenGo h "" acc depth args afterParen
1076+
1077+-- Any other char: accumulate
1078+else instance
1079+ ( Symbol.Append acc h acc'
1080+ , Symbol.Cons nextH nextT tail
1081+ , ExtractUntilParenGo nextH nextT acc' depth args afterParen
1082+ ) =>
1083+ ExtractUntilParenGo h tail acc depth args afterParen
1084+
1085+-- Resolve aggregate argument: "*" -> Star, column ref -> unwrapped type
1086+data Star
1087+
1088+class ResolveAggregateArg :: Symbol -> Row (Row Type) -> Type -> Constraint
1089+class ResolveAggregateArg args tables argType | args tables -> argType
1090+
1091+instance ResolveAggregateArg "*" tables Star
1092+else instance ResolveAggregateArg "" tables Star
1093+else instance
1094+ ( SkipSpaces args trimmedFront
1095+ , ExtractIdent trimmedFront col rest
1096+ , ResolveAggregateArgDispatch col rest tables argType
1097+ ) =>
1098+ ResolveAggregateArg args tables argType
1099+
1100+-- ExtractIdent: like ExtractWord but also stops at "(" so we can detect nested function calls
1101+class ExtractIdent :: Symbol -> Symbol -> Symbol -> Constraint
1102+class ExtractIdent sym word rest | sym -> word rest
1103+
1104+instance ExtractIdent "" "" ""
1105+else instance
1106+ ( Symbol.Cons h t sym
1107+ , ExtractIdentGo h t "" word rest
1108+ ) =>
1109+ ExtractIdent sym word rest
1110+
1111+class ExtractIdentGo :: Symbol -> Symbol -> Symbol -> Symbol -> Symbol -> Constraint
1112+class ExtractIdentGo head tail acc word rest | head tail acc -> word rest
1113+
1114+instance (SkipSpaces tail rest) => ExtractIdentGo " " tail acc acc rest
1115+else instance Symbol.Cons "," tail rest => ExtractIdentGo "," tail acc acc rest
1116+else instance Symbol.Append "(" tail rest => ExtractIdentGo "(" tail acc acc rest
1117+else instance Symbol.Append acc h word => ExtractIdentGo h "" acc word ""
1118+else instance
1119+ ( Symbol.Append acc h acc'
1120+ , Symbol.Cons nextH nextT tail
1121+ , ExtractIdentGo nextH nextT acc' word rest
1122+ ) =>
1123+ ExtractIdentGo h tail acc word rest
1124+
1125+-- After extracting the identifier, check if followed by "(" (nested function call) or not (column ref)
1126+class ResolveAggregateArgDispatch :: Symbol -> Symbol -> Row (Row Type) -> Type -> Constraint
1127+class ResolveAggregateArgDispatch col rest tables argType | col rest tables -> argType
1128+
1129+instance
1130+ ResolveAggregateArgCol col tables argType =>
1131+ ResolveAggregateArgDispatch col "" tables argType
1132+
1133+else instance
1134+ ( Symbol.Cons h t rest
1135+ , ResolveAggregateArgDispatchByHead h t col tables argType
1136+ ) =>
1137+ ResolveAggregateArgDispatch col rest tables argType
1138+
1139+class ResolveAggregateArgDispatchByHead :: Symbol -> Symbol -> Symbol -> Row (Row Type) -> Type -> Constraint
1140+class ResolveAggregateArgDispatchByHead head tail col tables argType | head tail col tables -> argType
1141+
1142+-- Nested function call: col(...)
1143+instance
1144+ ( ExtractUntilParen tail innerArgs _afterParen
1145+ , ResolveAggregateArg innerArgs tables innerArgType
1146+ , AggregateReturnType col innerArgType argType
1147+ ) =>
1148+ ResolveAggregateArgDispatchByHead "(" tail col tables argType
1149+
1150+-- Not a function call: column reference
1151+else instance
1152+ ResolveAggregateArgCol col tables argType =>
1153+ ResolveAggregateArgDispatchByHead h t col tables argType
1154+
1155+class ResolveAggregateArgCol :: Symbol -> Row (Row Type) -> Type -> Constraint
1156+class ResolveAggregateArgCol col tables argType | col tables -> argType
1157+
1158+instance ResolveAggregateArgCol "*" tables Star
1159+else instance
1160+ ( Symbol.Cons h _t col
1161+ , ResolveAggregateArgColByHead h col tables argType
1162+ ) =>
1163+ ResolveAggregateArgCol col tables argType
1164+
1165+class ResolveAggregateArgColByHead :: Symbol -> Symbol -> Row (Row Type) -> Type -> Constraint
1166+class ResolveAggregateArgColByHead head col tables argType | head col tables -> argType
1167+
1168+-- Numeric literals: treat as Star (return type determined by function)
1169+instance ResolveAggregateArgColByHead "0" col tables Star
1170+else instance ResolveAggregateArgColByHead "1" col tables Star
1171+else instance ResolveAggregateArgColByHead "2" col tables Star
1172+else instance ResolveAggregateArgColByHead "3" col tables Star
1173+else instance ResolveAggregateArgColByHead "4" col tables Star
1174+else instance ResolveAggregateArgColByHead "5" col tables Star
1175+else instance ResolveAggregateArgColByHead "6" col tables Star
1176+else instance ResolveAggregateArgColByHead "7" col tables Star
1177+else instance ResolveAggregateArgColByHead "8" col tables Star
1178+else instance ResolveAggregateArgColByHead "9" col tables Star
1179+-- Column reference
1180+else instance
1181+ ( ResolveColumn col tables entry
1182+ , ExtractType entry typ
1183+ , UnwrapMaybe typ unwrapped
1184+ ) =>
1185+ ResolveAggregateArgColByHead head col tables unwrapped
1186+
1187+-- Map (funcName, argType) -> returnType
1188+-- Dispatches on first character to avoid linear search
1189+class AggregateReturnType :: Symbol -> Type -> Type -> Constraint
1190+class AggregateReturnType funcName argType returnType | funcName argType -> returnType
1191+
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
1219+else instance
1220+ Fail (Beside (Text "Unknown function: ") (Quote funcName)) =>
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
1328+
1329+-- After aggregate ): require AS alias, then continue
1330+class ParseAfterAggregate :: Symbol -> Row (Row Type) -> Type -> RL.RowList Type -> RL.RowList Type -> Constraint
1331+class ParseAfterAggregate rest tables returnType accRL outRL | rest tables returnType accRL -> outRL
1332+
1333+-- End of string without alias
1334+instance
1335+ Fail (Text "Aggregate function requires AS alias (e.g. COUNT(*) AS cnt)") =>
1336+ ParseAfterAggregate "" tables returnType accRL outRL
1337+
1338+else instance
1339+ ( Symbol.Cons h t rest
1340+ , ParseAfterAggregateByHead h t tables returnType accRL outRL
1341+ ) =>
1342+ ParseAfterAggregate rest tables returnType accRL outRL
1343+
1344+class ParseAfterAggregateByHead :: Symbol -> Symbol -> Row (Row Type) -> Type -> RL.RowList Type -> RL.RowList Type -> Constraint
1345+class ParseAfterAggregateByHead head tail tables returnType accRL outRL | head tail tables returnType accRL -> outRL
1346+
1347+-- Comma without alias
1348+instance
1349+ Fail (Text "Aggregate function requires AS alias (e.g. COUNT(*) AS cnt)") =>
1350+ ParseAfterAggregateByHead "," tail tables returnType accRL outRL
1351+
1352+-- Otherwise: extract keyword and dispatch (OVER or AS)
1353+else instance
1354+ ( Symbol.Append h t rest
1355+ , ExtractWord rest keyword afterKeyword
1356+ , ParseAfterAggregateKeyword keyword afterKeyword tables returnType accRL outRL
1357+ ) =>
1358+ ParseAfterAggregateByHead h t tables returnType accRL outRL
1359+
1360+class ParseAfterAggregateKeyword :: Symbol -> Symbol -> Row (Row Type) -> Type -> RL.RowList Type -> RL.RowList Type -> Constraint
1361+class ParseAfterAggregateKeyword keyword afterKeyword tables returnType accRL outRL | keyword afterKeyword tables returnType accRL -> outRL
1362+
1363+-- OVER: parse the over clause, then continue to AS
1364+instance
1365+ ( SkipSpaces afterKeyword rest
1366+ , ParseOverClause rest tables returnType accRL outRL
1367+ ) =>
1368+ ParseAfterAggregateKeyword "OVER" afterKeyword tables returnType accRL outRL
1369+
1370+else instance
1371+ ( SkipSpaces afterKeyword rest
1372+ , ParseOverClause rest tables returnType accRL outRL
1373+ ) =>
1374+ ParseAfterAggregateKeyword "over" afterKeyword tables returnType accRL outRL
1375+
1376+-- AS: extract alias
1377+else instance
1378+ ( ExtractWord afterKeyword alias afterAlias
1379+ , SkipSpaces afterAlias rest
1380+ , ParseSelectExpectEnd rest tables (RL.Cons alias returnType accRL) outRL
1381+ ) =>
1382+ ParseAfterAggregateKeyword "AS" afterKeyword tables returnType accRL outRL
1383+
1384+else instance
1385+ ( ExtractWord afterKeyword alias afterAlias
1386+ , SkipSpaces afterAlias rest
1387+ , ParseSelectExpectEnd rest tables (RL.Cons alias returnType accRL) outRL
1388+ ) =>
1389+ ParseAfterAggregateKeyword "as" afterKeyword tables returnType accRL outRL
1390+
1391+else instance
1392+ Fail (Text "Aggregate function requires AS alias (e.g. COUNT(*) AS cnt)") =>
1393+ ParseAfterAggregateKeyword keyword afterKeyword tables returnType accRL outRL
1394+
1395+-- Parse OVER (...) clause: expect (, skip until ), then continue to AS alias
1396+class ParseOverClause :: Symbol -> Row (Row Type) -> Type -> RL.RowList Type -> RL.RowList Type -> Constraint
1397+class ParseOverClause rest tables returnType accRL outRL | rest tables returnType accRL -> outRL
1398+
1399+instance
1400+ Fail (Text "Expected ( after OVER") =>
1401+ ParseOverClause "" tables returnType accRL outRL
1402+
1403+else instance
1404+ ( Symbol.Cons h t rest
1405+ , ParseOverClauseByHead h t tables returnType accRL outRL
1406+ ) =>
1407+ ParseOverClause rest tables returnType accRL outRL
1408+
1409+class ParseOverClauseByHead :: Symbol -> Symbol -> Row (Row Type) -> Type -> RL.RowList Type -> RL.RowList Type -> Constraint
1410+class ParseOverClauseByHead head tail tables returnType accRL outRL | head tail tables returnType accRL -> outRL
1411+
1412+-- Open paren: extract until close paren, validate content, continue to AS
1413+instance
1414+ ( ExtractUntilParen tail overContent afterParen
1415+ , ValidateOverContent overContent tables
1416+ , SkipSpaces afterParen rest
1417+ , ParseAfterAggregate rest tables returnType accRL outRL
1418+ ) =>
1419+ ParseOverClauseByHead "(" tail tables returnType accRL outRL
1420+
1421+else instance
1422+ Fail (Text "Expected ( after OVER") =>
1423+ ParseOverClauseByHead h t tables returnType accRL outRL
1424+
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+
1572+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
1573+-- ParseWhere: parse "id = $id AND age > $age" -> params
1574+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
1575+
1576+data NoType
1577+
1578+class ParseWhere :: Symbol -> Row (Row Type) -> Row Type -> Constraint
1579+class ParseWhere sym tables params | sym tables -> params
1580+
1581+instance Fail (Text "Empty WHERE clause") => ParseWhere "" tables params
1582+else instance
1583+ ( Symbol.Cons h t sym
1584+ , ParseWhereGo h t "" NoType tables RL.Nil outRL
1585+ , ListToRow outRL params
1586+ ) =>
1587+ ParseWhere sym tables params
1588+
1589+class ParseWhereGo :: Symbol -> Symbol -> Symbol -> Type -> Row (Row Type) -> RL.RowList Type -> RL.RowList Type -> Constraint
1590+class ParseWhereGo head tail acc currentType tables paramsIn paramsOut | head tail acc currentType tables paramsIn -> paramsOut
1591+
1592+-- Space: flush word, continue
1593+instance
1594+ ( FlushWhereWord acc currentType tables paramsIn currentType' paramsOut'
1595+ , SkipSpaces tail rest
1596+ , ParseWhereContinue rest currentType' tables paramsOut' paramsOut
1597+ ) =>
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
1895+
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
1898+
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
1907+else instance
1908+ ( ResolveColumn word tables entry
1909+ , ExtractType entry typ
1910+ , UnwrapMaybe typ unwrapped
1911+ ) =>
1912+ FlushWhereWordN word currentType tables paramsIn unwrapped paramsIn
1913+
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
1923+else instance
1924+ ( ResolveColumn word tables entry
1925+ , ExtractType entry typ
1926+ , UnwrapMaybe typ unwrapped
1927+ ) =>
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
1956+
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
1959+
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
1963+else instance
1964+ ( ResolveColumn word tables entry
1965+ , ExtractType entry typ
1966+ , UnwrapMaybe typ unwrapped
1967+ ) =>
1968+ FlushWhereWordU word currentType tables paramsIn unwrapped paramsIn
1969+
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
1972+
1973+instance FlushWhereWordV "varchar" currentType tables paramsIn currentType paramsIn
1974+else instance
1975+ ( ResolveColumn word tables entry
1976+ , ExtractType entry typ
1977+ , UnwrapMaybe typ unwrapped
1978+ ) =>
1979+ FlushWhereWordV word currentType tables paramsIn unwrapped paramsIn
1980+
1981+class FlushWhereWordP :: Symbol -> Type -> Row (Row Type) -> RL.RowList Type -> Type -> RL.RowList Type -> Constraint
1982+class FlushWhereWordP word currentType tables paramsIn currentTypeOut paramsOut | word currentType tables paramsIn -> currentTypeOut paramsOut
1983+
1984+instance FlushWhereWordP "point" currentType tables paramsIn currentType paramsIn
1985+else instance FlushWhereWordP "POINT" currentType tables paramsIn currentType paramsIn
1986+else instance FlushWhereWordP "plainto_tsquery" currentType tables paramsIn currentType paramsIn
1987+else instance FlushWhereWordP "PLAINTO_TSQUERY" currentType tables paramsIn currentType paramsIn
1988+else instance
1989+ ( ResolveColumn word tables entry
1990+ , ExtractType entry typ
1991+ , UnwrapMaybe typ unwrapped
1992+ ) =>
1993+ FlushWhereWordP word currentType tables paramsIn unwrapped paramsIn
1994+
1995+class FlushWhereWordR :: Symbol -> Type -> Row (Row Type) -> RL.RowList Type -> Type -> RL.RowList Type -> Constraint
1996+class FlushWhereWordR word currentType tables paramsIn currentTypeOut paramsOut | word currentType tables paramsIn -> currentTypeOut paramsOut
1997+
1998+instance FlushWhereWordR "real" currentType tables paramsIn currentType paramsIn
1999+else instance FlushWhereWordR "REAL" currentType tables paramsIn currentType paramsIn
2000+else instance
2001+ ( ResolveColumn word tables entry
2002+ , ExtractType entry typ
2003+ , UnwrapMaybe typ unwrapped
2004+ ) =>
2005+ FlushWhereWordR word currentType tables paramsIn unwrapped paramsIn
2006+
2007+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
2008+-- ValidateColumnList: comma-separated column references
2009+-- Used by GROUP BY, DISTINCT ON, ON CONFLICT target
2010+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
2011+
2012+class ValidateColumnList :: Symbol -> Row (Row Type) -> Constraint
2013+class ValidateColumnList sym tables
2014+
2015+instance Fail (Text "Empty column list") => ValidateColumnList "" tables
2016+else instance
2017+ ( Symbol.Cons h t sym
2018+ , ValidateColumnListGo h t "" tables
2019+ ) =>
2020+ ValidateColumnList sym tables
2021+
2022+class ValidateColumnListContinue :: Symbol -> Row (Row Type) -> Constraint
2023+class ValidateColumnListContinue sym tables
2024+
2025+instance ValidateColumnListContinue "" tables
2026+else instance
2027+ ( Symbol.Cons h t sym
2028+ , ValidateColumnListGo h t "" tables
2029+ ) =>
2030+ ValidateColumnListContinue sym tables
2031+
2032+class ValidateColumnListGo :: Symbol -> Symbol -> Symbol -> Row (Row Type) -> Constraint
2033+class ValidateColumnListGo head tail acc tables
2034+
2035+instance
2036+ ( ResolveColumn acc tables typ
2037+ , SkipSpaces tail rest
2038+ , ValidateColumnListContinue rest tables
2039+ ) =>
2040+ ValidateColumnListGo "," tail acc tables
2041+
2042+else instance
2043+ ( SkipSpaces tail rest
2044+ , ResolveColumn acc tables typ
2045+ , ValidateColumnListContinue rest tables
2046+ ) =>
2047+ ValidateColumnListGo " " tail acc tables
2048+
2049+else instance
2050+ ( Symbol.Append acc h acc'
2051+ , ResolveColumn acc' tables typ
2052+ ) =>
2053+ ValidateColumnListGo h "" acc tables
2054+
2055+else instance
2056+ ( Symbol.Append acc h acc'
2057+ , Symbol.Cons nextH nextT tail
2058+ , ValidateColumnListGo nextH nextT acc' tables
2059+ ) =>
2060+ ValidateColumnListGo h tail acc tables
2061+
2062+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
2063+-- ValidateOrderBy: validate ORDER BY with qualified column support
2064+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
2065+
2066+class ValidateOrderBy :: Symbol -> Row (Row Type) -> Constraint
2067+class ValidateOrderBy sym tables
2068+
2069+instance ValidateOrderBy "" tables
2070+else instance
2071+ ( Symbol.Cons h t sym
2072+ , ValidateOrderByGo h t "" tables
2073+ ) =>
2074+ ValidateOrderBy sym tables
2075+
2076+class ValidateOrderByGo :: Symbol -> Symbol -> Symbol -> Row (Row Type) -> Constraint
2077+class ValidateOrderByGo head tail acc tables
2078+
2079+-- Leading/double comma: no column before comma
2080+instance
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
2086+ ( FlushOrderByWord acc tables
2087+ , SkipSpaces tail rest
2088+ , ValidateOrderByContinueNonEmpty rest tables
2089+ ) =>
2090+ ValidateOrderByGo "," tail acc tables
2091+
2092+-- Space: flush column, skip modifiers
2093+else instance
2094+ ( SkipSpaces tail rest
2095+ , FlushOrderByThenSkip acc rest tables
2096+ ) =>
2097+ ValidateOrderByGo " " tail acc tables
2098+
2099+-- End of string: flush final column
2100+else instance
2101+ ( Symbol.Append acc h acc'
2102+ , FlushOrderByFinalWord acc' tables
2103+ ) =>
2104+ ValidateOrderByGo h "" acc tables
2105+
2106+-- Regular char (including dot): accumulate
2107+else instance
2108+ ( Symbol.Append acc h acc'
2109+ , Symbol.Cons nextH nextT tail
2110+ , ValidateOrderByGo nextH nextT acc' tables
2111+ ) =>
2112+ ValidateOrderByGo h tail acc tables
2113+
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+
2139+class FlushOrderByWord :: Symbol -> Row (Row Type) -> Constraint
2140+class FlushOrderByWord word tables
2141+
2142+instance FlushOrderByWord "" tables
2143+else instance FlushOrderByWord "ASC" tables
2144+else instance FlushOrderByWord "asc" tables
2145+else instance FlushOrderByWord "DESC" tables
2146+else instance FlushOrderByWord "desc" tables
2147+else instance FlushOrderByWord "NULLS" tables
2148+else instance FlushOrderByWord "FIRST" tables
2149+else instance FlushOrderByWord "LAST" tables
2150+else instance ResolveColumn word tables typ => FlushOrderByWord word tables
2151+
2152+class FlushOrderByThenSkip :: Symbol -> Symbol -> Row (Row Type) -> Constraint
2153+class FlushOrderByThenSkip colName rest tables
2154+
2155+instance FlushOrderByWord colName tables => FlushOrderByThenSkip colName "" tables
2156+else instance
2157+ ( FlushOrderByWord colName tables
2158+ , Symbol.Cons h t rest
2159+ , FlushOrderByThenSkipByHead h t tables
2160+ ) =>
2161+ FlushOrderByThenSkip colName rest tables
2162+
2163+class FlushOrderByThenSkipByHead :: Symbol -> Symbol -> Row (Row Type) -> Constraint
2164+class FlushOrderByThenSkipByHead head tail tables
2165+
2166+-- Comma: continue with next column
2167+instance
2168+ ( SkipSpaces tail rest
2169+ , ValidateOrderBy rest tables
2170+ ) =>
2171+ FlushOrderByThenSkipByHead "," tail tables
2172+
2173+-- Modifier word: consume it, continue
2174+else instance
2175+ ( Symbol.Append h t rest
2176+ , ExtractWord rest word afterWord
2177+ , FlushOrderByWord word tables
2178+ , SkipSpaces afterWord rest'
2179+ , ValidateOrderByContinue rest' tables
2180+ ) =>
2181+ FlushOrderByThenSkipByHead h t tables
2182+
2183+class ValidateOrderByContinue :: Symbol -> Row (Row Type) -> Constraint
2184+class ValidateOrderByContinue sym tables
2185+
2186+instance ValidateOrderByContinue "" tables
2187+else instance
2188+ ( Symbol.Cons h t sym
2189+ , ValidateOrderByContinueByHead h t tables
2190+ ) =>
2191+ ValidateOrderByContinue sym tables
2192+
2193+class ValidateOrderByContinueByHead :: Symbol -> Symbol -> Row (Row Type) -> Constraint
2194+class ValidateOrderByContinueByHead head tail tables
2195+
2196+instance
2197+ ( SkipSpaces tail rest
2198+ , ValidateOrderBy rest tables
2199+ ) =>
2200+ ValidateOrderByContinueByHead "," tail tables
2201+
2202+else instance
2203+ ( Symbol.Append h t rest
2204+ , ExtractWord rest word afterWord
2205+ , FlushOrderByWord word tables
2206+ , SkipSpaces afterWord rest'
2207+ , ValidateOrderByContinue rest' tables
2208+ ) =>
2209+ ValidateOrderByContinueByHead h t tables
2210+
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+
2382+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
2383+-- ValidateColumns: comma-separated column names (for ON CONFLICT target)
2384+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
2385+
2386+class ValidateColumns :: Symbol -> Row Type -> Constraint
2387+class ValidateColumns sym cols
2388+
2389+instance ValidateColumns "" cols
2390+else instance
2391+ ( Symbol.Cons h t sym
2392+ , ValidateColumnsGo h t "" cols
2393+ ) =>
2394+ ValidateColumns sym cols
2395+
2396+class ValidateColumnsGo :: Symbol -> Symbol -> Symbol -> Row Type -> Constraint
2397+class ValidateColumnsGo head tail acc cols
2398+
2399+-- Comma: flush name, continue
2400+instance
2401+ ( FlushColumnWord acc cols
2402+ , SkipSpaces tail rest
2403+ , ValidateColumns rest cols
2404+ ) =>
2405+ ValidateColumnsGo "," tail acc cols
2406+
2407+-- Space: flush name, skip to comma or end
2408+else instance
2409+ ( SkipSpaces tail rest
2410+ , ValidateAfterName acc rest cols
2411+ ) =>
2412+ ValidateColumnsGo " " tail acc cols
2413+
2414+-- End of string: flush final name
2415+else instance
2416+ ( Symbol.Append acc h acc'
2417+ , FlushColumnWord acc' cols
2418+ ) =>
2419+ ValidateColumnsGo h "" acc cols
2420+
2421+-- Regular char: accumulate
2422+else instance
2423+ ( Symbol.Append acc h acc'
2424+ , Symbol.Cons nextH nextT tail
2425+ , ValidateColumnsGo nextH nextT acc' cols
2426+ ) =>
2427+ ValidateColumnsGo h tail acc cols
2428+
2429+class FlushColumnWord :: Symbol -> Row Type -> Constraint
2430+class FlushColumnWord word cols
2431+
2432+instance FlushColumnWord "" cols
2433+else instance FlushColumnWord "$" cols
2434+else instance FlushColumnWord "AND" cols
2435+else instance FlushColumnWord "OR" cols
2436+else instance FlushColumnWord "NOT" cols
2437+else instance FlushColumnWord "IS" cols
2438+else instance FlushColumnWord "NULL" cols
2439+else instance FlushColumnWord "LIKE" cols
2440+else instance FlushColumnWord "ILIKE" cols
2441+else instance FlushColumnWord "IN" cols
2442+else instance FlushColumnWord "TRUE" cols
2443+else instance FlushColumnWord "FALSE" cols
2444+else instance FlushColumnWord "BETWEEN" cols
2445+else instance FlushColumnWord "ANY" cols
2446+else instance FlushColumnWord "ALL" cols
2447+else instance
2448+ ( Symbol.Cons head rest word
2449+ , FlushColumnWordByHead head word cols
2450+ ) =>
2451+ FlushColumnWord word cols
2452+
2453+class FlushColumnWordByHead :: Symbol -> Symbol -> Row Type -> Constraint
2454+class FlushColumnWordByHead head word cols
2455+
2456+instance FlushColumnWordByHead "$" word cols
2457+else instance FlushColumnWordByHead "0" word cols
2458+else instance FlushColumnWordByHead "1" word cols
2459+else instance FlushColumnWordByHead "2" word cols
2460+else instance FlushColumnWordByHead "3" word cols
2461+else instance FlushColumnWordByHead "4" word cols
2462+else instance FlushColumnWordByHead "5" word cols
2463+else instance FlushColumnWordByHead "6" word cols
2464+else instance FlushColumnWordByHead "7" word cols
2465+else instance FlushColumnWordByHead "8" word cols
2466+else instance FlushColumnWordByHead "9" word cols
2467+else instance Row.Cons word typ rest cols => FlushColumnWordByHead head word cols
2468+else instance
2469+ Fail (Beside (Beside (Text "Column ") (Quote word)) (Text " does not exist in the table")) =>
2470+ FlushColumnWordByHead head word cols
2471+
2472+class ValidateAfterName :: Symbol -> Symbol -> Row Type -> Constraint
2473+class ValidateAfterName acc rest cols
2474+
2475+instance FlushColumnWord acc cols => ValidateAfterName acc "" cols
2476+else instance
2477+ ( FlushColumnWord acc cols
2478+ , Symbol.Cons h t rest
2479+ , ValidateAfterNameByHead h t cols
2480+ ) =>
2481+ ValidateAfterName acc rest cols
2482+
2483+class ValidateAfterNameByHead :: Symbol -> Symbol -> Row Type -> Constraint
2484+class ValidateAfterNameByHead head tail cols
2485+
2486+instance
2487+ ( SkipSpaces tail rest
2488+ , ValidateColumns rest cols
2489+ ) =>
2490+ ValidateAfterNameByHead "," tail cols
2491+
2492+else instance
2493+ ( Symbol.Append h t rest
2494+ , ExtractWord rest word afterWord
2495+ , HandleAfterColumnWord word afterWord cols
2496+ ) =>
2497+ ValidateAfterNameByHead h t cols
2498+
2499+class HandleAfterColumnWord :: Symbol -> Symbol -> Row Type -> Constraint
2500+class HandleAfterColumnWord word rest cols
2501+
2502+instance SkipAlias rest cols => HandleAfterColumnWord "AS" rest cols
2503+else instance SkipAlias rest cols => HandleAfterColumnWord "as" rest cols
2504+
2505+class SkipAlias :: Symbol -> Row Type -> Constraint
2506+class SkipAlias sym cols
2507+
2508+instance SkipAlias "" cols
2509+else instance
2510+ ( ExtractWord sym _alias afterAlias
2511+ , SkipSpaces afterAlias rest
2512+ , ExpectCommaOrEnd rest cols
2513+ ) =>
2514+ SkipAlias sym cols
2515+
2516+class ExpectCommaOrEnd :: Symbol -> Row Type -> Constraint
2517+class ExpectCommaOrEnd sym cols
2518+
2519+instance ExpectCommaOrEnd "" cols
2520+else instance
2521+ ( Symbol.Cons h t sym
2522+ , ExpectCommaOrEndByHead h t cols
2523+ ) =>
2524+ ExpectCommaOrEnd sym cols
2525+
2526+class ExpectCommaOrEndByHead :: Symbol -> Symbol -> Row Type -> Constraint
2527+class ExpectCommaOrEndByHead head tail cols
2528+
2529+instance
2530+ ( SkipSpaces tail rest
2531+ , ValidateColumns rest cols
2532+ ) =>
2533+ ExpectCommaOrEndByHead "," tail cols
2534+
2535+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
2536+-- ValidateJoinCondition: validate ON clause column references
2537+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
2538+
2539+class ValidateJoinCondition :: Symbol -> Row (Row Type) -> Constraint
2540+class ValidateJoinCondition sym tables
2541+
2542+instance ValidateJoinCondition "" tables
2543+else instance
2544+ ( Symbol.Cons h t sym
2545+ , ValidateJoinCondGo h t "" tables
2546+ ) =>
2547+ ValidateJoinCondition sym tables
2548+
2549+class ValidateJoinCondGo :: Symbol -> Symbol -> Symbol -> Row (Row Type) -> Constraint
2550+class ValidateJoinCondGo head tail acc tables
2551+
2552+-- Space: flush word, continue
2553+instance
2554+ ( FlushJoinWord acc tables
2555+ , SkipSpaces tail rest
2556+ , ValidateJoinCondition rest tables
2557+ ) =>
2558+ ValidateJoinCondGo " " tail acc tables
2559+
2560+-- Operators
2561+else instance (FlushJoinWord acc tables, ValidateJoinCondition tail tables) => ValidateJoinCondGo "=" tail acc tables
2562+else instance (FlushJoinWord acc tables, ValidateJoinCondition tail tables) => ValidateJoinCondGo ">" tail acc tables
2563+else instance (FlushJoinWord acc tables, ValidateJoinCondition tail tables) => ValidateJoinCondGo "<" tail acc tables
2564+else instance (FlushJoinWord acc tables, ValidateJoinCondition tail tables) => ValidateJoinCondGo "!" tail acc tables
2565+else instance (FlushJoinWord acc tables, ValidateJoinCondition tail tables) => ValidateJoinCondGo "(" tail acc tables
2566+else instance (FlushJoinWord acc tables, ValidateJoinCondition tail tables) => ValidateJoinCondGo ")" tail acc tables
2567+
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+
2576+-- End of string: flush final word
2577+else instance
2578+ ( Symbol.Append acc h acc'
2579+ , FlushJoinWord acc' tables
2580+ ) =>
2581+ ValidateJoinCondGo h "" acc tables
2582+
2583+-- Regular char (including dot): accumulate
2584+else instance
2585+ ( Symbol.Append acc h acc'
2586+ , Symbol.Cons nextH nextT tail
2587+ , ValidateJoinCondGo nextH nextT acc' tables
2588+ ) =>
2589+ ValidateJoinCondGo h tail acc tables
2590+
2591+class FlushJoinWord :: Symbol -> Row (Row Type) -> Constraint
2592+class FlushJoinWord word tables
2593+
2594+instance FlushJoinWord "" tables
2595+else instance FlushJoinWord "AND" tables
2596+else instance FlushJoinWord "OR" tables
2597+else instance FlushJoinWord "NOT" tables
2598+else instance FlushJoinWord "IS" tables
2599+else instance FlushJoinWord "NULL" tables
2600+else instance FlushJoinWord "TRUE" tables
2601+else instance FlushJoinWord "FALSE" tables
2602+else instance
2603+ ( Symbol.Cons head rest word
2604+ , FlushJoinWordByHead head word tables
2605+ ) =>
2606+ FlushJoinWord word tables
2607+
2608+class FlushJoinWordByHead :: Symbol -> Symbol -> Row (Row Type) -> Constraint
2609+class FlushJoinWordByHead head word tables
2610+
2611+instance FlushJoinWordByHead "$" word tables
2612+else instance FlushJoinWordByHead "0" word tables
2613+else instance FlushJoinWordByHead "1" word tables
2614+else instance FlushJoinWordByHead "2" word tables
2615+else instance FlushJoinWordByHead "3" word tables
2616+else instance FlushJoinWordByHead "4" word tables
2617+else instance FlushJoinWordByHead "5" word tables
2618+else instance FlushJoinWordByHead "6" word tables
2619+else instance FlushJoinWordByHead "7" word tables
2620+else instance FlushJoinWordByHead "8" word tables
2621+else instance FlushJoinWordByHead "9" word tables
2622+else instance ResolveColumn word tables typ => FlushJoinWordByHead head word tables
2623+
2624+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
2625+-- ON CONFLICT
2626+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
2627+
2628+class ParseConflictAction :: Symbol -> Row Type -> Constraint
2629+class ParseConflictAction sym cols
2630+
2631+instance
2632+ ( ExtractWord sym w1 rest1
2633+ , ExpectKeyword w1 "DO"
2634+ , ExtractWord rest1 w2 rest2
2635+ , ExpectKeyword w2 "UPDATE"
2636+ , ExtractWord rest2 w3 rest3
2637+ , ExpectKeyword w3 "SET"
2638+ , ParseAssignments rest3 cols
2639+ ) =>
2640+ ParseConflictAction sym cols
2641+
2642+class ExpectKeyword :: Symbol -> Symbol -> Constraint
2643+class ExpectKeyword actual expected
2644+
2645+instance ExpectKeyword a a
2646+else instance
2647+ Fail (Beside (Beside (Text "Expected keyword ") (Quote expected)) (Beside (Text " but got ") (Quote actual))) =>
2648+ ExpectKeyword actual expected
2649+
2650+class ParseAssignments :: Symbol -> Row Type -> Constraint
2651+class ParseAssignments sym cols
2652+
2653+instance ParseAssignments "" cols
2654+else instance
2655+ ( ExtractWord sym colName rest1
2656+ , Row.Cons colName colType colRest cols
2657+ , SkipSpaces rest1 rest2
2658+ , ExpectChar rest2 "=" rest3
2659+ , SkipSpaces rest3 rest4
2660+ , SkipExpression rest4 rest5
2661+ , ParseAssignmentsContinue rest5 cols
2662+ ) =>
2663+ ParseAssignments sym cols
2664+
2665+-- | Skip a SQL expression on the RHS of an assignment.
2666+-- | Handles balanced parentheses so that e.g. now() and
2667+-- | COALESCE(EXCLUDED.value, '') are consumed as a single expression.
2668+-- | Stops at an unparenthesised comma or end-of-string.
2669+class SkipExpression :: Symbol -> Symbol -> Constraint
2670+class SkipExpression sym rest | sym -> rest
2671+
2672+instance SkipExpression "" ""
2673+else instance
2674+ ( Symbol.Cons h t sym
2675+ , SkipExpressionGo h t rest
2676+ ) =>
2677+ SkipExpression sym rest
2678+
2679+class SkipExpressionGo :: Symbol -> Symbol -> Symbol -> Constraint
2680+class SkipExpressionGo head tail rest | head tail -> rest
2681+
2682+-- Comma at depth 0 → stop, keep comma in rest
2683+instance Symbol.Cons "," tail rest => SkipExpressionGo "," tail rest
2684+-- Open paren → enter nested expression
2685+else instance
2686+ ( SkipNested tail rest1
2687+ , SkipExpression rest1 rest
2688+ ) =>
2689+ SkipExpressionGo "(" tail rest
2690+-- Space → skip and continue (expressions can have spaces, e.g. "EXCLUDED.col")
2691+else instance (SkipSpaces tail rest1, SkipExpressionAfterSpace rest1 rest) => SkipExpressionGo " " tail rest
2692+-- End of string after this char
2693+else instance SkipExpressionGo h "" ""
2694+-- Regular char → continue
2695+else instance (Symbol.Cons h2 t2 tail, SkipExpressionGo h2 t2 rest) => SkipExpressionGo h tail rest
2696+
2697+-- | After a space in an expression, check if we've hit a comma or a new assignment (word = ...).
2698+-- | If the next word is a column name followed by '=', this is a new assignment, so stop.
2699+-- | Otherwise, continue the expression.
2700+class SkipExpressionAfterSpace :: Symbol -> Symbol -> Constraint
2701+class SkipExpressionAfterSpace sym rest | sym -> rest
2702+
2703+instance SkipExpressionAfterSpace "" ""
2704+else instance
2705+ ( Symbol.Cons h t sym
2706+ , SkipExpressionAfterSpaceGo h t sym rest
2707+ ) =>
2708+ SkipExpressionAfterSpace sym rest
2709+
2710+class SkipExpressionAfterSpaceGo :: Symbol -> Symbol -> Symbol -> Symbol -> Constraint
2711+class SkipExpressionAfterSpaceGo head tail sym rest | head tail sym -> rest
2712+
2713+-- Comma → stop
2714+instance Symbol.Cons "," tail rest => SkipExpressionAfterSpaceGo "," tail sym rest
2715+-- Otherwise continue the expression
2716+else instance (SkipExpressionGo h tail rest) => SkipExpressionAfterSpaceGo h tail sym rest
2717+
2718+-- | Skip a parenthesised group (after the opening paren has been consumed).
2719+-- | Handles nesting.
2720+class SkipNested :: Symbol -> Symbol -> Constraint
2721+class SkipNested sym rest | sym -> rest
2722+
2723+instance
2724+ ( Symbol.Cons h t sym
2725+ , SkipNestedGo h t rest
2726+ ) =>
2727+ SkipNested sym rest
2728+
2729+class SkipNestedGo :: Symbol -> Symbol -> Symbol -> Constraint
2730+class SkipNestedGo head tail rest | head tail -> rest
2731+
2732+-- Close paren → done
2733+instance SkipNestedGo ")" tail tail
2734+-- Open paren → recurse
2735+else instance (SkipNested tail rest1, SkipNested rest1 rest) => SkipNestedGo "(" tail rest
2736+-- Any other char → continue
2737+else instance (SkipNested tail rest) => SkipNestedGo h tail rest
2738+
2739+class ParseAssignmentsContinue :: Symbol -> Row Type -> Constraint
2740+class ParseAssignmentsContinue sym cols
2741+
2742+instance ParseAssignmentsContinue "" cols
2743+else instance
2744+ ( Symbol.Cons h t sym
2745+ , ParseAssignmentsContinueByHead h t cols
2746+ ) =>
2747+ ParseAssignmentsContinue sym cols
2748+
2749+class ParseAssignmentsContinueByHead :: Symbol -> Symbol -> Row Type -> Constraint
2750+class ParseAssignmentsContinueByHead head tail cols
2751+
2752+instance
2753+ ( SkipSpaces tail rest
2754+ , ParseAssignments rest cols
2755+ ) =>
2756+ ParseAssignmentsContinueByHead "," tail cols
2757+
2758+class ExpectChar :: Symbol -> Symbol -> Symbol -> Constraint
2759+class ExpectChar sym char rest | sym char -> rest
2760+
2761+instance
2762+ ( Symbol.Cons h t sym
2763+ , ExpectCharMatch h t char rest
2764+ ) =>
2765+ ExpectChar sym char rest
2766+
2767+class ExpectCharMatch :: Symbol -> Symbol -> Symbol -> Symbol -> Constraint
2768+class ExpectCharMatch head tail expected rest | head tail expected -> rest
2769+
2770+instance ExpectCharMatch c tail c tail
2771+else instance
2772+ Fail (Beside (Beside (Text "Expected '") (Quote expected)) (Beside (Text "' but got '") (Quote head))) =>
2773+ ExpectCharMatch head tail expected rest
2774+
2775+class ValidateExcludedRef :: Symbol -> Symbol -> Constraint
2776+class ValidateExcludedRef ref colName
2777+
2778+instance
2779+ ( Symbol.Append "EXCLUDED." colName expected
2780+ , MatchSymbol ref expected
2781+ ) =>
2782+ ValidateExcludedRef ref colName
2783+
2784+class MatchSymbol :: Symbol -> Symbol -> Constraint
2785+class MatchSymbol a b
2786+
2787+instance MatchSymbol a a
2788+else instance
2789+ Fail (Beside (Beside (Text "Expected ") (Quote expected)) (Beside (Text " but got ") (Quote actual))) =>
2790+ MatchSymbol actual expected
2791+
2792+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
2793+-- Type-level IsAutoGenerated (Boolean kind)
2794+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
2795+
2796+class IsAutoGeneratedTC :: Type -> Boolean -> Constraint
2797+class IsAutoGeneratedTC constraints result | constraints -> result
2798+
2799+instance IsAutoGeneratedTC (AutoIncrement a) True
2800+else instance IsAutoGeneratedTC (Default s a) True
2801+else instance IsAutoGeneratedTC (DefaultExpr expression a) True
2802+else instance IsAutoGeneratedTC a result => IsAutoGeneratedTC (PrimaryKey a) result
2803+else instance IsAutoGeneratedTC a result => IsAutoGeneratedTC (Unique a) result
2804+else instance IsAutoGeneratedTC a result => IsAutoGeneratedTC (ForeignKey t r c a) result
2805+else instance IsAutoGeneratedTC a result => IsAutoGeneratedTC (Nullable a) result
2806+else instance IsAutoGeneratedTC a False
2807+
2808+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
2809+-- InsertableColumnsRL: filter out auto-generated columns
2810+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
2811+
2812+class InsertableColumnsRL :: RL.RowList Type -> RL.RowList Type -> Constraint
2813+class InsertableColumnsRL tableRL outRL | tableRL -> outRL
2814+
2815+instance InsertableColumnsRL RL.Nil RL.Nil
2816+instance
2817+ ( IsAutoGeneratedTC entry isAuto
2818+ , ExtractType entry typ
2819+ , InsertableColumnDecide isAuto name typ tail outRL
2820+ ) =>
2821+ InsertableColumnsRL (RL.Cons name entry tail) outRL
2822+
2823+class InsertableColumnDecide :: Boolean -> Symbol -> Type -> RL.RowList Type -> RL.RowList Type -> Constraint
2824+class InsertableColumnDecide isAuto name typ tail outRL | isAuto name typ tail -> outRL
2825+
2826+instance InsertableColumnsRL tail outRL => InsertableColumnDecide True name typ tail outRL
2827+instance InsertableColumnsRL tail outRL => InsertableColumnDecide False name typ tail (RL.Cons name typ outRL)
2828+
2829+-- Split insertable columns into required (non-Maybe) and optional (Maybe)
2830+class RequiredColumnsRL :: RL.RowList Type -> RL.RowList Type -> Constraint
2831+class RequiredColumnsRL rl out | rl -> out
2832+
2833+instance RequiredColumnsRL RL.Nil RL.Nil
2834+instance RequiredColumnsRL tail out => RequiredColumnsRL (RL.Cons name (Maybe a) tail) out
2835+else instance RequiredColumnsRL tail out => RequiredColumnsRL (RL.Cons name typ tail) (RL.Cons name typ out)
2836+
2837+-- Generate column names from a RowList
2838+class ColumnNamesRL :: RL.RowList Type -> Constraint
2839+class ColumnNamesRL rl where
2840+ columnNamesRL :: Proxy rl -> Array String
2841+
2842+instance ColumnNamesRL RL.Nil where
2843+ columnNamesRL _ = []
2844+
2845+instance (IsSymbol name, ColumnNamesRL tail) => ColumnNamesRL (RL.Cons name typ tail) where
2846+ columnNamesRL _ = [ reflectSymbol (Proxy :: Proxy name) ] <> columnNamesRL (Proxy :: Proxy tail)
2847+
2848+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
2849+-- RecordValuesRL: extract record values in RowList order
2850+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
2851+
2852+class FieldToPGValue :: Type -> Constraint
2853+class FieldToPGValue a where
2854+ fieldToPGValue :: a -> PG.PGValue
2855+
2856+instance FieldToPGValue a => FieldToPGValue (Maybe a) where
2857+ fieldToPGValue = case _ of
2858+ Nothing -> unsafeCoerce (toNullable Nothing)
2859+ Just value -> fieldToPGValue value
2860+else instance FieldToPGValue DateTime where
2861+ fieldToPGValue = JSDate.fromDateTime >>> unsafeCoerce
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
2867+ fieldToPGValue = unsafeCoerce
2868+else instance WriteForeign a => FieldToPGValue a where
2869+ fieldToPGValue = writeImpl >>> unsafeCoerce
2870+
2871+class RecordValuesRL :: RL.RowList Type -> Row Type -> Constraint
2872+class RecordValuesRL rl row where
2873+ recordValuesRL :: Proxy rl -> { | row } -> Array PG.PGValue
2874+
2875+instance RecordValuesRL RL.Nil row where
2876+ recordValuesRL _ _ = []
2877+
2878+instance
2879+ ( IsSymbol name
2880+ , Row.Cons name typ rest row
2881+ , FieldToPGValue typ
2882+ , RecordValuesRL tail row
2883+ ) =>
2884+ RecordValuesRL (RL.Cons name typ tail) row where
2885+ recordValuesRL _ rec =
2886+ [ fieldToPGValue (Record.get (Proxy :: Proxy name) rec) ]
2887+ <> recordValuesRL (Proxy :: Proxy tail) rec
2888+
2889+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
2890+-- MakeNullableRL: wrap column types in Maybe for LEFT JOIN
2891+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
2892+
2893+class MakeNullableRL :: RL.RowList Type -> RL.RowList Type -> Constraint
2894+class MakeNullableRL rl out | rl -> out
2895+
2896+instance MakeNullableRL RL.Nil RL.Nil
2897+instance
2898+ ( ExtractType entry typ
2899+ , MakeNullableDecide typ name entry tail out
2900+ ) =>
2901+ MakeNullableRL (RL.Cons name entry tail) out
2902+
2903+class MakeNullableDecide :: Type -> Symbol -> Type -> RL.RowList Type -> RL.RowList Type -> Constraint
2904+class MakeNullableDecide typ name entry tail out | typ name entry tail -> out
2905+
2906+-- Already nullable: keep as-is
2907+instance MakeNullableRL tail out' => MakeNullableDecide (Maybe a) name entry tail (RL.Cons name entry out')
2908+-- Not nullable: wrap in Nullable
2909+else instance MakeNullableRL tail out' => MakeNullableDecide typ name entry tail (RL.Cons name (Nullable entry) out')
2910+
2911+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
2912+-- Query builder: unified Q type
2913+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
2914+
2915+newtype Q :: Row (Row Type) -> Row Type -> Row Type -> Row Type -> Type
2916+newtype Q tables result params stage = Q { sql :: String, values :: Array PG.PGValue }
2917+
2918+class HasClause :: Symbol -> Row Type -> Constraint
2919+class HasClause label row
2920+
2921+instance Row.Cons label Unit rest row => HasClause label row
2922+
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+
2951+toSQL :: forall tables result params stage. Q tables result params stage -> String
2952+toSQL (Q q) = q.sql
2953+
2954+from :: forall name cols tables. IsSymbol name => Row.Cons name cols () tables => Proxy (Table name cols) -> Q tables () () ()
2955+from _ = Q { sql: reflectSymbol (Proxy :: Proxy name), values: [] }
2956+
2957+fromAs :: forall @alias name cols tables. IsSymbol name => IsSymbol alias => Row.Cons alias cols () tables => Proxy (Table name cols) -> Q tables () () ()
2958+fromAs _ = Q { sql: reflectSymbol (Proxy :: Proxy name) <> " " <> reflectSymbol (Proxy :: Proxy alias), values: [] }
2959+
2960+into :: forall name cols tables. IsSymbol name => Row.Cons name cols () tables => Proxy (Table name cols) -> Q tables () () (into :: Unit)
2961+into _ = Q { sql: reflectSymbol (Proxy :: Proxy name), values: [] }
2962+
2963+update :: forall name cols tables. IsSymbol name => Row.Cons name cols () tables => Proxy (Table name cols) -> Q tables () () (update :: Unit)
2964+update _ = Q { sql: reflectSymbol (Proxy :: Proxy name), values: [] }
2965+
2966+selectAll
2967+ :: forall tables name cols result r p stage stage'
2968+ . SingleTable tables name cols
2969+ => IsSymbol name
2970+ => StripColumns cols result
2971+ => Row.Lacks "select" stage
2972+ => Row.Lacks "insert" stage
2973+ => Row.Lacks "into" stage
2974+ => Row.Lacks "set" stage
2975+ => Row.Lacks "delete" stage
2976+ => Row.Lacks "where" stage
2977+ => Row.Lacks "orderBy" stage
2978+ => Row.Lacks "limit" stage
2979+ => Row.Lacks "offset" stage
2980+ => Row.Cons "select" Unit stage stage'
2981+ => Q tables r p stage
2982+ -> Q tables result p stage'
2983+selectAll (Q q) = Q (q { sql = "SELECT * FROM " <> q.sql })
2984+
2985+select
2986+ :: forall @sel tables result r p stage stage'
2987+ . IsSymbol sel
2988+ => ParseSelect sel tables result
2989+ => Row.Lacks "select" stage
2990+ => Row.Lacks "insert" stage
2991+ => Row.Lacks "into" stage
2992+ => Row.Lacks "set" stage
2993+ => Row.Lacks "delete" stage
2994+ => Row.Lacks "where" stage
2995+ => Row.Lacks "orderBy" stage
2996+ => Row.Lacks "limit" stage
2997+ => Row.Lacks "offset" stage
2998+ => Row.Cons "select" Unit stage stage'
2999+ => Q tables r p stage
3000+ -> Q tables result p stage'
3001+select (Q q) = Q (q { sql = "SELECT " <> reflectSymbol (Proxy :: Proxy sel) <> " FROM " <> q.sql })
3002+
3003+selectDistinct
3004+ :: forall @sel tables result r p stage stage' stage''
3005+ . IsSymbol sel
3006+ => ParseSelect sel tables result
3007+ => Row.Lacks "select" stage
3008+ => Row.Lacks "insert" stage
3009+ => Row.Lacks "into" stage
3010+ => Row.Lacks "set" stage
3011+ => Row.Lacks "delete" stage
3012+ => Row.Lacks "where" stage
3013+ => Row.Lacks "orderBy" stage
3014+ => Row.Lacks "limit" stage
3015+ => Row.Lacks "offset" stage
3016+ => Row.Cons "select" Unit stage stage'
3017+ => Row.Cons "distinct" Unit stage' stage''
3018+ => Q tables r p stage
3019+ -> Q tables result p stage''
3020+selectDistinct (Q q) = Q (q { sql = "SELECT DISTINCT " <> reflectSymbol (Proxy :: Proxy sel) <> " FROM " <> q.sql })
3021+
3022+selectDistinctOn
3023+ :: forall @on @sel tables result r p stage stage'
3024+ . IsSymbol on
3025+ => IsSymbol sel
3026+ => ValidateColumnList on tables
3027+ => ParseSelect sel tables result
3028+ => Row.Lacks "select" stage
3029+ => Row.Lacks "insert" stage
3030+ => Row.Lacks "into" stage
3031+ => Row.Lacks "set" stage
3032+ => Row.Lacks "delete" stage
3033+ => Row.Lacks "where" stage
3034+ => Row.Lacks "orderBy" stage
3035+ => Row.Lacks "limit" stage
3036+ => Row.Lacks "offset" stage
3037+ => Row.Cons "select" Unit stage stage'
3038+ => Q tables r p stage
3039+ -> Q tables result p stage'
3040+selectDistinctOn (Q q) = Q (q { sql = "SELECT DISTINCT ON (" <> reflectSymbol (Proxy :: Proxy on) <> ") " <> reflectSymbol (Proxy :: Proxy sel) <> " FROM " <> q.sql })
3041+
3042+where_
3043+ :: forall @whr tables result params p stage stage'
3044+ . IsSymbol whr
3045+ => ParseWhere whr tables params
3046+ => HasAnyDML stage
3047+ => Row.Lacks "where" stage
3048+ => Row.Lacks "insert" stage
3049+ => Row.Lacks "groupBy" stage
3050+ => Row.Lacks "having" stage
3051+ => Row.Lacks "orderBy" stage
3052+ => Row.Lacks "limit" stage
3053+ => Row.Lacks "offset" stage
3054+ => Row.Cons "where" Unit stage stage'
3055+ => Q tables result p stage
3056+ -> Q tables result params stage'
3057+where_ (Q q) = Q (q { sql = q.sql <> " WHERE " <> reflectSymbol (Proxy :: Proxy whr) })
3058+
3059+orderBy
3060+ :: forall @cols tables result params stage stage'
3061+ . IsSymbol cols
3062+ => ValidateOrderBy cols tables
3063+ => CheckDistinctOrderBy stage cols result
3064+ => HasClause "select" stage
3065+ => Row.Lacks "orderBy" stage
3066+ => Row.Lacks "limit" stage
3067+ => Row.Lacks "offset" stage
3068+ => Row.Cons "orderBy" Unit stage stage'
3069+ => Q tables result params stage
3070+ -> Q tables result params stage'
3071+orderBy (Q q) = Q (q { sql = q.sql <> " ORDER BY " <> reflectSymbol (Proxy :: Proxy cols) })
3072+
3073+groupBy
3074+ :: forall @cols tables result params stage stage'
3075+ . IsSymbol cols
3076+ => ValidateColumnList cols tables
3077+ => HasClause "select" stage
3078+ => Row.Lacks "groupBy" stage
3079+ => Row.Lacks "having" stage
3080+ => Row.Lacks "orderBy" stage
3081+ => Row.Lacks "limit" stage
3082+ => Row.Lacks "offset" stage
3083+ => Row.Cons "groupBy" Unit stage stage'
3084+ => Q tables result params stage
3085+ -> Q tables result params stage'
3086+groupBy (Q q) = Q (q { sql = q.sql <> " GROUP BY " <> reflectSymbol (Proxy :: Proxy cols) })
3087+
3088+having
3089+ :: forall @cond tables result params havingParams allParams stage stage'
3090+ . IsSymbol cond
3091+ => ParseWhere cond tables havingParams
3092+ => Row.Union params havingParams allParams
3093+ => Row.Nub allParams allParams
3094+ => HasClause "groupBy" stage
3095+ => Row.Lacks "having" stage
3096+ => Row.Lacks "orderBy" stage
3097+ => Row.Lacks "limit" stage
3098+ => Row.Lacks "offset" stage
3099+ => Row.Cons "having" Unit stage stage'
3100+ => Q tables result params stage
3101+ -> Q tables result allParams stage'
3102+having (Q q) = Q (q { sql = q.sql <> " HAVING " <> reflectSymbol (Proxy :: Proxy cond) })
3103+
3104+class IsLimitParam :: Symbol -> Symbol -> Boolean -> Constraint
3105+class IsLimitParam head tail isParam | head tail -> isParam
3106+
3107+instance IsLimitParam "$" tail True
3108+else instance IsLimitParam head tail False
3109+
3110+class ParseLimitOffsetParams :: Boolean -> Symbol -> Row Type -> Row Type -> Constraint
3111+class ParseLimitOffsetParams isParam name params params' | isParam name params -> params'
3112+
3113+instance
3114+ ( Row.Lacks name params
3115+ , Row.Cons name Int params params'
3116+ ) =>
3117+ ParseLimitOffsetParams True name params params'
3118+
3119+instance ParseLimitOffsetParams False name params params
3120+
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+
3158+class ParseLimitOffset :: Symbol -> Row Type -> Row Type -> Constraint
3159+class ParseLimitOffset sym params params' | sym params -> params'
3160+
3161+instance
3162+ ( Symbol.Cons head tail sym
3163+ , IsLimitParam head tail isParam
3164+ , ParseLimitOffsetBranch isParam sym tail params params'
3165+ ) =>
3166+ ParseLimitOffset sym params params'
3167+
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+
3181+limit
3182+ :: forall @sym tables result params params' stage stage'
3183+ . ParseLimitOffset sym params params'
3184+ => IsSymbol sym
3185+ => HasClause "select" stage
3186+ => Row.Lacks "limit" stage
3187+ => Row.Cons "limit" Unit stage stage'
3188+ => Q tables result params stage
3189+ -> Q tables result params' stage'
3190+limit (Q q) = Q (q { sql = q.sql <> " LIMIT " <> reflectSymbol (Proxy :: Proxy sym) })
3191+
3192+offset
3193+ :: forall @sym tables result params params' stage stage'
3194+ . ParseLimitOffset sym params params'
3195+ => IsSymbol sym
3196+ => HasClause "select" stage
3197+ => Row.Lacks "offset" stage
3198+ => Row.Cons "offset" Unit stage stage'
3199+ => Q tables result params stage
3200+ -> Q tables result params' stage'
3201+offset (Q q) = Q (q { sql = q.sql <> " OFFSET " <> reflectSymbol (Proxy :: Proxy sym) })
3202+
3203+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
3204+-- INSERT builder
3205+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
3206+
3207+insert
3208+ :: forall tables name cols colsRL insertableRL insertable requiredRL required
3209+ optionalProvided missing userRow userRowRL stage stage'
3210+ . SingleTable tables name cols
3211+ => RowToList cols colsRL
3212+ => InsertableColumnsRL colsRL insertableRL
3213+ => ListToRow insertableRL insertable
3214+ => RequiredColumnsRL insertableRL requiredRL
3215+ => ListToRow requiredRL required
3216+ => Row.Union required optionalProvided userRow
3217+ => Row.Union userRow missing insertable
3218+ => RowToList userRow userRowRL
3219+ => ColumnNamesRL userRowRL
3220+ => RecordValuesRL userRowRL userRow
3221+ => IsSymbol name
3222+ => Row.Lacks "select" stage
3223+ => Row.Lacks "insert" stage
3224+ => Row.Lacks "set" stage
3225+ => Row.Lacks "delete" stage
3226+ => Row.Cons "insert" Unit stage stage'
3227+ => { | userRow }
3228+ -> Q tables () () stage
3229+ -> Q tables () () stage'
3230+insert rec _ = Q { sql, values }
3231+ where
3232+ tableName = reflectSymbol (Proxy :: Proxy name)
3233+ colNames = columnNamesRL (Proxy :: Proxy userRowRL)
3234+ placeholders = colNames # mapWithIndex \i _ -> "$" <> show (i + 1)
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+ <> ")"
3246+ values = recordValuesRL (Proxy :: Proxy userRowRL) rec
3247+
3248+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
3249+-- RETURNING clause
3250+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
3251+
3252+returning
3253+ :: forall @sel tables name cols result p stage stage'
3254+ . SingleTable tables name cols
3255+ => IsSymbol sel
3256+ => ParseSelect sel tables result
3257+ => HasMutation stage
3258+ => Row.Lacks "returning" stage
3259+ => Row.Lacks "select" stage
3260+ => Row.Cons "returning" Unit stage stage'
3261+ => Q tables () p stage
3262+ -> Q tables result p stage'
3263+returning (Q q) = Q (q { sql = q.sql <> " RETURNING " <> reflectSymbol (Proxy :: Proxy sel) })
3264+
3265+returningAll
3266+ :: forall tables name cols result p stage stage'
3267+ . SingleTable tables name cols
3268+ => StripColumns cols result
3269+ => HasMutation stage
3270+ => Row.Lacks "returning" stage
3271+ => Row.Lacks "select" stage
3272+ => Row.Cons "returning" Unit stage stage'
3273+ => Q tables () p stage
3274+ -> Q tables result p stage'
3275+returningAll (Q q) = Q (q { sql = q.sql <> " RETURNING *" })
3276+
3277+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
3278+-- UPDATE builder (SET)
3279+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
3280+
3281+class ValidateSetColumnsRL :: RL.RowList Type -> Row Type -> Constraint
3282+class ValidateSetColumnsRL rl cols
3283+
3284+instance ValidateSetColumnsRL RL.Nil cols
3285+instance
3286+ ( Row.Cons name entry rest cols
3287+ , ExtractType entry typ
3288+ , ValidateSetColumnsRL tail cols
3289+ ) =>
3290+ ValidateSetColumnsRL (RL.Cons name typ tail) cols
3291+
3292+class SetClauseRL :: RL.RowList Type -> Constraint
3293+class SetClauseRL rl where
3294+ setClauseRL :: Proxy rl -> Int -> Array String
3295+
3296+instance SetClauseRL RL.Nil where
3297+ setClauseRL _ _ = []
3298+
3299+instance (IsSymbol name, SetClauseRL tail) => SetClauseRL (RL.Cons name typ tail) where
3300+ setClauseRL _ idx =
3301+ [ reflectSymbol (Proxy :: Proxy name) <> " = $" <> show idx ]
3302+ <> setClauseRL (Proxy :: Proxy tail) (idx + 1)
3303+
3304+set
3305+ :: forall tables name cols setRow setRL stage stage'
3306+ . SingleTable tables name cols
3307+ => RowToList setRow setRL
3308+ => IsSymbol name
3309+ => ValidateSetColumnsRL setRL cols
3310+ => SetClauseRL setRL
3311+ => RecordValuesRL setRL setRow
3312+ => HasClause "update" stage
3313+ => Row.Lacks "select" stage
3314+ => Row.Lacks "insert" stage
3315+ => Row.Lacks "into" stage
3316+ => Row.Lacks "set" stage
3317+ => Row.Lacks "delete" stage
3318+ => Row.Cons "set" Unit stage stage'
3319+ => { | setRow }
3320+ -> Q tables () () stage
3321+ -> Q tables () () stage'
3322+set rec _ = Q { sql, values }
3323+ where
3324+ tableName = reflectSymbol (Proxy :: Proxy name)
3325+ setClauses = setClauseRL (Proxy :: Proxy setRL) 1
3326+ sql = "UPDATE " <> tableName <> " SET " <> intercalate ", " setClauses
3327+ values = recordValuesRL (Proxy :: Proxy setRL) rec
3328+
3329+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
3330+-- DELETE builder
3331+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
3332+
3333+delete
3334+ :: forall tables name cols r p stage stage'
3335+ . SingleTable tables name cols
3336+ => IsSymbol name
3337+ => Row.Lacks "select" stage
3338+ => Row.Lacks "insert" stage
3339+ => Row.Lacks "into" stage
3340+ => Row.Lacks "set" stage
3341+ => Row.Lacks "delete" stage
3342+ => Row.Cons "delete" Unit stage stage'
3343+ => Q tables r p stage
3344+ -> Q tables () () stage'
3345+delete _ = Q { sql: "DELETE FROM " <> reflectSymbol (Proxy :: Proxy name), values: [] }
3346+
3347+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
3348+-- ON CONFLICT
3349+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
3350+
3351+onConflict
3352+ :: forall @target @action tables name cols result params stage stage'
3353+ . SingleTable tables name cols
3354+ => IsSymbol target
3355+ => IsSymbol action
3356+ => ValidateColumns target cols
3357+ => ParseConflictAction action cols
3358+ => HasClause "insert" stage
3359+ => Row.Lacks "conflict" stage
3360+ => Row.Cons "conflict" Unit stage stage'
3361+ => Q tables result params stage
3362+ -> Q tables result params stage'
3363+onConflict (Q q) = Q
3364+ ( q
3365+ { sql = q.sql
3366+ <> " ON CONFLICT ("
3367+ <> reflectSymbol (Proxy :: Proxy target)
3368+ <> ") "
3369+ <> reflectSymbol (Proxy :: Proxy action)
3370+ }
3371+ )
3372+
3373+onConflictDoNothing
3374+ :: forall @target tables name cols result params stage stage'
3375+ . SingleTable tables name cols
3376+ => IsSymbol target
3377+ => ValidateColumns target cols
3378+ => HasClause "insert" stage
3379+ => Row.Lacks "conflict" stage
3380+ => Row.Cons "conflict" Unit stage stage'
3381+ => Q tables result params stage
3382+ -> Q tables result params stage'
3383+onConflictDoNothing (Q q) = Q
3384+ ( q
3385+ { sql = q.sql
3386+ <> " ON CONFLICT ("
3387+ <> reflectSymbol (Proxy :: Proxy target)
3388+ <> ") DO NOTHING"
3389+ }
3390+ )
3391+
3392+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
3393+-- JOIN builders
3394+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
3395+
3396+innerJoin
3397+ :: forall @cond name cols tables tables' r p stage
3398+ . IsSymbol name
3399+ => IsSymbol cond
3400+ => Row.Lacks name tables
3401+ => Row.Cons name cols tables tables'
3402+ => ValidateJoinCondition cond tables'
3403+ => Row.Lacks "select" stage
3404+ => Row.Lacks "insert" stage
3405+ => Row.Lacks "set" stage
3406+ => Row.Lacks "delete" stage
3407+ => Proxy (Table name cols)
3408+ -> Q tables r p stage
3409+ -> Q tables' () () (join :: Unit)
3410+innerJoin _ (Q q) = Q
3411+ { sql: q.sql
3412+ <> " INNER JOIN "
3413+ <> reflectSymbol (Proxy :: Proxy name)
3414+ <> " ON "
3415+ <> reflectSymbol (Proxy :: Proxy cond)
3416+ , values: q.values
3417+ }
3418+
3419+leftJoin
3420+ :: forall @cond name cols colsRL nullableColsRL nullableCols tables tables' r p stage
3421+ . IsSymbol name
3422+ => IsSymbol cond
3423+ => RowToList cols colsRL
3424+ => MakeNullableRL colsRL nullableColsRL
3425+ => ListToRow nullableColsRL nullableCols
3426+ => Row.Lacks name tables
3427+ => Row.Cons name nullableCols tables tables'
3428+ => ValidateJoinCondition cond tables'
3429+ => Row.Lacks "select" stage
3430+ => Row.Lacks "insert" stage
3431+ => Row.Lacks "set" stage
3432+ => Row.Lacks "delete" stage
3433+ => Proxy (Table name cols)
3434+ -> Q tables r p stage
3435+ -> Q tables' () () (join :: Unit)
3436+leftJoin _ (Q q) = Q
3437+ { sql: q.sql
3438+ <> " LEFT JOIN "
3439+ <> reflectSymbol (Proxy :: Proxy name)
3440+ <> " ON "
3441+ <> reflectSymbol (Proxy :: Proxy cond)
3442+ , values: q.values
3443+ }
3444+
3445+innerJoinAs
3446+ :: forall @alias @cond name cols tables tables' r p stage
3447+ . IsSymbol name
3448+ => IsSymbol alias
3449+ => IsSymbol cond
3450+ => Row.Lacks alias tables
3451+ => Row.Cons alias cols tables tables'
3452+ => ValidateJoinCondition cond tables'
3453+ => Row.Lacks "select" stage
3454+ => Row.Lacks "insert" stage
3455+ => Row.Lacks "set" stage
3456+ => Row.Lacks "delete" stage
3457+ => Proxy (Table name cols)
3458+ -> Q tables r p stage
3459+ -> Q tables' () () (join :: Unit)
3460+innerJoinAs _ (Q q) = Q
3461+ { sql: q.sql
3462+ <> " INNER JOIN "
3463+ <> reflectSymbol (Proxy :: Proxy name)
3464+ <> " "
3465+ <> reflectSymbol (Proxy :: Proxy alias)
3466+ <> " ON "
3467+ <> reflectSymbol (Proxy :: Proxy cond)
3468+ , values: q.values
3469+ }
3470+
3471+leftJoinAs
3472+ :: forall @alias @cond name cols colsRL nullableColsRL nullableCols tables tables' r p stage
3473+ . IsSymbol name
3474+ => IsSymbol alias
3475+ => IsSymbol cond
3476+ => RowToList cols colsRL
3477+ => MakeNullableRL colsRL nullableColsRL
3478+ => ListToRow nullableColsRL nullableCols
3479+ => Row.Lacks alias tables
3480+ => Row.Cons alias nullableCols tables tables'
3481+ => ValidateJoinCondition cond tables'
3482+ => Row.Lacks "select" stage
3483+ => Row.Lacks "insert" stage
3484+ => Row.Lacks "set" stage
3485+ => Row.Lacks "delete" stage
3486+ => Proxy (Table name cols)
3487+ -> Q tables r p stage
3488+ -> Q tables' () () (join :: Unit)
3489+leftJoinAs _ (Q q) = Q
3490+ { sql: q.sql
3491+ <> " LEFT JOIN "
3492+ <> reflectSymbol (Proxy :: Proxy name)
3493+ <> " "
3494+ <> reflectSymbol (Proxy :: Proxy alias)
3495+ <> " ON "
3496+ <> reflectSymbol (Proxy :: Proxy cond)
3497+ , values: q.values
3498+ }
3499+
3500+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
3501+-- Set operations: UNION, INTERSECT, EXCEPT
3502+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
3503+
3504+type SetOpStage =
3505+ ( select :: Unit
3506+ , "where" :: Unit
3507+ , groupBy :: Unit
3508+ , having :: Unit
3509+ , insert :: Unit
3510+ , "set" :: Unit
3511+ , "delete" :: Unit
3512+ )
3513+
3514+union
3515+ :: forall tables1 tables2 result params1 params2 params stage1 stage2
3516+ . HasClause "select" stage1
3517+ => HasClause "select" stage2
3518+ => Row.Union params1 params2 params
3519+ => Row.Nub params params
3520+ => Q tables1 result params1 stage1
3521+ -> Q tables2 result params2 stage2
3522+ -> Q tables1 result params SetOpStage
3523+union (Q q1) (Q q2) = Q { sql: "(" <> q1.sql <> ") UNION (" <> q2.sql <> ")", values: q1.values <> q2.values }
3524+
3525+unionAll
3526+ :: forall tables1 tables2 result params1 params2 params stage1 stage2
3527+ . HasClause "select" stage1
3528+ => HasClause "select" stage2
3529+ => Row.Union params1 params2 params
3530+ => Row.Nub params params
3531+ => Q tables1 result params1 stage1
3532+ -> Q tables2 result params2 stage2
3533+ -> Q tables1 result params SetOpStage
3534+unionAll (Q q1) (Q q2) = Q { sql: "(" <> q1.sql <> ") UNION ALL (" <> q2.sql <> ")", values: q1.values <> q2.values }
3535+
3536+intersect
3537+ :: forall tables1 tables2 result params1 params2 params stage1 stage2
3538+ . HasClause "select" stage1
3539+ => HasClause "select" stage2
3540+ => Row.Union params1 params2 params
3541+ => Row.Nub params params
3542+ => Q tables1 result params1 stage1
3543+ -> Q tables2 result params2 stage2
3544+ -> Q tables1 result params SetOpStage
3545+intersect (Q q1) (Q q2) = Q { sql: "(" <> q1.sql <> ") INTERSECT (" <> q2.sql <> ")", values: q1.values <> q2.values }
3546+
3547+intersectAll
3548+ :: forall tables1 tables2 result params1 params2 params stage1 stage2
3549+ . HasClause "select" stage1
3550+ => HasClause "select" stage2
3551+ => Row.Union params1 params2 params
3552+ => Row.Nub params params
3553+ => Q tables1 result params1 stage1
3554+ -> Q tables2 result params2 stage2
3555+ -> Q tables1 result params SetOpStage
3556+intersectAll (Q q1) (Q q2) = Q { sql: "(" <> q1.sql <> ") INTERSECT ALL (" <> q2.sql <> ")", values: q1.values <> q2.values }
3557+
3558+except_
3559+ :: forall tables1 tables2 result params1 params2 params stage1 stage2
3560+ . HasClause "select" stage1
3561+ => HasClause "select" stage2
3562+ => Row.Union params1 params2 params
3563+ => Row.Nub params params
3564+ => Q tables1 result params1 stage1
3565+ -> Q tables2 result params2 stage2
3566+ -> Q tables1 result params SetOpStage
3567+except_ (Q q1) (Q q2) = Q { sql: "(" <> q1.sql <> ") EXCEPT (" <> q2.sql <> ")", values: q1.values <> q2.values }
3568+
3569+exceptAll
3570+ :: forall tables1 tables2 result params1 params2 params stage1 stage2
3571+ . HasClause "select" stage1
3572+ => HasClause "select" stage2
3573+ => Row.Union params1 params2 params
3574+ => Row.Nub params params
3575+ => Q tables1 result params1 stage1
3576+ -> Q tables2 result params2 stage2
3577+ -> Q tables1 result params SetOpStage
3578+exceptAll (Q q1) (Q q2) = Q { sql: "(" <> q1.sql <> ") EXCEPT ALL (" <> q2.sql <> ")", values: q1.values <> q2.values }
3579+
3580+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
3581+-- CTE (WITH clause) support
3582+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
3583+
3584+newtype WithCTEs :: Row (Row Type) -> Row Type -> Type
3585+newtype WithCTEs cteTables cteParams = WithCTEs
3586+ { sql :: String, values :: Array PG.PGValue }
3587+
3588+-- Wrap a complete SELECT query as a named CTE
3589+cte
3590+ :: forall @name tables result params stage cteTables
3591+ . IsSymbol name
3592+ => HasClause "select" stage
3593+ => Row.Cons name result () cteTables
3594+ => Q tables result params stage
3595+ -> WithCTEs cteTables params
3596+cte (Q q) = WithCTEs
3597+ { sql: reflectSymbol (Proxy :: Proxy name) <> " AS (" <> q.sql <> ")"
3598+ , values: q.values
3599+ }
3600+
3601+-- Add another named CTE to an accumulator
3602+andCTE
3603+ :: forall @name tables result params stage cteTables cteParams cteTables' cteParams'
3604+ . IsSymbol name
3605+ => HasClause "select" stage
3606+ => Row.Lacks name cteTables
3607+ => Row.Cons name result cteTables cteTables'
3608+ => Row.Union cteParams params cteParams'
3609+ => Row.Nub cteParams' cteParams'
3610+ => Q tables result params stage
3611+ -> WithCTEs cteTables cteParams
3612+ -> WithCTEs cteTables' cteParams'
3613+andCTE (Q q) (WithCTEs w) = WithCTEs
3614+ { sql: w.sql <> ", " <> reflectSymbol (Proxy :: Proxy name) <> " AS (" <> q.sql <> ")"
3615+ , values: w.values <> q.values
3616+ }
3617+
3618+-- Start main query FROM a named CTE; cteTables becomes available as tables
3619+fromCTE
3620+ :: forall @name result restTables cteTables cteParams
3621+ . IsSymbol name
3622+ => Row.Cons name result restTables cteTables
3623+ => WithCTEs cteTables cteParams
3624+ -> Q cteTables () () ()
3625+fromCTE _ = Q { sql: reflectSymbol (Proxy :: Proxy name), values: [] }
3626+
3627+-- Finalize: prepend WITH clause and merge params
3628+with_
3629+ :: forall cteTables cteParams mainParams allParams result stage
3630+ . Row.Union cteParams mainParams allParams
3631+ => Row.Nub allParams allParams
3632+ => WithCTEs cteTables cteParams
3633+ -> Q cteTables result mainParams stage
3634+ -> Q cteTables result allParams stage
3635+with_ (WithCTEs w) (Q q) = Q
3636+ { sql: "WITH " <> w.sql <> " " <> q.sql
3637+ , values: w.values <> q.values
3638+ }
3639+
3640+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
3641+-- Query execution
3642+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
3643+
3644+class ParamsToArray :: RL.RowList Type -> Row Type -> Constraint
3645+class ParamsToArray rl row where
3646+ paramsToArray :: Proxy rl -> { | row } -> Array { name :: String, value :: Foreign }
3647+
3648+instance ParamsToArray RL.Nil row where
3649+ paramsToArray _ _ = []
3650+
3651+instance
3652+ ( IsSymbol name
3653+ , Row.Cons name typ rest row
3654+ , Row.Lacks name rest
3655+ , FieldToPGValue typ
3656+ , ParamsToArray tail row
3657+ ) =>
3658+ ParamsToArray (RL.Cons name typ tail) row where
3659+ paramsToArray _ rec =
3660+ [ { name: reflectSymbol (Proxy :: Proxy name)
3661+ , value: unsafeCoerce (fieldToPGValue (Record.get (Proxy :: Proxy name) rec))
3662+ }
3663+ ]
3664+ <> paramsToArray (Proxy :: Proxy tail) rec
3665+
3666+namedParamRegex :: Regex.Regex
3667+namedParamRegex = case Regex.regex "\\$[a-zA-Z_][a-zA-Z0-9_]*(::[a-zA-Z_]+)?" Regex.global of
3668+ Right r -> r
3669+ Left _ -> unsafeCoerce unit
3670+
3671+stripCast :: String -> String
3672+stripCast s = case SCU.indexOf (Pattern "::") s of
3673+ Nothing -> s
3674+ Just i -> SCU.take i s
3675+
3676+replaceNamedParams :: Int -> Array { name :: String, value :: Foreign } -> String -> { sql :: String, values :: Array PG.PGValue }
3677+replaceNamedParams offset entries sql = do
3678+ let indexed = entries # mapWithIndex \i e -> { idx: offset + i + 1, name: e.name, value: e.value }
3679+ let replacements = indexed # foldl (\m e -> Map.insert ("$" <> e.name) ("$" <> show e.idx) m) Map.empty
3680+ let
3681+ sql' = Regex.replace' namedParamRegex
3682+ ( \match _ -> case Map.lookup (stripCast match) replacements of
3683+ Nothing -> match
3684+ Just v -> v
3685+ )
3686+ sql
3687+ { sql: sql', values: map (\e -> unsafeCoerce e.value) indexed }
3688+
3689+runQuery
3690+ :: forall tables result params paramsRL stage
3691+ . RowToList params paramsRL
3692+ => ParamsToArray paramsRL params
3693+ => ReadForeign { | result }
3694+ => PG.Connection
3695+ -> { | params }
3696+ -> Q tables result params stage
3697+ -> Aff (Array { | result })
3698+runQuery conn params (Q q) = do
3699+ let entries = paramsToArray (Proxy :: Proxy paramsRL) params
3700+ let { sql, values } = replaceNamedParams (Array.length q.values) entries q.sql
3701+ let allValues = q.values <> values
3702+ result <- PG.query (PG.SQL sql) allValues conn
3703+ case decodeRows result.rows of
3704+ Left errs -> throwError (Exception.error ("Row decode failed: " <> show errs))
3705+ Right rows -> pure rows
3706+
3707+runQueryOne
3708+ :: forall tables result params paramsRL stage
3709+ . RowToList params paramsRL
3710+ => ParamsToArray paramsRL params
3711+ => ReadForeign { | result }
3712+ => PG.Connection
3713+ -> { | params }
3714+ -> Q tables result params stage
3715+ -> Aff (Maybe { | result })
3716+runQueryOne conn params (Q q) = do
3717+ let entries = paramsToArray (Proxy :: Proxy paramsRL) params
3718+ let { sql, values } = replaceNamedParams (Array.length q.values) entries q.sql
3719+ let allValues = q.values <> values
3720+ result <- PG.queryOne (PG.SQL sql) allValues conn
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)
3726+
3727+runExecute
3728+ :: forall tables params paramsRL stage
3729+ . RowToList params paramsRL
3730+ => ParamsToArray paramsRL params
3731+ => PG.Connection
3732+ -> { | params }
3733+ -> Q tables () params stage
3734+ -> Aff Int
3735+runExecute conn params (Q q) = do
3736+ let entries = paramsToArray (Proxy :: Proxy paramsRL) params
3737+ let { sql, values } = replaceNamedParams (Array.length q.values) entries q.sql
3738+ let allValues = q.values <> values
3739+ PG.execute (PG.SQL sql) allValues conn
3740+
3741+-- Transaction variants
3742+
3743+runQueryTx
3744+ :: forall tables result params paramsRL stage
3745+ . RowToList params paramsRL
3746+ => ParamsToArray paramsRL params
3747+ => ReadForeign { | result }
3748+ => PG.Transaction
3749+ -> { | params }
3750+ -> Q tables result params stage
3751+ -> Aff (Array { | result })
3752+runQueryTx txn params (Q q) = do
3753+ let entries = paramsToArray (Proxy :: Proxy paramsRL) params
3754+ let { sql, values } = replaceNamedParams (Array.length q.values) entries q.sql
3755+ let allValues = q.values <> values
3756+ result <- PG.txQuery (PG.SQL sql) allValues txn
3757+ case decodeRows result.rows of
3758+ Left errs -> throwError (Exception.error ("Row decode failed: " <> show errs))
3759+ Right rows -> pure rows
3760+
3761+runExecuteTx
3762+ :: forall tables params paramsRL stage
3763+ . RowToList params paramsRL
3764+ => ParamsToArray paramsRL params
3765+ => PG.Transaction
3766+ -> { | params }
3767+ -> Q tables () params stage
3768+ -> Aff Int
3769+runExecuteTx txn params (Q q) = do
3770+ let entries = paramsToArray (Proxy :: Proxy paramsRL) params
3771+ let { sql, values } = replaceNamedParams (Array.length q.values) entries q.sql
3772+ let allValues = q.values <> values
3773+ PG.txExecute (PG.SQL sql) allValues txn
3774+
3775+
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
2+
3+import Prelude
4+
5+import Control.Parallel (parTraverse)
6+import Data.Array as Array
7+import Data.Date (canonicalDate)
8+import Data.DateTime (DateTime(..))
9+import Data.Either (Either(..))
10+import Data.Enum (toEnum)
11+import Data.Maybe (Maybe(..), fromJust)
12+import Data.Identity (Identity)
13+import Data.Time (Time(..))
14+import Data.Time.Duration (Milliseconds(..))
15+import Data.UUID as UUID
16+import Effect (Effect)
17+import Effect.Aff (Aff, delay, forkAff, killFiber, throwError, try)
18+import Effect.Class (liftEffect)
19+import Effect.Exception (error, message)
20+import Effect.Ref as Ref
21+import Effect.Uncurried (EffectFn1, runEffectFn1)
22+import Foreign (unsafeToForeign)
23+import JS.BigInt (BigInt)
24+import JS.BigInt as BigInt
25+import Partial.Unsafe (unsafePartial)
26+import Prim.Boolean (True)
27+import Test.Spec (Spec, SpecT, describe, it)
28+import Test.Spec.Assertions (shouldEqual, shouldSatisfy)
29+import Type.Function (type (#))
30+import Type.Proxy (Proxy(..))
31+import Yoga.Postgres as PG
32+import Yoga.Postgres.Schema as Schema
33+import Yoga.Postgres.TypedQuery as Typed
34+import Yoga.SQL.PostgresTypes (SQLQuery, arg, combineBuilders, int, sql, str)
35+
36+isLeft :: forall a b. Either a b -> Boolean
37+isLeft (Left _) = true
38+isLeft _ = false
39+
40+poisonRollback :: PG.Transaction -> Effect Unit
41+poisonRollback = runEffectFn1 poisonRollbackImpl
42+
43+foreign import poisonRollbackImpl :: EffectFn1 PG.Transaction Unit
44+
45+testConnection :: Effect PG.Connection
46+testConnection = PG.postgres
47+ { host: PG.PostgresHost "localhost"
48+ , port: PG.PostgresPort 5434
49+ , database: PG.PostgresDatabase "test_playground"
50+ , username: PG.PostgresUsername "postgres"
51+ , password: PG.PostgresPassword "postgres"
52+ }
53+
54+type BehaviorTable = Schema.Table "behavior_values"
55+ ( id :: Int # Schema.PrimaryKey # Schema.AutoIncrement
56+ , name :: String
57+ , optional_int :: Maybe Int
58+ )
59+
60+behaviorTable :: Proxy BehaviorTable
61+behaviorTable = Proxy
62+
63+type AllDefaultTable = Schema.Table "behavior_defaults"
64+ ( active :: Boolean # Schema.Default True
65+ , id :: Int # Schema.PrimaryKey # Schema.AutoIncrement
66+ )
67+
68+allDefaultTable :: Proxy AllDefaultTable
69+allDefaultTable = Proxy
70+
71+type TxTable = Schema.Table "behavior_tx"
72+ ( id :: Int # Schema.PrimaryKey # Schema.AutoIncrement
73+ , name :: String
74+ )
75+
76+txTable :: Proxy TxTable
77+txTable = Proxy
78+
79+type TemporalParamTable = Schema.Table "behavior_temporal"
80+ ( document :: Schema.Jsonb
81+ , event_at :: Schema.TimestampTZ
82+ , event_date :: Schema.PGDate
83+ , event_time :: Schema.PGTime
84+ , label :: String
85+ , uuid :: Schema.PGUUID
86+ , optional_event_at :: Maybe Schema.TimestampTZ
87+ )
88+
89+temporalParamTable :: Proxy TemporalParamTable
90+temporalParamTable = Proxy
91+
92+typedIntQuery :: SQLQuery (n :: Int)
93+typedIntQuery = sql $ combineBuilders (combineBuilders "SELECT " (int @"n")) "::int AS n"
94+
95+typedMaybeQuery :: SQLQuery (value :: Maybe Int)
96+typedMaybeQuery = sql $ combineBuilders (combineBuilders "SELECT " (arg @(Maybe Int) @"value")) "::int AS value"
97+
98+typedBadDecodeQuery :: SQLQuery ()
99+typedBadDecodeQuery = sql $ combineBuilders "SELECT 'not-an-int' AS n" ""
100+
101+typedMutationQuery :: SQLQuery (name :: String)
102+typedMutationQuery = sql $ combineBuilders (combineBuilders "INSERT INTO behavior_values (name) VALUES (" (str @"name")) ")"
103+
104+expectedDate :: Schema.PGDate
105+expectedDate = unsafePartial do
106+ let year = fromJust (toEnum 2025)
107+ let month = fromJust (toEnum 6)
108+ let day = fromJust (toEnum 15)
109+ Schema.PGDate (canonicalDate year month day)
110+
111+expectedTime :: Schema.PGTime
112+expectedTime = unsafePartial do
113+ let hour = fromJust (toEnum 14)
114+ let minute = fromJust (toEnum 30)
115+ let second = fromJust (toEnum 45)
116+ let millisecond = fromJust (toEnum 125)
117+ Schema.PGTime (Time hour minute second millisecond)
118+
119+expectedHalfSecondTime :: Schema.PGTime
120+expectedHalfSecondTime = unsafePartial do
121+ let hour = fromJust (toEnum 14)
122+ let minute = fromJust (toEnum 30)
123+ let second = fromJust (toEnum 45)
124+ let millisecond = fromJust (toEnum 500)
125+ Schema.PGTime (Time hour minute second millisecond)
126+
127+expectedTimestamp :: Schema.TimestampTZ
128+expectedTimestamp = unsafePartial do
129+ let year = fromJust (toEnum 2025)
130+ let month = fromJust (toEnum 1)
131+ let day = fromJust (toEnum 15)
132+ let hour = fromJust (toEnum 12)
133+ let minute = fromJust (toEnum 0)
134+ let second = fromJust (toEnum 0)
135+ let millisecond = fromJust (toEnum 0)
136+ Schema.TimestampTZ (DateTime (canonicalDate year month day) (Time hour minute second millisecond))
137+
138+setupBehaviorTable :: PG.Connection -> Aff Unit
139+setupBehaviorTable conn = do
140+ _ <- PG.executeSimple (PG.SQL "DROP TABLE IF EXISTS behavior_values") conn
141+ _ <- PG.executeSimple (PG.SQL (Schema.createTableDDL @BehaviorTable)) conn
142+ pure unit
143+
144+setupTxTable :: PG.Connection -> Aff Unit
145+setupTxTable conn = do
146+ _ <- PG.executeSimple (PG.SQL "DROP TABLE IF EXISTS behavior_tx") conn
147+ _ <- PG.executeSimple (PG.SQL (Schema.createTableDDL @TxTable)) conn
148+ pure unit
149+
150+setupTemporalParamTable :: PG.Connection -> Aff Unit
151+setupTemporalParamTable conn = do
152+ _ <- PG.executeSimple (PG.SQL "DROP TABLE IF EXISTS behavior_temporal") conn
153+ _ <- PG.executeSimple (PG.SQL (Schema.createTableDDL @TemporalParamTable)) conn
154+ pure unit
155+
156+pureSpec :: Spec Unit
157+pureSpec = do
158+ describe "Postgres schema metadata and deterministic SQL" do
159+ it "renders every public scalar, array, and nullable type name" do
160+ Schema.pgTypeName (Proxy :: Proxy Int) `shouldEqual` "INTEGER"
161+ Schema.pgTypeName (Proxy :: Proxy String) `shouldEqual` "TEXT"
162+ Schema.pgTypeName (Proxy :: Proxy Boolean) `shouldEqual` "BOOLEAN"
163+ Schema.pgTypeName (Proxy :: Proxy Number) `shouldEqual` "DOUBLE PRECISION"
164+ Schema.pgTypeName (Proxy :: Proxy BigInt) `shouldEqual` "BIGINT"
165+ Schema.pgTypeName (Proxy :: Proxy Schema.PGUUID) `shouldEqual` "UUID"
166+ Schema.pgTypeName (Proxy :: Proxy Schema.PGDate) `shouldEqual` "DATE"
167+ Schema.pgTypeName (Proxy :: Proxy Schema.PGTime) `shouldEqual` "TIME"
168+ Schema.pgTypeName (Proxy :: Proxy Schema.TimestampTZ) `shouldEqual` "TIMESTAMPTZ"
169+ Schema.pgTypeName (Proxy :: Proxy Schema.Point) `shouldEqual` "POINT"
170+ Schema.pgTypeName (Proxy :: Proxy Schema.TSVector) `shouldEqual` "TSVECTOR"
171+ Schema.pgTypeName (Proxy :: Proxy Schema.TSQuery) `shouldEqual` "TSQUERY"
172+ Schema.pgTypeName (Proxy :: Proxy Schema.Jsonb) `shouldEqual` "JSONB"
173+ Schema.pgTypeName (Proxy :: Proxy (Array Int)) `shouldEqual` "INTEGER[]"
174+ Schema.pgTypeName (Proxy :: Proxy (Maybe Int)) `shouldEqual` "INTEGER"
175+
176+ it "reports nullability from Maybe only" do
177+ Schema.isNullable (Proxy :: Proxy (Maybe Int)) `shouldEqual` true
178+ Schema.isNullable (Proxy :: Proxy Int) `shouldEqual` false
179+
180+ it "renders IF NOT EXISTS and DEFAULT VALUES DDL" do
181+ Schema.createTableDDLIfNotExists @BehaviorTable
182+ `shouldEqual` "CREATE TABLE IF NOT EXISTS behavior_values (id INTEGER NOT NULL GENERATED ALWAYS AS IDENTITY PRIMARY KEY, name TEXT NOT NULL, optional_int INTEGER)"
183+ Schema.insertSQLFor @AllDefaultTable
184+ `shouldEqual` "INSERT INTO behavior_defaults DEFAULT VALUES RETURNING *"
185+ (Schema.into allDefaultTable # Schema.insert {} # Schema.toSQL)
186+ `shouldEqual` "INSERT INTO behavior_defaults DEFAULT VALUES"
187+
188+ it "renders update entrypoint and all set-operation variants" do
189+ (Schema.update behaviorTable # Schema.set { name: "updated" } # Schema.where_ @"id = $id" # Schema.toSQL)
190+ `shouldEqual` "UPDATE behavior_values SET name = $1 WHERE id = $id"
191+ let left = Schema.from behaviorTable # Schema.select @"name"
192+ let right = Schema.from behaviorTable # Schema.select @"name"
193+ (left `Schema.intersectAll` right # Schema.toSQL)
194+ `shouldEqual` "(SELECT name FROM behavior_values) INTERSECT ALL (SELECT name FROM behavior_values)"
195+ (left `Schema.exceptAll` right # Schema.toSQL)
196+ `shouldEqual` "(SELECT name FROM behavior_values) EXCEPT ALL (SELECT name FROM behavior_values)"
197+
198+ it "renders CTEs and merges their named parameters" do
199+ let adults = Schema.cte @"adults" (Schema.from behaviorTable # Schema.select @"name" # Schema.where_ @"optional_int > $age")
200+ let mainQuery = Schema.fromCTE @"adults" adults # Schema.select @"name"
201+ (Schema.with_ adults mainQuery # Schema.toSQL)
202+ `shouldEqual` "WITH adults AS (SELECT name FROM behavior_values WHERE optional_int > $age) SELECT name FROM adults"
203+
204+ it "replaces repeated named parameters and preserves casts" do
205+ let replaced = Schema.replaceNamedParams 2
206+ [ { name: "id", value: unsafeToForeign 7 }
207+ , { name: "name", value: unsafeToForeign "Alice" }
208+ ]
209+ "id = $id::int OR parent_id = $id AND name = $name"
210+ replaced.sql `shouldEqual` "id = $3 OR parent_id = $3 AND name = $4"
211+ Array.length replaced.values `shouldEqual` 2
212+ Schema.stripCast "$id::uuid" `shouldEqual` "$id"
213+
214+ it "decodes rows and rejects mismatched result shapes" do
215+ let decoded = Schema.decodeRows
216+ [ unsafeToForeign { id: 1, name: "ok" }
217+ , unsafeToForeign { id: 2, name: "also ok" }
218+ ] :: Either _ (Array { id :: Int, name :: String })
219+ decoded `shouldEqual` Right [ { id: 1, name: "ok" }, { id: 2, name: "also ok" } ]
220+ let bad = Schema.decodeRow (unsafeToForeign { id: "wrong" }) :: Either _ { id :: Int }
221+ bad `shouldSatisfy` isLeft
222+ let fractionalTime = Schema.decodeRow (unsafeToForeign { value: "14:30:45.5" }) :: Either _ { value :: Schema.PGTime }
223+ fractionalTime `shouldEqual` Right { value: expectedHalfSecondTime }
224+
225+integrationSpec :: SpecT Aff PG.Connection Identity Unit
226+integrationSpec = do
227+ describe "How to use the public Postgres API" do
228+ it "reports query metadata and preserves heterogeneous and homogeneous parameters" \conn -> do
229+ result <- PG.query
230+ (PG.SQL "SELECT $1::int AS minimum, $2::int AS maximum, $3::double precision AS huge, $4::text AS first, $5::text AS second, $6::int[] AS integers")
231+ ( PG.param (bottom :: Int)
232+ <> PG.param (top :: Int)
233+ <> PG.param 1.5e200
234+ <> PG.params [ "first", "second" ]
235+ <> PG.param [ bottom :: Int, top :: Int ]
236+ )
237+ conn
238+ result.command `shouldEqual` "SELECT"
239+ result.count `shouldEqual` 1
240+ case Schema.decodeRows result.rows of
241+ Left errs -> throwError (error (show errs))
242+ Right rows -> rows `shouldEqual`
243+ [ { minimum: bottom :: Int
244+ , maximum: top :: Int
245+ , huge: 1.5e200
246+ , first: "first"
247+ , second: "second"
248+ , integers: [ bottom :: Int, top :: Int ]
249+ }
250+ ]
251+
252+ it "round-trips UUID, JSON, date, time, timestamp, arrays, and bigint rows" \conn -> do
253+ uuid <- liftEffect UUID.genUUID
254+ result <- PG.query
255+ (PG.SQL "SELECT $1::uuid AS uuid, $2::jsonb AS document, $3::date AS event_date, $4::time AS event_time, $5::timestamptz AS event_at, $6::text[] AS tags, $7::bigint AS big")
256+ [ PG.toPGValue uuid
257+ , PG.toPGValue (unsafeToForeign { key: "value", nested: { count: 2 } })
258+ , PG.toPGValue "2025-06-15"
259+ , PG.toPGValue "14:30:45.125"
260+ , PG.toPGValue "2025-01-15T12:00:00.000Z"
261+ , PG.toPGValue [ "a", "b" ]
262+ , PG.toPGValue "9223372036854775807"
263+ ]
264+ conn
265+ case Schema.decodeRows result.rows of
266+ Left errs -> throwError (error (show errs))
267+ Right rows -> rows `shouldEqual`
268+ [ { uuid: Schema.PGUUID uuid
269+ , document: { key: "value", nested: { count: 2 } }
270+ , event_date: expectedDate
271+ , event_time: expectedTime
272+ , event_at: expectedTimestamp
273+ , tags: [ "a", "b" ]
274+ , big: BigInt.fromString "9223372036854775807" # unsafePartial fromJust
275+ }
276+ ]
277+
278+ it "distinguishes query-one, unsafe exact-row, and no-row behavior" \conn -> do
279+ one <- PG.queryOneSimple (PG.SQL "SELECT 41::int AS value") conn
280+ case one of
281+ Nothing -> throwError (error "expected queryOneSimple row")
282+ Just row -> Schema.decodeRow row `shouldEqual` Right { value: 41 }
283+ exact <- PG.unsafe (PG.SQL "SELECT $1::int AS value") [ PG.toPGValue 42 ] conn
284+ Schema.decodeRow exact `shouldEqual` Right { value: 42 }
285+ missing <- PG.queryOneSimple (PG.SQL "SELECT 1 WHERE false") conn
286+ case missing of
287+ Nothing -> pure unit
288+ Just _ -> throwError (error "expected queryOneSimple to return Nothing")
289+ unsafeMissing <- try $ PG.unsafe (PG.SQL "SELECT 1 WHERE false") [] conn
290+ case unsafeMissing of
291+ Left _ -> pure unit
292+ Right _ -> throwError (error "expected unsafe to reject an empty result")
293+
294+ it "returns affected rows including zero matches" \conn -> do
295+ setupBehaviorTable conn
296+ inserted <- PG.execute (PG.SQL "INSERT INTO behavior_values (name) VALUES ($1), ($2)") (PG.params [ "a", "b" ]) conn
297+ inserted `shouldEqual` 2
298+ updated <- PG.execute (PG.SQL "UPDATE behavior_values SET name = $1 WHERE name = $2") (PG.params [ "updated", "missing" ]) conn
299+ updated `shouldEqual` 0
300+ deleted <- PG.executeSimple (PG.SQL "DELETE FROM behavior_values") conn
301+ deleted `shouldEqual` 2
302+
303+ it "executes typed queries, Maybe parameters, raw results, mutations, and decode errors" \conn -> do
304+ setupBehaviorTable conn
305+ rows <- (Typed.executeSql typedIntQuery { n: 7 } conn :: Aff (Either String (Array { n :: Int })))
306+ rows `shouldEqual` Right [ { n: 7 } ]
307+ nullable <- (Typed.executeSql typedMaybeQuery { value: Nothing } conn :: Aff (Either String (Array { value :: Maybe Int })))
308+ nullable `shouldEqual` Right [ { value: Nothing } ]
309+ raw <- Typed.executeSqlRaw typedIntQuery { n: 8 } conn
310+ raw.count `shouldEqual` 1
311+ one <- (Typed.executeSqlOne typedIntQuery { n: 9 } conn :: Aff (Either String (Maybe { n :: Int })))
312+ one `shouldEqual` Right (Just { n: 9 })
313+ noRows <- (Typed.executeSqlOne (sql $ combineBuilders "SELECT 1::int AS n WHERE false" "") {} conn :: Aff (Either String (Maybe { n :: Int })))
314+ noRows `shouldEqual` Right (Nothing :: Maybe { n :: Int })
315+ many <- (Typed.executeSqlOne (sql $ combineBuilders "SELECT generate_series(1, 2)::int AS n" "") {} conn :: Aff (Either String (Maybe { n :: Int })))
316+ many `shouldEqual` Right (Nothing :: Maybe { n :: Int })
317+ bad <- (Typed.executeSql typedBadDecodeQuery {} conn :: Aff (Either String (Array { n :: Int })))
318+ bad `shouldSatisfy` isLeft
319+ affected <- Typed.executeMutation typedMutationQuery { name: "typed" } conn
320+ affected `shouldEqual` 1
321+
322+ it "uses schema wrappers as typed query parameters" \conn -> do
323+ setupTemporalParamTable conn
324+ uuid <- liftEffect UUID.genUUID
325+ let pgUuid = Schema.PGUUID uuid
326+ let document = unsafeToForeign { key: "value", nested: { count: 2 } }
327+ _ <- PG.execute
328+ (PG.SQL "INSERT INTO behavior_temporal (document, event_at, event_date, event_time, label, uuid) VALUES ($1, $2, $3, $4, $5, $6)")
329+ [ PG.toPGValue document
330+ , PG.toPGValue "2025-01-15T12:00:00.000Z"
331+ , PG.toPGValue "2025-06-15"
332+ , PG.toPGValue "14:30:45.125"
333+ , PG.toPGValue "matched"
334+ , PG.toPGValue (UUID.toString uuid)
335+ ]
336+ conn
337+ byDate <- Schema.from temporalParamTable
338+ # Schema.select @"label"
339+ # Schema.where_ @"event_date = $date"
340+ # Schema.runQuery conn { date: expectedDate }
341+ byTime <- Schema.from temporalParamTable
342+ # Schema.select @"label"
343+ # Schema.where_ @"event_time = $time"
344+ # Schema.runQuery conn { time: expectedTime }
345+ byTimestamp <- Schema.from temporalParamTable
346+ # Schema.select @"label"
347+ # Schema.where_ @"event_at = $timestamp"
348+ # Schema.runQuery conn { timestamp: expectedTimestamp }
349+ byDocument <- Schema.from temporalParamTable
350+ # Schema.select @"label"
351+ # Schema.where_ @"document @> $document"
352+ # Schema.runQuery conn { document: Schema.Jsonb document }
353+ byDate `shouldEqual` [ { label: "matched" } ]
354+ byTime `shouldEqual` [ { label: "matched" } ]
355+ byTimestamp `shouldEqual` [ { label: "matched" } ]
356+ byDocument `shouldEqual` [ { label: "matched" } ]
357+ inserted <- Schema.into temporalParamTable
358+ # Schema.insert
359+ { document: Schema.Jsonb document
360+ , event_at: expectedTimestamp
361+ , event_date: expectedDate
362+ , event_time: expectedTime
363+ , label: "typed"
364+ , uuid: pgUuid
365+ }
366+ # Schema.runExecute conn {}
367+ inserted `shouldEqual` 1
368+ allRows <- PG.querySimple (PG.SQL "SELECT label FROM behavior_temporal ORDER BY label") conn
369+ decoded <- case Schema.decodeRows allRows.rows of
370+ Left errs -> throwError (error (show errs))
371+ Right values -> pure values
372+ decoded `shouldEqual` [ { label: "matched" }, { label: "typed" } ]
373+
374+ it "converts Just values through the inner field encoder" \conn -> do
375+ setupTemporalParamTable conn
376+ uuid <- liftEffect UUID.genUUID
377+ let document = unsafeToForeign { key: "nullable timestamp" }
378+ inserted <- Schema.into temporalParamTable
379+ # Schema.insert
380+ { document: Schema.Jsonb document
381+ , event_at: expectedTimestamp
382+ , event_date: expectedDate
383+ , event_time: expectedTime
384+ , label: "nullable"
385+ , optional_event_at: Just expectedTimestamp
386+ , uuid: Schema.PGUUID uuid
387+ }
388+ # Schema.runExecute conn {}
389+ inserted `shouldEqual` 1
390+ rows <- Schema.from temporalParamTable
391+ # Schema.select @"optional_event_at"
392+ # Schema.runQuery conn {}
393+ rows `shouldEqual` [ { optional_event_at: Just expectedTimestamp } ]
394+
395+ it "use begin/commit/rollback when transaction boundaries are explicit" \conn -> do
396+ setupTxTable conn
397+ committed <- PG.begin conn
398+ _ <- PG.txExecute (PG.SQL "INSERT INTO behavior_tx (name) VALUES ($1)") [ PG.toPGValue "committed" ] committed
399+ inTransaction <- PG.txQuery (PG.SQL "SELECT name FROM behavior_tx WHERE name = $1") [ PG.toPGValue "committed" ] committed
400+ inTransaction.count `shouldEqual` 1
401+ PG.commit committed
402+ afterCommit <- PG.querySimple (PG.SQL "SELECT name FROM behavior_tx") conn
403+ afterCommit.count `shouldEqual` 1
404+
405+ rolledBack <- PG.begin conn
406+ _ <- PG.txExecute (PG.SQL "INSERT INTO behavior_tx (name) VALUES ($1)") [ PG.toPGValue "rolled back" ] rolledBack
407+ PG.rollback rolledBack
408+ afterRollback <- PG.querySimple (PG.SQL "SELECT name FROM behavior_tx") conn
409+ afterRollback.count `shouldEqual` 1
410+
411+
412+ it "let transaction roll back SQL errors and return the connection to the pool" \conn -> do
413+ setupTxTable conn
414+ result <- try $ PG.withTransaction (\txn -> do
415+ _ <- PG.txExecute (PG.SQL "INSERT INTO behavior_tx (name) VALUES ($1)") [ PG.toPGValue "before error" ] txn
416+ _ <- PG.txExecute (PG.SQL "INSERT INTO missing_behavior_table VALUES ($1)") [ PG.toPGValue 1 ] txn
417+ pure unit
418+ ) conn
419+ result `shouldSatisfy` isLeft
420+ rows <- PG.querySimple (PG.SQL "SELECT * FROM behavior_tx") conn
421+ rows.count `shouldEqual` 0
422+ PG.ping conn >>= (_ `shouldEqual` true)
423+
424+ it "preserves the action failure when rollback also fails" \conn -> do
425+ result <- try $ PG.withTransaction
426+ (\txn -> do
427+ liftEffect $ poisonRollback txn
428+ throwError (error "action failed")
429+ )
430+ conn
431+ case result of
432+ Left cause -> message cause `shouldEqual` "action failed"
433+ Right _ -> throwError (error "expected transaction to fail")
434+ PG.ping conn >>= (_ `shouldEqual` true)
435+
436+ it "let transaction roll back cancellation and return the connection to the pool" \conn -> do
437+ setupTxTable conn
438+ wrote <- liftEffect $ Ref.new false
439+ fiber <- forkAff $ PG.withTransaction
440+ (\txn -> do
441+ _ <- PG.txExecute
442+ (PG.SQL "INSERT INTO behavior_tx (name) VALUES ($1)")
443+ [ PG.toPGValue "cancelled" ]
444+ txn
445+ liftEffect $ Ref.write true wrote
446+ delay (Milliseconds 10000.0)
447+ )
448+ conn
449+ delay (Milliseconds 50.0)
450+ didWrite <- liftEffect $ Ref.read wrote
451+ didWrite `shouldEqual` true
452+ killFiber (error "cancel transaction") fiber
453+ rows <- PG.querySimple (PG.SQL "SELECT * FROM behavior_tx") conn
454+ rows.count `shouldEqual` 0
455+ PG.ping conn >>= (_ `shouldEqual` true)
456+
457+ it "releases the reserved connection when commit itself fails" \_ -> do
458+ own <- liftEffect $ PG.postgres
459+ { host: PG.PostgresHost "localhost"
460+ , port: PG.PostgresPort 5434
461+ , database: PG.PostgresDatabase "test_playground"
462+ , username: PG.PostgresUsername "postgres"
463+ , password: PG.PostgresPassword "postgres"
464+ , max: PG.MaxConnections 1
465+ }
466+ _ <- PG.executeSimple (PG.SQL "DROP TABLE IF EXISTS behavior_commit_failure") own
467+ _ <- PG.executeSimple
468+ (PG.SQL "CREATE TABLE behavior_commit_failure (name TEXT UNIQUE DEFERRABLE INITIALLY DEFERRED)")
469+ own
470+ txn <- PG.begin own
471+ _ <- PG.txExecute
472+ (PG.SQL "INSERT INTO behavior_commit_failure (name) VALUES ($1), ($2)")
473+ [ PG.toPGValue "duplicate", PG.toPGValue "duplicate" ]
474+ txn
475+ commitResult <- try $ PG.commit txn
476+ commitResult `shouldSatisfy` isLeft
477+ PG.ping own >>= (_ `shouldEqual` true)
478+ PG.end own
479+
480+
481+ it "supports deterministic concurrent pool queries" \conn -> do
482+ setupBehaviorTable conn
483+ counts <- parTraverse
484+ (\n -> PG.execute (PG.SQL "INSERT INTO behavior_values (name) VALUES ($1)") [ PG.toPGValue ("worker-" <> show n) ] conn)
485+ (Array.range 1 8)
486+ counts `shouldEqual` Array.replicate 8 1
487+ rows <- PG.querySimple (PG.SQL "SELECT * FROM behavior_values") conn
488+ rows.count `shouldEqual` 8
489+
490+ it "delivers notifications and actually unsubscribes" \conn -> do
491+ received <- liftEffect $ Ref.new ([] :: Array String)
492+ let channel = PG.Channel "behavior_notifications"
493+ PG.listen channel (\notification -> Ref.modify_ (_ <> [ notification.payload ]) received) conn
494+ PG.notify channel "before-unlisten" conn
495+ delay (Milliseconds 100.0)
496+ liftEffect (Ref.read received) >>= (_ `shouldEqual` [ "before-unlisten" ])
497+ PG.unlisten channel conn
498+ PG.notify channel "after-unlisten" conn
499+ delay (Milliseconds 100.0)
500+ liftEffect (Ref.read received) >>= (_ `shouldEqual` [ "before-unlisten" ])
501+
502+ it "rejects missing and deallocated prepared statements" \conn -> do
503+ setupBehaviorTable conn
504+ let name = PG.StatementName "behavior_insert"
505+ missing <- try $ PG.executePrepared name [ PG.toPGValue "x" ] conn
506+ case missing of
507+ Left _ -> pure unit
508+ Right _ -> throwError (error "expected missing prepared statement to fail")
509+ PG.prepare name (PG.SQL "INSERT INTO behavior_values (name) VALUES ($1)") conn
510+ PG.executePrepared name [ PG.toPGValue "prepared" ] conn >>= (_.count >>> (_ `shouldEqual` 1))
511+ PG.deallocate name conn
512+ deallocated <- try $ PG.executePrepared name [ PG.toPGValue "again" ] conn
513+ case deallocated of
514+ Left _ -> pure unit
515+ Right _ -> throwError (error "expected deallocated prepared statement to fail")
516+
517+ it "invokes notice and parameter callbacks as PureScript Effects" \_ -> do
518+ noticeSeen <- liftEffect $ Ref.new false
519+ parameterSeen <- liftEffect $ Ref.new false
520+ callbackConn <- liftEffect $ PG.postgres
521+ { host: PG.PostgresHost "localhost"
522+ , port: PG.PostgresPort 5434
523+ , database: PG.PostgresDatabase "test_playground"
524+ , username: PG.PostgresUsername "postgres"
525+ , password: PG.PostgresPassword "postgres"
526+ , onnotice: Ref.write true noticeSeen
527+ , onparameter: \_ -> Ref.write true parameterSeen
528+ }
529+ _ <- PG.executeSimple (PG.SQL "DO $$ BEGIN RAISE NOTICE 'behavior callback'; END $$") callbackConn
530+ _ <- PG.executeSimple (PG.SQL "SET application_name TO 'yoga-postgres-callback-test'") callbackConn
531+ liftEffect (Ref.read noticeSeen) >>= (_ `shouldEqual` true)
532+ liftEffect (Ref.read parameterSeen) >>= (_ `shouldEqual` true)
533+ PG.end callbackConn
534+
535+ it "connects via connection string and end closes the pool" \_ -> do
536+ own <- liftEffect $ PG.postgres
537+ { connection: PG.ConnectionString "postgres://postgres:postgres@localhost:5434/test_playground" }
538+ PG.ping own >>= (_ `shouldEqual` true)
539+ PG.end own
540+ PG.ping own >>= (_ `shouldEqual` false)
test/EdgeCases.pursnew file+161
@@ -0,0 +1,161 @@
1+module Test.Postgres.EdgeCases where
2+
3+import Prelude
4+
5+import Data.Maybe (Maybe)
6+import JS.BigInt (BigInt)
7+import Prim.Boolean (True)
8+import Type.Function (type (#))
9+import Type.Proxy (Proxy(..))
10+import Yoga.Postgres.Schema
11+
12+-- Same table definitions as Schema tests
13+type UsersTable = Table "users"
14+ ( id :: Int # PrimaryKey # AutoIncrement
15+ , name :: String
16+ , email :: String # Unique
17+ , age :: Maybe Int
18+ )
19+
20+usersTable :: Proxy UsersTable
21+usersTable = Proxy
22+
23+type PostsTable = Table "posts"
24+ ( id :: Int # PrimaryKey # AutoIncrement
25+ , title :: String
26+ , body :: String
27+ , user_id :: Int
28+ )
29+
30+postsTable :: Proxy PostsTable
31+postsTable = Proxy
32+
33+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
34+-- EDGE CASE 1: HAVING merges WHERE params (FIXED)
35+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
36+
37+havingMergesWhereParams
38+ :: Q _ (name :: String, cnt :: BigInt) (age :: Int, minCount :: Int) _
39+havingMergesWhereParams = from usersTable
40+ # select @"name, COUNT(*) AS cnt"
41+ # where_ @"age > $age"
42+ # groupBy @"name"
43+ # having @"COUNT(*) > $minCount"
44+
45+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
46+-- EDGE CASE 2: WHERE without any DML operation (FIXED)
47+-- from table # where_ now fails to compile (see WhereWithoutDML.purs)
48+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
49+
50+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
51+-- EDGE CASE 3: GROUP BY doesn't enforce aggregation rules
52+-- Non-aggregated, non-grouped columns in SELECT should be
53+-- rejected when GROUP BY is present.
54+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
55+
56+-- This produces invalid SQL: SELECT name, email FROM users GROUP BY name
57+-- 'email' is not in GROUP BY and not aggregated.
58+-- PostgreSQL would reject this at runtime.
59+groupByMissingColumn
60+ :: Q _ (name :: String, email :: String) () _
61+groupByMissingColumn = from usersTable
62+ # select @"name, email"
63+ # groupBy @"name"
64+
65+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
66+-- EDGE CASE 4: OVER clause content validated (FIXED)
67+-- Invalid OVER content now fails to compile
68+-- (see OverClauseInvalidContent.purs, OverClauseNonexistentColumn.purs)
69+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
70+
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
82+ :: Q _ (name :: String, rn :: Int) () _
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"
90+
91+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
92+-- EDGE CASE 5: WHERE keywords are case-sensitive (uppercase only)
93+-- "IS NULL" works but "is null" would fail (tries to resolve "is" as column)
94+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
95+
96+uppercaseIsNull :: Q _ _ () _
97+uppercaseIsNull = from usersTable # selectAll # where_ @"age IS NULL"
98+
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"
113+
114+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
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)
118+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
119+
120+distinctOrderByValid
121+ :: Q _ (name :: String) () _
122+distinctOrderByValid = from usersTable
123+ # selectDistinct @"name"
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"
131+
132+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
133+-- EDGE CASE 7: Nonexistent column in OVER (FIXED)
134+-- OVER content is now validated (see OverClauseNonexistentColumn.purs)
135+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
136+
137+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
138+-- EDGE CASE 8: Nested parens in aggregate args (FIXED)
139+-- ExtractUntilParen now uses Peano depth counter for nesting
140+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
141+
142+coalesceSimple
143+ :: Q _ (name :: String, val :: Int) () _
144+coalesceSimple = from usersTable
145+ # select @"name, COALESCE(age, 0) AS val"
146+
147+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
148+-- EDGE CASE 9: INSERT on table with all auto-generated columns
149+-- Produces: INSERT INTO config () VALUES ()
150+-- This is invalid PostgreSQL syntax (should be DEFAULT VALUES)
151+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
152+
153+type AllDefaultTable = Table "all_default"
154+ ( id :: Int # PrimaryKey # AutoIncrement
155+ , active :: Boolean # Default True
156+ , score :: Int # Default 0
157+ )
158+
159+allDefaultInsert :: Q _ () () _
160+allDefaultInsert = from (Proxy :: Proxy AllDefaultTable)
161+ # insert {}
test/Integration.pursnew file+50
@@ -0,0 +1,50 @@
1+module Test.Postgres.Integration where
2+
3+import Prelude
4+
5+import Effect (Effect)
6+import Effect.Aff (launchAff_)
7+import Effect.Class (liftEffect)
8+import Test.Postgres.Schema as Schema
9+import Test.Spec.Reporter.Console (consoleReporter)
10+import Yoga.Postgres.Schema (createTableDDL)
11+import Test.Spec.Runner (runSpec)
12+import Yoga.Postgres as PG
13+
14+main :: Effect Unit
15+main = launchAff_ do
16+ conn <- liftEffect $ PG.postgres
17+ { host: PG.PostgresHost "localhost"
18+ , port: PG.PostgresPort 5434
19+ , database: PG.PostgresDatabase "test_playground"
20+ , username: PG.PostgresUsername "postgres"
21+ , password: PG.PostgresPassword "postgres"
22+ }
23+ _ <- PG.executeSimple (PG.SQL "DROP TABLE IF EXISTS 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
30+ _ <- PG.executeSimple (PG.SQL (createTableDDL @Schema.UsersTable)) conn
31+ _ <- PG.executeSimple (PG.SQL (createTableDDL @Schema.EventsTable)) conn
32+ _ <- PG.executeSimple (PG.SQL (createTableDDL @Schema.PostsTable)) conn
33+ _ <- PG.executeSimple (PG.SQL (createTableDDL @Schema.SessionsTable)) conn
34+ _ <- PG.executeSimple (PG.SQL (createTableDDL @Schema.ScheduleTable)) conn
35+ _ <- PG.executeSimple (PG.SQL (createTableDDL @Schema.LocationsTable)) conn
36+ _ <- PG.executeSimple (PG.SQL (createTableDDL @Schema.ArticlesTable)) conn
37+ _ <- PG.execute (PG.SQL "INSERT INTO users (name, email, age) VALUES ($1, $2, $3)")
38+ [ PG.toPGValue "Alice", PG.toPGValue "alice@example.com", PG.toPGValue 22 ]
39+ conn
40+ _ <- PG.execute (PG.SQL "INSERT INTO users (name, email, age) VALUES ($1, $2, $3)")
41+ [ PG.toPGValue "Bob", PG.toPGValue "bob@example.com", PG.toPGValue 30 ]
42+ conn
43+ _ <- PG.execute (PG.SQL "INSERT INTO posts (title, body, user_id) VALUES ($1, $2, $3)")
44+ [ PG.toPGValue "Alice's Post", PG.toPGValue "Hello from Alice", PG.toPGValue 1 ]
45+ conn
46+ _ <- PG.execute (PG.SQL "INSERT INTO posts (title, body, user_id) VALUES ($1, $2, $3)")
47+ [ PG.toPGValue "Bob's Post", PG.toPGValue "Hello from Bob", PG.toPGValue 2 ]
48+ conn
49+ runSpec [ consoleReporter ] (Schema.integrationSpec conn)
50+ PG.end conn
test/Main.purs+26−16
@@ -4,6 +4,7 @@ import Prelude
4
4
5import Data.Either (Either(..))
5import Data.Either (Either(..))
6import Data.Maybe (Maybe(..))
6import Data.Maybe (Maybe(..))
7+import Data.Time.Duration (Milliseconds(..))
7import Effect (Effect)
8import Effect (Effect)
8import Effect.Aff (Aff, bracket, launchAff_, throwError, try)
9import Effect.Aff (Aff, bracket, launchAff_, throwError, try)
9import Effect.Class (liftEffect)
10import Effect.Class (liftEffect)
@@ -11,9 +12,11 @@ import Effect.Console (log)
11import Effect.Exception (error)
12import Effect.Exception (error)
12import Test.Spec (Spec, around, describe, it)
13import Test.Spec (Spec, around, describe, it)
13import Test.Spec.Assertions (shouldEqual, shouldSatisfy)
14import Test.Spec.Assertions (shouldEqual, shouldSatisfy)
15+import Test.Postgres.Behavioral as Behavioral
14import Test.Spec.Reporter.Console (consoleReporter)
16import Test.Spec.Reporter.Console (consoleReporter)
15import Test.Spec.Runner (runSpec)
17import Test.Spec.Runner (runSpec)
16import Yoga.Test.Docker as Docker
18import Yoga.Test.Docker as Docker
19+import Test.Postgres.Schema as Schema
17import Yoga.Postgres as PG
20import Yoga.Postgres as PG
18
21
19-- Test configuration
22-- Test configuration
@@ -21,7 +24,7 @@ testHost :: PG.PostgresHost
21testHost = PG.PostgresHost "localhost"
24testHost = PG.PostgresHost "localhost"
22
25
23testPort :: PG.PostgresPort
26testPort :: PG.PostgresPort
24−testPort = PG.PostgresPort 5433 -- Test port from docker-compose.test.yml
27+testPort = PG.PostgresPort 5434 -- Test port from docker-compose.test.yml
25
28
26testDatabase :: PG.PostgresDatabase
29testDatabase :: PG.PostgresDatabase
27testDatabase = PG.PostgresDatabase "test_playground"
30testDatabase = PG.PostgresDatabase "test_playground"
@@ -91,6 +94,13 @@ setupTableWithConstraints conn = do
91
94
92spec :: Spec Unit
95spec :: Spec Unit
93spec = do
96spec = do
97+ Schema.spec
98+ Behavioral.pureSpec
99+
100+ around withPostgres do
101+ Behavioral.integrationSpec
102+
103+
94 describe "Yoga.Postgres Integration Tests" do
104 describe "Yoga.Postgres Integration Tests" do
95
105
96 -- Connection Management Tests
106 -- Connection Management Tests
@@ -103,7 +113,7 @@ spec = do
103 it "retrieves connection options" \conn -> do
113 it "retrieves connection options" \conn -> do
104 opts <- liftEffect $ PG.options conn
114 opts <- liftEffect $ PG.options conn
105 opts.host `shouldSatisfy` (_ /= "")
115 opts.host `shouldSatisfy` (_ /= "")
106− opts.port `shouldEqual` 5433
116+ opts.port `shouldEqual` 5434
107 opts.database `shouldEqual` "test_playground"
117 opts.database `shouldEqual` "test_playground"
108
118
109 describe "Connection Errors" do
119 describe "Connection Errors" do
@@ -117,7 +127,10 @@ spec = do
117 , password: testPassword
127 , password: testPassword
118 }
128 }
119 PG.ping conn
129 PG.ping conn
120− result `shouldSatisfy` isLeft
130+ case result of
131+ Left _ -> pure unit
132+ Right false -> pure unit
133+ Right true -> shouldEqual "unhealthy" "healthy"
121
134
122 -- Basic Query Tests
135 -- Basic Query Tests
123 around withPostgres do
136 around withPostgres do
@@ -227,7 +240,7 @@ spec = do
227 it "commits transactions successfully" \conn -> do
240 it "commits transactions successfully" \conn -> do
228 setupTestTable conn
241 setupTestTable conn
229
242
230− _ <- PG.transaction
243+ _ <- PG.withTransaction
231 ( \txn -> do
244 ( \txn -> do
232 _ <- PG.txExecute (PG.SQL "INSERT INTO test_users (name) VALUES ($1)")
245 _ <- PG.txExecute (PG.SQL "INSERT INTO test_users (name) VALUES ($1)")
233 [ PG.toPGValue "Henry" ]
246 [ PG.toPGValue "Henry" ]
@@ -245,12 +258,12 @@ spec = do
245 it "rolls back on errors" \conn -> do
258 it "rolls back on errors" \conn -> do
246 setupTestTable conn
259 setupTestTable conn
247
260
248− result <- try $ PG.transaction
261+ result <- try $ PG.withTransaction
249 ( \txn -> do
262 ( \txn -> do
250 _ <- PG.txExecute (PG.SQL "INSERT INTO test_users (name) VALUES ($1)")
263 _ <- PG.txExecute (PG.SQL "INSERT INTO test_users (name) VALUES ($1)")
251 [ PG.toPGValue "Jack" ]
264 [ PG.toPGValue "Jack" ]
252 txn
265 txn
253− throwError (error "Intentional error")
266+ (throwError (error "Intentional error") :: Aff Unit)
254 )
267 )
255 conn
268 conn
256
269
@@ -262,7 +275,7 @@ spec = do
262 it "queries within transaction" \conn -> do
275 it "queries within transaction" \conn -> do
263 setupTestTable conn
276 setupTestTable conn
264
277
265− _ <- PG.transaction
278+ _ <- PG.withTransaction
266 ( \txn -> do
279 ( \txn -> do
267 _ <- PG.txExecute (PG.SQL "INSERT INTO test_users (name) VALUES ($1)")
280 _ <- PG.txExecute (PG.SQL "INSERT INTO test_users (name) VALUES ($1)")
268 [ PG.toPGValue "Leo" ]
281 [ PG.toPGValue "Leo" ]
@@ -422,19 +435,16 @@ spec = do
422
435
423main :: Effect Unit
436main :: Effect Unit
424main = launchAff_ do
437main = launchAff_ do
425− liftEffect $ log "\n🧪 Starting Postgres Integration Tests (with Docker)\n"
438+ liftEffect $ log "\nStarting Postgres Integration Tests (with Docker)\n"
426
439
427 bracket
440 bracket
428− -- Start Docker before tests
429 ( do
441 ( do
430− liftEffect $ log "⏳ Starting Postgres and waiting for it to be ready..."
442+ liftEffect $ log "Starting Postgres and waiting for it to be ready..."
431− Docker.startService "packages/yoga-postgres/docker-compose.test.yml" 30
443+ Docker.startService (Docker.ComposeFile "docker-compose.test.yml") (Docker.Timeout (Milliseconds 30000.0))
432− liftEffect $ log "✅ Postgres is ready!\n"
444+ liftEffect $ log "Postgres is ready!\n"
433 )
445 )
434− -- Stop Docker after tests (always runs!)
435 ( \_ -> do
446 ( \_ -> do
436− Docker.stopService "packages/yoga-postgres/docker-compose.test.yml"
447+ Docker.stopService (Docker.ComposeFile "docker-compose.test.yml")
437− liftEffect $ log "✅ Cleanup complete\n"
448+ liftEffect $ log "Cleanup complete\n"
438 )
449 )
439− -- Run tests
440 (\_ -> runSpec [ consoleReporter ] spec)
450 (\_ -> runSpec [ consoleReporter ] spec)
test/Schema.pursnew file+1433
@@ -0,0 +1,1433 @@
1+module Test.Postgres.Schema where
2+
3+import Prelude
4+
5+import Data.Array as Array
6+import Data.Date (canonicalDate)
7+import Data.DateTime (DateTime(..))
8+import Data.Enum (toEnum)
9+import Data.Maybe (Maybe(..), fromJust)
10+import Data.Newtype (un)
11+import Data.String as String
12+import Data.Time (Time(..))
13+import Data.UUID as UUID
14+import Partial.Unsafe (unsafePartial)
15+
16+import Type.Function (type (#))
17+import Effect.Aff (Aff)
18+import Effect.Class (liftEffect)
19+import Foreign (Foreign, unsafeToForeign)
20+import JS.BigInt (BigInt)
21+import JS.BigInt as BigInt
22+import Prim.Boolean (True)
23+import Test.Spec (Spec, describe, it)
24+import Test.Spec.Assertions (shouldEqual)
25+import Type.Proxy (Proxy(..))
26+import Yoga.Postgres as PG
27+import Yoga.Postgres.Schema
28+
29+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
30+-- Phase 1: Table type definitions compile
31+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
32+
33+type UsersTable = Table "users"
34+ ( id :: Int # PrimaryKey # AutoIncrement
35+ , name :: String
36+ , email :: String # Unique
37+ , age :: Maybe Int
38+ )
39+
40+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
41+-- Phase 2: CREATE TABLE DDL generation
42+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
43+
44+ddl :: String
45+ddl = createTableDDL @UsersTable
46+
47+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
48+-- Phase 3: Type-safe INSERT
49+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
50+
51+insertSQL :: String
52+insertSQL = insertSQLFor @UsersTable
53+
54+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
55+-- Phase 4: Type-safe SELECT
56+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
57+
58+selectAllSQL :: String
59+selectAllSQL = selectAllSQLFor @UsersTable
60+
61+selectWhereSQL :: String
62+selectWhereSQL = selectWhereSQLFor @UsersTable @(id :: Int)
63+
64+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
65+-- Phase 5: Type-level defaults
66+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
67+
68+type ConfigTable = Table "config"
69+ ( id :: Int # PrimaryKey # AutoIncrement
70+ , active :: Boolean # Default True
71+ , role :: String # Default "user"
72+ , score :: Int # Default 0
73+ )
74+
75+configDDL :: String
76+configDDL = createTableDDL @ConfigTable
77+
78+configInsertSQL :: String
79+configInsertSQL = insertSQLFor @ConfigTable
80+
81+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
82+-- Extended types: DateTime, BigInt, Jsonb, Array
83+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
84+
85+type EventsTable = Table "events"
86+ ( id :: Int # PrimaryKey # AutoIncrement
87+ , title :: String
88+ , metadata :: Jsonb
89+ , tags :: Array String
90+ , created_at :: DateTime
91+ , view_count :: BigInt
92+ )
93+
94+eventsTable :: Proxy EventsTable
95+eventsTable = Proxy
96+
97+eventsDDL :: String
98+eventsDDL = createTableDDL @EventsTable
99+
100+typedJsonbWhere
101+ :: Q _ _ (metadata :: Jsonb) _
102+typedJsonbWhere = from eventsTable # selectAll # where_ @"metadata @> $metadata"
103+
104+typedJsonbInvalid
105+ :: Q _ _ (metadata :: Jsonb) _
106+typedJsonbInvalid = from eventsTable # selectAll # where_ @"metadata !* $metadata"
107+
108+typedTitleLike
109+ :: Q _ _ (title :: String) _
110+typedTitleLike = from eventsTable # selectAll # where_ @"title LIKE $title"
111+
112+typedArrayWhere
113+ :: Q _ _ (id :: Array Int) _
114+typedArrayWhere = from eventsTable # selectAll # where_ @"id = ANY($id)"
115+
116+testDateTime :: DateTime
117+testDateTime = unsafePartial do
118+ let year = fromJust (toEnum 2025)
119+ let month = fromJust (toEnum 1)
120+ let day = fromJust (toEnum 15)
121+ let hour = fromJust (toEnum 12)
122+ let minute = fromJust (toEnum 0)
123+ let second = fromJust (toEnum 0)
124+ let ms = fromJust (toEnum 0)
125+ DateTime (canonicalDate year month day) (Time hour minute second ms)
126+
127+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
128+-- Phase 6: Type-safe UPDATE
129+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
130+
131+updateSQL :: String
132+updateSQL = updateSQLFor @UsersTable @(name :: String) @(id :: Int)
133+
134+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
135+-- Phase 7: Type-safe DELETE
136+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
137+
138+deleteSQL :: String
139+deleteSQL = deleteSQLFor @UsersTable @(id :: Int)
140+
141+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
142+-- Phase 8: Builder-style query API
143+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
144+
145+usersTable :: Proxy UsersTable
146+usersTable = Proxy
147+
148+typedSelectAll
149+ :: Q _
150+ (age :: Maybe Int, email :: String, id :: Int, name :: String)
151+ ()
152+ _
153+typedSelectAll = from usersTable # selectAll
154+
155+typedSelectCols
156+ :: Q _
157+ (name :: String, email :: String)
158+ ()
159+ _
160+typedSelectCols = from usersTable # select @"name, email"
161+
162+typedSelectAlias
163+ :: Q _
164+ (name :: String, e :: String)
165+ ()
166+ _
167+typedSelectAlias = from usersTable # select @"name, email AS e"
168+
169+typedWhere
170+ :: Q _
171+ (age :: Maybe Int, email :: String, id :: Int, name :: String)
172+ (id :: Int)
173+ _
174+typedWhere = from usersTable # selectAll # where_ @"id = $id"
175+
176+typedWhereComplex
177+ :: Q _
178+ (age :: Maybe Int, email :: String, id :: Int, name :: String)
179+ (name :: String, age :: Int)
180+ _
181+typedWhereComplex = from usersTable # selectAll # where_ @"name = $name AND age > $age"
182+
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+
190+typedSelectColsWhere
191+ :: Q _
192+ (name :: String)
193+ (age :: Int)
194+ _
195+typedSelectColsWhere = from usersTable # select @"name" # where_ @"age > $age"
196+
197+builderSelectAll :: String
198+builderSelectAll = typedSelectAll # toSQL
199+
200+builderSelectCols :: String
201+builderSelectCols = typedSelectCols # toSQL
202+
203+builderSelectAlias :: String
204+builderSelectAlias = typedSelectAlias # toSQL
205+
206+builderSelectWhere :: String
207+builderSelectWhere = typedWhere # toSQL
208+
209+builderSelectColsWhere :: String
210+builderSelectColsWhere = typedSelectColsWhere # toSQL
211+
212+builderWhereComplex :: String
213+builderWhereComplex = typedWhereComplex # toSQL
214+
215+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
216+-- Phase 9: Builder INSERT / UPDATE / ON CONFLICT
217+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
218+
219+typedInsert
220+ :: Q _ () () _
221+typedInsert = from usersTable # insert { name: "Alice", email: "alice@example.com", age: Nothing :: Maybe Int }
222+
223+typedInsertOptional
224+ :: Q _ () () _
225+typedInsertOptional = from usersTable # insert { name: "Alice", email: "alice@example.com" }
226+
227+typedInsertReturning
228+ :: Q _ (id :: Int, name :: String) () _
229+typedInsertReturning = from usersTable
230+ # insert { name: "Alice", email: "alice@example.com" }
231+ # returning @"id, name"
232+
233+typedSet
234+ :: Q _ () () _
235+typedSet = update usersTable # set { name: "Bob" }
236+
237+typedSetWhere
238+ :: Q _ () (id :: Int) _
239+typedSetWhere = update usersTable # set { name: "Bob" } # where_ @"id = $id"
240+
241+typedSetReturning
242+ :: Q _ (id :: Int, name :: String, email :: String) (id :: Int) _
243+typedSetReturning = update usersTable
244+ # set { name: "Bob" }
245+ # where_ @"id = $id"
246+ # returning @"id, name, email"
247+
248+typedUpsert
249+ :: Q _ () () _
250+typedUpsert = from usersTable
251+ # insert { name: "Alice", email: "alice@example.com", age: Nothing :: Maybe Int }
252+ # onConflictDoNothing @"email"
253+
254+builderInsert :: String
255+builderInsert = typedInsert # toSQL
256+
257+builderInsertReturning :: String
258+builderInsertReturning = typedInsertReturning # toSQL
259+
260+builderSet :: String
261+builderSet = typedSet # toSQL
262+
263+builderSetWhere :: String
264+builderSetWhere = typedSetWhere # toSQL
265+
266+builderUpsert :: String
267+builderUpsert = typedUpsert # toSQL
268+
269+typedDelete
270+ :: Q _ () (id :: Int) _
271+typedDelete = from usersTable # delete # where_ @"id = $id"
272+
273+typedDeleteReturning
274+ :: Q _ (name :: String, email :: String) (id :: Int) _
275+typedDeleteReturning = from usersTable # delete # where_ @"id = $id" # returning @"name, email"
276+
277+typedOrderBy
278+ :: Q _ (age :: Maybe Int, email :: String, id :: Int, name :: String) () _
279+typedOrderBy = from usersTable # selectAll # orderBy @"name"
280+
281+typedOrderByDesc
282+ :: Q _ (age :: Maybe Int, email :: String, id :: Int, name :: String) () _
283+typedOrderByDesc = from usersTable # selectAll # orderBy @"name DESC, age ASC"
284+
285+typedLimitOffset
286+ :: Q _ (age :: Maybe Int, email :: String, id :: Int, name :: String) () _
287+typedLimitOffset = from usersTable # selectAll # orderBy @"name" # limit @"10" # offset @"5"
288+
289+typedInArray
290+ :: Q _ (age :: Maybe Int, email :: String, id :: Int, name :: String) (id :: Array Int) _
291+typedInArray = from usersTable # selectAll # where_ @"id IN $id"
292+
293+typedReturningAll
294+ :: Q _ (age :: Maybe Int, email :: String, id :: Int, name :: String) (id :: Int) _
295+typedReturningAll = from usersTable # delete # where_ @"id = $id" # returningAll
296+
297+builderDelete :: String
298+builderDelete = typedDelete # toSQL
299+
300+builderDeleteReturning :: String
301+builderDeleteReturning = typedDeleteReturning # toSQL
302+
303+builderOrderBy :: String
304+builderOrderBy = typedOrderBy # toSQL
305+
306+builderOrderByDesc :: String
307+builderOrderByDesc = typedOrderByDesc # toSQL
308+
309+builderLimitOffset :: String
310+builderLimitOffset = typedLimitOffset # toSQL
311+
312+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
313+-- Phase 10: Query execution (type annotations prove correctness)
314+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
315+
316+queryAllUsers :: PG.Connection -> Aff (Array { id :: Int, name :: String, email :: String, age :: Maybe Int })
317+queryAllUsers conn = from usersTable # selectAll # runQuery conn {}
318+
319+queryUsersByAge :: PG.Connection -> Aff (Array { name :: String, email :: String })
320+queryUsersByAge conn =
321+ from usersTable
322+ # select @"name, email"
323+ # where_ @"age > $age"
324+ # runQuery conn { age: 25 }
325+
326+queryUserById :: PG.Connection -> Aff (Maybe { name :: String, e :: String })
327+queryUserById conn =
328+ from usersTable # select @"name, email AS e" # where_ @"id = $id" # runQueryOne conn { id: 1 }
329+
330+queryComplexWhere :: PG.Connection -> Aff (Array { id :: Int, name :: String, email :: String, age :: Maybe Int })
331+queryComplexWhere conn =
332+ from usersTable # selectAll
333+ # where_ @"name = $name AND age > $age"
334+ # runQuery conn { name: "Alice", age: 21 }
335+
336+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
337+-- Phase 11: JOIN builder
338+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
339+
340+type PostsTable = Table "posts"
341+ ( id :: Int # PrimaryKey # AutoIncrement
342+ , title :: String
343+ , body :: String
344+ , user_id :: Int
345+ )
346+
347+postsTable :: Proxy PostsTable
348+postsTable = Proxy
349+
350+type CommentsTable = Table "comments"
351+ ( id :: Int # PrimaryKey # AutoIncrement
352+ , text :: String
353+ , post_id :: Int
354+ , user_id :: Int
355+ )
356+
357+commentsTable :: Proxy CommentsTable
358+commentsTable = Proxy
359+
360+typedInnerJoin
361+ :: Q _ (name :: String, title :: String) (age :: Int) _
362+typedInnerJoin = from usersTable
363+ # innerJoin @"users.id = posts.user_id" postsTable
364+ # select @"users.name, posts.title"
365+ # where_ @"users.age > $age"
366+
367+typedInnerJoinSQL :: String
368+typedInnerJoinSQL = typedInnerJoin # toSQL
369+
370+typedInnerJoinAlias
371+ :: Q _ (user_name :: String, post_title :: String) () _
372+typedInnerJoinAlias = from usersTable
373+ # innerJoin @"users.id = posts.user_id" postsTable
374+ # select @"users.name AS user_name, posts.title AS post_title"
375+
376+typedLeftJoin
377+ :: Q _ (name :: String, title :: Maybe String) () _
378+typedLeftJoin = from usersTable
379+ # leftJoin @"users.id = posts.user_id" postsTable
380+ # select @"users.name, posts.title"
381+
382+typedLeftJoinSQL :: String
383+typedLeftJoinSQL = typedLeftJoin # toSQL
384+
385+typedJoinOrderBy
386+ :: Q _ (name :: String, title :: String) () _
387+typedJoinOrderBy = from usersTable
388+ # innerJoin @"users.id = posts.user_id" postsTable
389+ # select @"users.name, posts.title"
390+ # orderBy @"users.name ASC"
391+
392+typedJoinLimitOffset
393+ :: Q _ (name :: String, title :: String) () _
394+typedJoinLimitOffset = from usersTable
395+ # innerJoin @"users.id = posts.user_id" postsTable
396+ # select @"users.name, posts.title"
397+ # orderBy @"users.name"
398+ # limit @"10"
399+ # offset @"5"
400+
401+typedUnqualifiedSelect
402+ :: Q _ (title :: String, name :: String) () _
403+typedUnqualifiedSelect = from usersTable
404+ # innerJoin @"users.id = posts.user_id" postsTable
405+ # select @"title, name"
406+
407+typedMultiJoin
408+ :: Q _ (name :: String, title :: String, text :: String) () _
409+typedMultiJoin = from usersTable
410+ # innerJoin @"users.id = posts.user_id" postsTable
411+ # innerJoin @"posts.id = comments.post_id" commentsTable
412+ # select @"users.name, posts.title, comments.text"
413+
414+joinQueryExecution :: PG.Connection -> Aff (Array { name :: String, title :: String })
415+joinQueryExecution conn =
416+ from usersTable
417+ # innerJoin @"users.id = posts.user_id" postsTable
418+ # select @"users.name, posts.title"
419+ # where_ @"users.age > $age"
420+ # runQuery conn { age: 25 }
421+
422+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
423+-- DISTINCT
424+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
425+
426+typedDistinct
427+ :: Q _ (name :: String) () _
428+typedDistinct = from usersTable # selectDistinct @"name"
429+
430+typedDistinctOn
431+ :: Q _ (name :: String, email :: String) () _
432+typedDistinctOn = from usersTable # selectDistinctOn @"name" @"name, email"
433+
434+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
435+-- GROUP BY, HAVING, Aggregates
436+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
437+
438+typedGroupBy
439+ :: Q _ (name :: String) () _
440+typedGroupBy = from usersTable # select @"name" # groupBy @"name"
441+
442+typedCountStar
443+ :: Q _ (name :: String, cnt :: BigInt) () _
444+typedCountStar = from usersTable
445+ # select @"name, COUNT(*) AS cnt"
446+ # groupBy @"name"
447+
448+typedSumAge
449+ :: Q _ (name :: String, total :: Int) () _
450+typedSumAge = from usersTable
451+ # select @"name, SUM(age) AS total"
452+ # groupBy @"name"
453+
454+typedAvgAge
455+ :: Q _ (name :: String, avg_age :: Number) () _
456+typedAvgAge = from usersTable
457+ # select @"name, AVG(age) AS avg_age"
458+ # groupBy @"name"
459+
460+typedMinMax
461+ :: Q _ (name :: String, youngest :: Int, oldest :: Int) () _
462+typedMinMax = from usersTable
463+ # select @"name, MIN(age) AS youngest, MAX(age) AS oldest"
464+ # groupBy @"name"
465+
466+typedHaving
467+ :: Q _ (name :: String, cnt :: BigInt) (minCount :: Int) _
468+typedHaving = from usersTable
469+ # select @"name, COUNT(*) AS cnt"
470+ # groupBy @"name"
471+ # having @"COUNT(*) > $minCount"
472+
473+typedFullAggregate
474+ :: Q _ (name :: String, cnt :: BigInt) (min :: Int) _
475+typedFullAggregate = from usersTable
476+ # select @"name, COUNT(*) AS cnt"
477+ # groupBy @"name"
478+ # having @"COUNT(*) > $min"
479+ # orderBy @"name"
480+ # limit @"10"
481+
482+typedWhereGroupByHaving
483+ :: Q _ (name :: String, cnt :: BigInt) (age :: Int, minCount :: Int) _
484+typedWhereGroupByHaving = from usersTable
485+ # select @"name, COUNT(*) AS cnt"
486+ # where_ @"age > $age"
487+ # groupBy @"name"
488+ # having @"COUNT(*) > $minCount"
489+
490+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
491+-- Table aliases
492+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
493+
494+typedFromAs
495+ :: Q _ (name :: String) () _
496+typedFromAs = fromAs @"u" usersTable # select @"u.name"
497+
498+typedSelfJoin
499+ :: Q _ (name :: String, manager_name :: String) () _
500+typedSelfJoin = from usersTable
501+ # innerJoinAs @"managers" @"users.id = managers.id" usersTable
502+ # select @"users.name, managers.name AS manager_name"
503+
504+typedBothAliased
505+ :: Q _ (name :: String, other_name :: String) () _
506+typedBothAliased = fromAs @"u1" usersTable
507+ # innerJoinAs @"u2" @"u1.id = u2.id" usersTable
508+ # select @"u1.name, u2.name AS other_name"
509+
510+typedLeftJoinAs
511+ :: Q _ (name :: String, other_email :: Maybe String) () _
512+typedLeftJoinAs = from usersTable
513+ # leftJoinAs @"u2" @"users.id = u2.id" usersTable
514+ # select @"users.name, u2.email AS other_email"
515+
516+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
517+-- Window functions
518+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
519+
520+typedRowNumber
521+ :: Q _ (name :: String, rn :: Int) () _
522+typedRowNumber = from usersTable
523+ # select @"name, ROW_NUMBER() OVER (ORDER BY age) AS rn"
524+
525+typedRank
526+ :: Q _ (name :: String, rnk :: Int) () _
527+typedRank = from usersTable
528+ # select @"name, RANK() OVER (PARTITION BY name ORDER BY age DESC) AS rnk"
529+
530+typedDenseRank
531+ :: Q _ (name :: String, dr :: Int) () _
532+typedDenseRank = from usersTable
533+ # select @"name, DENSE_RANK() OVER (ORDER BY age) AS dr"
534+
535+typedLag
536+ :: Q _ (name :: String, prev_age :: Int) () _
537+typedLag = from usersTable
538+ # select @"name, LAG(age) OVER (ORDER BY id) AS prev_age"
539+
540+typedLead
541+ :: Q _ (name :: String, next_age :: Int) () _
542+typedLead = from usersTable
543+ # select @"name, LEAD(age) OVER (ORDER BY id) AS next_age"
544+
545+typedFirstValue
546+ :: Q _ (name :: String, first_name :: String) () _
547+typedFirstValue = from usersTable
548+ # select @"name, FIRST_VALUE(name) OVER (ORDER BY age) AS first_name"
549+
550+typedNtile
551+ :: Q _ (name :: String, bucket :: Int) () _
552+typedNtile = from usersTable
553+ # select @"name, NTILE(4) OVER (ORDER BY age) AS bucket"
554+
555+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
556+-- Parameterized LIMIT / OFFSET
557+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
558+
559+typedLimitParam
560+ :: Q _ (name :: String) (n :: Int) _
561+typedLimitParam = from usersTable # select @"name" # limit @"$n"
562+
563+typedOffsetParam
564+ :: Q _ (name :: String) (n :: Int) _
565+typedOffsetParam = from usersTable # select @"name" # offset @"$n"
566+
567+typedLimitParamWithWhere
568+ :: Q _ (name :: String) (age :: Int, n :: Int) _
569+typedLimitParamWithWhere = from usersTable
570+ # select @"name"
571+ # where_ @"age > $age"
572+ # limit @"$n"
573+
574+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
575+-- UNION / INTERSECT / EXCEPT
576+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
577+
578+typedUnion
579+ :: Q _ (name :: String) () _
580+typedUnion = (from usersTable # select @"name")
581+ `union` (from usersTable # select @"name")
582+
583+typedUnionAll
584+ :: Q _ (name :: String) () _
585+typedUnionAll = (from usersTable # select @"name")
586+ `unionAll` (from usersTable # select @"name")
587+
588+typedUnionWithParams
589+ :: Q _ (name :: String) (a :: Int, b :: Int) _
590+typedUnionWithParams =
591+ (from usersTable # select @"name" # where_ @"age > $a")
592+ `union` (from usersTable # select @"name" # where_ @"age < $b")
593+
594+typedUnionOrderByLimit
595+ :: Q _ (name :: String) () _
596+typedUnionOrderByLimit =
597+ (from usersTable # select @"name")
598+ `union` (from usersTable # select @"name")
599+ # orderBy @"name"
600+ # limit @"10"
601+
602+typedIntersect
603+ :: Q _ (name :: String) () _
604+typedIntersect = (from usersTable # select @"name")
605+ `intersect` (from usersTable # select @"name")
606+
607+typedExcept
608+ :: Q _ (name :: String) () _
609+typedExcept = (from usersTable # select @"name")
610+ `except_` (from usersTable # select @"name")
611+
612+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
613+-- WHERE features
614+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
615+
616+typedBetween
617+ :: Q _ _ (lo :: Int, hi :: Int) _
618+typedBetween = from usersTable # selectAll # where_ @"age BETWEEN $lo AND $hi"
619+
620+typedIsNull
621+ :: Q _ _ () _
622+typedIsNull = from usersTable # selectAll # where_ @"age IS NULL"
623+
624+typedIsNotNull
625+ :: Q _ _ () _
626+typedIsNotNull = from usersTable # selectAll # where_ @"age IS NOT NULL"
627+
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+
640+typedNestedParens
641+ :: Q _ _ (a :: Int, b :: Int, name :: String) _
642+typedNestedParens = from usersTable # selectAll
643+ # where_ @"(age > $a OR age < $b) AND name = $name"
644+
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+
745+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
746+-- Spec
747+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
748+
749+spec :: Spec Unit
750+spec = do
751+ describe "Schema" do
752+ describe "CREATE TABLE DDL" do
753+ it "generates correct DDL for UsersTable" do
754+ ddl `shouldEqual` "CREATE TABLE users (age INTEGER, email TEXT NOT NULL UNIQUE, id INTEGER NOT NULL GENERATED ALWAYS AS IDENTITY PRIMARY KEY, name TEXT NOT NULL)"
755+
756+ describe "Extended types DDL" do
757+ it "generates DDL with JSONB, TIMESTAMPTZ, BIGINT, arrays" do
758+ eventsDDL `shouldEqual` "CREATE TABLE events (created_at TIMESTAMPTZ NOT NULL, id INTEGER NOT NULL GENERATED ALWAYS AS IDENTITY PRIMARY KEY, metadata JSONB NOT NULL, tags TEXT[] NOT NULL, title TEXT NOT NULL, view_count BIGINT NOT NULL)"
759+
760+ describe "INSERT SQL" do
761+ it "generates INSERT skipping AutoIncrement columns" do
762+ insertSQL `shouldEqual` "INSERT INTO users (age, email, name) VALUES ($1, $2, $3) RETURNING *"
763+
764+ describe "SELECT SQL" do
765+ it "generates SELECT ALL" do
766+ selectAllSQL `shouldEqual` "SELECT * FROM users"
767+ it "generates SELECT WHERE" do
768+ selectWhereSQL `shouldEqual` "SELECT * FROM users WHERE id = $1"
769+
770+ describe "Defaults" do
771+ it "renders DEFAULT in DDL" do
772+ configDDL `shouldEqual` "CREATE TABLE config (active BOOLEAN NOT NULL DEFAULT true, id INTEGER NOT NULL GENERATED ALWAYS AS IDENTITY PRIMARY KEY, role TEXT NOT NULL DEFAULT 'user', score INTEGER NOT NULL DEFAULT 0)"
773+ it "skips Default columns in INSERT" do
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)"
795+
796+ describe "UPDATE SQL" do
797+ it "generates UPDATE with SET and WHERE" do
798+ updateSQL `shouldEqual` "UPDATE users SET name = $1 WHERE id = $2"
799+
800+ describe "DELETE SQL" do
801+ it "generates DELETE with WHERE" do
802+ deleteSQL `shouldEqual` "DELETE FROM users WHERE id = $1"
803+
804+ describe "Builder API" do
805+ it "builds SELECT *" do
806+ builderSelectAll `shouldEqual` "SELECT * FROM users"
807+ it "builds SELECT with columns" do
808+ builderSelectCols `shouldEqual` "SELECT name, email FROM users"
809+ it "builds SELECT * with WHERE" do
810+ builderSelectWhere `shouldEqual` "SELECT * FROM users WHERE id = $id"
811+ it "builds SELECT columns with WHERE" do
812+ builderSelectColsWhere `shouldEqual` "SELECT name FROM users WHERE age > $age"
813+ it "builds SELECT with aliases" do
814+ builderSelectAlias `shouldEqual` "SELECT name, email AS e FROM users"
815+ it "builds complex WHERE" do
816+ builderWhereComplex `shouldEqual` "SELECT * FROM users WHERE name = $name AND age > $age"
817+
818+ describe "Builder INSERT" do
819+ it "builds INSERT" do
820+ builderInsert `shouldEqual` "INSERT INTO users (age, email, name) VALUES ($1, $2, $3)"
821+ it "builds INSERT with RETURNING" do
822+ builderInsertReturning `shouldEqual` "INSERT INTO users (email, name) VALUES ($1, $2) RETURNING id, name"
823+
824+ describe "Builder UPDATE" do
825+ it "builds UPDATE SET" do
826+ builderSet `shouldEqual` "UPDATE users SET name = $1"
827+ it "builds UPDATE SET with WHERE" do
828+ builderSetWhere `shouldEqual` "UPDATE users SET name = $1 WHERE id = $id"
829+
830+ describe "Builder ON CONFLICT" do
831+ it "builds INSERT ON CONFLICT DO NOTHING" do
832+ builderUpsert `shouldEqual` "INSERT INTO users (age, email, name) VALUES ($1, $2, $3) ON CONFLICT (email) DO NOTHING"
833+
834+ describe "Builder DELETE" do
835+ it "builds DELETE with WHERE" do
836+ builderDelete `shouldEqual` "DELETE FROM users WHERE id = $id"
837+ it "builds DELETE with RETURNING" do
838+ builderDeleteReturning `shouldEqual` "DELETE FROM users WHERE id = $id RETURNING name, email"
839+
840+ describe "Builder ORDER BY / LIMIT / OFFSET" do
841+ it "builds ORDER BY" do
842+ builderOrderBy `shouldEqual` "SELECT * FROM users ORDER BY name"
843+ it "builds ORDER BY with DESC/ASC" do
844+ builderOrderByDesc `shouldEqual` "SELECT * FROM users ORDER BY name DESC, age ASC"
845+ it "builds LIMIT and OFFSET" do
846+ builderLimitOffset `shouldEqual` "SELECT * FROM users ORDER BY name LIMIT 10 OFFSET 5"
847+
848+ describe "Builder JOIN" do
849+ it "builds INNER JOIN with SELECT and WHERE" do
850+ typedInnerJoinSQL `shouldEqual` "SELECT users.name, posts.title FROM users INNER JOIN posts ON users.id = posts.user_id WHERE users.age > $age"
851+ it "builds LEFT JOIN" do
852+ typedLeftJoinSQL `shouldEqual` "SELECT users.name, posts.title FROM users LEFT JOIN posts ON users.id = posts.user_id"
853+ it "builds JOIN with ORDER BY, LIMIT, OFFSET" do
854+ (typedJoinLimitOffset # toSQL) `shouldEqual` "SELECT users.name, posts.title FROM users INNER JOIN posts ON users.id = posts.user_id ORDER BY users.name LIMIT 10 OFFSET 5"
855+ it "builds multi-way JOIN" do
856+ (typedMultiJoin # toSQL) `shouldEqual` "SELECT users.name, posts.title, comments.text FROM users INNER JOIN posts ON users.id = posts.user_id INNER JOIN comments ON posts.id = comments.post_id"
857+
858+ describe "Builder table aliases" do
859+ it "builds FROM with alias" do
860+ (typedFromAs # toSQL) `shouldEqual` "SELECT u.name FROM users u"
861+ it "builds self-join with innerJoinAs" do
862+ (typedSelfJoin # toSQL) `shouldEqual` "SELECT users.name, managers.name AS manager_name FROM users INNER JOIN users managers ON users.id = managers.id"
863+ it "builds both sides aliased" do
864+ (typedBothAliased # toSQL) `shouldEqual` "SELECT u1.name, u2.name AS other_name FROM users u1 INNER JOIN users u2 ON u1.id = u2.id"
865+ it "builds LEFT JOIN with alias" do
866+ (typedLeftJoinAs # toSQL) `shouldEqual` "SELECT users.name, u2.email AS other_email FROM users LEFT JOIN users u2 ON users.id = u2.id"
867+
868+ describe "Builder DISTINCT" do
869+ it "builds SELECT DISTINCT" do
870+ (typedDistinct # toSQL) `shouldEqual` "SELECT DISTINCT name FROM users"
871+ it "builds SELECT DISTINCT ON" do
872+ (typedDistinctOn # toSQL) `shouldEqual` "SELECT DISTINCT ON (name) name, email FROM users"
873+
874+ describe "Builder GROUP BY, HAVING, Aggregates" do
875+ it "builds GROUP BY" do
876+ (typedGroupBy # toSQL) `shouldEqual` "SELECT name FROM users GROUP BY name"
877+ it "builds COUNT(*)" do
878+ (typedCountStar # toSQL) `shouldEqual` "SELECT name, COUNT(*) AS cnt FROM users GROUP BY name"
879+ it "builds SUM(col)" do
880+ (typedSumAge # toSQL) `shouldEqual` "SELECT name, SUM(age) AS total FROM users GROUP BY name"
881+ it "builds AVG(col)" do
882+ (typedAvgAge # toSQL) `shouldEqual` "SELECT name, AVG(age) AS avg_age FROM users GROUP BY name"
883+ it "builds MIN/MAX" do
884+ (typedMinMax # toSQL) `shouldEqual` "SELECT name, MIN(age) AS youngest, MAX(age) AS oldest FROM users GROUP BY name"
885+ it "builds HAVING" do
886+ (typedHaving # toSQL) `shouldEqual` "SELECT name, COUNT(*) AS cnt FROM users GROUP BY name HAVING COUNT(*) > $minCount"
887+ it "builds full aggregate chain" do
888+ (typedFullAggregate # toSQL) `shouldEqual` "SELECT name, COUNT(*) AS cnt FROM users GROUP BY name HAVING COUNT(*) > $min ORDER BY name LIMIT 10"
889+ it "builds WHERE + GROUP BY + HAVING" do
890+ (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"
893+
894+ describe "Builder window functions" do
895+ it "builds ROW_NUMBER() OVER" do
896+ (typedRowNumber # toSQL) `shouldEqual` "SELECT name, ROW_NUMBER() OVER (ORDER BY age) AS rn FROM users"
897+ it "builds RANK() OVER with PARTITION BY" do
898+ (typedRank # toSQL) `shouldEqual` "SELECT name, RANK() OVER (PARTITION BY name ORDER BY age DESC) AS rnk FROM users"
899+ it "builds DENSE_RANK() OVER" do
900+ (typedDenseRank # toSQL) `shouldEqual` "SELECT name, DENSE_RANK() OVER (ORDER BY age) AS dr FROM users"
901+ it "builds LAG(col) OVER" do
902+ (typedLag # toSQL) `shouldEqual` "SELECT name, LAG(age) OVER (ORDER BY id) AS prev_age FROM users"
903+ it "builds LEAD(col) OVER" do
904+ (typedLead # toSQL) `shouldEqual` "SELECT name, LEAD(age) OVER (ORDER BY id) AS next_age FROM users"
905+ it "builds FIRST_VALUE(col) OVER" do
906+ (typedFirstValue # toSQL) `shouldEqual` "SELECT name, FIRST_VALUE(name) OVER (ORDER BY age) AS first_name FROM users"
907+ it "builds NTILE(n) OVER" do
908+ (typedNtile # toSQL) `shouldEqual` "SELECT name, NTILE(4) OVER (ORDER BY age) AS bucket FROM users"
909+
910+ describe "Builder parameterized LIMIT/OFFSET" do
911+ it "builds LIMIT with param" do
912+ (typedLimitParam # toSQL) `shouldEqual` "SELECT name FROM users LIMIT $n"
913+ it "builds OFFSET with param" do
914+ (typedOffsetParam # toSQL) `shouldEqual` "SELECT name FROM users OFFSET $n"
915+ it "combines WHERE params with LIMIT param" do
916+ (typedLimitParamWithWhere # toSQL) `shouldEqual` "SELECT name FROM users WHERE age > $age LIMIT $n"
917+
918+ describe "Builder UNION / INTERSECT / EXCEPT" do
919+ it "builds UNION" do
920+ (typedUnion # toSQL) `shouldEqual` "(SELECT name FROM users) UNION (SELECT name FROM users)"
921+ it "builds UNION ALL" do
922+ (typedUnionAll # toSQL) `shouldEqual` "(SELECT name FROM users) UNION ALL (SELECT name FROM users)"
923+ it "builds UNION with params from both sides" do
924+ (typedUnionWithParams # toSQL) `shouldEqual` "(SELECT name FROM users WHERE age > $a) UNION (SELECT name FROM users WHERE age < $b)"
925+ it "builds UNION with ORDER BY and LIMIT" do
926+ (typedUnionOrderByLimit # toSQL) `shouldEqual` "(SELECT name FROM users) UNION (SELECT name FROM users) ORDER BY name LIMIT 10"
927+ it "builds INTERSECT" do
928+ (typedIntersect # toSQL) `shouldEqual` "(SELECT name FROM users) INTERSECT (SELECT name FROM users)"
929+ it "builds EXCEPT" do
930+ (typedExcept # toSQL) `shouldEqual` "(SELECT name FROM users) EXCEPT (SELECT name FROM users)"
931+
932+ describe "Builder WHERE features" do
933+ it "builds BETWEEN" do
934+ (typedBetween # toSQL) `shouldEqual` "SELECT * FROM users WHERE age BETWEEN $lo AND $hi"
935+ it "builds IS NULL" do
936+ (typedIsNull # toSQL) `shouldEqual` "SELECT * FROM users WHERE age IS NULL"
937+ it "builds IS NOT NULL" do
938+ (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"
945+ it "builds nested parentheses" do
946+ (typedNestedParens # toSQL) `shouldEqual` "SELECT * FROM users WHERE (age > $a OR age < $b) AND name = $name"
947+
948+resetUsers :: PG.Connection -> Aff Unit
949+resetUsers conn = do
950+ _ <- PG.executeSimple (PG.SQL "DELETE FROM users") conn
951+ _ <- PG.executeSimple (PG.SQL "ALTER SEQUENCE users_id_seq RESTART WITH 1") conn
952+ _ <- PG.execute (PG.SQL "INSERT INTO users (name, email, age) VALUES ($1, $2, $3)")
953+ [ PG.toPGValue "Alice", PG.toPGValue "alice@example.com", PG.toPGValue 22 ]
954+ conn
955+ _ <- PG.execute (PG.SQL "INSERT INTO users (name, email, age) VALUES ($1, $2, $3)")
956+ [ PG.toPGValue "Bob", PG.toPGValue "bob@example.com", PG.toPGValue 30 ]
957+ conn
958+ pure unit
959+
960+integrationSpec :: PG.Connection -> Spec Unit
961+integrationSpec conn = do
962+ describe "Builder query execution" do
963+ it "selectAll returns all rows" do
964+ resetUsers conn
965+ rows <- from usersTable # select @"name, email, age"
966+ # orderBy @"name"
967+ # runQuery conn {}
968+ rows `shouldEqual`
969+ [ { name: "Alice", email: "alice@example.com", age: Just 22 }
970+ , { name: "Bob", email: "bob@example.com", age: Just 30 }
971+ ]
972+
973+ it "select with columns returns projected rows" do
974+ rows <- from usersTable
975+ # select @"name, email"
976+ # where_ @"age > $age"
977+ # runQuery conn { age: 25 }
978+ rows `shouldEqual` [ { name: "Bob", email: "bob@example.com" } ]
979+
980+ it "select with alias" do
981+ rows <- from usersTable
982+ # select @"name, email AS e"
983+ # orderBy @"name"
984+ # runQuery conn {}
985+ rows `shouldEqual`
986+ [ { name: "Alice", e: "alice@example.com" }
987+ , { name: "Bob", e: "bob@example.com" }
988+ ]
989+
990+ it "runQueryOne returns Just for match" do
991+ result <- from usersTable
992+ # select @"name, email"
993+ # where_ @"name = $name"
994+ # runQueryOne conn { name: "Alice" }
995+ result `shouldEqual` Just { name: "Alice", email: "alice@example.com" }
996+
997+ it "runQueryOne returns Nothing for no match" do
998+ result <- from usersTable
999+ # selectAll
1000+ # where_ @"name = $name"
1001+ # runQueryOne conn { name: "Nobody" }
1002+ result `shouldEqual` Nothing
1003+
1004+ describe "Extended types execution" do
1005+ it "inserts and selects Jsonb, Array, DateTime, BigInt" do
1006+ _ <- from eventsTable
1007+ # insert
1008+ { title: "Launch"
1009+ , metadata: Jsonb (unsafeToForeign { key: "value", nested: { a: 1 } })
1010+ , tags: [ "release", "v1" ]
1011+ , created_at: testDateTime
1012+ , view_count: BigInt.fromInt 42
1013+ }
1014+ # runExecute conn {}
1015+ rows <- from eventsTable
1016+ # select @"title, tags, view_count"
1017+ # where_ @"title = $title"
1018+ # runQuery conn { title: "Launch" }
1019+ rows `shouldEqual` [ { title: "Launch", tags: [ "release", "v1" ], view_count: BigInt.fromInt 42 } ]
1020+
1021+ it "inserts with returningAll" do
1022+ rows <- from eventsTable
1023+ # insert { title: "Minimal", metadata: Jsonb (unsafeToForeign {}), tags: ([] :: Array String), created_at: testDateTime, view_count: BigInt.fromInt 0 }
1024+ # returning @"title"
1025+ # runQuery conn {}
1026+ rows `shouldEqual` [ { title: "Minimal" } ]
1027+
1028+ it "WHERE with JSONB @> operator" do
1029+ rows <- from eventsTable
1030+ # select @"title"
1031+ # where_ @"metadata @> $metadata"
1032+ # runQuery conn { metadata: Jsonb (unsafeToForeign { key: "value" }) }
1033+ rows `shouldEqual` [ { title: "Launch" } ]
1034+
1035+ it "WHERE with = ANY() array param" do
1036+ rows <- from usersTable
1037+ # select @"name"
1038+ # where_ @"id = ANY($id)"
1039+ # orderBy @"name"
1040+ # runQuery conn { id: [ 1, 2 ] }
1041+ rows `shouldEqual` [ { name: "Alice" }, { name: "Bob" } ]
1042+
1043+ it "complex where with multiple params" do
1044+ rows <- from usersTable
1045+ # select @"name, age"
1046+ # where_ @"name = $name AND age > $age"
1047+ # runQuery conn { name: "Bob", age: 20 }
1048+ rows `shouldEqual` [ { name: "Bob", age: Just 30 } ]
1049+
1050+ describe "Builder insert execution" do
1051+ it "inserts a row and returns count" do
1052+ resetUsers conn
1053+ count <- from usersTable
1054+ # insert { name: "Charlie", email: "charlie@example.com", age: Just 28 }
1055+ # runExecute conn {}
1056+ count `shouldEqual` 1
1057+ rows <- from usersTable
1058+ # select @"name"
1059+ # where_ @"name = $name"
1060+ # runQuery conn { name: "Charlie" }
1061+ rows `shouldEqual` [ { name: "Charlie" } ]
1062+
1063+ it "inserts with RETURNING" do
1064+ rows <- from usersTable
1065+ # insert { name: "Diana", email: "diana@example.com" }
1066+ # returning @"name, email"
1067+ # runQuery conn {}
1068+ rows `shouldEqual` [ { name: "Diana", email: "diana@example.com" } ]
1069+
1070+ describe "Builder update execution" do
1071+ it "updates a row" do
1072+ resetUsers conn
1073+ count <- update usersTable
1074+ # set { email: "alice-updated@example.com" }
1075+ # where_ @"name = $name"
1076+ # runExecute conn { name: "Alice" }
1077+ count `shouldEqual` 1
1078+ result <- from usersTable
1079+ # select @"email"
1080+ # where_ @"name = $name"
1081+ # runQueryOne conn { name: "Alice" }
1082+ result `shouldEqual` Just { email: "alice-updated@example.com" }
1083+
1084+ it "updates with RETURNING" do
1085+ rows <- update usersTable
1086+ # set { age: Just 99 }
1087+ # where_ @"name = $name"
1088+ # returning @"name, age"
1089+ # runQuery conn { name: "Bob" }
1090+ rows `shouldEqual` [ { name: "Bob", age: Just 99 } ]
1091+
1092+ describe "Builder upsert execution" do
1093+ it "ON CONFLICT DO NOTHING skips duplicate" do
1094+ resetUsers conn
1095+ count <- from usersTable
1096+ # insert { name: "Duplicate", email: "bob@example.com" }
1097+ # onConflictDoNothing @"email"
1098+ # runExecute conn {}
1099+ count `shouldEqual` 0
1100+
1101+ it "ON CONFLICT DO UPDATE" do
1102+ rows <- from usersTable
1103+ # insert { name: "Updated", email: "bob@example.com", age: Just 40 }
1104+ # onConflict @"email" @"DO UPDATE SET name = EXCLUDED.name, age = EXCLUDED.age"
1105+ # returning @"name, age"
1106+ # runQuery conn {}
1107+ rows `shouldEqual` [ { name: "Updated", age: Just 40 } ]
1108+
1109+ describe "Builder order by / limit / offset execution" do
1110+ it "ORDER BY sorts results" do
1111+ resetUsers conn
1112+ rows <- from usersTable
1113+ # select @"name"
1114+ # orderBy @"name ASC"
1115+ # runQuery conn {}
1116+ rows `shouldEqual` [ { name: "Alice" }, { name: "Bob" } ]
1117+
1118+ it "LIMIT restricts row count" do
1119+ rows <- from usersTable
1120+ # select @"name"
1121+ # orderBy @"name"
1122+ # limit @"1"
1123+ # runQuery conn {}
1124+ rows `shouldEqual` [ { name: "Alice" } ]
1125+
1126+ it "OFFSET skips rows" do
1127+ rows <- from usersTable
1128+ # select @"name"
1129+ # orderBy @"name ASC"
1130+ # limit @"1"
1131+ # offset @"1"
1132+ # runQuery conn {}
1133+ rows `shouldEqual` [ { name: "Bob" } ]
1134+
1135+ describe "Builder delete execution" do
1136+ it "deletes with RETURNING" do
1137+ resetUsers conn
1138+ _ <- from usersTable
1139+ # insert { name: "ToDelete", email: "delete@example.com", age: Just 50 }
1140+ # runExecute conn {}
1141+ rows <- from usersTable
1142+ # delete
1143+ # where_ @"name = $name"
1144+ # returning @"name, email"
1145+ # runQuery conn { name: "ToDelete" }
1146+ rows `shouldEqual` [ { name: "ToDelete", email: "delete@example.com" } ]
1147+ result <- from usersTable
1148+ # select @"name"
1149+ # where_ @"name = $name"
1150+ # runQueryOne conn { name: "ToDelete" }
1151+ result `shouldEqual` Nothing
1152+
1153+ describe "Builder JOIN execution" do
1154+ it "INNER JOIN returns matching rows" do
1155+ resetUsers conn
1156+ rows <- from usersTable
1157+ # innerJoin @"users.id = posts.user_id" postsTable
1158+ # select @"users.name, posts.title"
1159+ # orderBy @"users.name"
1160+ # runQuery conn {}
1161+ rows `shouldEqual`
1162+ [ { name: "Alice", title: "Alice's Post" }
1163+ , { name: "Bob", title: "Bob's Post" }
1164+ ]
1165+
1166+ it "INNER JOIN with WHERE filters correctly" do
1167+ rows <- from usersTable
1168+ # innerJoin @"users.id = posts.user_id" postsTable
1169+ # select @"users.name, posts.title"
1170+ # where_ @"users.age > $age"
1171+ # runQuery conn { age: 25 }
1172+ rows `shouldEqual` [ { name: "Bob", title: "Bob's Post" } ]
1173+
1174+ it "INNER JOIN with aliases" do
1175+ rows <- from usersTable
1176+ # innerJoin @"users.id = posts.user_id" postsTable
1177+ # select @"users.name AS author, posts.title AS post_title"
1178+ # orderBy @"users.name"
1179+ # runQuery conn {}
1180+ rows `shouldEqual`
1181+ [ { author: "Alice", post_title: "Alice's Post" }
1182+ , { author: "Bob", post_title: "Bob's Post" }
1183+ ]
1184+
1185+ it "INNER JOIN with ORDER BY and LIMIT" do
1186+ rows <- from usersTable
1187+ # innerJoin @"users.id = posts.user_id" postsTable
1188+ # select @"users.name, posts.title"
1189+ # orderBy @"users.name ASC"
1190+ # limit @"1"
1191+ # runQuery conn {}
1192+ rows `shouldEqual` [ { name: "Alice", title: "Alice's Post" } ]
1193+
1194+ it "LEFT JOIN includes unmatched rows" do
1195+ _ <- PG.execute (PG.SQL "INSERT INTO users (name, email, age) VALUES ($1, $2, $3)")
1196+ [ PG.toPGValue "NoPost", PG.toPGValue "nopost@example.com", PG.toPGValue 40 ]
1197+ conn
1198+ rows <- from usersTable
1199+ # leftJoin @"users.id = posts.user_id" postsTable
1200+ # select @"users.name, posts.title"
1201+ # orderBy @"users.name ASC"
1202+ # runQuery conn {}
1203+ rows `shouldEqual`
1204+ [ { name: "Alice", title: Just "Alice's Post" }
1205+ , { name: "Bob", title: Just "Bob's Post" }
1206+ , { name: "NoPost", title: Nothing }
1207+ ]
1208+ _ <- PG.execute (PG.SQL "DELETE FROM users WHERE name = $1")
1209+ [ PG.toPGValue "NoPost" ]
1210+ conn
1211+ pure unit
1212+
1213+ it "runQueryOne returns Just for match" do
1214+ result <- from usersTable
1215+ # innerJoin @"users.id = posts.user_id" postsTable
1216+ # select @"users.name, posts.title"
1217+ # where_ @"users.name = $name"
1218+ # runQueryOne conn { name: "Alice" }
1219+ result `shouldEqual` Just { name: "Alice", title: "Alice's Post" }
1220+
1221+ describe "Parameterized LIMIT/OFFSET execution" do
1222+ it "parameterized LIMIT restricts rows" do
1223+ resetUsers conn
1224+ rows <- from usersTable # select @"name" # orderBy @"name"
1225+ # limit @"$n"
1226+ # runQuery conn { n: 1 }
1227+ rows `shouldEqual` [ { name: "Alice" } ]
1228+
1229+ it "parameterized OFFSET skips rows" do
1230+ rows <- from usersTable # select @"name" # orderBy @"name"
1231+ # limit @"$n"
1232+ # offset @"$off"
1233+ # runQuery conn { n: 1, off: 1 }
1234+ rows `shouldEqual` [ { name: "Bob" } ]
1235+
1236+ it "parameterized LIMIT with WHERE" do
1237+ rows <- from usersTable # select @"name"
1238+ # where_ @"age > $age"
1239+ # orderBy @"name"
1240+ # limit @"$n"
1241+ # runQuery conn { age: 0, n: 1 }
1242+ rows `shouldEqual` [ { name: "Alice" } ]
1243+
1244+ describe "UNION / INTERSECT / EXCEPT execution" do
1245+ it "UNION deduplicates" do
1246+ resetUsers conn
1247+ rows <-
1248+ (from usersTable # select @"name")
1249+ # union (from usersTable # select @"name")
1250+ # orderBy @"name"
1251+ # runQuery conn {}
1252+ rows `shouldEqual` [ { name: "Alice" }, { name: "Bob" } ]
1253+
1254+ it "UNION ALL keeps duplicates" do
1255+ rows <-
1256+ (from usersTable # select @"name")
1257+ # unionAll (from usersTable # select @"name")
1258+ # orderBy @"name"
1259+ # runQuery conn {}
1260+ rows `shouldEqual`
1261+ [ { name: "Alice" }
1262+ , { name: "Alice" }
1263+ , { name: "Bob" }
1264+ , { name: "Bob" }
1265+ ]
1266+
1267+ it "UNION with params from both sides" do
1268+ rows <-
1269+ (from usersTable # select @"name" # where_ @"age > $maxAge")
1270+ # union (from usersTable # select @"name" # where_ @"age < $minAge")
1271+ # runQuery conn { maxAge: 100, minAge: 18 }
1272+ rows `shouldEqual` []
1273+
1274+ it "INTERSECT returns common rows" do
1275+ rows <-
1276+ (from usersTable # select @"name")
1277+ # intersect (from usersTable # select @"name")
1278+ # orderBy @"name"
1279+ # runQuery conn {}
1280+ rows `shouldEqual` [ { name: "Alice" }, { name: "Bob" } ]
1281+
1282+ it "EXCEPT removes matching rows" do
1283+ rows <-
1284+ (from usersTable # select @"name")
1285+ `except_` (from usersTable # select @"name" # where_ @"name = $name")
1286+ # runQuery conn { name: "Alice" }
1287+ rows `shouldEqual` [ { name: "Bob" } ]
1288+
1289+ it "UNION with ORDER BY and LIMIT" do
1290+ rows <-
1291+ (from usersTable # select @"name")
1292+ `union` (from usersTable # select @"name")
1293+ # orderBy @"name"
1294+ # limit @"1"
1295+ # runQuery conn {}
1296+ rows `shouldEqual` [ { name: "Alice" } ]
1297+
1298+ describe "WHERE features execution" do
1299+ it "BETWEEN filters range" do
1300+ resetUsers conn
1301+ rows <- from usersTable # select @"name"
1302+ # where_ @"age BETWEEN $lo AND $hi"
1303+ # runQuery conn { lo: 20, hi: 26 }
1304+ rows `shouldEqual` [ { name: "Alice" } ]
1305+
1306+ it "IS NULL matches null values" do
1307+ _ <- from usersTable
1308+ # insert { name: "NullAge", email: "nullage@example.com" }
1309+ # runExecute conn {}
1310+ rows <- from usersTable # select @"name"
1311+ # where_ @"age IS NULL"
1312+ # runQuery conn {}
1313+ rows `shouldEqual` [ { name: "NullAge" } ]
1314+ _ <- PG.execute (PG.SQL "DELETE FROM users WHERE name = $1")
1315+ [ PG.toPGValue "NullAge" ]
1316+ conn
1317+ pure unit
1318+
1319+ it "IS NOT NULL excludes null values" do
1320+ _ <- from usersTable
1321+ # insert { name: "NullAge2", email: "nullage2@example.com" }
1322+ # runExecute conn {}
1323+ rows <- from usersTable # select @"name"
1324+ # where_ @"age IS NOT NULL"
1325+ # orderBy @"name"
1326+ # runQuery conn {}
1327+ rows `shouldEqual` [ { name: "Alice" }, { name: "Bob" } ]
1328+ _ <- PG.execute (PG.SQL "DELETE FROM users WHERE name = $1")
1329+ [ PG.toPGValue "NullAge2" ]
1330+ conn
1331+ pure unit
1332+
1333+ it "nested parentheses" do
1334+ rows <- from usersTable # select @"name"
1335+ # where_ @"(age > $a OR age < $b) AND name = $name"
1336+ # runQuery conn { a: 100, b: 0, name: "Alice" }
1337+ rows `shouldEqual` ([] :: Array { name :: String })
1338+
1339+ describe "HAVING with WHERE params" do
1340+ it "WHERE + GROUP BY + HAVING merges params" do
1341+ resetUsers conn
1342+ rows <- from usersTable
1343+ # select @"name"
1344+ # where_ @"age > $age"
1345+ # groupBy @"name"
1346+ # having @"COUNT(*) > $minCount"
1347+ # orderBy @"name"
1348+ # runQuery conn { age: 10, minCount: 0 }
1349+ rows `shouldEqual` [ { name: "Alice" }, { name: "Bob" } ]
1350+
1351+ describe "UUID + DefaultExpr execution" do
1352+ it "creates sessions table from DDL" do
1353+ _ <- PG.executeSimple (PG.SQL "DELETE FROM sessions") conn
1354+ pure unit
1355+
1356+ it "inserts with server-generated UUID and timestamp" do
1357+ _ <- PG.executeSimple (PG.SQL "DELETE FROM sessions") conn
1358+ count <- from sessionsTable
1359+ # insert { user_id: 1, token: "sess-abc" }
1360+ # runExecute conn {}
1361+ count `shouldEqual` 1
1362+
1363+ it "selects back UUID column" do
1364+ rows <- from sessionsTable
1365+ # select @"id, token"
1366+ # where_ @"token = $token"
1367+ # runQuery conn { token: "sess-abc" }
1368+ let len = Array.length rows
1369+ len `shouldEqual` 1
1370+ do
1371+ let row = unsafePartial fromJust (Array.head rows)
1372+ let uuidStr = UUID.toString (un PGUUID row.id)
1373+ String.length uuidStr `shouldEqual` 36
1374+ row.token `shouldEqual` "sess-abc"
1375+
1376+ describe "PGDate + PGTime execution" do
1377+ it "round-trips date and time values" do
1378+ _ <- PG.executeSimple (PG.SQL "DELETE FROM schedule") conn
1379+ _ <- PG.executeSimple (PG.SQL "ALTER SEQUENCE schedule_id_seq RESTART WITH 1") conn
1380+ _ <- PG.execute
1381+ (PG.SQL "INSERT INTO schedule (event_date, start_time, title) VALUES ($1::date, $2::time, $3)")
1382+ [ PG.toPGValue "2025-06-15", PG.toPGValue "14:30:00", PG.toPGValue "Meeting" ]
1383+ conn
1384+ rows <- from scheduleTable
1385+ # select @"event_date, start_time, title"
1386+ # where_ @"title = $title"
1387+ # runQuery conn { title: "Meeting" }
1388+ let
1389+ expectedDate = unsafePartial do
1390+ let y = fromJust (toEnum 2025)
1391+ let m = fromJust (toEnum 6)
1392+ let d = fromJust (toEnum 15)
1393+ PGDate (canonicalDate y m d)
1394+ let
1395+ expectedTime = unsafePartial do
1396+ let h = fromJust (toEnum 14)
1397+ let mi = fromJust (toEnum 30)
1398+ let s = fromJust (toEnum 0)
1399+ let ms = fromJust (toEnum 0)
1400+ PGTime (Time h mi s ms)
1401+ rows `shouldEqual` [ { event_date: expectedDate, start_time: expectedTime, title: "Meeting" } ]
1402+
1403+ describe "Point execution" do
1404+ it "round-trips point values" do
1405+ _ <- PG.executeSimple (PG.SQL "DELETE FROM locations") conn
1406+ _ <- PG.executeSimple (PG.SQL "ALTER SEQUENCE locations_id_seq RESTART WITH 1") conn
1407+ _ <- PG.execute
1408+ (PG.SQL "INSERT INTO locations (name, coords) VALUES ($1, point($2, $3))")
1409+ [ PG.toPGValue "HQ", PG.toPGValue 40.7, PG.toPGValue (-74.0) ]
1410+ conn
1411+ rows <- from locationsTable
1412+ # select @"name, coords"
1413+ # where_ @"name = $name"
1414+ # runQuery conn { name: "HQ" }
1415+ rows `shouldEqual` [ { name: "HQ", coords: Point { x: 40.7, y: -74.0 } } ]
1416+
1417+ describe "TSVector + TSQuery execution" do
1418+ it "inserts and queries with full-text search" do
1419+ _ <- PG.executeSimple (PG.SQL "DELETE FROM articles") conn
1420+ _ <- PG.executeSimple (PG.SQL "ALTER SEQUENCE articles_id_seq RESTART WITH 1") conn
1421+ _ <- PG.execute
1422+ (PG.SQL "INSERT INTO articles (title, body_vector) VALUES ($1, to_tsvector($2))")
1423+ [ PG.toPGValue "PureScript Rocks", PG.toPGValue "purescript is a strongly typed functional language" ]
1424+ conn
1425+ _ <- PG.execute
1426+ (PG.SQL "INSERT INTO articles (title, body_vector) VALUES ($1, to_tsvector($2))")
1427+ [ PG.toPGValue "Haskell Guide", PG.toPGValue "haskell is a lazy functional language" ]
1428+ conn
1429+ rows <- from articlesTable
1430+ # select @"title"
1431+ # where_ @"body_vector @@ to_tsquery($q)"
1432+ # runQuery conn { q: "purescript" }
1433+ rows `shouldEqual` [ { title: "PureScript Rocks" } ]