{-# LANGUAGE DataKinds            #-}
{-# LANGUAGE DeriveFunctor        #-}
{-# LANGUAGE IncoherentInstances  #-}
{-# LANGUAGE MonoLocalBinds       #-}
{-# LANGUAGE UndecidableInstances #-}
{- |

  RIO is equivalent to @ResourceT (WriterT Warmup IO)@
  It can be used to instantiate "components as records of functions"
  where each component can allocate resources and have a "warmup phase"
  to preload data or assess if it is working properly.

-}
module Data.Registry.RIO where

import           Control.Monad.Base
import           Control.Monad.Catch
import           Control.Monad.Trans
import           Control.Monad.Trans.Resource
import qualified Control.Monad.Trans.Resource as Resource (allocate)

import           Control.Applicative
import           Data.Functor.Alt
import           Data.Registry.Make
import           Data.Registry.Registry
import           Data.Registry.Solver
import           Data.Registry.Warmup
import           Protolude                    hiding (Alt, try)

-- | Data type encapsulating resource finalizers
newtype Stop = Stop InternalState

-- | Run all finalizers
runStop :: Stop -> IO ()
runStop :: Stop -> IO ()
runStop (Stop InternalState
is) = ResourceT IO () -> IO ()
forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT (ResourceT IO () -> IO ()) -> ResourceT IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ InternalState -> ResourceT IO ()
forall (m :: * -> *). MonadIO m => InternalState -> m ()
closeInternalState InternalState
is

-- | This newtype creates a monad to sequence
--   component creation actions, cumulating start/stop tasks
--   found along the way

newtype RIO a = RIO { RIO a -> Stop -> IO (a, Warmup)
runRIO :: Stop -> IO (a, Warmup) } deriving (a -> RIO b -> RIO a
(a -> b) -> RIO a -> RIO b
(forall a b. (a -> b) -> RIO a -> RIO b)
-> (forall a b. a -> RIO b -> RIO a) -> Functor RIO
forall a b. a -> RIO b -> RIO a
forall a b. (a -> b) -> RIO a -> RIO b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> RIO b -> RIO a
$c<$ :: forall a b. a -> RIO b -> RIO a
fmap :: (a -> b) -> RIO a -> RIO b
$cfmap :: forall a b. (a -> b) -> RIO a -> RIO b
Functor)

instance Applicative RIO where
  pure :: a -> RIO a
pure a
a =
    (Stop -> IO (a, Warmup)) -> RIO a
forall a. (Stop -> IO (a, Warmup)) -> RIO a
RIO (IO (a, Warmup) -> Stop -> IO (a, Warmup)
forall a b. a -> b -> a
const ((a, Warmup) -> IO (a, Warmup)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
a, Warmup
forall a. Monoid a => a
mempty)))

  RIO Stop -> IO (a -> b, Warmup)
fab <*> :: RIO (a -> b) -> RIO a -> RIO b
<*> RIO Stop -> IO (a, Warmup)
fa =
    (Stop -> IO (b, Warmup)) -> RIO b
forall a. (Stop -> IO (a, Warmup)) -> RIO a
RIO ((Stop -> IO (b, Warmup)) -> RIO b)
-> (Stop -> IO (b, Warmup)) -> RIO b
forall a b. (a -> b) -> a -> b
$ \Stop
s ->
      do (a -> b
f, Warmup
sf) <- Stop -> IO (a -> b, Warmup)
fab Stop
s
         (a
a, Warmup
sa) <- Stop -> IO (a, Warmup)
fa Stop
s
         (b, Warmup) -> IO (b, Warmup)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> b
f a
a, Warmup
sf Warmup -> Warmup -> Warmup
forall a. Monoid a => a -> a -> a
`mappend` Warmup
sa)

instance Monad RIO where
  return :: a -> RIO a
return = a -> RIO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

  RIO Stop -> IO (a, Warmup)
ma >>= :: RIO a -> (a -> RIO b) -> RIO b
>>= a -> RIO b
f =
    (Stop -> IO (b, Warmup)) -> RIO b
forall a. (Stop -> IO (a, Warmup)) -> RIO a
RIO ((Stop -> IO (b, Warmup)) -> RIO b)
-> (Stop -> IO (b, Warmup)) -> RIO b
forall a b. (a -> b) -> a -> b
$ \Stop
s ->
      do (a
a, Warmup
sa) <- Stop -> IO (a, Warmup)
ma Stop
s
         (b
b, Warmup
sb) <- RIO b -> Stop -> IO (b, Warmup)
forall a. RIO a -> Stop -> IO (a, Warmup)
runRIO  (a -> RIO b
f a
a) Stop
s
         (b, Warmup) -> IO (b, Warmup)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (b
b, Warmup
sa Warmup -> Warmup -> Warmup
forall a. Monoid a => a -> a -> a
`mappend` Warmup
sb)

instance MonadIO RIO where
  liftIO :: IO a -> RIO a
liftIO IO a
io = (Stop -> IO (a, Warmup)) -> RIO a
forall a. (Stop -> IO (a, Warmup)) -> RIO a
RIO (IO (a, Warmup) -> Stop -> IO (a, Warmup)
forall a b. a -> b -> a
const (IO (a, Warmup) -> Stop -> IO (a, Warmup))
-> IO (a, Warmup) -> Stop -> IO (a, Warmup)
forall a b. (a -> b) -> a -> b
$ (, Warmup
forall a. Monoid a => a
mempty) (a -> (a, Warmup)) -> IO a -> IO (a, Warmup)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO a
io)

instance MonadThrow RIO where
  throwM :: e -> RIO a
throwM e
e = (Stop -> IO (a, Warmup)) -> RIO a
forall a. (Stop -> IO (a, Warmup)) -> RIO a
RIO (IO (a, Warmup) -> Stop -> IO (a, Warmup)
forall a b. a -> b -> a
const (IO (a, Warmup) -> Stop -> IO (a, Warmup))
-> IO (a, Warmup) -> Stop -> IO (a, Warmup)
forall a b. (a -> b) -> a -> b
$ e -> IO (a, Warmup)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM e
e)

instance MonadBase IO RIO where
  liftBase :: IO α -> RIO α
liftBase = IO α -> RIO α
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO

instance MonadResource RIO where
  liftResourceT :: ResourceT IO a -> RIO a
liftResourceT ResourceT IO a
action = (Stop -> IO (a, Warmup)) -> RIO a
forall a. (Stop -> IO (a, Warmup)) -> RIO a
RIO ((Stop -> IO (a, Warmup)) -> RIO a)
-> (Stop -> IO (a, Warmup)) -> RIO a
forall a b. (a -> b) -> a -> b
$ \(Stop InternalState
s) -> IO (a, Warmup) -> IO (a, Warmup)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO ((, Warmup
forall a. Monoid a => a
mempty) (a -> (a, Warmup)) -> IO a -> IO (a, Warmup)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ResourceT IO a -> InternalState -> IO a
forall (m :: * -> *) a. ResourceT m a -> InternalState -> m a
runInternalState ResourceT IO a
action InternalState
s)

-- We cannot piggy-back on the IO Alternative instance
-- because it only catches IOErrors
instance Alternative RIO where
  empty :: RIO a
empty = (Stop -> IO (a, Warmup)) -> RIO a
forall a. (Stop -> IO (a, Warmup)) -> RIO a
RIO (IO (a, Warmup) -> Stop -> IO (a, Warmup)
forall a b. a -> b -> a
const IO (a, Warmup)
forall (f :: * -> *) a. Alternative f => f a
empty)
  (RIO Stop -> IO (a, Warmup)
runA) <|> :: RIO a -> RIO a -> RIO a
<|> (RIO Stop -> IO (a, Warmup)
runB) = (Stop -> IO (a, Warmup)) -> RIO a
forall a. (Stop -> IO (a, Warmup)) -> RIO a
RIO ((Stop -> IO (a, Warmup)) -> RIO a)
-> (Stop -> IO (a, Warmup)) -> RIO a
forall a b. (a -> b) -> a -> b
$ \Stop
s -> do
    Either SomeException (a, Warmup)
res <- IO (a, Warmup) -> IO (Either SomeException (a, Warmup))
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
try (Stop -> IO (a, Warmup)
runA Stop
s)
    case Either SomeException (a, Warmup)
res of
      Left (SomeException
_::SomeException) -> Stop -> IO (a, Warmup)
runB Stop
s
      Right (a, Warmup)
r                 -> (a, Warmup) -> IO (a, Warmup)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a, Warmup)
r

instance Alt RIO where
  <!> :: RIO a -> RIO a -> RIO a
(<!>) = RIO a -> RIO a -> RIO a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)

-- * For production

-- | Use a RIO value and make sure that resources are closed
--   Only run the action if the warmup is successful
withRIO :: (MonadIO m) => RIO a -> (a -> IO ()) -> m Result
withRIO :: RIO a -> (a -> IO ()) -> m Result
withRIO RIO a
rio a -> IO ()
f = IO Result -> m Result
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Result -> m Result) -> IO Result -> m Result
forall a b. (a -> b) -> a -> b
$ ResourceT IO Result -> IO Result
forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT (ResourceT IO Result -> IO Result)
-> ResourceT IO Result -> IO Result
forall a b. (a -> b) -> a -> b
$ (InternalState -> IO Result) -> ResourceT IO Result
forall (m :: * -> *) a. (InternalState -> m a) -> ResourceT m a
withInternalState ((InternalState -> IO Result) -> ResourceT IO Result)
-> (InternalState -> IO Result) -> ResourceT IO Result
forall a b. (a -> b) -> a -> b
$ \InternalState
is ->
  do  (a
a, Warmup
warmup) <- RIO a -> Stop -> IO (a, Warmup)
forall a. RIO a -> Stop -> IO (a, Warmup)
runRIO RIO a
rio (InternalState -> Stop
Stop InternalState
is)
      Result
result      <- IO Result -> IO Result
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Result -> IO Result) -> IO Result -> IO Result
forall a b. (a -> b) -> a -> b
$ Warmup -> IO Result
runWarmup Warmup
warmup
      if Result -> Bool
isSuccess Result
result then a -> IO ()
f a
a else () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      Result -> IO Result
forall (f :: * -> *) a. Applicative f => a -> f a
pure Result
result

-- | This function must be used to run services involving a top component
--   It creates the top component and invokes all warmup functions
--
--   The passed function 'f' is used to decide whether to continue or
--   not depending on the Result
--
--   We also make sure that all effects are memoized by calling `memoizeAll` on the Registry here!
withRegistry :: forall a b ins out m . (Typeable a, Contains (RIO a) out, Solvable ins out, MonadIO m, MemoizedActions out) =>
     Registry ins out
  -> (Result -> a -> IO b)
  -> m b
withRegistry :: Registry ins out -> (Result -> a -> IO b) -> m b
withRegistry Registry ins out
registry Result -> a -> IO b
f = IO b -> m b
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO b -> m b) -> IO b -> m b
forall a b. (a -> b) -> a -> b
$ ResourceT IO b -> IO b
forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT (ResourceT IO b -> IO b) -> ResourceT IO b -> IO b
forall a b. (a -> b) -> a -> b
$ do
  (a
a, Warmup
warmup) <- Registry ins out -> ResourceT IO (a, Warmup)
forall a (ins :: [*]) (out :: [*]) (m :: * -> *).
(Typeable a, Contains (RIO a) out, Solvable ins out, MonadIO m,
 MemoizedActions out) =>
Registry ins out -> ResourceT m (a, Warmup)
runRegistryT @a Registry ins out
registry
  Result
result      <- IO Result -> ResourceT IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result -> ResourceT IO Result)
-> (IO Result -> IO Result) -> IO Result -> ResourceT IO Result
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO Result -> IO Result
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Result -> ResourceT IO Result)
-> IO Result -> ResourceT IO Result
forall a b. (a -> b) -> a -> b
$ Warmup -> IO Result
runWarmup Warmup
warmup
  IO b -> ResourceT IO b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO b -> ResourceT IO b) -> IO b -> ResourceT IO b
forall a b. (a -> b) -> a -> b
$ Result -> a -> IO b
f Result
result a
a

-- | This can be used if you want to insert the component creation inside
--   another action managed with 'ResourceT'. Or if you want to call 'runResourceT' yourself later
runRegistryT :: forall a ins out m . (Typeable a, Contains (RIO a) out, Solvable ins out, MonadIO m, MemoizedActions out)
  => Registry ins out
  -> ResourceT m (a, Warmup)
runRegistryT :: Registry ins out -> ResourceT m (a, Warmup)
runRegistryT Registry ins out
registry = (InternalState -> m (a, Warmup)) -> ResourceT m (a, Warmup)
forall (m :: * -> *) a. (InternalState -> m a) -> ResourceT m a
withInternalState ((InternalState -> m (a, Warmup)) -> ResourceT m (a, Warmup))
-> (InternalState -> m (a, Warmup)) -> ResourceT m (a, Warmup)
forall a b. (a -> b) -> a -> b
$ \InternalState
is -> do
  Registry ins out
r <- IO (Registry ins out) -> m (Registry ins out)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Registry ins out) -> m (Registry ins out))
-> IO (Registry ins out) -> m (Registry ins out)
forall a b. (a -> b) -> a -> b
$ Registry ins out -> IO (Registry ins out)
forall (m :: * -> *) (ins :: [*]) (out :: [*]).
(MonadIO m, MemoizedActions out) =>
Registry ins out -> IO (Registry ins out)
memoizeAll @RIO Registry ins out
registry
  IO (a, Warmup) -> m (a, Warmup)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (a, Warmup) -> m (a, Warmup))
-> IO (a, Warmup) -> m (a, Warmup)
forall a b. (a -> b) -> a -> b
$ RIO a -> Stop -> IO (a, Warmup)
forall a. RIO a -> Stop -> IO (a, Warmup)
runRIO (Registry ins out -> RIO a
forall a (ins :: [*]) (out :: [*]).
Typeable a =>
Registry ins out -> a
make @(RIO a) Registry ins out
r) (InternalState -> Stop
Stop InternalState
is)

-- * For testing

-- | This runs a RIO value without closing down resources or executing startup actions
unsafeRunRIO :: (Typeable a, MonadIO m) => RIO a -> m a
unsafeRunRIO :: RIO a -> m a
unsafeRunRIO RIO a
rio = IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> IO a -> m a
forall a b. (a -> b) -> a -> b
$ do
  InternalState
is <- IO InternalState
forall (m :: * -> *). MonadIO m => m InternalState
createInternalState
  (a, Warmup) -> a
forall a b. (a, b) -> a
fst ((a, Warmup) -> a) -> IO (a, Warmup) -> IO a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RIO a -> Stop -> IO (a, Warmup)
forall a. RIO a -> Stop -> IO (a, Warmup)
runRIO RIO a
rio (InternalState -> Stop
Stop InternalState
is)

-- | Use a RIO value and make sure that resources are closed
--   Don't run the warmup
withNoWarmupRIO :: (MonadIO m) => RIO a -> (a -> IO b) -> m b
withNoWarmupRIO :: RIO a -> (a -> IO b) -> m b
withNoWarmupRIO RIO a
rio a -> IO b
f = IO b -> m b
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO b -> m b) -> IO b -> m b
forall a b. (a -> b) -> a -> b
$
  ResourceT IO b -> IO b
forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT (ResourceT IO b -> IO b) -> ResourceT IO b -> IO b
forall a b. (a -> b) -> a -> b
$ (InternalState -> IO b) -> ResourceT IO b
forall (m :: * -> *) a. (InternalState -> m a) -> ResourceT m a
withInternalState ((InternalState -> IO b) -> ResourceT IO b)
-> (InternalState -> IO b) -> ResourceT IO b
forall a b. (a -> b) -> a -> b
$ \InternalState
is ->
  a -> IO b
f (a -> IO b) -> ((a, Warmup) -> a) -> (a, Warmup) -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, Warmup) -> a
forall a b. (a, b) -> a
fst ((a, Warmup) -> IO b) -> IO (a, Warmup) -> IO b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< RIO a -> Stop -> IO (a, Warmup)
forall a. RIO a -> Stop -> IO (a, Warmup)
runRIO RIO a
rio (InternalState -> Stop
Stop InternalState
is)

-- | Use a RIO value and make sure that resources are closed
--   Run the warmup but ignore the result
withRIOIgnoreWarmupResult :: (MonadIO m) => RIO a -> (a -> IO b) -> m b
withRIOIgnoreWarmupResult :: RIO a -> (a -> IO b) -> m b
withRIOIgnoreWarmupResult = (Result -> IO ()) -> RIO a -> (a -> IO b) -> m b
forall (m :: * -> *) a b.
MonadIO m =>
(Result -> IO ()) -> RIO a -> (a -> IO b) -> m b
withRIOAndWarmupResult (IO () -> Result -> IO ()
forall a b. a -> b -> a
const (IO () -> Result -> IO ()) -> IO () -> Result -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

-- | Use a RIO value and make sure that resources are closed
--   Run a unit function with the warmup result (print or throw exception)
withRIOAndWarmupResult :: (MonadIO m) => (Result -> IO ()) -> RIO a -> (a -> IO b) -> m b
withRIOAndWarmupResult :: (Result -> IO ()) -> RIO a -> (a -> IO b) -> m b
withRIOAndWarmupResult Result -> IO ()
withResult RIO a
rio a -> IO b
f = IO b -> m b
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO b -> m b) -> IO b -> m b
forall a b. (a -> b) -> a -> b
$
  ResourceT IO b -> IO b
forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT (ResourceT IO b -> IO b) -> ResourceT IO b -> IO b
forall a b. (a -> b) -> a -> b
$ (InternalState -> IO b) -> ResourceT IO b
forall (m :: * -> *) a. (InternalState -> m a) -> ResourceT m a
withInternalState ((InternalState -> IO b) -> ResourceT IO b)
-> (InternalState -> IO b) -> ResourceT IO b
forall a b. (a -> b) -> a -> b
$ \InternalState
is -> do
    (a
a, Warmup
warmup) <- RIO a -> Stop -> IO (a, Warmup)
forall a. RIO a -> Stop -> IO (a, Warmup)
runRIO RIO a
rio (InternalState -> Stop
Stop InternalState
is)
    Result
warmupResult <- IO Result -> IO Result
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Result -> IO Result) -> IO Result -> IO Result
forall a b. (a -> b) -> a -> b
$ Warmup -> IO Result
runWarmup Warmup
warmup
    Result -> IO ()
withResult Result
warmupResult
    IO b -> IO b
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (a -> IO b
f a
a)

-- | Instantiate the component but don't execute the warmup (it may take time)
--   and keep the Stop value to clean resources later
--   This function statically checks that the component can be instantiated
executeRegistry :: forall a ins out m . (Typeable a, Contains (RIO a) out, Solvable ins out, MonadIO m) => Registry ins out -> m (a, Warmup, Stop)
executeRegistry :: Registry ins out -> m (a, Warmup, Stop)
executeRegistry Registry ins out
registry = IO (a, Warmup, Stop) -> m (a, Warmup, Stop)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (a, Warmup, Stop) -> m (a, Warmup, Stop))
-> IO (a, Warmup, Stop) -> m (a, Warmup, Stop)
forall a b. (a -> b) -> a -> b
$ do
  InternalState
is <- IO InternalState -> IO InternalState
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO InternalState
forall (m :: * -> *). MonadIO m => m InternalState
createInternalState
  (a
a, Warmup
w) <- RIO a -> Stop -> IO (a, Warmup)
forall a. RIO a -> Stop -> IO (a, Warmup)
runRIO (Registry ins out -> RIO a
forall a (ins :: [*]) (out :: [*]).
Typeable a =>
Registry ins out -> a
make @(RIO a) Registry ins out
registry) (InternalState -> Stop
Stop InternalState
is)
  (a, Warmup, Stop) -> IO (a, Warmup, Stop)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
a, Warmup
w, InternalState -> Stop
Stop InternalState
is)

-- | Instantiate the component but don't execute the warmup (it may take time) and lose a way to cleanu up resources
-- | Almost no compilation time is spent on checking that component resolution is possible
unsafeRun :: forall a ins out m . (Typeable a, Contains (RIO a) out, MonadIO m) => Registry ins out -> m a
unsafeRun :: Registry ins out -> m a
unsafeRun = Registry ins out -> m a
forall a (ins :: [*]) (out :: [*]) (m :: * -> *).
(Typeable a, MonadIO m) =>
Registry ins out -> m a
unsafeRunDynamic

-- | Instantiate the component but don't execute the warmup (it may take time) and lose a way to cleanu up resources
--   Don't even check that a component can be built out of the registry
unsafeRunDynamic :: forall a ins out m . (Typeable a, MonadIO m) => Registry ins out -> m a
unsafeRunDynamic :: Registry ins out -> m a
unsafeRunDynamic Registry ins out
registry = IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> IO a -> m a
forall a b. (a -> b) -> a -> b
$ (a, Stop) -> a
forall a b. (a, b) -> a
fst ((a, Stop) -> a) -> IO (a, Stop) -> IO a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Registry ins out -> IO (a, Stop)
forall a (ins :: [*]) (out :: [*]) (m :: * -> *).
(Typeable a, MonadIO m) =>
Registry ins out -> m (a, Stop)
unsafeRunDynamicWithStop Registry ins out
registry

-- | Same as 'unsafeRun' but keep the 'Stop' value to be able to clean resources later
unsafeRunWithStop :: forall a ins out m . (Typeable a, Contains (RIO a) out, MonadIO m) => Registry ins out -> m (a, Stop)
unsafeRunWithStop :: Registry ins out -> m (a, Stop)
unsafeRunWithStop = Registry ins out -> m (a, Stop)
forall a (ins :: [*]) (out :: [*]) (m :: * -> *).
(Typeable a, MonadIO m) =>
Registry ins out -> m (a, Stop)
unsafeRunDynamicWithStop

unsafeRunDynamicWithStop :: forall a ins out m . (Typeable a, MonadIO m) => Registry ins out -> m (a, Stop)
unsafeRunDynamicWithStop :: Registry ins out -> m (a, Stop)
unsafeRunDynamicWithStop Registry ins out
registry = IO (a, Stop) -> m (a, Stop)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (a, Stop) -> m (a, Stop)) -> IO (a, Stop) -> m (a, Stop)
forall a b. (a -> b) -> a -> b
$ do
  InternalState
is <- IO InternalState
forall (m :: * -> *). MonadIO m => m InternalState
createInternalState
  (a
a, Warmup
_) <- RIO a -> Stop -> IO (a, Warmup)
forall a. RIO a -> Stop -> IO (a, Warmup)
runRIO (Registry ins out -> RIO a
forall a (ins :: [*]) (out :: [*]).
Typeable a =>
Registry ins out -> a
make @(RIO a) Registry ins out
registry) (InternalState -> Stop
Stop InternalState
is)
  (a, Stop) -> IO (a, Stop)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
a, InternalState -> Stop
Stop InternalState
is)

-- | Lift a 'Warmup' action into the 'RIO` monad
warmupWith :: Warmup -> RIO ()
warmupWith :: Warmup -> RIO ()
warmupWith Warmup
w = (Stop -> IO ((), Warmup)) -> RIO ()
forall a. (Stop -> IO (a, Warmup)) -> RIO a
RIO (IO ((), Warmup) -> Stop -> IO ((), Warmup)
forall a b. a -> b -> a
const (IO ((), Warmup) -> Stop -> IO ((), Warmup))
-> IO ((), Warmup) -> Stop -> IO ((), Warmup)
forall a b. (a -> b) -> a -> b
$ ((), Warmup) -> IO ((), Warmup)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((), Warmup
w))

-- | Allocate some resource
allocate :: IO a -> (a -> IO ()) -> RIO a
allocate :: IO a -> (a -> IO ()) -> RIO a
allocate IO a
resource a -> IO ()
cleanup =
  (ReleaseKey, a) -> a
forall a b. (a, b) -> b
snd ((ReleaseKey, a) -> a) -> RIO (ReleaseKey, a) -> RIO a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO a -> (a -> IO ()) -> RIO (ReleaseKey, a)
forall (m :: * -> *) a.
MonadResource m =>
IO a -> (a -> IO ()) -> m (ReleaseKey, a)
Resource.allocate IO a
resource a -> IO ()
cleanup