Conduits - multiple "attempts" into one Source

Question

I am trying to do the following:

sourceIRC
  :: (MonadBaseControl IO m, MonadLogger m)
  => NetworkSettings
  -> Producer (ConnectionT m) Message
sourceIRC networkSettings = do
  withConnectionForever networkSettings $ \socket -> do
    bracket (liftBase $ Network.socketToHandle socket IO.ReadWriteMode)
            (\handle -> liftBase $ IO.hClose handle)
            (\handle -> do
               mvar <- newMVar False
               bracket (fork $ do
                          threadDelay 5000000
                          _ <- swapMVar mvar True
                          return ())
                       (killThread)
                       (\_ -> runConnectionT handle (sourceHandle handle))
               takeMVar mvar)

As you can see, I am trying to create a Producer in terms of a primitive withConnectionForever. That primitive is of type:

withConnectionForever
  :: (MonadBaseControl IO m, MonadLogger m)
  => NetworkSettings
  -> (Network.Socket -> m Bool)
  -> m ()

As you can imagine, I am getting an error message on compilation! It is:

Haskell/IRC.hs:128:54:
    Couldn't match expected type `ConnectionT m0 a0'
                with actual type `ConduitM i0 ByteString.ByteString m1 ()'
    In the return type of a call of `sourceHandle'
    In the second argument of `runConnectionT', namely
      `(sourceHandle handle)'
    In the expression: runConnectionT handle (sourceHandle handle)

Now, I know that the type of the call to withConnectionForever is not obviously a conduit, but I had hoped that it could manage to be one, by virtue of the fact that a conduit is also a monad and withConnectionForever uses a free monad instead of a hardcoded one. My understanding of what the message is trying to communicate is that that's not happening, and I'd like to know why and what I can do about it.

Here, for completeness, is the source of the primitive:

withConnectionForever
  :: (MonadBaseControl IO m, MonadLogger m)
  => NetworkSettings
  -> (Network.Socket -> m Bool)
  -> m ()
withConnectionForever networkSettings action = do
  let loop nFailures = do
        maybeSocket <- newConnection networkSettings
        case maybeSocket of
          Nothing -> return ()
          Just socket -> do
            terminatedNormally <- action socket
            if terminatedNormally
              then loop 0
              else do
                exponentTwiddle <- liftBase $ Random.randomRIO (0, 100)
                let exponent =
                      1.25 + fromIntegral (exponentTwiddle - 50) / 100.0
                    delay = floor $ 1000000.0 *
                      ((0.5 ** (fromIntegral nFailures * negate exponent))
                       - 1.0 :: Double)
                $(logInfo) (Text.concat
                  ["Abnormal disconnection from the network ",
                   networkSettingsName networkSettings,
                   "; pausing attempts for ",
                   Text.pack $ show $ fromIntegral delay / 1000000.0,
                   " seconds..."])
                liftBase $ threadDelay delay
                loop (nFailures + 1)
  loop 0

I'd really prefer not to rewrite the primitive, unless it can be done in minimally invasive fashion, but I suppose that's on the table.

Thanks in advance!

Answer 1

The relevant thing to do was

(\_ -> transPipe (runConnectionT handle) (sourceHandle handle))

instead of

(\_ -> runConnectionT handle (sourceHandle handle))

Thanks for your time! :D