From d7916683d7f6c3952ca2b0c5042bc194fcc9a47d Mon Sep 17 00:00:00 2001 From: Orion Kindel Date: Wed, 27 Mar 2024 13:32:17 -0500 Subject: [PATCH] fix: client, result bindings --- spago.lock | 24 ++++++++++ spago.yaml | 3 ++ src/Data.Postgres.Geometry.purs | 23 ---------- src/Data.Postgres.purs | 12 +++++ src/Effect.Aff.Postgres.Client.js | 8 ++++ src/Effect.Aff.Postgres.Client.purs | 55 +++++++++++++++++++++++ src/Effect.Postgres.Client.js | 23 ++++++++++ src/Effect.Postgres.Client.purs | 70 +++++++++++++++++++++++++++++ src/Effect.Postgres.Result.js | 5 +++ src/Effect.Postgres.Result.purs | 17 +++++++ src/Effect.Postgres.purs | 5 ++- test/Test.Data.Postgres.purs | 8 ++-- 12 files changed, 225 insertions(+), 28 deletions(-) delete mode 100644 src/Data.Postgres.Geometry.purs create mode 100644 src/Effect.Aff.Postgres.Client.js create mode 100644 src/Effect.Aff.Postgres.Client.purs create mode 100644 src/Effect.Postgres.Client.js create mode 100644 src/Effect.Postgres.Client.purs create mode 100644 src/Effect.Postgres.Result.js create mode 100644 src/Effect.Postgres.Result.purs diff --git a/spago.lock b/spago.lock index d50ce4f..e426ff7 100644 --- a/spago.lock +++ b/spago.lock @@ -3,6 +3,7 @@ workspace: pg: path: ./ dependencies: + - aff-promise - bifunctors - control - datetime @@ -15,6 +16,8 @@ workspace: - mmorph - newtype - node-buffer + - node-event-emitter + - nullable - precise-datetime - prelude - simple-json @@ -27,6 +30,7 @@ workspace: - spec-quickcheck build_plan: - aff + - aff-promise - ansi - arraybuffer-types - arrays @@ -66,6 +70,7 @@ workspace: - mmorph - newtype - node-buffer + - node-event-emitter - nonempty - now - nullable @@ -122,6 +127,13 @@ packages: - tailrec - transformers - unsafe-coerce + aff-promise: + type: registry + version: 4.0.0 + integrity: sha256-Kq5EupbUpXeUXx4JqGQE7/RTTz/H6idzWhsocwlEFhM= + dependencies: + - aff + - foreign ansi: type: registry version: 7.0.0 @@ -540,6 +552,18 @@ packages: - nullable - st - unsafe-coerce + node-event-emitter: + type: registry + version: 3.0.0 + integrity: sha256-Qw0MjsT4xRH2j2i4K8JmRjcMKnH5z1Cw39t00q4LE4w= + dependencies: + - effect + - either + - functions + - maybe + - nullable + - prelude + - unsafe-coerce nonempty: type: registry version: 7.0.0 diff --git a/spago.yaml b/spago.yaml index 6ecf5b9..9d3ef98 100644 --- a/spago.yaml +++ b/spago.yaml @@ -4,6 +4,7 @@ package: strict: true pedantic_packages: true dependencies: + - aff-promise - bifunctors - control - datetime @@ -16,6 +17,8 @@ package: - mmorph - newtype - node-buffer + - node-event-emitter + - nullable - precise-datetime - prelude - simple-json diff --git a/src/Data.Postgres.Geometry.purs b/src/Data.Postgres.Geometry.purs deleted file mode 100644 index f37de52..0000000 --- a/src/Data.Postgres.Geometry.purs +++ /dev/null @@ -1,23 +0,0 @@ -module Data.Postgres.Geometry where - -import Prelude - -import Data.Generic.Rep (class Generic) -import Data.Newtype (class Newtype) -import Data.Show.Generic (genericShow) - -newtype Point = Point { x :: Number, y :: Number } - -derive instance Newtype Point _ -derive instance Generic Point _ -derive instance Eq Point -instance Show Point where - show = genericShow - -newtype Circle = Circle { center :: Point, radius :: Number } - -derive instance Newtype Circle _ -derive instance Generic Circle _ -derive instance Eq Circle -instance Show Circle where - show = genericShow diff --git a/src/Data.Postgres.purs b/src/Data.Postgres.purs index 1ddf643..f3749ec 100644 --- a/src/Data.Postgres.purs +++ b/src/Data.Postgres.purs @@ -72,6 +72,10 @@ unsafeSerializeCoerce = pure <<< Raw.unsafeFromForeign <<< F.unsafeToForeign instance Serialize Raw where serialize = pure +-- | Serializes as `Null`. +instance Serialize Unit where + serialize _ = serialize Null + instance Serialize Null where serialize _ = unsafeSerializeCoerce null_ @@ -110,6 +114,14 @@ instance Serialize a => Serialize (Array a) where instance Deserialize Raw where deserialize = pure +-- | Note: this will always succeed, discarding +-- | the actual raw value yielded. +-- | +-- | To explicitly deserialize NULL values and fail +-- | when the value is non-null, use `Null`. +instance Deserialize Unit where + deserialize _ = pure unit + instance Deserialize Null where deserialize = map (const Null) <<< F.readNullOrUndefined <<< Raw.unsafeToForeign diff --git a/src/Effect.Aff.Postgres.Client.js b/src/Effect.Aff.Postgres.Client.js new file mode 100644 index 0000000..6ce2384 --- /dev/null +++ b/src/Effect.Aff.Postgres.Client.js @@ -0,0 +1,8 @@ +/** @type {(c: import('pg').Client) => () => Promise} */ +export const connectImpl = c => () => c.connect() + +/** @type {(c: import('pg').Client) => () => Promise} */ +export const endImpl = c => () => c.end() + +/** @type {(q: import('pg').QueryConfig) => (c: import('pg').Client) => () => Promise} */ +export const queryImpl = q => c => () => c.query(q) diff --git a/src/Effect.Aff.Postgres.Client.purs b/src/Effect.Aff.Postgres.Client.purs new file mode 100644 index 0000000..1f7499d --- /dev/null +++ b/src/Effect.Aff.Postgres.Client.purs @@ -0,0 +1,55 @@ +module Effect.Aff.Postgres.Client where + +import Prelude + +import Control.Promise (Promise) +import Control.Promise as Promise +import Data.Maybe (Maybe(..)) +import Data.Nullable (Nullable, toNullable) +import Data.Postgres.Raw (Raw) +import Data.Tuple.Nested (type (/\), (/\)) +import Effect (Effect) +import Effect.Aff (Aff) +import Effect.Postgres.Client (Client) +import Effect.Postgres.Result (Result) +import Record (insert, modify) +import Type.Prelude (Proxy(..)) + +type QueryRaw = { text :: String, values :: Array Raw, name :: Nullable String, rowMode :: String } + +foreign import connectImpl :: Client -> Effect (Promise Unit) +foreign import endImpl :: Client -> Effect (Promise Unit) +foreign import queryImpl :: QueryRaw -> Client -> Effect (Promise Result) + +newtype Query = Query { text :: String, values :: Array Raw, name :: Maybe String } + +queryToRaw :: Query -> QueryRaw +queryToRaw (Query r) = + let + name = Proxy @"name" + rowMode = Proxy @"rowMode" + in + insert rowMode "array" + $ modify name toNullable + $ r + +class AsQuery a where + asQuery :: a -> Query + +instance AsQuery Query where + asQuery = identity + +instance AsQuery String where + asQuery text = Query { text, values: [], name: Nothing } + +instance AsQuery (String /\ Array Raw) where + asQuery (text /\ values) = Query { text, values, name: Nothing } + +connect :: Client -> Aff Unit +connect = Promise.toAffE <<< connectImpl + +end :: Client -> Aff Unit +end = Promise.toAffE <<< endImpl + +query :: forall q. AsQuery q => q -> Client -> Aff Result +query q = Promise.toAffE <<< queryImpl (queryToRaw $ asQuery q) diff --git a/src/Effect.Postgres.Client.js b/src/Effect.Postgres.Client.js new file mode 100644 index 0000000..97646e9 --- /dev/null +++ b/src/Effect.Postgres.Client.js @@ -0,0 +1,23 @@ +import {Client} from 'pg' + +/** @typedef {{statementTimeout: unknown, queryTimeout: unknown, idleInTransactionTimeout: unknown, connectionTimeout: unknown, applicationName: string}} ClientConfigExtra */ + +/** @type {(_: {unwrapMillis: (_m: unknown) => number}) => (cfg: import('pg').ClientConfig & ClientConfigExtra) => () => Client} */ +export const makeImpl = ({unwrapMillis}) => cfg => () => { + if ('statementTimeout' in cfg) { + cfg.statement_timeout = unwrapMillis(cfg.statementTimeout) + } + if ('queryTimeout' in cfg) { + cfg.query_timeout = unwrapMillis(cfg.queryTimeout) + } + if ('idleInTransactionTimeout' in cfg) { + cfg.idle_in_transaction_session_timeout = unwrapMillis(cfg.idleInTransactionTimeout) + } + if ('connectionTimeout' in cfg) { + cfg.connectionTimeoutMillis = unwrapMillis(cfg.connectionTimeout) + } + if ('applicationName' in cfg) { + cfg.application_name = cfg.applicationName + } + return new Client(cfg) +} diff --git a/src/Effect.Postgres.Client.purs b/src/Effect.Postgres.Client.purs new file mode 100644 index 0000000..1ece197 --- /dev/null +++ b/src/Effect.Postgres.Client.purs @@ -0,0 +1,70 @@ +module Effect.Postgres.Client 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.Time.Duration (Milliseconds) +import Effect (Effect) +import Effect.Exception (Error) +import Effect.Uncurried (EffectFn1, mkEffectFn1) +import Foreign (Foreign, unsafeToForeign) +import Node.EventEmitter (EventHandle(..)) +import Node.EventEmitter.UtilTypes (EventHandle1, EventHandle0) +import Prim.Row (class Union) +import Record (modify) +import Type.Prelude (Proxy(..)) + +foreign import data Client :: Type +foreign import makeImpl :: { unwrapMillis :: Milliseconds -> Number } -> Foreign -> Effect Client + +type Notification = + { processId :: Number + , channel :: String + , payload :: Maybe String + } + +type NotificationRaw = + { processId :: Number + , channel :: String + , payload :: Nullable String + } + +type Config r = + ( user :: String + , password :: String + , host :: String + , port :: Number + , database :: String + , connectionString :: String + , applicationName :: String + , statementTimeout :: Milliseconds + , queryTimeout :: Milliseconds + , connectionTimeout :: Milliseconds + , idleInTransactionTimeout :: Milliseconds + | r + ) + +make :: forall r trash. Union r trash (Config ()) => Record r -> Effect Client +make r = do + modifyPgTypes + makeImpl { unwrapMillis: unwrap } $ unsafeToForeign r + +error :: EventHandle1 Client Error +error = EventHandle "end" mkEffectFn1 + +notice :: EventHandle1 Client Error +notice = EventHandle "notice" mkEffectFn1 + +end :: EventHandle0 Client +end = EventHandle "end" identity + +notification :: EventHandle Client (Notification -> Effect Unit) (EffectFn1 NotificationRaw Unit) +notification = + let + payload = Proxy @"payload" + in + EventHandle "notification" (\f -> mkEffectFn1 $ f <<< modify payload Nullable.toMaybe) diff --git a/src/Effect.Postgres.Result.js b/src/Effect.Postgres.Result.js new file mode 100644 index 0000000..2ded8fe --- /dev/null +++ b/src/Effect.Postgres.Result.js @@ -0,0 +1,5 @@ +/** @type {(_: import('pg').QueryResult) => Array} */ +export const rows = r => r.rows + +/** @type {(_: import('pg').QueryResult) => number | null} */ +export const rowsAffectedImpl = r => r.rowCount diff --git a/src/Effect.Postgres.Result.purs b/src/Effect.Postgres.Result.purs new file mode 100644 index 0000000..5666907 --- /dev/null +++ b/src/Effect.Postgres.Result.purs @@ -0,0 +1,17 @@ +module Effect.Postgres.Result where + +import Prelude + +import Data.Int as Int +import Data.Maybe (Maybe) +import Data.Nullable (Nullable) +import Data.Nullable as Nullable +import Data.Postgres.Raw (Raw) + +foreign import data Result :: Type + +foreign import rowsAffectedImpl :: Result -> Nullable Number +foreign import rows :: Result -> Array (Array Raw) + +rowsAffected :: Result -> Maybe Int +rowsAffected = Int.fromNumber <=< Nullable.toMaybe <<< rowsAffectedImpl diff --git a/src/Effect.Postgres.purs b/src/Effect.Postgres.purs index 81762a7..f6ef42b 100644 --- a/src/Effect.Postgres.purs +++ b/src/Effect.Postgres.purs @@ -1,4 +1,7 @@ -module Effect.Pg where +module Effect.Postgres where import Prelude +import Data.Time.Duration (Milliseconds) + +foreign import data Pool :: Type diff --git a/test/Test.Data.Postgres.purs b/test/Test.Data.Postgres.purs index 5a0a36f..4432895 100644 --- a/test/Test.Data.Postgres.purs +++ b/test/Test.Data.Postgres.purs @@ -59,15 +59,15 @@ spec = describe "JSON" do describe "Record" do it "deserialize" $ - quickCheck \(a /\ b /\ c :: Int /\ String /\ Array {"foo" :: String}) -> unsafePerformEffect do + quickCheck \(a /\ b /\ c :: Int /\ String /\ Array { "foo" :: String }) -> unsafePerformEffect do let - obj = {a, b, c} + obj = { a, b, c } json = writeJSON obj act :: JSON _ <- smash $ deserialize $ asRaw json pure $ obj ==? unwrap act it "serialize" $ - quickCheck \(a /\ b /\ c :: Int /\ String /\ Array {"foo" :: String}) -> unsafePerformEffect do - let obj = {a, b, c} + quickCheck \(a /\ b /\ c :: Int /\ String /\ Array { "foo" :: String }) -> unsafePerformEffect do + let obj = { a, b, c } act <- smash $ serialize $ JSON obj pure $ asRaw (writeJSON obj) ==? act