{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE UndecidableInstances #-}
module RIO.Prelude.RIO
  ( RIO (..)
  , runRIO
  , liftRIO
  , mapRIO
  -- SomeRef for Writer/State interfaces
  , 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(..))

-- | The Reader+IO monad. This is different from a 'ReaderT' because:
--
-- * It's not a transformer, it hardcodes IO for simpler usage and
-- error messages.
--
-- * Instances of typeclasses like 'MonadLogger' are implemented using
-- classes defined on the environment, instead of using an
-- underlying monad.
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

-- | Using the environment run in IO the action that requires that environment.
--
-- @since 0.0.1.0
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)

-- | Abstract `RIO` to an arbitrary `MonadReader` instance, which can handle IO.
--
-- @since 0.0.1.0
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

-- | Lift one RIO env to another.
--
-- @since 0.1.13.0
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

-- | Abstraction over how to read from and write to a mutable reference
--
-- @since 0.1.4.0
data SomeRef a
  = SomeRef !(IO a) !(a -> IO ())

-- | Read from a SomeRef
--
-- @since 0.1.4.0
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

-- | Write to a SomeRef
--
-- @since 0.1.4.0
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

-- | Modify a SomeRef
-- This function is subject to change due to the lack of atomic operations
--
-- @since 0.1.4.0
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)

-- | Environment values with stateful capabilities to SomeRef
--
-- @since 0.1.4.0
class HasStateRef s env | env -> s where
  stateRefL :: Lens' env (SomeRef s)

-- | Identity state reference where the SomeRef is the env
--
-- @since 0.1.4.0
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)

-- | Environment values with writing capabilities to SomeRef
--
-- @since 0.1.4.0
class HasWriteRef w env | env -> w where
  writeRefL :: Lens' env (SomeRef w)

-- | Identity write reference where the SomeRef is the env
--
-- @since 0.1.4.0
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

-- | create a new boxed SomeRef
--
-- @since 0.1.4.0
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

-- | create a new unboxed SomeRef
--
-- @since 0.1.4.0
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)