{-# OPTIONS_HADDOCK not-home #-}
module Control.Effect.Type.Unlift
 ( -- * Effects
   Unlift(..)

   -- Threading utilities
 , threadUnliftViaClass

   -- 'MonadBaseControlPure' and 'MonadTransControlPure'
 , MonadBaseControlPure
 , unliftBase

 , MonadTransControlPure
 , unliftT
 ) where

import Control.Effect.Internal.Union
import Control.Monad.Trans.Control
import Control.Monad.Trans.Reader

class    a ~ StM m a => Pure m a
instance a ~ StM m a => Pure m a

-- | A constraint synonym for @'MonadBaseControl' b m@ together
-- with that @StM m a ~ a@ for all @a@.
class    ( MonadBaseControl b m
         , forall x. Pure m x
         )
        => MonadBaseControlPure b m

instance ( MonadBaseControl b m
         , forall x. Pure m x
         )
        => MonadBaseControlPure b m

class    a ~ StT t a => PureT t a
instance a ~ StT t a => PureT t a

class    ( MonadTransControl t
         , forall x. PureT t x
         )
        => MonadTransControlPure t

instance ( MonadTransControl t
         , forall x. PureT t x
         )
        => MonadTransControlPure t

unliftBase :: forall b m a
            . MonadBaseControlPure b m
           => ((forall x. m x -> b x) -> b a)
           -> m a
unliftBase :: ((forall x. m x -> b x) -> b a) -> m a
unliftBase (forall x. m x -> b x) -> b a
main = (RunInBase m b -> b a) -> m a
forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
(RunInBase m b -> b a) -> m a
liftBaseWith ((RunInBase m b -> b a) -> m a) -> (RunInBase m b -> b a) -> m a
forall a b. (a -> b) -> a -> b
$ \RunInBase m b
lower ->
  (forall x. m x -> b x) -> b a
main (RunInBase m b
forall x. Pure m x => m x -> b x
lower :: Pure m x => m x -> b x)
{-# INLINE unliftBase #-}

unliftT :: forall t m a
         . (MonadTransControlPure t, Monad m)
        => ((forall n x. Monad n => t n x -> n x) -> m a)
        -> t m a
unliftT :: ((forall (n :: * -> *) x. Monad n => t n x -> n x) -> m a) -> t m a
unliftT (forall (n :: * -> *) x. Monad n => t n x -> n x) -> m a
main = (Run t -> m a) -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
(Run t -> m a) -> t m a
liftWith ((Run t -> m a) -> t m a) -> (Run t -> m a) -> t m a
forall a b. (a -> b) -> a -> b
$ \Run t
lower ->
  (forall (n :: * -> *) x. Monad n => t n x -> n x) -> m a
main (forall x (n :: * -> *). (PureT t x, Monad n) => t n x -> n x
Run t
lower :: (PureT t x, Monad n) => t n x -> n x)
{-# INLINE unliftT #-}

-- | A /helper primitive effect/ for unlifting to a base monad.
--
-- Helper primitive effects are effects that allow you to avoid interpreting one
-- of your own effects as a primitive if the power needed from direct access to
-- the underlying monad can instead be provided by the relevant helper primitive
-- effect. The reason why you'd want to do this is that helper primitive effects
-- already have 'ThreadsEff' instances defined for them, so you don't have to
-- define any for your own effect.
--
-- The helper primitive effects offered in this library are -- in order of
-- ascending power -- 'Control.Effect.Regional.Regional',
-- 'Control.Effect.Optional.Optional', 'Control.Effect.BaseControl.BaseControl'
-- and 'Control.Effect.Unlift.Unlift'.
--
-- __'Unlift' is typically used as a primitive effect.__
-- If you define a 'Control.Effect.Carrier' that relies on a novel
-- non-trivial monad transformer @t@, then you need to make
-- a @'ThreadsEff' t ('Unlift' b)@ instance (if possible).
-- 'threadUnliftViaClass' can help you with that.
--
-- The following threading constraints accept 'Unlift':
--
-- * 'Control.Effect.ReaderThreads'
newtype Unlift b :: Effect where
  Unlift :: forall b m a. ((forall x. m x -> b x) -> b a) -> Unlift b m a

-- | A valid definition of 'threadEff' for a @'ThreadsEff' ('Unlift' b) t@ instance,
-- given that @t@ is a 'MonadTransControl' where @'StT' t a ~ a@ holds for all @a@.
threadUnliftViaClass :: forall b t m a
                      . (MonadTransControlPure t, Monad m)
                     => (forall x. Unlift b m x -> m x)
                     -> Unlift b (t m) a -> t m a
threadUnliftViaClass :: (forall x. Unlift b m x -> m x) -> Unlift b (t m) a -> t m a
threadUnliftViaClass forall x. Unlift b m x -> m x
alg (Unlift (forall x. t m x -> b x) -> b a
main) = ((forall (n :: * -> *) x. Monad n => t n x -> n x) -> m a) -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControlPure t, Monad m) =>
((forall (n :: * -> *) x. Monad n => t n x -> n x) -> m a) -> t m a
unliftT (((forall (n :: * -> *) x. Monad n => t n x -> n x) -> m a)
 -> t m a)
-> ((forall (n :: * -> *) x. Monad n => t n x -> n x) -> m a)
-> t m a
forall a b. (a -> b) -> a -> b
$ \forall (n :: * -> *) x. Monad n => t n x -> n x
lowerT ->
  Unlift b m a -> m a
forall x. Unlift b m x -> m x
alg (Unlift b m a -> m a) -> Unlift b m a -> m a
forall a b. (a -> b) -> a -> b
$ ((forall x. m x -> b x) -> b a) -> Unlift b m a
forall (b :: * -> *) (m :: * -> *) a.
((forall x. m x -> b x) -> b a) -> Unlift b m a
Unlift (((forall x. m x -> b x) -> b a) -> Unlift b m a)
-> ((forall x. m x -> b x) -> b a) -> Unlift b m a
forall a b. (a -> b) -> a -> b
$ \forall x. m x -> b x
lowerM -> (forall x. t m x -> b x) -> b a
main (m x -> b x
forall x. m x -> b x
lowerM (m x -> b x) -> (t m x -> m x) -> t m x -> b x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t m x -> m x
forall (n :: * -> *) x. Monad n => t n x -> n x
lowerT)
{-# INLINE threadUnliftViaClass #-}

instance ThreadsEff (ReaderT i) (Unlift b) where
  threadEff :: (forall x. Unlift b m x -> m x)
-> Unlift b (ReaderT i m) a -> ReaderT i m a
threadEff forall x. Unlift b m x -> m x
alg (Unlift (forall x. ReaderT i m x -> b x) -> b a
main) = (i -> m a) -> ReaderT i m a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((i -> m a) -> ReaderT i m a) -> (i -> m a) -> ReaderT i m a
forall a b. (a -> b) -> a -> b
$ \i
s ->
    Unlift b m a -> m a
forall x. Unlift b m x -> m x
alg (Unlift b m a -> m a) -> Unlift b m a -> m a
forall a b. (a -> b) -> a -> b
$ ((forall x. m x -> b x) -> b a) -> Unlift b m a
forall (b :: * -> *) (m :: * -> *) a.
((forall x. m x -> b x) -> b a) -> Unlift b m a
Unlift (((forall x. m x -> b x) -> b a) -> Unlift b m a)
-> ((forall x. m x -> b x) -> b a) -> Unlift b m a
forall a b. (a -> b) -> a -> b
$ \forall x. m x -> b x
lower -> (forall x. ReaderT i m x -> b x) -> b a
main (m x -> b x
forall x. m x -> b x
lower (m x -> b x) -> (ReaderT i m x -> m x) -> ReaderT i m x -> b x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ReaderT i m x -> i -> m x
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
`runReaderT` i
s))
  {-# INLINE threadEff #-}