summaryrefslogtreecommitdiff
path: root/libraries
diff options
context:
space:
mode:
authorAndreas Klebinger <klebinger.andreas@gmx.at>2020-04-09 18:17:29 +0200
committerBen Gamari <ben@smart-cactus.org>2020-07-15 16:41:02 -0400
commite2c6dac783d6cb15217a3be196abeba6c6105588 (patch)
tree5736b3f2db16cddd0237cf6f002ab62c7414968e /libraries
parentbe6af7324bcd918c61172f6814b8a70a6cfdd58e (diff)
downloadhaskell-e2c6dac783d6cb15217a3be196abeba6c6105588.tar.gz
winio: Mark FD instances as unsupported under WINIO.
Diffstat (limited to 'libraries')
-rw-r--r--libraries/base/GHC/IO/FD.hs56
1 files changed, 32 insertions, 24 deletions
diff --git a/libraries/base/GHC/IO/FD.hs b/libraries/base/GHC/IO/FD.hs
index 837c8b9858..2cb71b35dc 100644
--- a/libraries/base/GHC/IO/FD.hs
+++ b/libraries/base/GHC/IO/FD.hs
@@ -6,7 +6,6 @@
{-# OPTIONS_GHC -Wno-identities #-}
-- Whether there are identities depends on the platform
{-# OPTIONS_HADDOCK not-home #-}
-
-----------------------------------------------------------------------------
-- |
-- Module : GHC.IO.FD
@@ -47,6 +46,7 @@ import GHC.IO.Exception
#if defined(mingw32_HOST_OS)
import GHC.Windows
import Data.Bool
+import GHC.IO.SubSystem ((<!>))
#endif
import Foreign
@@ -102,29 +102,37 @@ fdIsSocket fd = fdIsSocket_ fd /= 0
instance Show FD where
show fd = show (fdFD fd)
+{-# INLINE ifSupported #-}
+ifSupported :: String -> a -> a
+#if defined(mingw32_HOST_OS)
+ifSupported s a = a <!> (error $ "FD:" ++ s ++ " not supported")
+#else
+ifSupported _ = id
+#endif
+
-- | @since 4.1.0.0
instance GHC.IO.Device.RawIO FD where
- read = fdRead
- readNonBlocking = fdReadNonBlocking
- write = fdWrite
- writeNonBlocking = fdWriteNonBlocking
+ read = ifSupported "fdRead" fdRead
+ readNonBlocking = ifSupported "fdReadNonBlocking" fdReadNonBlocking
+ write = ifSupported "fdWrite" fdWrite
+ writeNonBlocking = ifSupported "fdWriteNonBlocking" fdWriteNonBlocking
-- | @since 4.1.0.0
instance GHC.IO.Device.IODevice FD where
- ready = ready
- close = close
- isTerminal = isTerminal
- isSeekable = isSeekable
- seek = seek
- tell = tell
- getSize = getSize
- setSize = setSize
- setEcho = setEcho
- getEcho = getEcho
- setRaw = setRaw
- devType = devType
- dup = dup
- dup2 = dup2
+ ready = ifSupported "ready" ready
+ close = ifSupported "close" close
+ isTerminal = ifSupported "isTerm" isTerminal
+ isSeekable = ifSupported "isSeek" isSeekable
+ seek = ifSupported "seek" seek
+ tell = ifSupported "tell" tell
+ getSize = ifSupported "getSize" getSize
+ setSize = ifSupported "setSize" setSize
+ setEcho = ifSupported "setEcho" setEcho
+ getEcho = ifSupported "getEcho" getEcho
+ setRaw = ifSupported "setRaw" setRaw
+ devType = ifSupported "devType" devType
+ dup = ifSupported "dup" dup
+ dup2 = ifSupported "dup2" dup2
-- We used to use System.Posix.Internals.dEFAULT_BUFFER_SIZE, which is
-- taken from the value of BUFSIZ on the current platform. This value
@@ -135,11 +143,11 @@ dEFAULT_FD_BUFFER_SIZE = 8192
-- | @since 4.1.0.0
instance BufferedIO FD where
- newBuffer _dev state = newByteBuffer dEFAULT_FD_BUFFER_SIZE state
- fillReadBuffer fd buf = readBuf' fd buf
- fillReadBuffer0 fd buf = readBufNonBlocking fd buf
- flushWriteBuffer fd buf = writeBuf' fd buf
- flushWriteBuffer0 fd buf = writeBufNonBlocking fd buf
+ newBuffer _dev state = ifSupported "newBuf" $ newByteBuffer dEFAULT_FD_BUFFER_SIZE state
+ fillReadBuffer fd buf = ifSupported "readBuf" $ readBuf' fd buf
+ fillReadBuffer0 fd buf = ifSupported "readBufNonBlock" $ readBufNonBlocking fd buf
+ flushWriteBuffer fd buf = ifSupported "writeBuf" $ writeBuf' fd buf
+ flushWriteBuffer0 fd buf = ifSupported "writeBufNonBlock" $ writeBufNonBlocking fd buf
readBuf' :: FD -> Buffer Word8 -> IO (Int, Buffer Word8)
readBuf' fd buf = do