{-# LANGUAGE Unsafe #-}
{-# LANGUAGE NoImplicitPrelude
, BangPatterns
, RankNTypes
, MagicHash
, ScopedTypeVariables
, UnboxedTuples
#-}
{-# OPTIONS_GHC -funbox-strict-fields #-}
{-# OPTIONS_HADDOCK not-home #-}
module GHC.IO (
IO(..), unIO, failIO, liftIO, mplusIO,
unsafePerformIO, unsafeInterleaveIO,
unsafeDupablePerformIO, unsafeDupableInterleaveIO,
noDuplicate,
stToIO, ioToST, unsafeIOToST, unsafeSTToIO,
FilePath,
catch, catchException, catchAny, throwIO,
mask, mask_, uninterruptibleMask, uninterruptibleMask_,
MaskingState(..), getMaskingState,
unsafeUnmask, interruptible,
onException, bracket, finally, evaluate
) where
import GHC.Base
import GHC.ST
import GHC.Exception
import GHC.Show
import GHC.IO.Unsafe
import {-# SOURCE #-} GHC.IO.Exception ( userError, IOError )
liftIO :: IO a -> State# RealWorld -> STret RealWorld a
liftIO :: IO a -> State# RealWorld -> STret RealWorld a
liftIO (IO m :: State# RealWorld -> (# State# RealWorld, a #)
m) = \s :: State# RealWorld
s -> case State# RealWorld -> (# State# RealWorld, a #)
m State# RealWorld
s of (# s' :: State# RealWorld
s', r :: a
r #) -> State# RealWorld -> a -> STret RealWorld a
forall s a. State# s -> a -> STret s a
STret State# RealWorld
s' a
r
failIO :: String -> IO a
failIO :: String -> IO a
failIO s :: String
s = (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO (SomeException -> State# RealWorld -> (# State# RealWorld, a #)
forall a b. a -> State# RealWorld -> (# State# RealWorld, b #)
raiseIO# (IOError -> SomeException
forall e. Exception e => e -> SomeException
toException (String -> IOError
userError String
s)))
stToIO :: ST RealWorld a -> IO a
stToIO :: ST RealWorld a -> IO a
stToIO (ST m :: STRep RealWorld a
m) = STRep RealWorld a -> IO a
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO STRep RealWorld a
m
ioToST :: IO a -> ST RealWorld a
ioToST :: IO a -> ST RealWorld a
ioToST (IO m :: State# RealWorld -> (# State# RealWorld, a #)
m) = ((State# RealWorld -> (# State# RealWorld, a #)) -> ST RealWorld a
forall s a. STRep s a -> ST s a
ST State# RealWorld -> (# State# RealWorld, a #)
m)
unsafeIOToST :: IO a -> ST s a
unsafeIOToST :: IO a -> ST s a
unsafeIOToST (IO io :: State# RealWorld -> (# State# RealWorld, a #)
io) = STRep s a -> ST s a
forall s a. STRep s a -> ST s a
ST (STRep s a -> ST s a) -> STRep s a -> ST s a
forall a b. (a -> b) -> a -> b
$ \ s :: State# s
s -> ((State# RealWorld -> (# State# RealWorld, a #)) -> STRep s a
unsafeCoerce# State# RealWorld -> (# State# RealWorld, a #)
io) State# s
s
unsafeSTToIO :: ST s a -> IO a
unsafeSTToIO :: ST s a -> IO a
unsafeSTToIO (ST m :: STRep s a
m) = (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO (STRep s a -> State# RealWorld -> (# State# RealWorld, a #)
unsafeCoerce# STRep s a
m)
type FilePath = String
catchException :: Exception e => IO a -> (e -> IO a) -> IO a
catchException :: IO a -> (e -> IO a) -> IO a
catchException !IO a
io handler :: e -> IO a
handler = IO a -> (e -> IO a) -> IO a
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch IO a
io e -> IO a
handler
catch :: Exception e
=> IO a
-> (e -> IO a)
-> IO a
catch :: IO a -> (e -> IO a) -> IO a
catch (IO io :: State# RealWorld -> (# State# RealWorld, a #)
io) handler :: e -> IO a
handler = (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, a #)) -> IO a)
-> (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
forall a b. (a -> b) -> a -> b
$ (State# RealWorld -> (# State# RealWorld, a #))
-> (SomeException -> State# RealWorld -> (# State# RealWorld, a #))
-> State# RealWorld
-> (# State# RealWorld, a #)
forall a b.
(State# RealWorld -> (# State# RealWorld, a #))
-> (b -> State# RealWorld -> (# State# RealWorld, a #))
-> State# RealWorld
-> (# State# RealWorld, a #)
catch# State# RealWorld -> (# State# RealWorld, a #)
io SomeException -> State# RealWorld -> (# State# RealWorld, a #)
handler'
where handler' :: SomeException -> State# RealWorld -> (# State# RealWorld, a #)
handler' e :: SomeException
e = case SomeException -> Maybe e
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e of
Just e' :: e
e' -> IO a -> State# RealWorld -> (# State# RealWorld, a #)
forall a. IO a -> State# RealWorld -> (# State# RealWorld, a #)
unIO (e -> IO a
handler e
e')
Nothing -> SomeException -> State# RealWorld -> (# State# RealWorld, a #)
forall a b. a -> State# RealWorld -> (# State# RealWorld, b #)
raiseIO# SomeException
e
catchAny :: IO a -> (forall e . Exception e => e -> IO a) -> IO a
catchAny :: IO a -> (forall e. Exception e => e -> IO a) -> IO a
catchAny !(IO io :: State# RealWorld -> (# State# RealWorld, a #)
io) handler :: forall e. Exception e => e -> IO a
handler = (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, a #)) -> IO a)
-> (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
forall a b. (a -> b) -> a -> b
$ (State# RealWorld -> (# State# RealWorld, a #))
-> (SomeException -> State# RealWorld -> (# State# RealWorld, a #))
-> State# RealWorld
-> (# State# RealWorld, a #)
forall a b.
(State# RealWorld -> (# State# RealWorld, a #))
-> (b -> State# RealWorld -> (# State# RealWorld, a #))
-> State# RealWorld
-> (# State# RealWorld, a #)
catch# State# RealWorld -> (# State# RealWorld, a #)
io SomeException -> State# RealWorld -> (# State# RealWorld, a #)
handler'
where handler' :: SomeException -> State# RealWorld -> (# State# RealWorld, a #)
handler' (SomeException e :: e
e) = IO a -> State# RealWorld -> (# State# RealWorld, a #)
forall a. IO a -> State# RealWorld -> (# State# RealWorld, a #)
unIO (e -> IO a
forall e. Exception e => e -> IO a
handler e
e)
mplusIO :: IO a -> IO a -> IO a
mplusIO :: IO a -> IO a -> IO a
mplusIO m :: IO a
m n :: IO a
n = IO a
m IO a -> (IOError -> IO a) -> IO a
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catchException` \ (IOError
_ :: IOError) -> IO a
n
throwIO :: Exception e => e -> IO a
throwIO :: e -> IO a
throwIO e :: e
e = (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO (SomeException -> State# RealWorld -> (# State# RealWorld, a #)
forall a b. a -> State# RealWorld -> (# State# RealWorld, b #)
raiseIO# (e -> SomeException
forall e. Exception e => e -> SomeException
toException e
e))
block :: IO a -> IO a
block :: IO a -> IO a
block (IO io :: State# RealWorld -> (# State# RealWorld, a #)
io) = (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, a #)) -> IO a)
-> (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
forall a b. (a -> b) -> a -> b
$ (State# RealWorld -> (# State# RealWorld, a #))
-> State# RealWorld -> (# State# RealWorld, a #)
forall a.
(State# RealWorld -> (# State# RealWorld, a #))
-> State# RealWorld -> (# State# RealWorld, a #)
maskAsyncExceptions# State# RealWorld -> (# State# RealWorld, a #)
io
unblock :: IO a -> IO a
unblock :: IO a -> IO a
unblock = IO a -> IO a
forall a. IO a -> IO a
unsafeUnmask
unsafeUnmask :: IO a -> IO a
unsafeUnmask :: IO a -> IO a
unsafeUnmask (IO io :: State# RealWorld -> (# State# RealWorld, a #)
io) = (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, a #)) -> IO a)
-> (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
forall a b. (a -> b) -> a -> b
$ (State# RealWorld -> (# State# RealWorld, a #))
-> State# RealWorld -> (# State# RealWorld, a #)
forall a.
(State# RealWorld -> (# State# RealWorld, a #))
-> State# RealWorld -> (# State# RealWorld, a #)
unmaskAsyncExceptions# State# RealWorld -> (# State# RealWorld, a #)
io
interruptible :: IO a -> IO a
interruptible :: IO a -> IO a
interruptible act :: IO a
act = do
MaskingState
st <- IO MaskingState
getMaskingState
case MaskingState
st of
Unmasked -> IO a
act
MaskedInterruptible -> IO a -> IO a
forall a. IO a -> IO a
unsafeUnmask IO a
act
MaskedUninterruptible -> IO a
act
blockUninterruptible :: IO a -> IO a
blockUninterruptible :: IO a -> IO a
blockUninterruptible (IO io :: State# RealWorld -> (# State# RealWorld, a #)
io) = (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, a #)) -> IO a)
-> (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
forall a b. (a -> b) -> a -> b
$ (State# RealWorld -> (# State# RealWorld, a #))
-> State# RealWorld -> (# State# RealWorld, a #)
forall a.
(State# RealWorld -> (# State# RealWorld, a #))
-> State# RealWorld -> (# State# RealWorld, a #)
maskUninterruptible# State# RealWorld -> (# State# RealWorld, a #)
io
data MaskingState
= Unmasked
| MaskedInterruptible
| MaskedUninterruptible
deriving ( Eq
, Show
)
getMaskingState :: IO MaskingState
getMaskingState :: IO MaskingState
getMaskingState = (State# RealWorld -> (# State# RealWorld, MaskingState #))
-> IO MaskingState
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, MaskingState #))
-> IO MaskingState)
-> (State# RealWorld -> (# State# RealWorld, MaskingState #))
-> IO MaskingState
forall a b. (a -> b) -> a -> b
$ \s :: State# RealWorld
s ->
case State# RealWorld -> (# State# RealWorld, Int# #)
getMaskingState# State# RealWorld
s of
(# s' :: State# RealWorld
s', i :: Int#
i #) -> (# State# RealWorld
s', case Int#
i of
0# -> MaskingState
Unmasked
1# -> MaskingState
MaskedUninterruptible
_ -> MaskingState
MaskedInterruptible #)
onException :: IO a -> IO b -> IO a
onException :: IO a -> IO b -> IO a
onException io :: IO a
io what :: IO b
what = IO a
io IO a -> (SomeException -> IO a) -> IO a
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catchException` \e :: SomeException
e -> do b
_ <- IO b
what
SomeException -> IO a
forall e a. Exception e => e -> IO a
throwIO (SomeException
e :: SomeException)
mask :: ((forall a. IO a -> IO a) -> IO b) -> IO b
mask_ :: IO a -> IO a
uninterruptibleMask :: ((forall a. IO a -> IO a) -> IO b) -> IO b
uninterruptibleMask_ :: IO a -> IO a
mask_ :: IO a -> IO a
mask_ io :: IO a
io = ((forall a. IO a -> IO a) -> IO a) -> IO a
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
mask (((forall a. IO a -> IO a) -> IO a) -> IO a)
-> ((forall a. IO a -> IO a) -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \_ -> IO a
io
mask :: ((forall a. IO a -> IO a) -> IO b) -> IO b
mask io :: (forall a. IO a -> IO a) -> IO b
io = do
MaskingState
b <- IO MaskingState
getMaskingState
case MaskingState
b of
Unmasked -> IO b -> IO b
forall a. IO a -> IO a
block (IO b -> IO b) -> IO b -> IO b
forall a b. (a -> b) -> a -> b
$ (forall a. IO a -> IO a) -> IO b
io forall a. IO a -> IO a
unblock
MaskedInterruptible -> (forall a. IO a -> IO a) -> IO b
io forall a. IO a -> IO a
block
MaskedUninterruptible -> (forall a. IO a -> IO a) -> IO b
io forall a. IO a -> IO a
blockUninterruptible
uninterruptibleMask_ :: IO a -> IO a
uninterruptibleMask_ io :: IO a
io = ((forall a. IO a -> IO a) -> IO a) -> IO a
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
uninterruptibleMask (((forall a. IO a -> IO a) -> IO a) -> IO a)
-> ((forall a. IO a -> IO a) -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \_ -> IO a
io
uninterruptibleMask :: ((forall a. IO a -> IO a) -> IO b) -> IO b
uninterruptibleMask io :: (forall a. IO a -> IO a) -> IO b
io = do
MaskingState
b <- IO MaskingState
getMaskingState
case MaskingState
b of
Unmasked -> IO b -> IO b
forall a. IO a -> IO a
blockUninterruptible (IO b -> IO b) -> IO b -> IO b
forall a b. (a -> b) -> a -> b
$ (forall a. IO a -> IO a) -> IO b
io forall a. IO a -> IO a
unblock
MaskedInterruptible -> IO b -> IO b
forall a. IO a -> IO a
blockUninterruptible (IO b -> IO b) -> IO b -> IO b
forall a b. (a -> b) -> a -> b
$ (forall a. IO a -> IO a) -> IO b
io forall a. IO a -> IO a
block
MaskedUninterruptible -> (forall a. IO a -> IO a) -> IO b
io forall a. IO a -> IO a
blockUninterruptible
bracket
:: IO a
-> (a -> IO b)
-> (a -> IO c)
-> IO c
bracket :: IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket before :: IO a
before after :: a -> IO b
after thing :: a -> IO c
thing =
((forall a. IO a -> IO a) -> IO c) -> IO c
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
mask (((forall a. IO a -> IO a) -> IO c) -> IO c)
-> ((forall a. IO a -> IO a) -> IO c) -> IO c
forall a b. (a -> b) -> a -> b
$ \restore :: forall a. IO a -> IO a
restore -> do
a
a <- IO a
before
c
r <- IO c -> IO c
forall a. IO a -> IO a
restore (a -> IO c
thing a
a) IO c -> IO b -> IO c
forall a b. IO a -> IO b -> IO a
`onException` a -> IO b
after a
a
b
_ <- a -> IO b
after a
a
c -> IO c
forall (m :: * -> *) a. Monad m => a -> m a
return c
r
finally :: IO a
-> IO b
-> IO a
a :: IO a
a finally :: IO a -> IO b -> IO a
`finally` sequel :: IO b
sequel =
((forall a. IO a -> IO a) -> IO a) -> IO a
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
mask (((forall a. IO a -> IO a) -> IO a) -> IO a)
-> ((forall a. IO a -> IO a) -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \restore :: forall a. IO a -> IO a
restore -> do
a
r <- IO a -> IO a
forall a. IO a -> IO a
restore IO a
a IO a -> IO b -> IO a
forall a b. IO a -> IO b -> IO a
`onException` IO b
sequel
b
_ <- IO b
sequel
a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
r
evaluate :: a -> IO a
evaluate :: a -> IO a
evaluate a :: a
a = (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, a #)) -> IO a)
-> (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
forall a b. (a -> b) -> a -> b
$ \s :: State# RealWorld
s -> a -> State# RealWorld -> (# State# RealWorld, a #)
forall a d. a -> State# d -> (# State# d, a #)
seq# a
a State# RealWorld
s