再次打破 Haskell 中的循环

Question

我有一小段代码在 zeromq Pull 套接字上接收帧并在 opencv 中显示它 window:

module Main where

import           Control.Monad
import qualified OpenCV as CV
import           System.ZMQ4.Monadic
import           System.Exit

main :: IO()
main = runZMQ $ do
  receiver <- socket Pull
  bind receiver "tcp://*:5554"

  -- do some stuff not relevant

  forever $ do
    buffer <- receive receiver
    let img = CV.imdecode CV.ImreadUnchanged buffer -- simple decoder
    liftIO $ CV.withWindow "Video" $ \window -> do
        CV.imshow window img
        key <- CV.waitKey 10
        when (key == 27) exitSuccess -- <- UGLY!

我想找到一种打破循环的方法，让我有更多的控制权。我知道 Gabriel Gonzalez here（我非常喜欢）提出的 EitherT 解决方案，但我无法在 CV.withWindow 上下文中实现它，例如：

quit :: (Monad m) => e -> EitherT e m r
quit = left

loop :: (Monad m) => EitherT e m a -> m e
loop = fmap (either id id) . runEitherT . forever

main :: IO()
main = runZMQ $ do
  receiver <- socket Pull
  bind receiver "tcp://*:5554"

  loop $ do
    buffer <- receive receiver
    let img = CV.imdecode CV.ImreadUnchanged buffer -- simple decoder
    liftIO $ CV.withWindow "Video" $ \window -> do
        CV.imshow window img
        key <- CV.waitKey 10
        when (key == 27) $ quit ()

但当然 quit 将参数包装在 Left 中，此解决方案无法编译。

Answer 1

读写IORef，并使用whileM_。

main = runZMQ $ do
    receiver <- socket Pull
    bind receiver "tcp://*:5554"
    continue <- liftIO $ newIORef True

    whileM_ (liftIO $ readIORef continue) $ do
        buffer <- receive receiver
        let img = CV.imdecode CV.ImreadUnchanged buffer -- simple decoder
        liftIO . CV.withWindow "Video" $ \window -> do
            CV.imshow window img
            key <- CV.waitKey 10
            when (key == 27) $ writeIORef continue False

或者让你的循环适当地显式调用自身：

main = runZMQ $ do
    receiver <- socket Pull
    bind receiver "tcp://*:5554"

    let loop = do
            buffer <- receive receiver
            let img = CV.imdecode CV.ImreadUnchanged buffer -- simple decoder
            key <- liftIO . CV.withWindow "Video" $ \window -> do
                CV.imshow window img
                CV.waitKey 10
            when (key /= 27) loop

    loop

Answer 2

如何将回调 return 设为 Either () ()，然后将其包装在 ExceptT 中，然后再传递给永远？像

runExceptT . forever . ExceptT $ do
  buffer <- receive receiver
  let img = CV.imdecode CV.ImreadUnchanged buffer -- simple decoder
  liftIO $ CV.withWindow "Video" $ \window -> do
      CV.imshow window img
      key <- CV.waitKey 10
      if (key == 27) 
          then (return (Left ()))
          else (return (Right ()))

再次打破 Haskell 中的循环

Again on breaking loops in Haskell

opencv

haskell

zeromq