From ad0e5959b81f624bd081a6e2322c0ebab5174351 Mon Sep 17 00:00:00 2001 From: Orion Kindel Date: Sat, 30 Mar 2024 20:38:52 -0500 Subject: [PATCH] fix: test performance --- src/Effect.Postgres.Pool.js | 4 -- src/Effect.Postgres.Pool.purs | 3 +- test/Test.Common.purs | 17 +++-- test/Test.Data.Postgres.purs | 99 +++++++++++++++++---------- test/Test.Effect.Postgres.Client.purs | 39 +++++++++-- 5 files changed, 110 insertions(+), 52 deletions(-) diff --git a/src/Effect.Postgres.Pool.js b/src/Effect.Postgres.Pool.js index 8b128f6..185c16b 100644 --- a/src/Effect.Postgres.Pool.js +++ b/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) } diff --git a/src/Effect.Postgres.Pool.purs b/src/Effect.Postgres.Pool.purs index 877f97a..f96ee84 100644 --- a/src/Effect.Postgres.Pool.purs +++ b/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 -- | releaseClient :: Pool -> Client -> Effect Unit diff --git a/test/Test.Common.purs b/test/Test.Common.purs index 85de4e1..dfe0ad9 100644 --- a/test/Test.Common.purs +++ b/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.Postgres.Client (connected, end) +import Effect.Aff (Aff, Fiber, bracket, forkAff, joinFiber, launchAff) +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) diff --git a/test/Test.Data.Postgres.purs b/test/Test.Data.Postgres.purs index 92bb21a..f2edcc3 100644 --- a/test/Test.Data.Postgres.purs +++ b/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 purs sql xa isEq = + check + :: 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 - pure $ "insert into " <> tab <> " values (" <> x' <> " :: " <> sql <> ")" + x' <- Q.param $ fromArb x + let val = x' <> " :: " <> sql + pure $ "insert into " <> tab <> " values (" <> val <> ")" de x = Q.build do - x' <- Q.param $ xa x - pure $ "select " <> x' <> " :: " <> sql - void $ exec ("create temp table " <> tab <> " (val " <> sql <> ")") c + x' <- Q.param $ fromArb x + let val = x' <> " :: " <> sql + pure $ "select " <> val + void $ exec createtab c seed <- liftEffect randomSeed - let - xs = sample seed 20 (arbitrary @x) - void $ for xs \x -> do - void $ exec (ser x) c - res :: Array a <- query (de x) c - let - exp = xa x - 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 => FromRow a => Rep a => String -> String -> SpecT Aff Client Identity Unit - check_ purs sql = check @a @a purs sql identity eq + let xs = sample seed 10 (arbitrary @x) + flip parTraverse_ xs + \x -> do + void $ exec (ser x) c + res <- query (de x) c + let + exp = fromArb x + act = unsafePartial fromJust $ Array.head res + when (not $ isEq exp act) $ fail $ "expected " <> show exp <> " to equal " <> show act in - around withClient + around withPoolClient $ describe "Data.Postgres" $ do - check @Int @GenSmallInt "Int" "int2" unwrap eq - check_ @Int "Int" "int4" + check @Int @GenSmallInt { purs: "Int", sql: "int2", fromArb: unwrap, isEq: eq } + 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 @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 + check @String @GenJSON { purs: "JSON", sql: "json", fromArb: writeJSON <<< unwrap, isEq: eq } diff --git a/test/Test.Effect.Postgres.Client.purs b/test/Test.Effect.Postgres.Client.purs index 5700bb7..268bcfb 100644 --- a/test/Test.Effect.Postgres.Client.purs +++ b/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 - shouldEqual 1 =<< PG.Aff.Client.exec "insert into foo values (1);" c - shouldEqual 3 =<< PG.Aff.Client.exec "insert into foo values (1), (2), (3);" c - shouldEqual 4 =<< PG.Aff.Client.exec "update foo set bar = 10;" c + void $ Client.exec "create temp table foo (bar int);" c + shouldEqual 1 =<< Client.exec "insert into foo values (1);" c + shouldEqual 3 =<< Client.exec "insert into foo values (1), (2), (3);" 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")