orion/purescript-pg
1
0
Fork 0
generated from tpl/purs
Code Issues Pull Requests Packages Projects Releases Wiki Activity

fix: test performance

Browse Source
This commit is contained in:
orion 2024-03-30 20:38:52 -05:00
parent 7520b9eb19
commit ad0e5959b8
Signed by: orion
GPG Key ID: 6D4165AE4C928719
5 changed files with 110 additions and 52 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
src/Effect.Postgres.Pool.js
View File

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

3
src/Effect.Postgres.Pool.purs
View File

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

17
test/Test.Common.purs
View File

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

91
test/Test.Data.Postgres.purs
View File

@ -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
let xs = sample seed 10 (arbitrary @x)
flip parTraverse_ xs
\x -> do
void $ exec (ser x) c
res :: Array a <- query (de x) c
res <- query (de x) c
let
exp = xa x
exp = fromArb 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
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 }

39
test/Test.Effect.Postgres.Client.purs
View File

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