Concurrent echo server

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
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

Concurrent echo server (annotation)

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
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