{-# LANGUAGE Unsafe #-}
{-# LANGUAGE NoImplicitPrelude
, BangPatterns
, RankNTypes
, MagicHash
, ScopedTypeVariables
, UnboxedTuples
#-}
{-# OPTIONS_GHC -funbox-strict-fields #-}
{-# OPTIONS_HADDOCK not-home #-}
module GHC.IO (
IO(..), unIO, 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,
mkUserError
) 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 State# RealWorld -> (# State# RealWorld, a #)
m) = \State# RealWorld
s -> case State# RealWorld -> (# State# RealWorld, a #)
m State# RealWorld
s of (# State# RealWorld
s', a
r #) -> State# RealWorld -> a -> STret RealWorld a
forall s a. State# s -> a -> STret s a
STret State# RealWorld
s' a
r
stToIO :: ST RealWorld a -> IO a
stToIO :: ST RealWorld a -> IO a
stToIO (ST 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 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 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
$ \ 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 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 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 State# RealWorld -> (# State# RealWorld, a #)
io) 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 k1 a.
(State# RealWorld -> (# State# RealWorld, k1 #))
-> (a -> State# RealWorld -> (# State# RealWorld, k1 #))
-> State# RealWorld
-> (# State# RealWorld, k1 #)
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 = case SomeException -> Maybe e
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e of
Just 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')
Maybe e
Nothing -> SomeException -> State# RealWorld -> (# State# RealWorld, a #)
forall k1 a. k1 -> State# RealWorld -> (# State# RealWorld, a #)
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 State# RealWorld -> (# State# RealWorld, a #)
io) 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 k1 a.
(State# RealWorld -> (# State# RealWorld, k1 #))
-> (a -> State# RealWorld -> (# State# RealWorld, k1 #))
-> State# RealWorld
-> (# State# RealWorld, k1 #)
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) = 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 IO a
m 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 = (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO (SomeException -> State# RealWorld -> (# State# RealWorld, a #)
forall k1 a. k1 -> State# RealWorld -> (# State# RealWorld, a #)
raiseIO# (e -> SomeException
forall e. Exception e => e -> SomeException
toException e
e))
block :: IO a -> IO a
block :: IO a -> IO a
block (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 k1.
(State# RealWorld -> (# State# RealWorld, k1 #))
-> State# RealWorld -> (# State# RealWorld, k1 #)
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 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 k1.
(State# RealWorld -> (# State# RealWorld, k1 #))
-> State# RealWorld -> (# State# RealWorld, k1 #)
unmaskAsyncExceptions# State# RealWorld -> (# State# RealWorld, a #)
io
interruptible :: IO a -> IO a
interruptible :: IO a -> IO a
interruptible IO a
act = do
MaskingState
st <- IO MaskingState
getMaskingState
case MaskingState
st of
MaskingState
Unmasked -> IO a
act
MaskingState
MaskedInterruptible -> IO a -> IO a
forall a. IO a -> IO a
unsafeUnmask IO a
act
MaskingState
MaskedUninterruptible -> IO a
act
blockUninterruptible :: IO a -> IO a
blockUninterruptible :: IO a -> IO a
blockUninterruptible (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 k1.
(State# RealWorld -> (# State# RealWorld, k1 #))
-> State# RealWorld -> (# State# RealWorld, k1 #)
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
$ \State# RealWorld
s ->
case State# RealWorld -> (# State# RealWorld, Int# #)
getMaskingState# State# RealWorld
s of
(# State# RealWorld
s', Int#
i #) -> (# State# RealWorld
s', case Int#
i of
Int#
0# -> MaskingState
Unmasked
Int#
1# -> MaskingState
MaskedUninterruptible
Int#
_ -> MaskingState
MaskedInterruptible #)
onException :: IO a -> IO b -> IO a
onException :: IO a -> IO b -> IO a
onException IO a
io 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` \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 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
$ \forall a. IO a -> IO a
_ -> IO a
io
mask :: ((forall a. IO a -> IO a) -> IO b) -> IO b
mask (forall a. IO a -> IO a) -> IO b
io = do
MaskingState
b <- IO MaskingState
getMaskingState
case MaskingState
b of
MaskingState
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
MaskingState
MaskedInterruptible -> (forall a. IO a -> IO a) -> IO b
io forall a. IO a -> IO a
block
MaskingState
MaskedUninterruptible -> (forall a. IO a -> IO a) -> IO b
io forall a. IO a -> IO a
blockUninterruptible
uninterruptibleMask_ :: IO a -> IO a
uninterruptibleMask_ 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
$ \forall a. IO a -> IO a
_ -> IO a
io
uninterruptibleMask :: ((forall a. IO a -> IO a) -> IO b) -> IO b
uninterruptibleMask (forall a. IO a -> IO a) -> IO b
io = do
MaskingState
b <- IO MaskingState
getMaskingState
case MaskingState
b of
MaskingState
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
MaskingState
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
MaskingState
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 IO a
before a -> IO b
after 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
$ \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
IO a
a finally :: IO a -> IO b -> IO a
`finally` 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
$ \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 = (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
s -> a -> State# RealWorld -> (# State# RealWorld, a #)
forall k1 d. k1 -> State# d -> (# State# d, k1 #)
seq# a
a State# RealWorld
s
mkUserError :: [Char] -> SomeException
mkUserError :: String -> SomeException
mkUserError String
str = IOError -> SomeException
forall e. Exception e => e -> SomeException
toException (String -> IOError
userError String
str)