= do input ← hGetLBS h
acceptRequest (Context cnf tree fbs h port addr tQueue) input
`catches`
- [ Handler $ \ (_ ∷ IOException) → return ()
- , Handler $ \ e → case e of
- ThreadKilled → return ()
- _ → hPutStrLn stderr (show e)
- , Handler $ \ BlockedIndefinitelyOnSTM → hPutStrLn stderr "requestReader: blocked indefinitely"
- , Handler $ \ (e ∷ SomeException) → hPutStrLn stderr (show e)
+ [ Handler handleAsyncE
+ , Handler handleBIOS
+ , Handler handleOthers
]
+ where
+ handleAsyncE ∷ AsyncException → IO ()
+ handleAsyncE ThreadKilled = return ()
+ handleAsyncE e = dump e
+
+ handleBIOS ∷ BlockedIndefinitelyOnSTM → IO ()
+ handleBIOS = dump
+
+ handleOthers ∷ SomeException → IO ()
+ handleOthers = dump
+
+ dump ∷ Exception e ⇒ e → IO ()
+ dump e
+ = do hPutStrLn stderr "requestReader caught an exception:"
+ hPutStrLn stderr (show $ toException e)
acceptRequest ∷ HandleLike h ⇒ Context h → Lazy.ByteString → IO ()
acceptRequest ctx@(Context {..}) input