Again on breaking loops in Haskell

Question

I have a small piece of code that receives frames on a zeromq Pull socket and displays it in a 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!

What I would like to find is a way to break the loop that allows me more control. I'm aware of the EitherT solution proposed by Gabriel Gonzalez here (that I like very much) but I'm not able to implement it in the CV.withWindow context, for example:

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 ()

But of course quit wraps the argument in a Left and this solution doesn't compile.

What is the type of `CV.withWindow`? (Generally: where does the module `OpenCV` come from?) — Daniel Wagner, Dec 12 '16 at 19:55
`OpenCV` is coming from [here](https://github.com/LumiGuide/haskell-opencv) and according to the [docs](http://lumiguide.github.io/haskell-opencv/doc/OpenCV-HighGui.html) `CV.withWindow :: String -> (Window -> IO a) -> IO a` — mezzomondo, Dec 12 '16 at 20:02
Okay, because `withWindow` returns the result of the action you pass it there is another approach as well. I've expanded my answer. — Daniel Wagner, Dec 12 '16 at 20:41

Daniel Wagner · Accepted Answer · 2016-12-12T21:44:31.197

4

Read and write an IORef, and use 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

Or have your loop call itself explicitly as appropriate:

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

edited Dec 12 '16 at 21:44

answered Dec 12 '16 at 18:03

Daniel Wagner

145,880
9
220
380

I didn't consider IORef, good point. When I try it, though, I have to `liftIO` whileM_ and I end up with the same old clash between `ZMQ z ()` and `IO ()` when I use `receive`. Now I try the second solution... – mezzomondo Dec 12 '16 at 19:01
Ok, about the second solution. `loop` has signature `loop :: ZMQ z ()` but `CV.withWindow :: String -> (Window -> IO a) -> IO a` so if I do a `liftIO` before `CV.withWindow` I'm still out of luck. – mezzomondo Dec 12 '16 at 19:13
I wonder if the latter solution will leak memory at every loop or not. I guess that `withWindow` should be kind-of tail recursive, but I have no idea about how OpenCV works (and I can not find it, even on stackage) – chi Dec 12 '16 at 19:36
@mezzomondo I misunderstood the type of `runZMQ`, sorry about that. I've updated with a new proposal for the `whileM_`/`IORef` solution, but I don't have zeromq installed to test it; anyway, give it a try. – Daniel Wagner Dec 12 '16 at 19:45
Thank you @daniel-wagner, the `liftIO` in the parentheses was the missing bit. Now it works. – mezzomondo Dec 12 '16 at 20:11
In the second shouldn't it be `when (key /= 27) loop`? – mezzomondo Dec 12 '16 at 21:20
@mezzomondo Thanks, fixed. =) – Daniel Wagner Dec 12 '16 at 21:44
As a matter of style, would it be terrible to instead write: `fix $ \loop -> do {... when (key /= 27) loop}`? It seems a bit nicer to me to make it clear that we'll be calling loop immediately after defining it, and points out that the only reason for the let-binding is to create the recursive action. – amalloy Dec 12 '16 at 22:40

danidiaz · Answer 2 · 2016-12-12T20:14:26.833

2

How about making the callback return an Either () () and then wrapping it in ExceptT before passing it to forever? Something like

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 ()))

edited Dec 12 '16 at 20:14

answered Dec 12 '16 at 20:08

danidiaz

26,936
4
45
95

Giving it a try. `runExceptT . forever . ExceptT :: Monad m => m (Either e a) -> m (Either e b)`, so it returns a `ZMQ z (Either () b)` while I'm expecting a `ZMQ z ()`. – mezzomondo Dec 12 '16 at 20:23
@mezzomondo You could put `return ()` after the `ZMQ z (Either () b)` in a do-block, our you could use the function `void :: Functor f => f a -> f ()` from `Control.Monad` to "erase" the return value. – danidiaz Dec 12 '16 at 21:47

Again on breaking loops in Haskell

2 Answers2