Wolfgang Jeltsch pushed to branch wip/jeltsch/detecting-os-handle-types at Glasgow Haskell Compiler / GHC Commits: 3f8d806e by Wolfgang Jeltsch at 2026-01-27T16:51:12+02:00 Add OS handle type detection to `base` It is deliberate that this addition to `base` does not simply reflect the `conditional`/`` operation currently in `GHC.IO.SubSystem` but simply uses the value of a custom enumeration type to describe the type of OS handles currently in use. The reason for using this approach is that it is simpler and at the same type more future-proof: if a new OS handle type should be introduced in the future, it would only be necessary to add another value to `OSHandleType`, and user code that uses fallback branches in case distinctions regarding OS handle types would continue to be compilable at least; `conditional`, on the other hand, would have to have its argument count changed and `` could not even be used as an infix operator anymore. Since Haskell has `case` expressions, there is no real need to have a case-distinguishing operation like `conditional`/``. - - - - - 20 changed files: - libraries/base/changelog.md - libraries/base/src/System/IO/OS.hs - libraries/base/tests/IO/all.T - libraries/base/tests/IO/osHandles001FileDescriptors.hs - libraries/base/tests/IO/osHandles001FileDescriptors.stdout - libraries/base/tests/IO/osHandles001WindowsHandles.hs - libraries/base/tests/IO/osHandles001WindowsHandles.stdout - libraries/base/tests/IO/osHandles002FileDescriptors.hs - libraries/base/tests/IO/osHandles002FileDescriptors.stdout - libraries/base/tests/IO/osHandles002WindowsHandles.hs - libraries/base/tests/IO/osHandles002WindowsHandles.stdout - + libraries/base/tests/IO/osHandles003FileDescriptors.hs - libraries/base/tests/IO/osHandles002FileDescriptors.stderr → libraries/base/tests/IO/osHandles003FileDescriptors.stderr - libraries/base/tests/IO/osHandles002FileDescriptors.stdin → libraries/base/tests/IO/osHandles003FileDescriptors.stdin - libraries/base/tests/IO/osHandles002WindowsHandles.stdin → libraries/base/tests/IO/osHandles003FileDescriptors.stdout - + libraries/base/tests/IO/osHandles003WindowsHandles.hs - libraries/base/tests/IO/osHandles002WindowsHandles.stderr → libraries/base/tests/IO/osHandles003WindowsHandles.stderr - + libraries/base/tests/IO/osHandles003WindowsHandles.stdin - + libraries/base/tests/IO/osHandles003WindowsHandles.stdout - libraries/ghc-internal/src/GHC/Internal/System/IO/OS.hs Changes: ===================================== libraries/base/changelog.md ===================================== @@ -23,7 +23,7 @@ * `GHC.Conc.catchSTM` and `GHC.Conc.Sync.catchSTM` now attach `WhileHandling` annotation to exceptions thrown from the handler. ([GHC #25365](https://gitlab.haskell.org/ghc/ghc/-/issues/25365)) * Remove `GHC.JS.Prim.Internal.Build`, as per [CLC #329](https://github.com/haskell/core-libraries-committee/issues/329) * Export `labelThread` from `Control.Concurrent`.([CLC proposal #376](https://github.com/haskell/core-libraries-committee/issues/376)) - * Add a new module `System.IO.OS` with operations for obtaining operating-system handles (file descriptors, Windows handles). ([CLC proposal #369](https://github.com/haskell/core-libraries-committee/issues/369)) + * Add a new module `System.IO.OS` with operations for detecting the type of operating-system handles in use (file descriptors, Windows handles) and obtaining such handles. (CLC proposals [#395](https://github.com/haskell/core-libraries-committee/issues/395) and [#369](https://github.com/haskell/core-libraries-committee/issues/369)) ## 4.22.0.0 *TBA* * Shipped with GHC 9.14.1 ===================================== libraries/base/src/System/IO/OS.hs ===================================== @@ -6,6 +6,10 @@ -} module System.IO.OS ( + -- * OS handle type detection + OSHandleType (FileDescriptor, WindowsHandle), + osHandleType, + -- * Obtaining file descriptors and Windows handles withFileDescriptorReadingBiased, withFileDescriptorWritingBiased, @@ -23,6 +27,8 @@ where import GHC.Internal.System.IO.OS ( + OSHandleType (FileDescriptor, WindowsHandle), + osHandleType, withFileDescriptorReadingBiased, withFileDescriptorWritingBiased, withWindowsHandleReadingBiased, ===================================== libraries/base/tests/IO/all.T ===================================== @@ -189,9 +189,11 @@ test('mkdirExists', [exit_code(1), when(opsys('mingw32'), ignore_stderr)], compi test('osHandles001FileDescriptors', omit_ways(['winio', 'winio_threaded']), compile_and_run, ['']) test('osHandles001WindowsHandles', only_ways(['winio', 'winio_threaded']), compile_and_run, ['']) -test('osHandles002FileDescriptors', [when(opsys('mingw32'), skip), when(arch('javascript'), skip)], compile_and_run, ['']) +test('osHandles002FileDescriptors', omit_ways(['winio', 'winio_threaded']), compile_and_run, ['']) test('osHandles002WindowsHandles', only_ways(['winio', 'winio_threaded']), compile_and_run, ['']) -# It would be good to let `osHandles002FileDescriptors` run also on +test('osHandles003FileDescriptors', [when(opsys('mingw32'), skip), when(arch('javascript'), skip)], compile_and_run, ['']) +test('osHandles003WindowsHandles', only_ways(['winio', 'winio_threaded']), compile_and_run, ['']) +# It would be good to let `osHandles003FileDescriptors` run also on # Windows with the file-descriptor-based I/O manager. However, this # test, as it is currently implemented, requires the `unix` package. # That said, `UCRT.DLL`, which is used by GHC-generated Windows ===================================== libraries/base/tests/IO/osHandles001FileDescriptors.hs ===================================== @@ -1,23 +1,4 @@ -{-# LANGUAGE TypeApplications #-} - -import Control.Monad (mapM_) -import Control.Exception (SomeException, try) -import System.IO (stdin, stdout, stderr) -import System.IO.OS - ( - withFileDescriptorReadingBiasedRaw, - withFileDescriptorWritingBiasedRaw, - withWindowsHandleReadingBiasedRaw, - withWindowsHandleWritingBiasedRaw - ) +import System.IO.OS (osHandleType) main :: IO () -main = mapM_ ((>>= print) . try @SomeException) $ - [ - withFileDescriptorReadingBiasedRaw stdin (return . show), - withFileDescriptorWritingBiasedRaw stdout (return . show), - withFileDescriptorWritingBiasedRaw stderr (return . show), - withWindowsHandleReadingBiasedRaw stdin (return . const "_"), - withWindowsHandleWritingBiasedRaw stdout (return . const "_"), - withWindowsHandleWritingBiasedRaw stderr (return . const "_") - ] +main = print osHandleType ===================================== libraries/base/tests/IO/osHandles001FileDescriptors.stdout ===================================== @@ -1,6 +1 @@ -Right "0" -Right "1" -Right "2" -Left <stdin>: withWindowsHandleReadingBiasedRaw: inappropriate type (handle does not use Windows handles) -Left <stdout>: withWindowsHandleWritingBiasedRaw: inappropriate type (handle does not use Windows handles) -Left <stderr>: withWindowsHandleWritingBiasedRaw: inappropriate type (handle does not use Windows handles) +FileDescriptor ===================================== libraries/base/tests/IO/osHandles001WindowsHandles.hs ===================================== @@ -1,23 +1,4 @@ -{-# LANGUAGE TypeApplications #-} - -import Control.Monad (mapM_) -import Control.Exception (SomeException, try) -import System.IO (stdin, stdout, stderr) -import System.IO.OS - ( - withFileDescriptorReadingBiasedRaw, - withFileDescriptorWritingBiasedRaw, - withWindowsHandleReadingBiasedRaw, - withWindowsHandleWritingBiasedRaw - ) +import System.IO.OS (osHandleType) main :: IO () -main = mapM_ ((>>= print) . try @SomeException) $ - [ - withFileDescriptorReadingBiasedRaw stdin (return . show), - withFileDescriptorWritingBiasedRaw stdout (return . show), - withFileDescriptorWritingBiasedRaw stderr (return . show), - withWindowsHandleReadingBiasedRaw stdin (return . const "_"), - withWindowsHandleWritingBiasedRaw stdout (return . const "_"), - withWindowsHandleWritingBiasedRaw stderr (return . const "_") - ] +main = print osHandleType ===================================== libraries/base/tests/IO/osHandles001WindowsHandles.stdout ===================================== @@ -1,6 +1 @@ -Left <stdin>: withFileDescriptorReadingBiasedRaw: inappropriate type (handle does not use file descriptors) -Left <stdout>: withFileDescriptorWritingBiasedRaw: inappropriate type (handle does not use file descriptors) -Left <stderr>: withFileDescriptorWritingBiasedRaw: inappropriate type (handle does not use file descriptors) -Right "_" -Right "_" -Right "_" +WindowsHandle ===================================== libraries/base/tests/IO/osHandles002FileDescriptors.hs ===================================== @@ -1,28 +1,23 @@ -import Data.Functor (void) -import Data.ByteString.Char8 (pack) -import System.Posix.Types (Fd (Fd), ByteCount) -import System.Posix.IO.ByteString (fdRead, fdWrite) +{-# LANGUAGE TypeApplications #-} + +import Control.Monad (mapM_) +import Control.Exception (SomeException, try) import System.IO (stdin, stdout, stderr) import System.IO.OS ( - withFileDescriptorReadingBiased, - withFileDescriptorWritingBiased + withFileDescriptorReadingBiasedRaw, + withFileDescriptorWritingBiasedRaw, + withWindowsHandleReadingBiasedRaw, + withWindowsHandleWritingBiasedRaw ) main :: IO () -main = withFileDescriptorReadingBiased stdin $ \ stdinFD -> - withFileDescriptorWritingBiased stdout $ \ stdoutFD -> - withFileDescriptorWritingBiased stderr $ \ stderrFD -> - do - regularMsg <- fdRead (Fd stdinFD) inputSizeApproximation - void $ fdWrite (Fd stdoutFD) regularMsg - void $ fdWrite (Fd stderrFD) (pack errorMsg) - where - - inputSizeApproximation :: ByteCount - inputSizeApproximation = 100 - - errorMsg :: String - errorMsg = "And every single door\n\ - \That I've walked through\n\ - \Brings me back, back here again\n" +main = mapM_ ((>>= print) . try @SomeException) $ + [ + withFileDescriptorReadingBiasedRaw stdin (return . show), + withFileDescriptorWritingBiasedRaw stdout (return . show), + withFileDescriptorWritingBiasedRaw stderr (return . show), + withWindowsHandleReadingBiasedRaw stdin (return . const "_"), + withWindowsHandleWritingBiasedRaw stdout (return . const "_"), + withWindowsHandleWritingBiasedRaw stderr (return . const "_") + ] ===================================== libraries/base/tests/IO/osHandles002FileDescriptors.stdout ===================================== @@ -1 +1,6 @@ -We've got to get in to get out +Right "0" +Right "1" +Right "2" +Left <stdin>: withWindowsHandleReadingBiasedRaw: inappropriate type (handle does not use Windows handles) +Left <stdout>: withWindowsHandleWritingBiasedRaw: inappropriate type (handle does not use Windows handles) +Left <stderr>: withWindowsHandleWritingBiasedRaw: inappropriate type (handle does not use Windows handles) ===================================== libraries/base/tests/IO/osHandles002WindowsHandles.hs ===================================== @@ -1,49 +1,23 @@ -import Control.Monad (zipWithM_) -import Data.Functor (void) -import Data.Char (ord) -import Foreign.Marshal.Alloc (allocaBytes) -import Foreign.Storable (pokeElemOff) +{-# LANGUAGE TypeApplications #-} + +import Control.Monad (mapM_) +import Control.Exception (SomeException, try) import System.IO (stdin, stdout, stderr) import System.IO.OS ( - withWindowsHandleReadingBiased, - withWindowsHandleWritingBiased + withFileDescriptorReadingBiasedRaw, + withFileDescriptorWritingBiasedRaw, + withWindowsHandleReadingBiasedRaw, + withWindowsHandleWritingBiasedRaw ) main :: IO () -main = withWindowsHandleReadingBiased stdin $ \ windowsStdin -> - withWindowsHandleWritingBiased stdout $ \ windowsStdout -> - withWindowsHandleWritingBiased stderr $ \ windowsStderr -> - do - withBuffer inputSizeApproximation $ \ bufferPtr -> do - inputSize <- win32_ReadFile windowsStdin - bufferPtr - inputSizeApproximation - Nothing - void $ win32_WriteFile windowsStdout - bufferPtr - inputSize - Nothing - withBuffer errorMsgSize $ \ bufferPtr -> do - zipWithM_ (pokeElemOff bufferPtr) - [0 ..] - (map (fromIntegral . ord) errorMsg) - void $ win32_WriteFile windowsStderr - bufferPtr - errorMsgSize - Nothing - where - - withBuffer :: DWORD -> (Ptr Word8 -> IO a) -> IO a - withBuffer = allocaBytes . fromIntegral - - inputSizeApproximation :: DWORD - inputSizeApproximation = 100 - - errorMsg :: String - errorMsg = "And every single door\n\ - \That I've walked through\n\ - \Brings me back, back here again\n" - - errorMsgSize :: DWORD - errorMsgSize = fromIntegral (length errorMsg) +main = mapM_ ((>>= print) . try @SomeException) $ + [ + withFileDescriptorReadingBiasedRaw stdin (return . show), + withFileDescriptorWritingBiasedRaw stdout (return . show), + withFileDescriptorWritingBiasedRaw stderr (return . show), + withWindowsHandleReadingBiasedRaw stdin (return . const "_"), + withWindowsHandleWritingBiasedRaw stdout (return . const "_"), + withWindowsHandleWritingBiasedRaw stderr (return . const "_") + ] ===================================== libraries/base/tests/IO/osHandles002WindowsHandles.stdout ===================================== @@ -1 +1,6 @@ -We've got to get in to get out +Left <stdin>: withFileDescriptorReadingBiasedRaw: inappropriate type (handle does not use file descriptors) +Left <stdout>: withFileDescriptorWritingBiasedRaw: inappropriate type (handle does not use file descriptors) +Left <stderr>: withFileDescriptorWritingBiasedRaw: inappropriate type (handle does not use file descriptors) +Right "_" +Right "_" +Right "_" ===================================== libraries/base/tests/IO/osHandles003FileDescriptors.hs ===================================== @@ -0,0 +1,28 @@ +import Data.Functor (void) +import Data.ByteString.Char8 (pack) +import System.Posix.Types (Fd (Fd), ByteCount) +import System.Posix.IO.ByteString (fdRead, fdWrite) +import System.IO (stdin, stdout, stderr) +import System.IO.OS + ( + withFileDescriptorReadingBiased, + withFileDescriptorWritingBiased + ) + +main :: IO () +main = withFileDescriptorReadingBiased stdin $ \ stdinFD -> + withFileDescriptorWritingBiased stdout $ \ stdoutFD -> + withFileDescriptorWritingBiased stderr $ \ stderrFD -> + do + regularMsg <- fdRead (Fd stdinFD) inputSizeApproximation + void $ fdWrite (Fd stdoutFD) regularMsg + void $ fdWrite (Fd stderrFD) (pack errorMsg) + where + + inputSizeApproximation :: ByteCount + inputSizeApproximation = 100 + + errorMsg :: String + errorMsg = "And every single door\n\ + \That I've walked through\n\ + \Brings me back, back here again\n" ===================================== libraries/base/tests/IO/osHandles002FileDescriptors.stderr → libraries/base/tests/IO/osHandles003FileDescriptors.stderr ===================================== ===================================== libraries/base/tests/IO/osHandles002FileDescriptors.stdin → libraries/base/tests/IO/osHandles003FileDescriptors.stdin ===================================== ===================================== libraries/base/tests/IO/osHandles002WindowsHandles.stdin → libraries/base/tests/IO/osHandles003FileDescriptors.stdout ===================================== ===================================== libraries/base/tests/IO/osHandles003WindowsHandles.hs ===================================== @@ -0,0 +1,49 @@ +import Control.Monad (zipWithM_) +import Data.Functor (void) +import Data.Char (ord) +import Foreign.Marshal.Alloc (allocaBytes) +import Foreign.Storable (pokeElemOff) +import System.IO (stdin, stdout, stderr) +import System.IO.OS + ( + withWindowsHandleReadingBiased, + withWindowsHandleWritingBiased + ) + +main :: IO () +main = withWindowsHandleReadingBiased stdin $ \ windowsStdin -> + withWindowsHandleWritingBiased stdout $ \ windowsStdout -> + withWindowsHandleWritingBiased stderr $ \ windowsStderr -> + do + withBuffer inputSizeApproximation $ \ bufferPtr -> do + inputSize <- win32_ReadFile windowsStdin + bufferPtr + inputSizeApproximation + Nothing + void $ win32_WriteFile windowsStdout + bufferPtr + inputSize + Nothing + withBuffer errorMsgSize $ \ bufferPtr -> do + zipWithM_ (pokeElemOff bufferPtr) + [0 ..] + (map (fromIntegral . ord) errorMsg) + void $ win32_WriteFile windowsStderr + bufferPtr + errorMsgSize + Nothing + where + + withBuffer :: DWORD -> (Ptr Word8 -> IO a) -> IO a + withBuffer = allocaBytes . fromIntegral + + inputSizeApproximation :: DWORD + inputSizeApproximation = 100 + + errorMsg :: String + errorMsg = "And every single door\n\ + \That I've walked through\n\ + \Brings me back, back here again\n" + + errorMsgSize :: DWORD + errorMsgSize = fromIntegral (length errorMsg) ===================================== libraries/base/tests/IO/osHandles002WindowsHandles.stderr → libraries/base/tests/IO/osHandles003WindowsHandles.stderr ===================================== ===================================== libraries/base/tests/IO/osHandles003WindowsHandles.stdin ===================================== @@ -0,0 +1 @@ +We've got to get in to get out ===================================== libraries/base/tests/IO/osHandles003WindowsHandles.stdout ===================================== @@ -0,0 +1 @@ +We've got to get in to get out ===================================== libraries/ghc-internal/src/GHC/Internal/System/IO/OS.hs ===================================== @@ -8,6 +8,10 @@ -} module GHC.Internal.System.IO.OS ( + -- * OS handle type detection + OSHandleType (FileDescriptor, WindowsHandle), + osHandleType, + -- * Obtaining file descriptors and Windows handles withFileDescriptorReadingBiased, withFileDescriptorWritingBiased, @@ -23,6 +27,10 @@ module GHC.Internal.System.IO.OS ) where +import GHC.Internal.Classes (Eq, Ord) +import GHC.Internal.Enum (Bounded, Enum) +import GHC.Internal.Show (Show) +import GHC.Internal.Read (Read) import GHC.Internal.Control.Monad (return) import GHC.Internal.Control.Concurrent.MVar (MVar) import GHC.Internal.Control.Exception (mask) @@ -39,6 +47,7 @@ import GHC.Internal.Data.List ((++)) import GHC.Internal.Data.String (String) import GHC.Internal.Data.Typeable (Typeable, cast) import GHC.Internal.System.IO (IO) +import GHC.Internal.IO.SubSystem (conditional) import GHC.Internal.IO.FD (fdFD) #if defined(mingw32_HOST_OS) import GHC.Internal.IO.Windows.Handle @@ -64,6 +73,19 @@ import GHC.Internal.IO.Exception import GHC.Internal.Foreign.Ptr (Ptr) import GHC.Internal.Foreign.C.Types (CInt) +-- * OS handle type detection + +-- | The type of operating-system handle types. +data OSHandleType = FileDescriptor | WindowsHandle + deriving (Eq, Ord, Bounded, Enum, Show, Read) + +{-| + The type of operating-system handles that underlie Haskell handles with the + I/O manager currently in use. +-} +osHandleType :: OSHandleType +osHandleType = conditional FileDescriptor WindowsHandle + -- * Obtaining POSIX file descriptors and Windows handles {-| View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3f8d806e9421db25e2773b674ac45abe... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3f8d806e9421db25e2773b674ac45abe... You're receiving this email because of your account on gitlab.haskell.org.
participants (1)
-
Wolfgang Jeltsch (＠jeltsch)