There is the void function in Control.Monad:
http://hackage.haskell.org/packages/archive/base/latest/doc/html/Control-Monad.html#v:void
Instead of using return () you can just use void processLine.
Also some people like to use the either function instead of matching on Left/Right. In this case you can also avoid introducing a few names:
let processLine = void $ forkIO $
try (hGetLine sSession) >>= either
(\e -> if isEOFError e
then print e
else ioError e)
(putStrLn >=> const processLine)
On 28 June 2011 12:58, John Ky <newhoggy@gmail.com> wrote:
> Hi Eric, Ivan,
> On 28 June 2011 18:32, Erik de Castro Lopo <mle+hs@mega-nerd.com> wrote:
>>
>> The hlint program would have flagged both of those and possibly
>> others. See:
>
> Cool!
> It didn't flag either for me, but it recommended replacing ++ (show port)
> with ++ show port, if then else with unless, putStrLn (show x) with print x,
> and do stuff with stuff.
> All useful to know.
> On 28 June 2011 18:16, Ivan Lazar
> Miljenovic <ivan.miljenovic@gmail.com> wrote:
>>
>> I don't think you need all those return () everywhere...
>
>
> You're right. At some point I added it in to (try to) make the compiler
> happy, but it must have been or become unnecessary.
> I still need two though because forkIO (and therefore my processLine
> function) returns IO ThreadId, but the last line for do notation must be
> return () (see below).
> On 28 June 2011 18:16, Ivan Lazar
> Miljenovic <ivan.miljenovic@gmail.com> wrote:
>>
>> And at the end, why do you do "line <- getLine" when you don't use the
>> result?
>
> Oh that. I was trying to figure out a way to terminate by program. I've
> now changed it to exit on EOF.
> Here is my second attempt. Is it much better?:
>
> import Control.Concurrent
> import Control.Exception
> import Control.Monad
> import Network
> import System.IO
> import System.IO.Error (isEOFError)
> main = withSocketsDo $ do
> sListen <- listenOn (PortNumber 8000)
> putStrLn "Listening on Port 8000"
> forkIO $ forever $ do
> (sSession, hostname, port) <- accept sListen
> putStrLn ("Connected to " ++ hostname ++ ":" ++ show port)
> let processLine = forkIO $ do
> lineResult <- try (hGetLine sSession)
> case lineResult of
> Right line -> do
> putStrLn line
> processLine
> return ()
> Left e -> if isEOFError e
> then print e
> else ioError e
> processLine
> return()
> putStrLn "Press <CTRL-D> to quit."
> let processStdIn = do
> lineResult <- try getLine
> case lineResult of
> Right line -> processStdIn
> Left e -> unless (isEOFError e) $ ioError e
> processStdIn
>
> Thanks for the suggestions.
> Cheers,
> -John
>
> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-Cafe@haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe
>
>