test: pool

src/Effect.Aff.Postgres.Client.purs

@@ -22,8 +22,8 @@ import Prim.Row (class Union)
 -- | 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 :: forall r missing trash. Union r missing (Config trash) => Record r -> Aff Client
-connected cfg = (voidRight <*> connect) =<< liftEffect (make cfg)
+connected cfg = (voidRight <*> connect) =<< liftEffect (make @r @missing @trash cfg)
 
 -- | Connects the client to the database
 -- |

src/Effect.Postgres.Client.purs

@@ -50,7 +50,7 @@ type Config r =
 -- | 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 :: forall @r @missing @trash. Union r missing (Config trash) => Record r -> Effect Client
 make r = do
   modifyPgTypes
   __make $ __uncfg { unwrapMillis: unwrap } $ unsafeToForeign r

src/Effect.Postgres.Pool.purs

@@ -2,12 +2,8 @@ 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)
@@ -43,19 +39,19 @@ foreign import clientWaitingCount :: Pool -> Int
 -- | 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 :: forall r missing trash. Union r missing (Config trash) => Record r -> Effect Pool
 make r = do
   modifyPgTypes
   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
+release :: Pool -> Client -> Effect Unit
-releaseClient p c = __release p c false
+release p c = __release p c false
 
 -- | <https://node-postgres.com/apis/pool#releasing-clients>
-destroyClient :: Pool -> Client -> Effect Unit
+destroy :: Pool -> Client -> Effect Unit
-destroyClient p c = __release p c true
+destroy p c = __release p c true
 
 -- | <https://node-postgres.com/apis/pool#connect>
 connectE :: EventHandle1 Pool Client
@@ -74,8 +70,8 @@ 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 Pool (Client -> Effect Unit) (EffectFn2 Foreign Client Unit)
-releaseE = EventHandle "release" (mkEffectFn2 <<< lcmap Nullable.toMaybe)
+releaseE = EventHandle "release" (mkEffectFn2 <<< const)
 
 -- | FFI type for `import('pg').PoolConfig`
 foreign import data PoolConfigRaw :: Type

test/Test.Common.purs

@@ -3,7 +3,7 @@ module Test.Common where
 import Prelude
 
 import Effect (Effect)
-import Effect.Aff (Aff, Fiber, bracket, forkAff, joinFiber, launchAff)
+import Effect.Aff (Aff, bracket)
 import Effect.Aff.Postgres.Client (Client)
 import Effect.Aff.Postgres.Client as Client
 import Effect.Aff.Postgres.Pool (Pool)
@@ -12,6 +12,8 @@ import Effect.Class (liftEffect)
 import Effect.Unsafe (unsafePerformEffect)
 import Node.Path as Path
 import Node.Process (cwd)
+import Record (insert)
+import Type.Prelude (Proxy(..))
 
 config
   :: Effect
@@ -19,11 +21,12 @@ config
        , host :: String
        , password :: String
        , user :: String
+       , max :: Int
        }
 config = do
   cwd' <- liftEffect cwd
   host <- liftEffect $ Path.resolve [ cwd' ] "./pg"
-  pure { host, user: "postgres", password: "password", database: "postgres" }
+  pure { host, user: "postgres", password: "password", database: "postgres", max: 3 }
 
 withClient :: (Client -> Aff Unit) -> Aff Unit
 withClient = bracket (Client.connected =<< liftEffect config) Client.end
@@ -31,5 +34,8 @@ withClient = bracket (Client.connected =<< liftEffect config) Client.end
 pool :: Pool
 pool = unsafePerformEffect $ Pool.make =<< liftEffect config
 
+withPool :: (Pool -> Aff Unit) -> Aff Unit
+withPool = bracket (liftEffect $ Pool.make =<< config) Pool.end
+
 withPoolClient :: (Client -> Aff Unit) -> Aff Unit
-withPoolClient = bracket (Pool.connect pool) (liftEffect <<< Pool.releaseClient pool)
+withPoolClient = bracket (Pool.connect pool) (liftEffect <<< Pool.release pool)

test/Test.Effect.Postgres.Client.purs

@@ -16,6 +16,7 @@ import Effect.Exception as Error
 import Effect.Uncurried (EffectFn1)
 import Node.EventEmitter (EventHandle, once)
 import Test.Common (withClient)
+import Test.Event (onceAff)
 import Test.Spec (Spec, around, describe, it)
 import Test.Spec.Assertions (shouldEqual)
 
@@ -24,24 +25,23 @@ 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
+          expect <- forkAff $ onceAff Client.endE c
           Client.end c
-          void $ joinFiber endEvent
+          joinFiber expect
         it "notice" \c -> do
-          noticeEvent <- forkAff $ once_ Client.noticeE c
+          expect <- forkAff do
+            e <- onceAff Client.noticeE c
+            Error.message e `shouldEqual` "hello"
           void $ Client.exec "do language plpgsql $$ begin raise notice 'hello'; end; $$;" c
-          e <- joinFiber noticeEvent
+          joinFiber expect
-          Error.message e `shouldEqual` "hello"
         it "notification" \c -> do
           void $ Client.exec "listen hello;" c
-          notifEvent <- forkAff $ once_ Client.notificationE c
+          expect <- forkAff do
+            n <- onceAff Client.notificationE c
+            n.payload `shouldEqual` (Just "world")
           void $ Client.exec "notify hello, 'world';" c
-          n <- joinFiber notifEvent
+          joinFiber expect
-          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

test/Test.Effect.Postgres.Pool.js

@@ -0,0 +1,2 @@
+/** @type {(a: unknown) => (b: unknown) => boolean} */
+export const refEq = a => b => a === b

test/Test.Effect.Postgres.Pool.purs

@@ -0,0 +1,98 @@
+module Test.Effect.Postgres.Pool where
+
+import Prelude
+
+import Data.Traversable (traverse)
+import Effect.Aff (finally, forkAff, joinFiber)
+import Effect.Aff.Postgres.Client as Client
+import Effect.Aff.Postgres.Pool as Pool
+import Effect.Class (liftEffect)
+import Test.Common (config, withPool)
+import Test.Event (onceAff)
+import Test.Spec (Spec, around, describe, it)
+import Test.Spec.Assertions (expectError, shouldEqual)
+
+foreign import refEq :: forall a. a -> a -> Boolean
+
+spec :: Spec Unit
+spec = describe "Pool" do
+  it "make" do
+    cfg <- liftEffect config
+    void $ liftEffect $ Pool.make cfg
+  around withPool do
+    it "idleCount, totalCount" \p -> do
+      a <- Pool.connect p
+      b <- Pool.connect p
+      c <- Pool.connect p
+      liftEffect $ Pool.release p a
+      liftEffect $ Pool.release p b
+      finally (liftEffect $ Pool.release p c) do
+        Pool.clientIdleCount p `shouldEqual` 2
+        Pool.clientCount p `shouldEqual` 3
+      Pool.clientIdleCount p `shouldEqual` 3
+      Pool.clientCount p `shouldEqual` 3
+    it "waitingCount" \p -> do
+      a <- Pool.connect p
+      b <- Pool.connect p
+      c <- Pool.connect p
+      dFiber <- forkAff $ Pool.connect p
+      let
+        rel =
+          do
+            void $ liftEffect $ traverse (Pool.release p) [ a, b, c ]
+            d <- joinFiber dFiber
+            liftEffect $ Pool.release p d
+      finally rel $ Pool.clientWaitingCount p `shouldEqual` 1
+    describe "events" do
+      it "connect" \p -> do
+        expect <- forkAff $ void $ onceAff Pool.connectE p
+        c <- Pool.connect p
+        finally (liftEffect $ Pool.release p c) $ joinFiber expect
+      it "acquire" \p -> do
+        c <- Pool.connect p
+        liftEffect $ Pool.release p c
+        expect <- forkAff do
+          c'' <- onceAff Pool.acquireE p
+          refEq c c'' `shouldEqual` true
+        c' <- Pool.connect p
+        finally (liftEffect $ Pool.release p c') $ joinFiber expect
+      it "release" \p -> do
+        c <- Pool.connect p
+        expect <- forkAff do
+          c' <- onceAff Pool.releaseE p
+          refEq c c' `shouldEqual` true
+        liftEffect $ Pool.release p c
+        joinFiber expect
+      it "remove" \p -> do
+        c <- Pool.connect p
+        expect <- forkAff do
+          c' <- onceAff Pool.removeE p
+          refEq c c' `shouldEqual` true
+        liftEffect $ Pool.destroy p c
+        joinFiber expect
+    it "connect" \p -> do
+      c <- Pool.connect p
+      let rel = liftEffect $ Pool.release p c
+      finally rel $ shouldEqual [ 1 ] =<< Client.query "select 1" c
+    describe "destroy" do
+      it "throws on query after destroy" \p -> do
+        c <- Pool.connect p
+        liftEffect $ Pool.destroy p c
+        expectError $ Client.exec "select 1" c
+      it "different client yielded after destroy" \p -> do
+        a <- Pool.connect p
+        liftEffect $ Pool.destroy p a
+        b <- Pool.connect p
+        liftEffect $ Pool.destroy p b
+        refEq a b `shouldEqual` false
+    describe "release" do
+      it "allows reuse" \p -> do
+        a <- Pool.connect p
+        liftEffect $ Pool.release p a
+        b <- Pool.connect p
+        liftEffect $ Pool.release p b
+        refEq a b `shouldEqual` true
+      it "throws when invoked twice" \p -> do
+        c <- Pool.connect p
+        liftEffect $ Pool.release p c
+        expectError $ liftEffect $ Pool.release p c

test/Test.Event.purs

@@ -0,0 +1,29 @@
+module Test.Event where
+
+import Prelude
+
+import Data.Either (Either(..))
+import Data.Profunctor (lcmap)
+import Data.Tuple.Nested (type (/\), uncurry2, (/\))
+import Effect (Effect)
+import Effect.Aff (Aff, makeAff)
+import Node.EventEmitter (EventHandle(..))
+import Node.EventEmitter as EE
+
+class Curried a b | a -> b where
+  curried :: (b -> Effect Unit) -> a
+
+instance Curried (Effect Unit) Unit where
+  curried f = f unit
+
+instance Curried (a -> Effect Unit) a where
+  curried = identity
+
+instance Curried (a -> b -> Effect Unit) (a /\ b) where
+  curried f = \a b -> f $ a /\ b
+
+instance Curried (a -> b -> c -> Effect Unit) (a /\ b /\ c) where
+  curried f = \a b c -> f $ a /\ b /\ c
+
+onceAff :: forall psCb jsCb emitter r. Curried psCb r => EventHandle emitter psCb jsCb -> emitter -> Aff r
+onceAff ev em = makeAff \res -> mempty <* EE.once ev (curried (res <<< Right)) em

test/Test.Main.purs

@@ -22,6 +22,7 @@ import Node.Encoding (Encoding(..))
 import Node.EventEmitter as Event
 import Test.Data.Postgres as Test.Data.Postgres
 import Test.Effect.Postgres.Client as Test.Effect.Postgres.Client
+import Test.Effect.Postgres.Pool as Test.Effect.Postgres.Pool
 import Test.Spec.Reporter (specReporter)
 import Test.Spec.Runner (runSpec)
 
@@ -62,3 +63,4 @@ main = launchAff_ do
     $ runSpec [ specReporter ] do
         Test.Data.Postgres.spec
         Test.Effect.Postgres.Client.spec
+        Test.Effect.Postgres.Pool.spec