diff --git a/library/Hasql/Core/Batch.hs b/library/Hasql/Core/Batch.hs index 7aefa75..36e7af9 100644 --- a/library/Hasql/Core/Batch.hs +++ b/library/Hasql/Core/Batch.hs @@ -22,16 +22,16 @@ instance Applicative Batch where Batch (\_ psr -> (pure x, psr)) {-# INLINABLE (<*>) #-} (<*>) (Batch left) (Batch right) = - Batch (\idt psr -> case left idt psr of + Batch (\(!idt) (!psr) -> case left idt psr of (leftRequest, leftPsr) -> case right idt leftPsr of (rightRequest, rightPsr) -> (leftRequest <*> rightRequest, rightPsr)) statement :: A.Statement params result -> params -> Batch result statement (A.Statement template paramOIDs paramBytesBuilder1 paramBytesBuilder2 interpretResponses1 interpretResponses2 prepared) params = - Batch $ \idt psr -> + Batch $ \(!idt) (!psr) -> if prepared then case D.lookupOrRegister template paramOIDs psr of - (newOrOldName, newPsr) -> + (!newOrOldName, !newPsr) -> let request = case newOrOldName of diff --git a/profile-heap b/profile-heap index df1b73a..2d273dc 100755 --- a/profile-heap +++ b/profile-heap @@ -1,8 +1,17 @@ #!/bin/bash set -eo pipefail +function wait_till_exists { + while ! test -f "$1"; do + sleep 0.1 + done +} + cabal build profiling cd dist -build/profiling/profiling +RTS -N -hc -i0.01 -L70 -RTS +rm -f profiling.ps +rm -f profiling.hp +build/profiling/profiling +RTS -N -hr -i0.01 -L70 -RTS hp2ps -e8in -c profiling.hp +wait_till_exists "profiling.ps" open profiling.ps diff --git a/profiling/Main.hs b/profiling/Main.hs index 50c6664..928794e 100644 --- a/profiling/Main.hs +++ b/profiling/Main.hs @@ -17,8 +17,12 @@ main = do connection <- connect traceEventIO "START Session" - Right !result <- fmap force <$> A.session connection (session 10 200 100) - Right !result <- fmap force <$> A.session connection (session 200 10 100) + Right !result <- fmap force <$> A.session connection (session 50 10 100) + Right !result <- fmap force <$> A.session connection (session 50 10 100) + Right !result <- fmap force <$> A.session connection (session 10 50 100) + Right !result <- fmap force <$> A.session connection (session 50 10 100) + Right !result <- fmap force <$> A.session connection (session 10 50 100) + Right !result <- fmap force <$> A.session connection (session 10 50 100) traceEventIO "STOP Session" return ()