generated from tpl/purs
feat: pool, docs
This commit is contained in:
parent
340cee4745
commit
7520b9eb19
@ -24,6 +24,7 @@ workspace:
|
||||
- nullable
|
||||
- precise-datetime
|
||||
- prelude
|
||||
- profunctor
|
||||
- record
|
||||
- simple-json
|
||||
- transformers
|
||||
|
@ -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
|
||||
|
1
src/Control.Monad.Postgres.purs
Normal file
1
src/Control.Monad.Postgres.purs
Normal file
@ -0,0 +1 @@
|
||||
module Control.Monad.Postgres where
|
@ -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
|
||||
|
||||
|
@ -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 {
|
||||
|
@ -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 }
|
||||
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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)
|
||||
|
@ -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
|
||||
|
@ -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)
|
||||
|
@ -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)
|
||||
|
7
src/Effect.Aff.Postgres.Pool.js
Normal file
7
src/Effect.Aff.Postgres.Pool.js
Normal 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()
|
37
src/Effect.Aff.Postgres.Pool.purs
Normal file
37
src/Effect.Aff.Postgres.Pool.purs
Normal 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)
|
@ -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)
|
||||
|
@ -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
|
||||
}
|
||||
|
34
src/Effect.Postgres.Pool.js
Normal file
34
src/Effect.Postgres.Pool.js
Normal 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
|
92
src/Effect.Postgres.Pool.purs
Normal file
92
src/Effect.Postgres.Pool.purs
Normal 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
|
@ -1,3 +0,0 @@
|
||||
module Effect.Postgres where
|
||||
|
||||
foreign import data Pool :: Type
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user