Skip to content

Switch to high-level operations for obtaining OS handles #211

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
wants to merge 1 commit into
base: master
Choose a base branch
from
Open

Switch to high-level operations for obtaining OS handles #211

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
14 changes: 2 additions & 12 deletions System/Console/Haskeline/Backend/Posix.hsc
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -38,12 +38,8 @@ import System.Console.Haskeline.Prefs

import System.Console.Haskeline.Backend.Posix.Encoder

import GHC.IO.FD (fdFD)
import Data.Typeable (cast)
import System.IO.Error
import GHC.IO.Exception
import GHC.IO.Handle.Types hiding (getState)
import GHC.IO.Handle.Internals
import System.IO.OS (withFileDescriptorReadingBiasedRaw)
import System.Posix.Internals (FD)

#if defined(USE_TERMIOS_H) || defined(__ANDROID__)
Expand Down Expand Up @@ -87,13 +83,7 @@ ioctlLayout h = allocaBytes (#size struct winsize) $ \ws -> do
#endif

unsafeHandleToFD :: Handle -> IO FD
unsafeHandleToFD h =
withHandle_ "unsafeHandleToFd" h $ \Handle__{haDevice=dev} -> do
case cast dev of
Nothing -> ioError (ioeSetErrorString (mkIOError IllegalOperation
"unsafeHandleToFd" (Just h) Nothing)
"handle is not a file descriptor")
Just fd -> return (fdFD fd)
unsafeHandleToFD h = withFileDescriptorReadingBiasedRaw h $ return

envLayout :: IO (Maybe Layout)
envLayout = handle (\(_::IOException) -> return Nothing) $ do
Expand Down
72 changes: 3 additions & 69 deletions System/Console/Haskeline/Backend/Win32/Echo.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -12,22 +12,8 @@ import System.IO (Handle, hGetContents, hGetEcho, hSetEcho)
import System.Process (StdStream(..), createProcess, shell,
std_in, std_out, waitForProcess)

#if MIN_VERSION_Win32(2,5,0)
import Control.Concurrent.MVar (readMVar)

import Data.Typeable (cast)

import Foreign.C.Types
import Foreign.StablePtr (StablePtr, freeStablePtr, newStablePtr)

import GHC.IO.FD (FD(..))
#if defined(__IO_MANAGER_WINIO__)
import GHC.IO.Handle.Windows (handleToHANDLE)
import GHC.IO.SubSystem ((<!>))
#endif
import GHC.IO.Handle.Types (Handle(..), Handle__(..))

import System.Win32.Types (HANDLE)
#if MIN_VERSION_Win32(2,5,1)
import System.Win32.Types (withHandleToHANDLE)
import System.Win32.MinTTY (isMinTTYHandle)
#endif

Expand Down Expand Up @@ -133,61 +119,9 @@ type STTYSettings = String

-- | Is the current process attached to a MinTTY console (e.g., Cygwin or MSYS)?
minTTY :: Handle -> IO Bool
#if MIN_VERSION_Win32(2,5,0)
#if MIN_VERSION_Win32(2,5,1)
minTTY input = withHandleToHANDLE input isMinTTYHandle
#else
-- On older versions of Win32, we simply punt.
minTTY _ = return False
#endif

#if MIN_VERSION_Win32(2,5,0)
foreign import ccall unsafe "_get_osfhandle"
c_get_osfhandle :: CInt -> IO HANDLE

-- | Extract a Windows 'HANDLE' from a Haskell 'Handle' and perform
-- an action on it.

-- Originally authored by Max Bolingbroke in the ansi-terminal library
withHandleToHANDLE :: Handle -> (HANDLE -> IO a) -> IO a
#if defined(__IO_MANAGER_WINIO__)
withHandleToHANDLE = withHandleToHANDLEPosix <!> withHandleToHANDLENative
#else
withHandleToHANDLE = withHandleToHANDLEPosix
#endif

#if defined(__IO_MANAGER_WINIO__)
withHandleToHANDLENative :: Handle -> (HANDLE -> IO a) -> IO a
withHandleToHANDLENative haskell_handle action =
-- Create a stable pointer to the Handle. This prevents the garbage collector
-- 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
-- Do what the user originally wanted
action windows_handle
#endif

withHandleToHANDLEPosix :: Handle -> (HANDLE -> IO a) -> IO a
withHandleToHANDLEPosix haskell_handle action =
-- Create a stable pointer to the Handle. This prevents the garbage collector
-- getting to it while we are doing horrible manipulations with it, and hence
-- stops it being finalized (and closed).
withStablePtr haskell_handle $ const $ do
-- 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

-- Get the FD from the algebraic data type
Just fd <- fmap (\(Handle__ { haDevice = dev }) -> fmap fdFD (cast dev))
$ readMVar write_handle_mvar

-- Finally, turn that (C-land) FD into a HANDLE using msvcrt
windows_handle <- c_get_osfhandle fd
-- Do what the user originally wanted
action windows_handle

withStablePtr :: a -> (StablePtr a -> IO b) -> IO b
withStablePtr value = bracket (newStablePtr value) freeStablePtr
#endif
Loading