[Haskell-beginners] merge two handles

[David McBride]

The problem is the "forever" in the main thread.  It never has a way
to know that the two threads have died, but the stm knows that the
other two channels have disappeared, so they no longer block, and this
causes a busy loop.

So check this out.  I would have rather done it with a state monad to
count the number of threads I spawn and then wait for the appropriate
number of messages to arrive, but this way works too.

This is one of those cases where datatypes are awesome.  Now the
thread passes back either a line to be printed, or it tells the parent
thread that it has nothing left to print.  That way the main thread
knows exactly when to die.

Also, if you are going to be making command line scripts, I highly
recommend the cmdargs package on hackage, as it is pretty cool for
doing commandline arguments in a safe way.

{-# LANGUAGE ScopedTypeVariables #-}
module Main where

import GHC.Conc.Sync
import System.IO
import System.Environment
import System.Process
import Control.Monad
import Control.Concurrent.STM.TChan
import Control.Exception.Base
import Text.Printf
import Prelude hiding (catch)

data Message = MString String | ImDone

makeThread :: Handle -> TChan Message -> IO ThreadId
makeThread handle chan = forkIO $ (loop `catch` (\(e :: SomeException)
-> writeDone chan))
  where
    loop = do
      msg <- hGetLine handle
      writeMsg chan msg
      loop

    writeMsg chan msg = (atomically . writeTChan chan) $ MString msg
    writeDone chan = (atomically . writeTChan chan) ImDone

issueCmd :: String -> [String] -> IO ()
issueCmd cmd parms = do
    (_ ,Just hout ,Just herr ,_) <- createProcess (proc cmd parms) {
      std_out = CreatePipe,
      std_err = CreatePipe
    }
    chan <- newTChanIO :: IO (TChan Message)
    makeThread hout chan
    makeThread herr chan
    printCmd chan
    printCmd chan
  where
    printCmd chan = do
      msg <- atomically (readTChan chan)
      case msg of
        MString msg -> do
          putStrLn msg
          printCmd chan
        ImDone      -> return ()


main :: IO ()
main = do
 args <- getArgs
 let cmd = head args
 let parms = tail args
 issueCmd cmd parms
 print "Done"


On Wed, Jun 15, 2011 at 9:23 AM, Manfred Lotz <manfred.lotz at arcor.de> wrote:
> On Tue, 14 Jun 2011 13:10:36 -0400
> David McBride <dmcbride at neondsl.com> wrote:
>
>> It probably has to do more with parenthesis than anything:
>>
>> forever $ atomically $ readTchan chan >>= print
>> forever $ (atomically $ readTchan chan) >>= print
>>
>> That might work.  Once you get the types to line up, that should work.
>>
>
> Thanks for the hint. I finally got it compiled and almost working.
>
> The code is now like this:
>
>
> {-# LANGUAGE ScopedTypeVariables #-}
>
> import GHC.Conc.Sync
> import System.IO
> import System.Environment
> import System.Process
> import Control.Monad
> import Control.Concurrent.STM.TChan
> import Control.Exception.Base
> import Text.Printf
> import Prelude hiding (catch)
>
>
>
> makeThread :: Handle -> TChan String -> IO ThreadId
> makeThread handle chan = forkIO $
>  forever
>    (do eof <- hIsEOF handle
>        unless eof $ hGetLine handle >>= atomically . writeTChan chan)
>                            `catch` (\(e :: SomeException) -> return ())
>
> issueCmd :: String -> [String] -> IO ()
> issueCmd cmd parms = do
>  (_ ,Just hout ,Just herr ,_) <- createProcess (proc cmd parms) {
>    std_out = CreatePipe,
>    std_err = CreatePipe
>  }
>  chan <- newTChanIO :: IO (TChan String)
>  _ <- makeThread hout chan
>  _ <- makeThread herr chan
>  forever $ atomically (readTChan chan) >>= printf "%s\n"
>
> main :: IO ()
> main = do
>  args <- getArgs
>  let cmd = head args
>  let parms = tail args
>  issueCmd cmd parms
>  print "Done"
>
>
>
> If I run this with a command the command's output will be printed but
> after that the program is hanging, and top shows 100% cpu usage. "Done"
> will never be printed.
>
> Any idea what I have to add to prevent it from hanging?
>
>
> --
> Thanks,
> Manfred
>
>
>
> _______________________________________________
> Beginners mailing list
> Beginners at haskell.org
> http://www.haskell.org/mailman/listinfo/beginners
>