{----------------------------------------------------------------------------

Компилировать:
    ghc -O -threaded fact.hs

Использовать:
    $ ./fact server 12345 &
    Listening on 12345

    $ ./fact client ::1 12345
    345345435435
    Answer := [3,5,7,11,13,13,59,157,191]
    -5.3
    Answer := NaN
    43534524542534543534
    Answer := [2,485777,1495631,29960041]

Фичи:
    + Разбор параметров командной строки
    + Обработка некорректных данных
    + Клиент-серверная архитектура
    + Полностью асинхронный многопоточный tcp-сервер
    + Распараллелизация алгоритмов "из коробки"
    + Поддержка Unicode, IPv6 и BigInteger сразу "из коробки"
    + Как следствие, мгновенный отклик в любой ситуации
    + Мемоизация списка простых чисел (благодаря ленивости)
    ! Производительность на уровне чистого Си
    + Полная кроссплатформенность (Windows, *nix, Mac OS X, etc.)
    + Исходник чуть больше 60 строк (используются стандартные библиотеки)
    + Код фактически не нуждается в комментариях
    + Правильность тривиально доказывается мат. аппаратом прямо по коду с помощью индукции
    ! Время разработки с нуля чуть меньше 30 минут

А теперь сравните с этим уродливым (взято из доков по boost)

    class server
    {
    public:
      server(boost::asio::io_service& io_service, short port)
        : io_service_(io_service),
          acceptor_(io_service, tcp::endpoint(tcp::v4(), port))
      {
        session* new_session = new session(io_service_);
        acceptor_.async_accept(new_session->socket(),
            boost::bind(&server::handle_accept, this, new_session,
              boost::asio::placeholders::error));
      }
    .........

Haskell. Feel the difference.

----------------------------------------------------------------------------}


import Network (listenOn, withSocketsDo, accept, connectTo, PortID(..), Socket)
import System (getArgs)
import System.IO (hSetBuffering, hGetLine, hPutStrLn, BufferMode(..), Handle)
import Control.Concurrent (forkIO)

main :: IO ()
main = do
    args <- getArgs
    case args of
        ["server", port] -> server port
        ["client", host, port] -> client host port
        otherwise -> error "Usage: fact server [port] | fact client [host] [port]"

getPort :: String -> PortID
getPort port = PortNumber $ fromIntegral (read port :: Int)

-- client part

client :: String -> String -> IO ()
client host port = withSocketsDo $ do
    handle <- connectTo host $ getPort port
    hSetBuffering handle NoBuffering
    repl handle

repl :: Handle -> IO ()
repl handle = do
    getLine >>= hPutStrLn handle
    putStr "Answer := "
    hGetLine handle >>= putStrLn
    repl handle

-- server part

server :: String -> IO ()
server port = withSocketsDo $ do
    sock <- listenOn $ getPort port
    putStrLn $ "Listening on " ++ port
    sockHandler sock

sockHandler :: Socket -> IO ()
sockHandler sock = do
    (handle, _, _) <- accept sock
    hSetBuffering handle NoBuffering
    forkIO $ processRequest handle
    sockHandler sock

processRequest :: Handle -> IO ()
processRequest handle = do
    line <- hGetLine handle
    hPutStrLn handle $ prettyPrint $ reads line
    processRequest handle

prettyPrint :: [(Integer, String)] -> String
prettyPrint [(number, _)] = show $ primeFactors number
prettyPrint []            = "NaN"

primes = 2 : sieve [3, 5..] where
    sieve (p:xs) = p : sieve [x | x <- xs, rem x p /= 0]

primeFactors :: Integer -> [Integer]
primeFactors n = factor primes n where
    factor ps@(p:pt) n | p*p > n      = [n]
                       | rem n p == 0 = p : factor ps (quot n p)
                       | otherwise    = factor pt n