fix: client, result bindings

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

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

src/Data.Postgres.Geometry.purs

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

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
 

src/Effect.Aff.Postgres.Client.js

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

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)

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)
+}

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)

src/Effect.Postgres.Result.js

@@ -0,0 +1,5 @@
+/** @type {(_: import('pg').QueryResult) => Array<unknown>} */
+export const rows = r => r.rows
+
+/** @type {(_: import('pg').QueryResult) => number | null} */
+export const rowsAffectedImpl = r => r.rowCount

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

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

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
+            quickCheck \(a /\ b /\ c :: Int /\ String /\ Array { "foo" :: String }) -> unsafePerformEffect do
-              let obj = {a, b, c}
+              let obj = { a, b, c }
               act <- smash $ serialize $ JSON obj
               pure $ asRaw (writeJSON obj) ==? act