{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE GADTs, ScopedTypeVariables, TupleSections, GeneralizedNewtypeDeriving #-}

module Development.Shake.Internal.Core.Monad(
    RAW, Capture, runRAW,
    getRO, getRW, putRW, modifyRW,
    stepRAW,
    catchRAW, tryRAW, throwRAW, finallyRAW,
    captureRAW,
    ) where

import Control.Exception.Extra
import Development.Shake.Internal.Errors
import Control.Monad.IO.Class
import Data.IORef
import Control.Monad
import System.IO
import Data.Semigroup
import Control.Monad.Fail
import Prelude


data RAW k v ro rw a where
    Fmap :: (a -> b) -> RAW k v ro rw a -> RAW k v ro rw b
    Pure :: a -> RAW k v ro rw a
    Ap :: RAW k v ro rw (a -> b) -> RAW k v ro rw a -> RAW k v ro rw b
    Next :: RAW k v ro rw a -> RAW k v ro rw b -> RAW k v ro rw b
    Bind :: RAW k v ro rw a -> (a -> RAW k v ro rw b) -> RAW k v ro rw b
    LiftIO :: IO a -> RAW k v ro rw a
    GetRO :: RAW k v ro rw ro
    GetRW :: RAW k v ro rw rw
    PutRW :: !rw -> RAW k v ro rw ()
    ModifyRW :: (rw -> rw) -> RAW k v ro rw ()
    StepRAW :: k -> RAW k v ro rw v
    CaptureRAW :: Capture (Either SomeException a) -> RAW k v ro rw a
    CatchRAW :: RAW k v ro rw a -> (SomeException -> RAW k v ro rw a) -> RAW k v ro rw a

instance Functor (RAW k v ro rw) where
    fmap :: forall a b. (a -> b) -> RAW k v ro rw a -> RAW k v ro rw b
fmap = forall a b k v ro rw.
(a -> b) -> RAW k v ro rw a -> RAW k v ro rw b
Fmap

instance Applicative (RAW k v ro rw) where
    pure :: forall a. a -> RAW k v ro rw a
pure = forall a k v ro rw. a -> RAW k v ro rw a
Pure
    *> :: forall a b. RAW k v ro rw a -> RAW k v ro rw b -> RAW k v ro rw b
(*>) = forall k v ro rw a b.
RAW k v ro rw a -> RAW k v ro rw b -> RAW k v ro rw b
Next
    <*> :: forall a b.
RAW k v ro rw (a -> b) -> RAW k v ro rw a -> RAW k v ro rw b
(<*>) = forall k v ro rw a b.
RAW k v ro rw (a -> b) -> RAW k v ro rw a -> RAW k v ro rw b
Ap

instance Monad (RAW k v ro rw) where
    return :: forall a. a -> RAW k v ro rw a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure
    >> :: forall a b. RAW k v ro rw a -> RAW k v ro rw b -> RAW k v ro rw b
(>>) = forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>)
    >>= :: forall a b.
RAW k v ro rw a -> (a -> RAW k v ro rw b) -> RAW k v ro rw b
(>>=) = forall k v ro rw a b.
RAW k v ro rw a -> (a -> RAW k v ro rw b) -> RAW k v ro rw b
Bind

instance MonadIO (RAW k v ro rw) where
    liftIO :: forall a. IO a -> RAW k v ro rw a
liftIO = forall a k v ro rw. IO a -> RAW k v ro rw a
LiftIO

instance MonadFail (RAW k v ro rw) where
    fail :: forall a. String -> RAW k v ro rw a
fail = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadFail m => String -> m a
Control.Monad.Fail.fail

instance Semigroup a => Semigroup (RAW k v ro rw a) where
    <> :: RAW k v ro rw a -> RAW k v ro rw a -> RAW k v ro rw a
(<>) RAW k v ro rw a
a RAW k v ro rw a
b = forall a. Semigroup a => a -> a -> a
(<>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RAW k v ro rw a
a forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RAW k v ro rw a
b

instance (Semigroup a, Monoid a) => Monoid (RAW k v ro rw a) where
    mempty :: RAW k v ro rw a
mempty = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty
    mappend :: RAW k v ro rw a -> RAW k v ro rw a -> RAW k v ro rw a
mappend = forall a. Semigroup a => a -> a -> a
(<>)


type Capture a = (a -> IO ()) -> IO ()


-- Useful for checking that all continuations are run only once
-- Cannot be enabled for performance reasons and because some of
-- "monad test" deliberately breaks the invariant to check it doesn't go wrong
assertOnceCheck :: Bool
assertOnceCheck = Bool
False

assertOnce :: MonadIO m => String -> (a -> m b) -> IO (a -> m b)
assertOnce :: forall (m :: * -> *) a b.
MonadIO m =>
String -> (a -> m b) -> IO (a -> m b)
assertOnce String
msg a -> m b
k
    | Bool -> Bool
not Bool
assertOnceCheck = forall (f :: * -> *) a. Applicative f => a -> f a
pure a -> m b
k
    | Bool
otherwise = do
        IORef Bool
ref <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (IORef a)
newIORef Bool
False
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ \a
v -> do
            forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall a b. (a -> b) -> a -> b
$ forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef IORef Bool
ref forall a b. (a -> b) -> a -> b
$ \Bool
old -> (Bool
True,) forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
old forall a b. (a -> b) -> a -> b
$ do
                Handle -> String -> IO ()
hPutStrLn Handle
stderr String
"FATAL ERROR: assertOnce failed"
                forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail forall a b. (a -> b) -> a -> b
$ String
"assertOnce failed: " forall a. [a] -> [a] -> [a]
++ String
msg
            a -> m b
k a
v

-- | Run and then call a continuation.
runRAW :: ([k] -> RAW k v ro rw [v]) -> ro -> rw -> RAW k v ro rw a -> Capture (Either SomeException a)
runRAW :: forall k v ro rw a.
([k] -> RAW k v ro rw [v])
-> ro -> rw -> RAW k v ro rw a -> Capture (Either SomeException a)
runRAW [k] -> RAW k v ro rw [v]
step ro
ro rw
rw RAW k v ro rw a
m Either SomeException a -> IO ()
k = do
    Either SomeException a -> IO ()
k <- forall (m :: * -> *) a b.
MonadIO m =>
String -> (a -> m b) -> IO (a -> m b)
assertOnce String
"runRAW" Either SomeException a -> IO ()
k
    IORef rw
rw <- forall a. a -> IO (IORef a)
newIORef rw
rw
    IORef (SomeException -> IO ())
handler <- forall a. a -> IO (IORef a)
newIORef forall e a. Exception e => e -> IO a
throwIO
    Steps k v
steps <- forall k v. IO (Steps k v)
newSteps
    forall a. IORef a -> a -> IO ()
writeIORef IORef (SomeException -> IO ())
handler forall a b. (a -> b) -> a -> b
$ \SomeException
e -> do
        -- make sure we never call the error continuation twice
        forall a. IORef a -> a -> IO ()
writeIORef IORef (SomeException -> IO ())
handler forall e a. Exception e => e -> IO a
throwIO
        Either SomeException a -> IO ()
k forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left SomeException
e
    -- If the continuation itself throws an error we need to make sure we
    -- don't end up running it twice (once with its result, once with its own exception)
    forall k v ro rw a.
([k] -> RAW k v ro rw [v])
-> Steps k v
-> IORef (SomeException -> IO ())
-> ro
-> IORef rw
-> RAW k v ro rw a
-> Capture a
goRAW [k] -> RAW k v ro rw [v]
step Steps k v
steps IORef (SomeException -> IO ())
handler ro
ro IORef rw
rw RAW k v ro rw a
m (\a
v -> do forall a. IORef a -> a -> IO ()
writeIORef IORef (SomeException -> IO ())
handler forall e a. Exception e => e -> IO a
throwIO; Either SomeException a -> IO ()
k forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right a
v)
        forall a. IO a -> (SomeException -> IO a) -> IO a
`catch_` \SomeException
e -> (forall a b. (a -> b) -> a -> b
$ SomeException
e) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. IORef a -> IO a
readIORef IORef (SomeException -> IO ())
handler


goRAW :: forall k v ro rw a . ([k] -> RAW k v ro rw [v]) -> Steps k v -> IORef (SomeException -> IO ()) -> ro -> IORef rw -> RAW k v ro rw a -> Capture a
goRAW :: forall k v ro rw a.
([k] -> RAW k v ro rw [v])
-> Steps k v
-> IORef (SomeException -> IO ())
-> ro
-> IORef rw
-> RAW k v ro rw a
-> Capture a
goRAW [k] -> RAW k v ro rw [v]
step Steps k v
steps IORef (SomeException -> IO ())
handler ro
ro IORef rw
rw = \RAW k v ro rw a
x a -> IO ()
k -> forall b. RAW k v ro rw b -> Capture (SIO b)
go RAW k v ro rw a
x forall a b. (a -> b) -> a -> b
$ \SIO a
v -> forall b. SIO b -> Capture b
sio SIO a
v a -> IO ()
k
    where
        sio :: SIO b -> Capture b
        sio :: forall b. SIO b -> Capture b
sio (SIO IO b
v) b -> IO ()
k = IO () -> IO ()
flush forall a b. (a -> b) -> a -> b
$ do b
v <- IO b
v; b -> IO ()
k b
v

        flush :: IO () -> IO ()
        flush :: IO () -> IO ()
flush IO ()
k = do
            Maybe (([k] -> RAW k v ro rw [v]) -> RAW k v ro rw ())
v <- forall (m :: * -> *) k v.
MonadIO m =>
Steps k v -> IO (Maybe (([k] -> m [v]) -> m ()))
flushSteps Steps k v
steps
            case Maybe (([k] -> RAW k v ro rw [v]) -> RAW k v ro rw ())
v of
                Maybe (([k] -> RAW k v ro rw [v]) -> RAW k v ro rw ())
Nothing -> IO ()
k
                Just ([k] -> RAW k v ro rw [v]) -> RAW k v ro rw ()
f -> forall b. RAW k v ro rw b -> Capture (SIO b)
go (([k] -> RAW k v ro rw [v]) -> RAW k v ro rw ()
f [k] -> RAW k v ro rw [v]
step) forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const IO ()
k

        unflush :: IO ()
        unflush :: IO ()
unflush = forall k v. Steps k v -> IO ()
unflushSteps Steps k v
steps

        go :: RAW k v ro rw b -> Capture (SIO b)
        go :: forall b. RAW k v ro rw b -> Capture (SIO b)
go RAW k v ro rw b
x SIO b -> IO ()
k = case RAW k v ro rw b
x of
            Fmap a -> b
f RAW k v ro rw a
a -> forall b. RAW k v ro rw b -> Capture (SIO b)
go RAW k v ro rw a
a forall a b. (a -> b) -> a -> b
$ \SIO a
v -> SIO b -> IO ()
k forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f SIO a
v
            Pure b
a -> SIO b -> IO ()
k forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure b
a
            Ap RAW k v ro rw (a -> b)
f RAW k v ro rw a
x -> forall b. RAW k v ro rw b -> Capture (SIO b)
go RAW k v ro rw (a -> b)
f forall a b. (a -> b) -> a -> b
$ \SIO (a -> b)
f -> forall b. RAW k v ro rw b -> Capture (SIO b)
go RAW k v ro rw a
x forall a b. (a -> b) -> a -> b
$ \SIO a
v -> SIO b -> IO ()
k forall a b. (a -> b) -> a -> b
$ SIO (a -> b)
f forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SIO a
v
            Next RAW k v ro rw a
a RAW k v ro rw b
b -> forall b. RAW k v ro rw b -> Capture (SIO b)
go RAW k v ro rw a
a forall a b. (a -> b) -> a -> b
$ \SIO a
a -> forall b. RAW k v ro rw b -> Capture (SIO b)
go RAW k v ro rw b
b forall a b. (a -> b) -> a -> b
$ \SIO b
b -> SIO b -> IO ()
k forall a b. (a -> b) -> a -> b
$ SIO a
a forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> SIO b
b
            StepRAW k
q -> do
                SIO v
v <- forall k v. Steps k v -> k -> IO (SIO v)
addStep Steps k v
steps k
q
                SIO b -> IO ()
k SIO v
v

            Bind RAW k v ro rw a
a a -> RAW k v ro rw b
b -> forall b. RAW k v ro rw b -> Capture (SIO b)
go RAW k v ro rw a
a forall a b. (a -> b) -> a -> b
$ \SIO a
a -> forall b. SIO b -> Capture b
sio SIO a
a forall a b. (a -> b) -> a -> b
$ \a
a -> forall b. RAW k v ro rw b -> Capture (SIO b)
go (a -> RAW k v ro rw b
b a
a) SIO b -> IO ()
k
            LiftIO IO b
act -> IO () -> IO ()
flush forall a b. (a -> b) -> a -> b
$ do b
v <- IO b
act; SIO b -> IO ()
k forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure b
v

            RAW k v ro rw b
GetRO -> SIO b -> IO ()
k forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure ro
ro
            RAW k v ro rw b
GetRW -> IO () -> IO ()
flush forall a b. (a -> b) -> a -> b
$ SIO b -> IO ()
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. IORef a -> IO a
readIORef IORef rw
rw
            PutRW rw
x -> IO () -> IO ()
flush forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> a -> IO ()
writeIORef IORef rw
rw rw
x forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SIO b -> IO ()
k (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
            ModifyRW rw -> rw
f -> IO () -> IO ()
flush forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef rw
rw rw -> rw
f forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SIO b -> IO ()
k (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

            CatchRAW RAW k v ro rw b
m SomeException -> RAW k v ro rw b
hdl -> IO () -> IO ()
flush forall a b. (a -> b) -> a -> b
$ do
                SomeException -> RAW k v ro rw b
hdl <- forall (m :: * -> *) a b.
MonadIO m =>
String -> (a -> m b) -> IO (a -> m b)
assertOnce String
"CatchRAW" SomeException -> RAW k v ro rw b
hdl
                SomeException -> IO ()
old <- forall a. IORef a -> IO a
readIORef IORef (SomeException -> IO ())
handler
                forall a. IORef a -> a -> IO ()
writeIORef IORef (SomeException -> IO ())
handler forall a b. (a -> b) -> a -> b
$ \SomeException
e -> do
                    forall a. IORef a -> a -> IO ()
writeIORef IORef (SomeException -> IO ())
handler SomeException -> IO ()
old
                    forall b. RAW k v ro rw b -> Capture (SIO b)
go (SomeException -> RAW k v ro rw b
hdl SomeException
e) SIO b -> IO ()
k forall a. IO a -> (SomeException -> IO a) -> IO a
`catch_`
                        \SomeException
e -> do IO ()
unflush; (forall a b. (a -> b) -> a -> b
$ SomeException
e) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. IORef a -> IO a
readIORef IORef (SomeException -> IO ())
handler
                forall b. RAW k v ro rw b -> Capture (SIO b)
go RAW k v ro rw b
m forall a b. (a -> b) -> a -> b
$ \SIO b
x -> forall a. IORef a -> a -> IO ()
writeIORef IORef (SomeException -> IO ())
handler SomeException -> IO ()
old forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SIO b -> IO ()
k SIO b
x

            CaptureRAW Capture (Either SomeException b)
f -> IO () -> IO ()
flush forall a b. (a -> b) -> a -> b
$ do
                Capture (Either SomeException b)
f <- forall (m :: * -> *) a b.
MonadIO m =>
String -> (a -> m b) -> IO (a -> m b)
assertOnce String
"CaptureRAW" Capture (Either SomeException b)
f
                SomeException -> IO ()
old <- forall a. IORef a -> IO a
readIORef IORef (SomeException -> IO ())
handler
                forall a. IORef a -> a -> IO ()
writeIORef IORef (SomeException -> IO ())
handler forall e a. Exception e => e -> IO a
throwIO
                Capture (Either SomeException b)
f forall a b. (a -> b) -> a -> b
$ \case
                    Left SomeException
e -> SomeException -> IO ()
old SomeException
e
                    Right b
v -> do
                        forall a. IORef a -> a -> IO ()
writeIORef IORef (SomeException -> IO ())
handler SomeException -> IO ()
old
                        SIO b -> IO ()
k (forall (f :: * -> *) a. Applicative f => a -> f a
pure b
v) forall a. IO a -> (SomeException -> IO a) -> IO a
`catch_` \SomeException
e -> do IO ()
unflush; (forall a b. (a -> b) -> a -> b
$ SomeException
e) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. IORef a -> IO a
readIORef IORef (SomeException -> IO ())
handler


newtype SIO a = SIO (IO a)
    deriving (forall a b. a -> SIO b -> SIO a
forall a b. (a -> b) -> SIO a -> SIO b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> SIO b -> SIO a
$c<$ :: forall a b. a -> SIO b -> SIO a
fmap :: forall a b. (a -> b) -> SIO a -> SIO b
$cfmap :: forall a b. (a -> b) -> SIO a -> SIO b
Functor, Applicative SIO
forall a. a -> SIO a
forall a b. SIO a -> SIO b -> SIO b
forall a b. SIO a -> (a -> SIO b) -> SIO b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> SIO a
$creturn :: forall a. a -> SIO a
>> :: forall a b. SIO a -> SIO b -> SIO b
$c>> :: forall a b. SIO a -> SIO b -> SIO b
>>= :: forall a b. SIO a -> (a -> SIO b) -> SIO b
$c>>= :: forall a b. SIO a -> (a -> SIO b) -> SIO b
Monad, Functor SIO
forall a. a -> SIO a
forall a b. SIO a -> SIO b -> SIO a
forall a b. SIO a -> SIO b -> SIO b
forall a b. SIO (a -> b) -> SIO a -> SIO b
forall a b c. (a -> b -> c) -> SIO a -> SIO b -> SIO c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. SIO a -> SIO b -> SIO a
$c<* :: forall a b. SIO a -> SIO b -> SIO a
*> :: forall a b. SIO a -> SIO b -> SIO b
$c*> :: forall a b. SIO a -> SIO b -> SIO b
liftA2 :: forall a b c. (a -> b -> c) -> SIO a -> SIO b -> SIO c
$cliftA2 :: forall a b c. (a -> b -> c) -> SIO a -> SIO b -> SIO c
<*> :: forall a b. SIO (a -> b) -> SIO a -> SIO b
$c<*> :: forall a b. SIO (a -> b) -> SIO a -> SIO b
pure :: forall a. a -> SIO a
$cpure :: forall a. a -> SIO a
Applicative)


newtype Steps k v = Steps (IORef [(k, IORef v)])

newSteps :: IO (Steps k v)
newSteps :: forall k v. IO (Steps k v)
newSteps = forall k v. IORef [(k, IORef v)] -> Steps k v
Steps forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. a -> IO (IORef a)
newIORef []

addStep :: Steps k v -> k -> IO (SIO v)
addStep :: forall k v. Steps k v -> k -> IO (SIO v)
addStep (Steps IORef [(k, IORef v)]
ref) k
k = do
    IORef v
out <- forall a. a -> IO (IORef a)
newIORef forall a b. (a -> b) -> a -> b
$ forall a. SomeException -> a
throwImpure forall a b. (a -> b) -> a -> b
$ Partial => String -> SomeException
errorInternal String
"Monad, addStep not flushed"
    forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef [(k, IORef v)]
ref ((k
k,IORef v
out)forall a. a -> [a] -> [a]
:)
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. IO a -> SIO a
SIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> IO a
readIORef IORef v
out

unflushSteps :: Steps k v -> IO ()
unflushSteps :: forall k v. Steps k v -> IO ()
unflushSteps (Steps IORef [(k, IORef v)]
ref) = forall a. IORef a -> a -> IO ()
writeIORef IORef [(k, IORef v)]
ref []

flushSteps :: MonadIO m => Steps k v -> IO (Maybe (([k] -> m [v]) -> m ()))
flushSteps :: forall (m :: * -> *) k v.
MonadIO m =>
Steps k v -> IO (Maybe (([k] -> m [v]) -> m ()))
flushSteps (Steps IORef [(k, IORef v)]
ref) = do
    [(k, IORef v)]
v <- forall a. [a] -> [a]
reverse forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. IORef a -> IO a
readIORef IORef [(k, IORef v)]
ref
    case [(k, IORef v)]
v of
        [] -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
        [(k, IORef v)]
xs -> do
            forall a. IORef a -> a -> IO ()
writeIORef IORef [(k, IORef v)]
ref []
            forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ \[k] -> m [v]
step -> do
                [v]
vs <- [k] -> m [v]
step forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(k, IORef v)]
xs
                forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m ()
zipWithM_ forall a. IORef a -> a -> IO ()
writeIORef (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(k, IORef v)]
xs) [v]
vs


---------------------------------------------------------------------
-- STANDARD

getRO :: RAW k v ro rw ro
getRO :: forall k v ro rw. RAW k v ro rw ro
getRO = forall k v ro rw. RAW k v ro rw ro
GetRO

getRW :: RAW k v ro rw rw
getRW :: forall k v ro rw. RAW k v ro rw rw
getRW = forall k v ro rw. RAW k v ro rw rw
GetRW

-- | Strict version
putRW :: rw -> RAW k v ro rw ()
putRW :: forall rw k v ro. rw -> RAW k v ro rw ()
putRW = forall rw k v ro. rw -> RAW k v ro rw ()
PutRW

modifyRW :: (rw -> rw) -> RAW k v ro rw ()
modifyRW :: forall rw k v ro. (rw -> rw) -> RAW k v ro rw ()
modifyRW = forall rw k v ro. (rw -> rw) -> RAW k v ro rw ()
ModifyRW


---------------------------------------------------------------------
-- EXCEPTIONS

catchRAW :: RAW k v ro rw a -> (SomeException -> RAW k v ro rw a) -> RAW k v ro rw a
catchRAW :: forall k v ro rw a.
RAW k v ro rw a
-> (SomeException -> RAW k v ro rw a) -> RAW k v ro rw a
catchRAW = forall k v ro rw a.
RAW k v ro rw a
-> (SomeException -> RAW k v ro rw a) -> RAW k v ro rw a
CatchRAW

tryRAW :: RAW k v ro rw a -> RAW k v ro rw (Either SomeException a)
tryRAW :: forall k v ro rw a.
RAW k v ro rw a -> RAW k v ro rw (Either SomeException a)
tryRAW RAW k v ro rw a
m = forall k v ro rw a.
RAW k v ro rw a
-> (SomeException -> RAW k v ro rw a) -> RAW k v ro rw a
catchRAW (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. b -> Either a b
Right RAW k v ro rw a
m) (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left)

throwRAW :: Exception e => e -> RAW k v ro rw a
-- Note that while we could directly pass this to the handler
-- that would avoid triggering the catch, which would mean they built up on the stack
throwRAW :: forall e k v ro rw a. Exception e => e -> RAW k v ro rw a
throwRAW = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. Exception e => e -> IO a
throwIO

finallyRAW :: RAW k v ro rw a -> RAW k v ro rw b -> RAW k v ro rw a
finallyRAW :: forall k v ro rw a b.
RAW k v ro rw a -> RAW k v ro rw b -> RAW k v ro rw a
finallyRAW RAW k v ro rw a
a RAW k v ro rw b
undo = do
    a
r <- forall k v ro rw a.
RAW k v ro rw a
-> (SomeException -> RAW k v ro rw a) -> RAW k v ro rw a
catchRAW RAW k v ro rw a
a (\SomeException
e -> RAW k v ro rw b
undo forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall e k v ro rw a. Exception e => e -> RAW k v ro rw a
throwRAW SomeException
e)
    RAW k v ro rw b
undo
    forall (f :: * -> *) a. Applicative f => a -> f a
pure a
r


---------------------------------------------------------------------
-- CONTINUATIONS

-- | Capture a continuation. The continuation should be called at most once.
--   Calling the same continuation, multiple times, in parallel, results in incorrect behaviour.
captureRAW :: Capture (Either SomeException a) -> RAW k v ro rw a
captureRAW :: forall a k v ro rw.
Capture (Either SomeException a) -> RAW k v ro rw a
captureRAW = forall a k v ro rw.
Capture (Either SomeException a) -> RAW k v ro rw a
CaptureRAW


---------------------------------------------------------------------
-- STEPS

stepRAW :: k -> RAW k v ro rw v
stepRAW :: forall k v ro rw. k -> RAW k v ro rw v
stepRAW = forall k v ro rw. k -> RAW k v ro rw v
StepRAW