{-# 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 Unsafe.Coerce ( unsafeCoerce )
import {-# SOURCE #-} GHC.IO.Exception ( userError, IOError )
liftIO :: IO a -> State# RealWorld -> STret RealWorld a
liftIO :: forall a. 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 :: forall a. 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 :: forall a. 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 :: forall a s. 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
forall a b. a -> b
unsafeCoerce State# RealWorld -> (# State# RealWorld, a #)
io) State# s
s
unsafeSTToIO :: ST s a -> IO a
unsafeSTToIO :: forall s a. 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 #)
forall a b. a -> b
unsafeCoerce STRep s a
m)
type FilePath = String
catchException :: Exception e => IO a -> (e -> IO a) -> IO a
catchException :: forall e a. Exception e => 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 :: forall e a. Exception e => 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 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 = 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 a b. a -> State# RealWorld -> (# State# RealWorld, b #)
raiseIO# SomeException
e
catchAny :: IO a -> (forall e . Exception e => e -> IO a) -> IO a
catchAny :: forall a. 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 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) = 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 :: forall a. 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 :: forall e a. Exception e => 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 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 :: forall a. 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 a.
(State# RealWorld -> (# State# RealWorld, a #))
-> State# RealWorld -> (# State# RealWorld, a #)
maskAsyncExceptions# State# RealWorld -> (# State# RealWorld, a #)
io
unblock :: IO a -> IO a
unblock :: forall a. IO a -> IO a
unblock = IO a -> IO a
forall a. IO a -> IO a
unsafeUnmask
unsafeUnmask :: IO a -> IO a
unsafeUnmask :: forall a. 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 a.
(State# RealWorld -> (# State# RealWorld, a #))
-> State# RealWorld -> (# State# RealWorld, a #)
unmaskAsyncExceptions# State# RealWorld -> (# State# RealWorld, a #)
io
interruptible :: IO a -> IO a
interruptible :: forall a. 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 :: forall a. 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 a.
(State# RealWorld -> (# State# RealWorld, a #))
-> State# RealWorld -> (# State# RealWorld, a #)
maskUninterruptible# State# RealWorld -> (# State# RealWorld, a #)
io
data MaskingState
  = Unmasked 
  | MaskedInterruptible
      
  | MaskedUninterruptible
      
 deriving ( MaskingState -> MaskingState -> Bool
(MaskingState -> MaskingState -> Bool)
-> (MaskingState -> MaskingState -> Bool) -> Eq MaskingState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MaskingState -> MaskingState -> Bool
== :: MaskingState -> MaskingState -> Bool
$c/= :: MaskingState -> MaskingState -> Bool
/= :: MaskingState -> MaskingState -> Bool
Eq   
          , Int -> MaskingState -> ShowS
[MaskingState] -> ShowS
MaskingState -> String
(Int -> MaskingState -> ShowS)
-> (MaskingState -> String)
-> ([MaskingState] -> ShowS)
-> Show MaskingState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MaskingState -> ShowS
showsPrec :: Int -> MaskingState -> ShowS
$cshow :: MaskingState -> String
show :: MaskingState -> String
$cshowList :: [MaskingState] -> ShowS
showList :: [MaskingState] -> ShowS
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 :: forall a b. 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_ :: forall a. 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 b. ((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 IO a -> IO a
forall a. IO a -> IO a
unblock
    MaskingState
MaskedInterruptible   -> (forall a. IO a -> IO a) -> IO b
io IO a -> IO a
forall a. IO a -> IO a
block
    MaskingState
MaskedUninterruptible -> (forall a. IO a -> IO a) -> IO b
io IO a -> IO a
forall a. IO a -> IO a
blockUninterruptible
uninterruptibleMask_ :: forall a. 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 b. ((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 IO a -> IO a
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 IO a -> IO a
forall a. IO a -> IO a
block
    MaskingState
MaskedUninterruptible -> (forall a. IO a -> IO a) -> IO b
io IO a -> IO a
forall a. IO a -> IO a
blockUninterruptible
bracket
        :: IO a         
        -> (a -> IO b)  
        -> (a -> IO c)  
        -> IO c         
bracket :: forall a b c. 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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return c
r
finally :: IO a         
        -> IO b         
                        
        -> IO a         
IO a
a finally :: forall a b. 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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
r
evaluate :: a -> IO a
evaluate :: forall a. 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 a d. a -> State# d -> (# State# d, a #)
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)