haskell / win32

Haskell support for the Win32 API
http://hackage.haskell.org/package/Win32
Other
97 stars 63 forks source link

Add withHandleToHANDLE from ansi-terminal #70

Closed RyanGlScott closed 7 years ago

RyanGlScott commented 7 years ago

This brings over the withHandleToHANDLE function from the ansi-terminal library. I also added a basic test to ensure that it works with the standard handles.

I contemplated implementing the opposite direction (hANDLEToHandle?), but I'm not quite sure what the best way to do it would be. There's at least two different implementations (this and this) in GHC, for instance. As a result, I decided to leave that part alone.

Fixes #51.

Mistuke commented 7 years ago

Thanks @RyanGlScott ! W.r.t the inverse function, they're both essentially the same. I wrote the one in GHCi.hsc but don't know where the second came from. But they both do the same. so the one in Utils.hsc is a bit more general. We can probably include that one.

RyanGlScott commented 7 years ago

Hrm. I tried implementing hANDLEToHandle like so:

diff --git a/System/Win32/Types.hsc b/System/Win32/Types.hsc
index 4393c51..1e5e447 100755
--- a/System/Win32/Types.hsc
+++ b/System/Win32/Types.hsc
@@ -32,12 +32,13 @@ import Data.Word (Word8, Word16, Word32, Word64)
 import Foreign.C.Error (Errno(..), errnoToIOError)
 import Foreign.C.String (newCWString, withCWStringLen)
 import Foreign.C.String (peekCWString, peekCWStringLen, withCWString)
-import Foreign.C.Types (CChar, CUChar, CWchar, CInt(..), CIntPtr, CUIntPtr)
+import Foreign.C.Types (CChar, CUChar, CWchar, CInt(..), CIntPtr(..), CUIntPtr)
 import Foreign.ForeignPtr (ForeignPtr, newForeignPtr, newForeignPtr_)
-import Foreign.Ptr (FunPtr, Ptr, nullPtr)
+import Foreign.Ptr (FunPtr, Ptr, nullPtr, ptrToIntPtr)
 import Foreign.StablePtr (StablePtr, freeStablePtr, newStablePtr)
 import Foreign (allocaArray)
 import GHC.IO.FD (FD(..))
+import GHC.IO.Handle.FD (fdToHandle)
 import GHC.IO.Handle.Types (Handle(..), Handle__(..))
 import Numeric (showHex)
 import System.IO.Error (ioeSetErrorString)
@@ -56,6 +57,7 @@ finiteBitSize :: (Bits a) => a -> Int
 finiteBitSize = bitSize
 #endif

+#include <fcntl.h>
 #include <windows.h>
 ##include "windows_cconv.h"

@@ -218,6 +220,13 @@ nullFinalHANDLE = unsafePerformIO (newForeignPtr_ nullPtr)
 iNVALID_HANDLE_VALUE :: HANDLE
 iNVALID_HANDLE_VALUE = castUINTPtrToPtr (-1)

+foreign import ccall "_open_osfhandle"
+  _open_osfhandle :: CIntPtr -> CInt -> IO CInt
+
+hANDLEToHandle :: HANDLE -> IO Handle
+hANDLEToHandle handle =
+  _open_osfhandle (fromIntegral (ptrToIntPtr handle)) (#const _O_BINARY) >>= fdToHandle
+
 foreign import ccall unsafe "_get_osfhandle"
   c_get_osfhandle :: CInt -> IO HANDLE

It works, but only in a limited sense. You can, for instance, print to standard output:

> import System.Win32.Types
> import Graphics.Win32
> import System.IO
> __stdout <- getStdHandle sTD_OUTPUT_HANDLE
> stdout2 <- hANDLEToHandle __stdout
> hPutStrLn stdout2 "foo"
foo

However, stdout2 is not the same thing as the stdout Handle:

> stdout == stdout2
False
> stdout
{handle: <stdout>}
> stdout2
{handle: <file descriptor: 3>}

stdout is a FileHandle, but stdout2 is a DuplexHandle.

Is this acceptable?

Mistuke commented 7 years ago

To be perfectly honest, I'm not even sure that handle -> fd, fd -> handle returns the same. It's likely it's internally duplicating the Handle. But also the way GHC handles Handles is complex. I'm perfectly willing to accept that function with that caveat. If it causes problems for anyone I'll look into it then. We can just add a note to the documentation.

RyanGlScott commented 7 years ago

OK, I've added hANDLEToHandle with a little disclaimer.

Mistuke commented 7 years ago

Many thanks kind sir!

On Thu, 12 Jan 2017, 16:03 Ryan Scott, notifications@github.com wrote:

OK, I've added hANDLEToHandle with a little disclaimer.

— You are receiving this because you commented.

Reply to this email directly, view it on GitHub https://github.com/haskell/win32/pull/70#issuecomment-272203207, or mute the thread https://github.com/notifications/unsubscribe-auth/ABH3KXQu3Af8fu1_wLBQ6C4qYf6gGzVTks5rRk7sgaJpZM4LdwVF .