{-# 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 { forall env a. RIO env a -> ReaderT env IO a
unRIO :: ReaderT env IO a }
deriving (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
<$ :: forall a b. a -> RIO env b -> RIO env a
$c<$ :: forall env a b. a -> RIO env b -> RIO env a
fmap :: forall a b. (a -> b) -> RIO env a -> RIO env b
$cfmap :: forall env a b. (a -> b) -> RIO env a -> RIO env b
Functor,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
<* :: forall a b. RIO env a -> RIO env b -> RIO env a
$c<* :: forall env a b. RIO env a -> RIO env b -> RIO env a
*> :: forall a b. RIO env a -> RIO env b -> RIO env b
$c*> :: forall env a b. RIO env a -> RIO env b -> RIO env b
liftA2 :: forall a b c. (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
<*> :: forall a b. 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 :: forall a. a -> RIO env a
$cpure :: forall env a. a -> RIO env a
Applicative,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 :: forall a. a -> RIO env a
$creturn :: forall env a. a -> RIO env a
>> :: forall a b. RIO env a -> RIO env b -> RIO env b
$c>> :: forall env a b. RIO env a -> RIO env b -> RIO env b
>>= :: forall a 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
Monad,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 :: forall a. IO a -> RIO env a
$cliftIO :: forall env a. IO a -> RIO env a
MonadIO,MonadReader 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 :: forall e a. Exception e => e -> RIO env a
$cthrowM :: forall env e a. Exception e => e -> RIO env a
MonadThrow)
instance Semigroup a => Semigroup (RIO env a) where
<> :: 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 forall a. Semigroup a => a -> a -> a
(<>)
instance Monoid a => Monoid (RIO env a) where
mempty :: RIO env a
mempty = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty
mappend :: RIO env a -> RIO env a -> RIO env a
mappend = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Monoid a => a -> a -> a
mappend
runRIO :: MonadIO m => env -> RIO env a -> m a
runRIO :: forall (m :: * -> *) env a. MonadIO m => env -> RIO env a -> m a
runRIO env
env (RIO (ReaderT env -> IO a
f)) = 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 :: forall (m :: * -> *) env a.
(MonadIO m, MonadReader env m) =>
RIO env a -> m a
liftRIO RIO env a
rio = do
env
env <- forall r (m :: * -> *). MonadReader r m => m r
ask
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 :: forall outer inner a.
(outer -> inner) -> RIO inner a -> RIO outer a
mapRIO outer -> inner
f RIO inner a
m = do
outer
outer <- forall r (m :: * -> *). MonadReader r m => m r
ask
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 b. ((forall a. RIO env a -> IO a) -> IO b) -> RIO env b
withRunInIO (forall a. RIO env a -> IO a) -> IO b
inner = forall env a. ReaderT env IO a -> RIO env a
RIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO 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 (forall a. ReaderT env IO a -> IO a
run forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a.
(State# (PrimState (RIO env))
-> (# State# (PrimState (RIO env)), a #))
-> RIO env a
primitive = forall env a. ReaderT env IO a -> RIO env a
RIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall (m :: * -> *) a. MonadIO m => SomeRef a -> m a
readSomeRef (SomeRef IO a
x a -> IO ()
_) = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO a
x
writeSomeRef :: MonadIO m => SomeRef a -> a -> m ()
writeSomeRef :: forall (m :: * -> *) a. MonadIO m => SomeRef a -> a -> m ()
writeSomeRef (SomeRef IO a
_ a -> IO ()
x) = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> IO ()
x
modifySomeRef :: MonadIO m => SomeRef a -> (a -> a) -> m ()
modifySomeRef :: forall (m :: * -> *) a. MonadIO m => SomeRef a -> (a -> a) -> m ()
modifySomeRef (SomeRef IO a
read' a -> IO ()
write) a -> a
f =
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ (a -> a
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO a
read') forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> IO ()
write
ioRefToSomeRef :: IORef a -> SomeRef a
ioRefToSomeRef :: forall a. IORef a -> SomeRef a
ioRefToSomeRef IORef a
ref =
forall a. IO a -> (a -> IO ()) -> SomeRef a
SomeRef (forall (m :: * -> *) a. MonadIO m => IORef a -> m a
readIORef IORef a
ref)
(\a
val -> 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 :: forall a. Unbox a => URef RealWorld a -> SomeRef a
uRefToSomeRef URef RealWorld a
ref =
forall a. IO a -> (a -> IO ()) -> SomeRef a
SomeRef (forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
URef (PrimState m) a -> m a
readURef URef RealWorld a
ref) (forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
URef (PrimState m) a -> a -> m ()
writeURef URef RealWorld a
ref)
class HasStateRef s env | env -> s where
stateRefL :: Lens' env (SomeRef s)
instance HasStateRef a (SomeRef a) where
stateRefL :: Lens' (SomeRef a) (SomeRef a)
stateRefL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens 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 :: Lens' (SomeRef a) (SomeRef a)
writeRefL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens 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 <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall s env. HasStateRef s env => Lens' env (SomeRef s)
stateRefL
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => SomeRef a -> m a
readSomeRef SomeRef s
ref
put :: s -> RIO env ()
put s
st = do
SomeRef s
ref <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall s env. HasStateRef s env => Lens' env (SomeRef s)
stateRefL
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ 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 <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall w env. HasWriteRef w env => Lens' env (SomeRef w)
writeRefL
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => SomeRef a -> (a -> a) -> m ()
modifySomeRef SomeRef w
ref (forall a. Monoid a => a -> a -> a
`mappend` w
value)
listen :: forall a. RIO env a -> RIO env (a, w)
listen RIO env a
action = do
w
w1 <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall w env. HasWriteRef w env => Lens' env (SomeRef w)
writeRefL forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadIO m => SomeRef a -> m a
readSomeRef
a
a <- RIO env a
action
w
w2 <- do
SomeRef w
refEnv <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall w env. HasWriteRef w env => Lens' env (SomeRef w)
writeRefL
w
v <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => SomeRef a -> m a
readSomeRef SomeRef w
refEnv
()
_ <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => SomeRef a -> a -> m ()
writeSomeRef SomeRef w
refEnv w
w1
forall (m :: * -> *) a. Monad m => a -> m a
return w
v
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, w
w2)
pass :: forall a. 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 <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall w env. HasWriteRef w env => Lens' env (SomeRef w)
writeRefL
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => SomeRef a -> (a -> a) -> m ()
modifySomeRef SomeRef w
ref w -> w
transF
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
newSomeRef :: MonadIO m => a -> m (SomeRef a)
newSomeRef :: forall (m :: * -> *) a. MonadIO m => a -> m (SomeRef a)
newSomeRef a
a = do
forall a. IORef a -> SomeRef a
ioRefToSomeRef forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadIO m => a -> m (IORef a)
newIORef a
a
newUnboxedSomeRef :: (MonadIO m, Unbox a) => a -> m (SomeRef a)
newUnboxedSomeRef :: forall (m :: * -> *) a. (MonadIO m, Unbox a) => a -> m (SomeRef a)
newUnboxedSomeRef a
a =
forall a. Unbox a => URef RealWorld a -> SomeRef a
uRefToSomeRef forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
a -> m (URef (PrimState m) a)
newURef a
a)