Wolfgang Jeltsch pushed to branch wip/jeltsch/obtaining-os-handles at Glasgow Haskell Compiler / GHC
Commits:
-
5dcfb400
by Wolfgang Jeltsch at 2025-09-24T20:58:18+03:00
-
40318687
by Wolfgang Jeltsch at 2025-09-24T21:00:40+03:00
-
0a1ccf29
by Wolfgang Jeltsch at 2025-09-24T21:03:38+03:00
3 changed files:
- libraries/base/base.cabal.in
- libraries/base/src/GHC/IO/Handle.hs
- + libraries/base/src/System/IO/OS.hs
Changes:
| ... | ... | @@ -258,6 +258,7 @@ Library |
| 258 | 258 | , System.Exit
|
| 259 | 259 | , System.IO
|
| 260 | 260 | , System.IO.Error
|
| 261 | + , System.IO.OS
|
|
| 261 | 262 | , System.Mem
|
| 262 | 263 | , System.Mem.StableName
|
| 263 | 264 | , System.Posix.Internals
|
| 1 | 1 | {-# LANGUAGE Safe #-}
|
| 2 | -{-# LANGUAGE CPP #-}
|
|
| 3 | -{-# LANGUAGE RankNTypes #-}
|
|
| 4 | 2 | |
| 5 | 3 | -- |
|
| 6 | 4 | --
|
| ... | ... | @@ -16,8 +14,7 @@ |
| 16 | 14 | --
|
| 17 | 15 | |
| 18 | 16 | module GHC.IO.Handle
|
| 19 | - (-- * Portable operations
|
|
| 20 | - Handle,
|
|
| 17 | + (Handle,
|
|
| 21 | 18 | BufferMode(..),
|
| 22 | 19 | mkFileHandle,
|
| 23 | 20 | mkDuplexHandle,
|
| ... | ... | @@ -73,337 +70,7 @@ module GHC.IO.Handle |
| 73 | 70 | hGetBuf,
|
| 74 | 71 | hGetBufNonBlocking,
|
| 75 | 72 | hPutBuf,
|
| 76 | - hPutBufNonBlocking,
|
|
| 77 | - |
|
| 78 | - -- * Obtaining file descriptors and Windows handles
|
|
| 79 | - withFileDescriptorReadingBiased,
|
|
| 80 | - withFileDescriptorWritingBiased,
|
|
| 81 | - withWindowsHandleReadingBiased,
|
|
| 82 | - withWindowsHandleWritingBiased,
|
|
| 83 | - withFileDescriptorReadingBiasedRaw,
|
|
| 84 | - withFileDescriptorWritingBiasedRaw,
|
|
| 85 | - withWindowsHandleReadingBiasedRaw,
|
|
| 86 | - withWindowsHandleWritingBiasedRaw
|
|
| 87 | - |
|
| 88 | - -- ** Caveats
|
|
| 89 | - -- $with-ref-caveats
|
|
| 90 | -) where
|
|
| 73 | + hPutBufNonBlocking
|
|
| 74 | + ) where
|
|
| 91 | 75 | |
| 92 | 76 | import GHC.Internal.IO.Handle |
| 93 | - |
|
| 94 | -import GHC.Internal.Control.Monad (return)
|
|
| 95 | -import GHC.Internal.Control.Concurrent.MVar (MVar)
|
|
| 96 | -import GHC.Internal.Control.Exception (mask)
|
|
| 97 | -import GHC.Internal.Data.Function (const, (.), ($))
|
|
| 98 | -import GHC.Internal.Data.Functor (fmap)
|
|
| 99 | -#if defined(mingw32_HOST_OS)
|
|
| 100 | -import GHC.Internal.Data.Bool (otherwise)
|
|
| 101 | -#endif
|
|
| 102 | -import GHC.Internal.Data.Maybe (Maybe (Nothing), maybe)
|
|
| 103 | -#if defined(mingw32_HOST_OS)
|
|
| 104 | -import GHC.Internal.Data.Maybe (Maybe (Just))
|
|
| 105 | -#endif
|
|
| 106 | -import GHC.Internal.Data.List ((++))
|
|
| 107 | -import GHC.Internal.Data.String (String)
|
|
| 108 | -import GHC.Internal.Data.Typeable (Typeable, cast)
|
|
| 109 | -import GHC.Internal.System.IO (IO)
|
|
| 110 | -import GHC.Internal.IO.FD (fdFD)
|
|
| 111 | -#if defined(mingw32_HOST_OS)
|
|
| 112 | -import GHC.Internal.IO.Windows.Handle
|
|
| 113 | - (
|
|
| 114 | - NativeHandle,
|
|
| 115 | - ConsoleHandle,
|
|
| 116 | - IoHandle,
|
|
| 117 | - toHANDLE
|
|
| 118 | - )
|
|
| 119 | -#endif
|
|
| 120 | -import GHC.Internal.IO.Handle.Types
|
|
| 121 | - (
|
|
| 122 | - Handle (FileHandle, DuplexHandle),
|
|
| 123 | - Handle__ (Handle__, haDevice)
|
|
| 124 | - )
|
|
| 125 | -import GHC.Internal.IO.Handle.Internals (withHandle_', flushBuffer)
|
|
| 126 | -import GHC.Internal.IO.Exception
|
|
| 127 | - (
|
|
| 128 | - IOErrorType (InappropriateType),
|
|
| 129 | - IOException (IOError),
|
|
| 130 | - ioException
|
|
| 131 | - )
|
|
| 132 | -import GHC.Internal.Foreign.Ptr (Ptr)
|
|
| 133 | -import GHC.Internal.Foreign.C.Types (CInt)
|
|
| 134 | - |
|
| 135 | --- * Obtaining POSIX file descriptors and Windows handles
|
|
| 136 | - |
|
| 137 | -{-|
|
|
| 138 | - Obtains an operating-system handle that underlies a Haskell handle and
|
|
| 139 | - executes a user-provided action on it. Before the user-provided action is
|
|
| 140 | - run, user-defined perparation based on the handle state that contains the
|
|
| 141 | - operating-system handle is performed. While the user-provided action is
|
|
| 142 | - executed, further operations on the Haskell handle are blocked to a degree
|
|
| 143 | - that interference with this action is prevented.
|
|
| 144 | - |
|
| 145 | - See [below](#with-ref-caveats) for caveats regarding this operation.
|
|
| 146 | --}
|
|
| 147 | -withOSHandle :: String
|
|
| 148 | - -- ^ The name of the overall operation
|
|
| 149 | - -> (Handle -> MVar Handle__)
|
|
| 150 | - {-^
|
|
| 151 | - Obtaining of the handle state variable that holds the
|
|
| 152 | - operating-system handle
|
|
| 153 | - -}
|
|
| 154 | - -> (forall d. Typeable d => d -> IO a)
|
|
| 155 | - -- ^ Conversion of a device into an operating-system handle
|
|
| 156 | - -> (Handle__ -> IO ())
|
|
| 157 | - -- ^ The preparation
|
|
| 158 | - -> Handle
|
|
| 159 | - -- ^ The Haskell handle to use
|
|
| 160 | - -> (a -> IO r)
|
|
| 161 | - -- ^ The action to execute on the operating-system handle
|
|
| 162 | - -> IO r
|
|
| 163 | -withOSHandle opName handleStateVar getOSHandle prepare handle act
|
|
| 164 | - = mask $ \ withOriginalMaskingState ->
|
|
| 165 | - withHandleState $ \ handleState@Handle__ {haDevice = dev} -> do
|
|
| 166 | - osHandle <- getOSHandle dev
|
|
| 167 | - prepare handleState
|
|
| 168 | - withOriginalMaskingState $ act osHandle
|
|
| 169 | - where
|
|
| 170 | - |
|
| 171 | - withHandleState = withHandle_' opName handle (handleStateVar handle)
|
|
| 172 | -{-
|
|
| 173 | - The 'withHandle_'' operation, which we use here, already performs masking.
|
|
| 174 | - Still, we have to employ 'mask', in order do obtain the operation that
|
|
| 175 | - restores the original masking state. The user-provided action should be
|
|
| 176 | - executed with this original masking state, as there is no inherent reason to
|
|
| 177 | - generally perform it with masking in place. The masking that 'withHandle_''
|
|
| 178 | - performs is only for safely accessing handle state and thus constitutes an
|
|
| 179 | - implementation detail; it has nothing to do with the user-provided action.
|
|
| 180 | --}
|
|
| 181 | -{-
|
|
| 182 | - The order of actions in 'withOSHandle' is such that any exception from
|
|
| 183 | - 'getOSHandle' is thrown before the flushing of the Haskell-managed buffers.
|
|
| 184 | --}
|
|
| 185 | - |
|
| 186 | -{-|
|
|
| 187 | - Obtains the handle state variable that underlies a handle or specifically
|
|
| 188 | - the handle state variable for reading if the handle uses different state
|
|
| 189 | - variables for reading and writing.
|
|
| 190 | --}
|
|
| 191 | -handleStateVarReadingBiased :: Handle -> MVar Handle__
|
|
| 192 | -handleStateVarReadingBiased (FileHandle _ var) = var
|
|
| 193 | -handleStateVarReadingBiased (DuplexHandle _ readingVar _) = readingVar
|
|
| 194 | - |
|
| 195 | -{-|
|
|
| 196 | - Obtains the handle state variable that underlies a handle or specifically
|
|
| 197 | - the handle state variable for writing if the handle uses different state
|
|
| 198 | - variables for reading and writing.
|
|
| 199 | --}
|
|
| 200 | -handleStateVarWritingBiased :: Handle -> MVar Handle__
|
|
| 201 | -handleStateVarWritingBiased (FileHandle _ var) = var
|
|
| 202 | -handleStateVarWritingBiased (DuplexHandle _ _ writingVar) = writingVar
|
|
| 203 | - |
|
| 204 | -{-|
|
|
| 205 | - Yields the result of another operation if that operation succeeded, and
|
|
| 206 | - otherwise throws an exception that signals that the other operation failed
|
|
| 207 | - because some Haskell handle does not use an operating-system handle of a
|
|
| 208 | - required type.
|
|
| 209 | --}
|
|
| 210 | -requiringOSHandleOfType :: String
|
|
| 211 | - -- ^ The name of the operating-system handle type
|
|
| 212 | - -> Maybe a
|
|
| 213 | - {-^
|
|
| 214 | - The result of the other operation if it succeeded
|
|
| 215 | - -}
|
|
| 216 | - -> IO a
|
|
| 217 | -requiringOSHandleOfType osHandleTypeName
|
|
| 218 | - = maybe (ioException osHandleOfTypeRequired) return
|
|
| 219 | - where
|
|
| 220 | - |
|
| 221 | - osHandleOfTypeRequired :: IOException
|
|
| 222 | - osHandleOfTypeRequired
|
|
| 223 | - = IOError Nothing
|
|
| 224 | - InappropriateType
|
|
| 225 | - ""
|
|
| 226 | - ("handle does not use " ++ osHandleTypeName ++ "s")
|
|
| 227 | - Nothing
|
|
| 228 | - Nothing
|
|
| 229 | - |
|
| 230 | -{-|
|
|
| 231 | - Obtains the POSIX file descriptor of a device if the device contains one,
|
|
| 232 | - and throws an exception otherwise.
|
|
| 233 | --}
|
|
| 234 | -getFileDescriptor :: Typeable d => d -> IO CInt
|
|
| 235 | -getFileDescriptor = requiringOSHandleOfType "POSIX file descriptor" .
|
|
| 236 | - fmap fdFD . cast
|
|
| 237 | - |
|
| 238 | -{-|
|
|
| 239 | - Obtains the Windows handle of a device if the device contains one, and
|
|
| 240 | - throws an exception otherwise.
|
|
| 241 | --}
|
|
| 242 | -getWindowsHandle :: Typeable d => d -> IO (Ptr ())
|
|
| 243 | -getWindowsHandle = requiringOSHandleOfType "Windows handle" .
|
|
| 244 | - toMaybeWindowsHandle
|
|
| 245 | - where
|
|
| 246 | - |
|
| 247 | - toMaybeWindowsHandle :: Typeable d => d -> Maybe (Ptr ())
|
|
| 248 | -#if defined(mingw32_HOST_OS)
|
|
| 249 | - toMaybeWindowsHandle dev
|
|
| 250 | - | Just nativeHandle <- cast dev :: Maybe (IoHandle NativeHandle)
|
|
| 251 | - = Just (toHANDLE nativeHandle)
|
|
| 252 | - | Just consoleHandle <- cast dev :: Maybe (IoHandle ConsoleHandle)
|
|
| 253 | - = Just (toHANDLE consoleHandle)
|
|
| 254 | - | otherwise
|
|
| 255 | - = Nothing
|
|
| 256 | - {-
|
|
| 257 | - This is inspired by the implementation of
|
|
| 258 | - 'System.Win32.Types.withHandleToHANDLENative'.
|
|
| 259 | - -}
|
|
| 260 | -#else
|
|
| 261 | - toMaybeWindowsHandle _ = Nothing
|
|
| 262 | -#endif
|
|
| 263 | - |
|
| 264 | -{-|
|
|
| 265 | - Obtains the POSIX file descriptor that underlies a handle or specifically
|
|
| 266 | - the POSIX file descriptor for reading if the handle uses different file
|
|
| 267 | - descriptors for reading and writing and executes a user-provided action on
|
|
| 268 | - it. The Haskell-managed buffers related to the file descriptor are flushed
|
|
| 269 | - before the user-provided action is run. While this action is executed,
|
|
| 270 | - further operations on the handle are blocked to a degree that interference
|
|
| 271 | - with this action is prevented.
|
|
| 272 | - |
|
| 273 | - If the handle does not use POSIX file descriptors, an exception is thrown.
|
|
| 274 | - |
|
| 275 | - See [below](#with-ref-caveats) for caveats regarding this operation.
|
|
| 276 | --}
|
|
| 277 | -withFileDescriptorReadingBiased :: Handle -> (CInt -> IO r) -> IO r
|
|
| 278 | -withFileDescriptorReadingBiased = withOSHandle "withFileDescriptorReadingBiased"
|
|
| 279 | - handleStateVarReadingBiased
|
|
| 280 | - getFileDescriptor
|
|
| 281 | - flushBuffer
|
|
| 282 | - |
|
| 283 | -{-|
|
|
| 284 | - Obtains the POSIX file descriptor that underlies a handle or specifically
|
|
| 285 | - the POSIX file descriptor for writing if the handle uses different file
|
|
| 286 | - descriptors for reading and writing and executes a user-provided action on
|
|
| 287 | - it. The Haskell-managed buffers related to the file descriptor are flushed
|
|
| 288 | - before the user-provided action is run. While this action is executed,
|
|
| 289 | - further operations on the handle are blocked to a degree that interference
|
|
| 290 | - with this action is prevented.
|
|
| 291 | - |
|
| 292 | - If the handle does not use POSIX file descriptors, an exception is thrown.
|
|
| 293 | - |
|
| 294 | - See [below](#with-ref-caveats) for caveats regarding this operation.
|
|
| 295 | --}
|
|
| 296 | -withFileDescriptorWritingBiased :: Handle -> (CInt -> IO r) -> IO r
|
|
| 297 | -withFileDescriptorWritingBiased = withOSHandle "withFileDescriptorWritingBiased"
|
|
| 298 | - handleStateVarWritingBiased
|
|
| 299 | - getFileDescriptor
|
|
| 300 | - flushBuffer
|
|
| 301 | - |
|
| 302 | -{-|
|
|
| 303 | - Obtains the Windows handle that underlies a Haskell handle or specifically
|
|
| 304 | - the Windows handle for reading if the Haskell handle uses different Windows
|
|
| 305 | - handles for reading and writing and executes a user-provided action on it.
|
|
| 306 | - The Haskell-managed buffers related to the Windows handle are flushed before
|
|
| 307 | - the user-provided action is run. While this action is executed, further
|
|
| 308 | - operations on the Haskell handle are blocked to a degree that interference
|
|
| 309 | - with this action is prevented.
|
|
| 310 | - |
|
| 311 | - If the Haskell handle does not use Windows handles, an exception is thrown.
|
|
| 312 | - |
|
| 313 | - See [below](#with-ref-caveats) for caveats regarding this operation.
|
|
| 314 | --}
|
|
| 315 | -withWindowsHandleReadingBiased :: Handle -> (Ptr () -> IO r) -> IO r
|
|
| 316 | -withWindowsHandleReadingBiased = withOSHandle "withWindowsHandleReadingBiased"
|
|
| 317 | - handleStateVarReadingBiased
|
|
| 318 | - getWindowsHandle
|
|
| 319 | - flushBuffer
|
|
| 320 | - |
|
| 321 | -{-|
|
|
| 322 | - Obtains the Windows handle that underlies a Haskell handle or specifically
|
|
| 323 | - the Windows handle for writing if the Haskell handle uses different Windows
|
|
| 324 | - handles for reading and writing and executes a user-provided action on it.
|
|
| 325 | - The Haskell-managed buffers related to the Windows handle are flushed before
|
|
| 326 | - the user-provided action is run. While this action is executed, further
|
|
| 327 | - operations on the Haskell handle are blocked to a degree that interference
|
|
| 328 | - with this action is prevented.
|
|
| 329 | - |
|
| 330 | - If the Haskell handle does not use Windows handles, an exception is thrown.
|
|
| 331 | - |
|
| 332 | - See [below](#with-ref-caveats) for caveats regarding this operation.
|
|
| 333 | --}
|
|
| 334 | -withWindowsHandleWritingBiased :: Handle -> (Ptr () -> IO r) -> IO r
|
|
| 335 | -withWindowsHandleWritingBiased = withOSHandle "withWindowsHandleWritingBiased"
|
|
| 336 | - handleStateVarWritingBiased
|
|
| 337 | - getWindowsHandle
|
|
| 338 | - flushBuffer
|
|
| 339 | - |
|
| 340 | -{-|
|
|
| 341 | - Like 'withFileDescriptorReadingBiased' except that Haskell-managed buffers
|
|
| 342 | - are not flushed.
|
|
| 343 | --}
|
|
| 344 | -withFileDescriptorReadingBiasedRaw :: Handle -> (CInt -> IO r) -> IO r
|
|
| 345 | -withFileDescriptorReadingBiasedRaw
|
|
| 346 | - = withOSHandle "withFileDescriptorReadingBiasedRaw"
|
|
| 347 | - handleStateVarReadingBiased
|
|
| 348 | - getFileDescriptor
|
|
| 349 | - (const $ return ())
|
|
| 350 | - |
|
| 351 | -{-|
|
|
| 352 | - Like 'withFileDescriptorWritingBiased' except that Haskell-managed buffers
|
|
| 353 | - are not flushed.
|
|
| 354 | --}
|
|
| 355 | -withFileDescriptorWritingBiasedRaw :: Handle -> (CInt -> IO r) -> IO r
|
|
| 356 | -withFileDescriptorWritingBiasedRaw
|
|
| 357 | - = withOSHandle "withFileDescriptorWritingBiasedRaw"
|
|
| 358 | - handleStateVarWritingBiased
|
|
| 359 | - getFileDescriptor
|
|
| 360 | - (const $ return ())
|
|
| 361 | - |
|
| 362 | -{-|
|
|
| 363 | - Like 'withWindowsHandleReadingBiased' except that Haskell-managed buffers
|
|
| 364 | - are not flushed.
|
|
| 365 | --}
|
|
| 366 | -withWindowsHandleReadingBiasedRaw :: Handle -> (Ptr () -> IO r) -> IO r
|
|
| 367 | -withWindowsHandleReadingBiasedRaw
|
|
| 368 | - = withOSHandle "withWindowsHandleReadingBiasedRaw"
|
|
| 369 | - handleStateVarReadingBiased
|
|
| 370 | - getWindowsHandle
|
|
| 371 | - (const $ return ())
|
|
| 372 | - |
|
| 373 | -{-|
|
|
| 374 | - Like 'withWindowsHandleWritingBiased' except that Haskell-managed buffers
|
|
| 375 | - are not flushed.
|
|
| 376 | --}
|
|
| 377 | -withWindowsHandleWritingBiasedRaw :: Handle -> (Ptr () -> IO r) -> IO r
|
|
| 378 | -withWindowsHandleWritingBiasedRaw
|
|
| 379 | - = withOSHandle "withWindowsHandleWritingBiasedRaw"
|
|
| 380 | - handleStateVarWritingBiased
|
|
| 381 | - getWindowsHandle
|
|
| 382 | - (const $ return ())
|
|
| 383 | - |
|
| 384 | --- ** Caveats
|
|
| 385 | - |
|
| 386 | -{-$with-ref-caveats
|
|
| 387 | - #with-ref-caveats#There are the following caveats regarding the above
|
|
| 388 | - operations:
|
|
| 389 | - |
|
| 390 | - * Flushing of buffers can fail if the given handle is readable but not
|
|
| 391 | - seekable.
|
|
| 392 | - |
|
| 393 | - * If one of these operation is performed as part of an action executed by
|
|
| 394 | - 'unsafePerformIO', 'unsafeInterleaveIO', or one of their “dupable”
|
|
| 395 | - variants and the user-provided action receives an asychnchronous
|
|
| 396 | - exception and does not catch it, then the following happens:
|
|
| 397 | - |
|
| 398 | - - Before the overall computation is suspended, the blocking of handle
|
|
| 399 | - operations is removed.
|
|
| 400 | - |
|
| 401 | - - When the computation is later resumed due to another evaluation
|
|
| 402 | - attempt, the blocking of handle operations is reinstantiated, the
|
|
| 403 | - Haskell-managed buffers are flushed again, and the user-provided
|
|
| 404 | - action is run from the beginning.
|
|
| 405 | - |
|
| 406 | - Repeating the previously executed part of the user-provided action
|
|
| 407 | - cannot be avoided apparently. See the @[async]@ note in the source code
|
|
| 408 | - of "GHC.Internal.IO.Handle.Internals" for further explanation.
|
|
| 409 | --} |
| 1 | +{-# LANGUAGE Safe #-}
|
|
| 2 | +{-# LANGUAGE CPP #-}
|
|
| 3 | +{-# LANGUAGE RankNTypes #-}
|
|
| 4 | + |
|
| 5 | +{-|
|
|
| 6 | + This module bridges between Haskell handles and underlying operating-system
|
|
| 7 | + features.
|
|
| 8 | +-}
|
|
| 9 | +module System.IO.OS
|
|
| 10 | +(
|
|
| 11 | + -- * Obtaining file descriptors and Windows handles
|
|
| 12 | + withFileDescriptorReadingBiased,
|
|
| 13 | + withFileDescriptorWritingBiased,
|
|
| 14 | + withWindowsHandleReadingBiased,
|
|
| 15 | + withWindowsHandleWritingBiased,
|
|
| 16 | + withFileDescriptorReadingBiasedRaw,
|
|
| 17 | + withFileDescriptorWritingBiasedRaw,
|
|
| 18 | + withWindowsHandleReadingBiasedRaw,
|
|
| 19 | + withWindowsHandleWritingBiasedRaw
|
|
| 20 | + |
|
| 21 | + -- ** Caveats
|
|
| 22 | + -- $with-ref-caveats
|
|
| 23 | +)
|
|
| 24 | +where
|
|
| 25 | + |
|
| 26 | +import GHC.Internal.Control.Monad (return)
|
|
| 27 | +import GHC.Internal.Control.Concurrent.MVar (MVar)
|
|
| 28 | +import GHC.Internal.Control.Exception (mask)
|
|
| 29 | +import GHC.Internal.Data.Function (const, (.), ($))
|
|
| 30 | +import GHC.Internal.Data.Functor (fmap)
|
|
| 31 | +#if defined(mingw32_HOST_OS)
|
|
| 32 | +import GHC.Internal.Data.Bool (otherwise)
|
|
| 33 | +#endif
|
|
| 34 | +import GHC.Internal.Data.Maybe (Maybe (Nothing), maybe)
|
|
| 35 | +#if defined(mingw32_HOST_OS)
|
|
| 36 | +import GHC.Internal.Data.Maybe (Maybe (Just))
|
|
| 37 | +#endif
|
|
| 38 | +import GHC.Internal.Data.List ((++))
|
|
| 39 | +import GHC.Internal.Data.String (String)
|
|
| 40 | +import GHC.Internal.Data.Typeable (Typeable, cast)
|
|
| 41 | +import GHC.Internal.System.IO (IO)
|
|
| 42 | +import GHC.Internal.IO.FD (fdFD)
|
|
| 43 | +#if defined(mingw32_HOST_OS)
|
|
| 44 | +import GHC.Internal.IO.Windows.Handle
|
|
| 45 | + (
|
|
| 46 | + NativeHandle,
|
|
| 47 | + ConsoleHandle,
|
|
| 48 | + IoHandle,
|
|
| 49 | + toHANDLE
|
|
| 50 | + )
|
|
| 51 | +#endif
|
|
| 52 | +import GHC.Internal.IO.Handle.Types
|
|
| 53 | + (
|
|
| 54 | + Handle (FileHandle, DuplexHandle),
|
|
| 55 | + Handle__ (Handle__, haDevice)
|
|
| 56 | + )
|
|
| 57 | +import GHC.Internal.IO.Handle.Internals (withHandle_', flushBuffer)
|
|
| 58 | +import GHC.Internal.IO.Exception
|
|
| 59 | + (
|
|
| 60 | + IOErrorType (InappropriateType),
|
|
| 61 | + IOException (IOError),
|
|
| 62 | + ioException
|
|
| 63 | + )
|
|
| 64 | +import GHC.Internal.Foreign.Ptr (Ptr)
|
|
| 65 | +import GHC.Internal.Foreign.C.Types (CInt)
|
|
| 66 | + |
|
| 67 | +-- * Obtaining POSIX file descriptors and Windows handles
|
|
| 68 | + |
|
| 69 | +{-|
|
|
| 70 | + Executes a user-provided action on an operating-system handle that underlies
|
|
| 71 | + a Haskell handle. Before the user-provided action is run, user-defined
|
|
| 72 | + perparation based on the handle state that contains the operating-system
|
|
| 73 | + handle is performed. While the user-provided action is executed, further
|
|
| 74 | + operations on the Haskell handle are blocked to a degree that interference
|
|
| 75 | + with this action is prevented.
|
|
| 76 | + |
|
| 77 | + See [below](#with-ref-caveats) for caveats regarding this operation.
|
|
| 78 | +-}
|
|
| 79 | +withOSHandle :: String
|
|
| 80 | + -- ^ The name of the overall operation
|
|
| 81 | + -> (Handle -> MVar Handle__)
|
|
| 82 | + {-^
|
|
| 83 | + Obtaining of the handle state variable that holds the
|
|
| 84 | + operating-system handle
|
|
| 85 | + -}
|
|
| 86 | + -> (forall d. Typeable d => d -> IO a)
|
|
| 87 | + -- ^ Conversion of a device into an operating-system handle
|
|
| 88 | + -> (Handle__ -> IO ())
|
|
| 89 | + -- ^ The preparation
|
|
| 90 | + -> Handle
|
|
| 91 | + -- ^ The Haskell handle to use
|
|
| 92 | + -> (a -> IO r)
|
|
| 93 | + -- ^ The action to execute on the operating-system handle
|
|
| 94 | + -> IO r
|
|
| 95 | +withOSHandle opName handleStateVar getOSHandle prepare handle act
|
|
| 96 | + = mask $ \ withOriginalMaskingState ->
|
|
| 97 | + withHandleState $ \ handleState@Handle__ {haDevice = dev} -> do
|
|
| 98 | + osHandle <- getOSHandle dev
|
|
| 99 | + prepare handleState
|
|
| 100 | + withOriginalMaskingState $ act osHandle
|
|
| 101 | + where
|
|
| 102 | + |
|
| 103 | + withHandleState = withHandle_' opName handle (handleStateVar handle)
|
|
| 104 | +{-
|
|
| 105 | + The 'withHandle_'' operation, which we use here, already performs masking.
|
|
| 106 | + Still, we have to employ 'mask', in order do obtain the operation that
|
|
| 107 | + restores the original masking state. The user-provided action should be
|
|
| 108 | + executed with this original masking state, as there is no inherent reason to
|
|
| 109 | + generally perform it with masking in place. The masking that 'withHandle_''
|
|
| 110 | + performs is only for safely accessing handle state and thus constitutes an
|
|
| 111 | + implementation detail; it has nothing to do with the user-provided action.
|
|
| 112 | +-}
|
|
| 113 | +{-
|
|
| 114 | + The order of actions in 'withOSHandle' is such that any exception from
|
|
| 115 | + 'getOSHandle' is thrown before the flushing of the Haskell-managed buffers.
|
|
| 116 | +-}
|
|
| 117 | + |
|
| 118 | +{-|
|
|
| 119 | + Obtains the handle state variable that underlies a handle or specifically
|
|
| 120 | + the handle state variable for reading if the handle uses different state
|
|
| 121 | + variables for reading and writing.
|
|
| 122 | +-}
|
|
| 123 | +handleStateVarReadingBiased :: Handle -> MVar Handle__
|
|
| 124 | +handleStateVarReadingBiased (FileHandle _ var) = var
|
|
| 125 | +handleStateVarReadingBiased (DuplexHandle _ readingVar _) = readingVar
|
|
| 126 | + |
|
| 127 | +{-|
|
|
| 128 | + Obtains the handle state variable that underlies a handle or specifically
|
|
| 129 | + the handle state variable for writing if the handle uses different state
|
|
| 130 | + variables for reading and writing.
|
|
| 131 | +-}
|
|
| 132 | +handleStateVarWritingBiased :: Handle -> MVar Handle__
|
|
| 133 | +handleStateVarWritingBiased (FileHandle _ var) = var
|
|
| 134 | +handleStateVarWritingBiased (DuplexHandle _ _ writingVar) = writingVar
|
|
| 135 | + |
|
| 136 | +{-|
|
|
| 137 | + Yields the result of another operation if that operation succeeded, and
|
|
| 138 | + otherwise throws an exception that signals that the other operation failed
|
|
| 139 | + because some Haskell handle does not use an operating-system handle of a
|
|
| 140 | + required type.
|
|
| 141 | +-}
|
|
| 142 | +requiringOSHandleOfType :: String
|
|
| 143 | + -- ^ The name of the operating-system handle type
|
|
| 144 | + -> Maybe a
|
|
| 145 | + {-^
|
|
| 146 | + The result of the other operation if it succeeded
|
|
| 147 | + -}
|
|
| 148 | + -> IO a
|
|
| 149 | +requiringOSHandleOfType osHandleTypeName
|
|
| 150 | + = maybe (ioException osHandleOfTypeRequired) return
|
|
| 151 | + where
|
|
| 152 | + |
|
| 153 | + osHandleOfTypeRequired :: IOException
|
|
| 154 | + osHandleOfTypeRequired
|
|
| 155 | + = IOError Nothing
|
|
| 156 | + InappropriateType
|
|
| 157 | + ""
|
|
| 158 | + ("handle does not use " ++ osHandleTypeName ++ "s")
|
|
| 159 | + Nothing
|
|
| 160 | + Nothing
|
|
| 161 | + |
|
| 162 | +{-|
|
|
| 163 | + Obtains the POSIX file descriptor of a device if the device contains one,
|
|
| 164 | + and throws an exception otherwise.
|
|
| 165 | +-}
|
|
| 166 | +getFileDescriptor :: Typeable d => d -> IO CInt
|
|
| 167 | +getFileDescriptor = requiringOSHandleOfType "POSIX file descriptor" .
|
|
| 168 | + fmap fdFD . cast
|
|
| 169 | + |
|
| 170 | +{-|
|
|
| 171 | + Obtains the Windows handle of a device if the device contains one, and
|
|
| 172 | + throws an exception otherwise.
|
|
| 173 | +-}
|
|
| 174 | +getWindowsHandle :: Typeable d => d -> IO (Ptr ())
|
|
| 175 | +getWindowsHandle = requiringOSHandleOfType "Windows handle" .
|
|
| 176 | + toMaybeWindowsHandle
|
|
| 177 | + where
|
|
| 178 | + |
|
| 179 | + toMaybeWindowsHandle :: Typeable d => d -> Maybe (Ptr ())
|
|
| 180 | +#if defined(mingw32_HOST_OS)
|
|
| 181 | + toMaybeWindowsHandle dev
|
|
| 182 | + | Just nativeHandle <- cast dev :: Maybe (IoHandle NativeHandle)
|
|
| 183 | + = Just (toHANDLE nativeHandle)
|
|
| 184 | + | Just consoleHandle <- cast dev :: Maybe (IoHandle ConsoleHandle)
|
|
| 185 | + = Just (toHANDLE consoleHandle)
|
|
| 186 | + | otherwise
|
|
| 187 | + = Nothing
|
|
| 188 | + {-
|
|
| 189 | + This is inspired by the implementation of
|
|
| 190 | + 'System.Win32.Types.withHandleToHANDLENative'.
|
|
| 191 | + -}
|
|
| 192 | +#else
|
|
| 193 | + toMaybeWindowsHandle _ = Nothing
|
|
| 194 | +#endif
|
|
| 195 | + |
|
| 196 | +{-|
|
|
| 197 | + Executes a user-provided action on the POSIX file descriptor that underlies
|
|
| 198 | + a handle or specifically on the POSIX file descriptor for reading if the
|
|
| 199 | + handle uses different file descriptors for reading and writing. The
|
|
| 200 | + Haskell-managed buffers related to the file descriptor are flushed before
|
|
| 201 | + the user-provided action is run. While this action is executed, further
|
|
| 202 | + operations on the handle are blocked to a degree that interference with this
|
|
| 203 | + action is prevented.
|
|
| 204 | + |
|
| 205 | + If the handle does not use POSIX file descriptors, an exception is thrown.
|
|
| 206 | + |
|
| 207 | + See [below](#with-ref-caveats) for caveats regarding this operation.
|
|
| 208 | +-}
|
|
| 209 | +withFileDescriptorReadingBiased :: Handle -> (CInt -> IO r) -> IO r
|
|
| 210 | +withFileDescriptorReadingBiased = withOSHandle "withFileDescriptorReadingBiased"
|
|
| 211 | + handleStateVarReadingBiased
|
|
| 212 | + getFileDescriptor
|
|
| 213 | + flushBuffer
|
|
| 214 | + |
|
| 215 | +{-|
|
|
| 216 | + Executes a user-provided action on the POSIX file descriptor that underlies
|
|
| 217 | + a handle or specifically on the POSIX file descriptor for writing if the
|
|
| 218 | + handle uses different file descriptors for reading and writing. The
|
|
| 219 | + Haskell-managed buffers related to the file descriptor are flushed before
|
|
| 220 | + the user-provided action is run. While this action is executed, further
|
|
| 221 | + operations on the handle are blocked to a degree that interference with this
|
|
| 222 | + action is prevented.
|
|
| 223 | + |
|
| 224 | + If the handle does not use POSIX file descriptors, an exception is thrown.
|
|
| 225 | + |
|
| 226 | + See [below](#with-ref-caveats) for caveats regarding this operation.
|
|
| 227 | +-}
|
|
| 228 | +withFileDescriptorWritingBiased :: Handle -> (CInt -> IO r) -> IO r
|
|
| 229 | +withFileDescriptorWritingBiased = withOSHandle "withFileDescriptorWritingBiased"
|
|
| 230 | + handleStateVarWritingBiased
|
|
| 231 | + getFileDescriptor
|
|
| 232 | + flushBuffer
|
|
| 233 | + |
|
| 234 | +{-|
|
|
| 235 | + Executes a user-provided action on the Windows handle that underlies a
|
|
| 236 | + Haskell handle or specifically on the Windows handle for reading if the
|
|
| 237 | + Haskell handle uses different Windows handles for reading and writing. The
|
|
| 238 | + Haskell-managed buffers related to the Windows handle are flushed before the
|
|
| 239 | + user-provided action is run. While this action is executed, further
|
|
| 240 | + operations on the Haskell handle are blocked to a degree that interference
|
|
| 241 | + with this action is prevented.
|
|
| 242 | + |
|
| 243 | + If the Haskell handle does not use Windows handles, an exception is thrown.
|
|
| 244 | + |
|
| 245 | + See [below](#with-ref-caveats) for caveats regarding this operation.
|
|
| 246 | +-}
|
|
| 247 | +withWindowsHandleReadingBiased :: Handle -> (Ptr () -> IO r) -> IO r
|
|
| 248 | +withWindowsHandleReadingBiased = withOSHandle "withWindowsHandleReadingBiased"
|
|
| 249 | + handleStateVarReadingBiased
|
|
| 250 | + getWindowsHandle
|
|
| 251 | + flushBuffer
|
|
| 252 | + |
|
| 253 | +{-|
|
|
| 254 | + Executes a user-provided action on the Windows handle that underlies a
|
|
| 255 | + Haskell handle or specifically on the Windows handle for writing if the
|
|
| 256 | + Haskell handle uses different Windows handles for reading and writing. The
|
|
| 257 | + Haskell-managed buffers related to the Windows handle are flushed before the
|
|
| 258 | + user-provided action is run. While this action is executed, further
|
|
| 259 | + operations on the Haskell handle are blocked to a degree that interference
|
|
| 260 | + with this action is prevented.
|
|
| 261 | + |
|
| 262 | + If the Haskell handle does not use Windows handles, an exception is thrown.
|
|
| 263 | + |
|
| 264 | + See [below](#with-ref-caveats) for caveats regarding this operation.
|
|
| 265 | +-}
|
|
| 266 | +withWindowsHandleWritingBiased :: Handle -> (Ptr () -> IO r) -> IO r
|
|
| 267 | +withWindowsHandleWritingBiased = withOSHandle "withWindowsHandleWritingBiased"
|
|
| 268 | + handleStateVarWritingBiased
|
|
| 269 | + getWindowsHandle
|
|
| 270 | + flushBuffer
|
|
| 271 | + |
|
| 272 | +{-|
|
|
| 273 | + Like 'withFileDescriptorReadingBiased' except that Haskell-managed buffers
|
|
| 274 | + are not flushed.
|
|
| 275 | +-}
|
|
| 276 | +withFileDescriptorReadingBiasedRaw :: Handle -> (CInt -> IO r) -> IO r
|
|
| 277 | +withFileDescriptorReadingBiasedRaw
|
|
| 278 | + = withOSHandle "withFileDescriptorReadingBiasedRaw"
|
|
| 279 | + handleStateVarReadingBiased
|
|
| 280 | + getFileDescriptor
|
|
| 281 | + (const $ return ())
|
|
| 282 | + |
|
| 283 | +{-|
|
|
| 284 | + Like 'withFileDescriptorWritingBiased' except that Haskell-managed buffers
|
|
| 285 | + are not flushed.
|
|
| 286 | +-}
|
|
| 287 | +withFileDescriptorWritingBiasedRaw :: Handle -> (CInt -> IO r) -> IO r
|
|
| 288 | +withFileDescriptorWritingBiasedRaw
|
|
| 289 | + = withOSHandle "withFileDescriptorWritingBiasedRaw"
|
|
| 290 | + handleStateVarWritingBiased
|
|
| 291 | + getFileDescriptor
|
|
| 292 | + (const $ return ())
|
|
| 293 | + |
|
| 294 | +{-|
|
|
| 295 | + Like 'withWindowsHandleReadingBiased' except that Haskell-managed buffers
|
|
| 296 | + are not flushed.
|
|
| 297 | +-}
|
|
| 298 | +withWindowsHandleReadingBiasedRaw :: Handle -> (Ptr () -> IO r) -> IO r
|
|
| 299 | +withWindowsHandleReadingBiasedRaw
|
|
| 300 | + = withOSHandle "withWindowsHandleReadingBiasedRaw"
|
|
| 301 | + handleStateVarReadingBiased
|
|
| 302 | + getWindowsHandle
|
|
| 303 | + (const $ return ())
|
|
| 304 | + |
|
| 305 | +{-|
|
|
| 306 | + Like 'withWindowsHandleWritingBiased' except that Haskell-managed buffers
|
|
| 307 | + are not flushed.
|
|
| 308 | +-}
|
|
| 309 | +withWindowsHandleWritingBiasedRaw :: Handle -> (Ptr () -> IO r) -> IO r
|
|
| 310 | +withWindowsHandleWritingBiasedRaw
|
|
| 311 | + = withOSHandle "withWindowsHandleWritingBiasedRaw"
|
|
| 312 | + handleStateVarWritingBiased
|
|
| 313 | + getWindowsHandle
|
|
| 314 | + (const $ return ())
|
|
| 315 | + |
|
| 316 | +-- ** Caveats
|
|
| 317 | + |
|
| 318 | +{-$with-ref-caveats
|
|
| 319 | + #with-ref-caveats#There are the following caveats regarding the above
|
|
| 320 | + operations:
|
|
| 321 | + |
|
| 322 | + * Flushing of buffers can fail if the given handle is readable but not
|
|
| 323 | + seekable.
|
|
| 324 | + |
|
| 325 | + * If one of these operations is performed as part of an action executed by
|
|
| 326 | + 'System.IO.Unsafe.unsafePerformIO',
|
|
| 327 | + 'System.IO.Unsafe.unsafeInterleaveIO', or one of their “dupable”
|
|
| 328 | + variants and the user-provided action receives an asychnchronous
|
|
| 329 | + exception and does not catch it, then the following happens:
|
|
| 330 | + |
|
| 331 | + - Before the overall computation is suspended, the blocking of handle
|
|
| 332 | + operations is removed.
|
|
| 333 | + |
|
| 334 | + - When the computation is later resumed due to another evaluation
|
|
| 335 | + attempt, the blocking of handle operations is reinstantiated, the
|
|
| 336 | + Haskell-managed buffers are flushed again, and the user-provided
|
|
| 337 | + action is run from the beginning.
|
|
| 338 | + |
|
| 339 | + Repeating the previously executed part of the user-provided action
|
|
| 340 | + cannot be avoided apparently. See the @[async]@ note in the source code
|
|
| 341 | + of "GHC.Internal.IO.Handle.Internals" for further explanation.
|
|
| 342 | +-} |