Memory leak in recursive IO function - PAP : <p>I've written a library called <a href="https://hackage.haskell.org/package/amqp-worker" rel="nofollow noreferrer">amqp-worker</a> that provides a function called <code>worker</code> that polls a message queue (like <a href="https://www.rabbitmq.com/" rel="nofollow noreferrer">RabbitMQ</a>) for messages, calling a handler when a message is found. Then it goes back to polling. </p>

<p>It's leaking memory. I've profiled it and the graph says <code>PAP</code> (partial function application) is the culprit. <strong>Where is the leak in my code? How can I avoid leaks when looping in <code>IO</code> with <code>forever</code>?</strong></p>

<p><a href="https://i.stack.imgur.com/NIY2J.png" rel="nofollow noreferrer"><img src="https://i.stack.imgur.com/NIY2J.png" alt="enter image description here"></a></p>

<p>Here are some relevant functions. <a href="https://github.com/seanhess/amqp-worker" rel="nofollow noreferrer">The full source is here</a>.</p>

<p><a href="https://github.com/seanhess/amqp-worker/blob/master/test/Example.hs" rel="nofollow noreferrer">Example Program</a>. This leaks</p>

<pre><code>main :: IO ()
main = do
  -- connect
  conn &lt;- Worker.connect (fromURI "amqp://guest:guest@localhost:5672")

  -- initialize the queues
  Worker.initQueue conn queue
  Worker.initQueue conn results

  -- publish a message
  Worker.publish conn queue (TestMessage "hello world")

  -- create a worker, the program loops here
  Worker.worker def conn queue onError (onMessage conn)
</code></pre>

<p><a href="https://github.com/seanhess/amqp-worker/blob/master/src/Network/AMQP/Worker/Worker.hs#L35" rel="nofollow noreferrer">worker</a></p>

<pre><code>worker :: (FromJSON a, MonadBaseControl IO m, MonadCatch m) =&gt; WorkerOptions -&gt; Connection -&gt; Queue key a -&gt; (WorkerException SomeException -&gt; m ()) -&gt; (Message a -&gt; m ()) -&gt; m ()
worker opts conn queue onError action =
  forever $ do
    eres &lt;- consumeNext (pollDelay opts) conn queue
    case eres of
      Error (ParseError reason bd) -&gt;
        onError (MessageParseError bd reason)

      Parsed msg -&gt;
        catch
          (action msg)
          (onError . OtherException (body msg))
    liftBase $ threadDelay (loopDelay opts)
</code></pre>

<p><a href="https://github.com/seanhess/amqp-worker/blob/master/src/Network/AMQP/Worker/Message.hs#L100" rel="nofollow noreferrer">consumeNext</a></p>

<pre><code>consumeNext :: (FromJSON msg, MonadBaseControl IO m) =&gt; Microseconds -&gt; Connection -&gt; Queue key msg -&gt; m (ConsumeResult msg)
consumeNext pd conn queue =
    poll pd $ consume conn queue
</code></pre>

<p><a href="https://github.com/seanhess/amqp-worker/blob/master/src/Network/AMQP/Worker/Poll.hs#L9" rel="nofollow noreferrer">poll</a></p>

<pre><code>poll :: (MonadBaseControl IO m) =&gt; Int -&gt; m (Maybe a) -&gt; m a
poll us action = do
    ma &lt;- action
    case ma of
      Just a -&gt; return a
      Nothing -&gt; do
        liftBase $ threadDelay us
        poll us action
</code></pre>
