<div dir="ltr"><br><div class="gmail_extra"><br><div class="gmail_quote">On Sun, Oct 5, 2014 at 1:14 PM, Tilmann <span dir="ltr"><<a href="mailto:t_gass@gmx.de" target="_blank">t_gass@gmx.de</a>></span> wrote:<br><blockquote class="gmail_quote" style="margin:0px 0px 0px 0.8ex;border-left:1px solid rgb(204,204,204);padding-left:1ex">Hi,<br>
I have this little program that works 'sometimes'. It is supposed to connect to a server via telnet and print the incoming text to a wx textwidget. Usually I get an error message: ChessGui: <socket: 22>: hGetBufSome: illegal operation (handle is closed), but I acutally saw it working a few times...<br>
The whole thing is a bit out of my Haskell-league, so I´m a bit lost now. Any help is very appreciated!<br>
<br>
Best regards,<br>
Tilmann<br>
<br>
<br>
<br>
module Main where<br>
<br>
import Control.Concurrent (forkIO, killThread)<br>
import Control.Monad.IO.Class (MonadIO, liftIO)<br>
import Control.Monad.Trans.Resource<br>
import Data.Conduit<br>
import qualified Data.Conduit.Binary as CB<br>
import qualified Data.ByteString.Char8 as BS<br>
import Network (connectTo, PortID (..))<br>
import System.IO<br>
import Graphics.UI.WX<br>
import Graphics.UI.WX.Types<br>
import Graphics.UI.WXCore.WxcDefs<br>
<br>
main = start gui<br>
<br>
gui = do<br>
f <- frame []<br>
t <- textCtrlEx f (wxTE_MULTILINE .+. wxTE_RICH2) [font := fontFixed]<br>
e <- entry f []<br>
set f [layout := boxed "console" (grid 5 5 [[floatLeft $ expand $ hstretch $ widget t]<br>
,[expand $ hstretch $ widget e]])]<br>
telnet "<a href="http://freechess.org" target="_blank">freechess.org</a>" 5000 t<br>
<br>
<br>
telnet :: String -> Int -> TextCtrl() -> IO ()<br>
telnet host port t = runResourceT $ do<br>
(releaseSock, hsock) <- allocate (connectTo host $ PortNumber $ fromIntegral port) hClose<br>
liftIO $ mapM_ (`hSetBuffering` LineBuffering) [ hsock ]<br>
liftIO $ forkIO $ CB.sourceHandle hsock $$ (sink' t)<br>
return ()<br>
<br></blockquote><div><br></div><div>I don't know anything about wxwidgets, but I *do* see a problem here. You're using `allocate` to say "when this ResourceT block exits, call hClose on the Socket". You then take the socket and pass it to a new thread. That new thread tries to continue using that Socket, but the first thread's ResourceT block exits immediately, closing the Socket. You may want to instead try using resourceForkIO[1].<br><br></div><div>On a separate note, your usage of mapM_ isn't necessary in this case. You can make do with:<br><br></div><div>    liftIO $ hSetBuffering hsock LineBuffering<br></div><div><br>[1] <a href="http://haddocks.fpcomplete.com/fp/7.8/20140916-162/resourcet/Control-Monad-Trans-Resource.html#v:resourceForkIO">http://haddocks.fpcomplete.com/fp/7.8/20140916-162/resourcet/Control-Monad-Trans-Resource.html#v:resourceForkIO</a><br></div><div> </div><blockquote class="gmail_quote" style="margin:0px 0px 0px 0.8ex;border-left:1px solid rgb(204,204,204);padding-left:1ex">
sink' :: TextCtrl () -> Sink BS.ByteString IO ()<br>
sink' textCtrl = do<br>
mstr <- await<br>
case mstr of<br>
Nothing -> return ()<br>
Just str -> do<br>
text' <- liftIO $ (get textCtrl text)<br>
liftIO $ set textCtrl [text := text' ++ BS.unpack str ]<br>
sink' textCtrl<br>
<br>
______________________________<u></u>_________________<br>
Haskell-Cafe mailing list<br>
<a href="mailto:Haskell-Cafe@haskell.org" target="_blank">Haskell-Cafe@haskell.org</a><br>
<a href="http://www.haskell.org/mailman/listinfo/haskell-cafe" target="_blank">http://www.haskell.org/<u></u>mailman/listinfo/haskell-cafe</a><br>
</blockquote></div><br></div></div>