Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
Sample telnet chat in Haskell
module Main(main) where
import Network
import System.IO
import Control.Monad
import Control.Concurrent
import Data.List
type Message = String
data ChatUser = ChatUser { userId :: Int, username :: String }
deriving Eq
data ChatMessage = ChatMessage { messageFrom :: ChatUser, messageText :: Message }
| QuitMessage { messageFrom :: ChatUser, messageText :: Message }
| JoinMessage { messageFrom :: ChatUser }
instance Show ChatUser where
show (ChatUser uid name) = name ++ "(" ++ show uid ++ ")"
instance Show ChatMessage where
show (ChatMessage user message) = show user ++ ": " ++ message
show (QuitMessage user message)
| null message = "! " ++ show user ++ " saiu."
| otherwise = "! " ++ show user ++ " saiu: " ++ message
show (JoinMessage user) = "! " ++ show user ++ " entrou."
port :: PortID
port = PortNumber 23
main :: IO ()
main = withSocketsDo $ do
let userCount = 0
chan <- newChan
socket <- listenOn port
handleConnections socket userCount chan
handleConnections :: Socket -> Int -> Chan ChatMessage -> IO ()
handleConnections socket userCount chan = do
(socketHandle, _, _) <- accept socket
hSetBuffering socketHandle NoBuffering
let nextUserNumber = (userCount + 1)
_ <- forkIO $ handleUserConnection chan socketHandle nextUserNumber
handleConnections socket nextUserNumber chan
handleUserConnection :: Chan ChatMessage -> Handle -> Int -> IO ()
handleUserConnection chan socketHandle thisUserNumber = do
name <- readUsername socketHandle
let thisUser = ChatUser thisUserNumber name
broadcast chan $ JoinMessage thisUser
chanReader <- dupChan chan
readerThread <- forkIO (startReader chanReader socketHandle thisUser)
quitMessage <- (startSender chan socketHandle thisUser)
`catch` (\_ -> return "")
broadcast chan $ QuitMessage thisUser quitMessage
killThread readerThread
hClose socketHandle
readUsername :: Handle -> IO String
readUsername socketHandle = do
hPutStr socketHandle "Informe seu nome: "
readLine $ socketHandle
startReader :: Chan ChatMessage -> Handle -> ChatUser -> IO ()
startReader chanReader socketHandle thisUser = forever $ do
message <- readChan chanReader
when ((messageFrom message) /= thisUser) (display message socketHandle)
startSender :: Chan ChatMessage -> Handle -> ChatUser -> IO String
startSender chan socketHandle thisUser = do
line <- readLine socketHandle
if "/quit" `isPrefixOf` line
then return . dropWhile (== ' ') $ drop 5 line
else do
broadcast chan (ChatMessage thisUser line)
startSender chan socketHandle thisUser
broadcast :: Chan ChatMessage -> ChatMessage -> IO ()
broadcast = writeChan
display :: ChatMessage -> Handle -> IO ()
display message socketHandle = do
hPutStr socketHandle (show message ++ "\r\n")
hFlush socketHandle
readLine :: Handle -> IO String
readLine = liftM (filter (/= '\r')) . hGetLine
@YasCoMa

This comment has been minimized.

Copy link

@YasCoMa YasCoMa commented Sep 18, 2012

Olá, gostei do código, mas como eu testo isso?? Eu e a outra pessoa em outro computador temos que ter o ghci para interpretar e carregar oss módulos de Haskell, e como envio e leio? Obrigada!

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment