Haskell mutithreaded factorial server

Taking the Haskell factorial joke to a new level

module Main where

import Control.Concurrent
import Control.Exception
import System.IO
import Network

interactTCP :: Int -> (String -> IO String) -> IO ()
interactTCP port f = do
        servSock <- listenOn $ PortNumber (fromIntegral port)
        waitLoop f servSock

waitLoop :: (String -> IO String) -> Socket -> IO t
waitLoop f servSock = do
        (h,_,_) <- accept servSock
        forkIO $ finally (y (\f' ->
            (do hSetBuffering h LineBuffering
                hGetLine h >>= f >>= hPutStrLn h >> f')))
                         (hClose h)
        waitLoop f servSock

factorial :: Integer -> Integer
factorial = product . enumFromTo 1

readApplyShow :: (Read a, Show c) => (a -> c) -> String -> String
readApplyShow f = show . f . read

y :: (t -> t) -> t
y f = f (y f)

main :: IO ()
main = interactTCP 1234
                   (return . readApplyShow factorial)

>>33
It doesn't just do that -- this is the equivalent pointful version:
> map ((,) a) b
As you can clearly see, it takes a single element, and a list of elements, and returns a list of pairs of the first argument with every element in `b'.