{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE UndecidableInstances #-}
module RIO.Prelude.RIO
( RIO (..)
, runRIO
, liftRIO
, mapRIO
, SomeRef
, HasStateRef (..)
, HasWriteRef (..)
, newSomeRef
, newUnboxedSomeRef
, readSomeRef
, writeSomeRef
, modifySomeRef
) where
import GHC.Exts (RealWorld)
import RIO.Prelude.Lens
import RIO.Prelude.URef
import RIO.Prelude.Reexports
import Control.Monad.State (MonadState(..))
import Control.Monad.Writer (MonadWriter(..))
newtype RIO env a = RIO { RIO env a -> ReaderT env IO a
unRIO :: ReaderT env IO a }
deriving (a -> RIO env b -> RIO env a
(a -> b) -> RIO env a -> RIO env b
(forall a b. (a -> b) -> RIO env a -> RIO env b)
-> (forall a b. a -> RIO env b -> RIO env a) -> Functor (RIO env)
forall a b. a -> RIO env b -> RIO env a
forall a b. (a -> b) -> RIO env a -> RIO env b
forall env a b. a -> RIO env b -> RIO env a
forall env a b. (a -> b) -> RIO env a -> RIO env b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> RIO env b -> RIO env a
$c<$ :: forall env a b. a -> RIO env b -> RIO env a
fmap :: (a -> b) -> RIO env a -> RIO env b
$cfmap :: forall env a b. (a -> b) -> RIO env a -> RIO env b
Functor,Functor (RIO env)
a -> RIO env a
Functor (RIO env)
-> (forall a. a -> RIO env a)
-> (forall a b. RIO env (a -> b) -> RIO env a -> RIO env b)
-> (forall a b c.
(a -> b -> c) -> RIO env a -> RIO env b -> RIO env c)
-> (forall a b. RIO env a -> RIO env b -> RIO env b)
-> (forall a b. RIO env a -> RIO env b -> RIO env a)
-> Applicative (RIO env)
RIO env a -> RIO env b -> RIO env b
RIO env a -> RIO env b -> RIO env a
RIO env (a -> b) -> RIO env a -> RIO env b
(a -> b -> c) -> RIO env a -> RIO env b -> RIO env c
forall env. Functor (RIO env)
forall a. a -> RIO env a
forall env a. a -> RIO env a
forall a b. RIO env a -> RIO env b -> RIO env a
forall a b. RIO env a -> RIO env b -> RIO env b
forall a b. RIO env (a -> b) -> RIO env a -> RIO env b
forall env a b. RIO env a -> RIO env b -> RIO env a
forall env a b. RIO env a -> RIO env b -> RIO env b
forall env a b. RIO env (a -> b) -> RIO env a -> RIO env b
forall a b c. (a -> b -> c) -> RIO env a -> RIO env b -> RIO env c
forall env a b c.
(a -> b -> c) -> RIO env a -> RIO env b -> RIO env 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
<* :: RIO env a -> RIO env b -> RIO env a
$c<* :: forall env a b. RIO env a -> RIO env b -> RIO env a
*> :: RIO env a -> RIO env b -> RIO env b
$c*> :: forall env a b. RIO env a -> RIO env b -> RIO env b
liftA2 :: (a -> b -> c) -> RIO env a -> RIO env b -> RIO env c
$cliftA2 :: forall env a b c.
(a -> b -> c) -> RIO env a -> RIO env b -> RIO env c
<*> :: RIO env (a -> b) -> RIO env a -> RIO env b
$c<*> :: forall env a b. RIO env (a -> b) -> RIO env a -> RIO env b
pure :: a -> RIO env a
$cpure :: forall env a. a -> RIO env a
$cp1Applicative :: forall env. Functor (RIO env)
Applicative,Applicative (RIO env)
a -> RIO env a
Applicative (RIO env)
-> (forall a b. RIO env a -> (a -> RIO env b) -> RIO env b)
-> (forall a b. RIO env a -> RIO env b -> RIO env b)
-> (forall a. a -> RIO env a)
-> Monad (RIO env)
RIO env a -> (a -> RIO env b) -> RIO env b
RIO env a -> RIO env b -> RIO env b
forall env. Applicative (RIO env)
forall a. a -> RIO env a
forall env a. a -> RIO env a
forall a b. RIO env a -> RIO env b -> RIO env b
forall a b. RIO env a -> (a -> RIO env b) -> RIO env b
forall env a b. RIO env a -> RIO env b -> RIO env b
forall env a b. RIO env a -> (a -> RIO env b) -> RIO env 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 :: a -> RIO env a
$creturn :: forall env a. a -> RIO env a
>> :: RIO env a -> RIO env b -> RIO env b
$c>> :: forall env a b. RIO env a -> RIO env b -> RIO env b
>>= :: RIO env a -> (a -> RIO env b) -> RIO env b
$c>>= :: forall env a b. RIO env a -> (a -> RIO env b) -> RIO env b
$cp1Monad :: forall env. Applicative (RIO env)
Monad,Monad (RIO env)
Monad (RIO env)
-> (forall a. IO a -> RIO env a) -> MonadIO (RIO env)
IO a -> RIO env a
forall env. Monad (RIO env)
forall a. IO a -> RIO env a
forall env a. IO a -> RIO env a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> RIO env a
$cliftIO :: forall env a. IO a -> RIO env a
$cp1MonadIO :: forall env. Monad (RIO env)
MonadIO,MonadReader env,Monad (RIO env)
e -> RIO env a
Monad (RIO env)
-> (forall e a. Exception e => e -> RIO env a)
-> MonadThrow (RIO env)
forall env. Monad (RIO env)
forall e a. Exception e => e -> RIO env a
forall env e a. Exception e => e -> RIO env a
forall (m :: * -> *).
Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
throwM :: e -> RIO env a
$cthrowM :: forall env e a. Exception e => e -> RIO env a
$cp1MonadThrow :: forall env. Monad (RIO env)
MonadThrow)
instance Semigroup a => Semigroup (RIO env a) where
<> :: RIO env a -> RIO env a -> RIO env a
(<>) = (a -> a -> a) -> RIO env a -> RIO env a -> RIO env a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Semigroup a => a -> a -> a
(<>)
instance Monoid a => Monoid (RIO env a) where
mempty :: RIO env a
mempty = a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
forall a. Monoid a => a
mempty
mappend :: RIO env a -> RIO env a -> RIO env a
mappend = (a -> a -> a) -> RIO env a -> RIO env a -> RIO env a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Monoid a => a -> a -> a
mappend
runRIO :: MonadIO m => env -> RIO env a -> m a
runRIO :: env -> RIO env a -> m a
runRIO env
env (RIO (ReaderT env -> IO a
f)) = IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (env -> IO a
f env
env)
liftRIO :: (MonadIO m, MonadReader env m) => RIO env a -> m a
liftRIO :: RIO env a -> m a
liftRIO RIO env a
rio = do
env
env <- m env
forall r (m :: * -> *). MonadReader r m => m r
ask
env -> RIO env a -> m a
forall (m :: * -> *) env a. MonadIO m => env -> RIO env a -> m a
runRIO env
env RIO env a
rio
mapRIO :: (outer -> inner) -> RIO inner a -> RIO outer a
mapRIO :: (outer -> inner) -> RIO inner a -> RIO outer a
mapRIO outer -> inner
f RIO inner a
m = do
outer
outer <- RIO outer outer
forall r (m :: * -> *). MonadReader r m => m r
ask
inner -> RIO inner a -> RIO outer a
forall (m :: * -> *) env a. MonadIO m => env -> RIO env a -> m a
runRIO (outer -> inner
f outer
outer) RIO inner a
m
instance MonadUnliftIO (RIO env) where
withRunInIO :: ((forall a. RIO env a -> IO a) -> IO b) -> RIO env b
withRunInIO (forall a. RIO env a -> IO a) -> IO b
inner = ReaderT env IO b -> RIO env b
forall env a. ReaderT env IO a -> RIO env a
RIO (ReaderT env IO b -> RIO env b) -> ReaderT env IO b -> RIO env b
forall a b. (a -> b) -> a -> b
$ ((forall a. ReaderT env IO a -> IO a) -> IO b) -> ReaderT env IO b
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. ReaderT env IO a -> IO a) -> IO b)
-> ReaderT env IO b)
-> ((forall a. ReaderT env IO a -> IO a) -> IO b)
-> ReaderT env IO b
forall a b. (a -> b) -> a -> b
$ \forall a. ReaderT env IO a -> IO a
run -> (forall a. RIO env a -> IO a) -> IO b
inner (ReaderT env IO a -> IO a
forall a. ReaderT env IO a -> IO a
run (ReaderT env IO a -> IO a)
-> (RIO env a -> ReaderT env IO a) -> RIO env a -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RIO env a -> ReaderT env IO a
forall env a. RIO env a -> ReaderT env IO a
unRIO)
{-# INLINE withRunInIO #-}
instance PrimMonad (RIO env) where
type PrimState (RIO env) = PrimState IO
primitive :: (State# (PrimState (RIO env))
-> (# State# (PrimState (RIO env)), a #))
-> RIO env a
primitive = ReaderT env IO a -> RIO env a
forall env a. ReaderT env IO a -> RIO env a
RIO (ReaderT env IO a -> RIO env a)
-> ((State# RealWorld -> (# State# RealWorld, a #))
-> ReaderT env IO a)
-> (State# RealWorld -> (# State# RealWorld, a #))
-> RIO env a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (env -> IO a) -> ReaderT env IO a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((env -> IO a) -> ReaderT env IO a)
-> ((State# RealWorld -> (# State# RealWorld, a #)) -> env -> IO a)
-> (State# RealWorld -> (# State# RealWorld, a #))
-> ReaderT env IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> env -> IO a
forall a b. a -> b -> a
const (IO a -> env -> IO a)
-> ((State# RealWorld -> (# State# RealWorld, a #)) -> IO a)
-> (State# RealWorld -> (# State# RealWorld, a #))
-> env
-> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive
data SomeRef a
= SomeRef !(IO a) !(a -> IO ())
readSomeRef :: MonadIO m => SomeRef a -> m a
readSomeRef :: SomeRef a -> m a
readSomeRef (SomeRef IO a
x a -> IO ()
_) = IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO a
x
writeSomeRef :: MonadIO m => SomeRef a -> a -> m ()
writeSomeRef :: SomeRef a -> a -> m ()
writeSomeRef (SomeRef IO a
_ a -> IO ()
x) = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (a -> IO ()) -> a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> IO ()
x
modifySomeRef :: MonadIO m => SomeRef a -> (a -> a) -> m ()
modifySomeRef :: SomeRef a -> (a -> a) -> m ()
modifySomeRef (SomeRef IO a
read' a -> IO ()
write) a -> a
f =
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ (a -> a
f (a -> a) -> IO a -> IO a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO a
read') IO a -> (a -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> IO ()
write
ioRefToSomeRef :: IORef a -> SomeRef a
ioRefToSomeRef :: IORef a -> SomeRef a
ioRefToSomeRef IORef a
ref =
IO a -> (a -> IO ()) -> SomeRef a
forall a. IO a -> (a -> IO ()) -> SomeRef a
SomeRef (IORef a -> IO a
forall (m :: * -> *) a. MonadIO m => IORef a -> m a
readIORef IORef a
ref)
(\a
val -> IORef a -> (a -> a) -> IO ()
forall (m :: * -> *) a. MonadIO m => IORef a -> (a -> a) -> m ()
modifyIORef' IORef a
ref (\a
_ -> a
val))
uRefToSomeRef :: Unbox a => URef RealWorld a -> SomeRef a
uRefToSomeRef :: URef RealWorld a -> SomeRef a
uRefToSomeRef URef RealWorld a
ref =
IO a -> (a -> IO ()) -> SomeRef a
forall a. IO a -> (a -> IO ()) -> SomeRef a
SomeRef (URef (PrimState IO) a -> IO a
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
URef (PrimState m) a -> m a
readURef URef RealWorld a
URef (PrimState IO) a
ref) (URef (PrimState IO) a -> a -> IO ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
URef (PrimState m) a -> a -> m ()
writeURef URef RealWorld a
URef (PrimState IO) a
ref)
class HasStateRef s env | env -> s where
stateRefL :: Lens' env (SomeRef s)
instance HasStateRef a (SomeRef a) where
stateRefL :: (SomeRef a -> f (SomeRef a)) -> SomeRef a -> f (SomeRef a)
stateRefL = (SomeRef a -> SomeRef a)
-> (SomeRef a -> SomeRef a -> SomeRef a)
-> Lens' (SomeRef a) (SomeRef a)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens SomeRef a -> SomeRef a
forall a. a -> a
id (\SomeRef a
_ SomeRef a
x -> SomeRef a
x)
class HasWriteRef w env | env -> w where
writeRefL :: Lens' env (SomeRef w)
instance HasWriteRef a (SomeRef a) where
writeRefL :: (SomeRef a -> f (SomeRef a)) -> SomeRef a -> f (SomeRef a)
writeRefL = (SomeRef a -> SomeRef a)
-> (SomeRef a -> SomeRef a -> SomeRef a)
-> Lens' (SomeRef a) (SomeRef a)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens SomeRef a -> SomeRef a
forall a. a -> a
id (\SomeRef a
_ SomeRef a
x -> SomeRef a
x)
instance HasStateRef s env => MonadState s (RIO env) where
get :: RIO env s
get = do
SomeRef s
ref <- Getting (SomeRef s) env (SomeRef s) -> RIO env (SomeRef s)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (SomeRef s) env (SomeRef s)
forall s env. HasStateRef s env => Lens' env (SomeRef s)
stateRefL
IO s -> RIO env s
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO s -> RIO env s) -> IO s -> RIO env s
forall a b. (a -> b) -> a -> b
$ SomeRef s -> IO s
forall (m :: * -> *) a. MonadIO m => SomeRef a -> m a
readSomeRef SomeRef s
ref
put :: s -> RIO env ()
put s
st = do
SomeRef s
ref <- Getting (SomeRef s) env (SomeRef s) -> RIO env (SomeRef s)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (SomeRef s) env (SomeRef s)
forall s env. HasStateRef s env => Lens' env (SomeRef s)
stateRefL
IO () -> RIO env ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> RIO env ()) -> IO () -> RIO env ()
forall a b. (a -> b) -> a -> b
$ SomeRef s -> s -> IO ()
forall (m :: * -> *) a. MonadIO m => SomeRef a -> a -> m ()
writeSomeRef SomeRef s
ref s
st
instance (Monoid w, HasWriteRef w env) => MonadWriter w (RIO env) where
tell :: w -> RIO env ()
tell w
value = do
SomeRef w
ref <- Getting (SomeRef w) env (SomeRef w) -> RIO env (SomeRef w)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (SomeRef w) env (SomeRef w)
forall w env. HasWriteRef w env => Lens' env (SomeRef w)
writeRefL
IO () -> RIO env ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> RIO env ()) -> IO () -> RIO env ()
forall a b. (a -> b) -> a -> b
$ SomeRef w -> (w -> w) -> IO ()
forall (m :: * -> *) a. MonadIO m => SomeRef a -> (a -> a) -> m ()
modifySomeRef SomeRef w
ref (w -> w -> w
forall a. Monoid a => a -> a -> a
`mappend` w
value)
listen :: RIO env a -> RIO env (a, w)
listen RIO env a
action = do
w
w1 <- Getting (SomeRef w) env (SomeRef w) -> RIO env (SomeRef w)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (SomeRef w) env (SomeRef w)
forall w env. HasWriteRef w env => Lens' env (SomeRef w)
writeRefL RIO env (SomeRef w) -> (SomeRef w -> RIO env w) -> RIO env w
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO w -> RIO env w
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO w -> RIO env w)
-> (SomeRef w -> IO w) -> SomeRef w -> RIO env w
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeRef w -> IO w
forall (m :: * -> *) a. MonadIO m => SomeRef a -> m a
readSomeRef
a
a <- RIO env a
action
w
w2 <- do
SomeRef w
refEnv <- Getting (SomeRef w) env (SomeRef w) -> RIO env (SomeRef w)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (SomeRef w) env (SomeRef w)
forall w env. HasWriteRef w env => Lens' env (SomeRef w)
writeRefL
w
v <- IO w -> RIO env w
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO w -> RIO env w) -> IO w -> RIO env w
forall a b. (a -> b) -> a -> b
$ SomeRef w -> IO w
forall (m :: * -> *) a. MonadIO m => SomeRef a -> m a
readSomeRef SomeRef w
refEnv
()
_ <- IO () -> RIO env ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> RIO env ()) -> IO () -> RIO env ()
forall a b. (a -> b) -> a -> b
$ SomeRef w -> w -> IO ()
forall (m :: * -> *) a. MonadIO m => SomeRef a -> a -> m ()
writeSomeRef SomeRef w
refEnv w
w1
w -> RIO env w
forall (m :: * -> *) a. Monad m => a -> m a
return w
v
(a, w) -> RIO env (a, w)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, w
w2)
pass :: RIO env (a, w -> w) -> RIO env a
pass RIO env (a, w -> w)
action = do
(a
a, w -> w
transF) <- RIO env (a, w -> w)
action
SomeRef w
ref <- Getting (SomeRef w) env (SomeRef w) -> RIO env (SomeRef w)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (SomeRef w) env (SomeRef w)
forall w env. HasWriteRef w env => Lens' env (SomeRef w)
writeRefL
IO () -> RIO env ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> RIO env ()) -> IO () -> RIO env ()
forall a b. (a -> b) -> a -> b
$ SomeRef w -> (w -> w) -> IO ()
forall (m :: * -> *) a. MonadIO m => SomeRef a -> (a -> a) -> m ()
modifySomeRef SomeRef w
ref w -> w
transF
a -> RIO env a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
newSomeRef :: MonadIO m => a -> m (SomeRef a)
newSomeRef :: a -> m (SomeRef a)
newSomeRef a
a = do
IORef a -> SomeRef a
forall a. IORef a -> SomeRef a
ioRefToSomeRef (IORef a -> SomeRef a) -> m (IORef a) -> m (SomeRef a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> m (IORef a)
forall (m :: * -> *) a. MonadIO m => a -> m (IORef a)
newIORef a
a
newUnboxedSomeRef :: (MonadIO m, Unbox a) => a -> m (SomeRef a)
newUnboxedSomeRef :: a -> m (SomeRef a)
newUnboxedSomeRef a
a =
URef RealWorld a -> SomeRef a
forall a. Unbox a => URef RealWorld a -> SomeRef a
uRefToSomeRef (URef RealWorld a -> SomeRef a)
-> m (URef RealWorld a) -> m (SomeRef a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (IO (URef RealWorld a) -> m (URef RealWorld a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (URef RealWorld a) -> m (URef RealWorld a))
-> IO (URef RealWorld a) -> m (URef RealWorld a)
forall a b. (a -> b) -> a -> b
$ a -> IO (URef (PrimState IO) a)
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
a -> m (URef (PrimState m) a)
newURef a
a)