Wolfgang Jeltsch pushed to branch wip/jeltsch/obtaining-os-handles at Glasgow Haskell Compiler / GHC

Commits:

27 changed files:

Changes:

  • .gitlab-ci.yml
    ... ... @@ -1050,10 +1050,6 @@ abi-test:
    1050 1050 
           optional: true
    1051 1051 
       dependencies: null
    1052 1052 
       image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-fedora43:$DOCKER_REV"
    1053 
    -  rules:
    1054 
    -    - if: $CI_MERGE_REQUEST_ID
    1055 
    -    - if: '$CI_COMMIT_BRANCH == "master"'
    1056 
    -    - if: '$CI_COMMIT_BRANCH =~ /ghc-[0.9]+\.[0-9]+/'
    1057 1053 
       tags:
    1058 1054 
         - x86_64-linux
    1059 1055 
       script:

  • docs/users_guide/exts/roles.rst
    ... ... @@ -38,7 +38,7 @@ trouble.
    38 38 
     The way to identify such situations is to have *roles* assigned to type
    39 39 
     variables of datatypes, classes, and type synonyms.
    40 40
    41 
    -Roles as implemented in GHC are a from a simplified version of the work
    41 
    +Roles as implemented in GHC are based on a simplified version of the work
    42 42 
     described in `Generative type abstraction and type-level
    43 43 
     computation <https://www.seas.upenn.edu/~sweirich/papers/popl163af-weirich.pdf>`__,
    44 44 
     published at POPL 2011.

  • hadrian/src/Context.hs
    ... ... @@ -11,7 +11,7 @@ module Context (
    11 11 
         pkgLibraryFile,
    12 12 
         pkgConfFile, pkgStampFile, resourcePath, objectPath, contextPath, getContextPath, libPath, distDir,
    13 13 
         distDynDir,
    14 
    -    haddockStatsFilesDir, ensureConfigured, autogenPath, rtsContext, rtsBuildPath, libffiBuildPath
    14 
    +    haddockStatsFilesDir, ensureConfigured, autogenPath, rtsContext, rtsBuildPath
    15 15 
         ) where
    16 16
    17 17 
     import Base
    ... ... @@ -93,14 +93,6 @@ rtsContext stage = vanillaContext stage rts
    93 93 
     rtsBuildPath :: Stage -> Action FilePath
    94 94 
     rtsBuildPath stage = buildPath (rtsContext stage)
    95 95
    96 
    --- | Build directory for in-tree 'libffi' library.
    97 
    -libffiBuildPath :: Stage -> Action FilePath
    98 
    -libffiBuildPath stage = buildPath $ Context
    99 
    -    stage
    100 
    -    libffi
    101 
    -    (error "libffiBuildPath: way not set.")
    102 
    -    (error "libffiBuildPath: inplace not set.")
    103 
    -
    104 96 
     pkgFileName :: Context -> Package -> String -> String -> Action FilePath
    105 97 
     pkgFileName context package prefix suffix = do
    106 98 
         pid  <- pkgUnitId (stage context) package

  • hadrian/src/Settings/Builders/Configure.hs
    ... ... @@ -8,8 +8,7 @@ configureBuilderArgs :: Args
    8 8 
     configureBuilderArgs = do
    9 9 
         stage      <- getStage
    10 10 
         gmpPath    <- expr (gmpBuildPath stage)
    11 
    -    libffiPath <- expr (libffiBuildPath stage)
    12 
    -    mconcat [ builder (Configure gmpPath) ? do
    11 
    +    builder (Configure gmpPath) ? do
    13 12 
                     targetArch <- queryTarget queryArch
    14 13 
                     targetPlatform <- queryTarget targetPlatformTriple
    15 14 
                     buildPlatform <- queryBuild targetPlatformTriple
    ... ... @@ -28,16 +27,3 @@ configureBuilderArgs = do
    28 27 
                          -- option.
    29 28 
                          <> [ "--enable-alloca=malloc-notreentrant" | targetArch == "wasm32" ]
    30 29 
                          <> [ "--with-pic=yes" ]
    31 
    -
    32 
    -            , builder (Configure libffiPath) ? do
    33 
    -                top            <- expr topDirectory
    34 
    -                targetPlatform <- queryTarget targetPlatformTriple
    35 
    -                way            <- getWay
    36 
    -                pure [ "--prefix=" ++ top -/- libffiPath -/- "inst"
    37 
    -                     , "--libdir=" ++ top -/- libffiPath -/- "inst/lib"
    38 
    -                     , "--enable-static=yes"
    39 
    -                     , "--enable-shared="
    40 
    -                            ++ (if wayUnit Dynamic way
    41 
    -                                    then "yes"
    42 
    -                                    else "no")
    43 
    -                     , "--host=" ++ targetPlatform ] ]

  • hadrian/src/Settings/Builders/Make.hs
    ... ... @@ -12,12 +12,8 @@ makeBuilderArgs = do
    12 12 
         threads    <- shakeThreads <$> expr getShakeOptions
    13 13 
         stage      <- getStage
    14 14 
         gmpPath    <- expr (gmpBuildPath stage)
    15 
    -    libffiPaths <- forM [Stage1, Stage2, Stage3 ] $ \s -> expr (libffiBuildPath s)
    16 15 
         let t = show $ max 4 (threads - 2) -- Don't use all Shake's threads
    17 
    -    mconcat $
    18 
    -        (builder (Make gmpPath   ) ? pure ["MAKEFLAGS=-j" ++ t]) :
    19 
    -        [ builder (Make libffiPath) ? pure ["MAKEFLAGS=-j" ++ t, "install"]
    20 
    -        | libffiPath <- libffiPaths ]
    16 
    +    builder (Make gmpPath) ? pure ["MAKEFLAGS=-j" ++ t]
    21 17
    22 18 
     validateBuilderArgs :: Args
    23 19 
     validateBuilderArgs = builder (Make "testsuite/tests") ? do

  • libraries/base/base.cabal.in
    ... ... @@ -255,6 +255,7 @@ Library
    255 255 
             , System.Exit
    256 256 
             , System.IO
    257 257 
             , System.IO.Error
    258 
    +        , System.IO.OS
    258 259 
             , System.Mem
    259 260 
             , System.Mem.StableName
    260 261 
             , System.Posix.Internals

  • libraries/base/changelog.md
    ... ... @@ -23,6 +23,7 @@
    23 23 
       * `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))
    24 24 
       * Remove `GHC.JS.Prim.Internal.Build`, as per [CLC #329](https://github.com/haskell/core-libraries-committee/issues/329)
    25 25 
       * Export `labelThread` from `Control.Concurrent`.([CLC proposal #376](https://github.com/haskell/core-libraries-committee/issues/376))
    26 
    +  * 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))
    26 27
    27 28 
     ## 4.22.0.0 *TBA*
    28 29 
       * Shipped with GHC 9.14.1

  • libraries/base/src/System/IO/OS.hs
    1 
    +{-# LANGUAGE Safe #-}
    2 
    +
    3 
    +{-|
    4 
    +    This module bridges between Haskell handles and underlying operating-system
    5 
    +    features.
    6 
    +-}
    7 
    +module System.IO.OS
    8 
    +(
    9 
    +    -- * Obtaining file descriptors and Windows handles
    10 
    +    withFileDescriptorReadingBiased,
    11 
    +    withFileDescriptorWritingBiased,
    12 
    +    withWindowsHandleReadingBiased,
    13 
    +    withWindowsHandleWritingBiased,
    14 
    +    withFileDescriptorReadingBiasedRaw,
    15 
    +    withFileDescriptorWritingBiasedRaw,
    16 
    +    withWindowsHandleReadingBiasedRaw,
    17 
    +    withWindowsHandleWritingBiasedRaw
    18 
    +
    19 
    +    -- ** Caveats
    20 
    +    -- $with-ref-caveats
    21 
    +)
    22 
    +where
    23 
    +
    24 
    +import GHC.Internal.System.IO.OS
    25 
    +       (
    26 
    +           withFileDescriptorReadingBiased,
    27 
    +           withFileDescriptorWritingBiased,
    28 
    +           withWindowsHandleReadingBiased,
    29 
    +           withWindowsHandleWritingBiased,
    30 
    +           withFileDescriptorReadingBiasedRaw,
    31 
    +           withFileDescriptorWritingBiasedRaw,
    32 
    +           withWindowsHandleReadingBiasedRaw,
    33 
    +           withWindowsHandleWritingBiasedRaw
    34 
    +       )
    35 
    +
    36 
    +-- ** Caveats
    37 
    +
    38 
    +{-$with-ref-caveats
    39 
    +    #with-ref-caveats#There are the following caveats regarding the above
    40 
    +    operations:
    41 
    +
    42 
    +      * Flushing of buffers can fail if the given handle is readable but not
    43 
    +        seekable.
    44 
    +
    45 
    +      * If one of these operations is performed as part of an action executed by
    46 
    +        'System.IO.Unsafe.unsafePerformIO',
    47 
    +        'System.IO.Unsafe.unsafeInterleaveIO', or one of their “dupable”
    48 
    +        variants and the user-provided action receives an asychnchronous
    49 
    +        exception and does not catch it, then the following happens:
    50 
    +
    51 
    +          - Before the overall computation is suspended, the blocking of handle
    52 
    +            operations is removed.
    53 
    +
    54 
    +          - When the computation is later resumed due to another evaluation
    55 
    +            attempt, the blocking of handle operations is reinstantiated, the
    56 
    +            Haskell-managed buffers are flushed again, and the user-provided
    57 
    +            action is run from the beginning.
    58 
    +
    59 
    +        Repeating the previously executed part of the user-provided action
    60 
    +        cannot be avoided apparently. See the @[async]@ note in the source code
    61 
    +        of "GHC.Internal.IO.Handle.Internals" for further explanation.
    62 
    +-}

  • libraries/base/tests/IO/all.T
    ... ... @@ -186,3 +186,15 @@ test('T17912', [only_ways(['threaded1']), when(opsys('mingw32'),expect_broken(1)
    186 186 
     test('T18832', only_ways(['threaded1']), compile_and_run, [''])
    187 187
    188 188 
     test('mkdirExists', [exit_code(1), when(opsys('mingw32'), ignore_stderr)], compile_and_run, [''])
    189 
    +
    190 
    +test('osHandles001FileDescriptors', omit_ways(['winio', 'winio_threaded']), compile_and_run, [''])
    191 
    +test('osHandles001WindowsHandles', only_ways(['winio', 'winio_threaded']), compile_and_run, [''])
    192 
    +test('osHandles002FileDescriptors', [when(opsys('mingw32'), skip), when(arch('javascript'), skip)], compile_and_run, [''])
    193 
    +test('osHandles002WindowsHandles', only_ways(['winio', 'winio_threaded']), compile_and_run, [''])
    194 
    +# It would be good to let `osHandles002FileDescriptors` run also on
    195 
    +# Windows with the file-descriptor-based I/O manager. However, this
    196 
    +# test, as it is currently implemented, requires the `unix` package.
    197 
    +# That said, `UCRT.DLL`, which is used by GHC-generated Windows
    198 
    +# executables, emulates part of POSIX, enough for this test. As a
    199 
    +# result, this test could be generalized to also supporting Windows, but
    200 
    +# this would likely involve creating bindings to C code.

  • libraries/base/tests/IO/osHandles001FileDescriptors.hs
    1 
    +{-# LANGUAGE TypeApplications #-}
    2 
    +
    3 
    +import Control.Monad (mapM_)
    4 
    +import Control.Exception (SomeException, try)
    5 
    +import System.IO (stdin, stdout, stderr)
    6 
    +import System.IO.OS
    7 
    +       (
    8 
    +           withFileDescriptorReadingBiasedRaw,
    9 
    +           withFileDescriptorWritingBiasedRaw,
    10 
    +           withWindowsHandleReadingBiasedRaw,
    11 
    +           withWindowsHandleWritingBiasedRaw
    12 
    +       )
    13 
    +
    14 
    +main :: IO ()
    15 
    +main = mapM_ ((>>= print) . try @SomeException) $
    16 
    +       [
    17 
    +           withFileDescriptorReadingBiasedRaw stdin  (return . show),
    18 
    +           withFileDescriptorWritingBiasedRaw stdout (return . show),
    19 
    +           withFileDescriptorWritingBiasedRaw stderr (return . show),
    20 
    +           withWindowsHandleReadingBiasedRaw  stdin  (return . const "_"),
    21 
    +           withWindowsHandleWritingBiasedRaw  stdout (return . const "_"),
    22 
    +           withWindowsHandleWritingBiasedRaw  stderr (return . const "_")
    23 
    +       ]

  • libraries/base/tests/IO/osHandles001FileDescriptors.stdout
    1 
    +Right "0"
    2 
    +Right "1"
    3 
    +Right "2"
    4 
    +Left <stdin>: withWindowsHandleReadingBiasedRaw: inappropriate type (handle does not use Windows handles)
    5 
    +Left <stdout>: withWindowsHandleWritingBiasedRaw: inappropriate type (handle does not use Windows handles)
    6 
    +Left <stderr>: withWindowsHandleWritingBiasedRaw: inappropriate type (handle does not use Windows handles)

  • libraries/base/tests/IO/osHandles001WindowsHandles.hs
    1 
    +{-# LANGUAGE TypeApplications #-}
    2 
    +
    3 
    +import Control.Monad (mapM_)
    4 
    +import Control.Exception (SomeException, try)
    5 
    +import System.IO (stdin, stdout, stderr)
    6 
    +import System.IO.OS
    7 
    +       (
    8 
    +           withFileDescriptorReadingBiasedRaw,
    9 
    +           withFileDescriptorWritingBiasedRaw,
    10 
    +           withWindowsHandleReadingBiasedRaw,
    11 
    +           withWindowsHandleWritingBiasedRaw
    12 
    +       )
    13 
    +
    14 
    +main :: IO ()
    15 
    +main = mapM_ ((>>= print) . try @SomeException) $
    16 
    +       [
    17 
    +           withFileDescriptorReadingBiasedRaw stdin  (return . show),
    18 
    +           withFileDescriptorWritingBiasedRaw stdout (return . show),
    19 
    +           withFileDescriptorWritingBiasedRaw stderr (return . show),
    20 
    +           withWindowsHandleReadingBiasedRaw  stdin  (return . const "_"),
    21 
    +           withWindowsHandleWritingBiasedRaw  stdout (return . const "_"),
    22 
    +           withWindowsHandleWritingBiasedRaw  stderr (return . const "_")
    23 
    +       ]

  • libraries/base/tests/IO/osHandles001WindowsHandles.stdout
    1 
    +Left <stdin>: withFileDescriptorReadingBiasedRaw: inappropriate type (handle does not use file descriptors)
    2 
    +Left <stdout>: withFileDescriptorWritingBiasedRaw: inappropriate type (handle does not use file descriptors)
    3 
    +Left <stderr>: withFileDescriptorWritingBiasedRaw: inappropriate type (handle does not use file descriptors)
    4 
    +Right "_"
    5 
    +Right "_"
    6 
    +Right "_"

  • libraries/base/tests/IO/osHandles002FileDescriptors.hs
    1 
    +import Data.Functor (void)
    2 
    +import Data.ByteString.Char8 (pack)
    3 
    +import System.Posix.Types (Fd (Fd), ByteCount)
    4 
    +import System.Posix.IO.ByteString (fdRead, fdWrite)
    5 
    +import System.IO (stdin, stdout, stderr)
    6 
    +import System.IO.OS
    7 
    +       (
    8 
    +           withFileDescriptorReadingBiased,
    9 
    +           withFileDescriptorWritingBiased
    10 
    +       )
    11 
    +
    12 
    +main :: IO ()
    13 
    +main = withFileDescriptorReadingBiased stdin  $ \ stdinFD  ->
    14 
    +       withFileDescriptorWritingBiased stdout $ \ stdoutFD ->
    15 
    +       withFileDescriptorWritingBiased stderr $ \ stderrFD ->
    16 
    +       do
    17 
    +           regularMsg <- fdRead (Fd stdinFD) inputSizeApproximation
    18 
    +           void $ fdWrite (Fd stdoutFD) regularMsg
    19 
    +           void $ fdWrite (Fd stderrFD) (pack errorMsg)
    20 
    +    where
    21 
    +
    22 
    +    inputSizeApproximation :: ByteCount
    23 
    +    inputSizeApproximation = 100
    24 
    +
    25 
    +    errorMsg :: String
    26 
    +    errorMsg = "And every single door\n\
    27 
    +               \That I've walked through\n\
    28 
    +               \Brings me back, back here again\n"

  • libraries/base/tests/IO/osHandles002FileDescriptors.stderr
    1 
    +And every single door
    2 
    +That I've walked through
    3 
    +Brings me back, back here again

  • libraries/base/tests/IO/osHandles002FileDescriptors.stdin
    1 
    +We've got to get in to get out

  • libraries/base/tests/IO/osHandles002FileDescriptors.stdout
    1 
    +We've got to get in to get out

  • libraries/base/tests/IO/osHandles002WindowsHandles.hs
    1 
    +import Control.Monad (zipWithM_)
    2 
    +import Data.Functor (void)
    3 
    +import Data.Char (ord)
    4 
    +import Foreign.Marshal.Alloc (allocaBytes)
    5 
    +import Foreign.Storable (pokeElemOff)
    6 
    +import System.IO (stdin, stdout, stderr)
    7 
    +import System.IO.OS
    8 
    +       (
    9 
    +           withWindowsHandleReadingBiased,
    10 
    +           withWindowsHandleWritingBiased
    11 
    +       )
    12 
    +
    13 
    +main :: IO ()
    14 
    +main = withWindowsHandleReadingBiased stdin  $ \ windowsStdin  ->
    15 
    +       withWindowsHandleWritingBiased stdout $ \ windowsStdout ->
    16 
    +       withWindowsHandleWritingBiased stderr $ \ windowsStderr ->
    17 
    +       do
    18 
    +           withBuffer inputSizeApproximation $ \ bufferPtr -> do
    19 
    +               inputSize <- win32_ReadFile windowsStdin
    20 
    +                                           bufferPtr
    21 
    +                                           inputSizeApproximation
    22 
    +                                           Nothing
    23 
    +               void $ win32_WriteFile windowsStdout
    24 
    +                                      bufferPtr
    25 
    +                                      inputSize
    26 
    +                                      Nothing
    27 
    +           withBuffer errorMsgSize $ \ bufferPtr -> do
    28 
    +               zipWithM_ (pokeElemOff bufferPtr)
    29 
    +                         [0 ..]
    30 
    +                         (map (fromIntegral . ord) errorMsg)
    31 
    +               void $ win32_WriteFile windowsStderr
    32 
    +                                      bufferPtr
    33 
    +                                      errorMsgSize
    34 
    +                                      Nothing
    35 
    +    where
    36 
    +
    37 
    +    withBuffer :: DWORD -> (Ptr Word8 -> IO a) -> IO a
    38 
    +    withBuffer = allocaBytes . fromIntegral
    39 
    +
    40 
    +    inputSizeApproximation :: DWORD
    41 
    +    inputSizeApproximation = 100
    42 
    +
    43 
    +    errorMsg :: String
    44 
    +    errorMsg = "And every single door\n\
    45 
    +               \That I've walked through\n\
    46 
    +               \Brings me back, back here again\n"
    47 
    +
    48 
    +    errorMsgSize :: DWORD
    49 
    +    errorMsgSize = fromIntegral (length errorMsg)

  • libraries/base/tests/IO/osHandles002WindowsHandles.stderr
    1 
    +And every single door
    2 
    +That I've walked through
    3 
    +Brings me back, back here again

  • libraries/base/tests/IO/osHandles002WindowsHandles.stdin
    1 
    +We've got to get in to get out

  • libraries/base/tests/IO/osHandles002WindowsHandles.stdout
    1 
    +We've got to get in to get out

  • libraries/ghc-internal/ghc-internal.cabal.in
    ... ... @@ -328,6 +328,7 @@ Library
    328 328 
             GHC.Internal.System.Exit
    329 329 
             GHC.Internal.System.IO
    330 330 
             GHC.Internal.System.IO.Error
    331 
    +        GHC.Internal.System.IO.OS
    331 332 
             GHC.Internal.System.Mem
    332 333 
             GHC.Internal.System.Mem.StableName
    333 334 
             GHC.Internal.System.Posix.Internals

  • libraries/ghc-internal/src/GHC/Internal/System/IO/OS.hs
    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 GHC.Internal.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 
    +    preparation 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 user-defined preparation is performed.
    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#This subsection is just a dummy, whose purpose is to serve
    320 
    +    as the target of the hyperlinks above. The real documentation of the caveats
    321 
    +    is in the /Caveats/ subsection in the @base@ module @System.IO.OS@, which
    322 
    +    re-exports the above operations.
    323 
    +-}

  • testsuite/tests/interface-stability/base-exports.stdout
    ... ... @@ -10048,6 +10048,17 @@ module System.IO.Error where
    10048 10048 
       userError :: GHC.Internal.Base.String -> IOError
    10049 10049 
       userErrorType :: IOErrorType
    10050 10050
    10051 
    +module System.IO.OS where
    10052 
    +  -- Safety: Safe
    10053 
    +  withFileDescriptorReadingBiased :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Foreign.C.Types.CInt -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r
    10054 
    +  withFileDescriptorReadingBiasedRaw :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Foreign.C.Types.CInt -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r
    10055 
    +  withFileDescriptorWritingBiased :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Foreign.C.Types.CInt -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r
    10056 
    +  withFileDescriptorWritingBiasedRaw :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Foreign.C.Types.CInt -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r
    10057 
    +  withWindowsHandleReadingBiased :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Ptr.Ptr () -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r
    10058 
    +  withWindowsHandleReadingBiasedRaw :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Ptr.Ptr () -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r
    10059 
    +  withWindowsHandleWritingBiased :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Ptr.Ptr () -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r
    10060 
    +  withWindowsHandleWritingBiasedRaw :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Ptr.Ptr () -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r
    10061 
    +
    10051 10062 
     module System.IO.Unsafe where
    10052 10063 
       -- Safety: Unsafe
    10053 10064 
       unsafeDupablePerformIO :: forall a. GHC.Internal.Types.IO a -> a

  • testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
    ... ... @@ -10086,6 +10086,17 @@ module System.IO.Error where
    10086 10086 
       userError :: GHC.Internal.Base.String -> IOError
    10087 10087 
       userErrorType :: IOErrorType
    10088 10088
    10089 
    +module System.IO.OS where
    10090 
    +  -- Safety: Safe
    10091 
    +  withFileDescriptorReadingBiased :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Foreign.C.Types.CInt -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r
    10092 
    +  withFileDescriptorReadingBiasedRaw :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Foreign.C.Types.CInt -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r
    10093 
    +  withFileDescriptorWritingBiased :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Foreign.C.Types.CInt -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r
    10094 
    +  withFileDescriptorWritingBiasedRaw :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Foreign.C.Types.CInt -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r
    10095 
    +  withWindowsHandleReadingBiased :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Ptr.Ptr () -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r
    10096 
    +  withWindowsHandleReadingBiasedRaw :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Ptr.Ptr () -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r
    10097 
    +  withWindowsHandleWritingBiased :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Ptr.Ptr () -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r
    10098 
    +  withWindowsHandleWritingBiasedRaw :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Ptr.Ptr () -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r
    10099 
    +
    10089 10100 
     module System.IO.Unsafe where
    10090 10101 
       -- Safety: Unsafe
    10091 10102 
       unsafeDupablePerformIO :: forall a. GHC.Internal.Types.IO a -> a

  • testsuite/tests/interface-stability/base-exports.stdout-mingw32
    ... ... @@ -10328,6 +10328,17 @@ module System.IO.Error where
    10328 10328 
       userError :: GHC.Internal.Base.String -> IOError
    10329 10329 
       userErrorType :: IOErrorType
    10330 10330
    10331 
    +module System.IO.OS where
    10332 
    +  -- Safety: Safe
    10333 
    +  withFileDescriptorReadingBiased :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Foreign.C.Types.CInt -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r
    10334 
    +  withFileDescriptorReadingBiasedRaw :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Foreign.C.Types.CInt -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r
    10335 
    +  withFileDescriptorWritingBiased :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Foreign.C.Types.CInt -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r
    10336 
    +  withFileDescriptorWritingBiasedRaw :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Foreign.C.Types.CInt -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r
    10337 
    +  withWindowsHandleReadingBiased :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Ptr.Ptr () -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r
    10338 
    +  withWindowsHandleReadingBiasedRaw :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Ptr.Ptr () -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r
    10339 
    +  withWindowsHandleWritingBiased :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Ptr.Ptr () -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r
    10340 
    +  withWindowsHandleWritingBiasedRaw :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Ptr.Ptr () -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r
    10341 
    +
    10331 10342 
     module System.IO.Unsafe where
    10332 10343 
       -- Safety: Unsafe
    10333 10344 
       unsafeDupablePerformIO :: forall a. GHC.Internal.Types.IO a -> a

  • testsuite/tests/interface-stability/base-exports.stdout-ws-32
    ... ... @@ -10048,6 +10048,17 @@ module System.IO.Error where
    10048 10048 
       userError :: GHC.Internal.Base.String -> IOError
    10049 10049 
       userErrorType :: IOErrorType
    10050 10050
    10051 
    +module System.IO.OS where
    10052 
    +  -- Safety: Safe
    10053 
    +  withFileDescriptorReadingBiased :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Foreign.C.Types.CInt -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r
    10054 
    +  withFileDescriptorReadingBiasedRaw :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Foreign.C.Types.CInt -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r
    10055 
    +  withFileDescriptorWritingBiased :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Foreign.C.Types.CInt -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r
    10056 
    +  withFileDescriptorWritingBiasedRaw :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Foreign.C.Types.CInt -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r
    10057 
    +  withWindowsHandleReadingBiased :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Ptr.Ptr () -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r
    10058 
    +  withWindowsHandleReadingBiasedRaw :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Ptr.Ptr () -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r
    10059 
    +  withWindowsHandleWritingBiased :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Ptr.Ptr () -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r
    10060 
    +  withWindowsHandleWritingBiasedRaw :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Ptr.Ptr () -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r
    10061 
    +
    10051 10062 
     module System.IO.Unsafe where
    10052 10063 
       -- Safety: Unsafe
    10053 10064 
       unsafeDupablePerformIO :: forall a. GHC.Internal.Types.IO a -> a

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications · Help