Created
September 22, 2009 22:44
-
-
Save hwatkins/191513 to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
module Main where | |
import Network.Socket | |
import System.Environment | |
import Control.Concurrent | |
import Control.Monad | |
-- Port number to listen on | |
listenPort :: PortNumber | |
listenPort = 3000 | |
-- | The main function | |
main :: IO () | |
main = withSocketsDo $ do | |
args <- getArgs -- get arguments | |
(host,port) <- parseArgs args -- parse arguments | |
s <- setupSocket -- setup our socket | |
-- Make the remote address we're talking to | |
let remote = SockAddrInet port host | |
-- Make a new thread to read messages from the socket | |
read_t <- forkIO $ readChat s | |
-- Continue in this thread and write messages to the socket | |
writeChat s remote | |
-- | A function to parse arguments | |
parseArgs :: [String] -> IO (HostAddress, PortNumber) | |
parseArgs (h:p:_) = do | |
host <- inet_addr h | |
return (host, port) | |
where | |
port = fromIntegral . read $ p | |
-- | A function to create the socket | |
setupSocket :: IO Socket | |
setupSocket = do | |
-- UDP socket | |
s <- socket AF_INET Datagram defaultProtocol | |
bindSocket s (SockAddrInet listenPort 0) | |
return s | |
-- | A function to read messages from the socket and print them | |
readChat :: Socket -> IO () | |
readChat s = forever $ do | |
(s,l,f) <- recvFrom s 4000 | |
putStrLn $ (show f) ++ " (" ++ (show l) ++ ") >>> " ++ s | |
-- | A function to read messages from stdin and send them to the remote host | |
writeChat :: Socket -> SockAddr -> IO () | |
writeChat s a = forever $ do | |
msg <- getLine | |
sendTo s msg a | |
putStrLn $ "Sent to " ++ (show a) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment