feat: pool, docs

spago.lock

@@ -24,6 +24,7 @@ workspace:
         - nullable
         - precise-datetime
         - prelude
+        - profunctor
         - record
         - simple-json
         - transformers

spago.yaml

@@ -1,6 +1,8 @@
 package:
   name: pg
   build:
+    censorProjectWarnings:
+      - 'ImplicitQualifiedImportReExport'
     strict: true
     pedanticPackages: true
   dependencies:
@@ -25,6 +27,7 @@ package:
     - nullable
     - precise-datetime
     - prelude
+    - profunctor
     - record
     - simple-json
     - transformers

src/Control.Monad.Postgres.purs

@@ -0,0 +1 @@
+module Control.Monad.Postgres where

src/Data.Postgres.Query.purs

@@ -11,9 +11,6 @@ import Effect (Effect)
 import Record (insert, modify)
 import Type.Prelude (Proxy(..))
 
--- | FFI Query type
-type QueryRaw = { text :: String, values :: Array Raw, name :: Nullable String, rowMode :: String }
-
 -- | SQL Query
 -- |
 -- | * `text` - the query string
@@ -22,27 +19,18 @@ type QueryRaw = { text :: String, values :: Array Raw, name :: Nullable String,
 newtype Query = Query { text :: String, values :: Array Raw, name :: Maybe String }
 
 derive instance Newtype Query _
-derive newtype instance Eq Query
 derive newtype instance Show Query
 
 -- | An empty query
 emptyQuery :: Query
 emptyQuery = Query { text: "", values: [], name: Nothing }
 
-queryToRaw :: Query -> QueryRaw
-queryToRaw (Query r) =
-  let
-    name = Proxy @"name"
-    rowMode = Proxy @"rowMode"
-  in
-    insert rowMode "array" $ modify name toNullable $ r
-
 -- | Values that can be rendered as a SQL query
 class AsQuery a where
   asQuery :: a -> Effect Query
 
 instance AsQuery a => AsQuery (Effect a) where
-  asQuery = flip bind asQuery
+  asQuery a = asQuery =<< a
 
 instance AsQuery Query where
   asQuery = pure
@@ -52,3 +40,16 @@ instance AsQuery String where
 
 instance AsQuery (String /\ Array Raw) where
   asQuery (text /\ values) = pure $ Query { text, values, name: Nothing }
+
+-- | FFI
+type QueryRaw = { text :: String, values :: Array Raw, name :: Nullable String, rowMode :: String }
+
+-- | FFI
+__queryToRaw :: Query -> QueryRaw
+__queryToRaw (Query r) =
+  let
+    name = Proxy @"name"
+    rowMode = Proxy @"rowMode"
+  in
+    insert rowMode "array" $ modify name toNullable $ r
+

src/Data.Postgres.Range.js

@@ -6,7 +6,7 @@ import * as Range from 'postgres-range'
  */
 
 /** @type {<T>(_: Range.Range<T>) => RangeRawRecord<T>} */
-export const rangeRawToRecord = r => {
+export const __rangeRawToRecord = r => {
   if (r.hasMask(Range.RANGE_EMPTY)) {
     return {
       upper: undefined,
@@ -27,7 +27,7 @@ export const rangeRawToRecord = r => {
 }
 
 /** @type {<T>(_: RangeRawRecord<T>) => Range.Range<T>} */
-export const rangeRawFromRecord = r => {
+export const __rangeRawFromRecord = r => {
   const upper = r.upper === undefined ? null : r.upper
   const lower = r.lower === undefined ? null : r.lower
   if (upper === null && lower === null) {
@@ -52,17 +52,17 @@ export const rangeRawFromRecord = r => {
 }
 
 /** @type {<T>(r: Range.Range<T>) => () => string} */
-export const rangeRawSerialize = r => () => {
+export const __rangeRawSerialize = r => () => {
   return Range.serialize(r)
 }
 
 /** @type {<T>(r: string) => (f: (s: string) => () => T) => () => Range.Range<T>} */
-export const rangeRawParse = r => f => () => {
+export const __rangeRawParse = r => f => () => {
   return Range.parse(r, s => f(s)())
 }
 
 /** @type {(r: unknown) => () => Range.Range<unknown>} */
-export const readRangeRaw = r => () => {
+export const __rangeRawFromRaw = r => () => {
   if (r instanceof Range.Range) {
     return r
   } else {

src/Data.Postgres.Range.purs

@@ -14,53 +14,12 @@ import Data.Show.Generic (genericShow)
 import Effect (Effect)
 import Foreign (unsafeToForeign)
 
-type RangeRawRecord = { upper :: Raw, lower :: Raw, lowerIncl :: Boolean, upperIncl :: Boolean }
+-- | A range of values with optional upper & lower bounds.
-
+-- |
-foreign import data RangeRaw :: Type
+-- | * `mempty -> '(,)'`
-foreign import readRangeRaw :: Raw -> Effect RangeRaw
+-- | * `gte 1 -> '[1,)'`
-foreign import rangeRawToRecord :: RangeRaw -> RangeRawRecord
+-- | * `lt 2 -> '(,2]'`
-foreign import rangeRawFromRecord :: RangeRawRecord -> RangeRaw
+-- | * `gte 1 <> lt 2 -> '[1,2)'`
-foreign import rangeRawParse :: String -> (String -> Effect Raw) -> Effect RangeRaw
-foreign import rangeRawSerialize :: RangeRaw -> Effect String
-
-rangeFromRaw :: forall a. Deserialize a => RangeRawRecord -> RepT (Range a)
-rangeFromRaw raw = do
-  upper' :: Maybe a <- deserialize raw.upper
-  lower' :: Maybe a <- deserialize raw.lower
-  pure $ Range { upper: makeBound raw.upperIncl <$> upper', lower: makeBound raw.lowerIncl <$> lower' }
-
-rangeToRaw :: forall a. Serialize a => Range a -> RepT RangeRawRecord
-rangeToRaw r = do
-  upper' <- serialize $ boundValue <$> upper r
-  lower' <- serialize $ boundValue <$> lower r
-  pure $ { upper: upper', lower: lower', upperIncl: fromMaybe false $ boundIsInclusive <$> upper r, lowerIncl: fromMaybe false $ boundIsInclusive <$> lower r }
-
-data Bound a = BoundIncl a | BoundExcl a
-
-derive instance Generic (Bound a) _
-derive instance Eq a => Eq (Bound a)
-instance Show a => Show (Bound a) where
-  show = genericShow
-
-boundValue :: forall a. Bound a -> a
-boundValue (BoundIncl a) = a
-boundValue (BoundExcl a) = a
-
-boundIsInclusive :: forall a. Bound a -> Boolean
-boundIsInclusive (BoundIncl _) = true
-boundIsInclusive (BoundExcl _) = false
-
-upper :: forall a. Range a -> Maybe (Bound a)
-upper = _.upper <<< unwrap
-
-lower :: forall a. Range a -> Maybe (Bound a)
-lower = _.lower <<< unwrap
-
-makeBound :: forall a. Boolean -> a -> Bound a
-makeBound i a
-  | i = BoundIncl a
-  | otherwise = BoundExcl a
-
 newtype Range a = Range { upper :: Maybe (Bound a), lower :: Maybe (Bound a) }
 
 derive instance Generic (Range a) _
@@ -70,14 +29,10 @@ instance Show a => Show (Range a) where
   show = genericShow
 
 instance (Ord a, Rep a) => Serialize (Range a) where
-  serialize a = do
+  serialize = map (Raw.unsafeFromForeign <<< unsafeToForeign <<< __rangeRawFromRecord) <<< __rangeToRecord
-    raw <- rangeToRaw a
-    pure $ Raw.unsafeFromForeign $ unsafeToForeign $ rangeRawFromRecord raw
 
 instance (Ord a, Rep a) => Deserialize (Range a) where
-  deserialize raw = do
+  deserialize = __rangeFromRecord <=< map __rangeRawToRecord <<< lift <<< __rangeRawFromRaw
-    range :: RangeRaw <- lift $ readRangeRaw raw
-    rangeFromRaw $ rangeRawToRecord range
 
 instance Monoid (Range a) where
   mempty = Range { upper: Nothing, lower: Nothing }
@@ -85,16 +40,52 @@ instance Monoid (Range a) where
 instance Semigroup (Range a) where
   append (Range { upper: au, lower: al }) (Range { upper: bu, lower: bl }) = Range ({ upper: bu <|> au, lower: bl <|> al })
 
+-- | An upper or lower range bound
+data Bound a = BoundIncl a | BoundExcl a
+
+derive instance Generic (Bound a) _
+derive instance Eq a => Eq (Bound a)
+instance Show a => Show (Bound a) where
+  show = genericShow
+
+-- | Get the value of the bound
+boundValue :: forall a. Bound a -> a
+boundValue (BoundIncl a) = a
+boundValue (BoundExcl a) = a
+
+-- | Whether this bound includes the value `a`
+boundIsInclusive :: forall a. Bound a -> Boolean
+boundIsInclusive (BoundIncl _) = true
+boundIsInclusive (BoundExcl _) = false
+
+-- | The upper bound of a range
+upper :: forall a. Range a -> Maybe (Bound a)
+upper = _.upper <<< unwrap
+
+-- | The lower bound of a range
+lower :: forall a. Range a -> Maybe (Bound a)
+lower = _.lower <<< unwrap
+
+-- | Creates a bound from a bool indicating if the bound is inclusive
+-- | and a value `a`
+makeBound :: forall a. Boolean -> a -> Bound a
+makeBound i a
+  | i = BoundIncl a
+  | otherwise = BoundExcl a
+
+-- | Attempt to parse a SQL string of a range as `Range a`
 parseSQL :: forall a. Rep a => (String -> RepT a) -> String -> RepT (Range a)
 parseSQL fromString sql = do
-  range <- lift $ rangeRawParse sql $ smash <<< (serialize <=< fromString)
+  range <- lift $ __rangeRawParse sql $ smash <<< (serialize <=< fromString)
-  rangeFromRaw $ rangeRawToRecord range
+  __rangeFromRecord $ __rangeRawToRecord range
 
+-- | Serialize a `Range` as a SQL string
 printSQL :: forall a. Rep a => Range a -> RepT String
 printSQL range = do
-  record <- rangeToRaw range
+  record <- __rangeToRecord range
-  lift $ rangeRawSerialize $ rangeRawFromRecord record
+  lift $ __rangeRawSerialize $ __rangeRawFromRecord record
 
+-- | Returns whether the range contains value `a`
 contains :: forall a. Ord a => a -> Range a -> Boolean
 contains a r =
   let
@@ -109,14 +100,49 @@ contains a r =
   in
     upperOk && lowerOk
 
+-- | Creates a range with no upper bound and inclusive lower bound `a`; `[a,)`
 gte :: forall a. Ord a => a -> Range a
-gte a = Range { upper: Just $ BoundIncl a, lower: Nothing }
+gte a = Range { lower: Just $ BoundIncl a, upper: Nothing }
 
+-- | Creates a range with no upper bound and exclusive lower bound `a`; `(a,)`
 gt :: forall a. Ord a => a -> Range a
-gt a = Range { upper: Just $ BoundExcl a, lower: Nothing }
+gt a = Range { lower: Just $ BoundExcl a, upper: Nothing }
 
+-- | Creates a range with no lower bound and inclusive upper bound `a`; `(,a]`
 lt :: forall a. Ord a => a -> Range a
-lt a = Range { upper: Nothing, lower: Just $ BoundExcl a }
+lt a = Range { lower: Nothing, upper: Just $ BoundExcl a }
 
+-- | Creates a range with no lower bound and exclusive upper bound `a`; `(,a)`
 lte :: forall a. Ord a => a -> Range a
-lte a = Range { upper: Nothing, lower: Just $ BoundIncl a }
+lte a = Range { lower: Nothing, upper: Just $ BoundIncl a }
+
+-- | FFI
+type RangeRecord = { upper :: Raw, lower :: Raw, lowerIncl :: Boolean, upperIncl :: Boolean }
+
+-- | FFI
+foreign import data RangeRaw :: Type
+-- | FFI
+foreign import __rangeRawFromRaw :: Raw -> Effect RangeRaw
+-- | FFI
+foreign import __rangeRawToRecord :: RangeRaw -> RangeRecord
+-- | FFI
+foreign import __rangeRawFromRecord :: RangeRecord -> RangeRaw
+-- | FFI
+foreign import __rangeRawParse :: String -> (String -> Effect Raw) -> Effect RangeRaw
+-- | FFI
+foreign import __rangeRawSerialize :: RangeRaw -> Effect String
+
+-- | FFI
+__rangeFromRecord :: forall a. Deserialize a => RangeRecord -> RepT (Range a)
+__rangeFromRecord raw = do
+  upper' :: Maybe a <- deserialize raw.upper
+  lower' :: Maybe a <- deserialize raw.lower
+  pure $ Range { upper: makeBound raw.upperIncl <$> upper', lower: makeBound raw.lowerIncl <$> lower' }
+
+-- | FFI
+__rangeToRecord :: forall a. Serialize a => Range a -> RepT RangeRecord
+__rangeToRecord r = do
+  upper' <- serialize $ boundValue <$> upper r
+  lower' <- serialize $ boundValue <$> lower r
+  pure $ { upper: upper', lower: lower', upperIncl: fromMaybe false $ boundIsInclusive <$> upper r, lowerIncl: fromMaybe false $ boundIsInclusive <$> lower r }
+

src/Data.Postgres.Raw.js

@@ -1,5 +1,5 @@
 /** @type {(raw: unknown) => string} */
-export const rawToString = raw =>
+export const rawToDebugString = raw =>
   typeof raw === 'undefined'
     ? 'undefined'
     : typeof raw === 'string'
@@ -15,7 +15,7 @@ export const rawToString = raw =>
           : 'unknown'
 
 /** @type {(a: unknown) => (b: unknown) => boolean} */
-export const rawEq = a => b =>
+export const rawDebugEq = a => b =>
   typeof a === 'undefined' && typeof b === 'undefined'
     ? true
     : typeof a === typeof b &&
@@ -25,6 +25,6 @@ export const rawEq = a => b =>
         ? a === null && b === null
           ? true
           : a instanceof Array && b instanceof Array
-            ? a.every((a_, ix) => rawEq(a_)(b[ix]))
+            ? a.every((a_, ix) => rawDebugEq(a_)(b[ix]))
             : false
         : false

src/Data.Postgres.Raw.purs

@@ -3,20 +3,43 @@ module Data.Postgres.Raw where
 import Prelude
 
 import Foreign (Foreign)
+import Prim.TypeError (class Warn, Text)
 import Unsafe.Coerce (unsafeCoerce)
 
+-- | A raw JS value converted from SQL
+-- |
+-- | In practice, this is an alias for `Foreign` with
+-- | type system guarantees that purescript types are
+-- | correctly represented in JS to be represented in SQL.
 foreign import data Raw :: Type
-foreign import rawToString :: Raw -> String
+
-foreign import rawEq :: Raw -> Raw -> Boolean
+-- | Stringifies a `Raw` value if a JS primitive,
+-- | else returns a debug representation.
+-- |
+-- | * `{foo: 'bar'} -> "[Object]"`
+-- | * `[1, 2, 3] -> "[Array]"`
+-- | * `'foo' -> "foo"`
+-- | * `123 -> "123"`
+foreign import rawToDebugString :: Raw -> String
+
+-- | Performs JS referential equality `===` for primitives
+-- | or arrays of primitives, else returns `false`.
+foreign import rawDebugEq :: Raw -> Raw -> Boolean
 
 instance Show Raw where
-  show = rawToString
+  show = rawToDebugString
 
-instance Eq Raw where
+instance (Warn (Text "`Eq Raw` only checks equality for JS primitives, and is always `false` for objects.")) => Eq Raw where
-  eq = rawEq
+  eq = rawDebugEq
 
+-- | Coerce a `Foreign` value to `Raw`.
+-- |
+-- | This is only safe if the `Foreign` value
+-- | is guaranteed to be serializable to a SQL
+-- | value via `pg-types`.
 unsafeFromForeign :: Foreign -> Raw
 unsafeFromForeign = unsafeCoerce
 
-unsafeToForeign :: Raw -> Foreign
+-- | Coerce a `Raw` value to `Foreign`.
-unsafeToForeign = unsafeCoerce
+asForeign :: Raw -> Foreign
+asForeign = unsafeCoerce

src/Data.Postgres.Result.js

@@ -2,4 +2,4 @@
 export const rows = r => r.rows
 
 /** @type {(_: import('pg').QueryResult) => number | null} */
-export const rowsAffectedImpl = r => r.rowCount
+export const __rowsAffected = r => r.rowCount

src/Data.Postgres.Result.purs

@@ -15,38 +15,83 @@ import Data.Tuple.Nested (type (/\), (/\))
 import Foreign (ForeignError(..))
 import Type.Prelude (Proxy(..))
 
+-- | A raw query result
+-- |
+-- | <https://node-postgres.com/apis/result>
 foreign import data Result :: Type
 
-foreign import rowsAffectedImpl :: Result -> Nullable Number
+-- | Returns the number of rows affected by the query
-foreign import rows :: Result -> Array (Array Raw)
+-- |
-
+-- | <https://node-postgres.com/apis/result#resultrowcount-int--null>
 rowsAffected :: Result -> Maybe Int
-rowsAffected = Int.fromNumber <=< Nullable.toMaybe <<< rowsAffectedImpl
+rowsAffected = Int.fromNumber <=< Nullable.toMaybe <<< __rowsAffected
 
-class FromResult (a :: Type) where
+-- | Can be unmarshalled from a queried row
-  expectedRowLength :: forall g. g a -> Int
+-- |
+-- | Implementations are provided for:
+-- |  * tuples of any length containing types that are `Rep`
+-- |  * tuples of any length with the last member of `Array Raw`
+-- |  * a single value of a type that is `Rep`
+-- |  * `Array Raw`
+-- |  * `Unit` (always succeeds)
+-- |
+-- | ```
+-- | -- CREATE TABLE foo
+-- | --   ( id INT NOT NULL PRIMARY KEY
+-- | --   , fruit TEXT NOT NULL
+-- | --   , created TIMESTAMPTZ NOT NULL DEFAULT NOW()
+-- | --   );
+-- | do
+-- |   let q = query "select id, fruit, created from foo" client
+-- |
+-- |   -- pick all 3 columns explicitly
+-- |   _ :: Array (Int /\ String /\ DateTime) <- q
+-- |
+-- |   -- pick first 2 columns, discarding any others
+-- |   _ :: Array (Int /\ String) <- q
+-- |
+-- |   -- pick first 2 columns, if any more keep as `Array Raw`
+-- |   _ :: Array (Int /\ String /\ Array Raw) <- q
+-- |
+-- |   -- pick just the ID, discarding all other columns
+-- |   id :: Array Int <- q
+-- |
+-- |   pure unit
+-- | ```
+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
 
-instance (Rep a, FromResult b) => FromResult (a /\ b) where
+instance (Rep a, FromRow b) => FromRow (a /\ b) where
-  expectedRowLength _ = expectedRowLength (Proxy @b) + 1
+  minColumnCount _ = minColumnCount (Proxy @b) + 1
   fromRow r =
     let
-      expLen = expectedRowLength (Proxy @(Tuple a b))
+      minLen = minColumnCount (Proxy @(Tuple a b))
-      lengthMismatch = pure $ TypeMismatch ("Expected row of length " <> show expLen) ("Found row of length " <> show (Array.length r))
+      lengthMismatch = pure $ TypeMismatch ("Expected row to have at least " <> show minLen <> " columns") ("Found row of length " <> show (Array.length r))
     in
       do
-        when (Array.length r /= expLen) (throwError lengthMismatch)
+        when (Array.length r < minLen) (throwError lengthMismatch)
         a <- deserialize =<< liftMaybe lengthMismatch (Array.head r)
         b <- fromRow =<< liftMaybe lengthMismatch (Array.tail r)
         pure $ a /\ b
-else instance FromResult Unit where
+else instance FromRow (Array Raw) where
-  expectedRowLength _ = 0
+  minColumnCount _ = 0
+  fromRow = pure
+else instance FromRow Unit where
+  minColumnCount _ = 0
   fromRow _ = pure unit
-else instance Rep a => FromResult a where
+else instance Rep a => FromRow a where
-  expectedRowLength _ = 1
+  minColumnCount _ = 1
-  fromRow =
+  fromRow r =
     let
-      get [ a ] = pure a
+      err = pure $ TypeMismatch "Expected row of length >= 1" "Empty row"
-      get o = throwError $ pure $ TypeMismatch "Expected row of length 1" $ show o
     in
-      deserialize <=< get
+      deserialize =<< liftMaybe err (Array.head r)
+
+-- | FFI binding for `Result#rowCount`
+foreign import __rowsAffected :: Result -> Nullable Number
+
+-- | FFI binding for `Result#rows`
+foreign import rows :: Result -> Array (Array Raw)

src/Data.Postgres.purs

@@ -13,7 +13,7 @@ import Data.List.NonEmpty (NonEmptyList)
 import Data.Maybe (Maybe(..))
 import Data.Newtype (class Newtype, unwrap, wrap)
 import Data.Postgres.Raw (Raw)
-import Data.Postgres.Raw (unsafeFromForeign, unsafeToForeign) as Raw
+import Data.Postgres.Raw (unsafeFromForeign, asForeign) as Raw
 import Data.RFC3339String as DateTime.ISO
 import Data.Show.Generic (genericShow)
 import Data.Traversable (traverse)
@@ -141,7 +141,7 @@ instance Deserialize Unit where
 
 -- | `NULL` (fails if non-null)
 instance Deserialize Null where
-  deserialize = map (const Null) <<< F.readNullOrUndefined <<< Raw.unsafeToForeign
+  deserialize = map (const Null) <<< F.readNullOrUndefined <<< Raw.asForeign
 
 -- | `json`, `jsonb`
 instance ReadForeign a => Deserialize (JSON a) where
@@ -149,11 +149,11 @@ instance ReadForeign a => Deserialize (JSON a) where
 
 -- | `bytea`
 instance Deserialize Buffer where
-  deserialize = (F.unsafeReadTagged "Buffer") <<< Raw.unsafeToForeign
+  deserialize = (F.unsafeReadTagged "Buffer") <<< Raw.asForeign
 
 -- | `int2`, `int4`
 instance Deserialize Int where
-  deserialize = F.readInt <<< Raw.unsafeToForeign
+  deserialize = F.readInt <<< Raw.asForeign
 
 -- | `int8`
 instance Deserialize BigInt where
@@ -166,15 +166,15 @@ instance Deserialize BigInt where
 
 -- | `bool`
 instance Deserialize Boolean where
-  deserialize = F.readBoolean <<< Raw.unsafeToForeign
+  deserialize = F.readBoolean <<< Raw.asForeign
 
 -- | `text`, `inet`, `tsquery`, `tsvector`, `uuid`, `xml`, `cidr`, `time`, `timetz`
 instance Deserialize String where
-  deserialize = F.readString <<< Raw.unsafeToForeign
+  deserialize = F.readString <<< Raw.asForeign
 
 -- | `float4`, `float8`
 instance Deserialize Number where
-  deserialize = F.readNumber <<< Raw.unsafeToForeign
+  deserialize = F.readNumber <<< Raw.asForeign
 
 -- | `timestamp`, `timestamptz`
 instance Deserialize DateTime where
@@ -185,7 +185,7 @@ instance Deserialize DateTime where
 
 -- | postgres `array`
 instance Deserialize a => Deserialize (Array a) where
-  deserialize = traverse (deserialize <<< Raw.unsafeFromForeign) <=< F.readArray <<< Raw.unsafeToForeign
+  deserialize = traverse (deserialize <<< Raw.unsafeFromForeign) <=< F.readArray <<< Raw.asForeign
 
 -- | non-NULL -> `Just`, NULL -> `Nothing`
 instance Deserialize a => Deserialize (Maybe a) where

src/Effect.Aff.Postgres.Client.js

@@ -1,8 +1,8 @@
 /** @type {(c: import('pg').Client) => () => Promise<void>} */
-export const connectImpl = c => () => c.connect()
+export const __connect = c => () => c.connect()
 
 /** @type {(c: import('pg').Client) => () => Promise<void>} */
-export const endImpl = c => () => c.end()
+export const __end = c => () => c.end()
 
 /** @type {(q: import('pg').QueryConfig) => (c: import('pg').Client) => () => Promise<import('pg').QueryResult>} */
-export const queryImpl = q => c => () => c.query(q)
+export const __query = q => c => () => c.query(q)

src/Effect.Aff.Postgres.Client.purs

@@ -1,43 +1,69 @@
-module Effect.Aff.Postgres.Client where
+module Effect.Aff.Postgres.Client (connected, connect, end, exec, query, queryRaw, __connect, __end, __query, module X) where
 
 import Prelude
 
 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.Postgres.Query (class AsQuery, QueryRaw, asQuery, __queryToRaw)
-import Data.Postgres.Result (class FromResult, Result, fromRow, rows, rowsAffected)
+import Data.Postgres.Result (class FromRow, Result, fromRow, rows, rowsAffected)
 import Data.Traversable (traverse)
 import Effect (Effect)
 import Effect.Aff (Aff)
 import Effect.Class (liftEffect)
 import Effect.Postgres.Client (Client, Config, make)
+import Effect.Postgres.Client as X
 import Prim.Row (class Union)
 
-foreign import connectImpl :: Client -> Effect (Promise Unit)
+-- | Create a client and immediately connect it to the database
-foreign import endImpl :: Client -> Effect (Promise Unit)
+-- |
-foreign import queryImpl :: QueryRaw -> Client -> Effect (Promise Result)
+-- | The config parameter `r` is `Config` with all keys optional.
-
+-- |
+-- | This is a shorthand for `(voidRight <*> connect) =<< liftEffect (make cfg)`
 connected :: forall r trash. Union r trash (Config ()) => Record r -> Aff Client
-connected c = do
+connected cfg = (voidRight <*> connect) =<< liftEffect (make cfg)
-  client <- liftEffect $ make c
-  connect client
-  pure client
 
+-- | Connects the client to the database
+-- |
+-- | <https://node-postgres.com/apis/client#clientconnect>
 connect :: Client -> Aff Unit
-connect = Promise.toAffE <<< connectImpl
+connect = Promise.toAffE <<< __connect
 
+-- | Disconnects the client from the database
+-- |
+-- | <https://node-postgres.com/apis/client#clientend>
 end :: Client -> Aff Unit
-end = Promise.toAffE <<< endImpl
+end = 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 q c = do
-  q' <- queryToRaw <$> liftEffect (asQuery q)
+  q' <- __queryToRaw <$> liftEffect (asQuery q)
-  Promise.toAffE $ queryImpl q' c
+  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 q = map (fromMaybe 0 <<< rowsAffected) <<< queryRaw q
 
-query :: forall q r. AsQuery q => FromResult r => q -> Client -> Aff (Array r)
+-- | 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 => FromRow r => q -> Client -> Aff (Array r)
 query q = traverse (liftEffect <<< smash <<< fromRow) <=< map rows <<< queryRaw q
+
+-- | FFI binding to `Client#connect`
+foreign import __connect :: Client -> Effect (Promise Unit)
+
+-- | FFI binding to `Client#end`
+foreign import __end :: Client -> Effect (Promise Unit)
+
+-- | FFI binding to `Client#query`
+foreign import __query :: QueryRaw -> Client -> Effect (Promise Result)

src/Effect.Aff.Postgres.Pool.js

@@ -0,0 +1,7 @@
+import Pg from 'pg'
+
+/** @type {(pool: Pg.Pool) => () => Promise<void>} */
+export const __end = pool => () => pool.end()
+
+/** @type {(pool: Pg.Pool) => () => Promise<Pg.PoolClient>} */
+export const __connect = pool => () => pool.connect()

src/Effect.Aff.Postgres.Pool.purs

@@ -0,0 +1,37 @@
+module Effect.Aff.Postgres.Pool (connect, end, __end, __connect, module X) where
+
+import Prelude
+
+import Control.Promise (Promise)
+import Control.Promise as Promise
+import Effect (Effect)
+import Effect.Aff (Aff)
+import Effect.Postgres.Client (Client)
+import Effect.Postgres.Pool (Pool)
+import Effect.Postgres.Pool as X
+
+-- | Acquires a client from the pool.
+-- | 
+-- |  * If there are idle clients in the pool one will be returned to the callback on process.nextTick.
+-- |  * If the pool is not full but all current clients are checked out a new client will be created & returned to this callback.
+-- |  * 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
+
+-- | Drain the pool of all active clients, disconnect them,
+-- | and shut down any internal timers in the pool.
+-- |
+-- | It is common to call this at the end of a script using the pool or when
+-- | your process is attempting to shut down cleanly.
+-- |
+-- | <https://node-postgres.com/apis/pool#poolend>
+end :: Pool -> Aff Unit
+end = Promise.toAffE <<< __end
+
+-- | FFI binding to `Pool#end`
+foreign import __end :: Pool -> Effect (Promise Unit)
+
+-- | FFI binding to `Pool#connect`
+foreign import __connect :: Pool -> Effect (Promise Client)

src/Effect.Postgres.Client.js

@@ -2,11 +2,10 @@ import Pg from 'pg'
 
 /** @typedef {{statementTimeout: unknown, queryTimeout: unknown, idleInTransactionTimeout: unknown, connectionTimeout: unknown, applicationName: string}} ClientConfigExtra */
 
-/** @type {(_: {unwrapMillis: (_m: unknown) => number}) => (cfg: Pg.ClientConfig & ClientConfigExtra) => () => Pg.Client} */
+/** @type {(_o: {unwrapMillis: (ms: unknown) => number}) => (cfg: Pg.ClientConfig & ClientConfigExtra) => Pg.ClientConfig} */
-export const makeImpl =
+export const __uncfg =
   ({ unwrapMillis }) =>
-  cfg =>
+  cfg => {
-  () => {
     if ('statementTimeout' in cfg) {
       cfg.statement_timeout = unwrapMillis(cfg.statementTimeout)
     }
@@ -24,5 +23,8 @@ export const makeImpl =
     if ('applicationName' in cfg) {
       cfg.application_name = cfg.applicationName
     }
-    return new Pg.Client(cfg)
+    return cfg
   }
+
+/** @type {(cfg: Pg.ClientConfig) => () => Pg.Client} */
+export const __make = cfg => () => new Pg.Client(cfg)

src/Effect.Postgres.Client.purs

@@ -7,6 +7,7 @@ import Data.Newtype (unwrap)
 import Data.Nullable (Nullable)
 import Data.Nullable as Nullable
 import Data.Postgres (modifyPgTypes)
+import Data.Profunctor (lcmap)
 import Data.Time.Duration (Milliseconds)
 import Effect (Effect)
 import Effect.Exception (Error)
@@ -18,21 +19,17 @@ import Prim.Row (class Union)
 import Record (modify)
 import Type.Prelude (Proxy(..))
 
+-- | Database connection
 foreign import data Client :: Type
-foreign import makeImpl :: { unwrapMillis :: Milliseconds -> Number } -> Foreign -> Effect Client
 
+-- | A notification raised by `NOTIFY`
 type Notification =
   { processId :: Number
   , channel :: String
   , payload :: Maybe String
   }
 
-type NotificationRaw =
+-- | Client connection config
-  { processId :: Number
-  , channel :: String
-  , payload :: Nullable String
-  }
-
 type Config r =
   ( user :: String
   , password :: String
@@ -48,23 +45,49 @@ type Config r =
   | r
   )
 
+-- | Creates a new client, not yet connected to the database.
+-- |
+-- | The config parameter `r` is `Config` with all keys optional.
+-- |
+-- | <https://node-postgres.com/apis/client#new-client>
 make :: forall r trash. Union r trash (Config ()) => Record r -> Effect Client
 make r = do
   modifyPgTypes
-  makeImpl { unwrapMillis: unwrap } $ unsafeToForeign r
+  __make $ __uncfg { unwrapMillis: unwrap } $ unsafeToForeign r
 
-error :: EventHandle1 Client Error
+-- | <https://node-postgres.com/apis/client#error>
-error = EventHandle "end" mkEffectFn1
+errorE :: EventHandle1 Client Error
+errorE = EventHandle "error" mkEffectFn1
 
-notice :: EventHandle1 Client Error
+-- | <https://node-postgres.com/apis/client#notice>
-notice = EventHandle "notice" mkEffectFn1
+noticeE :: EventHandle1 Client Error
+noticeE = EventHandle "notice" mkEffectFn1
 
-end :: EventHandle0 Client
+-- | <https://node-postgres.com/apis/client#end>
-end = EventHandle "end" identity
+endE :: EventHandle0 Client
+endE = EventHandle "end" identity
 
-notification :: EventHandle Client (Notification -> Effect Unit) (EffectFn1 NotificationRaw Unit)
+-- | <https://node-postgres.com/apis/client#notification>
-notification =
+notificationE :: EventHandle Client (Notification -> Effect Unit) (EffectFn1 NotificationRaw Unit)
+notificationE =
   let
     payload = Proxy @"payload"
+    payloadToMaybe = modify payload Nullable.toMaybe
   in
-    EventHandle "notification" (\f -> mkEffectFn1 $ f <<< modify payload Nullable.toMaybe)
+    EventHandle "notification" (mkEffectFn1 <<< lcmap payloadToMaybe)
+
+-- | FFI
+foreign import data ClientConfigRaw :: Type
+
+-- | FFI
+foreign import __make :: ClientConfigRaw -> Effect Client
+
+-- | FFI
+foreign import __uncfg :: { unwrapMillis :: Milliseconds -> Number } -> Foreign -> ClientConfigRaw
+
+-- | FFI
+type NotificationRaw =
+  { processId :: Number
+  , channel :: String
+  , payload :: Nullable String
+  }

src/Effect.Postgres.Pool.js

@@ -0,0 +1,34 @@
+import Pg from 'pg'
+
+import { __uncfg as uncfgClient } from './Effect.Postgres.Client.js'
+
+/** @typedef {{idleTimeout: unknown}} PoolConfigExtra */
+
+/** @type {(o: {unwrapMillis: (_: unknown) => number}) => (cfg: Pg.PoolConfig & PoolConfigExtra & import('./Effect.Postgres.Client.js').ClientConfigExtra) => Pg.PoolConfig} */
+export const __uncfg =
+  ({ unwrapMillis }) =>
+  cfg => {
+    uncfgClient({ unwrapMillis })(cfg)
+
+    if ('idleTimeout' in cfg) {
+      cfg.idleTimeoutMillis = unwrapMillis(cfg.idleTimeout)
+    }
+
+    return cfg
+  }
+
+/** @type {(cfg: Pg.PoolConfig) => () => Pg.Pool} */
+export const __make = cfg => () => new Pg.Pool(cfg)
+
+/** @type {(pool: Pg.Pool) => number} */
+export const clientCount = pool => pool.totalCount
+
+/** @type {(pool: Pg.Pool) => number} */
+export const clientIdleCount = pool => pool.idleCount
+
+/** @type {(pool: Pg.Pool) => number} */
+export const clientWaitingCount = pool => pool.waitingCount
+
+/** @type {(pool: Pg.Pool) => (client: Pg.Client | Pg.PoolClient) => (destroy: boolean) => () => void} */
+export const __release = _pool => client => destroy => () =>
+  'release' in client ? client.release(destroy) : undefined

src/Effect.Postgres.Pool.purs

@@ -0,0 +1,92 @@
+module Effect.Postgres.Pool where
+
+import Prelude
+
+import Data.Maybe (Maybe)
+import Data.Newtype (unwrap)
+import Data.Nullable (Nullable)
+import Data.Nullable as Nullable
+import Data.Postgres (modifyPgTypes)
+import Data.Profunctor (lcmap)
+import Data.Time.Duration (Milliseconds)
+import Effect (Effect)
+import Effect.Exception (Error)
+import Effect.Postgres.Client (Client)
+import Effect.Postgres.Client as Client
+import Effect.Uncurried (EffectFn2, mkEffectFn1, mkEffectFn2)
+import Foreign (Foreign, unsafeToForeign)
+import Node.EventEmitter (EventHandle(..))
+import Node.EventEmitter.UtilTypes (EventHandle1, EventHandle2)
+import Prim.Row (class Union)
+import Type.Row (type (+))
+
+-- | Database connection pool
+foreign import data Pool :: Type
+
+-- | Pool construction config
+-- |
+-- | Includes all Client config options
+type Config r = Client.Config + (idleTimeout :: Milliseconds, max :: Int, allowExitOnIdle :: Boolean | r)
+
+-- | The total number of clients existing within the pool.
+foreign import clientCount :: Pool -> Int
+
+-- | The number of clients which are not checked out but are currently idle in the pool.
+foreign import clientIdleCount :: Pool -> Int
+
+-- | The number of queued requests waiting on a client when all clients are checked out.
+-- | It can be helpful to monitor this number to see if you need to adjust the size of the pool.
+foreign import clientWaitingCount :: Pool -> Int
+
+-- | Creates a new pool
+-- |
+-- | The config parameter `r` is `Config` with all keys optional.
+-- |
+-- | <https://node-postgres.com/apis/pool#new-pool>
+make :: forall r omitted. Union r omitted (Config ()) => Record r -> Effect Pool
+make r = do
+  modifyPgTypes
+  __make $ __uncfg { unwrapMillis: unwrap } $ unsafeToForeign r
+
+-- | <https://node-postgres.com/apis/pool#releasing-clients>
+releaseClient :: Pool -> Client -> Effect Unit
+releaseClient p c = __release p c false
+
+-- | <https://node-postgres.com/apis/pool#releasing-clients>
+destroyClient :: Pool -> Client -> Effect Unit
+destroyClient p c = __release p c true
+
+-- | <https://node-postgres.com/apis/pool#connect>
+connectE :: EventHandle1 Pool Client
+connectE = EventHandle "connect" mkEffectFn1
+
+-- | <https://node-postgres.com/apis/pool#error>
+errorE :: EventHandle2 Pool Error Client
+errorE = EventHandle "error" mkEffectFn2
+
+-- | <https://node-postgres.com/apis/pool#acquire>
+acquireE :: EventHandle1 Pool Client
+acquireE = EventHandle "acquire" mkEffectFn1
+
+-- | <https://node-postgres.com/apis/pool#remove>
+removeE :: EventHandle1 Pool Client
+removeE = EventHandle "remove" mkEffectFn1
+
+-- | <https://node-postgres.com/apis/pool#release>
+releaseE :: EventHandle Pool (Maybe Error -> Client -> Effect Unit) (EffectFn2 (Nullable Error) Client Unit)
+releaseE = EventHandle "release" (mkEffectFn2 <<< lcmap Nullable.toMaybe)
+
+-- | FFI type for `import('pg').PoolConfig`
+foreign import data PoolConfigRaw :: Type
+
+-- | FFI binding to `new Pool()`
+foreign import __make :: PoolConfigRaw -> Effect Pool
+
+-- | FFI binding to `Client#release` for clients created from pools
+-- |
+-- | Accepts a `Pool` as a type-level hint that the `Client` should have
+-- | come from a `Pool`
+foreign import __release :: Pool -> Client -> Boolean -> Effect Unit
+
+-- | partial `Config` to `import('pg').PoolConfig`
+foreign import __uncfg :: { unwrapMillis :: Milliseconds -> Number } -> Foreign -> PoolConfigRaw

src/Effect.Postgres.purs

@@ -1,3 +0,0 @@
-module Effect.Postgres where
-
-foreign import data Pool :: Type

test/Test.Data.Postgres.purs

@@ -18,7 +18,7 @@ import Data.Postgres (class Rep, jsNull)
 import Data.Postgres.Query.Builder as Q
 import Data.Postgres.Raw (Raw)
 import Data.Postgres.Raw as Raw
-import Data.Postgres.Result (class FromResult)
+import Data.Postgres.Result (class FromRow)
 import Data.RFC3339String as DateTime.ISO
 import Data.String as String
 import Data.Time (Time(..))
@@ -48,11 +48,13 @@ foreign import readBigInt64BE :: Buffer -> Effect BigInt
 foreign import dbg :: forall a. a -> Effect Unit
 
 newtype GenSmallInt = GenSmallInt Int
+
 derive instance Newtype GenSmallInt _
 instance Arbitrary GenSmallInt where
   arbitrary = wrap <$> chooseInt (-32768) 32767
 
 newtype GenDateTime = GenDateTime DateTime
+
 derive instance Newtype GenDateTime _
 instance Arbitrary GenDateTime where
   arbitrary = do
@@ -69,6 +71,7 @@ instance Arbitrary GenDateTime where
     pure $ wrap $ DateTime date time
 
 newtype GenString = GenString String
+
 derive instance Newtype GenString _
 instance Arbitrary GenString where
   arbitrary = do
@@ -78,6 +81,7 @@ instance Arbitrary GenString where
     pure $ wrap $ fold chars'
 
 newtype GenSmallFloat = GenSmallFloat Number
+
 derive instance Newtype GenSmallFloat _
 instance Arbitrary GenSmallFloat where
   arbitrary = do
@@ -132,8 +136,8 @@ asRaw = Raw.unsafeFromForeign <<< unsafeToForeign
 spec :: Spec Unit
 spec =
   let
-    check :: forall @a @x. Show a => Arbitrary x => Rep a => FromResult a => String -> String -> (x -> a) -> (a -> Raw) -> (a -> a -> Boolean) -> SpecT Aff Client Identity Unit
+    check :: forall @a @x. Show a => Arbitrary x => Rep a => FromRow a => String -> String -> (x -> a) -> (a -> a -> Boolean) -> SpecT Aff Client Identity Unit
-    check purs sql xa asRaw_ isEq =
+    check purs sql xa isEq =
       it (purs <> " <> " <> sql) \c -> do
         let
           tab = String.replace (wrap " ") (wrap "_") $ String.replace (wrap "[") (wrap "") $ String.replace (wrap "]") (wrap "") $ sql <> "_is_" <> String.toLower purs
@@ -157,27 +161,24 @@ spec =
             act = unsafePartial fromJust $ Array.head res
           when (not $ isEq exp act) $ fail $ "expected " <> show exp <> " to equal " <> show act
 
-    check_ :: forall @a. Eq a => Show a => Arbitrary a => FromResult a => Rep a => String -> String -> SpecT Aff Client Identity Unit
+    check_ :: forall @a. Eq a => Show a => Arbitrary a => FromRow a => Rep a => String -> String -> SpecT Aff Client Identity Unit
-    check_ purs sql = check @a @a purs sql identity asRaw eq
+    check_ purs sql = check @a @a purs sql identity eq
-
-    dateTimeFromArbitrary :: Int -> DateTime
-    dateTimeFromArbitrary = Instant.toDateTime <<< unsafePartial fromJust <<< Instant.instant <<< wrap <<< Int.toNumber
   in
     around withClient
       $ describe "Data.Postgres"
       $ do
-          check @Int @GenSmallInt "Int" "int2" unwrap asRaw eq
+          check @Int @GenSmallInt "Int" "int2" unwrap eq
           check_ @Int "Int" "int4"
 
-          check @String @GenString "String" "text" unwrap asRaw eq
+          check @String @GenString "String" "text" unwrap eq
 
           check_ @Boolean "Boolean" "bool"
 
-          check @Number @GenSmallFloat "Number" "float4" unwrap asRaw (\a b -> Number.abs (a - b) <= 0.0001)
+          check @Number @GenSmallFloat "Number" "float4" unwrap (\a b -> Number.abs (a - b) <= 0.0001)
           check_ @Number "Number" "float8"
 
-          check @BigInt @GenBigInt "BigInt" "int8" unwrap (asRaw <<< BigInt.toString) eq
+          check @BigInt @GenBigInt "BigInt" "int8" unwrap eq
-          check @(Maybe String) @(Maybe GenString) "Maybe String" "text" (map unwrap) (maybe jsNull asRaw) eq
+          check @(Maybe String) @(Maybe GenString) "Maybe String" "text" (map unwrap) eq
-          check @(Array String) @(Array GenString) "Array String" "text[]" (map unwrap) asRaw eq
+          check @(Array String) @(Array GenString) "Array String" "text[]" (map unwrap) eq
-          check @DateTime @GenDateTime "DateTime" "timestamptz" unwrap (asRaw <<< DateTime.ISO.fromDateTime) eq
+          check @DateTime @GenDateTime "DateTime" "timestamptz" unwrap eq
-          check @String @GenJSON "JSON" "json" (writeJSON <<< unwrap) asRaw eq
+          check @String @GenJSON "JSON" "json" (writeJSON <<< unwrap) eq