module Z.IO.UV.UVStream
(
initUVStream
, UVStream(..)
, getUVStreamFD
, closeUVStream
, helloWorld, echo
) where
import Control.Concurrent
import Control.Monad
import Z.IO.UV.Errno
import Z.IO.UV.FFI
import Z.IO.UV.Manager
import Z.IO.Buffered
import Z.IO.Exception
import Z.IO.Resource
import Data.IORef
import GHC.Ptr
data UVStream = UVStream
{ uvsHandle :: {-# UNPACK #-} !(Ptr UVHandle)
, uvsSlot :: {-# UNPACK #-} !UVSlot
, uvsManager :: UVManager
, uvsClosed :: {-# UNPACK #-} !(IORef Bool)
}
instance Show UVStream where
show (UVStream hdl slot uvm _) =
"UVStream{uvsHandle=" ++ show hdl ++
",uvsSlot=" ++ show slot ++
",uvsManager=" ++ show uvm ++ "}"
initUVStream :: HasCallStack
=> (Ptr UVLoop -> Ptr UVHandle -> IO ())
-> UVManager
-> Resource UVStream
initUVStream f uvm = initResource
(withUVManager uvm $ \ loop -> do
hdl <- hs_uv_handle_alloc loop
slot <- getUVSlot uvm (peekUVHandleData hdl)
_ <- tryTakeMVar =<< getBlockMVar uvm slot
f loop hdl `onException` hs_uv_handle_free hdl
closed <- newIORef False
return (UVStream hdl slot uvm closed))
closeUVStream
closeUVStream :: UVStream -> IO ()
closeUVStream (UVStream hdl _ uvm closed) = withUVManager' uvm $ do
c <- readIORef closed
unless c $ writeIORef closed True >> hs_uv_handle_close hdl
getUVStreamFD :: HasCallStack => UVStream -> IO UVFD
getUVStreamFD (UVStream hdl _ _ closed) = do
c <- readIORef closed
when c throwECLOSED
throwUVIfMinus (hs_uv_fileno hdl)
instance Input UVStream where
{-# INLINABLE readInput #-}
readInput (UVStream hdl slot uvm closed) buf len = mask_ $ do
c <- readIORef closed
when c throwECLOSED
pokeBufferTable uvm slot buf len
m <- getBlockMVar uvm slot
_ <- tryTakeMVar m
throwUVIfMinus_ $ withUVManager' uvm (hs_uv_read_start hdl)
r <- takeMVar m `onException` (do
throwUVIfMinus_ $ withUVManager' uvm (uv_read_stop hdl)
void (tryTakeMVar m))
if | r > 0 -> return r
| r == fromIntegral UV_EOF -> return 0
| r < 0 -> throwUVIfMinus (return r)
instance Output UVStream where
{-# INLINABLE writeOutput #-}
writeOutput (UVStream hdl _ uvm closed) buf len = mask_ $ do
c <- readIORef closed
when c throwECLOSED
m <- withUVManager' uvm $ do
reqSlot <- getUVSlot uvm (hs_uv_write hdl buf len)
m <- getBlockMVar uvm reqSlot
_ <- tryTakeMVar m
return m
throwUVIfMinus_ (uninterruptibleMask_ $ takeMVar m)
helloWorld :: UVStream -> IO ()
helloWorld uvs = writeOutput uvs (Ptr "hello world"#) 11
echo :: UVStream -> IO ()
echo uvs = do
i <- newBufferedInput uvs
o <- newBufferedOutput uvs
forever $ readBuffer i >>= writeBuffer o >> flushBuffer o