[Haskell-cafe] Confused about my IterIO code

John Ky newhoggy at gmail.com
Thu Jun 30 15:53:02 CEST 2011


Hi Hakell Cafe,

I'm struggling to understand my unambitious IterIO code that somehow manages
to work.

Basically I run an echo server that is supposed to read from a socket line
by line and write back to the socket with all the characters in the line
reversed:

import Control.Exception
import Control.Monad
import Control.Monad.Trans
import Data.IterIO
import Data.IterIO.Inum
import Network
import System.IO
import System.IO.Error (isEOFError)
import qualified Data.ByteString.Lazy as L
import qualified Data.ByteString.Lazy.Char8 as C

iterHandle' :: (MonadIO m) => Handle -> IO (Iter L.ByteString m (), Onum
L.ByteString m a)
iterHandle' = iterHandle

main = withSocketsDo $ do
  sListen <- listenOn (PortNumber 8000)
  putStrLn "Listening on Port 8000"
  forkIO $ forever $ do
    (sSession, hostname, port) <- accept sListen
    hSetBuffering sSession NoBuffering
    putStrLn ("Connected to " ++ hostname ++ ":" ++ show port)
    forkIO $ do
      (iter, enum) <- iterHandle' sSession
      enum |$ inumReverseLines .| iter
  putStrLn "Press <CTRL-D> to quit."
  exitOnCtrlD

inumReverseLines :: (Monad m) => Inum L.ByteString L.ByteString m a
inumReverseLines = mkInum $ do
  line <- lineI
  return (L.reverse (L.concat [line, C.pack "\n"]))

exitOnCtrlD = try getLine >>= either
  (\e -> unless (isEOFError e) $ ioError e)
  (const exitOnCtrlD)


When I run it, it does this:

asdfghc7 at hoggy-nn:/home/hoggy$ nc localhost 8000
1234
4321
4321
1234
abcde
edcba


The red lines are the replies from my echo server.

But all I've done is:

enum |$ inumReverseLines .| iter

inumReverseLines = mkInum $ do
  line <- lineI
  return (L.reverse (L.concat [line, C.pack "\n"]))


No attempt was made to reverse more than one line - at least as far as I can
see.  What have I done wrong that it should work so well?

Also, is there a better way to do this?

Cheers,

-John
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20110630/16159ce3/attachment.htm>


More information about the Haskell-Cafe mailing list