blob: e26fd9f55a7e88f5134e9ad569a068d856711745 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
|
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE CPP #-}
-----------------------------------------------------------------------------
-- |
-- Module : GHC.IO.SubSystem
-- Copyright : (c) The University of Glasgow, 2017
-- License : see libraries/base/LICENSE
--
-- Maintainer : libraries@haskell.org
-- Stability : internal
-- Portability : non-portable
--
-- The SubSystem control interface. These methods can be used to disambiguate
-- between the two operations.
--
-----------------------------------------------------------------------------
module GHC.IO.SubSystem (
withIoSubSystem,
withIoSubSystem',
whenIoSubSystem,
ioSubSystem,
IoSubSystem(..),
conditional,
(<!>),
isWindowsNativeIO
) where
import GHC.Base
import GHC.RTS.Flags
#if defined(mingw32_HOST_OS)
import GHC.IO.Unsafe
#endif
infixl 7 <!>
-- | Conditionally execute an action depending on the configured I/O subsystem.
-- On POSIX systems always execute the first action.
-- On windows execute the second action if WINIO as active, otherwise fall back to
-- the first action.
conditional :: a -> a -> a
#if defined(mingw32_HOST_OS)
conditional posix windows =
case ioSubSystem of
IoPOSIX -> posix
IoNative -> windows
#else
conditional posix _ = posix
#endif
-- | Infix version of `conditional`.
-- posix <!> windows == conditional posix windows
(<!>) :: a -> a -> a
(<!>) = conditional
isWindowsNativeIO :: Bool
isWindowsNativeIO = False <!> True
ioSubSystem :: IoSubSystem
#if defined(mingw32_HOST_OS)
{-# NOINLINE ioSubSystem #-}
ioSubSystem = unsafeDupablePerformIO getIoManagerFlag
#else
ioSubSystem = IoPOSIX
#endif
withIoSubSystem :: (IoSubSystem -> IO a) -> IO a
withIoSubSystem f = f ioSubSystem
withIoSubSystem' :: (IoSubSystem -> a) -> a
withIoSubSystem' f = f ioSubSystem
whenIoSubSystem :: IoSubSystem -> IO () -> IO ()
whenIoSubSystem m f = do let sub = ioSubSystem
when (sub == m) f
|
