diff options
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 |