Concurrent echo server :: hpaste — Haskell Pastebin

Contact/support | Changelog

Edit - Annotate - Report/Delete

Concurrent echo server

Paste:#52742
Author(s):Ertugrul Söylemez
Language:Haskell
Channel:#haskell Context in IRC logs
Created:2011-10-17 08:48:37 UTC
Raw:View raw link

module Main where

import Control.Concurrent
import Control.Exception
import Control.Monad
import Network
import System.IO
import Text.Printf


type Logger = String -> IO ()


main :: IO ()
main = do
    log <- logger

    sock <- listenOn (PortNumber 4000)
    forkIO (server log sock)

    log "Press enter to exit"
    fmap (const ()) getLine


    where
    logger :: IO Logger
    logger = do
        logVar <- newEmptyMVar
        forkIO . forever $ takeMVar logVar >>= putStrLn
        return (putMVar logVar)

    server :: Logger -> Socket -> IO ()
    server log sock =
        forever $ do
            (h, caddr, cport) <- accept sock
            log (printf "Connection from %s" caddr)
            hSetBuffering h NoBuffering

            forkIO $ (hGetContents h >>= hPutStr h)
                     `finally` hClose h

Diff original - Edit - Annotate - Report/Delete

Concurrent echo server (annotation)

Paste:#67362 (an annotation of #52742)
Author(s):aids
Language:Haskell
Channel:#haskell Context in IRC logs
Created:2012-04-21 01:59:53 UTC
Raw:View raw link

module Main where

import Control.Concurrent
import Control.Exception
import Control.Monad
import Network
import System.IO
import Text.Printf


type Logger = String -> IO ()


main :: IO ()
main = do
    log <- logger

    sock <- listenOn (PortNumber 4000)
    forkIO (server log sock)

    log "Press enter to exit"
    fmap (const ()) getLine


    where
    logger :: IO Logger
    logger = do
        logVar <- newEmptyMVar
        forkIO . forever $ takeMVar logVar >>= putStrLn
        return (putMVar logVar)

    server :: Logger -> Socket -> IO ()
    server log sock =
        forever $ do
            (h, caddr, cport) <- accept sock
            log (printf "Connection from %s" caddr)
            hSetBuffering h NoBuffering

            forkIO $ (hGetContents h >>= hPutStr h)
                     `finally` hClose h

22:5: Warning: Use void
Found:
  fmap (const ())
Why not:
  void