Re: Debugging Haskell

[Jerry, JiJie]

Thank you very much, it works :)

As I think it might be of help to the others, I'm cc'ing this mail
to the mailing list where my question was initially posted with the
revised code attached.

Sincerely,
Jerry

* Simon Marlow <[EMAIL PROTECTED]> [020313 20:16]:
> [ redirected to [EMAIL PROTECTED] ]
> 
> > Good day everyone, I was fiddling around with this tiny echo
> > client/server haskell program from 'The Great Language Shootout'
> > site (http://www.bagley.org/~doug/shootout/) and got stuck. 
> > 
> > The code (attached) has been reformatted with minimal API tweak
> > (mkPortNumber, writeSocket, readSocket) to please my ghc-5.02.2, and
> > all what I get is something stuck forever after the first
> > iteration:
> > 
> > $ ./echo 3
> > Client wrote: Hello there sailor
> > Server recv: Hello there sailor
> > Server read: Hello there sailor
> > Server wrote: Hello there sailor
> > 
> > After adding all these print statement, I still don't have a clue
> > what's jammed there. Hope someone here can shred some light.
> 
> It turns out to be a bug in the network library; we weren't putting the
> socket returned from accept into non-blocking mode.  It works fine if
> you use Handles rather than send/recv because the act of making a Handle
> from a file descriptor sets non-blocking mode on the FD, so a workaround
> for your program is just to insert a call to socketToHandle on the
> socket returned from accept (you don't have to use the Handle, just
> calling socketToHandle has the desired effect).
> 
> Thanks for the report.
> 
> > BTW, I'd also like to take this chance to ask how to debug a haskell
> > program in general?
> 
> With putStr or IOExts.trace, or using one of the more sophisticated
> debugging tools such as the nhc98 tracing system or Andy Gill's Observe
> library.  You should be able to find links on the www.haskell.org pages
> to these projects.
> 
> Cheers,
>       Simon
> 

-- $Id: echo.ghc,v 1.2 2001/05/01 20:19:52 doug Exp $
-- http://www.bagley.org/~doug/shootout/
-- Haskell echo/client server
-- written by Brian Gregor
-- compile with:
-- ghc -O -o echo -package net -package concurrent -package lang echo.hs
    
module Main where

import SocketPrim
import Concurrent
import System (getArgs,exitFailure)
import Exception(finally)
import MVar
import IO

server_sock :: IO (Socket)
server_sock = do
    s <- socket AF_INET Stream 6
    setSocketOption s ReuseAddr 1
    -- bindSocket s (SockAddrInet (mkPortNumber portnum) iNADDR_ANY)
    bindSocket s (SockAddrInet (PortNum portnum) iNADDR_ANY)
    listen s 2
    return s

echo_server :: Socket -> IO ()
echo_server s = do
    (s', clientAddr) <- accept s
    h <- socketToHandle s' ReadWriteMode
    proc <- read_data s' 0
    putStrLn ("server processed "++(show proc)++" bytes")
    sClose s'
    where
        read_data sock totalbytes = do
            -- (str,i) <- readSocket sock 19
            str <- recv sock 18
            -- if (i >= 19) 
            putStrLn ("Server recv: " ++ str)
            if ((length str) >= 18) 
                then do
                    putStrLn ("Server read: " ++ str)
                    -- writ <- writeSocket sock str
                    writ <- send sock str
                    putStrLn ("Server wrote: " ++ str)
                    --
                    read_data sock $! (totalbytes+(length $! str))
                    -- read_data sock (totalbytes+(length str))
                else do
                    putStrLn ("server read: " ++ str)
                    return totalbytes

local       = "127.0.0.1"        
message     = "Hello there sailor"
portnum     = 7001

client_sock = do
    s <- socket AF_INET Stream 6
    ia <- inet_addr local
    -- connect s (SockAddrInet (mkPortNumber portnum) ia)
    connect s (SockAddrInet (PortNum portnum) ia)
    return s

echo_client n = do
    s <- client_sock
    drop <- server_echo s n
    sClose s
    where
        server_echo sock n = if n > 0
            then do 
                -- writeSocket sock message
                send sock message
                putStrLn ("Client wrote: " ++ message)
                --
                -- (str,i) <- readSocket sock 19
                str <- recv sock 19
                if (str /= message)
                    then do
                        putStrLn ("Client read error: " ++ str)
                        exitFailure
                    else do
                        putStrLn ("Client read success")
                        server_echo sock (n-1)
            else do 
                putStrLn "Client read nil"
                return []

main = do 
    ~[n] <- getArgs
    -- server & client semaphores
    -- get the server socket
    ssock <- server_sock 
    -- fork off the server
    s <- myForkIO (echo_server ssock)
    -- fork off the client
    c <- myForkIO (echo_client (read n::Int))
    -- let 'em run until they've signaled they're done
    join s
    putStrLn "join s"
    join c
    putStrLn "join c"

-- these are used to make the main thread wait until
-- the child threads have exited
myForkIO :: IO () -> IO (MVar ())
myForkIO io = do
    mvar <- newEmptyMVar
    forkIO (io `finally` putMVar mvar ())
    return mvar

join :: MVar () -> IO ()
join mvar = readMVar mvar