{-# LANGUAGE UndecidableInstances #-}

-- |
-- Most definitions follow the RIO lib: https://hackage.haskell.org/package/rio-0.1.22.0/docs/RIO.html
-- The rest follow from orphans: https://hackage.haskell.org/package/rio-orphans-0.1.2.0/docs/RIO-Orphans.html
-- See LICENSE info in the README.
module LittleRIO
  ( RIO (..)
  , mapRIO
  , liftRIO
  , unliftRIO
  , runRIO
  , SomeRef (..)
  , readSomeRef
  , writeSomeRef
  , modifySomeRef
  , newSomeRef
  , HasStateRef (..)
  , HasWriteRef (..)
  , ResourceMap
  , HasResourceMap (..)
  , withResourceMap
  )
where

import Control.Monad.Catch (MonadCatch, MonadMask, MonadThrow)
import Control.Monad.IO.Class (MonadIO (..))
import Control.Monad.IO.Unlift (MonadUnliftIO (..), UnliftIO, askUnliftIO)
import Control.Monad.Primitive (PrimMonad (..))
import Control.Monad.Reader (MonadReader (..), ReaderT (..), asks)
import Control.Monad.State (MonadState (..))
import Control.Monad.Trans.Resource (InternalState, MonadResource (..), ResourceT, runResourceT, withInternalState)
import Control.Monad.Trans.Resource.Internal (unResourceT)
import Control.Monad.Writer (MonadWriter (..))
import Data.IORef (IORef, newIORef, readIORef, writeIORef)
import LittleLogger (LogActionWrapperM (..), MonadLogger)
import Optics (Lens', equality', view)

newtype RIO env a = RIO {forall env a. RIO env a -> ReaderT env IO a
unRIO :: ReaderT env IO a}
  deriving newtype
    ( (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
$cfmap :: forall env a b. (a -> b) -> RIO env a -> RIO env b
fmap :: forall a b. (a -> b) -> RIO env a -> RIO env b
$c<$ :: forall env a b. a -> RIO env b -> RIO env a
<$ :: forall a b. a -> RIO env b -> RIO env a
Functor
    , Functor (RIO env)
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)
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
$cpure :: forall env a. a -> RIO env a
pure :: forall a. a -> RIO env a
$c<*> :: forall env a b. RIO env (a -> b) -> RIO env a -> RIO env b
<*> :: forall a b. RIO env (a -> b) -> RIO env a -> RIO env b
$cliftA2 :: forall env a b c.
(a -> b -> c) -> RIO env a -> RIO env b -> RIO env c
liftA2 :: forall a b c. (a -> b -> c) -> RIO env a -> RIO env b -> RIO env c
$c*> :: forall env a b. RIO env a -> RIO env b -> RIO env b
*> :: 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 a
<* :: forall a b. RIO env a -> RIO env b -> RIO env a
Applicative
    , Applicative (RIO env)
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)
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
$c>>= :: forall env a b. RIO env a -> (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 -> RIO env b -> RIO env b
>> :: forall a b. RIO env a -> RIO env b -> RIO env b
$creturn :: forall env a. a -> RIO env a
return :: forall a. a -> RIO env a
Monad
    , MonadReader env
    , Monad (RIO env)
Monad (RIO env) =>
(forall a. IO a -> RIO env a) -> MonadIO (RIO env)
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
$cliftIO :: forall env a. IO a -> RIO env a
liftIO :: forall a. IO a -> RIO env a
MonadIO
    , Monad (RIO env)
Monad (RIO env) =>
(forall e a. (HasCallStack, Exception e) => e -> RIO env a)
-> MonadThrow (RIO env)
forall env. Monad (RIO env)
forall e a. (HasCallStack, Exception e) => e -> RIO env a
forall env e a. (HasCallStack, Exception e) => e -> RIO env a
forall (m :: * -> *).
Monad m =>
(forall e a. (HasCallStack, Exception e) => e -> m a)
-> MonadThrow m
$cthrowM :: forall env e a. (HasCallStack, Exception e) => e -> RIO env a
throwM :: forall e a. (HasCallStack, Exception e) => e -> RIO env a
MonadThrow
    , Monad (RIO env)
Monad (RIO env) =>
(forall a. String -> RIO env a) -> MonadFail (RIO env)
forall env. Monad (RIO env)
forall a. String -> RIO env a
forall env a. String -> RIO env a
forall (m :: * -> *).
Monad m =>
(forall a. String -> m a) -> MonadFail m
$cfail :: forall env a. String -> RIO env a
fail :: forall a. String -> RIO env a
MonadFail
    , MonadThrow (RIO env)
MonadThrow (RIO env) =>
(forall e a.
 (HasCallStack, Exception e) =>
 RIO env a -> (e -> RIO env a) -> RIO env a)
-> MonadCatch (RIO env)
forall env. MonadThrow (RIO env)
forall e a.
(HasCallStack, Exception e) =>
RIO env a -> (e -> RIO env a) -> RIO env a
forall env e a.
(HasCallStack, Exception e) =>
RIO env a -> (e -> RIO env a) -> RIO env a
forall (m :: * -> *).
MonadThrow m =>
(forall e a.
 (HasCallStack, Exception e) =>
 m a -> (e -> m a) -> m a)
-> MonadCatch m
$ccatch :: forall env e a.
(HasCallStack, Exception e) =>
RIO env a -> (e -> RIO env a) -> RIO env a
catch :: forall e a.
(HasCallStack, Exception e) =>
RIO env a -> (e -> RIO env a) -> RIO env a
MonadCatch
    , MonadCatch (RIO env)
MonadCatch (RIO env) =>
(forall b.
 HasCallStack =>
 ((forall a. RIO env a -> RIO env a) -> RIO env b) -> RIO env b)
-> (forall b.
    HasCallStack =>
    ((forall a. RIO env a -> RIO env a) -> RIO env b) -> RIO env b)
-> (forall a b c.
    HasCallStack =>
    RIO env a
    -> (a -> ExitCase b -> RIO env c)
    -> (a -> RIO env b)
    -> RIO env (b, c))
-> MonadMask (RIO env)
forall env. MonadCatch (RIO env)
forall b.
HasCallStack =>
((forall a. RIO env a -> RIO env a) -> RIO env b) -> RIO env b
forall env b.
HasCallStack =>
((forall a. RIO env a -> RIO env a) -> RIO env b) -> RIO env b
forall a b c.
HasCallStack =>
RIO env a
-> (a -> ExitCase b -> RIO env c)
-> (a -> RIO env b)
-> RIO env (b, c)
forall env a b c.
HasCallStack =>
RIO env a
-> (a -> ExitCase b -> RIO env c)
-> (a -> RIO env b)
-> RIO env (b, c)
forall (m :: * -> *).
MonadCatch m =>
(forall b. HasCallStack => ((forall a. m a -> m a) -> m b) -> m b)
-> (forall b.
    HasCallStack =>
    ((forall a. m a -> m a) -> m b) -> m b)
-> (forall a b c.
    HasCallStack =>
    m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c))
-> MonadMask m
$cmask :: forall env b.
HasCallStack =>
((forall a. RIO env a -> RIO env a) -> RIO env b) -> RIO env b
mask :: forall b.
HasCallStack =>
((forall a. RIO env a -> RIO env a) -> RIO env b) -> RIO env b
$cuninterruptibleMask :: forall env b.
HasCallStack =>
((forall a. RIO env a -> RIO env a) -> RIO env b) -> RIO env b
uninterruptibleMask :: forall b.
HasCallStack =>
((forall a. RIO env a -> RIO env a) -> RIO env b) -> RIO env b
$cgeneralBracket :: forall env a b c.
HasCallStack =>
RIO env a
-> (a -> ExitCase b -> RIO env c)
-> (a -> RIO env b)
-> RIO env (b, c)
generalBracket :: forall a b c.
HasCallStack =>
RIO env a
-> (a -> ExitCase b -> RIO env c)
-> (a -> RIO env b)
-> RIO env (b, c)
MonadMask
    , MonadIO (RIO env)
MonadIO (RIO env) =>
(forall b. ((forall a. RIO env a -> IO a) -> IO b) -> RIO env b)
-> MonadUnliftIO (RIO env)
forall env. MonadIO (RIO env)
forall b. ((forall a. RIO env a -> IO a) -> IO b) -> RIO env b
forall env b. ((forall a. RIO env a -> IO a) -> IO b) -> RIO env b
forall (m :: * -> *).
MonadIO m =>
(forall b. ((forall a. m a -> IO a) -> IO b) -> m b)
-> MonadUnliftIO m
$cwithRunInIO :: forall env b. ((forall a. RIO env a -> IO a) -> IO b) -> RIO env b
withRunInIO :: forall b. ((forall a. RIO env a -> IO a) -> IO b) -> RIO env b
MonadUnliftIO
    )
  deriving (Monad (RIO env)
Monad (RIO env) =>
(forall msg.
 ToLogStr msg =>
 Loc -> LogSource -> LogLevel -> msg -> RIO env ())
-> MonadLogger (RIO env)
forall msg.
ToLogStr msg =>
Loc -> LogSource -> LogLevel -> msg -> RIO env ()
forall env. HasLogAction env => Monad (RIO env)
forall env msg.
(HasLogAction env, ToLogStr msg) =>
Loc -> LogSource -> LogLevel -> msg -> RIO env ()
forall (m :: * -> *).
Monad m =>
(forall msg.
 ToLogStr msg =>
 Loc -> LogSource -> LogLevel -> msg -> m ())
-> MonadLogger m
$cmonadLoggerLog :: forall env msg.
(HasLogAction env, ToLogStr msg) =>
Loc -> LogSource -> LogLevel -> msg -> RIO env ()
monadLoggerLog :: forall msg.
ToLogStr msg =>
Loc -> LogSource -> LogLevel -> msg -> RIO env ()
MonadLogger) via LogActionWrapperM env (RIO env)

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 a b c. (a -> b -> c) -> RIO env a -> RIO env b -> RIO env c
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 a. 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 = RIO env a -> RIO env a -> RIO env a
forall a. Semigroup a => a -> a -> a
(<>)

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 = 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
(State# (PrimState IO) -> (# State# (PrimState IO), a #)) -> IO a
forall a.
(State# (PrimState IO) -> (# State# (PrimState IO), a #)) -> IO a
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive

mapRIO :: (env -> env') -> RIO env' a -> RIO env a
mapRIO :: forall env env' a. (env -> env') -> RIO env' a -> RIO env a
mapRIO env -> env'
f RIO env' a
m = do
  env
env <- RIO env env
forall r (m :: * -> *). MonadReader r m => m r
ask
  let env' :: env'
env' = env -> env'
f env
env
  env' -> RIO env' a -> RIO env a
forall (m :: * -> *) env a. MonadIO m => env -> RIO env a -> m a
runRIO env'
env' RIO env' a
m

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
m = 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
m

unliftRIO :: (MonadIO m) => env -> m (UnliftIO (RIO env))
unliftRIO :: forall (m :: * -> *) env.
MonadIO m =>
env -> m (UnliftIO (RIO env))
unliftRIO env
env = IO (UnliftIO (RIO env)) -> m (UnliftIO (RIO env))
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (env -> RIO env (UnliftIO (RIO env)) -> IO (UnliftIO (RIO env))
forall (m :: * -> *) env a. MonadIO m => env -> RIO env a -> m a
runRIO env
env RIO env (UnliftIO (RIO env))
forall (m :: * -> *). MonadUnliftIO m => m (UnliftIO m)
askUnliftIO)

runRIO :: (MonadIO m) => env -> RIO env a -> m a
runRIO :: forall (m :: * -> *) env a. MonadIO m => env -> RIO env a -> m a
runRIO env
r RIO env a
m = IO a -> m a
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ReaderT env IO a -> env -> IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (RIO env a -> ReaderT env IO a
forall env a. RIO env a -> ReaderT env IO a
unRIO RIO env a
m) env
r)

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 ()
_) = IO a -> m a
forall a. 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 :: forall (m :: * -> *) a. MonadIO m => SomeRef a -> a -> m ()
writeSomeRef (SomeRef IO a
_ a -> IO ()
x) = IO () -> m ()
forall a. IO a -> m a
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 :: forall (m :: * -> *) a. MonadIO m => SomeRef a -> (a -> a) -> m ()
modifySomeRef (SomeRef IO a
read' a -> IO ()
write) a -> a
f = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a
read' IO a -> (a -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> IO ()
write (a -> IO ()) -> (a -> a) -> a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
f)

ioRefToSomeRef :: IORef a -> SomeRef a
ioRefToSomeRef :: forall a. 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 a. IORef a -> IO a
readIORef IORef a
ref) (IORef a -> a -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef a
ref)

newSomeRef :: (MonadIO m) => a -> m (SomeRef a)
newSomeRef :: forall (m :: * -> *) a. MonadIO m => a -> m (SomeRef a)
newSomeRef = IO (SomeRef a) -> m (SomeRef a)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (SomeRef a) -> m (SomeRef a))
-> (a -> IO (SomeRef a)) -> a -> m (SomeRef a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IORef a -> SomeRef a) -> IO (IORef a) -> IO (SomeRef a)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap IORef a -> SomeRef a
forall a. IORef a -> SomeRef a
ioRefToSomeRef (IO (IORef a) -> IO (SomeRef a))
-> (a -> IO (IORef a)) -> a -> IO (SomeRef a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> IO (IORef a)
forall a. a -> IO (IORef a)
newIORef

class HasStateRef st env | env -> st where
  stateRefL :: Lens' env (SomeRef st)

instance HasStateRef a (SomeRef a) where
  stateRefL :: Lens' (SomeRef a) (SomeRef a)
stateRefL = Lens' (SomeRef a) (SomeRef a)
forall a b. Lens a b a b
equality'

getStateRef :: (HasStateRef st env, MonadReader env m, MonadIO m) => m st
getStateRef :: forall st env (m :: * -> *).
(HasStateRef st env, MonadReader env m, MonadIO m) =>
m st
getStateRef = do
  SomeRef st
ref <- (env -> SomeRef st) -> m (SomeRef st)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Optic' A_Lens NoIx env (SomeRef st) -> env -> SomeRef st
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx env (SomeRef st)
forall st env. HasStateRef st env => Lens' env (SomeRef st)
stateRefL)
  IO st -> m st
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (SomeRef st -> IO st
forall (m :: * -> *) a. MonadIO m => SomeRef a -> m a
readSomeRef SomeRef st
ref)

putStateRef :: (HasStateRef st env, MonadReader env m, MonadIO m) => st -> m ()
putStateRef :: forall st env (m :: * -> *).
(HasStateRef st env, MonadReader env m, MonadIO m) =>
st -> m ()
putStateRef st
st = do
  SomeRef st
ref <- (env -> SomeRef st) -> m (SomeRef st)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Optic' A_Lens NoIx env (SomeRef st) -> env -> SomeRef st
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx env (SomeRef st)
forall st env. HasStateRef st env => Lens' env (SomeRef st)
stateRefL)
  IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (SomeRef st -> st -> IO ()
forall (m :: * -> *) a. MonadIO m => SomeRef a -> a -> m ()
writeSomeRef SomeRef st
ref st
st)

modifyStateRef :: (HasStateRef st env, MonadReader env m, MonadIO m) => (st -> st) -> m ()
modifyStateRef :: forall st env (m :: * -> *).
(HasStateRef st env, MonadReader env m, MonadIO m) =>
(st -> st) -> m ()
modifyStateRef st -> st
f = do
  SomeRef st
ref <- (env -> SomeRef st) -> m (SomeRef st)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Optic' A_Lens NoIx env (SomeRef st) -> env -> SomeRef st
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx env (SomeRef st)
forall st env. HasStateRef st env => Lens' env (SomeRef st)
stateRefL)
  IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (SomeRef st -> (st -> st) -> IO ()
forall (m :: * -> *) a. MonadIO m => SomeRef a -> (a -> a) -> m ()
modifySomeRef SomeRef st
ref st -> st
f)

instance (HasStateRef st env) => MonadState st (RIO env) where
  get :: RIO env st
get = RIO env st
forall st env (m :: * -> *).
(HasStateRef st env, MonadReader env m, MonadIO m) =>
m st
getStateRef
  put :: st -> RIO env ()
put = st -> RIO env ()
forall st env (m :: * -> *).
(HasStateRef st env, MonadReader env m, MonadIO m) =>
st -> m ()
putStateRef

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 = Lens' (SomeRef a) (SomeRef a)
forall a b. Lens a b a b
equality'

tellWriteRef :: (HasWriteRef w env, MonadReader env m, MonadIO m, Semigroup w) => w -> m ()
tellWriteRef :: forall w env (m :: * -> *).
(HasWriteRef w env, MonadReader env m, MonadIO m, Semigroup w) =>
w -> m ()
tellWriteRef w
value = do
  SomeRef w
ref <- (env -> SomeRef w) -> m (SomeRef w)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Optic' A_Lens NoIx env (SomeRef w) -> env -> SomeRef w
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx env (SomeRef w)
forall w env. HasWriteRef w env => Lens' env (SomeRef w)
writeRefL)
  IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (SomeRef w -> (w -> w) -> IO ()
forall (m :: * -> *) a. MonadIO m => SomeRef a -> (a -> a) -> m ()
modifySomeRef SomeRef w
ref (w -> w -> w
forall a. Semigroup a => a -> a -> a
<> w
value))

listenWriteRef :: (HasWriteRef w env, MonadReader env m, MonadIO m) => m a -> m (a, w)
listenWriteRef :: forall w env (m :: * -> *) a.
(HasWriteRef w env, MonadReader env m, MonadIO m) =>
m a -> m (a, w)
listenWriteRef m a
action = do
  w
w1 <- (env -> SomeRef w) -> m (SomeRef w)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Optic' A_Lens NoIx env (SomeRef w) -> env -> SomeRef w
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx env (SomeRef w)
forall w env. HasWriteRef w env => Lens' env (SomeRef w)
writeRefL) m (SomeRef w) -> (SomeRef w -> m w) -> m w
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO w -> m w
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO w -> m w) -> (SomeRef w -> IO w) -> SomeRef w -> m 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 <- m a
action
  w
w2 <- do
    SomeRef w
refEnv <- (env -> SomeRef w) -> m (SomeRef w)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Optic' A_Lens NoIx env (SomeRef w) -> env -> SomeRef w
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx env (SomeRef w)
forall w env. HasWriteRef w env => Lens' env (SomeRef w)
writeRefL)
    w
v <- IO w -> m w
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (SomeRef w -> IO w
forall (m :: * -> *) a. MonadIO m => SomeRef a -> m a
readSomeRef SomeRef w
refEnv)
    ()
_ <- IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (SomeRef w -> w -> IO ()
forall (m :: * -> *) a. MonadIO m => SomeRef a -> a -> m ()
writeSomeRef SomeRef w
refEnv w
w1)
    w -> m w
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return w
v
  (a, w) -> m (a, w)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, w
w2)

passWriteRef :: (HasWriteRef w env, MonadReader env m, MonadIO m) => m (a, w -> w) -> m a
passWriteRef :: forall w env (m :: * -> *) a.
(HasWriteRef w env, MonadReader env m, MonadIO m) =>
m (a, w -> w) -> m a
passWriteRef m (a, w -> w)
action = do
  (a
a, w -> w
transF) <- m (a, w -> w)
action
  SomeRef w
ref <- (env -> SomeRef w) -> m (SomeRef w)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Optic' A_Lens NoIx env (SomeRef w) -> env -> SomeRef w
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx env (SomeRef w)
forall w env. HasWriteRef w env => Lens' env (SomeRef w)
writeRefL)
  IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (SomeRef w -> (w -> w) -> IO ()
forall (m :: * -> *) a. MonadIO m => SomeRef a -> (a -> a) -> m ()
modifySomeRef SomeRef w
ref w -> w
transF)
  a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a

instance (Monoid w, HasWriteRef w env) => MonadWriter w (RIO env) where
  tell :: w -> RIO env ()
tell = w -> RIO env ()
forall w env (m :: * -> *).
(HasWriteRef w env, MonadReader env m, MonadIO m, Semigroup w) =>
w -> m ()
tellWriteRef
  listen :: forall a. RIO env a -> RIO env (a, w)
listen = RIO env a -> RIO env (a, w)
forall w env (m :: * -> *) a.
(HasWriteRef w env, MonadReader env m, MonadIO m) =>
m a -> m (a, w)
listenWriteRef
  pass :: forall a. RIO env (a, w -> w) -> RIO env a
pass = RIO env (a, w -> w) -> RIO env a
forall w env (m :: * -> *) a.
(HasWriteRef w env, MonadReader env m, MonadIO m) =>
m (a, w -> w) -> m a
passWriteRef

type ResourceMap = InternalState

withResourceMap :: (MonadUnliftIO m) => (ResourceMap -> m a) -> m a
withResourceMap :: forall (m :: * -> *) a.
MonadUnliftIO m =>
(ResourceMap -> m a) -> m a
withResourceMap ResourceMap -> m a
inner = ResourceT m a -> m a
forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT ((ResourceMap -> m a) -> ResourceT m a
forall (m :: * -> *) a. (ResourceMap -> m a) -> ResourceT m a
withInternalState ResourceMap -> m a
inner)

class HasResourceMap env where
  resourceMapL :: Lens' env ResourceMap

instance HasResourceMap ResourceMap where
  resourceMapL :: Lens' ResourceMap ResourceMap
resourceMapL = Lens' ResourceMap ResourceMap
forall a b. Lens a b a b
equality'

resourceRIO :: (HasResourceMap env) => ResourceT IO a -> RIO env a
resourceRIO :: forall env a. HasResourceMap env => ResourceT IO a -> RIO env a
resourceRIO ResourceT IO a
m = (env -> ResourceMap) -> RIO env ResourceMap
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Optic' A_Lens NoIx env ResourceMap -> env -> ResourceMap
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx env ResourceMap
forall env. HasResourceMap env => Lens' env ResourceMap
resourceMapL) RIO env ResourceMap -> (ResourceMap -> RIO env a) -> RIO env a
forall a b. RIO env a -> (a -> RIO env b) -> RIO env b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO a -> RIO env a
forall a. IO a -> RIO env a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> RIO env a)
-> (ResourceMap -> IO a) -> ResourceMap -> RIO env a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResourceT IO a -> ResourceMap -> IO a
forall (m :: * -> *) a. ResourceT m a -> ResourceMap -> m a
unResourceT ResourceT IO a
m

instance (HasResourceMap env) => MonadResource (RIO env) where
  liftResourceT :: forall a. ResourceT IO a -> RIO env a
liftResourceT = ResourceT IO a -> RIO env a
forall env a. HasResourceMap env => ResourceT IO a -> RIO env a
resourceRIO