fix: test performance

src/Effect.Postgres.Pool.js

@@ -1,15 +1,11 @@
 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)
     }

src/Effect.Postgres.Pool.purs

@@ -46,7 +46,8 @@ foreign import clientWaitingCount :: Pool -> Int
 make :: forall r omitted. Union r omitted (Config ()) => Record r -> Effect Pool
 make r = do
   modifyPgTypes
-  __make $ __uncfg { unwrapMillis: unwrap } $ unsafeToForeign r
+  let asClientConfig = Client.__uncfg { unwrapMillis: unwrap } $ unsafeToForeign r
+  __make $ __uncfg { unwrapMillis: unwrap } $ unsafeToForeign asClientConfig
 
 -- | <https://node-postgres.com/apis/pool#releasing-clients>
 releaseClient :: Pool -> Client -> Effect Unit

test/Test.Common.purs

@@ -3,10 +3,13 @@ module Test.Common where
 import Prelude
 
 import Effect (Effect)
-import Effect.Aff (Aff, bracket)
+import Effect.Aff (Aff, Fiber, bracket, forkAff, joinFiber, launchAff)
-import Effect.Aff.Postgres.Client (connected, end)
+import Effect.Aff.Postgres.Client (Client)
+import Effect.Aff.Postgres.Client as Client
+import Effect.Aff.Postgres.Pool (Pool)
+import Effect.Aff.Postgres.Pool as Pool
 import Effect.Class (liftEffect)
-import Effect.Postgres.Client (Client)
+import Effect.Unsafe (unsafePerformEffect)
 import Node.Path as Path
 import Node.Process (cwd)
 
@@ -23,4 +26,10 @@ config = do
   pure { host, user: "postgres", password: "password", database: "postgres" }
 
 withClient :: (Client -> Aff Unit) -> Aff Unit
-withClient = bracket (connected =<< liftEffect config) end
+withClient = bracket (Client.connected =<< liftEffect config) Client.end
+
+pool :: Pool
+pool = unsafePerformEffect $ Pool.make =<< liftEffect config
+
+withPoolClient :: (Client -> Aff Unit) -> Aff Unit
+withPoolClient = bracket (Pool.connect pool) (liftEffect <<< Pool.releaseClient pool)

test/Test.Data.Postgres.purs

@@ -3,6 +3,8 @@ module Test.Data.Postgres where
 import Prelude
 
 import Control.Monad.Gen (chooseInt, elements, oneOf)
+import Control.Parallel (parTraverse_)
+import Data.Array (intercalate)
 import Data.Array as Array
 import Data.Array.NonEmpty as Array.NonEmpty
 import Data.DateTime (DateTime(..), canonicalDate)
@@ -38,10 +40,10 @@ import Node.Buffer (Buffer)
 import Node.Buffer as Buffer
 import Partial.Unsafe (unsafePartial)
 import Simple.JSON (writeJSON)
-import Test.Common (withClient)
+import Test.Common (withClient, withPoolClient)
 import Test.QuickCheck (class Arbitrary, arbitrary, randomSeed)
 import Test.QuickCheck.Gen (sample, vectorOf)
-import Test.Spec (Spec, SpecT, around, describe, it)
+import Test.Spec (Spec, SpecT, around, describe, it, parallel)
 import Test.Spec.Assertions (fail)
 
 foreign import readBigInt64BE :: Buffer -> Effect BigInt
@@ -133,52 +135,77 @@ instance Arbitrary GenJSON where
 asRaw :: forall a. a -> Raw
 asRaw = Raw.unsafeFromForeign <<< unsafeToForeign
 
+type PursType = String
+type SQLType = String
+type FromArbitrary x a = x -> a
+type IsEqual a = a -> a -> Boolean
+
+class (Show a, FromRow a, Rep a) <= Checkable a
+
+instance (Show a, FromRow a, Rep a) => Checkable a
+
 spec :: Spec Unit
 spec =
   let
-    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
-    check purs sql xa isEq =
+      :: forall @a @x
+       . Checkable a
+      => Arbitrary x
+      => { purs :: String
+         , sql :: String
+         , fromArb :: x -> a
+         , isEq :: a -> a -> Boolean
+         }
+      -> SpecT Aff Client Identity Unit
+    check { purs, sql, fromArb, 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
+          tab =
+            String.replace (wrap " ") (wrap "_")
+              $ String.replace (wrap "[") (wrap "")
+              $ String.replace (wrap "]") (wrap "")
+              $ sql <> "_is_" <> String.toLower purs
+          createtab =
+            intercalate "\n"
+              [ "create temp table " <> tab
+              , "  ( val " <> sql
+              , "  );"
+              ]
           ser x =
             Q.build do
-              x' <- Q.param $ xa x
+              x' <- Q.param $ fromArb x
-              pure $ "insert into " <> tab <> " values (" <> x' <> " :: " <> sql <> ")"
+              let val = x' <> " :: " <> sql
+              pure $ "insert into " <> tab <> " values (" <> val <> ")"
           de x =
             Q.build do
-              x' <- Q.param $ xa x
+              x' <- Q.param $ fromArb x
-              pure $ "select " <> x' <> " :: " <> sql
+              let val = x' <> " :: " <> sql
-        void $ exec ("create temp table " <> tab <> " (val " <> sql <> ")") c
+              pure $ "select " <> val
+        void $ exec createtab c
         seed <- liftEffect randomSeed
-        let
+        let xs = sample seed 10 (arbitrary @x)
-          xs = sample seed 20 (arbitrary @x)
+        flip parTraverse_ xs
-        void $ for xs \x -> do
+          \x -> do
-          void $ exec (ser x) c
+            void $ exec (ser x) c
-          res :: Array a <- query (de x) c
+            res <- query (de x) c
-          let
+            let
-            exp = xa x
+              exp = fromArb x
-            act = unsafePartial fromJust $ Array.head res
+              act = unsafePartial fromJust $ Array.head res
-          when (not $ isEq exp act) $ fail $ "expected " <> show exp <> " to equal " <> show act
+            when (not $ isEq exp act) $ fail $ "expected " <> show exp <> " to equal " <> show act
-
-    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
+    around withPoolClient
       $ describe "Data.Postgres"
       $ do
-          check @Int @GenSmallInt "Int" "int2" unwrap eq
+          check @Int @GenSmallInt { purs: "Int", sql: "int2", fromArb: unwrap, isEq: eq }
-          check_ @Int "Int" "int4"
+          check @Int { purs: "Int", sql: "int4", fromArb: identity, isEq: eq }
+          check @String @GenString { purs: "String", sql: "text", fromArb: unwrap, isEq: eq }
+          check @Boolean { purs: "Boolean", sql: "bool", fromArb: identity, isEq: eq }
+          check @Number @GenSmallFloat { purs: "Number", sql: "float4", fromArb: unwrap, isEq: \a b -> Number.abs (a - b) <= 0.0001 }
+          check @Number { purs: "Number", sql: "float8", fromArb: identity, isEq: eq }
+          check @BigInt @GenBigInt { purs: "BigInt", sql: "int8", fromArb: unwrap, isEq: eq }
+          check @DateTime @GenDateTime { purs: "DateTime", sql: "timestamptz", fromArb: unwrap, isEq: eq }
 
-          check @String @GenString "String" "text" unwrap eq
+          check @(Maybe String) @(Maybe GenString) { purs: "Maybe String", sql: "text", fromArb: map unwrap, isEq: eq }
+          check @(Array String) @(Array GenString) { purs: "Array String", sql: "text[]", fromArb: map unwrap, isEq: eq }
 
-          check_ @Boolean "Boolean" "bool"
+          check @String @GenJSON { purs: "JSON", sql: "json", fromArb: writeJSON <<< unwrap, isEq: eq }
-
-          check @Number @GenSmallFloat "Number" "float4" unwrap (\a b -> Number.abs (a - b) <= 0.0001)
-          check_ @Number "Number" "float8"
-
-          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

test/Test.Effect.Postgres.Client.purs

@@ -3,12 +3,18 @@ module Test.Effect.Postgres.Client where
 import Prelude
 
 import Control.Monad.Error.Class (try)
-import Data.Either (Either, isLeft)
+import Data.Either (Either(..), isLeft)
+import Data.Maybe (Maybe(..))
 import Data.Newtype (wrap)
 import Data.Postgres (JSON(..))
 import Data.PreciseDateTime (fromRFC3339String, toDateTimeLossy)
+import Effect (Effect)
+import Effect.Aff (Aff, forkAff, joinFiber, makeAff)
 import Effect.Aff.Postgres.Client (query)
-import Effect.Aff.Postgres.Client as PG.Aff.Client
+import Effect.Aff.Postgres.Client as Client
+import Effect.Exception as Error
+import Effect.Uncurried (EffectFn1)
+import Node.EventEmitter (EventHandle, once)
 import Test.Common (withClient)
 import Test.Spec (Spec, around, describe, it)
 import Test.Spec.Assertions (shouldEqual)
@@ -17,18 +23,37 @@ spec :: Spec Unit
 spec =
   around withClient do
     describe "Client" do
+      describe "events" do
+        let
+          once_ :: forall a b. EventHandle Client.Client (a -> Effect Unit) (EffectFn1 b Unit) -> Client.Client -> Aff a
+          once_ e c = makeAff \res -> mempty <$ once e (res <<< Right) c
+        it "end" \c -> do
+          endEvent <- forkAff $ makeAff \res -> mempty <$ once Client.endE (res $ Right unit) c
+          Client.end c
+          void $ joinFiber endEvent
+        it "notice" \c -> do
+          noticeEvent <- forkAff $ once_ Client.noticeE c
+          void $ Client.exec "do language plpgsql $$ begin raise notice 'hello'; end; $$;" c
+          e <- joinFiber noticeEvent
+          Error.message e `shouldEqual` "hello"
+        it "notification" \c -> do
+          void $ Client.exec "listen hello;" c
+          notifEvent <- forkAff $ once_ Client.notificationE c
+          void $ Client.exec "notify hello, 'world';" c
+          n <- joinFiber notifEvent
+          n.payload `shouldEqual` (Just "world")
       it "connect & end do not throw" $ const $ pure unit
       describe "query" do
         it "ok if connected" \c -> shouldEqual [ 1, 2, 3 ] =<< query "select unnest(array[1, 2, 3])" c
         it "throws if ended" \c -> do
-          PG.Aff.Client.end c
+          Client.end c
           res :: Either _ (Array Int) <- try $ query "select 1" c
           isLeft res `shouldEqual` true
         it "rowsAffected is correct" \c -> do
-          void $ PG.Aff.Client.exec "create temp table foo (bar int);" c
+          void $ Client.exec "create temp table foo (bar int);" c
-          shouldEqual 1 =<< PG.Aff.Client.exec "insert into foo values (1);" c
+          shouldEqual 1 =<< Client.exec "insert into foo values (1);" c
-          shouldEqual 3 =<< PG.Aff.Client.exec "insert into foo values (1), (2), (3);" c
+          shouldEqual 3 =<< Client.exec "insert into foo values (1), (2), (3);" c
-          shouldEqual 4 =<< PG.Aff.Client.exec "update foo set bar = 10;" c
+          shouldEqual 4 =<< Client.exec "update foo set bar = 10;" c
         describe "timestamp" do
           it "unmarshals" \c -> do
             let exp = toDateTimeLossy <$> fromRFC3339String (wrap "2020-01-01T00:00:00Z")