{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE CPP #-}
module GHC.Internal.IO.SubSystem (
withIoSubSystem,
withIoSubSystem',
whenIoSubSystem,
ioSubSystem,
IoSubSystem(..),
conditional,
(<!>),
isWindowsNativeIO
) where
import GHC.Internal.Base
#if defined(mingw32_HOST_OS)
import GHC.Internal.IO.Unsafe
import GHC.Internal.Foreign.Ptr
import GHC.Internal.Foreign.Storable
import GHC.Internal.Foreign.C.Types
import GHC.Internal.Foreign.Marshal.Utils
#endif
infixl 7 <!>
data IoSubSystem
= IoPOSIX
| IoNative
deriving (IoSubSystem -> IoSubSystem -> Bool
(IoSubSystem -> IoSubSystem -> Bool)
-> (IoSubSystem -> IoSubSystem -> Bool) -> Eq IoSubSystem
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IoSubSystem -> IoSubSystem -> Bool
== :: IoSubSystem -> IoSubSystem -> Bool
$c/= :: IoSubSystem -> IoSubSystem -> Bool
/= :: IoSubSystem -> IoSubSystem -> Bool
Eq)
conditional :: a -> a -> a
#if defined(mingw32_HOST_OS)
conditional posix windows =
case ioSubSystem of
IoPOSIX -> posix
IoNative -> windows
#else
conditional :: forall a. a -> a -> a
conditional a
posix a
_ = a
posix
#endif
(<!>) :: a -> a -> a
<!> :: forall a. a -> a -> a
(<!>) = a -> a -> a
forall a. a -> a -> a
conditional
isWindowsNativeIO :: Bool
isWindowsNativeIO :: Bool
isWindowsNativeIO = Bool
False Bool -> Bool -> Bool
forall a. a -> a -> a
<!> Bool
True
ioSubSystem :: IoSubSystem
#if defined(mingw32_HOST_OS)
{-# INLINE ioSubSystem #-}
ioSubSystem =
case toBool ioManagerIsWin32NativeCBool of
False -> IoPOSIX
True -> IoNative
{-# NOINLINE ioManagerIsWin32NativeCBool #-}
ioManagerIsWin32NativeCBool :: CBool
ioManagerIsWin32NativeCBool =
unsafeDupablePerformIO $ peek ioManagerIsWin32NativePtr
foreign import ccall "&rts_IOManagerIsWin32Native"
ioManagerIsWin32NativePtr :: Ptr CBool
#else
ioSubSystem :: IoSubSystem
ioSubSystem = IoSubSystem
IoPOSIX
#endif
withIoSubSystem :: (IoSubSystem -> IO a) -> IO a
withIoSubSystem :: forall a. (IoSubSystem -> IO a) -> IO a
withIoSubSystem IoSubSystem -> IO a
f = IoSubSystem -> IO a
f IoSubSystem
ioSubSystem
withIoSubSystem' :: (IoSubSystem -> a) -> a
withIoSubSystem' :: forall a. (IoSubSystem -> a) -> a
withIoSubSystem' IoSubSystem -> a
f = IoSubSystem -> a
f IoSubSystem
ioSubSystem
whenIoSubSystem :: IoSubSystem -> IO () -> IO ()
whenIoSubSystem :: IoSubSystem -> IO () -> IO ()
whenIoSubSystem IoSubSystem
m IO ()
f = do let sub :: IoSubSystem
sub = IoSubSystem
ioSubSystem
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (IoSubSystem
sub IoSubSystem -> IoSubSystem -> Bool
forall a. Eq a => a -> a -> Bool
== IoSubSystem
m) IO ()
f