Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Using a monad inside the IO monad

Is there something that is like the opposite of liftIO? I'm using websockets, and I want to be able to listen for messages from the server in a separate thread. Here's what I'm doing:

import Network.WebSockets
import qualified Data.Text as T
import Control.Monad.IO.Class
import Control.Monad
import Control.Concurrent
import Control.Applicative

printMessages :: WebSockets Hybi00 ()
printMessages = forever $ do
    resp <- receiveDataMessage 
    liftIO $ print resp

run :: WebSockets Hybi00 ()
run = do
    liftIO . forkIO $ printMessages
    forever $ do
      line <- liftIO getLine
      sendTextData . T.pack $ line

main = connect "0.0.0.0" 8080 "/" run

So printMessages listens for messages from the server and keeps printing them out. The problem is, forkIO expects a function that returns IO (). Is there any way for me to run printMessages in the IO monad?

like image 532
Vlad the Impala Avatar asked May 08 '13 21:05

Vlad the Impala


1 Answers

If I'm understanding this right, the reason you want to receive messages in another thread is because the main thread will be waiting for user input to send.

From a look at the documentation, it seems like you'll have an easier time if you reverse the roles of the threads: receive in the main thread, and send asynchronously from the other.

Then you can use getSink :: Protocol p => WebSockets p (Sink p) to grab a sink before forking, which you can then use with sendSink :: Sink p -> Message p -> IO () which lives in IO, avoiding the whole problem of mixing monads.

In other words, restructure your code to something like this:

sendMessages :: Sink Hybi00 -> IO ()
sendMessages sink = forever $ do
    line <- getLine
    let msg = textData . T.pack $ line
    sendSink sink msg

run :: WebSockets Hybi00 ()
run = do
    sink <- getSink
    liftIO . forkIO $ sendMessages sink
    forever $ do
      resp <- receiveDataMessage 
      liftIO $ print resp

main = connect "0.0.0.0" 8080 "/" run
like image 138
hammar Avatar answered Sep 26 '22 15:09

hammar