module Z.IO.StdStream
(
StdStream
, isStdStreamTTY
, getStdStreamFD
, setStdinTTYMode
, getStdoutWinSize
, stdin, stdout, stderr
, stdinBuf, stdoutBuf, stderrBuf
, printStd
, readLineStd
, putStd
, putLineStd
, withMVar
, TTYMode
, pattern TTY_MODE_NORMAL
, pattern TTY_MODE_RAW
) where
import Control.Monad
import Control.Concurrent.MVar
import Foreign.Ptr
import System.IO.Unsafe
import Z.Data.Builder as B
import Z.Data.Vector as V
import Z.Data.Text.ShowT (ShowT, toBuilder)
import Z.IO.UV.FFI
import Z.IO.UV.Manager
import Z.IO.UV.Errno
import Z.IO.Exception
import Z.IO.Buffered
import Z.Foreign
data StdStream
= StdTTY {-# UNPACK #-}!(Ptr UVHandle) {-# UNPACK #-}!UVSlot UVManager
| StdFile {-# UNPACK #-}!UVFD
isStdStreamTTY :: StdStream -> Bool
isStdStreamTTY (StdTTY _ _ _) = True
isStdStreamTTY _ = False
getStdStreamFD :: StdStream -> IO UVFD
getStdStreamFD (StdTTY hdl _ _) = throwUVIfMinus (hs_uv_fileno hdl)
getStdStreamFD (StdFile fd) = return fd
instance Input StdStream where
{-# INLINE readInput #-}
readInput (StdTTY hdl slot uvm) buf len = mask_ $ do
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)
readInput (StdFile fd) buf len =
throwUVIfMinus $ hs_uv_fs_read fd buf len (-1)
instance Output StdStream where
{-# INLINE writeOutput #-}
writeOutput (StdTTY hdl _ uvm) buf len = mask_ $ do
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)
writeOutput (StdFile fd) buf len = go buf len
where
go !b !bufSiz = do
written <- throwUVIfMinus
(hs_uv_fs_write fd b bufSiz (-1))
when (written < bufSiz)
(go (b `plusPtr` written) (bufSiz-written))
stdin :: StdStream
{-# NOINLINE stdin #-}
stdin = unsafePerformIO (makeStdStream 0)
stdout :: StdStream
{-# NOINLINE stdout #-}
stdout = unsafePerformIO (makeStdStream 1)
stderr :: StdStream
{-# NOINLINE stderr #-}
stderr = unsafePerformIO (makeStdStream 2)
stdinBuf :: MVar (BufferedInput StdStream)
{-# NOINLINE stdinBuf #-}
stdinBuf = unsafePerformIO (newBufferedInput stdin >>= newMVar)
stdoutBuf :: MVar (BufferedOutput StdStream)
{-# NOINLINE stdoutBuf #-}
stdoutBuf = unsafePerformIO (newBufferedOutput stdout >>= newMVar)
stderrBuf :: MVar (BufferedOutput StdStream)
{-# NOINLINE stderrBuf #-}
stderrBuf = unsafePerformIO (newBufferedOutput stderr >>= newMVar)
makeStdStream :: HasCallStack => UVFD -> IO StdStream
makeStdStream fd = do
typ <- uv_guess_handle fd
if typ == UV_TTY
then do
uvm <- getUVManager
withUVManager uvm $ \ loop -> do
hdl <- hs_uv_handle_alloc loop
slot <- getUVSlot uvm (peekUVHandleData hdl)
_ <- tryTakeMVar =<< getBlockMVar uvm slot
throwUVIfMinus_ (uv_tty_init loop hdl (fromIntegral fd))
`onException` hs_uv_handle_free hdl
return (StdTTY hdl slot uvm)
else return (StdFile fd)
setStdinTTYMode :: TTYMode -> IO ()
setStdinTTYMode mode = case stdin of
StdTTY hdl _ uvm ->
withUVManager' uvm . throwUVIfMinus_ $ uv_tty_set_mode hdl mode
_ -> return ()
getStdoutWinSize :: HasCallStack => IO (CInt, CInt)
getStdoutWinSize = case stdout of
StdTTY hdl _ uvm ->
withUVManager' uvm $ do
(w, (h, ())) <- allocPrimUnsafe $ \ w ->
allocPrimUnsafe $ \ h -> throwUVIfMinus_ $ uv_tty_get_winsize hdl w h
return (w, h)
_ -> return (-1, -1)
printStd :: HasCallStack => ShowT a => a -> IO ()
printStd s = putStd (toBuilder s)
putStd :: HasCallStack => Builder a -> IO ()
putStd b = withMVar stdoutBuf $ \ o -> do
writeBuilder o b
flushBuffer o
putLineStd :: HasCallStack => Builder a -> IO ()
putLineStd b = withMVar stdoutBuf $ \ o -> do
writeBuilder o (b >> B.char8 '\n')
flushBuffer o
readLineStd :: HasCallStack => IO V.Bytes
readLineStd = withMVar stdinBuf $ \ s -> do
line <- readLine s
case line of Just line' -> return line'
Nothing -> throwIO (ResourceVanished
(IOEInfo "ECLOSED" "stdin is closed" callStack))