module Network.Socket.Handle where
import qualified GHC.IO.Device (IODeviceType(Stream))
import GHC.IO.Handle.FD (fdToHandle')
import System.IO (IOMode(..), Handle, BufferMode(..), hSetBuffering)
import Network.Socket.Types
socketToHandle :: Socket -> IOMode -> IO Handle
socketToHandle :: Socket -> IOMode -> IO Handle
socketToHandle Socket
s IOMode
mode = forall a. Socket -> (CInt -> IO a) -> (CInt -> IO a) -> IO a
invalidateSocket Socket
s forall {p} {a}. p -> IO a
err forall a b. (a -> b) -> a -> b
$ \CInt
oldfd -> do
Handle
h <- CInt
-> Maybe IODeviceType
-> Bool
-> FilePath
-> IOMode
-> Bool
-> IO Handle
fdToHandle' CInt
oldfd (forall a. a -> Maybe a
Just IODeviceType
GHC.IO.Device.Stream) Bool
True (forall a. Show a => a -> FilePath
show Socket
s) IOMode
mode Bool
True
Handle -> BufferMode -> IO ()
hSetBuffering Handle
h BufferMode
NoBuffering
forall (m :: * -> *) a. Monad m => a -> m a
return Handle
h
where
err :: p -> IO a
err p
_ = forall a. IOError -> IO a
ioError forall a b. (a -> b) -> a -> b
$ FilePath -> IOError
userError forall a b. (a -> b) -> a -> b
$ FilePath
"socketToHandle: socket is no longer valid"