管道 - 多个“尝试”到一个来源

Question

我正在尝试执行以下操作：

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)

如您所见，我正在尝试根据原始withConnectionForever 创建一个Producer。该原语的类型为：

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

如您所想，我在编译时收到一条错误消息！它是：

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)

现在，我知道对withConnectionForever 的调用类型显然不是一个管道，但我希望它可以成为一个，因为管道也是一个单子和@987654327 @ 使用免费的单子而不是硬编码的单子。我对消息试图传达的内容的理解是，这并没有发生，我想知道为什么以及我能做些什么。

为了完整起见，这里是原语的来源：

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

我真的不想重写原语，除非它可以以微创方式完成，但我想这已经摆在桌面上了。

提前致谢！

Answer 1

相关的事情是

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

而不是

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

感谢您的宝贵时间！ :D