feat: pool, docs

This commit is contained in:
orion 2024-03-30 19:49:54 -05:00
parent 340cee4745
commit 7520b9eb19
Signed by: orion
GPG Key ID: 6D4165AE4C928719
21 changed files with 496 additions and 177 deletions

View File

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

View File

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

View File

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

View File

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

View File

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

View File

@ -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 }
foreign import data RangeRaw :: Type
foreign import readRangeRaw :: Raw -> Effect RangeRaw
foreign import rangeRawToRecord :: RangeRaw -> RangeRawRecord
foreign import rangeRawFromRecord :: RangeRawRecord -> RangeRaw
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
-- | A range of values with optional upper & lower bounds.
-- |
-- | * `mempty -> '(,)'`
-- | * `gte 1 -> '[1,)'`
-- | * `lt 2 -> '(,2]'`
-- | * `gte 1 <> lt 2 -> '[1,2)'`
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
raw <- rangeToRaw a
pure $ Raw.unsafeFromForeign $ unsafeToForeign $ rangeRawFromRecord raw
serialize = map (Raw.unsafeFromForeign <<< unsafeToForeign <<< __rangeRawFromRecord) <<< __rangeToRecord
instance (Ord a, Rep a) => Deserialize (Range a) where
deserialize raw = do
range :: RangeRaw <- lift $ readRangeRaw raw
rangeFromRaw $ rangeRawToRecord range
deserialize = __rangeFromRecord <=< map __rangeRawToRecord <<< lift <<< __rangeRawFromRaw
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)
rangeFromRaw $ rangeRawToRecord range
range <- lift $ __rangeRawParse sql $ smash <<< (serialize <=< fromString)
__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
lift $ rangeRawSerialize $ rangeRawFromRecord record
record <- __rangeToRecord range
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 }

View File

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

View File

@ -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
eq = rawEq
instance (Warn (Text "`Eq Raw` only checks equality for JS primitives, and is always `false` for objects.")) => Eq Raw where
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
unsafeToForeign = unsafeCoerce
-- | Coerce a `Raw` value to `Foreign`.
asForeign :: Raw -> Foreign
asForeign = unsafeCoerce

View File

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

View File

@ -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
foreign import rows :: Result -> Array (Array Raw)
-- | Returns the number of rows affected by the query
-- |
-- | <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
expectedRowLength :: forall g. g a -> Int
-- | Can be unmarshalled from a queried row
-- |
-- | 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
expectedRowLength _ = expectedRowLength (Proxy @b) + 1
instance (Rep a, FromRow b) => FromRow (a /\ b) where
minColumnCount _ = minColumnCount (Proxy @b) + 1
fromRow r =
let
expLen = expectedRowLength (Proxy @(Tuple a b))
lengthMismatch = pure $ TypeMismatch ("Expected row of length " <> show expLen) ("Found row of length " <> show (Array.length r))
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
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
expectedRowLength _ = 0
else instance FromRow (Array Raw) where
minColumnCount _ = 0
fromRow = pure
else instance FromRow Unit where
minColumnCount _ = 0
fromRow _ = pure unit
else instance Rep a => FromResult a where
expectedRowLength _ = 1
fromRow =
else instance Rep a => FromRow a where
minColumnCount _ = 1
fromRow r =
let
get [ a ] = pure a
get o = throwError $ pure $ TypeMismatch "Expected row of length 1" $ show o
err = pure $ TypeMismatch "Expected row of length >= 1" "Empty row"
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)

View File

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

View File

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

View File

@ -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.Result (class FromResult, Result, fromRow, rows, rowsAffected)
import Data.Postgres.Query (class AsQuery, QueryRaw, asQuery, __queryToRaw)
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)
foreign import endImpl :: Client -> Effect (Promise Unit)
foreign import queryImpl :: QueryRaw -> Client -> Effect (Promise Result)
-- | Create a client and immediately connect it to the database
-- |
-- | 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
client <- liftEffect $ make c
connect client
pure client
connected cfg = (voidRight <*> connect) =<< liftEffect (make cfg)
-- | 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)
Promise.toAffE $ queryImpl q' c
q' <- __queryToRaw <$> liftEffect (asQuery 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 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)

View File

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

View File

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

View File

@ -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} */
export const makeImpl =
/** @type {(_o: {unwrapMillis: (ms: unknown) => number}) => (cfg: Pg.ClientConfig & ClientConfigExtra) => Pg.ClientConfig} */
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)

View File

@ -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 =
{ processId :: Number
, channel :: String
, payload :: Nullable String
}
-- | Client connection config
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
error = EventHandle "end" mkEffectFn1
-- | <https://node-postgres.com/apis/client#error>
errorE :: EventHandle1 Client Error
errorE = EventHandle "error" mkEffectFn1
notice :: EventHandle1 Client Error
notice = EventHandle "notice" mkEffectFn1
-- | <https://node-postgres.com/apis/client#notice>
noticeE :: EventHandle1 Client Error
noticeE = EventHandle "notice" mkEffectFn1
end :: EventHandle0 Client
end = EventHandle "end" identity
-- | <https://node-postgres.com/apis/client#end>
endE :: EventHandle0 Client
endE = EventHandle "end" identity
notification :: EventHandle Client (Notification -> Effect Unit) (EffectFn1 NotificationRaw Unit)
notification =
-- | <https://node-postgres.com/apis/client#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
}

View File

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

View File

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

View File

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

View File

@ -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 purs sql xa asRaw_ isEq =
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 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_ purs sql = check @a @a purs sql identity asRaw eq
dateTimeFromArbitrary :: Int -> DateTime
dateTimeFromArbitrary = Instant.toDateTime <<< unsafePartial fromJust <<< Instant.instant <<< wrap <<< Int.toNumber
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 eq
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 @(Maybe String) @(Maybe GenString) "Maybe String" "text" (map unwrap) (maybe jsNull asRaw) eq
check @(Array String) @(Array GenString) "Array String" "text[]" (map unwrap) asRaw eq
check @DateTime @GenDateTime "DateTime" "timestamptz" unwrap (asRaw <<< DateTime.ISO.fromDateTime) eq
check @String @GenJSON "JSON" "json" (writeJSON <<< unwrap) asRaw eq
check @BigInt @GenBigInt "BigInt" "int8" unwrap eq
check @(Maybe String) @(Maybe GenString) "Maybe String" "text" (map unwrap) eq
check @(Array String) @(Array GenString) "Array String" "text[]" (map unwrap) eq
check @DateTime @GenDateTime "DateTime" "timestamptz" unwrap eq
check @String @GenJSON "JSON" "json" (writeJSON <<< unwrap) eq