diff options
| author | Tamar Christina <tamar@zhox.com> | 2022-01-18 01:30:42 +0000 |
|---|---|---|
| committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2022-04-28 22:19:34 -0400 |
| commit | 905206d67854edbc89978bd554724f57dc8553c2 (patch) | |
| tree | 1e5bb9ba25985b0f3adca6194533ac52c4a83914 /libraries/libiserv | |
| parent | 292e39713e2e17ca902e575d6a41a6f95ee444b2 (diff) | |
| download | haskell-905206d67854edbc89978bd554724f57dc8553c2.tar.gz | |
winio: add support to iserv.
Diffstat (limited to 'libraries/libiserv')
| -rw-r--r-- | libraries/libiserv/src/GHCi/Utils.hsc | 29 |
1 files changed, 27 insertions, 2 deletions
diff --git a/libraries/libiserv/src/GHCi/Utils.hsc b/libraries/libiserv/src/GHCi/Utils.hsc index f606eb9d94..6b6613ad1b 100644 --- a/libraries/libiserv/src/GHCi/Utils.hsc +++ b/libraries/libiserv/src/GHCi/Utils.hsc @@ -6,7 +6,16 @@ module GHCi.Utils import Foreign.C import GHC.IO.Handle (Handle()) #if defined(mingw32_HOST_OS) +import Foreign.Ptr (ptrToIntPtr) +import GHC.IO (onException) import GHC.IO.Handle.FD (fdToHandle) +import GHC.Windows (HANDLE) +import GHC.IO.SubSystem ((<!>)) +import GHC.IO.Handle.Windows (mkHandleFromHANDLE) +import GHC.IO.Device as IODevice +import GHC.IO.Encoding (getLocaleEncoding) +import GHC.IO.IOMode +import GHC.IO.Windows.Handle (fromHANDLE, Io(), NativeHandle()) #else import System.Posix #endif @@ -14,12 +23,28 @@ import System.Posix #include <fcntl.h> /* for _O_BINARY */ -- | Gets a GHC Handle File description from the given OS Handle or POSIX fd. -getGhcHandle :: CInt -> IO Handle + #if defined(mingw32_HOST_OS) -getGhcHandle handle = _open_osfhandle handle (#const _O_BINARY) >>= fdToHandle +getGhcHandle :: HANDLE -> IO Handle +getGhcHandle = getGhcHandlePOSIX <!> getGhcHandleNative + +getGhcHandlePOSIX :: HANDLE -> IO Handle +getGhcHandlePOSIX handle = do + let intptr = ptrToIntPtr handle + _open_osfhandle (fromIntegral intptr) (#const _O_BINARY) >>= fdToHandle + +getGhcHandleNative :: HANDLE -> IO Handle +getGhcHandleNative hwnd = + do mb_codec <- fmap Just getLocaleEncoding + let iomode = ReadWriteMode + native_handle = fromHANDLE hwnd :: Io NativeHandle + hw_type <- IODevice.devType $ native_handle + mkHandleFromHANDLE native_handle hw_type (show hwnd) iomode mb_codec + `onException` IODevice.close native_handle foreign import ccall "io.h _open_osfhandle" _open_osfhandle :: CInt -> CInt -> IO CInt #else +getGhcHandle :: CInt -> IO Handle getGhcHandle fd = fdToHandle $ Fd fd #endif |