44673e3...main · rowtype-yoga/purescript-yoga-postgres

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

130 files changed+7708−183

since splitsnapshots

unifiedsplit

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

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

66 steps:

77 - uses: actions/checkout@v4

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

9− - run: spago build

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

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

11+ - run: spago test

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

13+ - if: always()

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

.gitignore+1

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

33output/

44output-*/

55.DS_Store

6+.psc-ide-port

.psc-ide-port+1−1

@@ -1 +1 @@

1−15553

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

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

3+export const and = function (n1) {

4+ return function (n2) {

5+ /* jshint bitwise: false */

6+ return n1 & n2;

7+ };

8+};

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

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

.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+};

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

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

.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";

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

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

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

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

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

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

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

.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 @@

.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

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

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.lock+3

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

66 "dependencies": {

77 "pg": "^8.11.0",

88 "postgres": "^3.4.8",

9+ "uuid": "^13.0.0",

910 },

1011 },

1112 },

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

3839

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

4041

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

43+

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

4245 }

4346}

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

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

1+-- EXPECT: Aggregate function requires AS alias

2+module Test.CompileFail.AggregateWithoutAlias where

4+import Prelude

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

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

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

8+import Yoga.Postgres.Schema

10+type UsersTable = Table "users"

11+ ( id :: Int # PrimaryKey # AutoIncrement

12+ , name :: String

13+ , email :: String # Unique

14+ , age :: Maybe Int

15+ )

16+

17+usersTable :: Proxy UsersTable

18+usersTable = Proxy

19+

20+bad = from usersTable # select @"COUNT(*)"

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

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

1+-- EXPECT: Lacks

2+module Test.CompileFail.DeleteAfterSelect where

4+import Prelude

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

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

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

8+import Yoga.Postgres.Schema

10+type UsersTable = Table "users"

11+ ( id :: Int # PrimaryKey # AutoIncrement

12+ , name :: String

13+ , email :: String # Unique

14+ , age :: Maybe Int

15+ )

16+

17+usersTable :: Proxy UsersTable

18+usersTable = Proxy

19+

20+bad = from usersTable # selectAll # 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

4+import Prelude

5+import Data.Maybe (Maybe)

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

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

8+import Yoga.Postgres.Schema

10+type UsersTable = Table "users"

11+ ( id :: Int # PrimaryKey # AutoIncrement

12+ , name :: String

13+ , email :: String # Unique

14+ , age :: Maybe Int

15+ )

16+

17+usersTable :: Proxy UsersTable

18+usersTable = Proxy

19+

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

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

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

1+-- EXPECT: Lacks

2+module Test.CompileFail.DoubleGroupBy where

4+import Prelude

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

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

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

8+import Yoga.Postgres.Schema

10+type UsersTable = Table "users"

11+ ( id :: Int # PrimaryKey # AutoIncrement

12+ , name :: String

13+ , email :: String # Unique

14+ , age :: Maybe Int

15+ )

16+

17+usersTable :: Proxy UsersTable

18+usersTable = Proxy

19+

20+bad = from usersTable # select @"name" # groupBy @"name" # groupBy @"name"

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

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

1+-- EXPECT: Lacks

2+module Test.CompileFail.DoubleHaving where

4+import Prelude

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

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

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

8+import Yoga.Postgres.Schema

10+type UsersTable = Table "users"

11+ ( id :: Int # PrimaryKey # AutoIncrement

12+ , name :: String

13+ , email :: String # Unique

14+ , age :: Maybe Int

15+ )

16+

17+usersTable :: Proxy UsersTable

18+usersTable = Proxy

19+

20+bad = from usersTable # select @"name" # 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

4+import Prelude

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

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

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

8+import Yoga.Postgres.Schema

10+type UsersTable = Table "users"

11+ ( id :: Int # PrimaryKey # AutoIncrement

12+ , name :: String

13+ , email :: String # Unique

14+ , age :: Maybe Int

15+ )

16+

17+usersTable :: Proxy UsersTable

18+usersTable = Proxy

19+

20+bad = from usersTable # 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

4+import Prelude

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

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

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

8+import Yoga.Postgres.Schema

10+type UsersTable = Table "users"

11+ ( id :: Int # PrimaryKey # AutoIncrement

12+ , name :: String

13+ , email :: String # Unique

14+ , age :: Maybe Int

15+ )

16+

17+usersTable :: Proxy UsersTable

18+usersTable = Proxy

19+

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

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

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

1+-- EXPECT: Lacks

2+module Test.CompileFail.DoubleOffset where

4+import Prelude

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

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

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

8+import Yoga.Postgres.Schema

10+type UsersTable = Table "users"

11+ ( id :: Int # PrimaryKey # AutoIncrement

12+ , name :: String

13+ , email :: String # Unique

14+ , age :: Maybe Int

15+ )

16+

17+usersTable :: Proxy UsersTable

18+usersTable = Proxy

19+

20+bad = from usersTable # selectAll # offset @"10" # offset @"5"

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

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

1+-- EXPECT: Lacks

2+module Test.CompileFail.DoubleOnConflict where

4+import Prelude

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

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

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

8+import Yoga.Postgres.Schema

10+type UsersTable = Table "users"

11+ ( id :: Int # PrimaryKey # AutoIncrement

12+ , name :: String

13+ , email :: String # Unique

14+ , age :: Maybe Int

15+ )

16+

17+usersTable :: Proxy UsersTable

18+usersTable = Proxy

19+

20+bad = from usersTable # 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

4+import Prelude

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

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

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

8+import Yoga.Postgres.Schema

10+type UsersTable = Table "users"

11+ ( id :: Int # PrimaryKey # AutoIncrement

12+ , name :: String

13+ , email :: String # Unique

14+ , age :: Maybe Int

15+ )

16+

17+usersTable :: Proxy UsersTable

18+usersTable = Proxy

19+

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

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

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

1+-- EXPECT: Lacks

2+module Test.CompileFail.DoubleReturning where

4+import Prelude

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

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

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

8+import Yoga.Postgres.Schema

10+type UsersTable = Table "users"

11+ ( id :: Int # PrimaryKey # AutoIncrement

12+ , name :: String

13+ , email :: String # Unique

14+ , age :: Maybe Int

15+ )

16+

17+usersTable :: Proxy UsersTable

18+usersTable = Proxy

19+

20+bad = from usersTable # 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

4+import Prelude

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

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

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

8+import Yoga.Postgres.Schema

10+type UsersTable = Table "users"

11+ ( id :: Int # PrimaryKey # AutoIncrement

12+ , name :: String

13+ , email :: String # Unique

14+ , age :: Maybe Int

15+ )

16+

17+usersTable :: Proxy UsersTable

18+usersTable = Proxy

19+

20+bad = from usersTable # selectAll # selectAll

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

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

1+-- EXPECT: Lacks

2+module Test.CompileFail.DoubleSet where

4+import Prelude

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

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

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

8+import Yoga.Postgres.Schema

10+type UsersTable = Table "users"

11+ ( id :: Int # PrimaryKey # AutoIncrement

12+ , name :: String

13+ , email :: String # Unique

14+ , age :: Maybe Int

15+ )

16+

17+usersTable :: Proxy UsersTable

18+usersTable = Proxy

19+

20+bad = from usersTable # 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

4+import Prelude

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

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

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

8+import Yoga.Postgres.Schema

10+type UsersTable = Table "users"

11+ ( id :: Int # PrimaryKey # AutoIncrement

12+ , name :: String

13+ , email :: String # Unique

14+ , age :: Maybe Int

15+ )

16+

17+usersTable :: Proxy UsersTable

18+usersTable = Proxy

19+

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

4+import Prelude

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

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

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

8+import Yoga.Postgres.Schema

10+type UsersTable = Table "users"

11+ ( id :: Int # PrimaryKey # AutoIncrement

12+ , name :: String

13+ , email :: String # Unique

14+ , age :: Maybe Int

15+ )

16+

17+usersTable :: Proxy UsersTable

18+usersTable = Proxy

19+

20+bad = from usersTable # selectDistinctOn @"" @"name"

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

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

1+-- EXPECT: Empty column list

2+module Test.CompileFail.EmptyGroupBy where

4+import Prelude

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

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

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

8+import Yoga.Postgres.Schema

10+type UsersTable = Table "users"

11+ ( id :: Int # PrimaryKey # AutoIncrement

12+ , name :: String

13+ , email :: String # Unique

14+ , age :: Maybe Int

15+ )

16+

17+usersTable :: Proxy UsersTable

18+usersTable = Proxy

19+

20+bad = from usersTable # select @"name" # groupBy @""

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

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

1+-- EXPECT: Empty WHERE clause

2+module Test.CompileFail.EmptyWhere where

4+import Prelude

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

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

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

8+import Yoga.Postgres.Schema

10+type UsersTable = Table "users"

11+ ( id :: Int # PrimaryKey # AutoIncrement

12+ , name :: String

13+ , email :: String # Unique

14+ , age :: Maybe Int

15+ )

16+

17+usersTable :: Proxy UsersTable

18+usersTable = Proxy

19+

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

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

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

1+-- EXPECT: Lacks

2+module Test.CompileFail.GroupByAfterUnion where

4+import Prelude

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

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

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

8+import Yoga.Postgres.Schema

10+type UsersTable = Table "users"

11+ ( id :: Int # PrimaryKey # AutoIncrement

12+ , name :: String

13+ , email :: String # Unique

14+ , age :: Maybe Int

15+ )

16+

17+usersTable :: Proxy UsersTable

18+usersTable = Proxy

19+

20+bad = (from usersTable # select @"name") `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

4+import Prelude

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

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

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

8+import Yoga.Postgres.Schema

10+type UsersTable = Table "users"

11+ ( id :: Int # PrimaryKey # AutoIncrement

12+ , name :: String

13+ , email :: String # Unique

14+ , age :: Maybe Int

15+ )

16+

17+usersTable :: Proxy UsersTable

18+usersTable = Proxy

19+

20+bad = from usersTable # groupBy @"name"

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

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

1+-- EXPECT: Cons

2+module Test.CompileFail.HavingBeforeGroupBy where

4+import Prelude

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

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

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

8+import Yoga.Postgres.Schema

10+type UsersTable = Table "users"

11+ ( id :: Int # PrimaryKey # AutoIncrement

12+ , name :: String

13+ , email :: String # Unique

14+ , age :: Maybe Int

15+ )

16+

17+usersTable :: Proxy UsersTable

18+usersTable = Proxy

19+

20+bad = from usersTable # select @"name" # having @"COUNT(*) > 5"

compile-fail-tests/HavingParamDuplicateName.pursnew file+24

@@ -0,0 +1,24 @@

1+-- EXPECT: Nub

2+module Test.CompileFail.HavingParamDuplicateName where

4+import Prelude

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

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

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

8+import Yoga.Postgres.Schema

10+type UsersTable = Table "users"

11+ ( id :: Int # PrimaryKey # AutoIncrement

12+ , name :: String

13+ , email :: String # Unique

14+ , age :: Maybe Int

15+ )

16+

17+usersTable :: Proxy UsersTable

18+usersTable = Proxy

19+

20+bad = from usersTable

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

4+import Prelude

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

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

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

8+import Yoga.Postgres.Schema

10+type UsersTable = Table "users"

11+ ( id :: Int # PrimaryKey # AutoIncrement

12+ , name :: String

13+ , email :: String # Unique

14+ , age :: Maybe Int

15+ )

16+

17+usersTable :: Proxy UsersTable

18+usersTable = Proxy

19+

20+bad = from usersTable # selectAll # 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

4+import Prelude

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

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

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

8+import Yoga.Postgres.Schema

10+type UsersTable = Table "users"

11+ ( id :: Int # PrimaryKey # AutoIncrement

12+ , name :: String

13+ , email :: String # Unique

14+ , age :: Maybe Int

15+ )

16+

17+usersTable :: Proxy UsersTable

18+usersTable = Proxy

19+

20+bad = from usersTable # 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

4+import Prelude

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

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

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

8+import Yoga.Postgres.Schema

10+type UsersTable = Table "users"

11+ ( id :: Int # PrimaryKey # AutoIncrement

12+ , name :: String

13+ , email :: String # Unique

14+ , age :: Maybe Int

15+ )

16+

17+usersTable :: Proxy UsersTable

18+usersTable = Proxy

19+

20+bad = from usersTable # selectDistinctOn @"nonexistent" @"name"

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

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

1+-- EXPECT: NoInstanceFound

2+module Test.CompileFail.InvalidColumnInGroupBy where

4+import Prelude

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

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

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

8+import Yoga.Postgres.Schema

10+type UsersTable = Table "users"

11+ ( id :: Int # PrimaryKey # AutoIncrement

12+ , name :: String

13+ , email :: String # Unique

14+ , age :: Maybe Int

15+ )

16+

17+usersTable :: Proxy UsersTable

18+usersTable = Proxy

19+

20+bad = from usersTable # select @"name" # groupBy @"nonexistent"

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

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

1+-- EXPECT: TypesDoNotUnify

2+module Test.CompileFail.InvalidColumnInOnConflict where

4+import Prelude

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

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

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

8+import Yoga.Postgres.Schema

10+type UsersTable = Table "users"

11+ ( id :: Int # PrimaryKey # AutoIncrement

12+ , name :: String

13+ , email :: String # Unique

14+ , age :: Maybe Int

15+ )

16+

17+usersTable :: Proxy UsersTable

18+usersTable = Proxy

19+

20+bad = from usersTable # 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

4+import Prelude

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

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

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

8+import Yoga.Postgres.Schema

10+type UsersTable = Table "users"

11+ ( id :: Int # PrimaryKey # AutoIncrement

12+ , name :: String

13+ , email :: String # Unique

14+ , age :: Maybe Int

15+ )

16+

17+usersTable :: Proxy UsersTable

18+usersTable = Proxy

19+

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

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

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

1+-- EXPECT: NoInstanceFound

2+module Test.CompileFail.InvalidColumnInSelect where

4+import Prelude

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

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

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

8+import Yoga.Postgres.Schema

10+type UsersTable = Table "users"

11+ ( id :: Int # PrimaryKey # AutoIncrement

12+ , name :: String

13+ , email :: String # Unique

14+ , age :: Maybe Int

15+ )

16+

17+usersTable :: Proxy UsersTable

18+usersTable = Proxy

19+

20+bad = from usersTable # select @"nonexistent"

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

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

1+-- EXPECT: TypesDoNotUnify

2+module Test.CompileFail.InvalidColumnInSet where

4+import Prelude

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

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

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

8+import Yoga.Postgres.Schema

10+type UsersTable = Table "users"

11+ ( id :: Int # PrimaryKey # AutoIncrement

12+ , name :: String

13+ , email :: String # Unique

14+ , age :: Maybe Int

15+ )

16+

17+usersTable :: Proxy UsersTable

18+usersTable = Proxy

19+

20+bad = from usersTable # set { nonexistent: "B" }

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

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

1+-- EXPECT: NoInstanceFound

2+module Test.CompileFail.InvalidColumnInWhere where

4+import Prelude

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

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

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

8+import Yoga.Postgres.Schema

10+type UsersTable = Table "users"

11+ ( id :: Int # PrimaryKey # AutoIncrement

12+ , name :: String

13+ , email :: String # Unique

14+ , age :: Maybe Int

15+ )

16+

17+usersTable :: Proxy UsersTable

18+usersTable = Proxy

19+

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

4+import Prelude

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

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

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

8+import Yoga.Postgres.Schema

10+type UsersTable = Table "users"

11+ ( id :: Int # PrimaryKey # AutoIncrement

12+ , name :: String

13+ , email :: String # Unique

14+ , age :: Maybe Int

15+ )

16+

17+usersTable :: Proxy UsersTable

18+usersTable = Proxy

19+

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

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

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

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

2+module Test.CompileFail.InvalidLimitNegative where

4+import Prelude

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

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

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

8+import Yoga.Postgres.Schema

10+type UsersTable = Table "users"

11+ ( id :: Int # PrimaryKey # AutoIncrement

12+ , name :: String

13+ , email :: String # Unique

14+ , age :: Maybe Int

15+ )

16+

17+usersTable :: Proxy UsersTable

18+usersTable = Proxy

19+

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

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

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

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

2+module Test.CompileFail.InvalidLimitNonNumeric where

4+import Prelude

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

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

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

8+import Yoga.Postgres.Schema

10+type UsersTable = Table "users"

11+ ( id :: Int # PrimaryKey # AutoIncrement

12+ , name :: String

13+ , email :: String # Unique

14+ , age :: Maybe Int

15+ )

16+

17+usersTable :: Proxy UsersTable

18+usersTable = Proxy

19+

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

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

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

1+-- EXPECT: NoInstanceFound

2+module Test.CompileFail.JoinAmbiguousColumn where

4+import Prelude

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

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

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

8+import Yoga.Postgres.Schema

10+type UsersTable = Table "users"

11+ ( id :: Int # PrimaryKey # AutoIncrement

12+ , name :: String

13+ )

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

4+import Prelude

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

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

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

8+import Yoga.Postgres.Schema

10+type UsersTable = Table "users"

11+ ( id :: Int # PrimaryKey # AutoIncrement

12+ , name :: String

13+ )

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

4+import Prelude

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

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

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

8+import Yoga.Postgres.Schema

10+type UsersTable = Table "users"

11+ ( id :: Int # PrimaryKey # AutoIncrement

12+ , name :: String

13+ )

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

4+import Prelude

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

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

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

8+import Yoga.Postgres.Schema

10+type UsersTable = Table "users"

11+ ( id :: Int # PrimaryKey # AutoIncrement

12+ , name :: String

13+ )

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

4+import Prelude

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

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

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

8+import Yoga.Postgres.Schema

10+type UsersTable = Table "users"

11+ ( id :: Int # PrimaryKey # AutoIncrement

12+ , name :: String

13+ , email :: String # Unique

14+ , age :: Maybe Int

15+ )

16+

17+usersTable :: Proxy UsersTable

18+usersTable = Proxy

19+

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

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

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

1+-- EXPECT: Unexpected comma in SELECT clause (missing column name)

2+module Test.CompileFail.LeadingCommaInSelect where

4+import Prelude

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

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

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

8+import Yoga.Postgres.Schema

10+type UsersTable = Table "users"

11+ ( id :: Int # PrimaryKey # AutoIncrement

12+ , name :: String

13+ , email :: String # Unique

14+ , age :: Maybe Int

15+ )

16+

17+usersTable :: Proxy UsersTable

18+usersTable = Proxy

19+

20+bad = from usersTable # select @",name"

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

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

1+-- EXPECT: Cons

2+module Test.CompileFail.LimitBeforeSelect where

4+import Prelude

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

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

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

8+import Yoga.Postgres.Schema

10+type UsersTable = Table "users"

11+ ( id :: Int # PrimaryKey # AutoIncrement

12+ , name :: String

13+ , email :: String # Unique

14+ , age :: Maybe Int

15+ )

16+

17+usersTable :: Proxy UsersTable

18+usersTable = Proxy

19+

20+bad = from usersTable # limit @"10"

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

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

1+-- EXPECT: Cons

2+module Test.CompileFail.LimitOnInsert where

4+import Prelude

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

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

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

8+import Yoga.Postgres.Schema

10+type UsersTable = Table "users"

11+ ( id :: Int # PrimaryKey # AutoIncrement

12+ , name :: String

13+ , email :: String # Unique

14+ , age :: Maybe Int

15+ )

16+

17+usersTable :: Proxy UsersTable

18+usersTable = Proxy

19+

20+bad = from usersTable # 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

4+import Prelude

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

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

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

8+import Yoga.Postgres.Schema

10+type UsersTable = Table "users"

11+ ( id :: Int # PrimaryKey # AutoIncrement

12+ , name :: String

13+ , email :: String # Unique

14+ , age :: Maybe Int

15+ )

16+

17+usersTable :: Proxy UsersTable

18+usersTable = Proxy

19+

20+bad = from usersTable # selectAll # where_ @"age > $n" # limit @"$n"

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

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

1+-- EXPECT: Cons

2+module Test.CompileFail.OffsetBeforeSelect where

4+import Prelude

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

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

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

8+import Yoga.Postgres.Schema

10+type UsersTable = Table "users"

11+ ( id :: Int # PrimaryKey # AutoIncrement

12+ , name :: String

13+ , email :: String # Unique

14+ , age :: Maybe Int

15+ )

16+

17+usersTable :: Proxy UsersTable

18+usersTable = Proxy

19+

20+bad = from usersTable # offset @"5"

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

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

1+-- EXPECT: TypesDoNotUnify

2+module Test.CompileFail.OnConflictBadColumn where

4+import Prelude

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

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

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

8+import Yoga.Postgres.Schema

10+type UsersTable = Table "users"

11+ ( id :: Int # PrimaryKey # AutoIncrement

12+ , name :: String

13+ , email :: String # Unique

14+ , age :: Maybe Int

15+ )

16+

17+usersTable :: Proxy UsersTable

18+usersTable = Proxy

19+

20+bad = from usersTable # 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

4+import Prelude

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

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

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

8+import Yoga.Postgres.Schema

10+type UsersTable = Table "users"

11+ ( id :: Int # PrimaryKey # AutoIncrement

12+ , name :: String

13+ , email :: String # Unique

14+ , age :: Maybe Int

15+ )

16+

17+usersTable :: Proxy UsersTable

18+usersTable = Proxy

19+

20+-- 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

4+import Prelude

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

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

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

8+import Yoga.Postgres.Schema

10+type UsersTable = Table "users"

11+ ( id :: Int # PrimaryKey # AutoIncrement

12+ , name :: String

13+ , email :: String # Unique

14+ , age :: Maybe Int

15+ )

16+

17+usersTable :: Proxy UsersTable

18+usersTable = Proxy

19+

20+bad = from usersTable # 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

4+import Prelude

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

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

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

8+import Yoga.Postgres.Schema

10+type UsersTable = Table "users"

11+ ( id :: Int # PrimaryKey # AutoIncrement

12+ , name :: String

13+ , email :: String # Unique

14+ , age :: Maybe Int

15+ )

16+

17+usersTable :: Proxy UsersTable

18+usersTable = Proxy

19+

20+bad = from usersTable # selectAll # onConflictDoNothing @"email"

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

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

1+-- EXPECT: Lacks

2+module Test.CompileFail.OrderByAfterLimit where

4+import Prelude

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

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

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

8+import Yoga.Postgres.Schema

10+type UsersTable = Table "users"

11+ ( id :: Int # PrimaryKey # AutoIncrement

12+ , name :: String

13+ , email :: String # Unique

14+ , age :: Maybe Int

15+ )

16+

17+usersTable :: Proxy UsersTable

18+usersTable = Proxy

19+

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

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

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

1+-- EXPECT: Cons

2+module Test.CompileFail.OrderByBeforeSelect where

4+import Prelude

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

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

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

8+import Yoga.Postgres.Schema

10+type UsersTable = Table "users"

11+ ( id :: Int # PrimaryKey # AutoIncrement

12+ , name :: String

13+ , email :: String # Unique

14+ , age :: Maybe Int

15+ )

16+

17+usersTable :: Proxy UsersTable

18+usersTable = Proxy

19+

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

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

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

1+-- EXPECT: Cons

2+module Test.CompileFail.OrderByOnUpdate where

4+import Prelude

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

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

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

8+import Yoga.Postgres.Schema

10+type UsersTable = Table "users"

11+ ( id :: Int # PrimaryKey # AutoIncrement

12+ , name :: String

13+ , email :: String # Unique

14+ , age :: Maybe Int

15+ )

16+

17+usersTable :: Proxy UsersTable

18+usersTable = Proxy

19+

20+bad = from usersTable # 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

4+import Prelude

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

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

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

8+import Yoga.Postgres.Schema

10+type UsersTable = Table "users"

11+ ( id :: Int # PrimaryKey # AutoIncrement

12+ , name :: String

13+ , email :: String # Unique

14+ , age :: Maybe Int

15+ )

16+

17+usersTable :: Proxy UsersTable

18+usersTable = Proxy

19+

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

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

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

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

2+module Test.CompileFail.OverClauseInvalidContent where

4+import Prelude

5+import Data.Maybe (Maybe)

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

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

8+import Yoga.Postgres.Schema

10+type UsersTable = Table "users"

11+ ( id :: Int # PrimaryKey # AutoIncrement

12+ , name :: String

13+ , email :: String # Unique

14+ , age :: Maybe Int

15+ )

16+

17+usersTable :: Proxy UsersTable

18+usersTable = Proxy

19+

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

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

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

1+-- EXPECT: not found in any table

2+module Test.CompileFail.OverClauseNonexistentColumn where

4+import Prelude

5+import Data.Maybe (Maybe)

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

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

8+import Yoga.Postgres.Schema

10+type UsersTable = Table "users"

11+ ( id :: Int # PrimaryKey # AutoIncrement

12+ , name :: String

13+ , email :: String # Unique

14+ , age :: Maybe Int

15+ )

16+

17+usersTable :: Proxy UsersTable

18+usersTable = Proxy

19+

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

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

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

1+-- EXPECT: Lacks

2+module Test.CompileFail.ReturningOnSelect where

4+import Prelude

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

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

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

8+import Yoga.Postgres.Schema

10+type UsersTable = Table "users"

11+ ( id :: Int # PrimaryKey # AutoIncrement

12+ , name :: String

13+ , email :: String # Unique

14+ , age :: Maybe Int

15+ )

16+

17+usersTable :: Proxy UsersTable

18+usersTable = Proxy

19+

20+bad = from usersTable # selectAll # 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

4+import Prelude

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

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

7+import Yoga.Postgres.Schema

9+type UsersTable = Table "users"

10+ ( id :: Int # PrimaryKey # AutoIncrement

11+ , name :: String

12+ )

13+

14+usersTable :: Proxy UsersTable

15+usersTable = Proxy

16+

17+bad = from usersTable # returning @"id"

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

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

1+-- EXPECT: Lacks

2+module Test.CompileFail.SelectAfterInsert where

4+import Prelude

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

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

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

8+import Yoga.Postgres.Schema

10+type UsersTable = Table "users"

11+ ( id :: Int # PrimaryKey # AutoIncrement

12+ , name :: String

13+ , email :: String # Unique

14+ , age :: Maybe Int

15+ )

16+

17+usersTable :: Proxy UsersTable

18+usersTable = Proxy

19+

20+bad = from usersTable # 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

4+import Prelude

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

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

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

8+import Yoga.Postgres.Schema

10+type UsersTable = Table "users"

11+ ( id :: Int # PrimaryKey # AutoIncrement

12+ , name :: String

13+ , email :: String # Unique

14+ , age :: Maybe Int

15+ )

16+

17+usersTable :: Proxy UsersTable

18+usersTable = Proxy

19+

20+bad = from usersTable # selectAll # limit @"10" # select @"name"

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

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

1+-- EXPECT: Lacks

2+module Test.CompileFail.SelectAfterOrderBy where

4+import Prelude

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

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

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

8+import Yoga.Postgres.Schema

10+type UsersTable = Table "users"

11+ ( id :: Int # PrimaryKey # AutoIncrement

12+ , name :: String

13+ , email :: String # Unique

14+ , age :: Maybe Int

15+ )

16+

17+usersTable :: Proxy UsersTable

18+usersTable = Proxy

19+

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

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

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

1+-- EXPECT: Lacks

2+module Test.CompileFail.SelectAfterWhere where

4+import Prelude

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

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

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

8+import Yoga.Postgres.Schema

10+type UsersTable = Table "users"

11+ ( id :: Int # PrimaryKey # AutoIncrement

12+ , name :: String

13+ , email :: String # Unique

14+ , age :: Maybe Int

15+ )

16+

17+usersTable :: Proxy UsersTable

18+usersTable = Proxy

19+

20+bad = from usersTable # selectAll # where_ @"id = $id" # select @"name"

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

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

1+-- EXPECT: Lacks

2+module Test.CompileFail.SetAfterSelect where

4+import Prelude

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

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

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

8+import Yoga.Postgres.Schema

10+type UsersTable = Table "users"

11+ ( id :: Int # PrimaryKey # AutoIncrement

12+ , name :: String

13+ , email :: String # Unique

14+ , age :: Maybe Int

15+ )

16+

17+usersTable :: Proxy UsersTable

18+usersTable = Proxy

19+

20+bad = from usersTable # selectAll # 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

4+import Prelude

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

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

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

8+import Yoga.Postgres.Schema

10+type UsersTable = Table "users"

11+ ( id :: Int # PrimaryKey # AutoIncrement

12+ , name :: String

13+ , email :: String # Unique

14+ , age :: Maybe Int

15+ )

16+

17+usersTable :: Proxy UsersTable

18+usersTable = Proxy

19+

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

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

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

1+-- EXPECT: Trailing comma in SELECT clause

2+module Test.CompileFail.TrailingCommaInSelect where

4+import Prelude

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

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

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

8+import Yoga.Postgres.Schema

10+type UsersTable = Table "users"

11+ ( id :: Int # PrimaryKey # AutoIncrement

12+ , name :: String

13+ , email :: String # Unique

14+ , age :: Maybe Int

15+ )

16+

17+usersTable :: Proxy UsersTable

18+usersTable = Proxy

19+

20+bad = from usersTable # select @"name, email,"

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

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

1+-- EXPECT: Unclosed string literal

2+module Test.CompileFail.UnclosedStringLiteral where

4+import Prelude

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

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

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

8+import Yoga.Postgres.Schema

10+type UsersTable = Table "users"

11+ ( id :: Int # PrimaryKey # AutoIncrement

12+ , name :: String

13+ , email :: String # Unique

14+ , age :: Maybe Int

15+ )

16+

17+usersTable :: Proxy UsersTable

18+usersTable = Proxy

19+

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

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

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

1+-- EXPECT: Unclosed string literal

2+module Test.CompileFail.UnclosedStringLiteralJoin where

4+import Prelude

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

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

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

8+import Yoga.Postgres.Schema

10+type UsersTable = Table "users"

11+ ( id :: Int # PrimaryKey # AutoIncrement

12+ , name :: String

13+ , email :: String # Unique

14+ , age :: Maybe Int

15+ )

16+

17+type PostsTable = Table "posts"

18+ ( id :: Int # PrimaryKey # AutoIncrement

19+ , user_id :: Int

20+ , title :: String

21+ )

22+

23+usersTable :: Proxy UsersTable

24+usersTable = Proxy

25+

26+postsTable :: Proxy PostsTable

27+postsTable = Proxy

28+

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

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

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

1+-- EXPECT: Cons

2+module Test.CompileFail.UnionWithoutSelect where

4+import Prelude

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

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

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

8+import Yoga.Postgres.Schema

10+type UsersTable = Table "users"

11+ ( id :: Int # PrimaryKey # AutoIncrement

12+ , name :: String

13+ , email :: String # Unique

14+ , age :: Maybe Int

15+ )

16+

17+usersTable :: Proxy UsersTable

18+usersTable = Proxy

19+

20+bad = (from usersTable) `union` (from usersTable)

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

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

1+-- EXPECT: Lacks

2+module Test.CompileFail.WhereAfterGroupBy where

4+import Prelude

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

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

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

8+import Yoga.Postgres.Schema

10+type UsersTable = Table "users"

11+ ( id :: Int # PrimaryKey # AutoIncrement

12+ , name :: String

13+ , email :: String # Unique

14+ , age :: Maybe Int

15+ )

16+

17+usersTable :: Proxy UsersTable

18+usersTable = Proxy

19+

20+bad = from usersTable # select @"name" # 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

4+import Prelude

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

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

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

8+import Yoga.Postgres.Schema

10+type UsersTable = Table "users"

11+ ( id :: Int # PrimaryKey # AutoIncrement

12+ , name :: String

13+ , email :: String # Unique

14+ , age :: Maybe Int

15+ )

16+

17+usersTable :: Proxy UsersTable

18+usersTable = Proxy

19+

20+bad = from usersTable # selectAll # limit @"10" # where_ @"id = $id"

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

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

1+-- EXPECT: Lacks

2+module Test.CompileFail.WhereAfterOrderBy where

4+import Prelude

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

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

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

8+import Yoga.Postgres.Schema

10+type UsersTable = Table "users"

11+ ( id :: Int # PrimaryKey # AutoIncrement

12+ , name :: String

13+ , email :: String # Unique

14+ , age :: Maybe Int

15+ )

16+

17+usersTable :: Proxy UsersTable

18+usersTable = Proxy

19+

20+bad = from usersTable # selectAll # orderBy @"name" # where_ @"id = $id"

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

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

1+-- EXPECT: Lacks

2+module Test.CompileFail.WhereAfterUnion where

4+import Prelude

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

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

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

8+import Yoga.Postgres.Schema

10+type UsersTable = Table "users"

11+ ( id :: Int # PrimaryKey # AutoIncrement

12+ , name :: String

13+ , email :: String # Unique

14+ , age :: Maybe Int

15+ )

16+

17+usersTable :: Proxy UsersTable

18+usersTable = Proxy

19+

20+bad = (from usersTable # select @"name") `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

4+import Prelude

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

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

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

8+import Yoga.Postgres.Schema

10+type UsersTable = Table "users"

11+ ( id :: Int # PrimaryKey # AutoIncrement

12+ , name :: String

13+ , email :: String # Unique

14+ , age :: Maybe Int

15+ )

16+

17+usersTable :: Proxy UsersTable

18+usersTable = Proxy

19+

20+bad = from usersTable # 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

4+import Prelude

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

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

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

8+import Yoga.Postgres.Schema

10+type UsersTable = Table "users"

11+ ( id :: Int # PrimaryKey # AutoIncrement

12+ , name :: String

13+ , email :: String # Unique

14+ , age :: Maybe Int

15+ )

16+

17+usersTable :: Proxy UsersTable

18+usersTable = Proxy

19+

20+bad = from usersTable # where_ @"id = $id"

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

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

1+-- EXPECT: Aggregate function requires AS alias

2+module Test.CompileFail.WindowFunctionNoAlias where

4+import Prelude

5+import Data.Maybe (Maybe)

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

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

8+import Yoga.Postgres.Schema

10+type UsersTable = Table "users"

11+ ( id :: Int # PrimaryKey # AutoIncrement

12+ , name :: String

13+ , email :: String # Unique

14+ , age :: Maybe Int

15+ )

16+

17+usersTable :: Proxy UsersTable

18+usersTable = Proxy

19+

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

4+import Prelude

5+import Data.Maybe (Maybe)

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

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

8+import Yoga.Postgres.Schema

10+type UsersTable = Table "users"

11+ ( id :: Int # PrimaryKey # AutoIncrement

12+ , name :: String

13+ , email :: String # Unique

14+ , age :: Maybe Int

15+ )

16+

17+usersTable :: Proxy UsersTable

18+usersTable = Proxy

19+

20+bad = from usersTable # select @"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")/.."

4+# Build the library first

5+bunx spago build > /dev/null 2>&1

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+2−1

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

2525 },

2626 "dependencies": {

2727 "pg": "^8.11.0",

28− "postgres": "^3.4.8"

28+ "postgres": "^3.4.8",

29+ "uuid": "^13.0.0"

2930 }

3031}

spago.lock+64−15

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

66 "core": {

77 "dependencies": [

88 {

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

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

10+ },

11+ {

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

1013 },

1114 {

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

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

1720 {

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

1922 },

23+ {

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

25+ },

26+ {

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

28+ },

2029 {

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

2231 },

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

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

2534 },

2635 {

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

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

37+ },

38+ {

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

40+ },

41+ {

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

43+ },

44+ {

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

2846 },

2947 {

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

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

3250 {

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

3452 },

53+ {

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

55+ },

3556 {

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

3758 },

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

4162 {

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

4364 },

65+ {

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

67+ },

4468 {

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

4670 },

4771 {

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

4973 },

74+ {

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

76+ },

77+ {

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

79+ },

80+ {

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

82+ },

83+ {

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

85+ },

5086 {

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

5288 },

5389 {

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

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

5591 },

5692 {

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

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

94+ },

95+ {

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

5897 }

5998 ]

6099 },

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

84123 "packages": {

85124 "aff": {

86125 "type": "registry",

87− "version": "7.1.0",

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

126+ "version": "8.0.0",

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

89128 "dependencies": [

90129 "control",

91130 "datetime",

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

436475 },

437476 "heterogeneous": {

438477 "type": "registry",

439− "version": "0.6.0",

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

478+ "version": "0.7.0",

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

441480 "dependencies": [

442481 "either",

443482 "foldable-traversable",

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

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

917956 "dependencies": []

918957 },

958+ "uuid": {

959+ "type": "registry",

960+ "version": "9.0.0",

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

962+ "dependencies": [

963+ "effect",

964+ "maybe",

965+ "prelude"

966+ ]

967+ },

919968 "variant": {

920969 "type": "registry",

921970 "version": "8.0.0",

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

934983 },

935984 "yoga-json": {

936985 "type": "registry",

937− "version": "5.2.0",

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

986+ "version": "5.2.1",

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

939988 "dependencies": [

940989 "arrays",

941990 "bifunctors",

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

9731022 },

9741023 "yoga-sql-types": {

9751024 "type": "registry",

976− "version": "0.1.0",

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

1025+ "version": "0.2.0",

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

9781027 "dependencies": [

9791028 "arrays",

9801029 "bifunctors",

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

10021051 },

10031052 "yoga-test-docker": {

10041053 "type": "registry",

1005− "version": "0.1.0",

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

1054+ "version": "0.1.2",

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

10071056 "dependencies": [

10081057 "aff",

10091058 "datetime",

1010− "effect",

10111059 "exceptions",

1060+ "newtype",

10121061 "prelude"

10131062 ]

10141063 },

spago.yaml+18−5

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

33package:

44 name: yoga-postgres

55 publish:

6− version: 0.1.0

6+ version: 0.3.2

77 license: MIT

88 location:

99 githubOwner: rowtype-yoga

1010 githubRepo: purescript-yoga-postgres

1111 dependencies:

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

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

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

1314 - datetime: ">=6.1.0 <7.0.0"

1415 - effect: ">=4.0.0 <5.0.0"

1516 - either: ">=6.1.0 <7.0.0"

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

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

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

1720 - foreign: ">=7.0.0 <8.0.0"

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

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

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

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

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

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

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

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

2128 - maybe: ">=6.0.0 <7.0.0"

2229 - newtype: ">=5.0.0 <6.0.0"

2330 - nullable: ">=6.0.0 <7.0.0"

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

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

2533 - prelude: ">=6.0.2 <7.0.0"

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

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

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

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

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

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

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

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

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

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

2942 test:

3043 main: Test.Postgres.Main

3144 dependencies:

src/Yoga/Postgres.js+42−42

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

33// Create Postgres connection

44export const postgresImpl = (config) => {

5− // Support both individual config and connection string

6− if (config.connection) {

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

8− }

9−

10− return postgres({

11− host: config.host,

12− port: config.port,

13− database: config.database,

14− username: config.username,

15− password: config.password,

16− max: config.max,

17− idle_timeout: config.idle_timeout,

18− connect_timeout: config.connect_timeout,

19− ssl: config.ssl,

20− debug: config.debug,

21− onnotice: config.onnotice,

22− onparameter: config.onparameter,

23− // Pass through any other options

24− ...config

25− });

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

6+ const options = {

7+ ...configOptions,

8+ onnotice: config.onnotice

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

10+ : undefined,

11+ onparameter: config.onparameter

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

13+ : undefined

14+ };

15+

16+ return connection

17+ ? postgres(connection, options)

18+ : postgres(options);

2619};

2720

2821// Query operations

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

9285};

9386

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

95− if (txn._reserved) {

96− await txn._reserved`COMMIT`;

97− // Release the connection back to the pool

98− await txn._reserved.release();

88+ if (!txn._reserved) return;

89+

90+ const reserved = txn._reserved;

91+ txn._reserved = null;

92+ try {

93+ await reserved`COMMIT`;

94+ } finally {

95+ await reserved.release();

9996 }

10097};

10198

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

103− if (txn._reserved) {

104− await txn._reserved`ROLLBACK`;

105− // Release the connection back to the pool

106− await txn._reserved.release();

100+ if (!txn._reserved) return;

101+

102+ const reserved = txn._reserved;

103+ txn._reserved = null;

104+ try {

105+ await reserved`ROLLBACK`;

106+ } finally {

107+ await reserved.release();

107108 }

108109};

109110

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

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

112− const affAction = handler(txn);

113− return await affAction();

114− });

115−};

116111

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

118113 // Use the underlying SQL connection

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

147142

148143// Listen/Notify

149144

145+const listeners = new WeakMap();

146+

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

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

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

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

153150 });

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

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

153+ subscriptions.push(subscription);

154+ byChannel.set(channel, subscriptions);

155+ listeners.set(sql, byChannel);

154156};

155157

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

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

158− if (sql.listen.unlisten) {

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

160− }

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

162− return Promise.resolve();

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

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

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

162+ byChannel?.delete(channel);

163163};

164164

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

src/Yoga/Postgres.purs+18−8

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

33import Prelude

57import Data.Maybe (Maybe)

68import Data.Newtype (class Newtype)

79import Data.Nullable (Nullable)

810import Data.Nullable as Nullable

911import Data.Time.Duration (Milliseconds)

12+import Data.UUID (UUID)

13+import Data.UUID as UUID

1014import Effect (Effect)

11−import Effect.Aff (Aff)

15+import Effect.Aff (Aff, generalBracket)

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

1317import Foreign (Foreign)

1418import Prim.Row (class Union)

1519import Promise (Promise)

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

20+import Promise.Aff (toAffE) as Promise

1721import Unsafe.Coerce (unsafeCoerce)

1822

1923-- Opaque Postgres types

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

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

115119 toPGValue arr = unsafeCoerce (map toPGValue arr)

116120

121+instance ToPGValue UUID where

122+ toPGValue = toPGValue <<< UUID.toString

123+

117124instance ToPGValue Foreign where

118125 toPGValue = unsafeCoerce

119126

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

219226rollback :: Transaction -> Aff Unit

220227rollback = runEffectFn1 rollbackImpl >>> Promise.toAffE

221228

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

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

224229

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

226−transaction handler conn =

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

228− # Promise.toAffE

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

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

232+withTransaction operation conn =

233+ generalBracket (begin conn)

234+ { killed: \_ -> rollback

235+ , failed: \_ -> rollback

236+ , completed: \_ -> commit

237+ }

238+ operation

229239

230240-- Query within transaction

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

src/Yoga/Postgres/Schema.purs+3534−65

@@ -2,14 +2,48 @@ module Yoga.Postgres.Schema where

33import Prelude

5−import Data.Array (intercalate, mapWithIndex)

6−import Data.Maybe (Maybe)

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

720import 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

826import Data.Symbol (class IsSymbol, reflectSymbol)

9−import Data.Tuple.Nested (type (/\))

10−import Prim.RowList as RL

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

1137import 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

1242import 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

1347

1448-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

1549-- Core phantom types

@@ -18,26 +52,217 @@ import Type.Proxy (Proxy(..))

1852data Table :: Symbol -> Row Type -> Type

1953data Table name columns = Table

2054

21−data Column :: Type -> Type -> Type

22−data Column typ constraints = Column

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

23211

24212-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

25−-- Constraint phantom types

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

26214-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

27215

28−data PrimaryKey

29−data AutoIncrement

30−data Unique

31−data None

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

32249

33−data Default :: Symbol -> Type

34−data Default a

250+instance ReadForeign TSVector where

251+ readImpl f = do

252+ s :: String <- readImpl f

253+ pure (TSVector s)

35254

36−data DefaultInt :: Int -> Type

37−data DefaultInt a

255+newtype TSQuery = TSQuery String

38256

39−data DefaultBool :: Boolean -> Type

40−data DefaultBool a

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)

41266

42267-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

43268-- Nullability: inferred from Maybe

@@ -52,7 +277,23 @@ else instance IsNullable a where

52277 isNullable _ = false

53278

54279-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

55−-- PureScript type → Postgres type name

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

56297-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

57298

58299class PGTypeName a where

@@ -70,47 +311,109 @@ instance PGTypeName Boolean where

70311instance PGTypeName Number where

71312 pgTypeName _ = "DOUBLE PRECISION"

72313

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+

73347instance PGTypeName a => PGTypeName (Maybe a) where

74348 pgTypeName _ = pgTypeName (Proxy :: Proxy a)

75349

76350-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

77−-- Constraint → DDL fragment

351+-- Constraint -> DDL fragment

78352-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

79353

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+

80382class RenderConstraint a where

81383 renderConstraint :: Proxy a -> String

82384

83−instance RenderConstraint PrimaryKey where

84− renderConstraint _ = "PRIMARY KEY"

385+instance RenderConstraint a => RenderConstraint (PrimaryKey a) where

386+ renderConstraint _ = joinConstraints "PRIMARY KEY" (renderConstraint (Proxy :: Proxy a))

85387

86−instance RenderConstraint AutoIncrement where

87− renderConstraint _ = "GENERATED ALWAYS AS IDENTITY"

388+else instance RenderConstraint a => RenderConstraint (AutoIncrement a) where

389+ renderConstraint _ = joinConstraints "GENERATED ALWAYS AS IDENTITY" (renderConstraint (Proxy :: Proxy a))

88390

89−instance RenderConstraint Unique where

90− renderConstraint _ = "UNIQUE"

391+else instance RenderConstraint a => RenderConstraint (Unique a) where

392+ renderConstraint _ = joinConstraints "UNIQUE" (renderConstraint (Proxy :: Proxy a))

91393

92−instance RenderConstraint None where

93− renderConstraint _ = ""

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

94396

95−instance Reflectable sym String => RenderConstraint (Default sym) where

96− renderConstraint _ = "DEFAULT " <> reflectType (Proxy :: Proxy sym)

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

97405

98−instance Reflectable val Int => RenderConstraint (DefaultInt val) where

99− renderConstraint _ = "DEFAULT " <> show (reflectType (Proxy :: Proxy val))

406+else instance RenderConstraint a => RenderConstraint (Nullable a) where

407+ renderConstraint _ = renderConstraint (Proxy :: Proxy a)

100408

101−instance Reflectable val Boolean => RenderConstraint (DefaultBool val) where

102− renderConstraint _ =

103− if reflectType (Proxy :: Proxy val) then "DEFAULT true"

104− else "DEFAULT false"

409+else instance RenderConstraint a where

410+ renderConstraint _ = ""

105411

106−instance (RenderConstraint a, RenderConstraint b) => RenderConstraint (a /\ b) where

107− renderConstraint _ = do

108− let a = renderConstraint (Proxy :: Proxy a)

109− let b = renderConstraint (Proxy :: Proxy b)

110− case a, b of

111− "", s -> s

112− s, "" -> s

113− s1, s2 -> s1 <> " " <> s2

412+joinConstraints :: String -> String -> String

413+joinConstraints a b = case a, b of

414+ "", s -> s

415+ s, "" -> s

416+ s1, s2 -> s1 <> " " <> s2

114417

115418-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

116419-- DDL generation

@@ -128,18 +431,19 @@ instance RenderColumnsRL RL.Nil where

128431

129432instance

130433 ( IsSymbol name

434+ , ExtractType entry typ

131435 , PGTypeName typ

132436 , IsNullable typ

133− , RenderConstraint constraints

437+ , RenderConstraint entry

134438 , RenderColumnsRL tail

135439 ) =>

136− RenderColumnsRL (RL.Cons name (Column typ constraints) tail) where

440+ RenderColumnsRL (RL.Cons name entry tail) where

137441 renderColumnsRL _ = do

138442 let colName = reflectSymbol (Proxy :: Proxy name)

139443 let colType = pgTypeName (Proxy :: Proxy typ)

140444 let nullable = isNullable (Proxy :: Proxy typ)

141445 let notNull = if nullable then "" else " NOT NULL"

142− let constraints = renderConstraint (Proxy :: Proxy constraints)

446+ let constraints = renderConstraint (Proxy :: Proxy entry)

143447 let constraintsSuffix = if constraints == "" then "" else " " <> constraints

144448 [ colName <> " " <> colType <> notNull <> constraintsSuffix ] <> renderColumnsRL (Proxy :: Proxy tail)

145449

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

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

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

156460

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+

157466-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

158467-- INSERT SQL generation

159468-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

@@ -161,16 +470,20 @@ instance

161470class IsAutoGenerated a where

162471 isAutoGenerated :: Proxy a -> Boolean

163472

164−instance IsAutoGenerated AutoIncrement where

473+instance IsAutoGenerated (AutoIncrement a) where

165474 isAutoGenerated _ = true

166−else instance IsAutoGenerated (Default a) where

475+else instance IsAutoGenerated (Default v a) where

167476 isAutoGenerated _ = true

168−else instance IsAutoGenerated (DefaultInt a) where

477+else instance IsAutoGenerated (DefaultExpr expression a) where

169478 isAutoGenerated _ = true

170−else instance IsAutoGenerated (DefaultBool a) where

171− isAutoGenerated _ = true

172−else instance (IsAutoGenerated a, IsAutoGenerated b) => IsAutoGenerated (a /\ b) where

173− isAutoGenerated _ = isAutoGenerated (Proxy :: Proxy a) || isAutoGenerated (Proxy :: Proxy b)

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)

174487else instance IsAutoGenerated a where

175488 isAutoGenerated _ = false

176489

@@ -183,15 +496,15 @@ instance InsertColumnsRL RL.Nil where

183496

184497instance

185498 ( IsSymbol name

186− , IsAutoGenerated constraints

499+ , IsAutoGenerated entry

187500 , InsertColumnsRL tail

188501 ) =>

189− InsertColumnsRL (RL.Cons name (Column typ constraints) tail) where

502+ InsertColumnsRL (RL.Cons name entry tail) where

190503 insertColumnsRL _ =

191504 let

192505 rest = insertColumnsRL (Proxy :: Proxy tail)

193506 in

194− if isAutoGenerated (Proxy :: Proxy constraints) then rest

507+ if isAutoGenerated (Proxy :: Proxy entry) then rest

195508 else [ reflectSymbol (Proxy :: Proxy name) ] <> rest

196509

197510class InsertSQLFor a where

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

206519 insertSQLFor = do

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

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

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

210− "INSERT INTO " <> tableName

211− <> " ("

212− <> intercalate ", " cols

213− <> ")"

214− <> " VALUES ("

215− <> intercalate ", " placeholders

216− <> ")"

217− <> " RETURNING *"

522+ if Array.null cols then

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

524+ else do

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

526+ "INSERT INTO " <> tableName

527+ <> " ("

528+ <> intercalate ", " cols

529+ <> ")"

530+ <> " VALUES ("

531+ <> intercalate ", " placeholders

532+ <> ")"

533+ <> " RETURNING *"

218534

219535-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

220536-- SELECT SQL generation

@@ -309,3 +625,3156 @@ instance

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

310626 let conditions = whereClauseRL (Proxy :: Proxy whereRL) 1

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

3+import Prelude

5+import Control.Parallel (parTraverse)

6+import Data.Array as Array

7+import Data.Date (canonicalDate)

8+import Data.DateTime (DateTime(..))

9+import Data.Either (Either(..))

10+import Data.Enum (toEnum)

11+import Data.Maybe (Maybe(..), fromJust)

12+import Data.Identity (Identity)

13+import Data.Time (Time(..))

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

15+import Data.UUID as UUID

16+import Effect (Effect)

17+import Effect.Aff (Aff, delay, forkAff, killFiber, throwError, try)

18+import Effect.Class (liftEffect)

19+import Effect.Exception (error, message)

20+import Effect.Ref as Ref

21+import Effect.Uncurried (EffectFn1, runEffectFn1)

22+import Foreign (unsafeToForeign)

23+import JS.BigInt (BigInt)

24+import JS.BigInt as BigInt

25+import Partial.Unsafe (unsafePartial)

26+import Prim.Boolean (True)

27+import Test.Spec (Spec, SpecT, describe, it)

28+import Test.Spec.Assertions (shouldEqual, shouldSatisfy)

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

30+import Type.Proxy (Proxy(..))

31+import Yoga.Postgres as PG

32+import Yoga.Postgres.Schema as Schema

33+import Yoga.Postgres.TypedQuery as Typed

34+import Yoga.SQL.PostgresTypes (SQLQuery, arg, combineBuilders, int, sql, str)

35+

36+isLeft :: forall a b. Either a b -> Boolean

37+isLeft (Left _) = true

38+isLeft _ = false

39+

40+poisonRollback :: PG.Transaction -> Effect Unit

41+poisonRollback = runEffectFn1 poisonRollbackImpl

42+

43+foreign import poisonRollbackImpl :: EffectFn1 PG.Transaction Unit

44+

45+testConnection :: Effect PG.Connection

46+testConnection = PG.postgres

47+ { host: PG.PostgresHost "localhost"

48+ , port: PG.PostgresPort 5434

49+ , database: PG.PostgresDatabase "test_playground"

50+ , username: PG.PostgresUsername "postgres"

51+ , password: PG.PostgresPassword "postgres"

52+ }

53+

54+type BehaviorTable = Schema.Table "behavior_values"

55+ ( id :: Int # Schema.PrimaryKey # Schema.AutoIncrement

56+ , name :: String

57+ , optional_int :: Maybe Int

58+ )

59+

60+behaviorTable :: Proxy BehaviorTable

61+behaviorTable = Proxy

62+

63+type AllDefaultTable = Schema.Table "behavior_defaults"

64+ ( active :: Boolean # Schema.Default True

65+ , id :: Int # Schema.PrimaryKey # Schema.AutoIncrement

66+ )

67+

68+allDefaultTable :: Proxy AllDefaultTable

69+allDefaultTable = Proxy

70+

71+type TxTable = Schema.Table "behavior_tx"

72+ ( id :: Int # Schema.PrimaryKey # Schema.AutoIncrement

73+ , name :: String

74+ )

75+

76+txTable :: Proxy TxTable

77+txTable = Proxy

78+

79+type TemporalParamTable = Schema.Table "behavior_temporal"

80+ ( document :: Schema.Jsonb

81+ , event_at :: Schema.TimestampTZ

82+ , event_date :: Schema.PGDate

83+ , event_time :: Schema.PGTime

84+ , label :: String

85+ , uuid :: Schema.PGUUID

86+ , optional_event_at :: Maybe Schema.TimestampTZ

87+ )

88+

89+temporalParamTable :: Proxy TemporalParamTable

90+temporalParamTable = Proxy

91+

92+typedIntQuery :: SQLQuery (n :: Int)

93+typedIntQuery = sql $ combineBuilders (combineBuilders "SELECT " (int @"n")) "::int AS n"

94+

95+typedMaybeQuery :: SQLQuery (value :: Maybe Int)

96+typedMaybeQuery = sql $ combineBuilders (combineBuilders "SELECT " (arg @(Maybe Int) @"value")) "::int AS value"

97+

98+typedBadDecodeQuery :: SQLQuery ()

99+typedBadDecodeQuery = sql $ combineBuilders "SELECT 'not-an-int' AS n" ""

100+

101+typedMutationQuery :: SQLQuery (name :: String)

102+typedMutationQuery = sql $ combineBuilders (combineBuilders "INSERT INTO behavior_values (name) VALUES (" (str @"name")) ")"

103+

104+expectedDate :: Schema.PGDate

105+expectedDate = unsafePartial do

106+ let year = fromJust (toEnum 2025)

107+ let month = fromJust (toEnum 6)

108+ let day = fromJust (toEnum 15)

109+ Schema.PGDate (canonicalDate year month day)

110+

111+expectedTime :: Schema.PGTime

112+expectedTime = unsafePartial do

113+ let hour = fromJust (toEnum 14)

114+ let minute = fromJust (toEnum 30)

115+ let second = fromJust (toEnum 45)

116+ let millisecond = fromJust (toEnum 125)

117+ Schema.PGTime (Time hour minute second millisecond)

118+

119+expectedHalfSecondTime :: Schema.PGTime

120+expectedHalfSecondTime = unsafePartial do

121+ let hour = fromJust (toEnum 14)

122+ let minute = fromJust (toEnum 30)

123+ let second = fromJust (toEnum 45)

124+ let millisecond = fromJust (toEnum 500)

125+ Schema.PGTime (Time hour minute second millisecond)

126+

127+expectedTimestamp :: Schema.TimestampTZ

128+expectedTimestamp = unsafePartial do

129+ let year = fromJust (toEnum 2025)

130+ let month = fromJust (toEnum 1)

131+ let day = fromJust (toEnum 15)

132+ let hour = fromJust (toEnum 12)

133+ let minute = fromJust (toEnum 0)

134+ let second = fromJust (toEnum 0)

135+ let millisecond = fromJust (toEnum 0)

136+ Schema.TimestampTZ (DateTime (canonicalDate year month day) (Time hour minute second millisecond))

137+

138+setupBehaviorTable :: PG.Connection -> Aff Unit

139+setupBehaviorTable conn = do

140+ _ <- PG.executeSimple (PG.SQL "DROP TABLE IF EXISTS behavior_values") conn

141+ _ <- PG.executeSimple (PG.SQL (Schema.createTableDDL @BehaviorTable)) conn

142+ pure unit

143+

144+setupTxTable :: PG.Connection -> Aff Unit

145+setupTxTable conn = do

146+ _ <- PG.executeSimple (PG.SQL "DROP TABLE IF EXISTS behavior_tx") conn

147+ _ <- PG.executeSimple (PG.SQL (Schema.createTableDDL @TxTable)) conn

148+ pure unit

149+

150+setupTemporalParamTable :: PG.Connection -> Aff Unit

151+setupTemporalParamTable conn = do

152+ _ <- PG.executeSimple (PG.SQL "DROP TABLE IF EXISTS behavior_temporal") conn

153+ _ <- PG.executeSimple (PG.SQL (Schema.createTableDDL @TemporalParamTable)) conn

154+ pure unit

155+

156+pureSpec :: Spec Unit

157+pureSpec = do

158+ describe "Postgres schema metadata and deterministic SQL" do

159+ it "renders every public scalar, array, and nullable type name" do

160+ Schema.pgTypeName (Proxy :: Proxy Int) `shouldEqual` "INTEGER"

161+ Schema.pgTypeName (Proxy :: Proxy String) `shouldEqual` "TEXT"

162+ Schema.pgTypeName (Proxy :: Proxy Boolean) `shouldEqual` "BOOLEAN"

163+ Schema.pgTypeName (Proxy :: Proxy Number) `shouldEqual` "DOUBLE PRECISION"

164+ Schema.pgTypeName (Proxy :: Proxy BigInt) `shouldEqual` "BIGINT"

165+ Schema.pgTypeName (Proxy :: Proxy Schema.PGUUID) `shouldEqual` "UUID"

166+ Schema.pgTypeName (Proxy :: Proxy Schema.PGDate) `shouldEqual` "DATE"

167+ Schema.pgTypeName (Proxy :: Proxy Schema.PGTime) `shouldEqual` "TIME"

168+ Schema.pgTypeName (Proxy :: Proxy Schema.TimestampTZ) `shouldEqual` "TIMESTAMPTZ"

169+ Schema.pgTypeName (Proxy :: Proxy Schema.Point) `shouldEqual` "POINT"

170+ Schema.pgTypeName (Proxy :: Proxy Schema.TSVector) `shouldEqual` "TSVECTOR"

171+ Schema.pgTypeName (Proxy :: Proxy Schema.TSQuery) `shouldEqual` "TSQUERY"

172+ Schema.pgTypeName (Proxy :: Proxy Schema.Jsonb) `shouldEqual` "JSONB"

173+ Schema.pgTypeName (Proxy :: Proxy (Array Int)) `shouldEqual` "INTEGER[]"

174+ Schema.pgTypeName (Proxy :: Proxy (Maybe Int)) `shouldEqual` "INTEGER"

175+

176+ it "reports nullability from Maybe only" do

177+ Schema.isNullable (Proxy :: Proxy (Maybe Int)) `shouldEqual` true

178+ Schema.isNullable (Proxy :: Proxy Int) `shouldEqual` false

179+

180+ it "renders IF NOT EXISTS and DEFAULT VALUES DDL" do

181+ Schema.createTableDDLIfNotExists @BehaviorTable

182+ `shouldEqual` "CREATE TABLE IF NOT EXISTS behavior_values (id INTEGER NOT NULL GENERATED ALWAYS AS IDENTITY PRIMARY KEY, name TEXT NOT NULL, optional_int INTEGER)"

183+ Schema.insertSQLFor @AllDefaultTable

184+ `shouldEqual` "INSERT INTO behavior_defaults DEFAULT VALUES RETURNING *"

185+ (Schema.into allDefaultTable # Schema.insert {} # Schema.toSQL)

186+ `shouldEqual` "INSERT INTO behavior_defaults DEFAULT VALUES"

187+

188+ it "renders update entrypoint and all set-operation variants" do

189+ (Schema.update behaviorTable # Schema.set { name: "updated" } # Schema.where_ @"id = $id" # Schema.toSQL)

190+ `shouldEqual` "UPDATE behavior_values SET name = $1 WHERE id = $id"

191+ let left = Schema.from behaviorTable # Schema.select @"name"

192+ let right = Schema.from behaviorTable # Schema.select @"name"

193+ (left `Schema.intersectAll` right # Schema.toSQL)

194+ `shouldEqual` "(SELECT name FROM behavior_values) INTERSECT ALL (SELECT name FROM behavior_values)"

195+ (left `Schema.exceptAll` right # Schema.toSQL)

196+ `shouldEqual` "(SELECT name FROM behavior_values) EXCEPT ALL (SELECT name FROM behavior_values)"

197+

198+ it "renders CTEs and merges their named parameters" do

199+ let adults = Schema.cte @"adults" (Schema.from behaviorTable # Schema.select @"name" # Schema.where_ @"optional_int > $age")

200+ let mainQuery = Schema.fromCTE @"adults" adults # Schema.select @"name"

201+ (Schema.with_ adults mainQuery # Schema.toSQL)

202+ `shouldEqual` "WITH adults AS (SELECT name FROM behavior_values WHERE optional_int > $age) SELECT name FROM adults"

203+

204+ it "replaces repeated named parameters and preserves casts" do

205+ let replaced = Schema.replaceNamedParams 2

206+ [ { name: "id", value: unsafeToForeign 7 }

207+ , { name: "name", value: unsafeToForeign "Alice" }

208+ ]

209+ "id = $id::int OR parent_id = $id AND name = $name"

210+ replaced.sql `shouldEqual` "id = $3 OR parent_id = $3 AND name = $4"

211+ Array.length replaced.values `shouldEqual` 2

212+ Schema.stripCast "$id::uuid" `shouldEqual` "$id"

213+

214+ it "decodes rows and rejects mismatched result shapes" do

215+ let decoded = Schema.decodeRows

216+ [ unsafeToForeign { id: 1, name: "ok" }

217+ , unsafeToForeign { id: 2, name: "also ok" }

218+ ] :: Either _ (Array { id :: Int, name :: String })

219+ decoded `shouldEqual` Right [ { id: 1, name: "ok" }, { id: 2, name: "also ok" } ]

220+ let bad = Schema.decodeRow (unsafeToForeign { id: "wrong" }) :: Either _ { id :: Int }

221+ bad `shouldSatisfy` isLeft

222+ let fractionalTime = Schema.decodeRow (unsafeToForeign { value: "14:30:45.5" }) :: Either _ { value :: Schema.PGTime }

223+ fractionalTime `shouldEqual` Right { value: expectedHalfSecondTime }

224+

225+integrationSpec :: SpecT Aff PG.Connection Identity Unit

226+integrationSpec = do

227+ describe "How to use the public Postgres API" do

228+ it "reports query metadata and preserves heterogeneous and homogeneous parameters" \conn -> do

229+ result <- PG.query

230+ (PG.SQL "SELECT $1::int AS minimum, $2::int AS maximum, $3::double precision AS huge, $4::text AS first, $5::text AS second, $6::int[] AS integers")

231+ ( PG.param (bottom :: Int)

232+ <> PG.param (top :: Int)

233+ <> PG.param 1.5e200

234+ <> PG.params [ "first", "second" ]

235+ <> PG.param [ bottom :: Int, top :: Int ]

236+ )

237+ conn

238+ result.command `shouldEqual` "SELECT"

239+ result.count `shouldEqual` 1

240+ case Schema.decodeRows result.rows of

241+ Left errs -> throwError (error (show errs))

242+ Right rows -> rows `shouldEqual`

243+ [ { minimum: bottom :: Int

244+ , maximum: top :: Int

245+ , huge: 1.5e200

246+ , first: "first"

247+ , second: "second"

248+ , integers: [ bottom :: Int, top :: Int ]

249+ }

250+ ]

251+

252+ it "round-trips UUID, JSON, date, time, timestamp, arrays, and bigint rows" \conn -> do

253+ uuid <- liftEffect UUID.genUUID

254+ result <- PG.query

255+ (PG.SQL "SELECT $1::uuid AS uuid, $2::jsonb AS document, $3::date AS event_date, $4::time AS event_time, $5::timestamptz AS event_at, $6::text[] AS tags, $7::bigint AS big")

256+ [ PG.toPGValue uuid

257+ , PG.toPGValue (unsafeToForeign { key: "value", nested: { count: 2 } })

258+ , PG.toPGValue "2025-06-15"

259+ , PG.toPGValue "14:30:45.125"

260+ , PG.toPGValue "2025-01-15T12:00:00.000Z"

261+ , PG.toPGValue [ "a", "b" ]

262+ , PG.toPGValue "9223372036854775807"

263+ ]

264+ conn

265+ case Schema.decodeRows result.rows of

266+ Left errs -> throwError (error (show errs))

267+ Right rows -> rows `shouldEqual`

268+ [ { uuid: Schema.PGUUID uuid

269+ , document: { key: "value", nested: { count: 2 } }

270+ , event_date: expectedDate

271+ , event_time: expectedTime

272+ , event_at: expectedTimestamp

273+ , tags: [ "a", "b" ]

274+ , big: BigInt.fromString "9223372036854775807" # unsafePartial fromJust

275+ }

276+ ]

277+

278+ it "distinguishes query-one, unsafe exact-row, and no-row behavior" \conn -> do

279+ one <- PG.queryOneSimple (PG.SQL "SELECT 41::int AS value") conn

280+ case one of

281+ Nothing -> throwError (error "expected queryOneSimple row")

282+ Just row -> Schema.decodeRow row `shouldEqual` Right { value: 41 }

283+ exact <- PG.unsafe (PG.SQL "SELECT $1::int AS value") [ PG.toPGValue 42 ] conn

284+ Schema.decodeRow exact `shouldEqual` Right { value: 42 }

285+ missing <- PG.queryOneSimple (PG.SQL "SELECT 1 WHERE false") conn

286+ case missing of

287+ Nothing -> pure unit

288+ Just _ -> throwError (error "expected queryOneSimple to return Nothing")

289+ unsafeMissing <- try $ PG.unsafe (PG.SQL "SELECT 1 WHERE false") [] conn

290+ case unsafeMissing of

291+ Left _ -> pure unit

292+ Right _ -> throwError (error "expected unsafe to reject an empty result")

293+

294+ it "returns affected rows including zero matches" \conn -> do

295+ setupBehaviorTable conn

296+ inserted <- PG.execute (PG.SQL "INSERT INTO behavior_values (name) VALUES ($1), ($2)") (PG.params [ "a", "b" ]) conn

297+ inserted `shouldEqual` 2

298+ updated <- PG.execute (PG.SQL "UPDATE behavior_values SET name = $1 WHERE name = $2") (PG.params [ "updated", "missing" ]) conn

299+ updated `shouldEqual` 0

300+ deleted <- PG.executeSimple (PG.SQL "DELETE FROM behavior_values") conn

301+ deleted `shouldEqual` 2

302+

303+ it "executes typed queries, Maybe parameters, raw results, mutations, and decode errors" \conn -> do

304+ setupBehaviorTable conn

305+ rows <- (Typed.executeSql typedIntQuery { n: 7 } conn :: Aff (Either String (Array { n :: Int })))

306+ rows `shouldEqual` Right [ { n: 7 } ]

307+ nullable <- (Typed.executeSql typedMaybeQuery { value: Nothing } conn :: Aff (Either String (Array { value :: Maybe Int })))

308+ nullable `shouldEqual` Right [ { value: Nothing } ]

309+ raw <- Typed.executeSqlRaw typedIntQuery { n: 8 } conn

310+ raw.count `shouldEqual` 1

311+ one <- (Typed.executeSqlOne typedIntQuery { n: 9 } conn :: Aff (Either String (Maybe { n :: Int })))

312+ one `shouldEqual` Right (Just { n: 9 })

313+ noRows <- (Typed.executeSqlOne (sql $ combineBuilders "SELECT 1::int AS n WHERE false" "") {} conn :: Aff (Either String (Maybe { n :: Int })))

314+ noRows `shouldEqual` Right (Nothing :: Maybe { n :: Int })

315+ many <- (Typed.executeSqlOne (sql $ combineBuilders "SELECT generate_series(1, 2)::int AS n" "") {} conn :: Aff (Either String (Maybe { n :: Int })))

316+ many `shouldEqual` Right (Nothing :: Maybe { n :: Int })

317+ bad <- (Typed.executeSql typedBadDecodeQuery {} conn :: Aff (Either String (Array { n :: Int })))

318+ bad `shouldSatisfy` isLeft

319+ affected <- Typed.executeMutation typedMutationQuery { name: "typed" } conn

320+ affected `shouldEqual` 1

321+

322+ it "uses schema wrappers as typed query parameters" \conn -> do

323+ setupTemporalParamTable conn

324+ uuid <- liftEffect UUID.genUUID

325+ let pgUuid = Schema.PGUUID uuid

326+ let document = unsafeToForeign { key: "value", nested: { count: 2 } }

327+ _ <- PG.execute

328+ (PG.SQL "INSERT INTO behavior_temporal (document, event_at, event_date, event_time, label, uuid) VALUES ($1, $2, $3, $4, $5, $6)")

329+ [ PG.toPGValue document

330+ , PG.toPGValue "2025-01-15T12:00:00.000Z"

331+ , PG.toPGValue "2025-06-15"

332+ , PG.toPGValue "14:30:45.125"

333+ , PG.toPGValue "matched"

334+ , PG.toPGValue (UUID.toString uuid)

335+ ]

336+ conn

337+ byDate <- Schema.from temporalParamTable

338+ # Schema.select @"label"

339+ # Schema.where_ @"event_date = $date"

340+ # Schema.runQuery conn { date: expectedDate }

341+ byTime <- Schema.from temporalParamTable

342+ # Schema.select @"label"

343+ # Schema.where_ @"event_time = $time"

344+ # Schema.runQuery conn { time: expectedTime }

345+ byTimestamp <- Schema.from temporalParamTable

346+ # Schema.select @"label"

347+ # Schema.where_ @"event_at = $timestamp"

348+ # Schema.runQuery conn { timestamp: expectedTimestamp }

349+ byDocument <- Schema.from temporalParamTable

350+ # Schema.select @"label"

351+ # Schema.where_ @"document @> $document"

352+ # Schema.runQuery conn { document: Schema.Jsonb document }

353+ byDate `shouldEqual` [ { label: "matched" } ]

354+ byTime `shouldEqual` [ { label: "matched" } ]

355+ byTimestamp `shouldEqual` [ { label: "matched" } ]

356+ byDocument `shouldEqual` [ { label: "matched" } ]

357+ inserted <- Schema.into temporalParamTable

358+ # Schema.insert

359+ { document: Schema.Jsonb document

360+ , event_at: expectedTimestamp

361+ , event_date: expectedDate

362+ , event_time: expectedTime

363+ , label: "typed"

364+ , uuid: pgUuid

365+ }

366+ # Schema.runExecute conn {}

367+ inserted `shouldEqual` 1

368+ allRows <- PG.querySimple (PG.SQL "SELECT label FROM behavior_temporal ORDER BY label") conn

369+ decoded <- case Schema.decodeRows allRows.rows of

370+ Left errs -> throwError (error (show errs))

371+ Right values -> pure values

372+ decoded `shouldEqual` [ { label: "matched" }, { label: "typed" } ]

373+

374+ it "converts Just values through the inner field encoder" \conn -> do

375+ setupTemporalParamTable conn

376+ uuid <- liftEffect UUID.genUUID

377+ let document = unsafeToForeign { key: "nullable timestamp" }

378+ inserted <- Schema.into temporalParamTable

379+ # Schema.insert

380+ { document: Schema.Jsonb document

381+ , event_at: expectedTimestamp

382+ , event_date: expectedDate

383+ , event_time: expectedTime

384+ , label: "nullable"

385+ , optional_event_at: Just expectedTimestamp

386+ , uuid: Schema.PGUUID uuid

387+ }

388+ # Schema.runExecute conn {}

389+ inserted `shouldEqual` 1

390+ rows <- Schema.from temporalParamTable

391+ # Schema.select @"optional_event_at"

392+ # Schema.runQuery conn {}

393+ rows `shouldEqual` [ { optional_event_at: Just expectedTimestamp } ]

394+

395+ it "use begin/commit/rollback when transaction boundaries are explicit" \conn -> do

396+ setupTxTable conn

397+ committed <- PG.begin conn

398+ _ <- PG.txExecute (PG.SQL "INSERT INTO behavior_tx (name) VALUES ($1)") [ PG.toPGValue "committed" ] committed

399+ inTransaction <- PG.txQuery (PG.SQL "SELECT name FROM behavior_tx WHERE name = $1") [ PG.toPGValue "committed" ] committed

400+ inTransaction.count `shouldEqual` 1

401+ PG.commit committed

402+ afterCommit <- PG.querySimple (PG.SQL "SELECT name FROM behavior_tx") conn

403+ afterCommit.count `shouldEqual` 1

404+

405+ rolledBack <- PG.begin conn

406+ _ <- PG.txExecute (PG.SQL "INSERT INTO behavior_tx (name) VALUES ($1)") [ PG.toPGValue "rolled back" ] rolledBack

407+ PG.rollback rolledBack

408+ afterRollback <- PG.querySimple (PG.SQL "SELECT name FROM behavior_tx") conn

409+ afterRollback.count `shouldEqual` 1

410+

411+

412+ it "let transaction roll back SQL errors and return the connection to the pool" \conn -> do

413+ setupTxTable conn

414+ result <- try $ PG.withTransaction (\txn -> do

415+ _ <- PG.txExecute (PG.SQL "INSERT INTO behavior_tx (name) VALUES ($1)") [ PG.toPGValue "before error" ] txn

416+ _ <- PG.txExecute (PG.SQL "INSERT INTO missing_behavior_table VALUES ($1)") [ PG.toPGValue 1 ] txn

417+ pure unit

418+ ) conn

419+ result `shouldSatisfy` isLeft

420+ rows <- PG.querySimple (PG.SQL "SELECT * FROM behavior_tx") conn

421+ rows.count `shouldEqual` 0

422+ PG.ping conn >>= (_ `shouldEqual` true)

423+

424+ it "preserves the action failure when rollback also fails" \conn -> do

425+ result <- try $ PG.withTransaction

426+ (\txn -> do

427+ liftEffect $ poisonRollback txn

428+ throwError (error "action failed")

429+ )

430+ conn

431+ case result of

432+ Left cause -> message cause `shouldEqual` "action failed"

433+ Right _ -> throwError (error "expected transaction to fail")

434+ PG.ping conn >>= (_ `shouldEqual` true)

435+

436+ it "let transaction roll back cancellation and return the connection to the pool" \conn -> do

437+ setupTxTable conn

438+ wrote <- liftEffect $ Ref.new false

439+ fiber <- forkAff $ PG.withTransaction

440+ (\txn -> do

441+ _ <- PG.txExecute

442+ (PG.SQL "INSERT INTO behavior_tx (name) VALUES ($1)")

443+ [ PG.toPGValue "cancelled" ]

444+ txn

445+ liftEffect $ Ref.write true wrote

446+ delay (Milliseconds 10000.0)

447+ )

448+ conn

449+ delay (Milliseconds 50.0)

450+ didWrite <- liftEffect $ Ref.read wrote

451+ didWrite `shouldEqual` true

452+ killFiber (error "cancel transaction") fiber

453+ rows <- PG.querySimple (PG.SQL "SELECT * FROM behavior_tx") conn

454+ rows.count `shouldEqual` 0

455+ PG.ping conn >>= (_ `shouldEqual` true)

456+

457+ it "releases the reserved connection when commit itself fails" \_ -> do

458+ own <- liftEffect $ PG.postgres

459+ { host: PG.PostgresHost "localhost"

460+ , port: PG.PostgresPort 5434

461+ , database: PG.PostgresDatabase "test_playground"

462+ , username: PG.PostgresUsername "postgres"

463+ , password: PG.PostgresPassword "postgres"

464+ , max: PG.MaxConnections 1

465+ }

466+ _ <- PG.executeSimple (PG.SQL "DROP TABLE IF EXISTS behavior_commit_failure") own

467+ _ <- PG.executeSimple

468+ (PG.SQL "CREATE TABLE behavior_commit_failure (name TEXT UNIQUE DEFERRABLE INITIALLY DEFERRED)")

469+ own

470+ txn <- PG.begin own

471+ _ <- PG.txExecute

472+ (PG.SQL "INSERT INTO behavior_commit_failure (name) VALUES ($1), ($2)")

473+ [ PG.toPGValue "duplicate", PG.toPGValue "duplicate" ]

474+ txn

475+ commitResult <- try $ PG.commit txn

476+ commitResult `shouldSatisfy` isLeft

477+ PG.ping own >>= (_ `shouldEqual` true)

478+ PG.end own

479+

480+

481+ it "supports deterministic concurrent pool queries" \conn -> do

482+ setupBehaviorTable conn

483+ counts <- parTraverse

484+ (\n -> PG.execute (PG.SQL "INSERT INTO behavior_values (name) VALUES ($1)") [ PG.toPGValue ("worker-" <> show n) ] conn)

485+ (Array.range 1 8)

486+ counts `shouldEqual` Array.replicate 8 1

487+ rows <- PG.querySimple (PG.SQL "SELECT * FROM behavior_values") conn

488+ rows.count `shouldEqual` 8

489+

490+ it "delivers notifications and actually unsubscribes" \conn -> do

491+ received <- liftEffect $ Ref.new ([] :: Array String)

492+ let channel = PG.Channel "behavior_notifications"

493+ PG.listen channel (\notification -> Ref.modify_ (_ <> [ notification.payload ]) received) conn

494+ PG.notify channel "before-unlisten" conn

495+ delay (Milliseconds 100.0)

496+ liftEffect (Ref.read received) >>= (_ `shouldEqual` [ "before-unlisten" ])

497+ PG.unlisten channel conn

498+ PG.notify channel "after-unlisten" conn

499+ delay (Milliseconds 100.0)

500+ liftEffect (Ref.read received) >>= (_ `shouldEqual` [ "before-unlisten" ])

501+

502+ it "rejects missing and deallocated prepared statements" \conn -> do

503+ setupBehaviorTable conn

504+ let name = PG.StatementName "behavior_insert"

505+ missing <- try $ PG.executePrepared name [ PG.toPGValue "x" ] conn

506+ case missing of

507+ Left _ -> pure unit

508+ Right _ -> throwError (error "expected missing prepared statement to fail")

509+ PG.prepare name (PG.SQL "INSERT INTO behavior_values (name) VALUES ($1)") conn

510+ PG.executePrepared name [ PG.toPGValue "prepared" ] conn >>= (_.count >>> (_ `shouldEqual` 1))

511+ PG.deallocate name conn

512+ deallocated <- try $ PG.executePrepared name [ PG.toPGValue "again" ] conn

513+ case deallocated of

514+ Left _ -> pure unit

515+ Right _ -> throwError (error "expected deallocated prepared statement to fail")

516+

517+ it "invokes notice and parameter callbacks as PureScript Effects" \_ -> do

518+ noticeSeen <- liftEffect $ Ref.new false

519+ parameterSeen <- liftEffect $ Ref.new false

520+ callbackConn <- liftEffect $ PG.postgres

521+ { host: PG.PostgresHost "localhost"

522+ , port: PG.PostgresPort 5434

523+ , database: PG.PostgresDatabase "test_playground"

524+ , username: PG.PostgresUsername "postgres"

525+ , password: PG.PostgresPassword "postgres"

526+ , onnotice: Ref.write true noticeSeen

527+ , onparameter: \_ -> Ref.write true parameterSeen

528+ }

529+ _ <- PG.executeSimple (PG.SQL "DO $$ BEGIN RAISE NOTICE 'behavior callback'; END $$") callbackConn

530+ _ <- PG.executeSimple (PG.SQL "SET application_name TO 'yoga-postgres-callback-test'") callbackConn

531+ liftEffect (Ref.read noticeSeen) >>= (_ `shouldEqual` true)

532+ liftEffect (Ref.read parameterSeen) >>= (_ `shouldEqual` true)

533+ PG.end callbackConn

534+

535+ it "connects via connection string and end closes the pool" \_ -> do

536+ own <- liftEffect $ PG.postgres

537+ { connection: PG.ConnectionString "postgres://postgres:postgres@localhost:5434/test_playground" }

538+ PG.ping own >>= (_ `shouldEqual` true)

539+ PG.end own

540+ PG.ping own >>= (_ `shouldEqual` false)

test/EdgeCases.pursnew file+161

@@ -0,0 +1,161 @@

1+module Test.Postgres.EdgeCases where

3+import Prelude

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

3+import Prelude

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+23−16

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

55import Data.Either (Either(..))

66import Data.Maybe (Maybe(..))

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

78import Effect (Effect)

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

910import Effect.Class (liftEffect)

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

1112import Effect.Exception (error)

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

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

15+import Test.Postgres.Behavioral as Behavioral

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

1517import Test.Spec.Runner (runSpec)

1618import Yoga.Test.Docker as Docker

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

2224testHost = PG.PostgresHost "localhost"

2325

2426testPort :: PG.PostgresPort

25−testPort = PG.PostgresPort 5433 -- Test port from docker-compose.test.yml

27+testPort = PG.PostgresPort 5434 -- Test port from docker-compose.test.yml

2628

2729testDatabase :: PG.PostgresDatabase

2830testDatabase = PG.PostgresDatabase "test_playground"

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

9395spec :: Spec Unit

9496spec = do

9597 Schema.spec

98+ Behavioral.pureSpec

99+

100+ around withPostgres do

101+ Behavioral.integrationSpec

102+

96103

97104 describe "Yoga.Postgres Integration Tests" do

98105

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

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

107114 opts <- liftEffect $ PG.options conn

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

109− opts.port `shouldEqual` 5433

116+ opts.port `shouldEqual` 5434

110117 opts.database `shouldEqual` "test_playground"

111118

112119 describe "Connection Errors" do

@@ -120,7 +127,10 @@ spec = do

120127 , password: testPassword

121128 }

122129 PG.ping conn

123− result `shouldSatisfy` isLeft

130+ case result of

131+ Left _ -> pure unit

132+ Right false -> pure unit

133+ Right true -> shouldEqual "unhealthy" "healthy"

124134

125135 -- Basic Query Tests

126136 around withPostgres do

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

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

231241 setupTestTable conn

232242

233− _ <- PG.transaction

243+ _ <- PG.withTransaction

234244 ( \txn -> do

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

236246 [ PG.toPGValue "Henry" ]

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

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

249259 setupTestTable conn

250260

251− result <- try $ PG.transaction

261+ result <- try $ PG.withTransaction

252262 ( \txn -> do

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

254264 [ PG.toPGValue "Jack" ]

255265 txn

256− throwError (error "Intentional error")

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

257267 )

258268 conn

259269

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

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

266276 setupTestTable conn

267277

268− _ <- PG.transaction

278+ _ <- PG.withTransaction

269279 ( \txn -> do

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

271281 [ PG.toPGValue "Leo" ]

@@ -425,19 +435,16 @@ spec = do

425435

426436main :: Effect Unit

427437main = launchAff_ do

428− liftEffect $ log "\n🧪 Starting Postgres Integration Tests (with Docker)\n"

438+ liftEffect $ log "\nStarting Postgres Integration Tests (with Docker)\n"

429439

430440 bracket

431− -- Start Docker before tests

432441 ( do

433− liftEffect $ log "⏳ Starting Postgres and waiting for it to be ready..."

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

435− liftEffect $ log "✅ Postgres is ready!\n"

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

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

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

436445 )

437− -- Stop Docker after tests (always runs!)

438446 ( \_ -> do

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

440− liftEffect $ log "✅ Cleanup complete\n"

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

448+ liftEffect $ log "Cleanup complete\n"

441449 )

442− -- Run tests

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

test/Schema.purs+1337−29

@@ -2,12 +2,28 @@ module Test.Postgres.Schema where

33import Prelude

5−import Data.Maybe (Maybe)

6−import Data.String (contains, Pattern(..))

7−import Data.Tuple.Nested (type (/\))

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

822import Prim.Boolean (True)

923import Test.Spec (Spec, describe, it)

10−import Test.Spec.Assertions (shouldEqual, shouldSatisfy)

24+import Test.Spec.Assertions (shouldEqual)

25+import Type.Proxy (Proxy(..))

26+import Yoga.Postgres as PG

1127import Yoga.Postgres.Schema

1228

1329-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

@@ -15,10 +31,10 @@ import Yoga.Postgres.Schema

1531-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

1632

1733type UsersTable = Table "users"

18− ( id :: Column Int (PrimaryKey /\ AutoIncrement)

19− , name :: Column String None

20− , email :: Column String Unique

21− , age :: Column (Maybe Int) None

34+ ( id :: Int # PrimaryKey # AutoIncrement

35+ , name :: String

36+ , email :: String # Unique

37+ , age :: Maybe Int

2238 )

2339

2440-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

@@ -32,10 +48,6 @@ ddl = createTableDDL @UsersTable

3248-- Phase 3: Type-safe INSERT

3349-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

3450

35−-- Insert should require non-PK, non-default columns

36−-- PK columns (id) are omitted

37−-- Maybe columns (age) become optional

38−

3951insertSQL :: String

4052insertSQL = insertSQLFor @UsersTable

4153

@@ -54,10 +66,10 @@ selectWhereSQL = selectWhereSQLFor @UsersTable @(id :: Int)

5466-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

5567

5668type ConfigTable = Table "config"

57− ( id :: Column Int (PrimaryKey /\ AutoIncrement)

58− , active :: Column Boolean (DefaultBool True)

59− , role :: Column String (Default "'user'")

60− , score :: Column Int (DefaultInt 0)

69+ ( id :: Int # PrimaryKey # AutoIncrement

70+ , active :: Boolean # Default True

71+ , role :: String # Default "user"

72+ , score :: Int # Default 0

6173 )

6274

6375configDDL :: String

@@ -66,6 +78,52 @@ configDDL = createTableDDL @ConfigTable

6678configInsertSQL :: String

6779configInsertSQL = insertSQLFor @ConfigTable

6880

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+

69127-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

70128-- Phase 6: Type-safe UPDATE

71129-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

@@ -80,6 +138,610 @@ updateSQL = updateSQLFor @UsersTable @(name :: String) @(id :: Int)

80138deleteSQL :: String

81139deleteSQL = deleteSQLFor @UsersTable @(id :: Int)

82140

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+

83745-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

84746-- Spec

85747-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

@@ -89,18 +751,15 @@ spec = do

89751 describe "Schema" do

90752 describe "CREATE TABLE DDL" do

91753 it "generates correct DDL for UsersTable" do

92− ddl `shouldSatisfy` contains (Pattern "CREATE TABLE users")

93− ddl `shouldSatisfy` contains (Pattern "id INTEGER NOT NULL PRIMARY KEY GENERATED ALWAYS AS IDENTITY")

94− ddl `shouldSatisfy` contains (Pattern "name TEXT NOT NULL")

95− ddl `shouldSatisfy` contains (Pattern "email TEXT NOT NULL UNIQUE")

96− ddl `shouldSatisfy` contains (Pattern "age INTEGER,")

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

97759

98760 describe "INSERT SQL" do

99761 it "generates INSERT skipping AutoIncrement columns" do

100− insertSQL `shouldSatisfy` contains (Pattern "INSERT INTO users")

101− insertSQL `shouldSatisfy` contains (Pattern "(age, email, name)")

102− insertSQL `shouldSatisfy` contains (Pattern "VALUES ($1, $2, $3)")

103− insertSQL `shouldSatisfy` contains (Pattern "RETURNING *")

762+ insertSQL `shouldEqual` "INSERT INTO users (age, email, name) VALUES ($1, $2, $3) RETURNING *"

104763

105764 describe "SELECT SQL" do

106765 it "generates SELECT ALL" do

@@ -110,11 +769,29 @@ spec = do

110769

111770 describe "Defaults" do

112771 it "renders DEFAULT in DDL" do

113− configDDL `shouldSatisfy` contains (Pattern "active BOOLEAN NOT NULL DEFAULT true")

114− configDDL `shouldSatisfy` contains (Pattern "role TEXT NOT NULL DEFAULT 'user'")

115− configDDL `shouldSatisfy` contains (Pattern "score INTEGER NOT NULL DEFAULT 0")

772+ configDDL `shouldEqual` "CREATE TABLE config (active BOOLEAN NOT NULL DEFAULT true, id INTEGER NOT NULL GENERATED ALWAYS AS IDENTITY PRIMARY KEY, role TEXT NOT NULL DEFAULT 'user', score INTEGER NOT NULL DEFAULT 0)"

116773 it "skips Default columns in INSERT" do

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

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

775+

776+ describe "UUID + DefaultExpr" do

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

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

779+ it "skips DefaultExpr columns in INSERT" do

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

781+ it "builds SELECT with UUID column" do

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

783+ it "builds INSERT skipping DefaultExpr columns" do

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

785+

786+ describe "PGDate + PGTime" do

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

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

789+

790+ describe "Point + TSVector + TSQuery" do

791+ it "renders POINT in DDL" do

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

793+ it "renders TSVECTOR in DDL" do

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

118795

119796 describe "UPDATE SQL" do

120797 it "generates UPDATE with SET and WHERE" do

@@ -123,3 +800,634 @@ spec = do

123800 describe "DELETE SQL" do

124801 it "generates DELETE with WHERE" do

125802 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" } ]