Illustrate Deadlock with Michael's Timeout module

timeout_deadlock.hs

import Control.Concurrent
import Control.Exception
import Control.Monad
import Network.Socket
import Timeout

main = do
  mgr <- initialize 1
  forever $ do
    threadDelay 10
    pair <- try $ socketPair AF_UNIX Stream defaultProtocol
    case pair of
         Left e -> do
           let _ = e :: SomeException
           print e
           putStrLn "sleep"
           threadDelay 100000
         Right (sock1, sock2) -> do
           tid <- forkIO $ do
             -- block until timeout
             _ <- recv sock1 1
             return ()

           _ <- register mgr $ do
             killThread tid
             print sock1
             sClose sock1
             sClose sock2

           return ()