75 Commits

Author SHA1 Message Date
f0fa32ab9c chore: prepare v2.0.17 2024-06-29 14:47:18 -05:00
0b1680a967 chore: prepare v2.0.16 2024-06-29 14:43:05 -05:00
d2c3eba082 fix: correct implementations of MonadAff, MonadEffect, Fork, Bracket 2024-06-29 14:42:47 -05:00
f7b2e6ceae chore: prepare v2.0.15 2024-06-25 17:57:57 -05:00
23496f71f3 fix: pipes should use streamin/out 2024-06-25 17:57:53 -05:00
2e7015b19d chore: prepare v2.0.14 2024-06-25 16:40:19 -05:00
3c686415b0 chore: prepare v2.0.13 2024-06-25 16:02:52 -05:00
4308ebe7e1 fix: strict 2024-06-25 16:02:50 -05:00
dbc2e70bf2 chore: prepare v2.0.12 2024-06-25 16:02:21 -05:00
901e931af4 fix: more relaxation 2024-06-25 16:02:15 -05:00
d5cc8ad95e chore: prepare v2.0.11 2024-06-25 15:54:44 -05:00
1a96e2e6d8 fix: relax class constraints 2024-06-25 15:54:38 -05:00
8350bc1c4a chore: prepare v2.0.10 2024-06-25 15:40:10 -05:00
fad3e8dbcb fix: parRE is alt 2024-06-25 15:40:05 -05:00
275bbe3583 chore: prepare v2.0.9 2024-06-25 15:07:46 -05:00
1d3c16a3a5 chore: prepare v2.0.8 2024-06-25 15:07:39 -05:00
a45aaf5647 chore: prepare v2.0.7 2024-06-25 15:04:12 -05:00
223eeb9160 chore: prepare v2.0.6 2024-06-25 15:04:08 -05:00
7044099d54 chore: prepare v2.0.5 2024-06-25 14:57:29 -05:00
814b1ad590 chore: prepare v2.0.4 2024-06-25 14:51:10 -05:00
bce45daa27 chore: prepare v2.0.3 2024-06-25 14:46:38 -05:00
8a6f84e8bf chore: prepare v2.0.2 2024-06-25 14:38:09 -05:00
cd01d280f4 fix: unused constraint 2024-06-25 14:36:01 -05:00
341971d3f3 chore: prepare v2.0.1 2024-06-25 13:56:30 -05:00
8c77779406 chore: prepare v2.0.0 2024-06-25 13:56:05 -05:00
11c1645173 feat!: rework error handling 2024-06-25 13:54:13 -05:00
c9e5ee9205 chore: prepare v1.7.2 2024-06-23 20:36:00 -05:00
9ab6e37bb1 fix: bump node-stream-pipes 2024-06-23 20:35:44 -05:00
f23eb4143a chore: prepare v1.7.1 2024-06-22 20:01:10 -05:00
d10d21b708 fix: bump node-stream-pipes to 2.0.2 (big perf improvement) 2024-06-22 20:00:58 -05:00
826c1e10b1 chore: prepare v1.7.0 2024-06-14 18:04:01 -05:00
fbb1f3b8a5 fix: add interval support 2024-06-14 17:00:22 -05:00
b4a84a3210 chore: prepare v1.6.5 2024-05-22 15:49:37 -05:00
a56add0ffc fix: update node-stream-pipes 2024-05-22 15:49:14 -05:00
7ed85ae22b fix: tagOf is not instanceof 2024-05-22 15:42:43 -05:00
bead3d81c3 chore: prepare v1.6.4 2024-05-11 23:00:24 -05:00
27a7abb329 fix: stdin txn 2024-05-11 23:00:05 -05:00
86263a7521 chore: prepare v1.6.3 2024-05-11 22:11:07 -05:00
2db29b8916 chore: prepare v1.6.2 2024-05-11 22:10:24 -05:00
cfb01608cd fix: ensure-ranges 2024-05-11 22:09:38 -05:00
aca76f7de3 chore: prepare v1.6.1 2024-05-11 20:45:41 -05:00
188403681a fix: pipes monad stuff 2024-05-11 20:45:04 -05:00
ca7ebb4337 chore: prepare v1.6.0 2024-05-11 13:26:44 -05:00
b3806d5f6e feat: add node-stream-pipes support 2024-05-11 13:25:27 -05:00
adb414662e chore: prepare v1.5.1 2024-04-30 19:26:35 -05:00
69721fcda4 chore: prepare v1.5.1 2024-04-30 19:26:21 -05:00
a616440abe chore: prepare v1.5.1 2024-04-30 19:26:20 -05:00
d66c3261b6 fix: impl Alternative 2024-04-30 19:26:01 -05:00
4e2fd8fa3f chore: prepare v1.5.0 2024-04-30 15:52:30 -05:00
e59266406b feat: streaming STDIO support 2024-04-30 15:46:10 -05:00
3be968da3a chore: prepare v1.4.0 2024-04-29 09:33:44 -05:00
20a0a6de31 chore: prepare v1.4.0 2024-04-29 09:32:23 -05:00
036a7b5de9 chore: prepare v1.4.0 2024-04-29 09:32:19 -05:00
639bee96d0 chore: prepare v 2024-04-29 09:32:05 -05:00
24b2156524 feat: MOVE support for cursors, RowsAffected 2024-04-29 09:31:49 -05:00
3e9f22397d chore: prepare v1.3.0 2024-04-11 16:45:35 -05:00
d3be053a8b chore: prepare v1.3.0 2024-04-11 16:45:27 -05:00
1319a4bce7 chore: prepare v1.3.0 2024-04-11 16:45:25 -05:00
8722e69013 feat: generalize PostgresT to MonadPostgres to allow mocking 2024-04-11 16:45:13 -05:00
5dc5912933 chore: prepare v1.2.7 2024-04-11 15:55:22 -05:00
a4d4e6bd75 fix: impl unlift 2024-04-11 15:55:11 -05:00
f0d2d764fe chore: prepare v1.2.6 2024-04-11 15:38:10 -05:00
ea3ff9b003 chore: lockfile 2024-04-11 15:38:01 -05:00
4832b594dc chore: prepare v1.2.5 2024-04-11 15:37:35 -05:00
aad6544658 chore: ranges 2024-04-11 15:37:29 -05:00
89dec85a31 chore: prepare v1.2.4 2024-04-11 15:36:40 -05:00
5a99e58062 fix: impl monadrec 2024-04-11 15:36:31 -05:00
02add2653a chore: prepare v1.2.3 2024-04-05 22:15:26 -05:00
de1aaccfb6 fix: pin unresult api to rept 2024-04-05 22:15:18 -05:00
43ce1354ea chore: prepare v1.2.2 2024-04-05 22:11:51 -05:00
87614611dd fix: relax cursor constraints, fix enum test 2024-04-05 22:11:44 -05:00
2ab53c43b2 chore: prepare v1.2.1 2024-04-05 21:53:42 -05:00
500e67d793 fix: FromRow t bound on cursor 2024-04-05 21:53:37 -05:00
ca95e0aa94 chore: prepare v1.2.0 2024-04-05 21:49:36 -05:00
bc120b072c feat: UnresultT 2024-04-05 21:49:31 -05:00
36 changed files with 1399 additions and 832 deletions

100
README.md
View File

@@ -116,6 +116,8 @@ which is implemented for:
- `Array a` where `a` is [`FromRow`]
- `Maybe a` where `a` is [`FromRow`] (equivalent to `Array.head <<< fromRows`)
- `a` where `a` is [`FromRow`] (throws if 0 rows yielded)
- `RowsAffected`
- Extracts the number of rows processed by the last command in the query (ex. `INSERT INTO foo (bar) VALUES ('a'), ('b')` -> `INSERT 2` -> `RowsAffected 2`)
### Data - Ranges
Postgres ranges are represented with [`Range`].
@@ -223,9 +225,11 @@ Execute [`CursorT`] monads with [`cursor`]:
dbMain :: PostgresT Aff Int
dbMain =
cursor @(Int /\ String) "people_cursor" "select id, name from persons" do
fetchOne -- Just (1 /\ "Henry")
fetchAll -- [2 /\ "Sarah"]
fetchOne -- Nothing
a <- fetchOne -- Just (1 /\ "Henry")
b <- fetchOne -- Just (2 /\ "Sarah")
void $ move (MoveRelative -2)
c <- fetchAll -- [1 /\ "Henry", 2 /\ "Sarah"]
d <- fetchOne -- Nothing
```
### Monads - `SessionT`
@@ -255,59 +259,59 @@ the api of [`node-postgres`]:
- release clients with [`Pool.release`] or [`Pool.destroy`]
- release with [`Pool.end`]
[`Pool`]: https://pursuit.purescript.org///////packages/purescript-postgresql/1.1.1/docs/Effect.Aff.Postgres.Pool#t:Pool
[`Config`]: https://pursuit.purescript.org///////packages/purescript-postgresql/1.1.1/docs/Effect.Aff.Postgres.Pool#t:Config
[`Pool.make`]: https://pursuit.purescript.org///////packages/purescript-postgresql/1.1.1/docs/Effect.Aff.Postgres.Pool#v:make
[`Pool.end`]: https://pursuit.purescript.org///////packages/purescript-postgresql/1.1.1/docs/Effect.Aff.Postgres.Pool#v:end
[`Pool.connect`]: https://pursuit.purescript.org///////packages/purescript-postgresql/1.1.1/docs/Effect.Aff.Postgres.Pool#v:connect
[`Pool.destroy`]: https://pursuit.purescript.org///////packages/purescript-postgresql/1.1.1/docs/Effect.Aff.Postgres.Pool#v:destroy
[`Pool.release`]: https://pursuit.purescript.org///////packages/purescript-postgresql/1.1.1/docs/Effect.Aff.Postgres.Pool#v:release
[`Pool`]: https://pursuit.purescript.org////////////////////////////////////////////////////////////packages/purescript-postgresql/2.0.17/Effect.Aff.Postgres.Pool#t:Pool
[`Config`]: https://pursuit.purescript.org////////////////////////////////////////////////////////////packages/purescript-postgresql/2.0.17/Effect.Aff.Postgres.Pool#t:Config
[`Pool.make`]: https://pursuit.purescript.org////////////////////////////////////////////////////////////packages/purescript-postgresql/2.0.17/Effect.Aff.Postgres.Pool#v:make
[`Pool.end`]: https://pursuit.purescript.org////////////////////////////////////////////////////////////packages/purescript-postgresql/2.0.17/Effect.Aff.Postgres.Pool#v:end
[`Pool.connect`]: https://pursuit.purescript.org////////////////////////////////////////////////////////////packages/purescript-postgresql/2.0.17/Effect.Aff.Postgres.Pool#v:connect
[`Pool.destroy`]: https://pursuit.purescript.org////////////////////////////////////////////////////////////packages/purescript-postgresql/2.0.17/Effect.Aff.Postgres.Pool#v:destroy
[`Pool.release`]: https://pursuit.purescript.org////////////////////////////////////////////////////////////packages/purescript-postgresql/2.0.17/Effect.Aff.Postgres.Pool#v:release
[`Client`]: https://pursuit.purescript.org///////packages/purescript-postgresql/1.1.1/docs/Effect.Aff.Postgres.Client#t:Client
[`Client.end`]: https://pursuit.purescript.org///////packages/purescript-postgresql/1.1.1/docs/Effect.Aff.Postgres.Client#v:end
[`Client.make`]: https://pursuit.purescript.org///////packages/purescript-postgresql/1.1.1/docs/Effect.Aff.Postgres.Client#v:make
[`Client.connected`]: https://pursuit.purescript.org///////packages/purescript-postgresql/1.1.1/docs/Effect.Aff.Postgres.Client#v:connected
[`Client.query`]: https://pursuit.purescript.org///////packages/purescript-postgresql/1.1.1/docs/Effect.Aff.Postgres.Client#v:query
[`Client.queryRaw`]: https://pursuit.purescript.org///////packages/purescript-postgresql/1.1.1/docs/Effect.Aff.Postgres.Client#v:queryRaw
[`Client.exec`]: https://pursuit.purescript.org///////packages/purescript-postgresql/1.1.1/docs/Effect.Aff.Postgres.Client#v:exec
[`Client`]: https://pursuit.purescript.org////////////////////////////////////////////////////////////packages/purescript-postgresql/2.0.17/Effect.Aff.Postgres.Client#t:Client
[`Client.end`]: https://pursuit.purescript.org////////////////////////////////////////////////////////////packages/purescript-postgresql/2.0.17/Effect.Aff.Postgres.Client#v:end
[`Client.make`]: https://pursuit.purescript.org////////////////////////////////////////////////////////////packages/purescript-postgresql/2.0.17/Effect.Aff.Postgres.Client#v:make
[`Client.connected`]: https://pursuit.purescript.org////////////////////////////////////////////////////////////packages/purescript-postgresql/2.0.17/Effect.Aff.Postgres.Client#v:connected
[`Client.query`]: https://pursuit.purescript.org////////////////////////////////////////////////////////////packages/purescript-postgresql/2.0.17/Effect.Aff.Postgres.Client#v:query
[`Client.queryRaw`]: https://pursuit.purescript.org////////////////////////////////////////////////////////////packages/purescript-postgresql/2.0.17/Effect.Aff.Postgres.Client#v:queryRaw
[`Client.exec`]: https://pursuit.purescript.org////////////////////////////////////////////////////////////packages/purescript-postgresql/2.0.17/Effect.Aff.Postgres.Client#v:exec
[`Range`]: https://pursuit.purescript.org///////packages/purescript-postgresql/1.1.1/docs/Data.Postgres.Range#t:Range
[`Range.gt`]: https://pursuit.purescript.org///////packages/purescript-postgresql/1.1.1/docs/Data.Postgres.Range#v:gt
[`Range.gte`]: https://pursuit.purescript.org///////packages/purescript-postgresql/1.1.1/docs/Data.Postgres.Range#v:gte
[`Range.lt`]: https://pursuit.purescript.org///////packages/purescript-postgresql/1.1.1/docs/Data.Postgres.Range#v:lt
[`Range.lte`]: https://pursuit.purescript.org///////packages/purescript-postgresql/1.1.1/docs/Data.Postgres.Range#v:lte
[`Range`]: https://pursuit.purescript.org////////////////////////////////////////////////////////////packages/purescript-postgresql/2.0.17/Data.Postgres.Range#t:Range
[`Range.gt`]: https://pursuit.purescript.org////////////////////////////////////////////////////////////packages/purescript-postgresql/2.0.17/Data.Postgres.Range#v:gt
[`Range.gte`]: https://pursuit.purescript.org////////////////////////////////////////////////////////////packages/purescript-postgresql/2.0.17/Data.Postgres.Range#v:gte
[`Range.lt`]: https://pursuit.purescript.org////////////////////////////////////////////////////////////packages/purescript-postgresql/2.0.17/Data.Postgres.Range#v:lt
[`Range.lte`]: https://pursuit.purescript.org////////////////////////////////////////////////////////////packages/purescript-postgresql/2.0.17/Data.Postgres.Range#v:lte
[`Raw`]: https://pursuit.purescript.org///////packages/purescript-postgresql/1.1.1/docs/Data.Postgres.Raw#t:Raw
[`Null`]: https://pursuit.purescript.org///////packages/purescript-postgresql/1.1.1/docs/Data.Postgres.Raw#t:Null
[`Raw`]: https://pursuit.purescript.org////////////////////////////////////////////////////////////packages/purescript-postgresql/2.0.17/Data.Postgres.Raw#t:Raw
[`Null`]: https://pursuit.purescript.org////////////////////////////////////////////////////////////packages/purescript-postgresql/2.0.17/Data.Postgres.Raw#t:Null
[`Serialize`]: https://pursuit.purescript.org///////packages/purescript-postgresql/1.1.1/docs/Data.Postgres#t:Serialize
[`Deserialize`]: https://pursuit.purescript.org///////packages/purescript-postgresql/1.1.1/docs/Data.Postgres#t:Deserialize
[`Rep`]: https://pursuit.purescript.org///////packages/purescript-postgresql/1.1.1/docs/Data.Postgres#t:Rep
[`modifyPgTypes`]: https://pursuit.purescript.org///////packages/purescript-postgresql/1.1.1/docs/Data.Postgres#v:modifyPgTypes
[`Serialize`]: https://pursuit.purescript.org////////////////////////////////////////////////////////////packages/purescript-postgresql/2.0.17/Data.Postgres#t:Serialize
[`Deserialize`]: https://pursuit.purescript.org////////////////////////////////////////////////////////////packages/purescript-postgresql/2.0.17/Data.Postgres#t:Deserialize
[`Rep`]: https://pursuit.purescript.org////////////////////////////////////////////////////////////packages/purescript-postgresql/2.0.17/Data.Postgres#t:Rep
[`modifyPgTypes`]: https://pursuit.purescript.org////////////////////////////////////////////////////////////packages/purescript-postgresql/2.0.17/Data.Postgres#v:modifyPgTypes
[`Result`]: https://pursuit.purescript.org///////packages/purescript-postgresql/1.1.1/docs/Data.Postgres.Result#t:Result
[`FromRow`]: https://pursuit.purescript.org///////packages/purescript-postgresql/1.1.1/docs/Data.Postgres.Result#t:FromRow
[`FromRows`]: https://pursuit.purescript.org///////packages/purescript-postgresql/1.1.1/docs/Data.Postgres.Result#t:FromRows
[`Result`]: https://pursuit.purescript.org////////////////////////////////////////////////////////////packages/purescript-postgresql/2.0.17/Data.Postgres.Result#t:Result
[`FromRow`]: https://pursuit.purescript.org////////////////////////////////////////////////////////////packages/purescript-postgresql/2.0.17/Data.Postgres.Result#t:FromRow
[`FromRows`]: https://pursuit.purescript.org////////////////////////////////////////////////////////////packages/purescript-postgresql/2.0.17/Data.Postgres.Result#t:FromRows
[`Query`]: https://pursuit.purescript.org///////packages/purescript-postgresql/1.1.1/docs/Data.Postgres.Query#t:Query
[`AsQuery`]: https://pursuit.purescript.org///////packages/purescript-postgresql/1.1.1/docs/Data.Postgres.Query#t:AsQuery
[`Query`]: https://pursuit.purescript.org////////////////////////////////////////////////////////////packages/purescript-postgresql/2.0.17/Data.Postgres.Query#t:Query
[`AsQuery`]: https://pursuit.purescript.org////////////////////////////////////////////////////////////packages/purescript-postgresql/2.0.17/Data.Postgres.Query#t:AsQuery
[`Query.Builder`]: https://pursuit.purescript.org///////packages/purescript-postgresql/1.1.1/docs/Data.Postgres.Query.Builder#t:Builder
[`Query.Builder.param`]: https://pursuit.purescript.org///////packages/purescript-postgresql/1.1.1/docs/Data.Postgres.Query.Builder#v:param
[`Query.Builder.build`]: https://pursuit.purescript.org///////packages/purescript-postgresql/1.1.1/docs/Data.Postgres.Query.Builder#v:build
[`Query.Builder`]: https://pursuit.purescript.org////////////////////////////////////////////////////////////packages/purescript-postgresql/2.0.17/Data.Postgres.Query.Builder#t:Builder
[`Query.Builder.param`]: https://pursuit.purescript.org////////////////////////////////////////////////////////////packages/purescript-postgresql/2.0.17/Data.Postgres.Query.Builder#v:param
[`Query.Builder.build`]: https://pursuit.purescript.org////////////////////////////////////////////////////////////packages/purescript-postgresql/2.0.17/Data.Postgres.Query.Builder#v:build
[`MonadCursor`]: https://pursuit.purescript.org///////packages/purescript-postgresql/1.1.1/docs/Control.Monad.Postgres#t:MonadCursor
[`MonadSession`]: https://pursuit.purescript.org///////packages/purescript-postgresql/1.1.1/docs/Control.Monad.Postgres#t:MonadSession
[`CursorT`]: https://pursuit.purescript.org///////packages/purescript-postgresql/1.1.1/docs/Control.Monad.Postgres#t:CursorT
[`SessionT`]: https://pursuit.purescript.org///////packages/purescript-postgresql/1.1.1/docs/Control.Monad.Postgres#t:SessionT
[`PostgresT`]: https://pursuit.purescript.org///////packages/purescript-postgresql/1.1.1/docs/Control.Monad.Postgres#t:PostgresT
[`cursor`]: https://pursuit.purescript.org///////packages/purescript-postgresql/1.1.1/docs/Control.Monad.Postgres#v:cursor
[`session`]: https://pursuit.purescript.org///////packages/purescript-postgresql/1.1.1/docs/Control.Monad.Postgres#v:session
[`transaction`]: https://pursuit.purescript.org///////packages/purescript-postgresql/1.1.1/docs/Control.Monad.Postgres#v:transaction
[`runPostgres`]: https://pursuit.purescript.org///////packages/purescript-postgresql/1.1.1/docs/Control.Monad.Postgres#v:runPostgres
[`query`]: https://pursuit.purescript.org///////packages/purescript-postgresql/1.1.1/docs/Control.Monad.Postgres#v:query
[`exec`]: https://pursuit.purescript.org///////packages/purescript-postgresql/1.1.1/docs/Control.Monad.Postgres#v:exec
[`exec_`]: https://pursuit.purescript.org///////packages/purescript-postgresql/1.1.1/docs/Control.Monad.Postgres#v:exec_
[`MonadCursor`]: https://pursuit.purescript.org////////////////////////////////////////////////////////////packages/purescript-postgresql/2.0.17/Control.Monad.Postgres#t:MonadCursor
[`MonadSession`]: https://pursuit.purescript.org////////////////////////////////////////////////////////////packages/purescript-postgresql/2.0.17/Control.Monad.Postgres#t:MonadSession
[`CursorT`]: https://pursuit.purescript.org////////////////////////////////////////////////////////////packages/purescript-postgresql/2.0.17/Control.Monad.Postgres#t:CursorT
[`SessionT`]: https://pursuit.purescript.org////////////////////////////////////////////////////////////packages/purescript-postgresql/2.0.17/Control.Monad.Postgres#t:SessionT
[`PostgresT`]: https://pursuit.purescript.org////////////////////////////////////////////////////////////packages/purescript-postgresql/2.0.17/Control.Monad.Postgres#t:PostgresT
[`cursor`]: https://pursuit.purescript.org////////////////////////////////////////////////////////////packages/purescript-postgresql/2.0.17/Control.Monad.Postgres#v:cursor
[`session`]: https://pursuit.purescript.org////////////////////////////////////////////////////////////packages/purescript-postgresql/2.0.17/Control.Monad.Postgres#v:session
[`transaction`]: https://pursuit.purescript.org////////////////////////////////////////////////////////////packages/purescript-postgresql/2.0.17/Control.Monad.Postgres#v:transaction
[`runPostgres`]: https://pursuit.purescript.org////////////////////////////////////////////////////////////packages/purescript-postgresql/2.0.17/Control.Monad.Postgres#v:runPostgres
[`query`]: https://pursuit.purescript.org////////////////////////////////////////////////////////////packages/purescript-postgresql/2.0.17/Control.Monad.Postgres#v:query
[`exec`]: https://pursuit.purescript.org////////////////////////////////////////////////////////////packages/purescript-postgresql/2.0.17/Control.Monad.Postgres#v:exec
[`exec_`]: https://pursuit.purescript.org////////////////////////////////////////////////////////////packages/purescript-postgresql/2.0.17/Control.Monad.Postgres#v:exec_
[`node-postgres`]: https://node-postgres.com/
[`pg-types`]: https://github.com/brianc/node-pg-types/

BIN
bun.lockb

Binary file not shown.

View File

@@ -1,5 +1,5 @@
{
"name": "purs",
"name": "purescript-postgresql",
"private": true,
"module": "index.js",
"type": "module",
@@ -14,6 +14,9 @@
"dependencies": {
"decimal.js": "^10.4.3",
"pg": "^8.11.3",
"pg-copy-streams": "^6.0.6",
"pg-listen": "^1.7.0",
"postgres-interval": "1.2.0",
"postgres-range": "^1.1.4"
}
}

View File

@@ -15,32 +15,42 @@ workspace:
- foldable-traversable: ">=6.0.0 <7.0.0"
- foreign: ">=7.0.0 <8.0.0"
- fork: ">=6.0.0 <7.0.0"
- functors: ">=5.0.0 <6.0.0"
- integers: ">=6.0.0 <7.0.0"
- js-bigints: ">=2.2.1 <3.0.0"
- lists: ">=7.0.0 <8.0.0"
- maybe: ">=6.0.0 <7.0.0"
- mmorph: ">=7.0.0 <8.0.0"
- monad-control: ">=5.0.0 <6.0.0"
- newtype: ">=5.0.0 <6.0.0"
- node-buffer: ">=9.0.0 <10.0.0"
- node-event-emitter: ">=3.0.0 <4.0.0"
- node-fs: ">=9.1.0 <9.2.0"
- node-stream-pipes: ">=2.1.0 <3.0.0"
- node-streams: ">=9.0.0 <10.0.0"
- nullable: ">=6.0.0 <7.0.0"
- parallel: ">=6.0.0 <7.0.0"
- partial: ">=4.0.0 <5.0.0"
- pipes: ">=8.0.0 <9.0.0"
- precise-datetime: ">=7.0.0 <8.0.0"
- prelude: ">=6.0.1 <7.0.0"
- profunctor: ">=6.0.1 <7.0.0"
- record: ">=4.0.0 <5.0.0"
- refs: ">=6.0.0 <7.0.0"
- simple-json: ">=9.0.0 <10.0.0"
- strings: ">=6.0.1 <7.0.0"
- tailrec: ">=6.1.0 <7.0.0"
- transformers: ">=6.0.0 <7.0.0"
- tuples: ">=7.0.0 <8.0.0"
- typelevel-prelude: ">=7.0.0 <8.0.0"
- unlift: ">=1.0.1 <2.0.0"
- unsafe-coerce: ">=6.0.0 <7.0.0"
test_dependencies:
- filterable
- foreign-object
- node-child-process
- node-process
- precise-datetime
- quickcheck
- spec
- spec-quickcheck
@@ -73,6 +83,7 @@ workspace:
- fork
- formatters
- free
- freet
- functions
- functors
- gen
@@ -86,6 +97,7 @@ workspace:
- lists
- maybe
- mmorph
- monad-control
- newtype
- node-buffer
- node-child-process
@@ -94,7 +106,9 @@ workspace:
- node-os
- node-path
- node-process
- node-stream-pipes
- node-streams
- node-zlib
- nonempty
- now
- nullable
@@ -126,489 +140,10 @@ workspace:
- typelevel-prelude
- unfoldable
- unicode
- unlift
- unordered-collections
- unsafe-coerce
- variant
package_set:
address:
registry: 50.5.0
compiler: ">=0.15.15 <0.16.0"
content:
abc-parser: 2.0.1
ace: 9.1.0
aff: 7.1.0
aff-bus: 6.0.0
aff-coroutines: 9.0.0
aff-promise: 4.0.0
aff-retry: 2.0.0
affjax: 13.0.0
affjax-node: 1.0.0
affjax-web: 1.0.0
ansi: 7.0.0
applicative-phases: 1.0.0
argonaut: 9.0.0
argonaut-aeson-generic: 0.4.1
argonaut-codecs: 9.1.0
argonaut-core: 7.0.0
argonaut-generic: 8.0.0
argonaut-traversals: 10.0.0
argparse-basic: 2.0.0
array-builder: 0.1.2
array-search: 0.5.6
arraybuffer: 13.2.0
arraybuffer-builder: 3.1.0
arraybuffer-types: 3.0.2
arrays: 7.3.0
arrays-extra: 0.6.1
arrays-zipper: 2.0.1
ask: 1.0.0
assert: 6.0.0
assert-multiple: 0.3.4
avar: 5.0.0
b64: 0.0.8
barbies: 1.0.1
barlow-lens: 0.9.0
bifunctors: 6.0.0
bigints: 7.0.1
bolson: 0.3.9
bookhound: 0.1.7
bower-json: 3.0.0
call-by-name: 4.0.1
canvas: 6.0.0
canvas-action: 9.0.0
cartesian: 1.0.6
catenable-lists: 7.0.0
chameleon: 1.0.0
chameleon-halogen: 1.0.3
chameleon-react-basic: 1.1.0
chameleon-styled: 2.5.0
chameleon-transformers: 1.0.0
channel: 1.0.0
checked-exceptions: 3.1.1
choku: 1.0.1
classless: 0.1.1
classless-arbitrary: 0.1.1
classless-decode-json: 0.1.1
classless-encode-json: 0.1.3
classnames: 2.0.0
codec: 6.1.0
codec-argonaut: 10.0.0
codec-json: 1.1.0
colors: 7.0.1
concur-core: 0.5.0
concur-react: 0.5.0
concurrent-queues: 3.0.0
console: 6.1.0
const: 6.0.0
contravariant: 6.0.0
control: 6.0.0
convertable-options: 1.0.0
coroutines: 7.0.0
css: 6.0.0
css-frameworks: 1.0.1
data-mvc: 0.0.2
datetime: 6.1.0
datetime-parsing: 0.2.0
debug: 6.0.2
decimals: 7.1.0
default-values: 1.0.1
deku: 0.9.23
deno: 0.0.5
dissect: 1.0.0
distributive: 6.0.0
dom-filereader: 7.0.0
dom-indexed: 12.0.0
dotenv: 4.0.3
droplet: 0.6.0
dts: 1.0.0
dual-numbers: 1.0.2
dynamic-buffer: 3.0.1
echarts-simple: 0.0.1
effect: 4.0.0
either: 6.1.0
elmish: 0.11.3
elmish-enzyme: 0.1.1
elmish-hooks: 0.10.0
elmish-html: 0.8.2
elmish-testing-library: 0.3.2
email-validate: 7.0.0
encoding: 0.0.9
enums: 6.0.1
env-names: 0.3.4
error: 2.0.0
eta-conversion: 0.3.2
exceptions: 6.0.0
exists: 6.0.0
exitcodes: 4.0.0
expect-inferred: 3.0.0
fahrtwind: 2.0.0
fallback: 0.1.0
fast-vect: 1.2.0
fetch: 4.1.0
fetch-argonaut: 1.0.1
fetch-core: 5.1.0
fetch-yoga-json: 1.1.0
fft-js: 0.1.0
filterable: 5.0.0
fix-functor: 0.1.0
fixed-points: 7.0.0
fixed-precision: 5.0.0
flame: 1.3.0
float32: 2.0.0
fmt: 0.2.1
foldable-traversable: 6.0.0
foldable-traversable-extra: 0.0.6
foreign: 7.0.0
foreign-object: 4.1.0
foreign-readwrite: 3.4.0
forgetmenot: 0.1.0
fork: 6.0.0
form-urlencoded: 7.0.0
formatters: 7.0.0
framer-motion: 1.0.1
free: 7.1.0
freeap: 7.0.0
freer-free: 0.0.1
freet: 7.0.0
functions: 6.0.0
functor1: 3.0.0
functors: 5.0.0
fuzzy: 0.4.0
gen: 4.0.0
generate-values: 1.0.1
generic-router: 0.0.1
geojson: 0.0.5
geometry-plane: 1.0.3
gojs: 0.1.1
grain: 3.0.0
grain-router: 3.0.0
grain-virtualized: 3.0.0
graphs: 8.1.0
group: 4.1.1
halogen: 7.0.0
halogen-bootstrap5: 5.3.2
halogen-canvas: 1.0.0
halogen-css: 10.0.0
halogen-echarts-simple: 0.0.4
halogen-formless: 4.0.3
halogen-helix: 1.0.0
halogen-hooks: 0.6.3
halogen-hooks-extra: 0.9.0
halogen-infinite-scroll: 1.1.0
halogen-store: 0.5.4
halogen-storybook: 2.0.0
halogen-subscriptions: 2.0.0
halogen-svg-elems: 8.0.0
halogen-typewriter: 1.0.4
halogen-vdom: 8.0.0
halogen-vdom-string-renderer: 0.5.0
halogen-xterm: 2.0.0
heckin: 2.0.1
heterogeneous: 0.6.0
homogeneous: 0.4.0
http-methods: 6.0.0
httpurple: 4.0.0
humdrum: 0.0.1
hyrule: 2.3.8
identity: 6.0.0
identy: 4.0.1
indexed-db: 1.0.0
indexed-monad: 3.0.0
int64: 3.0.0
integers: 6.0.0
interpolate: 5.0.2
intersection-observer: 1.0.1
invariant: 6.0.0
jarilo: 1.0.1
jelly: 0.10.0
jelly-router: 0.3.0
jelly-signal: 0.4.0
jest: 1.0.0
js-abort-controller: 1.0.0
js-bigints: 2.2.1
js-date: 8.0.0
js-fetch: 0.2.1
js-fileio: 3.0.0
js-intl: 1.0.4
js-iterators: 0.1.1
js-maps: 0.1.2
js-promise: 1.0.0
js-promise-aff: 1.0.0
js-timers: 6.1.0
js-uri: 3.1.0
json: 1.0.0
json-codecs: 5.0.0
justifill: 0.5.0
jwt: 0.0.9
labeled-data: 0.2.0
language-cst-parser: 0.14.0
lazy: 6.0.0
lazy-joe: 1.0.0
lcg: 4.0.0
leibniz: 5.0.0
leveldb: 1.0.1
liminal: 1.0.1
linalg: 6.0.0
lists: 7.0.0
literals: 1.0.2
logging: 3.0.0
logging-journald: 0.4.0
lumi-components: 18.0.0
machines: 7.0.0
maps-eager: 0.4.1
marionette: 1.0.0
marionette-react-basic-hooks: 0.1.1
marked: 0.1.0
matrices: 5.0.1
matryoshka: 1.0.0
maybe: 6.0.0
media-types: 6.0.0
meowclient: 1.0.0
midi: 4.0.0
milkis: 9.0.0
minibench: 4.0.1
mmorph: 7.0.0
monad-control: 5.0.0
monad-logger: 1.3.1
monad-loops: 0.5.0
monad-unlift: 1.0.1
monoid-extras: 0.0.1
monoidal: 0.16.0
morello: 0.4.0
mote: 3.0.0
motsunabe: 2.0.0
mvc: 0.0.1
mysql: 6.0.1
n3: 0.1.0
nano-id: 1.1.0
nanoid: 0.1.0
naturals: 3.0.0
nested-functor: 0.2.1
newtype: 5.0.0
nextjs: 0.1.1
nextui: 0.2.0
node-buffer: 9.0.0
node-child-process: 11.1.0
node-event-emitter: 3.0.0
node-execa: 5.0.0
node-fs: 9.1.0
node-glob-basic: 1.3.0
node-http: 9.1.0
node-http2: 1.1.1
node-human-signals: 1.0.0
node-net: 5.1.0
node-os: 5.1.0
node-path: 5.0.0
node-process: 11.2.0
node-readline: 8.1.0
node-sqlite3: 8.0.0
node-streams: 9.0.0
node-tls: 0.3.1
node-url: 7.0.1
node-zlib: 0.4.0
nonempty: 7.0.0
now: 6.0.0
npm-package-json: 2.0.0
nullable: 6.0.0
numberfield: 0.1.0
numbers: 9.0.1
oak: 3.1.1
oak-debug: 1.2.2
object-maps: 0.3.0
ocarina: 1.5.4
open-folds: 6.3.0
open-memoize: 6.1.0
open-pairing: 6.1.0
options: 7.0.0
optparse: 5.0.1
ordered-collections: 3.2.0
ordered-set: 0.4.0
orders: 6.0.0
owoify: 1.2.0
pairs: 9.0.1
parallel: 7.0.0
parsing: 10.2.0
parsing-dataview: 3.2.4
partial: 4.0.0
pathy: 9.0.0
pha: 0.13.0
phaser: 0.7.0
phylio: 1.1.2
pipes: 8.0.0
pirates-charm: 0.0.1
pmock: 0.9.0
point-free: 1.0.0
pointed-list: 0.5.1
polymorphic-vectors: 4.0.0
posix-types: 6.0.0
precise: 6.0.0
precise-datetime: 7.0.0
prelude: 6.0.1
prettier-printer: 3.0.0
profunctor: 6.0.1
profunctor-lenses: 8.0.0
protobuf: 4.3.0
psa-utils: 8.0.0
psci-support: 6.0.0
punycode: 1.0.0
qualified-do: 2.2.0
quantities: 12.2.0
quickcheck: 8.0.1
quickcheck-combinators: 0.1.3
quickcheck-laws: 7.0.0
quickcheck-utf8: 0.0.0
random: 6.0.0
rationals: 6.0.0
rdf: 0.1.0
react: 11.0.0
react-aria: 0.2.0
react-basic: 17.0.0
react-basic-classic: 3.0.0
react-basic-dnd: 10.1.0
react-basic-dom: 6.1.0
react-basic-emotion: 7.1.0
react-basic-hooks: 8.2.0
react-basic-storybook: 2.0.0
react-dom: 8.0.0
react-halo: 3.0.0
react-icons: 1.1.4
react-markdown: 0.1.0
react-testing-library: 4.0.1
react-virtuoso: 1.0.0
read: 1.0.1
recharts: 1.1.0
record: 4.0.0
record-extra: 5.0.1
record-ptional-fields: 0.1.2
record-studio: 1.0.4
refs: 6.0.0
remotedata: 5.0.1
resize-observer: 1.0.0
resource: 2.0.1
resourcet: 1.0.0
result: 1.0.3
return: 0.2.0
ring-modules: 5.0.1
rito: 0.3.4
rough-notation: 1.0.2
routing: 11.0.0
routing-duplex: 0.7.0
run: 5.0.0
safe-coerce: 2.0.0
safely: 4.0.1
school-of-music: 1.3.0
selection-foldable: 0.2.0
selective-functors: 1.0.1
semirings: 7.0.0
signal: 13.0.0
simple-emitter: 3.0.1
simple-i18n: 2.0.1
simple-json: 9.0.0
simple-ulid: 3.0.0
sized-matrices: 1.0.0
sized-vectors: 5.0.2
slug: 3.0.8
small-ffi: 4.0.1
soundfonts: 4.1.0
sparse-matrices: 1.3.0
sparse-polynomials: 2.0.5
spec: 7.6.0
spec-mocha: 5.1.0
spec-quickcheck: 5.0.0
splitmix: 2.1.0
ssrs: 1.0.0
st: 6.2.0
statistics: 0.3.2
strictlypositiveint: 1.0.1
string-parsers: 8.0.0
strings: 6.0.1
strings-extra: 4.0.0
stringutils: 0.0.12
substitute: 0.2.3
supply: 0.2.0
svg-parser: 3.0.0
systemd-journald: 0.3.0
tagged: 4.0.2
tailrec: 6.1.0
tecton: 0.2.1
tecton-halogen: 0.2.0
test-unit: 17.0.0
thermite: 6.3.1
thermite-dom: 0.3.1
these: 6.0.0
transformation-matrix: 1.0.1
transformers: 6.0.0
tree-rose: 4.0.2
ts-bridge: 4.0.0
tuples: 7.0.0
two-or-more: 1.0.0
type-equality: 4.0.1
typedenv: 2.0.1
typelevel: 6.0.0
typelevel-lists: 2.1.0
typelevel-peano: 1.0.1
typelevel-prelude: 7.0.0
typelevel-regex: 0.0.3
typelevel-rows: 0.1.0
uint: 7.0.0
ulid: 3.0.1
uncurried-transformers: 1.1.0
undefined: 2.0.0
undefined-is-not-a-problem: 1.1.0
unfoldable: 6.0.0
unicode: 6.0.0
unique: 0.6.1
unlift: 1.0.1
unordered-collections: 3.1.0
unsafe-coerce: 6.0.0
unsafe-reference: 5.0.0
untagged-to-tagged: 0.1.4
untagged-union: 1.0.0
uri: 9.0.0
uuid: 9.0.0
uuidv4: 1.0.0
validation: 6.0.0
variant: 8.0.0
variant-encodings: 2.0.0
vectorfield: 1.0.1
vectors: 2.1.0
versions: 7.0.0
visx: 0.0.2
web-clipboard: 5.0.0
web-cssom: 2.0.0
web-cssom-view: 0.1.0
web-dom: 6.0.0
web-dom-parser: 8.0.0
web-dom-xpath: 3.0.0
web-encoding: 3.0.0
web-events: 4.0.0
web-fetch: 4.0.1
web-file: 4.0.0
web-geometry: 0.1.0
web-html: 4.1.0
web-pointerevents: 2.0.0
web-proletarian: 1.0.0
web-promise: 3.2.0
web-resize-observer: 2.1.0
web-router: 1.0.0
web-socket: 4.0.0
web-storage: 5.0.0
web-streams: 4.0.0
web-touchevents: 4.0.0
web-uievents: 5.0.0
web-url: 2.0.0
web-workers: 1.1.0
web-xhr: 5.0.1
webextension-polyfill: 0.1.0
webgpu: 0.0.1
which: 2.0.0
xterm: 1.0.0
yoga-fetch: 1.0.1
yoga-json: 5.1.0
yoga-om: 0.1.0
yoga-postgres: 6.0.0
yoga-tree: 1.0.0
z3: 0.0.2
zipperarray: 2.0.0
extra_packages: {}
packages:
aff:
@@ -923,6 +458,21 @@ packages:
- transformers
- tuples
- unsafe-coerce
freet:
type: registry
version: 7.0.0
integrity: sha256-zkL6wU4ZPq8xz1kGFxoliWqyhBksepMJTyA68VEBaJo=
dependencies:
- aff
- bifunctors
- effect
- either
- exists
- free
- prelude
- tailrec
- transformers
- tuples
functions:
type: registry
version: 6.0.0
@@ -1059,6 +609,15 @@ packages:
- free
- functors
- transformers
monad-control:
type: registry
version: 5.0.0
integrity: sha256-bgfDW30wbIm70NR1Tvvh9P+VFQMDh1wK2sSJXCj/dZc=
dependencies:
- aff
- freet
- identity
- lists
newtype:
type: registry
version: 5.0.0
@@ -1171,6 +730,44 @@ packages:
- posix-types
- prelude
- unsafe-coerce
node-stream-pipes:
type: registry
version: 2.1.4
integrity: sha256-/DyKe03WTu5e4EJ5Ym7lvRhakhztLtNhy8fccE8+Ouw=
dependencies:
- aff
- arrays
- console
- control
- datetime
- effect
- either
- exceptions
- foldable-traversable
- foreign-object
- fork
- lists
- maybe
- mmorph
- newtype
- node-buffer
- node-event-emitter
- node-fs
- node-path
- node-streams
- node-zlib
- now
- ordered-collections
- parallel
- pipes
- prelude
- st
- strings
- tailrec
- transformers
- tuples
- unordered-collections
- unsafe-coerce
node-streams:
type: registry
version: 9.0.0
@@ -1184,6 +781,19 @@ packages:
- node-event-emitter
- nullable
- prelude
node-zlib:
type: registry
version: 0.4.0
integrity: sha256-kYSajFQFzWVg71l5/y4w4kXdTr5EJoqyV3D2RqmAjQ4=
dependencies:
- aff
- effect
- either
- functions
- node-buffer
- node-streams
- prelude
- unsafe-coerce
nonempty:
type: registry
version: 7.0.0
@@ -1242,8 +852,8 @@ packages:
- prelude
parallel:
type: registry
version: 7.0.0
integrity: sha256-gUC9i4Txnx9K9RcMLsjujbwZz6BB1bnE2MLvw4GIw5o=
version: 6.0.0
integrity: sha256-VJbkGD0rAKX+NUEeBJbYJ78bEKaZbgow+QwQEfPB6ko=
dependencies:
- control
- effect
@@ -1511,8 +1121,8 @@ packages:
- refs
transformers:
type: registry
version: 6.0.0
integrity: sha256-Pzw40HjthX77tdPAYzjx43LK3X5Bb7ZspYAp27wksFA=
version: 6.1.0
integrity: sha256-3Bm+Z6tsC/paG888XkywDngJ2JMos+JfOhRlkVfb7gI=
dependencies:
- control
- distributive
@@ -1525,6 +1135,7 @@ packages:
- maybe
- newtype
- prelude
- st
- tailrec
- tuples
- unfoldable
@@ -1566,6 +1177,38 @@ packages:
- foldable-traversable
- maybe
- strings
unlift:
type: registry
version: 1.0.1
integrity: sha256-nbBCVV0fZz/3UHKoW11dcTwBYmQOIgK31ht2BN47RPw=
dependencies:
- aff
- effect
- either
- freet
- identity
- lists
- maybe
- monad-control
- prelude
- st
- transformers
- tuples
unordered-collections:
type: registry
version: 3.1.0
integrity: sha256-H2eQR+ylI+cljz4XzWfEbdF7ee+pnw2IZCeq69AuJ+Q=
dependencies:
- arrays
- enums
- functions
- integers
- lists
- prelude
- record
- tuples
- typelevel-prelude
- unfoldable
unsafe-coerce:
type: registry
version: 6.0.0

View File

@@ -1,7 +1,7 @@
package:
name: postgresql
publish:
version: '1.1.1'
version: '2.0.17'
license: 'GPL-3.0-or-later'
location:
githubOwner: 'cakekindel'
@@ -25,27 +25,36 @@ package:
- foldable-traversable: ">=6.0.0 <7.0.0"
- foreign: ">=7.0.0 <8.0.0"
- fork: ">=6.0.0 <7.0.0"
- functors: ">=5.0.0 <6.0.0"
- integers: ">=6.0.0 <7.0.0"
- js-bigints: ">=2.2.1 <3.0.0"
- lists: ">=7.0.0 <8.0.0"
- maybe: ">=6.0.0 <7.0.0"
- mmorph: ">=7.0.0 <8.0.0"
- monad-control: ">=5.0.0 <6.0.0"
- newtype: ">=5.0.0 <6.0.0"
- node-buffer: ">=9.0.0 <10.0.0"
- node-event-emitter: ">=3.0.0 <4.0.0"
- node-stream-pipes: ">=2.1.0 <3.0.0"
- node-streams: ">=9.0.0 <10.0.0"
- nullable: ">=6.0.0 <7.0.0"
- parallel: ">=6.0.0 <7.0.0"
- partial: ">=4.0.0 <5.0.0"
- pipes: ">=8.0.0 <9.0.0"
- precise-datetime: ">=7.0.0 <8.0.0"
- prelude: ">=6.0.1 <7.0.0"
- profunctor: ">=6.0.1 <7.0.0"
- record: ">=4.0.0 <5.0.0"
- refs: ">=6.0.0 <7.0.0"
- simple-json: ">=9.0.0 <10.0.0"
- strings: ">=6.0.1 <7.0.0"
- tailrec: ">=6.1.0 <7.0.0"
- transformers: ">=6.0.0 <7.0.0"
- tuples: ">=7.0.0 <8.0.0"
- typelevel-prelude: ">=7.0.0 <8.0.0"
- unlift: ">=1.0.1 <2.0.0"
- unsafe-coerce: ">=6.0.0 <7.0.0"
- node-fs: ">=9.1.0 <9.2.0"
test:
main: Test.Main
dependencies:
@@ -53,10 +62,9 @@ package:
- foreign-object
- node-child-process
- node-process
- precise-datetime
- quickcheck
- spec
- spec-quickcheck
workspace:
extraPackages: {}
packageSet:
registry: 50.5.0

View File

@@ -2,22 +2,27 @@ module Control.Monad.Postgres.Base where
import Prelude
import Control.Alt (class Alt)
import Control.Alternative (class Plus)
import Control.Monad.Error.Class (class MonadError, class MonadThrow, catchError, throwError)
import Control.Monad.Fork.Class (class MonadBracket, class MonadFork, class MonadKill, bracket, kill, never, uninterruptible)
import Control.Monad.Morph (class MFunctor, class MMonad)
import Control.Monad.Postgres.Session (class MonadSession, SessionT, exec, exec_, query)
import Control.Monad.Reader (class MonadAsk, class MonadReader, ReaderT, ask, local, runReaderT)
import Control.Monad.Trans.Class (class MonadTrans, lift)
import Control.Parallel (class Parallel, parallel, sequential)
import Data.Newtype (class Newtype, unwrap, wrap)
import Effect.Aff (Fiber)
import Control.Monad.Error.Class (catchError, throwError)
import Control.Monad.Fork.Class (class MonadBracket, bracket)
import Control.Monad.Morph (hoist)
import Control.Monad.Postgres.Cursor (class MonadCursor, CursorT)
import Control.Monad.Postgres.Session (class MonadSession, SessionT, endSession, exec, exec_, startSession)
import Control.Monad.Reader (ask, runReaderT)
import Data.Newtype (unwrap)
import Data.Postgres (RepT)
import Data.Postgres.Query (class AsQuery, asQuery)
import Data.Postgres.Raw (Raw)
import Data.Postgres.Result (class FromRow, fromRow)
import Data.Tuple.Nested ((/\))
import Effect.Aff.Class (class MonadAff, liftAff)
import Effect.Aff.Postgres.Pool (Pool)
import Effect.Aff.Postgres.Pool as Pool
import Effect.Class (class MonadEffect, liftEffect)
import Effect.Exception (Error)
import Effect.Class (liftEffect)
import Effect.Exception as Effect
import Effect.Postgres.Error (RE)
import Effect.Postgres.Error as E
import Effect.Postgres.Error.Except as X
import Effect.Postgres.Error.RE as RE
import Prim.Row (class Union)
-- | Monad handling pool resource acquisition & release
@@ -44,84 +49,75 @@ import Prim.Row (class Union)
-- | res <- Client.query "select * from foo" client
-- | pure $ res == 1
-- | ```
newtype PostgresT :: forall k. (k -> Type) -> k -> Type
newtype PostgresT m a = PostgresT (ReaderT Pool m a)
type PostgresT :: (Type -> Type) -> Type -> Type
type PostgresT = RE Pool
derive instance Newtype (PostgresT m a) _
derive newtype instance (Functor m) => Functor (PostgresT m)
derive newtype instance (Apply m) => Apply (PostgresT m)
derive newtype instance (Applicative m) => Applicative (PostgresT m)
derive newtype instance (Plus m) => Plus (PostgresT m)
derive newtype instance (Alt m) => Alt (PostgresT m)
derive newtype instance (Bind m) => Bind (PostgresT m)
derive newtype instance (Monad m) => Monad (PostgresT m)
derive newtype instance (MonadEffect m) => MonadEffect (PostgresT m)
derive newtype instance (MonadAff m) => MonadAff (PostgresT m)
derive newtype instance MonadTrans (PostgresT)
derive newtype instance (MonadThrow e m) => MonadThrow e (PostgresT m)
derive newtype instance (MonadError e m) => MonadError e (PostgresT m)
derive newtype instance (MonadFork f m) => MonadFork f (PostgresT m)
derive newtype instance MFunctor PostgresT
derive newtype instance MMonad PostgresT
instance (Apply m, Apply p, Parallel p m) => Parallel (PostgresT p) (PostgresT m) where
parallel = wrap <<< parallel <<< unwrap
sequential = wrap <<< sequential <<< unwrap
instance (Monad m, MonadKill e f m) => MonadKill e f (PostgresT m) where
kill a b = lift $ kill a b
instance (Monad m, MonadBracket e f (ReaderT Pool m), MonadBracket e f m) => MonadBracket e f (PostgresT m) where
bracket acq rel m = wrap $ bracket (unwrap acq) (\a b -> unwrap $ rel a b) (unwrap <<< m)
uninterruptible a = wrap $ uninterruptible $ unwrap a
never = lift $ never
instance Monad m => MonadAsk Pool (PostgresT m) where
ask = wrap ask
instance Monad m => MonadReader Pool (PostgresT m) where
local f m = wrap $ local f $ unwrap m
instance (MonadBracket e f m, MonadAff m) => MonadSession (PostgresT m) where
query = session <<< query
exec = session <<< exec
exec_ = session <<< exec_
-- | Lifts a session to `PostgresT`, releasing the client to the pool
-- | after execution.
session :: forall e f m a. MonadBracket e f m => MonadAff m => MonadSession (SessionT m) => SessionT m a -> PostgresT m a
session m = do
pool <- ask
let
acq = liftAff $ Pool.connect pool
rel _ c = liftEffect $ Pool.release pool c
lift $ bracket acq rel (runReaderT m)
-- | Lifts a session to `PostgresT`, running the session
-- | in a transaction.
-- | Typeclass generalizing `PostgresT`. Allows for dependency-injecting different
-- | implementations of the idea of a postgres connection.
-- |
-- | If the session throws an error, the transaction will be
-- | rolled back and the error rethrown.
transaction :: forall m a. MonadBracket Error Fiber m => MonadAff m => MonadSession (SessionT m) => SessionT m a -> PostgresT m a
transaction m =
let
begin = void $ exec "begin;"
commit = m <* exec "commit;"
rollback e = exec "rollback;" *> throwError e
in
session $ begin *> catchError commit rollback
-- | - `session` - Session monad (for `PostgresT` this is `SessionT`)
-- | - `cursor` - Cursor session monad (for `PostgresT` this is `CursorT`)
-- | - `ct` - Open type parameter for cursor type. Don't pin this to a concrete type.
class (Monad m, MonadSession session, MonadCursor cursor ct) <= MonadPostgres m session cursor ct | m -> ct cursor session where
-- | Run a session in `m`.
session :: session ~> m
-- | Run a session in `m`, wrapped in a transaction.
-- |
-- | If any errors are raised, the transaction is rolled back and
-- | the error rethrown.
transaction :: session ~> m
-- | `cursor`, but using a custom deserialize function for the data
-- | yielded by the cursor
cursorWith :: forall q. AsQuery q => (Array Raw -> RepT ct) -> String -> q -> cursor ~> m
instance
( MonadAff m
, MonadSession (SessionT m)
, MonadCursor (CursorT t (SessionT m)) t
) => MonadPostgres
(PostgresT m)
(SessionT m)
(CursorT ct (SessionT m))
ct
where
session m = do
pool <- ask
client <- RE.liftExcept $ hoist liftAff $ startSession pool
RE.finally
(RE.liftExcept $ hoist liftEffect $ endSession pool client)
(RE.liftExcept $ RE.toExcept m client)
transaction m =
let
begin = void $ exec "begin;"
commit = m <* exec "commit;"
rollback e = exec "rollback;" *> throwError e
in
session $ begin *> catchError commit rollback
cursorWith f cur q m =
transaction do
q' <- RE.liftExcept $ X.printing $ asQuery q
exec_ $ "declare " <> cur <> " cursor for (" <> (unwrap q').text <> ");"
runReaderT (unwrap m) (cur /\ f)
-- | Create a server-side cursor for a query in a transaction,
-- | and execute a `CursorT` with a view to the new cursor.
cursor :: forall @cursort t session cursor q a. MonadPostgres t session cursor cursort => AsQuery q => FromRow cursort => String -> q -> cursor a -> t a
cursor = cursorWith (fromRow 0)
-- | Execute a `PostgresT` using an existing connection pool.
-- |
-- | This will not invoke `Pool.end` after executing.
withPool :: forall m a. PostgresT m a -> Pool -> m a
withPool = runReaderT <<< unwrap
withPool :: forall m a. PostgresT m a -> Pool -> E.Except m a
withPool m p = runReaderT (unwrap m) p
-- | Create a new connection pool from the provided config and execute
-- | the postgres monad, invoking `Effect.Aff.Postgres.Pool.end` afterwards.
runPostgres :: forall m a missing trash r e f. MonadBracket e f m => MonadAff m => Union r missing (Pool.Config trash) => Record r -> PostgresT m a -> m a
runPostgres :: forall m a missing trash r f. MonadBracket Effect.Error f m => MonadAff m => Union r missing (Pool.Config trash) => Record r -> PostgresT m a -> E.Except m a
runPostgres cfg m =
let
acq :: RE Unit m Pool
acq = liftEffect $ Pool.make @r @missing @trash cfg
rel _ p = liftAff $ Pool.end p
rel :: _ -> Pool -> RE Unit m Unit
rel _ p = RE.liftExcept $ hoist liftAff $ Pool.end p
in
bracket acq rel $ withPool m
RE.toExcept (bracket acq rel $ RE.liftExcept <<< withPool m) unit

View File

@@ -3,26 +3,35 @@ module Control.Monad.Postgres.Cursor where
import Prelude
import Control.Alt (class Alt)
import Control.Alternative (class Plus)
import Control.Alternative (class Alternative, class Plus)
import Control.Monad.Error.Class (class MonadError, class MonadThrow)
import Control.Monad.Fork.Class (class MonadBracket, class MonadFork, class MonadKill, bracket, kill, never, uninterruptible)
import Control.Monad.Postgres.Base (PostgresT, transaction)
import Control.Monad.Postgres.Session (class MonadSession, SessionT, exec, exec_, query)
import Control.Monad.Reader (class MonadAsk, class MonadReader, ReaderT, ask, local, runReaderT)
import Control.Monad.Postgres.Session (class MonadSession, exec, exec_, query, streamIn, streamOut)
import Control.Monad.Reader (class MonadAsk, class MonadReader, ReaderT, ask, local)
import Control.Monad.Rec.Class (class MonadRec)
import Control.Monad.Trans.Class (class MonadTrans, lift)
import Control.Parallel (class Parallel, parallel, sequential)
import Data.Array as Array
import Data.Maybe (Maybe)
import Data.Newtype (class Newtype, unwrap, wrap)
import Data.Postgres.Query (class AsQuery, asQuery)
import Data.Postgres.Result (class FromRow)
import Effect.Aff (Fiber)
import Data.Postgres (RepT, smash)
import Data.Postgres.Raw (Raw)
import Data.Postgres.Result (RowsAffected(..))
import Data.Traversable (traverse)
import Data.Tuple.Nested (type (/\), (/\))
import Effect.Aff.Class (class MonadAff)
import Effect.Aff.Unlift (class MonadUnliftAff)
import Effect.Class (class MonadEffect, liftEffect)
import Effect.Exception (Error)
import Effect.Unlift (class MonadUnliftEffect)
data Move
-- | `MOVE RELATIVE`
= MoveRelative Int
-- | `MOVE ABSOLUTE`
| MoveTo Int
newtype CursorT :: forall k. Type -> (k -> Type) -> k -> Type
newtype CursorT t m a = CursorT (ReaderT String m a)
newtype CursorT t m a = CursorT (ReaderT (String /\ (Array Raw -> RepT t)) m a)
derive instance Newtype (CursorT t m a) _
derive newtype instance (Functor m) => Functor (CursorT t m)
@@ -30,10 +39,14 @@ derive newtype instance (Apply m) => Apply (CursorT t m)
derive newtype instance (Applicative m) => Applicative (CursorT t m)
derive newtype instance (Plus m) => Plus (CursorT t m)
derive newtype instance (Alt m) => Alt (CursorT t m)
derive newtype instance (Alternative m) => Alternative (CursorT t m)
derive newtype instance (Bind m) => Bind (CursorT t m)
derive newtype instance (Monad m) => Monad (CursorT t m)
derive newtype instance (MonadEffect m) => MonadEffect (CursorT t m)
derive newtype instance (MonadAff m) => MonadAff (CursorT t m)
derive newtype instance MonadRec m => MonadRec (CursorT t m)
derive newtype instance (MonadUnliftEffect m) => MonadUnliftEffect (CursorT t m)
derive newtype instance (MonadUnliftAff m) => MonadUnliftAff (CursorT t m)
derive newtype instance MonadTrans (CursorT t)
derive newtype instance (MonadThrow e m) => MonadThrow e (CursorT t m)
derive newtype instance (MonadError e m) => MonadError e (CursorT t m)
@@ -46,10 +59,10 @@ instance (Monad m, MonadBracket e f (ReaderT String m), MonadBracket e f m) => M
uninterruptible a = wrap $ uninterruptible $ unwrap a
never = lift $ never
instance Monad m => MonadAsk String (CursorT t m) where
instance Monad m => MonadAsk (String /\ (Array Raw -> RepT t)) (CursorT t m) where
ask = wrap ask
instance Monad m => MonadReader String (CursorT t m) where
instance Monad m => MonadReader (String /\ (Array Raw -> RepT t)) (CursorT t m) where
local f m = wrap $ local f $ unwrap m
instance (Apply m, Apply p, Parallel p m) => Parallel (CursorT t p) (CursorT t m) where
@@ -78,34 +91,40 @@ instance (Apply m, Apply p, Parallel p m) => Parallel (CursorT t p) (CursorT t m
-- | e <- fetchAll -- 15..100
-- | pure unit
-- | ```
class (MonadSession m, FromRow t) <= MonadCursor m t where
class (MonadSession m) <= MonadCursor m t where
-- | Fetch a specified number of rows from the cursor
fetch :: Int -> m (Array t)
-- | Fetch all remaining rows from the cursor
fetchAll :: m (Array t)
-- | Change the cursor's position without fetching any data,
-- | returning the number of rows skipped.
move :: Move -> m Int
instance (FromRow t, MonadSession m) => MonadCursor (CursorT t m) t where
instance (MonadSession m) => MonadCursor (CursorT t m) t where
fetch n = do
cur <- ask
query $ "fetch forward " <> show n <> " from " <> cur
cur /\ f <- ask
raw :: Array (Array Raw) <- query $ "fetch forward " <> show n <> " from " <> cur
liftEffect $ smash $ traverse f raw
fetchAll = do
cur <- ask
query $ "fetch all from " <> cur
cur /\ f <- ask
raw :: Array (Array Raw) <- query $ "fetch all from " <> cur
liftEffect $ smash $ traverse f raw
move (MoveTo n) = do
cur /\ _ <- ask
RowsAffected n' <- query $ ("move absolute $1 from " <> cur) /\ n
pure n'
move (MoveRelative n) = do
cur /\ _ <- ask
RowsAffected n' <- query $ ("move relative $1 from " <> cur) /\ n
pure n'
instance (MonadSession m) => MonadSession (CursorT t m) where
query = lift <<< query
exec = lift <<< exec
exec_ = lift <<< exec_
streamIn = lift <<< streamIn
streamOut = lift <<< streamOut
-- | Fetch the next row from the cursor
fetchOne :: forall m t. MonadCursor m t => m (Maybe t)
fetchOne = Array.head <$> fetch 1
-- | Create a server-side cursor for a query in a transaction,
-- | and execute a `CursorT` with a view to the new cursor.
cursor :: forall m @t a q. AsQuery q => MonadAff m => MonadBracket Error Fiber m => MonadSession (SessionT m) => String -> q -> CursorT t (SessionT m) a -> PostgresT m a
cursor cur q m =
transaction do
q' <- liftEffect $ asQuery q
exec_ $ "declare " <> cur <> " cursor for (" <> (unwrap q').text <> ");"
runReaderT (unwrap m) cur

View File

@@ -1,16 +1,45 @@
module Control.Monad.Postgres.Session where
import Prelude
import Prelude hiding (join)
import Control.Monad.Reader (ReaderT, ask)
import Control.Monad.Error.Class (class MonadError, catchError, throwError)
import Control.Monad.Morph (hoist)
import Control.Monad.Reader (ask)
import Control.Monad.Trans.Class (lift)
import Data.Newtype (wrap)
import Data.Postgres.Query (class AsQuery)
import Data.Postgres.Result (class FromRows)
import Effect (Effect)
import Effect.Aff (Aff)
import Effect.Aff.Class (class MonadAff, liftAff)
import Effect.Aff.Postgres.Client (Client)
import Effect.Aff.Postgres.Client as Client
import Effect.Aff.Postgres.Pool (Pool)
import Effect.Aff.Postgres.Pool as Pool
import Effect.Class (class MonadEffect, liftEffect)
import Effect.Postgres.Error (RE)
import Effect.Postgres.Error as E
import Effect.Postgres.Error.Except as X
import Effect.Postgres.Error.RE as RE
import Effect.Ref as Ref
import Node.EventEmitter as Event
import Node.Stream (Readable, Stream, Writable)
import Node.Stream as Stream
type SessionT :: forall k. (k -> Type) -> k -> Type
type SessionT = ReaderT Client
type SessionT :: (Type -> Type) -> Type -> Type
type SessionT = RE Client
class MonadStartSession a where
startSession :: a -> E.Except Aff Client
endSession :: a -> Client -> E.Except Effect Unit
instance MonadStartSession Pool where
startSession = Pool.connect
endSession p c = Pool.release p c
instance MonadStartSession Client where
startSession = pure
endSession _ _ = pure unit
-- | A monad representing a connected session to a database
class MonadAff m <= MonadSession m where
@@ -20,12 +49,63 @@ class MonadAff m <= MonadSession m where
exec :: forall q. AsQuery q => q -> m Int
-- | Executes a query and discards the result
exec_ :: forall q. AsQuery q => q -> m Unit
-- | Execute a query with a `Writable` stream to `STDIN`
-- |
-- | Use with `COPY .. FROM` like so:
-- |
-- | ```purescript
-- | w <- streamIn "COPY foo FROM STDIN WITH (FORMAT CSV, HEADER true)"
-- | liftEffect $ Stream.writeString "bar\n\"my bar column\"" UTF8 w
-- | ```
streamIn :: String -> m (Writable ())
-- | Execute a query with a `Readable` stream from `STDOUT`
-- |
-- | Use with `COPY .. TO` like so:
-- |
-- | ```purescript
-- | r <- streamIn "COPY foo TO STDIN WITH (FORMAT CSV, HEADER true)"
-- | liftEffect $ Stream.readString r -- "bar\n\"my bar column\""
-- | ```
streamOut :: String -> m (Readable ())
instance MonadAff m => MonadSession (SessionT m) where
instance (MonadStartSession s, MonadAff m) => MonadSession (RE s m) where
query q = do
client <- ask
liftAff $ Client.query q client
pool <- ask
client <- hoist liftAff $ RE.liftExcept $ startSession pool
RE.finally
(hoist liftEffect $ RE.liftExcept $ endSession pool client)
(wrap $ lift $ hoist liftAff $ Client.query q client)
exec q = do
client <- ask
liftAff $ Client.exec q client
pool <- ask
client <- hoist liftAff $ RE.liftExcept $ startSession pool
RE.finally
(hoist liftEffect $ RE.liftExcept $ endSession pool client)
(wrap $ lift $ hoist liftAff $ Client.exec q client)
exec_ = void <<< exec
streamIn q = do
pool <- ask
client <- hoist liftAff $ RE.liftExcept $ startSession pool
handleStream (X.run $ endSession pool client) (RE.liftExcept $ hoist liftEffect $ Client.execWithStdin q client)
streamOut q = do
pool <- ask
client <- hoist liftAff $ RE.liftExcept $ startSession pool
handleStream (X.run $ endSession pool client) (RE.liftExcept $ hoist liftEffect $ Client.queryWithStdout q client)
handleStream :: forall e m r. MonadEffect m => MonadError e m => Effect Unit -> m (Stream r) -> m (Stream r)
handleStream onError getStream =
flip catchError
(\e -> liftEffect onError *> throwError e)
do
stream <- getStream
liftEffect $ onErrorOrClose stream onError
pure stream
onErrorOrClose :: forall r. Stream r -> Effect Unit -> Effect Unit
onErrorOrClose stream eff = do
did <- Ref.new false
let
onE = do
did' <- Ref.read did
when (not did') (Ref.write true did *> eff)
Event.once_ Stream.errorH (const onE) stream
Event.once_ Stream.closeH onE stream

View File

@@ -5,6 +5,7 @@ import Prelude
import Control.Alt ((<|>))
import Control.Monad.Error.Class (liftMaybe)
import Data.Array.NonEmpty.Internal (NonEmptyArray)
import Data.Bifunctor (lmap)
import Data.Foldable (intercalate)
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep as G
@@ -17,7 +18,7 @@ import Data.Postgres.Raw (Raw)
import Data.Symbol (class IsSymbol)
import Data.Traversable (find)
import Data.Tuple (fst, snd)
import Data.Tuple.Nested (type (/\))
import Data.Tuple.Nested (type (/\), (/\))
import Foreign (ForeignError(..))
import Type.Prelude (Proxy(..), reflectSymbol)
@@ -45,19 +46,19 @@ defaultSerializeEnum :: forall @a ty. CustomEnum a ty => a -> RepT Raw
defaultSerializeEnum = serialize <<< printEnum
class GenericCustomEnum a where
genericEnumVariants' :: NonEmptyArray a
genericEnumVariants' :: NonEmptyArray (a /\ String)
genericParseEnum' :: String -> Maybe a
genericPrintEnum' :: a -> String
instance IsSymbol n => GenericCustomEnum (G.Constructor n G.NoArguments) where
genericEnumVariants' = pure (G.Constructor @n G.NoArguments)
genericEnumVariants' = pure (G.Constructor @n G.NoArguments /\ reflectSymbol (Proxy @n))
genericParseEnum' s
| s == reflectSymbol (Proxy @n) = Just (G.Constructor @n G.NoArguments)
| otherwise = Nothing
genericPrintEnum' _ = reflectSymbol (Proxy @n)
instance (GenericCustomEnum a, GenericCustomEnum b) => GenericCustomEnum (G.Sum a b) where
genericEnumVariants' = (G.Inl <$> genericEnumVariants' @a) <> (G.Inr <$> genericEnumVariants' @b)
genericEnumVariants' = (lmap G.Inl <$> genericEnumVariants' @a) <> (lmap G.Inr <$> genericEnumVariants' @b)
genericParseEnum' s = (G.Inl <$> genericParseEnum' @a s) <|> (G.Inr <$> genericParseEnum' @b s)
genericPrintEnum' (G.Inl a) = genericPrintEnum' a
genericPrintEnum' (G.Inr a) = genericPrintEnum' a
@@ -65,8 +66,8 @@ instance (GenericCustomEnum a, GenericCustomEnum b) => GenericCustomEnum (G.Sum
enumPrintExpr :: forall @a ty. CustomEnum a ty => a -> Maybe String
enumPrintExpr = Just <<< (\s -> quoted s <> " :: " <> typeName @a) <<< printEnum
genericEnumVariants :: forall a g. Generic a g => GenericCustomEnum g => NonEmptyArray a
genericEnumVariants = G.to <$> genericEnumVariants'
genericEnumVariants :: forall a g. Generic a g => GenericCustomEnum g => NonEmptyArray (a /\ String)
genericEnumVariants = lmap G.to <$> genericEnumVariants'
genericParseEnum :: forall a g. Generic a g => GenericCustomEnum g => String -> Maybe a
genericParseEnum = map G.to <<< genericParseEnum'

View File

@@ -2,20 +2,13 @@ module Data.Postgres.Custom where
import Prelude
import Control.Monad.Except (ExceptT)
import Data.Either (hush)
import Data.List.NonEmpty (NonEmptyList)
import Data.Maybe (Maybe, fromJust)
import Data.Postgres.Raw (Raw)
import Data.Maybe (fromJust)
import Data.String as String
import Data.String.Regex (Regex)
import Data.String.Regex as Regex
import Data.String.Regex.Flags as Regex.Flags
import Effect (Effect)
import Foreign (ForeignError)
import Partial.Unsafe (unsafePartial)
import Type.Data.Symbol (reflectSymbol)
import Type.Prelude (class IsSymbol, Proxy(..))
quoted :: String -> String
quoted s = "'" <> s <> "'"

View File

@@ -0,0 +1,30 @@
import PostgresInterval from 'postgres-interval'
/** @typedef {import('postgres-interval').IPostgresInterval} I */
/** @type {(o: {years: number, months: number, days: number, hours: number, minutes: number, seconds: number, milliseconds: number}) => I} */
export const make = o => Object.assign(PostgresInterval(''), o)
/** @type {(s: string) => () => I} */
export const parse = s => () => PostgresInterval(s)
/** @type {(a: I) => number} */
export const getYears = i => i.years || 0.0
/** @type {(a: I) => number} */
export const getMonths = i => i.months || 0.0
/** @type {(a: I) => number} */
export const getDays = i => i.days || 0.0
/** @type {(a: I) => number} */
export const getMinutes = i => i.minutes || 0.0
/** @type {(a: I) => number} */
export const getHours = i => i.hours || 0.0
/** @type {(a: I) => number} */
export const getSeconds = i => i.seconds || 0.0
/** @type {(a: I) => number} */
export const getMilliseconds = i => i.milliseconds || 0.0

View File

@@ -0,0 +1,88 @@
module Data.Postgres.Interval where
import Prelude
import Data.Int as Int
import Data.Maybe (Maybe(..))
import Data.Newtype (unwrap)
import Data.Time.Duration (class Duration, Days(..), Hours(..), Milliseconds(..), Minutes(..), Seconds(..), convertDuration)
import Effect (Effect)
zero :: IntervalRecord
zero = {years: 0, months: 0, days: 0, hours: 0, minutes: 0, seconds: 0, milliseconds: 0.0}
type IntervalRecord =
{ years :: Int
, months :: Int
, days :: Int
, hours :: Int
, minutes :: Int
, seconds :: Int
, milliseconds :: Number
}
foreign import data Interval :: Type
foreign import make :: IntervalRecord -> Interval
foreign import parse :: String -> Effect Interval
foreign import getYears :: Interval -> Int
foreign import getMonths :: Interval -> Int
foreign import getDays :: Interval -> Int
foreign import getHours :: Interval -> Int
foreign import getMinutes :: Interval -> Int
foreign import getSeconds :: Interval -> Int
foreign import getMilliseconds :: Interval -> Number
toDuration :: forall d. Semigroup d => Duration d => Interval -> Maybe d
toDuration a =
let
includesMonths = getYears a > 0 || getMonths a > 0
days :: d
days = convertDuration $ Days $ Int.toNumber $ getDays a
hours :: d
hours = convertDuration $ Hours $ Int.toNumber $ getHours a
minutes :: d
minutes = convertDuration $ Minutes $ Int.toNumber $ getMinutes a
seconds :: d
seconds = convertDuration $ Seconds $ Int.toNumber $ getSeconds a
milliseconds :: d
milliseconds = convertDuration $ Milliseconds $ getMilliseconds a
in
if includesMonths then Nothing else Just (days <> hours <> minutes <> seconds <> milliseconds)
toRecord :: Interval -> IntervalRecord
toRecord a =
{ years: getYears a
, months: getMonths a
, days: getDays a
, hours: getHours a
, minutes: getMinutes a
, seconds: getSeconds a
, milliseconds: getMilliseconds a
}
fromDuration :: forall d. Duration d => d -> Interval
fromDuration a =
let
millisTotal :: Number
millisTotal = (unwrap :: Milliseconds -> Number) $ convertDuration a
secondFactor = 1000.0
minuteFactor = 60.0 * secondFactor
hourFactor = 60.0 * minuteFactor
dayFactor = 24.0 * hourFactor
days = Int.trunc $ millisTotal / dayFactor
daysRem = millisTotal - (Int.toNumber days * dayFactor)
hours = Int.trunc $ daysRem / hourFactor
hoursRem = daysRem - (Int.toNumber hours * hourFactor)
minutes = Int.trunc $ hoursRem / minuteFactor
minutesRem = hoursRem - (Int.toNumber minutes * minuteFactor)
seconds = Int.trunc $ minutesRem / secondFactor
milliseconds = minutesRem - (Int.toNumber seconds * secondFactor)
in
make {years: 0, months: 0, days, hours, minutes, seconds, milliseconds}

View File

@@ -2,10 +2,11 @@ module Data.Postgres.Query where
import Prelude
import Control.Monad.Cont (lift)
import Data.Maybe (Maybe(..))
import Data.Newtype (class Newtype)
import Data.Nullable (Nullable, toNullable)
import Data.Postgres (class Rep, serialize, smash)
import Data.Postgres (class Rep, RepT, serialize)
import Data.Postgres.Raw (Raw)
import Data.Tuple.Nested (type (/\), (/\))
import Effect (Effect)
@@ -30,26 +31,29 @@ derive newtype instance Show Query
emptyQuery :: Query
emptyQuery = Query { text: "", values: [], name: Nothing }
stringQuery :: String -> Query
stringQuery s = Query { text: s, values: [], name: Nothing }
-- | Any value that can be converted to an array of query parameters
class AsQueryParams a where
asQueryParams :: a -> Effect (Array Raw)
asQueryParams :: a -> RepT (Array Raw)
instance AsQueryParams (Array Raw) where
asQueryParams = pure
else instance (Rep a, AsQueryParams b) => AsQueryParams (a /\ b) where
asQueryParams (a /\ tail) = do
a' <- map pure $ smash $ serialize a
a' <- map pure $ serialize a
tail' <- asQueryParams tail
pure $ a' <> tail'
else instance (Rep a) => AsQueryParams a where
asQueryParams = map pure <<< smash <<< serialize
asQueryParams = map pure <<< serialize
-- | Values that can be rendered as a SQL query
class AsQuery a where
asQuery :: a -> Effect Query
asQuery :: a -> RepT Query
instance AsQuery a => AsQuery (Effect a) where
asQuery a = asQuery =<< a
asQuery a = asQuery =<< lift a
instance AsQuery Query where
asQuery = pure

View File

@@ -2,13 +2,15 @@ module Data.Postgres.Result where
import Prelude
import Control.Monad.Error.Class (liftMaybe, throwError)
import Control.Monad.Error.Class (catchError, liftMaybe, throwError)
import Data.Array as Array
import Data.Generic.Rep (class Generic)
import Data.Int as Int
import Data.Maybe (Maybe)
import Data.Newtype (class Newtype)
import Data.Nullable (Nullable)
import Data.Nullable as Nullable
import Data.Postgres (class Rep, RepT, deserialize)
import Data.Postgres (class Deserialize, RepT, deserialize)
import Data.Postgres.Raw (Raw)
import Data.Traversable (traverse)
import Data.Tuple (Tuple)
@@ -27,19 +29,29 @@ foreign import data Result :: Type
rowsAffected :: Result -> Maybe Int
rowsAffected = Int.fromNumber <=< Nullable.toMaybe <<< __rowsAffected
class FromRows a where
fromRows :: Array (Array Raw) -> RepT a
newtype RowsAffected = RowsAffected Int
instance (FromRow a) => FromRows (Array a) where
fromRows = traverse fromRow
derive instance Newtype RowsAffected _
derive instance Generic RowsAffected _
derive newtype instance Eq RowsAffected
derive newtype instance Ord RowsAffected
derive newtype instance Show RowsAffected
class FromRows a where
fromRows :: RowsAffected -> Array (Array Raw) -> RepT a
instance FromRows RowsAffected where
fromRows a _ = pure a
else instance (FromRow a) => FromRows (Array a) where
fromRows _ = traverse (fromRow 0)
else instance (FromRow a) => FromRows (Maybe a) where
fromRows = map Array.head <<< traverse fromRow
fromRows _ = map Array.head <<< traverse (fromRow 0)
else instance (FromRow a) => FromRows a where
fromRows =
fromRows a =
let
e = pure $ ForeignError $ "Expected at least 1 row"
in
liftMaybe e <=< fromRows @(Maybe a)
liftMaybe e <=< fromRows @(Maybe a) a
-- | Can be unmarshalled from a queried row
-- |
@@ -77,29 +89,34 @@ class FromRow (a :: Type) where
-- | Minimum length of row for type `a`
minColumnCount :: forall g. g a -> Int
-- | Performs the conversion
fromRow :: Array Raw -> RepT a
fromRow :: Int -> Array Raw -> RepT a
instance (Rep a, FromRow b) => FromRow (a /\ b) where
instance (Deserialize a, FromRow b) => FromRow (a /\ b) where
minColumnCount _ = minColumnCount (Proxy @b) + 1
fromRow r =
fromRow n r =
let
minLen = minColumnCount (Proxy @(Tuple a b))
lengthMismatch = pure $ TypeMismatch ("Expected row to have at least " <> show minLen <> " columns") ("Found row of length " <> show (Array.length r))
in
do
let
de a =
catchError
(deserialize @a a)
(\e -> throwError $ ErrorAtIndex n <$> e)
when (Array.length r < minLen) (throwError lengthMismatch)
a <- deserialize =<< liftMaybe lengthMismatch (Array.head r)
b <- fromRow =<< liftMaybe lengthMismatch (Array.tail r)
a <- de =<< liftMaybe lengthMismatch (Array.head r)
b <- fromRow (n + 1) =<< liftMaybe lengthMismatch (Array.tail r)
pure $ a /\ b
else instance FromRow (Array Raw) where
minColumnCount _ = 0
fromRow = pure
fromRow _ = pure
else instance FromRow Unit where
minColumnCount _ = 0
fromRow _ = pure unit
else instance Rep a => FromRow a where
fromRow _ _ = pure unit
else instance Deserialize a => FromRow a where
minColumnCount _ = 1
fromRow r =
fromRow _ r =
let
err = pure $ TypeMismatch "Expected row of length >= 1" "Empty row"
in

View File

@@ -0,0 +1,27 @@
module Data.Postgres.Unresult where
import Prelude
import Control.Monad.Error.Class (liftMaybe)
import Control.Monad.State (StateT, runStateT, state)
import Data.Array as Array
import Data.Postgres (class Deserialize, RepT, deserialize, smash)
import Data.Postgres.Raw (Raw)
import Data.Tuple (fst)
import Data.Tuple.Nested ((/\))
import Effect.Class (liftEffect)
import Foreign (ForeignError(..))
-- | Monad used to incrementally deserialize columns from a row
type Unresult a = StateT { ix :: Int, row :: Array Raw } RepT a
-- | Run an `UnresultT`
unresult :: forall a. Unresult a -> Array Raw -> RepT a
unresult m row = fst <$> runStateT m { ix: 0, row }
-- | Take the next column from the row, unmarshalling into `a`
take :: forall a. Deserialize a => Unresult a
take = do
raw <- state (\r -> Array.index r.row r.ix /\ r { ix = r.ix + 1 })
raw' <- liftMaybe (pure $ ForeignError $ "Ran out of columns!") raw
liftEffect $ smash $ deserialize raw'

View File

@@ -1,5 +1,24 @@
import Pg from 'pg'
import Range from 'postgres-range'
import { Buffer } from 'buffer'
import PostgresInterval from 'postgres-interval'
/** @type {(a: unknown) => boolean} */
export const isInstanceOfBuffer = a => a instanceof Buffer
/** @type {(a: unknown) => boolean} */
export const isInstanceOfInterval = a => {
return typeof a === 'object'
&& a !== null
&& ('years' in a
|| 'months' in a
|| 'days' in a
|| 'hours' in a
|| 'minutes' in a
|| 'seconds' in a
|| 'milliseconds' in a
)
}
export const modifyPgTypes = () => {
// https://github.com/brianc/node-pg-types/blob/master/lib/textParsers.js

View File

@@ -3,23 +3,28 @@ module Data.Postgres where
import Prelude
import Control.Alt ((<|>))
import Control.Monad.Error.Class (liftEither, liftMaybe)
import Control.Monad.Error.Class (liftEither, liftMaybe, throwError)
import Control.Monad.Except (ExceptT, runExceptT)
import Control.Monad.Morph (hoist)
import Control.Monad.Trans.Class (lift)
import Data.Bifunctor (lmap)
import Data.DateTime (DateTime)
import Data.DateTime.Instant (Instant)
import Data.DateTime.Instant as Instant
import Data.List.NonEmpty (NonEmptyList)
import Data.Maybe (Maybe(..))
import Data.Newtype (class Newtype, unwrap, wrap)
import Data.Postgres.Interval (Interval)
import Data.Postgres.Interval as Interval
import Data.Postgres.Range (Range, __rangeFromRecord, __rangeRawFromRaw, __rangeRawFromRecord, __rangeRawToRecord, __rangeToRecord)
import Data.Postgres.Raw (Null(..), Raw, jsNull)
import Data.Postgres.Raw (unsafeFromForeign, asForeign) as Raw
import Data.RFC3339String as DateTime.ISO
import Data.Time.Duration (Days, Hours, Milliseconds, Minutes, Seconds)
import Data.Traversable (traverse)
import Effect (Effect)
import Effect.Exception (error)
import Foreign (ForeignError(..), unsafeToForeign)
import Foreign (ForeignError(..), tagOf, unsafeFromForeign, unsafeToForeign)
import Foreign as F
import JS.BigInt (BigInt)
import JS.BigInt as BigInt
@@ -40,8 +45,11 @@ derive newtype instance ReadForeign a => ReadForeign (JSON a)
-- | for some types to unmarshal as strings rather than JS values.
foreign import modifyPgTypes :: Effect Unit
foreign import isInstanceOfBuffer :: F.Foreign -> Boolean
foreign import isInstanceOfInterval :: F.Foreign -> Boolean
-- | The serialization & deserialization monad.
type RepT a = ExceptT (NonEmptyList ForeignError) Effect a
type RepT = ExceptT (NonEmptyList ForeignError) Effect
-- | Flatten to an Effect, `show`ing errors
smash :: forall a. RepT a -> Effect a
@@ -68,6 +76,9 @@ instance (Serialize a, Deserialize a) => Rep a
unsafeSerializeCoerce :: forall m a. Monad m => a -> m Raw
unsafeSerializeCoerce = pure <<< Raw.unsafeFromForeign <<< F.unsafeToForeign
invalidDuration :: NonEmptyList ForeignError
invalidDuration = pure $ ForeignError $ "Can't convert interval with year or month components to Milliseconds"
instance Serialize Raw where
serialize = pure
@@ -107,10 +118,38 @@ instance Serialize String where
instance Serialize Number where
serialize = unsafeSerializeCoerce
-- | `timestamp`, `timestamptz`
-- | `interval`
instance Serialize DateTime where
serialize = serialize <<< unwrap <<< DateTime.ISO.fromDateTime
-- | `interval`
instance Serialize Interval where
serialize = unsafeSerializeCoerce
-- | `interval`
instance Serialize Milliseconds where
serialize = serialize <<< Interval.fromDuration
-- | `interval`
instance Serialize Seconds where
serialize = serialize <<< Interval.fromDuration
-- | `interval`
instance Serialize Minutes where
serialize = serialize <<< Interval.fromDuration
-- | `interval`
instance Serialize Hours where
serialize = serialize <<< Interval.fromDuration
-- | `interval`
instance Serialize Days where
serialize = serialize <<< Interval.fromDuration
-- | `timestamp`, `timestamptz`
instance Serialize Instant where
serialize = serialize <<< Instant.toDateTime
-- | `Just` -> `a`, `Nothing` -> `NULL`
instance Serialize a => Serialize (Maybe a) where
serialize (Just a) = serialize a
@@ -142,7 +181,41 @@ instance ReadForeign a => Deserialize (JSON a) where
-- | `bytea`
instance Deserialize Buffer where
deserialize = (F.unsafeReadTagged "Buffer") <<< Raw.asForeign
deserialize =
let
notBuffer a = pure $ TypeMismatch (tagOf a) "Buffer"
readBuffer a = when (not $ isInstanceOfBuffer a) (throwError $ notBuffer a) $> unsafeFromForeign a
in
readBuffer <<< Raw.asForeign
-- | `interval`
instance Deserialize Interval where
deserialize =
let
notInterval a = pure $ TypeMismatch (tagOf a) "Interval"
readInterval a = when (not $ isInstanceOfInterval a) (throwError $ notInterval a) $> unsafeFromForeign a
in
readInterval <<< Raw.asForeign
-- | `interval`
instance Deserialize Milliseconds where
deserialize = flip bind (liftMaybe invalidDuration) <<< map Interval.toDuration <<< deserialize
-- | `interval`
instance Deserialize Seconds where
deserialize = flip bind (liftMaybe invalidDuration) <<< map Interval.toDuration <<< deserialize
-- | `interval`
instance Deserialize Minutes where
deserialize = flip bind (liftMaybe invalidDuration) <<< map Interval.toDuration <<< deserialize
-- | `interval`
instance Deserialize Hours where
deserialize = flip bind (liftMaybe invalidDuration) <<< map Interval.toDuration <<< deserialize
-- | `interval`
instance Deserialize Days where
deserialize = flip bind (liftMaybe invalidDuration) <<< map Interval.toDuration <<< deserialize
-- | `int2`, `int4`
instance Deserialize Int where
@@ -176,6 +249,10 @@ instance Deserialize DateTime where
let invalid = pure $ ForeignError $ "Not a valid ISO8601 string: `" <> s <> "`"
liftMaybe invalid $ DateTime.ISO.toDateTime $ wrap s
-- | `timestamp`, `timestamptz`
instance Deserialize Instant where
deserialize = map Instant.fromDateTime <<< deserialize
-- | postgres `array`
instance Deserialize a => Deserialize (Array a) where
deserialize = traverse (deserialize <<< Raw.unsafeFromForeign) <=< F.readArray <<< Raw.asForeign

View File

@@ -1,3 +1,5 @@
import QueryStream from 'pg-copy-streams'
/** @type {(c: import('pg').Client) => () => Promise<void>} */
export const __connect = c => () => c.connect()
@@ -6,3 +8,9 @@ export const __end = c => () => c.end()
/** @type {(q: import('pg').QueryConfig) => (c: import('pg').Client) => () => Promise<import('pg').QueryResult>} */
export const __query = q => c => () => c.query(q)
/** @type {(q: string) => (c: import('pg').Client) => () => import('stream').Readable} */
export const __execStreamStdout = q => c => () => c.query(QueryStream.to(q))
/** @type {(q: string) => (c: import('pg').Client) => () => import('stream').Writable} */
export const __execStreamStdin = q => c => () => c.query(QueryStream.from(q))

View File

@@ -1,4 +1,4 @@
module Effect.Aff.Postgres.Client (connected, connect, end, exec, query, queryRaw, __connect, __end, __query, module X) where
module Effect.Aff.Postgres.Client (connected, connect, end, exec, execWithStdin, queryWithStdout, query, queryRaw, __connect, __end, __query, __execStreamStdin, __execStreamStdout, module Reexport) where
import Prelude
@@ -6,14 +6,17 @@ import Control.Promise (Promise)
import Control.Promise as Promise
import Data.Functor (voidRight)
import Data.Maybe (fromMaybe)
import Data.Postgres (smash)
import Data.Postgres.Query (class AsQuery, QueryRaw, asQuery, __queryToRaw)
import Data.Newtype (wrap)
import Data.Postgres.Query (class AsQuery, QueryRaw, __queryToRaw, asQuery, stringQuery)
import Data.Postgres.Result (class FromRows, Result, fromRows, rows, rowsAffected)
import Effect (Effect)
import Effect.Aff (Aff)
import Effect.Class (liftEffect)
import Effect.Postgres.Client (Client, ClientConfigRaw, Config, Notification, NotificationRaw, __make, __uncfg, endE, errorE, make, noticeE, notificationE) as Reexport
import Effect.Postgres.Client (Client, Config, make)
import Effect.Postgres.Client (Client, ClientConfigRaw, Config, Notification, NotificationRaw, __make, __uncfg, endE, errorE, make, noticeE, notificationE) as X
import Effect.Postgres.Error as E
import Effect.Postgres.Error.Except as X
import Node.Stream (Readable, Writable)
import Prim.Row (class Union)
-- | Create a client and immediately connect it to the database
@@ -21,8 +24,8 @@ import Prim.Row (class Union)
-- | The config parameter `r` is `Config` with all keys optional.
-- |
-- | This is a shorthand for `(voidRight <*> connect) =<< liftEffect (make cfg)`
connected :: forall r missing trash. Union r missing (Config trash) => Record r -> Aff Client
connected cfg = (voidRight <*> connect) =<< liftEffect (make @r @missing @trash cfg)
connected :: forall r missing trash. Union r missing (Config trash) => Record r -> E.Except Aff Client
connected cfg = X.with E.Connecting $ (voidRight <*> connect) =<< liftEffect (make @r @missing @trash cfg)
-- | Connects the client to the database
-- |
@@ -33,30 +36,43 @@ connect = Promise.toAffE <<< __connect
-- | Disconnects the client from the database
-- |
-- | <https://node-postgres.com/apis/client#clientend>
end :: Client -> Aff Unit
end = Promise.toAffE <<< __end
end :: Client -> E.Except Aff Unit
end = X.with E.Disconnecting <<< Promise.toAffE <<< __end
-- | Performs a query, returning the raw `Result` object
-- |
-- | <https://node-postgres.com/apis/client#clientquery>
queryRaw :: forall q. AsQuery q => q -> Client -> Aff Result
queryRaw :: forall q. AsQuery q => q -> Client -> E.Except Aff Result
queryRaw q c = do
q' <- __queryToRaw <$> liftEffect (asQuery q)
Promise.toAffE $ __query q' c
q' <- X.printing $ asQuery q
let q'' = __queryToRaw q'
X.executing q' $ Promise.toAffE $ __query q'' c
-- | Performs a query that we expect to not yield any rows,
-- | returning the number of rows affected by the statement.
-- |
-- | <https://node-postgres.com/apis/client#clientquery>
exec :: forall q. AsQuery q => q -> Client -> Aff Int
exec :: forall q. AsQuery q => q -> Client -> E.Except Aff Int
exec q = map (fromMaybe 0 <<< rowsAffected) <<< queryRaw q
-- | Performs a query that we expect to yield rows,
-- | returning them unmarshalled into destination type `r`.
-- |
-- | <https://node-postgres.com/apis/client#clientquery>
query :: forall q r. AsQuery q => FromRows r => q -> Client -> Aff r
query q = (liftEffect <<< smash <<< fromRows) <=< map rows <<< queryRaw q
query :: forall q r. AsQuery q => FromRows r => q -> Client -> E.Except Aff r
query q c = do
q' <- X.printing $ asQuery q
raw <- queryRaw q c
let
affected = rowsAffected raw
rows' = rows raw
X.parsing q' $ fromRows (wrap $ fromMaybe 0 affected) rows'
execWithStdin :: String -> Client -> E.Except Effect (Writable ())
execWithStdin q c = X.executing (stringQuery q) $ __execStreamStdin q c
queryWithStdout :: String -> Client -> E.Except Effect (Readable ())
queryWithStdout q c = X.executing (stringQuery q) $ __execStreamStdout q c
-- | FFI binding to `Client#connect`
foreign import __connect :: Client -> Effect (Promise Unit)
@@ -66,3 +82,9 @@ foreign import __end :: Client -> Effect (Promise Unit)
-- | FFI binding to `Client#query`
foreign import __query :: QueryRaw -> Client -> Effect (Promise Result)
-- | FFI binding to `import('pg-copy-streams').to`
foreign import __execStreamStdout :: String -> Client -> Effect (Readable ())
-- | FFI binding to `import('pg-copy-streams').from`
foreign import __execStreamStdin :: String -> Client -> Effect (Writable ())

View File

@@ -7,8 +7,25 @@ import Control.Promise as Promise
import Effect (Effect)
import Effect.Aff (Aff)
import Effect.Postgres.Client (Client)
import Effect.Postgres.Error as E
import Effect.Postgres.Error.Except as E.Except
import Effect.Postgres.Pool (Pool)
import Effect.Postgres.Pool as X
import Effect.Postgres.Pool
(Config
, Pool
, PoolConfigRaw
, acquireE
, clientCount
, clientIdleCount
, clientWaitingCount
, connectE
, destroy
, errorE
, make
, release
, releaseE
, removeE
) as X
-- | Acquires a client from the pool.
-- |
@@ -17,8 +34,8 @@ import Effect.Postgres.Pool as X
-- | * If the pool is 'full' and all clients are currently checked out will wait in a FIFO queue until a client becomes available by it being released back to the pool.
-- |
-- | <https://node-postgres.com/apis/pool#poolconnect>
connect :: Pool -> Aff Client
connect = Promise.toAffE <<< __connect
connect :: Pool -> E.Except Aff Client
connect = E.Except.with E.Connecting <<< Promise.toAffE <<< __connect
-- | Drain the pool of all active clients, disconnect them,
-- | and shut down any internal timers in the pool.
@@ -27,8 +44,8 @@ connect = Promise.toAffE <<< __connect
-- | your process is attempting to shut down cleanly.
-- |
-- | <https://node-postgres.com/apis/pool#poolend>
end :: Pool -> Aff Unit
end = Promise.toAffE <<< __end
end :: Pool -> E.Except Aff Unit
end = E.Except.with E.Disconnecting <<< Promise.toAffE <<< __end
-- | FFI binding to `Pool#end`
foreign import __end :: Pool -> Effect (Promise Unit)

View File

@@ -0,0 +1,30 @@
module Effect.Postgres.Error.Common where
import Prelude
import Data.Array.NonEmpty (NonEmptyArray)
import Data.Generic.Rep (class Generic)
import Data.Postgres.Query (Query)
import Data.Show.Generic (genericShow)
import Effect.Exception as Effect
import Foreign (MultipleErrors)
type E = NonEmptyArray Error
data Error
= Deserializing Query MultipleErrors
| Serializing MultipleErrors
| Executing Query Effect.Error
| Connecting Effect.Error
| Disconnecting Effect.Error
| Other Effect.Error
derive instance Generic Error _
instance Show Error where
show = genericShow
toException' :: Error -> Effect.Error
toException' = Effect.error <<< show
toException :: E -> Effect.Error
toException = Effect.error <<< show

View File

@@ -0,0 +1,44 @@
module Effect.Postgres.Error.Except where
import Prelude
import Control.Monad.Error.Class (class MonadError, class MonadThrow, liftEither, try)
import Control.Monad.Except (ExceptT(..), runExceptT)
import Control.Monad.Morph (hoist)
import Data.Bifunctor (lmap)
import Data.Either (Either)
import Data.Postgres (RepT)
import Data.Postgres.Query (Query)
import Effect.Class (class MonadEffect, liftEffect)
import Effect.Exception as Effect
import Effect.Postgres.Error.Common (E, Error(..), toException)
type Except m = ExceptT E m
run :: forall m a. MonadThrow Effect.Error m => Except m a -> m a
run m = liftEither =<< lmap toException <$> runExceptT m
toEither :: forall m a. Except m a -> m (Either E a)
toEither = runExceptT
with :: forall e m a. MonadError e m => (e -> Error) -> m a -> Except m a
with e m = ExceptT $ map (lmap $ pure <<< e) $ try m
withEither :: forall e m a. Monad m => (e -> Error) -> m (Either e a) -> Except m a
withEither e m = ExceptT $ map (lmap $ pure <<< e) $ m
exception :: forall m a. MonadError Effect.Error m => m a -> Except m a
exception = with Other
executing :: forall m a. MonadError Effect.Error m => Query -> m a -> Except m a
executing q = with (Executing q)
parsing :: forall m a. MonadEffect m => Query -> RepT a -> Except m a
parsing q m = do
e <- hoist liftEffect $ exception $ runExceptT m
withEither (Deserializing q) (pure e)
printing :: forall m a. MonadEffect m => RepT a -> Except m a
printing m = do
e <- hoist liftEffect $ exception $ runExceptT m
withEither Serializing (pure e)

View File

@@ -0,0 +1,157 @@
module Effect.Postgres.Error.RE where
import Prelude hiding (join)
import Control.Alt (class Alt)
import Control.Alternative (class Alternative, class Plus)
import Control.Monad.Base (class MonadBase)
import Control.Monad.Error.Class (class MonadError, class MonadThrow, catchError, liftEither, liftMaybe, throwError)
import Control.Monad.Except (ExceptT, runExceptT)
import Control.Monad.Fork.Class (class MonadBracket, class MonadFork, class MonadKill, bracket, fork, join, kill, never, suspend, uninterruptible)
import Control.Monad.Fork.Class as Bracket
import Control.Monad.Morph (class MFunctor, class MMonad, embed, hoist)
import Control.Monad.Reader (class MonadAsk, class MonadReader, ReaderT(..), ask, runReaderT)
import Control.Monad.Rec.Class (class MonadRec)
import Control.Monad.Trans.Class (class MonadTrans, lift)
import Control.Monad.Unlift (class MonadUnlift)
import Control.Parallel (class Parallel, parallel, sequential)
import Data.Array.NonEmpty as Array.NonEmpty
import Data.Bifunctor (lmap)
import Data.Either (Either, blush, hush)
import Data.Functor.Compose (Compose(..))
import Data.Maybe (Maybe(..), fromMaybe)
import Data.Newtype (class Newtype, unwrap, wrap)
import Data.Traversable (for_, traverse_)
import Effect.Aff.Class (class MonadAff, liftAff)
import Effect.Aff.Unlift (class MonadUnliftAff, withRunInAff)
import Effect.Class (class MonadEffect, liftEffect)
import Effect.Exception as Effect
import Effect.Exception as Exception
import Effect.Postgres.Error.Common (E, Error(..), toException)
import Effect.Postgres.Error.Except (Except)
import Effect.Postgres.Error.Except as E
import Effect.Ref as Ref
import Effect.Unlift (class MonadUnliftEffect, withRunInEffect)
-- | `ReaderT` with `ExceptT E`
-- |
-- | `ReaderT r (ExceptT (NonEmptyList Effect.Postgres.Error.Error) m) a`
newtype RE r m a = RE (ReaderT r (ExceptT E m) a)
newtype ParRE r f a = ParRE (ReaderT r (Compose f (Either E)) a)
finally :: forall r m a. Monad m => RE r m Unit -> RE r m a -> RE r m a
finally after m = (m <* after) `catchError` \e -> after *> throwError e
run :: forall m r a. MonadThrow Effect.Error m => RE r m a -> r -> m a
run m r = liftEither =<< lmap toException <$> runExceptT (runReaderT (unwrap m) r)
toExcept :: forall m r a. RE r m a -> r -> Except m a
toExcept m r = runReaderT (unwrap m) r
toEither :: forall m r a. RE r m a -> r -> m (Either E a)
toEither m r = runExceptT $ runReaderT (unwrap m) r
liftExcept :: forall m r a. Monad m => Except m a -> RE r m a
liftExcept = wrap <<< lift
derive instance Newtype (ParRE r m a) _
derive newtype instance Functor m => Functor (ParRE r m)
derive newtype instance Apply m => Apply (ParRE r m)
derive newtype instance Applicative m => Applicative (ParRE r m)
derive newtype instance Alt m => Alt (ParRE r m)
derive newtype instance Plus m => Plus (ParRE r m)
derive newtype instance Alternative m => Alternative (ParRE r m)
derive instance Newtype (RE r m a) _
derive newtype instance Monad m => MonadAsk r (RE r m)
derive newtype instance Monad m => MonadReader r (RE r m)
derive newtype instance Monad m => Functor (RE r m)
derive newtype instance Monad m => Apply (RE r m)
derive newtype instance Monad m => Applicative (RE r m)
derive newtype instance Monad m => Bind (RE r m)
derive newtype instance Monad m => Monad (RE r m)
derive newtype instance Monad m => MonadError E (RE r m)
derive newtype instance Monad m => MonadThrow E (RE r m)
derive newtype instance MonadRec m => MonadRec (RE r m)
instance MonadEffect m => MonadEffect (RE r m) where
liftEffect m = hoist liftEffect $ liftExcept $ E.exception m
instance MonadAff m => MonadAff (RE r m) where
liftAff m = hoist liftAff $ liftExcept $ E.exception m
instance (Monad m, Parallel p m) => Parallel (ParRE r p) (RE r m) where
parallel = wrap <<< parallel <<< unwrap
sequential = wrap <<< sequential <<< unwrap
instance MonadTrans (RE r) where
lift = wrap <<< lift <<< lift
instance MFunctor (RE r) where
hoist mn (RE m) = RE $ hoist (hoist mn) m
instance MMonad (RE r) where
embed :: forall n m b. Monad n => (forall a. m a -> RE r n a) -> RE r m b -> RE r n b
embed mtn (RE m) =
RE $ ReaderT $ \r -> embed (flip runReaderT r <<< unwrap <<< mtn) (runReaderT m r)
instance Monad m => Alt (RE r m) where
alt a b = catchError b (\e -> catchError a (\e' -> throwError $ e <> e'))
instance (MonadThrow Effect.Error m, MonadUnliftEffect m) => MonadUnliftEffect (RE r m) where
withRunInEffect f = RE $ ReaderT $ \r -> lift $ withRunInEffect @m $ \a -> f (a <<< flip run r)
instance (MonadThrow Effect.Error m, MonadUnliftAff m) => MonadUnliftAff (RE r m) where
withRunInAff f = RE $ ReaderT $ \r -> lift $ withRunInAff @m $ \a -> f (a <<< flip run r)
instance (MonadBase m (RE r m), MonadThrow Effect.Error m) => MonadUnlift m (RE r m) where
withRunInBase f = RE $ ReaderT $ \r -> lift $ f (flip run r)
instance Monad m => MonadBase m (RE r m) where
liftBase = lift
instance (MonadThrow Effect.Error m, MonadFork f m) => MonadFork (Compose f (Either E)) (RE r m) where
fork m = RE $ ReaderT \r -> lift $ Compose <$> fork (toEither m r)
suspend m = RE $ ReaderT \r -> lift $ Compose <$> suspend (toEither m r)
join f = liftEither =<< lift (join $ unwrap f)
instance (MonadKill Effect.Error f m) => MonadKill E (Compose f (Either E)) (RE r m) where
kill e f = lift $ kill (toException e) (unwrap f)
instance (MonadEffect m, MonadBracket Effect.Error f m) => MonadBracket E (Compose f (Either E)) (RE r m) where
bracket acq rel go = do
r <- ask
errs <- liftEffect $ Ref.new []
let
eErrsEmpty = pure $ Other $ Exception.error "no errors"
appendErrs = liftEffect <<< flip Ref.modify_ errs <<< (<>) <<< Array.NonEmpty.toArray
readErrs = liftEffect $ Array.NonEmpty.fromArray <$> Ref.read errs
run' :: forall a. RE r m a -> m (Maybe a)
run' m = do
either <- toEither m r
traverse_ appendErrs $ blush either
pure $ hush either
rel' _ Nothing = pure unit
rel' (Bracket.Failed e) (Just a) = void $ run' $ rel (Bracket.Failed $ pure $ Other e) a
rel' (Bracket.Killed e) (Just a) = void $ run' $ rel (Bracket.Killed $ pure $ Other e) a
rel' (Bracket.Completed (Just ret)) (Just a) = void $ run' $ rel (Bracket.Completed ret) a
rel' (Bracket.Completed Nothing) (Just a) = void $ run' do
errs' <- fromMaybe eErrsEmpty <$> readErrs
rel (Bracket.Failed errs') a
acq' = run' acq
go' (Just a) = run' $ go a
go' Nothing = pure Nothing
ret <- lift $ bracket acq' rel' go'
errs' <- readErrs
for_ errs' throwError
liftMaybe eErrsEmpty ret
uninterruptible = hoist uninterruptible
never = lift never

View File

@@ -0,0 +1,5 @@
module Effect.Postgres.Error (module X) where
import Effect.Postgres.Error.Common as X
import Effect.Postgres.Error.RE (RE(..), ParRE(..)) as X
import Effect.Postgres.Error.Except (Except) as X

View File

@@ -9,6 +9,8 @@ import Effect (Effect)
import Effect.Exception (Error)
import Effect.Postgres.Client (Client)
import Effect.Postgres.Client as Client
import Effect.Postgres.Error as E
import Effect.Postgres.Error.Except as E.Except
import Effect.Uncurried (EffectFn2, mkEffectFn1, mkEffectFn2)
import Foreign (Foreign, unsafeToForeign)
import Node.EventEmitter (EventHandle(..))
@@ -46,12 +48,12 @@ make r = do
__make $ __uncfg { unwrapMillis: unwrap } $ unsafeToForeign asClientConfig
-- | <https://node-postgres.com/apis/pool#releasing-clients>
release :: Pool -> Client -> Effect Unit
release p c = __release p c false
release :: Pool -> Client -> E.Except Effect Unit
release p c = E.Except.with E.Disconnecting $ __release p c false
-- | <https://node-postgres.com/apis/pool#releasing-clients>
destroy :: Pool -> Client -> Effect Unit
destroy p c = __release p c true
destroy :: Pool -> Client -> E.Except Effect Unit
destroy p c = E.Except.with E.Disconnecting $ __release p c true
-- | <https://node-postgres.com/apis/pool#connect>
connectE :: EventHandle1 Pool Client

View File

@@ -0,0 +1,10 @@
module Node.FS.PinnedVersion where
import Prelude
import Effect.Aff (Aff)
import Node.Encoding (Encoding(..))
import Node.FS.Aff as FS
foo :: Aff Unit
foo = FS.writeTextFile UTF8 "foo" "foo"

29
src/Pipes.Postgres.purs Normal file
View File

@@ -0,0 +1,29 @@
module Pipes.Postgres where
import Prelude
import Control.Monad.Cont (lift)
import Control.Monad.Morph (hoist)
import Control.Monad.Postgres (SessionT)
import Control.Monad.Reader (ask)
import Data.Maybe (Maybe)
import Effect.Aff.Class (class MonadAff, liftAff)
import Effect.Aff.Postgres.Client as Client
import Effect.Class (liftEffect)
import Effect.Postgres.Error.RE as RE
import Node.Buffer (Buffer)
import Node.Stream.Object as Node.Stream.Object
import Pipes.Core (Consumer, Producer)
import Pipes.Node.Stream as Pipe.Node
stdin :: forall m. MonadAff m => String -> Consumer (Maybe Buffer) (SessionT m) Unit
stdin q = do
client <- lift ask
stream <- lift $ RE.liftExcept $ hoist liftEffect $ Client.execWithStdin q client
hoist liftAff $ Pipe.Node.fromWritable $ Node.Stream.Object.unsafeFromBufferWritable stream
stdout :: forall m. MonadAff m => String -> Producer (Maybe Buffer) (SessionT m) Unit
stdout q = do
client <- lift ask
stream <- lift $ RE.liftExcept $ hoist liftEffect $ Client.queryWithStdout q client
hoist liftAff $ Pipe.Node.fromReadable $ Node.Stream.Object.unsafeFromBufferReadable stream

View File

@@ -5,7 +5,7 @@ import Prelude
import Data.Either (Either(..))
import Data.String.Regex (Regex)
import Data.String.Regex as Regex
import Data.String.Regex.Flags (RegexFlags(..))
import Data.String.Regex.Flags (RegexFlags)
import Data.Tuple.Nested (type (/\), (/\))
import Effect (Effect)
import Effect.Aff (Aff, bracket, makeAff)
@@ -14,14 +14,13 @@ import Effect.Aff.Postgres.Client as Client
import Effect.Aff.Postgres.Pool (Pool)
import Effect.Aff.Postgres.Pool as Pool
import Effect.Class (liftEffect)
import Effect.Postgres.Error.Except as X
import Effect.Unsafe (unsafePerformEffect)
import Node.EventEmitter (EventHandle(..))
import Node.EventEmitter (EventHandle)
import Node.EventEmitter as EE
import Node.Path as Path
import Node.Process (cwd)
import Partial.Unsafe (unsafePartial)
import Record (insert)
import Type.Prelude (Proxy(..))
type Config =
{ database :: String
@@ -41,16 +40,16 @@ withConfig :: (Config -> Aff Unit) -> Aff Unit
withConfig f = f =<< liftEffect config
withClient :: (Client -> Aff Unit) -> Aff Unit
withClient = bracket (Client.connected =<< liftEffect config) Client.end
withClient = bracket (X.run $ Client.connected =<< liftEffect config) (X.run <<< Client.end)
pool :: Pool
pool = unsafePerformEffect $ Pool.make =<< liftEffect config
withPool :: (Pool -> Aff Unit) -> Aff Unit
withPool = bracket (liftEffect $ Pool.make =<< config) Pool.end
withPool = bracket (liftEffect $ Pool.make =<< config) (X.run <<< Pool.end)
withPoolClient :: (Client -> Aff Unit) -> Aff Unit
withPoolClient = bracket (Pool.connect pool) (liftEffect <<< Pool.release pool)
withPoolClient = bracket (X.run $ Pool.connect pool) (liftEffect <<< X.run <<< Pool.release pool)
unsafeFromRight :: forall a b. Either a b -> b
unsafeFromRight e = unsafePartial $ case e of Right b -> b

View File

@@ -2,23 +2,32 @@ module Test.Control.Monad.Postgres where
import Prelude
import Control.Monad.Error.Class (throwError)
import Control.Monad.Cont (lift)
import Control.Monad.Error.Class (catchError, throwError, try)
import Control.Monad.Fork.Class (class MonadBracket, bracket)
import Control.Monad.Postgres (PostgresT, exec_, query, runPostgres, session, transaction, cursor, fetch, fetchAll, fetchOne)
import Control.Parallel (parTraverse_)
import Control.Monad.Postgres (PostgresT, cursor, exec_, fetch, fetchAll, fetchOne, query, runPostgres, transaction)
import Control.Monad.Reader (ask)
import Control.Parallel (parTraverse)
import Data.Array as Array
import Data.Array.NonEmpty as Array.NonEmpty
import Data.Maybe (Maybe(..), fromJust, maybe)
import Data.String.Regex as Regex
import Data.String.Regex.Flags as Regex.Flag
import Data.Traversable (for_)
import Data.Tuple.Nested ((/\))
import Effect.Aff (Fiber)
import Effect.Aff.Class (class MonadAff)
import Effect.Aff.Class (class MonadAff, liftAff)
import Effect.Aff.Unlift (UnliftAff(..), askUnliftAff)
import Effect.Class (liftEffect)
import Effect.Console (log)
import Effect.Exception (Error, error)
import Effect.Postgres.Error as E
import Effect.Postgres.Error.Except as X
import Effect.Postgres.Error.RE as RE
import Partial.Unsafe (unsafePartial)
import Test.Common (re, withConfig)
import Test.Spec (Spec, around, describe, it)
import Test.Spec.Assertions (expectError, shouldEqual)
import Test.Spec.Assertions (shouldEqual)
withTable :: forall a m. MonadBracket Error Fiber m => MonadAff m => String -> PostgresT m a -> PostgresT m a
withTable s m =
@@ -30,30 +39,41 @@ withTable s m =
spec :: Spec Unit
spec =
around withConfig $ describe "Control.Monad.Postgres" do
it "empty works" \cfg -> runPostgres cfg $ pure unit
it "connects" \cfg -> runPostgres cfg $ shouldEqual 1 =<< query "select 1"
it "multiple sessions serially" \cfg -> runPostgres cfg do
shouldEqual 1 =<< query "select 1"
shouldEqual 2 =<< query "select 2"
it "multiple sessions concurrently" \cfg -> runPostgres cfg do
flip parTraverse_ [ 1, 2, 3 ] \_ -> shouldEqual 1 =<< query "select 1"
it "transaction commits" \cfg -> runPostgres cfg do
exec_ "create temporary table test_txn_commits (id int);"
transaction $ exec_ "insert into test_txn_commits values (1);"
shouldEqual [ 1 ] =<< query "select * from test_txn_commits"
it "transaction rolls back" \cfg -> runPostgres cfg do
exec_ "create temporary table test_txn_rolls_back (id int);"
exec_ "insert into test_txn_rolls_back values (1);"
expectError $ transaction do
exec_ "insert into test_txn_rolls_back values (2);"
throwError $ error "foo"
shouldEqual [ 1 ] =<< query "select * from test_txn_rolls_back"
it "cursor" \cfg -> runPostgres cfg do
exec_ $ "create temporary table test_cursor_data (id int primary key generated always as identity)"
for_ (Array.range 1 50) $ const $ exec_ "insert into test_cursor_data (id) values (default);"
cursor @Int "test_cursor" "select id from test_cursor_data" do
shouldEqual (Just 1) =<< fetchOne
shouldEqual (Just 2) =<< fetchOne
shouldEqual (Just 3) =<< fetchOne
shouldEqual [ 4, 5, 6, 7, 8 ] =<< fetch 5
shouldEqual (Array.range 9 50) =<< fetchAll
it "empty works" \cfg -> X.run $ runPostgres cfg $ pure unit
it "connects" \cfg -> shouldEqual 1 =<< X.run (runPostgres cfg $ query "select 1")
it "multiple sessions serially" \cfg -> do
a /\ b <- X.run $ runPostgres cfg do
a <- query "select 1"
b <- query "select 2"
pure $ a /\ b
a `shouldEqual` 1
b `shouldEqual` 2
it "multiple sessions concurrently" \cfg -> do
nums <- X.run $ runPostgres cfg $ parTraverse (\n -> query $ "select $1 :: int" /\ n) (Array.range 1 3)
Array.sort nums `shouldEqual` [1, 2, 3]
it "transaction commits" \cfg -> do
a <- X.run $ runPostgres cfg do
exec_ "create temporary table test_txn_commits (id int);"
transaction $ exec_ "insert into test_txn_commits values (1);"
query "select * from test_txn_commits"
a `shouldEqual` [ 1 ]
it "transaction rolls back" \cfg -> do
a <- X.run $ runPostgres cfg do
exec_ "create temporary table test_txn_rolls_back (id int);"
exec_ "insert into test_txn_rolls_back values (1);"
void $ try $ transaction do
exec_ "insert into test_txn_rolls_back values (2);"
throwError $ pure $ E.Other $ error "foo"
query "select * from test_txn_rolls_back"
a `shouldEqual` [1]
it "cursor" \cfg ->
X.run $ runPostgres cfg do
exec_ $ "create temporary table test_cursor_data (id int primary key generated always as identity)"
for_ (Array.range 1 50) $ const $ exec_ "insert into test_cursor_data (id) values (default);"
cursor @Int "test_cursor" "select id from test_cursor_data" do
UnliftAff unliftAff <- askUnliftAff
liftAff $ shouldEqual (Just 1) =<< unliftAff fetchOne
liftAff $ shouldEqual (Just 2) =<< unliftAff fetchOne
liftAff $ shouldEqual (Just 3) =<< unliftAff fetchOne
liftAff $ shouldEqual [ 4, 5, 6, 7, 8 ] =<< unliftAff (fetch 5)
liftAff $ shouldEqual (Array.range 9 50) =<< unliftAff fetchAll

View File

@@ -10,7 +10,7 @@ import Data.Generic.Rep (class Generic)
import Data.Maybe (Maybe(..))
import Data.Newtype (unwrap)
import Data.Postgres (class Deserialize, class Serialize, deserialize, serialize, smash)
import Data.Postgres.Custom.Enum (class CustomEnum, create, enumDeserialize, enumPrintExpr, enumSerialize, genericEnumVariants, genericParseEnum, genericPrintEnum, parseEnum, printEnum)
import Data.Postgres.Custom.Enum (class CustomEnum, create, defaultDeserializeEnum, defaultSerializeEnum, enumPrintExpr, genericEnumVariants, genericParseEnum, genericPrintEnum, parseEnum, printEnum)
import Data.Show.Generic (genericShow)
import Effect.Class (liftEffect)
import Test.Spec (Spec, describe, it)
@@ -25,10 +25,10 @@ instance Show Enum1 where
show = genericShow
instance Serialize Enum1 where
serialize a = enumSerialize a
serialize a = defaultSerializeEnum a
instance Deserialize Enum1 where
deserialize a = enumDeserialize a
deserialize a = defaultDeserializeEnum a
instance CustomEnum Enum1 "enum_1" where
printEnum = genericPrintEnum
@@ -43,10 +43,10 @@ instance Show Enum2 where
show = genericShow
instance Serialize Enum2 where
serialize a = enumSerialize a
serialize a = defaultSerializeEnum a
instance Deserialize Enum2 where
deserialize a = enumDeserialize a
deserialize a = defaultDeserializeEnum a
instance CustomEnum Enum2 "enum_2" where
printEnum a = genericPrintEnum a
@@ -61,10 +61,10 @@ instance Show Enum5 where
show = genericShow
instance Serialize Enum5 where
serialize a = enumSerialize a
serialize a = defaultSerializeEnum a
instance Deserialize Enum5 where
deserialize a = enumDeserialize a
deserialize a = defaultDeserializeEnum a
instance CustomEnum Enum5 "enum_5" where
printEnum a = genericPrintEnum a

View File

@@ -0,0 +1,37 @@
module Test.Data.Postgres.Interval where
import Prelude
import Data.Postgres.Interval as Interval
import Data.Time.Duration (Milliseconds(..))
import Data.Traversable (for_)
import Data.Tuple.Nested (type (/\), (/\))
import Effect.Class (liftEffect)
import Test.Spec (Spec, describe, it)
import Test.Spec.Assertions (shouldEqual)
spec :: Spec Unit
spec =
describe "Data.Postgres.Interval" do
it "parse & toRecord" do
p <- liftEffect $ Interval.parse "3 days 04:05:06"
Interval.toRecord p `shouldEqual` Interval.zero {days = 3, hours = 4, minutes = 5, seconds = 6}
it "make & toRecord" do
let p = Interval.make $ Interval.zero {days = 3, hours = 4, minutes = 5, seconds = 6}
Interval.toRecord p `shouldEqual` Interval.zero {days = 3, hours = 4, minutes = 5, seconds = 6}
describe "fromDuration" do
for_
[ Milliseconds 100.0 /\ Interval.zero {milliseconds = 100.0}
, Milliseconds 1000.0 /\ Interval.zero {seconds = 1}
, Milliseconds 1100.0 /\ Interval.zero {seconds = 1, milliseconds = 100.0}
, Milliseconds 60000.0 /\ Interval.zero {minutes = 1}
, Milliseconds 61100.0 /\ Interval.zero {minutes = 1, seconds = 1, milliseconds = 100.0}
, Milliseconds 3600000.0 /\ Interval.zero {hours = 1}
, Milliseconds 3661100.0 /\ Interval.zero {hours = 1, minutes = 1, seconds = 1, milliseconds = 100.0}
, Milliseconds 86400000.0 /\ Interval.zero {days = 1}
, Milliseconds 90061100.0 /\ Interval.zero {days = 1, hours = 1, minutes = 1, seconds = 1, milliseconds = 100.0}
]
\(i /\ o) -> it ("converts " <> show i) do
Interval.toRecord (Interval.fromDuration i) `shouldEqual` o

View File

@@ -2,28 +2,28 @@ module Test.Data.Postgres where
import Prelude
import Control.Monad.Gen (chooseInt, elements, oneOf)
import Control.Monad.Gen (chooseFloat, chooseInt, elements, oneOf)
import Control.Parallel (parTraverse_)
import Data.Array (intercalate)
import Data.Array as Array
import Data.Array.NonEmpty as Array.NonEmpty
import Data.DateTime (DateTime(..), canonicalDate)
import Data.DateTime.Instant as Instant
import Data.Enum (toEnum)
import Data.Foldable (fold)
import Data.Identity (Identity)
import Data.Int as Int
import Data.Maybe (Maybe(..), fromJust, maybe)
import Data.Maybe (Maybe(..), fromJust, fromMaybe)
import Data.Newtype (class Newtype, unwrap, wrap)
import Data.Number (abs) as Number
import Data.Postgres (class Rep)
import Data.Postgres.Interval (Interval)
import Data.Postgres.Interval as Interval
import Data.Postgres.Query.Builder as Q
import Data.Postgres.Raw (Raw, jsNull)
import Data.Postgres.Raw as Raw
import Data.Postgres.Result (class FromRow)
import Data.RFC3339String as DateTime.ISO
import Data.String as String
import Data.Time (Time(..))
import Data.Time.Duration (class Duration, Days, Hours, Milliseconds, Minutes, Seconds)
import Data.Traversable (for, sequence)
import Data.Tuple.Nested ((/\))
import Effect (Effect)
@@ -31,24 +31,50 @@ import Effect.Aff (Aff)
import Effect.Aff.Postgres.Client (exec, query)
import Effect.Class (liftEffect)
import Effect.Postgres.Client (Client)
import Effect.Postgres.Error.Except as X
import Effect.Unsafe (unsafePerformEffect)
import Foreign (Foreign, unsafeToForeign)
import Foreign.Object as Object
import JS.BigInt (BigInt)
import JS.BigInt as BigInt
import Node.Buffer (Buffer)
import Node.Buffer as Buffer
import Partial.Unsafe (unsafePartial)
import Simple.JSON (writeJSON)
import Test.Common (withClient, withPoolClient)
import Test.Common (withPoolClient)
import Test.QuickCheck (class Arbitrary, arbitrary, randomSeed)
import Test.QuickCheck.Gen (sample, vectorOf)
import Test.Spec (Spec, SpecT, around, describe, it, parallel)
import Test.Spec (Spec, SpecT, around, describe, it)
import Test.Spec.Assertions (fail)
foreign import readBigInt64BE :: Buffer -> Effect BigInt
foreign import dbg :: forall a. a -> Effect Unit
newtype GenIntervalSubMonth = GenIntervalSubMonth Interval
derive instance Newtype GenIntervalSubMonth _
instance Arbitrary GenIntervalSubMonth where
arbitrary = do
days <- chooseInt 0 30
hours <- chooseInt 0 23
minutes <- chooseInt 0 59
seconds <- chooseInt 0 59
milliseconds <- chooseFloat 0.0 999.9
pure $ wrap $ Interval.make $ Interval.zero {days = days, hours = hours, minutes = minutes, seconds = seconds, milliseconds = milliseconds}
newtype GenInterval = GenInterval Interval
derive instance Newtype GenInterval _
instance Arbitrary GenInterval where
arbitrary = do
years <- chooseInt 0 10
months <- chooseInt 0 11
days <- chooseInt 0 30
hours <- chooseInt 0 23
minutes <- chooseInt 0 59
seconds <- chooseInt 0 59
milliseconds <- chooseFloat 0.0 999.9
pure $ wrap $ Interval.make {years, months, days, hours, minutes, seconds, milliseconds}
newtype GenSmallInt = GenSmallInt Int
derive instance Newtype GenSmallInt _
@@ -181,13 +207,13 @@ spec =
x' <- Q.param $ fromArb x
let val = x' <> " :: " <> sql
pure $ "select " <> val
void $ exec createtab c
void $ X.run $ exec createtab c
seed <- liftEffect randomSeed
let xs = sample seed 10 (arbitrary @x)
flip parTraverse_ xs
\x -> do
void $ exec (ser x) c
res <- query (de x) c
void $ X.run $ exec (ser x) c
res <- X.run $ query (de x) c
let
exp = fromArb x
act = unsafePartial fromJust $ Array.head res
@@ -196,6 +222,17 @@ spec =
around withPoolClient
$ describe "Data.Postgres"
$ do
let
durationFromGenInterval :: forall d. Semigroup d => Duration d => Newtype d Number => GenIntervalSubMonth -> d
durationFromGenInterval = fromMaybe (wrap 0.0) <<< Interval.toDuration <<< unwrap
durationEq :: forall d. Duration d => Newtype d Number => d -> d -> Boolean
durationEq a b = Number.abs (unwrap a - unwrap b) <= 0.001
check @Milliseconds @GenIntervalSubMonth { purs: "Milliseconds", sql: "interval", fromArb: durationFromGenInterval, isEq: durationEq}
check @Seconds @GenIntervalSubMonth { purs: "Seconds", sql: "interval", fromArb: durationFromGenInterval, isEq: durationEq}
check @Minutes @GenIntervalSubMonth { purs: "Minutes", sql: "interval", fromArb: durationFromGenInterval, isEq: durationEq}
check @Hours @GenIntervalSubMonth { purs: "Hours", sql: "interval", fromArb: durationFromGenInterval, isEq: durationEq}
check @Days @GenIntervalSubMonth { purs: "Days", sql: "interval", fromArb: durationFromGenInterval, isEq: durationEq}
check @Int @GenSmallInt { purs: "Int", sql: "int2", fromArb: unwrap, isEq: eq }
check @Int { purs: "Int", sql: "int4", fromArb: identity, isEq: eq }
check @String @GenString { purs: "String", sql: "text", fromArb: unwrap, isEq: eq }

View File

@@ -12,6 +12,7 @@ import Effect.Aff (forkAff, joinFiber)
import Effect.Aff.Postgres.Client (query)
import Effect.Aff.Postgres.Client as Client
import Effect.Exception as Error
import Effect.Postgres.Error.Except as X
import Test.Common (onceAff, withClient)
import Test.Spec (Spec, around, describe, it)
import Test.Spec.Assertions (shouldEqual)
@@ -23,40 +24,40 @@ spec =
describe "events" do
it "end" \c -> do
expect <- forkAff $ onceAff Client.endE c
Client.end c
X.run $ Client.end c
joinFiber expect
it "notice" \c -> do
expect <- forkAff do
e <- onceAff Client.noticeE c
Error.message e `shouldEqual` "hello"
void $ Client.exec "do language plpgsql $$ begin raise notice 'hello'; end; $$;" c
X.run $ void $ Client.exec "do language plpgsql $$ begin raise notice 'hello'; end; $$;" c
joinFiber expect
it "notification" \c -> do
void $ Client.exec "listen hello;" c
X.run $ void $ Client.exec "listen hello;" c
expect <- forkAff do
n <- onceAff Client.notificationE c
n.payload `shouldEqual` (Just "world")
void $ Client.exec "notify hello, 'world';" c
X.run $ void $ Client.exec "notify hello, 'world';" c
joinFiber expect
it "connect & end do not throw" $ const $ pure unit
describe "query" do
it "ok if connected" \c -> shouldEqual [ 1, 2, 3 ] =<< query "select unnest(array[1, 2, 3])" c
it "ok if connected" \c -> shouldEqual [ 1, 2, 3 ] =<< X.run (query "select unnest(array[1, 2, 3])" c)
it "throws if ended" \c -> do
Client.end c
res :: Either _ (Array Int) <- try $ query "select 1" c
X.run $ Client.end c
res :: Either _ (Array Int) <- try $ X.run $ query "select 1" c
isLeft res `shouldEqual` true
it "rowsAffected is correct" \c -> do
void $ Client.exec "create temp table foo (bar int);" c
shouldEqual 1 =<< Client.exec "insert into foo values (1);" c
shouldEqual 3 =<< Client.exec "insert into foo values (1), (2), (3);" c
shouldEqual 4 =<< Client.exec "update foo set bar = 10;" c
X.run $ void $ Client.exec "create temp table foo (bar int);" c
shouldEqual 1 =<< X.run (Client.exec "insert into foo values (1);" c)
shouldEqual 3 =<< X.run (Client.exec "insert into foo values (1), (2), (3);" c)
shouldEqual 4 =<< X.run (Client.exec "update foo set bar = 10;" c)
describe "timestamp" do
it "unmarshals" \c -> do
let exp = toDateTimeLossy <$> fromRFC3339String (wrap "2020-01-01T00:00:00Z")
shouldEqual exp =<< query "select '2020-01-01T00:00:00Z' :: timestamptz" c
it "is string" \c -> shouldEqual "2020-01-01 00:00:00+00" =<< query "select '2020-01-01T00:00:00Z' :: timestamptz" c
it "array is string" \c -> shouldEqual [ [ "2020-01-01 00:00:00+00" ] ] =<< query "select array['2020-01-01T00:00:00Z' :: timestamptz]" c
shouldEqual exp =<< X.run (query "select '2020-01-01T00:00:00Z' :: timestamptz" c)
it "is string" \c -> shouldEqual "2020-01-01 00:00:00+00" =<< X.run (query "select '2020-01-01T00:00:00Z' :: timestamptz" c)
it "array is string" \c -> shouldEqual [ [ "2020-01-01 00:00:00+00" ] ] =<< X.run (query "select array['2020-01-01T00:00:00Z' :: timestamptz]" c)
describe "json" do
it "unmarshals" \c -> shouldEqual (JSON { foo: "bar" }) =<< query "select '{\"foo\": \"bar\"}' :: json" c
it "is string" \c -> shouldEqual "{\"foo\": \"bar\"}" =<< query "select '{\"foo\": \"bar\"}' :: json" c
it "array is string" \c -> shouldEqual [ [ "{\"foo\": \"bar\"}" ] ] =<< query "select array['{\"foo\": \"bar\"}' :: json]" c
it "unmarshals" \c -> shouldEqual (JSON { foo: "bar" }) =<< X.run (query "select '{\"foo\": \"bar\"}' :: json" c)
it "is string" \c -> shouldEqual "{\"foo\": \"bar\"}" =<< X.run (query "select '{\"foo\": \"bar\"}' :: json" c)
it "array is string" \c -> shouldEqual [ [ "{\"foo\": \"bar\"}" ] ] =<< X.run (query "select array['{\"foo\": \"bar\"}' :: json]" c)

View File

@@ -0,0 +1,135 @@
module Test.Effect.Postgres.Error where
import Prelude hiding (join)
import Control.Monad.Cont (lift)
import Control.Monad.Error.Class (throwError)
import Control.Monad.Fork.Class (bracket, fork, join)
import Control.Parallel (parOneOf, parSequence)
import Data.Either (isLeft)
import Data.Newtype (wrap)
import Data.Postgres (deserialize)
import Data.Postgres.Query (stringQuery)
import Data.Postgres.Raw (Raw)
import Effect.Aff (Aff, delay)
import Effect.Aff.Class (liftAff)
import Effect.Class (liftEffect)
import Effect.Exception as Exn
import Effect.Postgres.Error (Error(..))
import Effect.Postgres.Error.Except as E
import Effect.Postgres.Error.RE (RE)
import Effect.Postgres.Error.RE as RE
import Test.Common (withPoolClient)
import Test.Spec (Spec, around, describe, it)
import Test.Spec.Assertions (shouldEqual)
import Unsafe.Coerce (unsafeCoerce)
spec :: Spec Unit
spec =
around withPoolClient $ describe "Effect.Postgres.Error" do
describe "Except" do
it "catches Aff" $ const do
either <- E.toEither $ E.exception (throwError $ Exn.error "foo")
isLeft either `shouldEqual` true
it "catches Effect" $ const do
either <- liftEffect $ E.toEither $ E.exception (throwError $ Exn.error "foo")
isLeft either `shouldEqual` true
it "catches RepT" $ const do
let
parse = deserialize @Int (unsafeCoerce "foo" :: Raw)
either <- liftEffect $ E.toEither $ E.parsing (stringQuery "select 'foo'") parse
isLeft either `shouldEqual` true
it "catches Effect exception in RepT" $ const do
let
parse = lift $ throwError $ Exn.error "foo"
either <- liftEffect $ E.toEither $ E.parsing (stringQuery "select 'foo'") parse
isLeft either `shouldEqual` true
describe "RE" do
it "liftAff catches exceptions" $ const do
either <- RE.toEither (liftAff $ throwError $ Exn.error "foo") unit
isLeft either `shouldEqual` true
it "liftEffect catches exceptions" $ const do
either <- RE.toEither (liftEffect $ throwError $ Exn.error "foo") unit
isLeft either `shouldEqual` true
it "liftExcept catches exceptions" $ const do
either <- RE.toEither (throwError $ pure $ Other $ Exn.error "foo") unit
isLeft either `shouldEqual` true
it "fork > join catches Fiber exceptions" $ const do
either <- flip RE.toEither unit do
fiber <- fork (liftAff $ throwError $ Exn.error "foo") :: RE Unit Aff _
liftAff $ delay $ wrap 1.0
join fiber
isLeft either `shouldEqual` true
it "bracket catches error in acq" $ const do
either <-
flip RE.toEither unit
$ bracket
(liftAff $ throwError $ Exn.error "foo")
(const $ const $ pure unit)
(const $ pure unit)
isLeft either `shouldEqual` true
it "bracket catches error in rel" $ const do
either <-
flip RE.toEither unit
$ bracket
(pure unit)
(const $ const $ liftAff $ throwError $ Exn.error "foo")
(const $ pure unit)
isLeft either `shouldEqual` true
it "bracket catches error in go" $ const do
either <-
flip RE.toEither unit
$ bracket
(pure unit)
(const $ const $ pure unit)
(const $ liftAff $ throwError $ Exn.error "foo")
isLeft either `shouldEqual` true
it "forked bracket catches error in acq" $ const do
either <- flip RE.toEither unit do
fiber <-
fork
$ bracket
(liftAff $ throwError $ Exn.error "foo")
(const $ const $ pure unit)
(const $ pure unit)
liftAff $ delay $ wrap 1.0
join fiber
isLeft either `shouldEqual` true
it "forked bracket catches error in rel" $ const do
either <- flip RE.toEither unit do
fiber <-
fork
$ bracket
(pure unit)
(const $ const $ liftAff $ throwError $ Exn.error "foo")
(const $ pure unit)
liftAff $ delay $ wrap 1.0
join fiber
isLeft either `shouldEqual` true
it "forked bracket catches error in go" $ const do
either <- flip RE.toEither unit do
fiber <-
fork
$ bracket
(pure unit)
(const $ const $ pure unit)
(const $ liftAff $ throwError $ Exn.error "foo")
liftAff $ delay $ wrap 1.0
join fiber
isLeft either `shouldEqual` true
it "catches errors in `parSequence`" $ const do
either <-
flip RE.toEither unit
$ parSequence
$ [ liftAff $ throwError $ Exn.error "a"
, pure "a"
]
isLeft either `shouldEqual` true
it "catches errors in `parOneOf`" $ const do
either <-
flip RE.toEither unit
$ parOneOf
$ [ liftAff $ throwError $ Exn.error "a"
, liftAff $ throwError $ Exn.error "b"
]
isLeft either `shouldEqual` true

View File

@@ -7,6 +7,7 @@ import Effect.Aff (finally, forkAff, joinFiber)
import Effect.Aff.Postgres.Client as Client
import Effect.Aff.Postgres.Pool as Pool
import Effect.Class (liftEffect)
import Effect.Postgres.Error.Except as X
import Test.Common (config, onceAff, withPool)
import Test.Spec (Spec, around, describe, it)
import Test.Spec.Assertions (expectError, shouldEqual)
@@ -20,78 +21,78 @@ spec = describe "Pool" do
void $ liftEffect $ Pool.make cfg
around withPool do
it "idleCount, totalCount" \p -> do
a <- Pool.connect p
b <- Pool.connect p
c <- Pool.connect p
liftEffect $ Pool.release p a
liftEffect $ Pool.release p b
finally (liftEffect $ Pool.release p c) do
a <- X.run $ Pool.connect p
b <- X.run $ Pool.connect p
c <- X.run $ Pool.connect p
liftEffect $ X.run $ Pool.release p a
liftEffect $ X.run $ Pool.release p b
finally (liftEffect $ X.run $ Pool.release p c) do
Pool.clientIdleCount p `shouldEqual` 2
Pool.clientCount p `shouldEqual` 3
Pool.clientIdleCount p `shouldEqual` 3
Pool.clientCount p `shouldEqual` 3
it "waitingCount" \p -> do
a <- Pool.connect p
b <- Pool.connect p
c <- Pool.connect p
dFiber <- forkAff $ Pool.connect p
a <- X.run $ Pool.connect p
b <- X.run $ Pool.connect p
c <- X.run $ Pool.connect p
dFiber <- forkAff $ X.run $ Pool.connect p
let
rel =
do
void $ liftEffect $ traverse (Pool.release p) [ a, b, c ]
void $ liftEffect $ X.run $ traverse (Pool.release p) [ a, b, c ]
d <- joinFiber dFiber
liftEffect $ Pool.release p d
liftEffect $ X.run $ Pool.release p d
finally rel $ Pool.clientWaitingCount p `shouldEqual` 1
describe "events" do
it "connect" \p -> do
expect <- forkAff $ void $ onceAff Pool.connectE p
c <- Pool.connect p
finally (liftEffect $ Pool.release p c) $ joinFiber expect
c <- X.run $ Pool.connect p
finally (liftEffect $ X.run $ Pool.release p c) $ joinFiber expect
it "acquire" \p -> do
c <- Pool.connect p
liftEffect $ Pool.release p c
c <- X.run$ Pool.connect p
liftEffect $ X.run$ Pool.release p c
expect <- forkAff do
c'' <- onceAff Pool.acquireE p
refEq c c'' `shouldEqual` true
c' <- Pool.connect p
finally (liftEffect $ Pool.release p c') $ joinFiber expect
c' <- X.run $ Pool.connect p
finally (liftEffect $ X.run$ Pool.release p c') $ joinFiber expect
it "release" \p -> do
c <- Pool.connect p
c <- X.run $ Pool.connect p
expect <- forkAff do
c' <- onceAff Pool.releaseE p
refEq c c' `shouldEqual` true
liftEffect $ Pool.release p c
liftEffect $ X.run $ Pool.release p c
joinFiber expect
it "remove" \p -> do
c <- Pool.connect p
c <- X.run $ Pool.connect p
expect <- forkAff do
c' <- onceAff Pool.removeE p
refEq c c' `shouldEqual` true
liftEffect $ Pool.destroy p c
liftEffect $ X.run $ Pool.destroy p c
joinFiber expect
it "connect" \p -> do
c <- Pool.connect p
let rel = liftEffect $ Pool.release p c
finally rel $ shouldEqual 1 =<< Client.query "select 1" c
c <- X.run $ Pool.connect p
let rel = liftEffect $ X.run $ Pool.release p c
finally rel $ shouldEqual 1 =<< X.run (Client.query "select 1" c)
describe "destroy" do
it "throws on query after destroy" \p -> do
c <- Pool.connect p
liftEffect $ Pool.destroy p c
expectError $ Client.exec "select 1" c
c <- X.run $ Pool.connect p
liftEffect $ X.run $ Pool.destroy p c
expectError $ X.run $ Client.exec "select 1" c
it "different client yielded after destroy" \p -> do
a <- Pool.connect p
liftEffect $ Pool.destroy p a
b <- Pool.connect p
liftEffect $ Pool.destroy p b
a <- X.run $ Pool.connect p
liftEffect $ X.run $ Pool.destroy p a
b <- X.run $ Pool.connect p
liftEffect $ X.run $ Pool.destroy p b
refEq a b `shouldEqual` false
describe "release" do
it "allows reuse" \p -> do
a <- Pool.connect p
liftEffect $ Pool.release p a
b <- Pool.connect p
liftEffect $ Pool.release p b
a <- X.run $ Pool.connect p
liftEffect $ X.run $ Pool.release p a
b <- X.run $ Pool.connect p
liftEffect $ X.run $ Pool.release p b
refEq a b `shouldEqual` true
it "throws when invoked twice" \p -> do
c <- Pool.connect p
liftEffect $ Pool.release p c
expectError $ liftEffect $ Pool.release p c
c <- X.run $ Pool.connect p
liftEffect $ X.run $ Pool.release p c
expectError $ liftEffect $ X.run $ Pool.release p c

View File

@@ -23,7 +23,9 @@ import Node.EventEmitter as Event
import Test.Control.Monad.Postgres as Test.Control.Monad.Postgres
import Test.Data.Postgres as Test.Data.Postgres
import Test.Data.Postgres.Custom as Test.Data.Postgres.Custom
import Test.Data.Postgres.Interval as Test.Data.Postgres.Interval
import Test.Effect.Postgres.Client as Test.Effect.Postgres.Client
import Test.Effect.Postgres.Error as Test.Effect.Postgres.Error
import Test.Effect.Postgres.Pool as Test.Effect.Postgres.Pool
import Test.Spec.Reporter (specReporter)
import Test.Spec.Runner (runSpec)
@@ -63,8 +65,10 @@ main = launchAff_ do
bracket spawnDb killDb
$ const
$ runSpec [ specReporter ] do
Test.Effect.Postgres.Error.spec
Test.Data.Postgres.Custom.spec
Test.Data.Postgres.spec
Test.Data.Postgres.Interval.spec
Test.Effect.Postgres.Client.spec
Test.Effect.Postgres.Pool.spec
Test.Control.Monad.Postgres.spec