{-# LANGUAGE CPP #-}
{-# LANGUAGE GADTs, ScopedTypeVariables #-}
module Development.Shake.Internal.Core.Monad(
RAW, Capture, runRAW,
getRO, getRW, putRW, modifyRW,
catchRAW, tryRAW, throwRAW,
captureRAW,
) where
import Control.Exception.Extra
import Control.Monad.IO.Class
import Data.IORef.Extra
import Control.Applicative
import Control.Monad
import Prelude
#if __GLASGOW_HASKELL__ >= 800
import Control.Monad.Fail
#endif
data RAW ro rw a where
Fmap :: (a -> b) -> RAW ro rw a -> RAW ro rw b
Pure :: a -> RAW ro rw a
Ap :: RAW ro rw (a -> b) -> RAW ro rw a -> RAW ro rw b
Next :: RAW ro rw a -> RAW ro rw b -> RAW ro rw b
Bind :: RAW ro rw a -> (a -> RAW ro rw b) -> RAW ro rw b
LiftIO :: IO a -> RAW ro rw a
GetRO :: RAW ro rw ro
GetRW :: RAW ro rw rw
PutRW :: !rw -> RAW ro rw ()
ModifyRW :: (rw -> rw) -> RAW ro rw ()
CaptureRAW :: Capture (Either SomeException a) -> RAW ro rw a
CatchRAW :: RAW ro rw a -> (SomeException -> RAW ro rw a) -> RAW ro rw a
instance Functor (RAW ro rw) where
fmap :: (a -> b) -> RAW ro rw a -> RAW ro rw b
fmap = (a -> b) -> RAW ro rw a -> RAW ro rw b
forall a b ro rw. (a -> b) -> RAW ro rw a -> RAW ro rw b
Fmap
instance Applicative (RAW ro rw) where
pure :: a -> RAW ro rw a
pure = a -> RAW ro rw a
forall a ro rw. a -> RAW ro rw a
Pure
*> :: RAW ro rw a -> RAW ro rw b -> RAW ro rw b
(*>) = RAW ro rw a -> RAW ro rw b -> RAW ro rw b
forall ro rw a b. RAW ro rw a -> RAW ro rw b -> RAW ro rw b
Next
<*> :: RAW ro rw (a -> b) -> RAW ro rw a -> RAW ro rw b
(<*>) = RAW ro rw (a -> b) -> RAW ro rw a -> RAW ro rw b
forall ro rw a b. RAW ro rw (a -> b) -> RAW ro rw a -> RAW ro rw b
Ap
instance Monad (RAW ro rw) where
return :: a -> RAW ro rw a
return = a -> RAW ro rw a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
>> :: RAW ro rw a -> RAW ro rw b -> RAW ro rw b
(>>) = RAW ro rw a -> RAW ro rw b -> RAW ro rw b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>)
>>= :: RAW ro rw a -> (a -> RAW ro rw b) -> RAW ro rw b
(>>=) = RAW ro rw a -> (a -> RAW ro rw b) -> RAW ro rw b
forall ro rw a b. RAW ro rw a -> (a -> RAW ro rw b) -> RAW ro rw b
Bind
instance MonadIO (RAW ro rw) where
liftIO :: IO a -> RAW ro rw a
liftIO = IO a -> RAW ro rw a
forall a ro rw. IO a -> RAW ro rw a
LiftIO
#if __GLASGOW_HASKELL__ >= 800
instance MonadFail (RAW ro rw) where
fail :: String -> RAW ro rw a
fail = IO a -> RAW ro rw a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> RAW ro rw a) -> (String -> IO a) -> String -> RAW ro rw a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
Control.Monad.Fail.fail
#endif
type Capture a = (a -> IO ()) -> IO ()
runRAW :: ro -> rw -> RAW ro rw a -> Capture (Either SomeException a)
runRAW :: ro -> rw -> RAW ro rw a -> Capture (Either SomeException a)
runRAW ro :: ro
ro rw :: rw
rw m :: RAW ro rw a
m k :: Either SomeException a -> IO ()
k = do
IORef rw
rw <- rw -> IO (IORef rw)
forall a. a -> IO (IORef a)
newIORef rw
rw
IORef (SomeException -> IO ())
handler <- (SomeException -> IO ()) -> IO (IORef (SomeException -> IO ()))
forall a. a -> IO (IORef a)
newIORef ((SomeException -> IO ()) -> IO (IORef (SomeException -> IO ())))
-> (SomeException -> IO ()) -> IO (IORef (SomeException -> IO ()))
forall a b. (a -> b) -> a -> b
$ Either SomeException a -> IO ()
k (Either SomeException a -> IO ())
-> (SomeException -> Either SomeException a)
-> SomeException
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> Either SomeException a
forall a b. a -> Either a b
Left
IORef (SomeException -> IO ())
-> ro -> IORef rw -> RAW ro rw a -> Capture a
forall ro rw a.
IORef (SomeException -> IO ())
-> ro -> IORef rw -> RAW ro rw a -> Capture a
goRAW IORef (SomeException -> IO ())
handler ro
ro IORef rw
rw RAW ro rw a
m (Either SomeException a -> IO ()
k (Either SomeException a -> IO ())
-> (a -> Either SomeException a) -> a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either SomeException a
forall a b. b -> Either a b
Right)
IO () -> (SomeException -> IO ()) -> IO ()
forall a. IO a -> (SomeException -> IO a) -> IO a
`catch_` \e :: SomeException
e -> ((SomeException -> IO ()) -> SomeException -> IO ()
forall a b. (a -> b) -> a -> b
$ SomeException
e) ((SomeException -> IO ()) -> IO ())
-> IO (SomeException -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IORef (SomeException -> IO ()) -> IO (SomeException -> IO ())
forall a. IORef a -> IO a
readIORef IORef (SomeException -> IO ())
handler
goRAW :: forall ro rw a . IORef (SomeException -> IO ()) -> ro -> IORef rw -> RAW ro rw a -> Capture a
goRAW :: IORef (SomeException -> IO ())
-> ro -> IORef rw -> RAW ro rw a -> Capture a
goRAW handler :: IORef (SomeException -> IO ())
handler ro :: ro
ro rw :: IORef rw
rw = RAW ro rw a -> Capture a
forall b. RAW ro rw b -> Capture b
go
where
go :: RAW ro rw b -> Capture b
go :: RAW ro rw b -> Capture b
go x :: RAW ro rw b
x k :: b -> IO ()
k = case RAW ro rw b
x of
Fmap f :: a -> b
f a :: RAW ro rw a
a -> RAW ro rw a -> Capture a
forall b. RAW ro rw b -> Capture b
go RAW ro rw a
a Capture a -> Capture a
forall a b. (a -> b) -> a -> b
$ \v :: a
v -> b -> IO ()
k (b -> IO ()) -> b -> IO ()
forall a b. (a -> b) -> a -> b
$ a -> b
f a
v
Pure a :: b
a -> b -> IO ()
k b
a
Ap f :: RAW ro rw (a -> b)
f x :: RAW ro rw a
x -> RAW ro rw (a -> b) -> Capture (a -> b)
forall b. RAW ro rw b -> Capture b
go RAW ro rw (a -> b)
f Capture (a -> b) -> Capture (a -> b)
forall a b. (a -> b) -> a -> b
$ \f :: a -> b
f -> RAW ro rw a -> Capture a
forall b. RAW ro rw b -> Capture b
go RAW ro rw a
x Capture a -> Capture a
forall a b. (a -> b) -> a -> b
$ \v :: a
v -> b -> IO ()
k (b -> IO ()) -> b -> IO ()
forall a b. (a -> b) -> a -> b
$ a -> b
f a
v
Bind a :: RAW ro rw a
a b :: a -> RAW ro rw b
b -> RAW ro rw a -> Capture a
forall b. RAW ro rw b -> Capture b
go RAW ro rw a
a Capture a -> Capture a
forall a b. (a -> b) -> a -> b
$ \a :: a
a -> RAW ro rw b -> Capture b
forall b. RAW ro rw b -> Capture b
go (a -> RAW ro rw b
b a
a) b -> IO ()
k
Next a :: RAW ro rw a
a b :: RAW ro rw b
b -> RAW ro rw a -> Capture a
forall b. RAW ro rw b -> Capture b
go RAW ro rw a
a Capture a -> Capture a
forall a b. (a -> b) -> a -> b
$ \_ -> RAW ro rw b -> Capture b
forall b. RAW ro rw b -> Capture b
go RAW ro rw b
b b -> IO ()
k
LiftIO x :: IO b
x -> b -> IO ()
k (b -> IO ()) -> IO b -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO b
x
GetRO -> b -> IO ()
k ro
b
ro
GetRW -> b -> IO ()
k (b -> IO ()) -> IO b -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IORef rw -> IO rw
forall a. IORef a -> IO a
readIORef IORef rw
rw
PutRW x :: rw
x -> IORef rw -> rw -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef rw
rw rw
x IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> b -> IO ()
k ()
ModifyRW f :: rw -> rw
f -> IORef rw -> (rw -> rw) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef rw
rw rw -> rw
f IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> b -> IO ()
k ()
CatchRAW m :: RAW ro rw b
m hdl :: SomeException -> RAW ro rw b
hdl -> do
SomeException -> IO ()
old <- IORef (SomeException -> IO ()) -> IO (SomeException -> IO ())
forall a. IORef a -> IO a
readIORef IORef (SomeException -> IO ())
handler
IORef (SomeException -> IO ()) -> (SomeException -> IO ()) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (SomeException -> IO ())
handler ((SomeException -> IO ()) -> IO ())
-> (SomeException -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \e :: SomeException
e -> do
IORef (SomeException -> IO ()) -> (SomeException -> IO ()) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (SomeException -> IO ())
handler SomeException -> IO ()
old
RAW ro rw b -> Capture b
forall b. RAW ro rw b -> Capture b
go (SomeException -> RAW ro rw b
hdl SomeException
e) b -> IO ()
k IO () -> (SomeException -> IO ()) -> IO ()
forall a. IO a -> (SomeException -> IO a) -> IO a
`catch_`
\e :: SomeException
e -> ((SomeException -> IO ()) -> SomeException -> IO ()
forall a b. (a -> b) -> a -> b
$ SomeException
e) ((SomeException -> IO ()) -> IO ())
-> IO (SomeException -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IORef (SomeException -> IO ()) -> IO (SomeException -> IO ())
forall a. IORef a -> IO a
readIORef IORef (SomeException -> IO ())
handler
RAW ro rw b -> Capture b
forall b. RAW ro rw b -> Capture b
go RAW ro rw b
m Capture b -> Capture b
forall a b. (a -> b) -> a -> b
$ \x :: b
x -> IORef (SomeException -> IO ()) -> (SomeException -> IO ()) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (SomeException -> IO ())
handler SomeException -> IO ()
old IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> b -> IO ()
k b
x
CaptureRAW f :: Capture (Either SomeException b)
f -> do
SomeException -> IO ()
old <- IORef (SomeException -> IO ()) -> IO (SomeException -> IO ())
forall a. IORef a -> IO a
readIORef IORef (SomeException -> IO ())
handler
IORef (SomeException -> IO ()) -> (SomeException -> IO ()) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (SomeException -> IO ())
handler SomeException -> IO ()
forall e a. Exception e => e -> IO a
throwIO
Capture (Either SomeException b)
f Capture (Either SomeException b)
-> Capture (Either SomeException b)
forall a b. (a -> b) -> a -> b
$ \x :: Either SomeException b
x -> case Either SomeException b
x of
Left e :: SomeException
e -> SomeException -> IO ()
old SomeException
e
Right v :: b
v -> do
IORef (SomeException -> IO ()) -> (SomeException -> IO ()) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (SomeException -> IO ())
handler SomeException -> IO ()
old
b -> IO ()
k b
v IO () -> (SomeException -> IO ()) -> IO ()
forall a. IO a -> (SomeException -> IO a) -> IO a
`catch_` \e :: SomeException
e -> ((SomeException -> IO ()) -> SomeException -> IO ()
forall a b. (a -> b) -> a -> b
$ SomeException
e) ((SomeException -> IO ()) -> IO ())
-> IO (SomeException -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IORef (SomeException -> IO ()) -> IO (SomeException -> IO ())
forall a. IORef a -> IO a
readIORef IORef (SomeException -> IO ())
handler
IORef (SomeException -> IO ()) -> (SomeException -> IO ()) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (SomeException -> IO ())
handler SomeException -> IO ()
forall e a. Exception e => e -> IO a
throwIO
getRO :: RAW ro rw ro
getRO :: RAW ro rw ro
getRO = RAW ro rw ro
forall ro rw. RAW ro rw ro
GetRO
getRW :: RAW ro rw rw
getRW :: RAW ro rw rw
getRW = RAW ro rw rw
forall ro rw. RAW ro rw rw
GetRW
putRW :: rw -> RAW ro rw ()
putRW :: rw -> RAW ro rw ()
putRW = rw -> RAW ro rw ()
forall rw ro. rw -> RAW ro rw ()
PutRW
modifyRW :: (rw -> rw) -> RAW ro rw ()
modifyRW :: (rw -> rw) -> RAW ro rw ()
modifyRW = (rw -> rw) -> RAW ro rw ()
forall rw ro. (rw -> rw) -> RAW ro rw ()
ModifyRW
catchRAW :: RAW ro rw a -> (SomeException -> RAW ro rw a) -> RAW ro rw a
catchRAW :: RAW ro rw a -> (SomeException -> RAW ro rw a) -> RAW ro rw a
catchRAW = RAW ro rw a -> (SomeException -> RAW ro rw a) -> RAW ro rw a
forall ro rw a.
RAW ro rw a -> (SomeException -> RAW ro rw a) -> RAW ro rw a
CatchRAW
tryRAW :: RAW ro rw a -> RAW ro rw (Either SomeException a)
tryRAW :: RAW ro rw a -> RAW ro rw (Either SomeException a)
tryRAW m :: RAW ro rw a
m = RAW ro rw (Either SomeException a)
-> (SomeException -> RAW ro rw (Either SomeException a))
-> RAW ro rw (Either SomeException a)
forall ro rw a.
RAW ro rw a -> (SomeException -> RAW ro rw a) -> RAW ro rw a
catchRAW ((a -> Either SomeException a)
-> RAW ro rw a -> RAW ro rw (Either SomeException a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Either SomeException a
forall a b. b -> Either a b
Right RAW ro rw a
m) (Either SomeException a -> RAW ro rw (Either SomeException a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either SomeException a -> RAW ro rw (Either SomeException a))
-> (SomeException -> Either SomeException a)
-> SomeException
-> RAW ro rw (Either SomeException a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> Either SomeException a
forall a b. a -> Either a b
Left)
throwRAW :: Exception e => e -> RAW ro rw a
throwRAW :: e -> RAW ro rw a
throwRAW = IO a -> RAW ro rw a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> RAW ro rw a) -> (e -> IO a) -> e -> RAW ro rw a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> IO a
forall e a. Exception e => e -> IO a
throwIO
captureRAW :: Capture (Either SomeException a) -> RAW ro rw a
captureRAW :: Capture (Either SomeException a) -> RAW ro rw a
captureRAW = Capture (Either SomeException a) -> RAW ro rw a
forall a ro rw. Capture (Either SomeException a) -> RAW ro rw a
CaptureRAW