Add support for duplex and console handles to withHandleToHANDLE with winio (#192)

Author: Mistuke

System/Win32/Types.hsc

@@ -57,10 +57,11 @@ finiteBitSize = bitSize
 #endif
 
 ##if defined(__IO_MANAGER_WINIO__)
+import GHC.IO.Exception (ioException, IOException(..), IOErrorType(InappropriateType))
 import GHC.IO.SubSystem ((<!>))
 import GHC.IO.Handle.Windows
-import GHC.IO.Windows.Handle (fromHANDLE, Io(), NativeHandle(),
-                              handleToMode, optimizeFileAccess)
+import GHC.IO.Windows.Handle (fromHANDLE, Io(), NativeHandle(), ConsoleHandle(),
+                              toHANDLE, handleToMode, optimizeFileAccess)
 import qualified GHC.Event.Windows as Mgr
 import GHC.IO.Device (IODeviceType(..))
 ##endif
@@ -290,9 +291,28 @@ withHandleToHANDLENative haskell_handle action =
     -- getting to it while we are doing horrible manipulations with it, and hence
     -- stops it being finalized (and closed).
     withStablePtr haskell_handle $ const $ do
-        windows_handle <- handleToHANDLE haskell_handle
+        -- Grab the write handle variable from the Handle
+        let write_handle_mvar = case haskell_handle of
+                FileHandle _ handle_mvar     -> handle_mvar
+                DuplexHandle _ _ handle_mvar -> handle_mvar
+
+        -- This is "write" MVar, we could also take the "read" one
+        windows_handle <- readMVar write_handle_mvar >>= handle_ToHANDLE
+
         -- Do what the user originally wanted
         action windows_handle
+  where
+    -- | Turn an existing Handle into a Win32 HANDLE. This function throws an
+    -- IOError if the Handle does not reference a HANDLE
+    handle_ToHANDLE :: Handle__ -> IO HANDLE
+    handle_ToHANDLE (Handle__{haDevice = dev}) =
+        case (cast dev :: Maybe (Io NativeHandle), cast dev :: Maybe (Io ConsoleHandle)) of
+          (Just hwnd, Nothing) -> return $ toHANDLE hwnd
+          (Nothing, Just hwnd) -> return $ toHANDLE hwnd
+          _                    -> throwErr "not a known HANDLE"
+
+    throwErr msg = ioException $ IOError (Just haskell_handle)
+      InappropriateType "withHandleToHANDLENative" msg Nothing Nothing
 ##endif
 
 withHandleToHANDLEPosix :: Handle -> (HANDLE -> IO a) -> IO a

Win32.cabal

@@ -1,5 +1,5 @@
 name:           Win32
-version:        2.13.1.0
+version:        2.13.2.0
 license:        BSD3
 license-file:   LICENSE
 author:         Alastair Reid, shelarcy, Tamar Christina
@@ -11,7 +11,7 @@ category:       System, Graphics
 synopsis:       A binding to Windows Win32 API.
 description:    This library contains direct bindings to the Windows Win32 APIs for Haskell.
 build-type:     Simple
-cabal-version:  >= 2.0
+cabal-version:  2.0
 extra-source-files:
     include/diatemp.h include/dumpBMP.h include/ellipse.h include/errors.h
     include/Win32Aux.h include/win32debug.h include/alignment.h

changelog.md

@@ -3,6 +3,7 @@
 ## New - Unreleased
 
 * Set maximum string size for getComputerName. (See #190)
+* Update withHandleToHANDLENative to handle duplex and console handles (See #191)
 
 ## 2.13.1.0 November 2021