Fix a memory leak

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

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

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