{-# LANGUAGE DerivingVia #-}
module Control.Effect.Unlift
 ( -- * Effects
   Unlift(..)

   -- * Actions
 , unlift

   -- * Interpretations
 , MonadBaseControlPure
 , unliftToFinal

 , runUnlift

   -- * Threading utilities
 , threadUnliftViaClass

    -- * Combinators for 'Algebra's
    -- Intended to be used for custom 'Carrier' instances when
    -- defining 'algPrims'.
  , powerAlgUnlift
  , powerAlgUnliftFinal

    -- * Carriers
 , UnliftToFinalC
 , UnliftC
 ) where

import Control.Effect
import Control.Effect.Carrier
import Control.Effect.Internal.Unlift

import Control.Effect.Type.Unlift

unlift :: Eff (Unlift b) m => ((forall x. m x -> b x) -> b a) -> m a
unlift :: ((forall x. m x -> b x) -> b a) -> m a
unlift (forall x. m x -> b x) -> b a
main = Unlift b m a -> m a
forall (e :: Effect) (m :: * -> *) a.
(Member e (Derivs m), Carrier m) =>
e m a -> m a
send (((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
main)
{-# INLINE unlift #-}

-- | Run a @'Unlift' m@ effect, where the unlifted monad @m@ is the
-- current monad.
--
-- @'Derivs' ('UnliftC' m) = 'Unlift' m ': 'Derivs' m@
--
-- @'Prims'  ('UnliftC' m) = 'Unlift' m ': 'Prims' m@
runUnlift :: Carrier m
          => UnliftC m a
          -> m a
runUnlift :: UnliftC m a -> m a
runUnlift = UnliftC m a -> m a
forall k (m :: k -> *) (a :: k). UnliftC m a -> m a
unUnliftC
{-# INLINE runUnlift #-}

data UnliftToFinalH

instance ( MonadBaseControlPure b m
         , Carrier m
         )
      => PrimHandler UnliftToFinalH (Unlift b) m where
  effPrimHandler :: Unlift b m x -> m x
effPrimHandler (Unlift (forall x. m x -> b x) -> b x
main) = ((forall x. m x -> b x) -> b x) -> m x
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 x
main
  {-# INLINEABLE effPrimHandler #-}

type UnliftToFinalC b = InterpretPrimC UnliftToFinalH (Unlift b)

-- | Run a @'Unlift' b@ effect, where the unlifted monad @b@ is the
-- final base monad of @m@
--
-- @'Derivs' ('UnliftToFinalC' b m) = 'Unlift' b ': 'Derivs' m@
--
-- @'Prims'  ('UnliftToFinalC' b m) = 'Unlift' b ': 'Prims' m@
unliftToFinal :: ( MonadBaseControlPure b m
                 , Carrier m
                 )
              => UnliftToFinalC b m a
              -> m a
unliftToFinal :: UnliftToFinalC b m a -> m a
unliftToFinal = UnliftToFinalC b m a -> m a
forall h (e :: Effect) (m :: * -> *) a.
PrimHandler h e m =>
InterpretPrimC h e m a -> m a
interpretPrimViaHandler
{-# INLINE unliftToFinal #-}

-- | Strengthen an @'Algebra' p m@ by adding a @'Unlift' m@ handler
powerAlgUnlift :: forall m p a
                . Algebra' p m a
               -> Algebra' (Unlift m ': p) m a
powerAlgUnlift :: Algebra' p m a -> Algebra' (Unlift m : p) m a
powerAlgUnlift Algebra' p m a
alg = Algebra' p m a
-> (Unlift m m a -> m a) -> Algebra' (Unlift m : p) m a
forall (e :: Effect) (r :: [Effect]) (m :: * -> *) a.
RepresentationalEff e =>
Algebra' r m a -> (e m a -> m a) -> Algebra' (e : r) m a
powerAlg Algebra' p m a
alg ((Unlift m m a -> m a) -> Algebra' (Unlift m : p) m a)
-> (Unlift m m a -> m a) -> Algebra' (Unlift m : p) m a
forall a b. (a -> b) -> a -> b
$ \case
  Unlift (forall x. m x -> m x) -> m a
main -> (forall x. m x -> m x) -> m a
main forall a. a -> a
forall x. m x -> m x
id
{-# INLINE powerAlgUnlift #-}

-- | Strengthen an @'Algebra' p m@ by adding a @'Unlift' b@ handler, where
-- @b@ is the final base monad.
powerAlgUnliftFinal :: forall b m p a
                     . MonadBaseControlPure b m
                    => Algebra' p m a
                    -> Algebra' (Unlift b ': p) m a
powerAlgUnliftFinal :: Algebra' p m a -> Algebra' (Unlift b : p) m a
powerAlgUnliftFinal Algebra' p m a
alg = Algebra' p m a
-> (Unlift b m a -> m a) -> Algebra' (Unlift b : p) m a
forall (e :: Effect) (r :: [Effect]) (m :: * -> *) a.
RepresentationalEff e =>
Algebra' r m a -> (e m a -> m a) -> Algebra' (e : r) m a
powerAlg Algebra' p m a
alg ((Unlift b m a -> m a) -> Algebra' (Unlift b : p) m a)
-> (Unlift b m a -> m a) -> Algebra' (Unlift b : p) m a
forall a b. (a -> b) -> a -> b
$ \case
  Unlift (forall x. m x -> b x) -> b a
main -> ((forall x. m x -> b x) -> b a) -> m a
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
main
{-# INLINE powerAlgUnliftFinal #-}