From 69d7bae8bee3ece5db9d18fbda8af99133444966 Mon Sep 17 00:00:00 2001
From: Nikita Volkov <nikita.y.volkov@mail.ru>
Date: Tue, 17 Oct 2017 16:00:28 +0200
Subject: [PATCH 1/3] Spot the issue

---
 profile-heap      | 5 ++++-
 profiling/Main.hs | 8 ++++++--
 2 files changed, 10 insertions(+), 3 deletions(-)

diff --git a/profile-heap b/profile-heap
index df1b73a..0561976 100755
--- a/profile-heap
+++ b/profile-heap
@@ -3,6 +3,9 @@ set -eo pipefail
 
 cabal build profiling
 cd dist
-build/profiling/profiling +RTS -N -hc -i0.01 -L70 -RTS
+rm profiling.ps
+rm profiling.hp
+build/profiling/profiling +RTS -N -hr -i0.01 -L70 -RTS
 hp2ps -e8in -c profiling.hp
+sleep 0.5
 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 ()
 

From 1ca56a60994dce6559da739e0d029ffec831a382 Mon Sep 17 00:00:00 2001
From: Nikita Volkov <nikita.y.volkov@mail.ru>
Date: Tue, 17 Oct 2017 16:22:25 +0200
Subject: [PATCH 2/3] Update the script

---
 profile-heap | 12 +++++++++---
 1 file changed, 9 insertions(+), 3 deletions(-)

diff --git a/profile-heap b/profile-heap
index 0561976..2d273dc 100755
--- a/profile-heap
+++ b/profile-heap
@@ -1,11 +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
-rm profiling.ps
-rm profiling.hp
+rm -f profiling.ps
+rm -f profiling.hp
 build/profiling/profiling +RTS -N -hr -i0.01 -L70 -RTS
 hp2ps -e8in -c profiling.hp
-sleep 0.5
+wait_till_exists "profiling.ps"
 open profiling.ps

From 45acfd9fd14d372a92427cd2bfc56feea8ab5142 Mon Sep 17 00:00:00 2001
From: Nikita Volkov <nikita.y.volkov@mail.ru>
Date: Thu, 19 Oct 2017 11:16:36 +0200
Subject: [PATCH 3/3] Fix the leak

---
 library/Hasql/Core/Batch.hs | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

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