Skip to content

Instantly share code, notes, and snippets.

@talios
Created July 7, 2014 10:36
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save talios/ee00fc6aabc0f4185704 to your computer and use it in GitHub Desktop.
Save talios/ee00fc6aabc0f4185704 to your computer and use it in GitHub Desktop.
Network Chat in Haskell.
import Control.Concurrent
import Control.Concurrent.Chan
import Data.UUID
import Data.UUID.V4
import Network.Socket
import System.IO
data Message = Message UUID String
deriving (Show, Eq)
main = do
channel <- newChan
sock <- getListeningSocket
forkIO (listenForSocketConnections sock channel)
forkIO (getMessagesFromStdIn channel)
displayMessagesFrom channel stdout
where
forever a = a >> forever a
getListeningSocket = do
sock <- socket AF_INET Stream 0
bindSocket sock (SockAddrInet 7077 iNADDR_ANY)
listen sock 2
return sock
listenForSocketConnections sock channel = forever $ do
(conn, _) <- accept sock
hdl <- socketToHandle conn ReadWriteMode
hSetBuffering hdl NoBuffering
forkIO (getMessagesFromSocket hdl channel)
getMessagesFromSocket hdl channel = do
echoChan <- dupChan channel
forkIO (displayMessagesFrom echoChan hdl)
forever $ do
line <- hGetLine hdl
uuid <- nextRandom
writeChan channel $ Message uuid line
getMessagesFromStdIn channel = forever $ do
line <- getLine
uuid <- nextRandom
writeChan channel $ Message uuid line
displayMessagesFrom channel hdl = do
msgs <- getChanContents channel
mapM_ (\msg -> hPutStrLn hdl $ show msg ) msgs
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment