{-# LANGUAGE MagicHash #-}
{-# OPTIONS_HADDOCK not-home #-}
module Control.Effect.Type.Unlift
(
Unlift(..)
, threadUnliftViaClass
, threadBaseControlViaUnlift
, MonadBaseControlPure
, unliftBase
, MonadTransControlPure
, unliftT
) where
import GHC.Exts (Proxy#, proxy#)
import Data.Coerce
import Control.Effect.Internal.Union
import Control.Effect.Internal.Utils
import Control.Effect.Type.Internal.BaseControl
import Control.Monad.Base
import Control.Monad.Trans
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
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 #-}
newtype Unlift b :: Effect where
Unlift :: forall b m a. ((forall x. m x -> b x) -> b a) -> Unlift b m 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 #-}
threadBaseControlViaUnlift :: forall b t m a
. ( Monad m
, MonadTrans t
, forall z. Monad z => Monad (t z)
, forall z
. Coercible z m
=> Coercible (t z) (t m)
, forall z. Monad z => ThreadsEff t (Unlift z)
)
=> (forall x. BaseControl b m x -> m x)
-> BaseControl b (t m) a -> t m a
threadBaseControlViaUnlift :: (forall x. BaseControl b m x -> m x)
-> BaseControl b (t m) a -> t m a
threadBaseControlViaUnlift forall x. BaseControl b m x -> m x
alg (GainBaseControl forall (z :: * -> *).
(MonadBaseControl b z, Coercible z (t m)) =>
Proxy# z -> a
main) =
m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> t m a) -> m a -> t m a
forall a b. (a -> b) -> a -> b
$ BaseControl b m a -> m a
forall x. BaseControl b m x -> m x
alg (BaseControl b m a -> m a) -> BaseControl b m a -> m a
forall a b. (a -> b) -> a -> b
$ (forall (z :: * -> *).
(MonadBaseControl b z, Coercible z m) =>
Proxy# z -> a)
-> BaseControl b m a
forall (b :: * -> *) (m :: * -> *) a.
(forall (z :: * -> *).
(MonadBaseControl b z, Coercible z m) =>
Proxy# z -> a)
-> BaseControl b m a
GainBaseControl ((forall (z :: * -> *).
(MonadBaseControl b z, Coercible z m) =>
Proxy# z -> a)
-> BaseControl b m a)
-> (forall (z :: * -> *).
(MonadBaseControl b z, Coercible z m) =>
Proxy# z -> a)
-> BaseControl b m a
forall a b. (a -> b) -> a -> b
$ \(Proxy# z
_ :: Proxy# z) ->
Proxy# (Unlifted t z) -> a
forall (z :: * -> *).
(MonadBaseControl b z, Coercible z (t m)) =>
Proxy# z -> a
main (Proxy# (Unlifted t z)
forall k (a :: k). Proxy# a
proxy# :: Proxy# (Unlifted t z))
{-# INLINE threadBaseControlViaUnlift #-}
newtype Unlifted t m a = Unlifted { Unlifted t m a -> t m a
unUnlifted :: t m a }
deriving (a -> Unlifted t m b -> Unlifted t m a
(a -> b) -> Unlifted t m a -> Unlifted t m b
(forall a b. (a -> b) -> Unlifted t m a -> Unlifted t m b)
-> (forall a b. a -> Unlifted t m b -> Unlifted t m a)
-> Functor (Unlifted t m)
forall a b. a -> Unlifted t m b -> Unlifted t m a
forall a b. (a -> b) -> Unlifted t m a -> Unlifted t m b
forall k (t :: k -> * -> *) (m :: k) a b.
Functor (t m) =>
a -> Unlifted t m b -> Unlifted t m a
forall k (t :: k -> * -> *) (m :: k) a b.
Functor (t m) =>
(a -> b) -> Unlifted t m a -> Unlifted t m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Unlifted t m b -> Unlifted t m a
$c<$ :: forall k (t :: k -> * -> *) (m :: k) a b.
Functor (t m) =>
a -> Unlifted t m b -> Unlifted t m a
fmap :: (a -> b) -> Unlifted t m a -> Unlifted t m b
$cfmap :: forall k (t :: k -> * -> *) (m :: k) a b.
Functor (t m) =>
(a -> b) -> Unlifted t m a -> Unlifted t m b
Functor, Functor (Unlifted t m)
a -> Unlifted t m a
Functor (Unlifted t m)
-> (forall a. a -> Unlifted t m a)
-> (forall a b.
Unlifted t m (a -> b) -> Unlifted t m a -> Unlifted t m b)
-> (forall a b c.
(a -> b -> c)
-> Unlifted t m a -> Unlifted t m b -> Unlifted t m c)
-> (forall a b. Unlifted t m a -> Unlifted t m b -> Unlifted t m b)
-> (forall a b. Unlifted t m a -> Unlifted t m b -> Unlifted t m a)
-> Applicative (Unlifted t m)
Unlifted t m a -> Unlifted t m b -> Unlifted t m b
Unlifted t m a -> Unlifted t m b -> Unlifted t m a
Unlifted t m (a -> b) -> Unlifted t m a -> Unlifted t m b
(a -> b -> c) -> Unlifted t m a -> Unlifted t m b -> Unlifted t m c
forall a. a -> Unlifted t m a
forall a b. Unlifted t m a -> Unlifted t m b -> Unlifted t m a
forall a b. Unlifted t m a -> Unlifted t m b -> Unlifted t m b
forall a b.
Unlifted t m (a -> b) -> Unlifted t m a -> Unlifted t m b
forall a b c.
(a -> b -> c) -> Unlifted t m a -> Unlifted t m b -> Unlifted t m c
forall k (t :: k -> * -> *) (m :: k).
Applicative (t m) =>
Functor (Unlifted t m)
forall k (t :: k -> * -> *) (m :: k) a.
Applicative (t m) =>
a -> Unlifted t m a
forall k (t :: k -> * -> *) (m :: k) a b.
Applicative (t m) =>
Unlifted t m a -> Unlifted t m b -> Unlifted t m a
forall k (t :: k -> * -> *) (m :: k) a b.
Applicative (t m) =>
Unlifted t m a -> Unlifted t m b -> Unlifted t m b
forall k (t :: k -> * -> *) (m :: k) a b.
Applicative (t m) =>
Unlifted t m (a -> b) -> Unlifted t m a -> Unlifted t m b
forall k (t :: k -> * -> *) (m :: k) a b c.
Applicative (t m) =>
(a -> b -> c) -> Unlifted t m a -> Unlifted t m b -> Unlifted t m 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
<* :: Unlifted t m a -> Unlifted t m b -> Unlifted t m a
$c<* :: forall k (t :: k -> * -> *) (m :: k) a b.
Applicative (t m) =>
Unlifted t m a -> Unlifted t m b -> Unlifted t m a
*> :: Unlifted t m a -> Unlifted t m b -> Unlifted t m b
$c*> :: forall k (t :: k -> * -> *) (m :: k) a b.
Applicative (t m) =>
Unlifted t m a -> Unlifted t m b -> Unlifted t m b
liftA2 :: (a -> b -> c) -> Unlifted t m a -> Unlifted t m b -> Unlifted t m c
$cliftA2 :: forall k (t :: k -> * -> *) (m :: k) a b c.
Applicative (t m) =>
(a -> b -> c) -> Unlifted t m a -> Unlifted t m b -> Unlifted t m c
<*> :: Unlifted t m (a -> b) -> Unlifted t m a -> Unlifted t m b
$c<*> :: forall k (t :: k -> * -> *) (m :: k) a b.
Applicative (t m) =>
Unlifted t m (a -> b) -> Unlifted t m a -> Unlifted t m b
pure :: a -> Unlifted t m a
$cpure :: forall k (t :: k -> * -> *) (m :: k) a.
Applicative (t m) =>
a -> Unlifted t m a
$cp1Applicative :: forall k (t :: k -> * -> *) (m :: k).
Applicative (t m) =>
Functor (Unlifted t m)
Applicative, Applicative (Unlifted t m)
a -> Unlifted t m a
Applicative (Unlifted t m)
-> (forall a b.
Unlifted t m a -> (a -> Unlifted t m b) -> Unlifted t m b)
-> (forall a b. Unlifted t m a -> Unlifted t m b -> Unlifted t m b)
-> (forall a. a -> Unlifted t m a)
-> Monad (Unlifted t m)
Unlifted t m a -> (a -> Unlifted t m b) -> Unlifted t m b
Unlifted t m a -> Unlifted t m b -> Unlifted t m b
forall a. a -> Unlifted t m a
forall a b. Unlifted t m a -> Unlifted t m b -> Unlifted t m b
forall a b.
Unlifted t m a -> (a -> Unlifted t m b) -> Unlifted t m b
forall k (t :: k -> * -> *) (m :: k).
Monad (t m) =>
Applicative (Unlifted t m)
forall k (t :: k -> * -> *) (m :: k) a.
Monad (t m) =>
a -> Unlifted t m a
forall k (t :: k -> * -> *) (m :: k) a b.
Monad (t m) =>
Unlifted t m a -> Unlifted t m b -> Unlifted t m b
forall k (t :: k -> * -> *) (m :: k) a b.
Monad (t m) =>
Unlifted t m a -> (a -> Unlifted t m b) -> Unlifted t m 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 :: a -> Unlifted t m a
$creturn :: forall k (t :: k -> * -> *) (m :: k) a.
Monad (t m) =>
a -> Unlifted t m a
>> :: Unlifted t m a -> Unlifted t m b -> Unlifted t m b
$c>> :: forall k (t :: k -> * -> *) (m :: k) a b.
Monad (t m) =>
Unlifted t m a -> Unlifted t m b -> Unlifted t m b
>>= :: Unlifted t m a -> (a -> Unlifted t m b) -> Unlifted t m b
$c>>= :: forall k (t :: k -> * -> *) (m :: k) a b.
Monad (t m) =>
Unlifted t m a -> (a -> Unlifted t m b) -> Unlifted t m b
$cp1Monad :: forall k (t :: k -> * -> *) (m :: k).
Monad (t m) =>
Applicative (Unlifted t m)
Monad)
deriving m a -> Unlifted t m a
(forall (m :: * -> *) a. Monad m => m a -> Unlifted t m a)
-> MonadTrans (Unlifted t)
forall (m :: * -> *) a. Monad m => m a -> Unlifted t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> Unlifted t m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
lift :: m a -> Unlifted t m a
$clift :: forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> Unlifted t m a
MonadTrans
instance (MonadBase b m, MonadTrans t, Monad (t m))
=> MonadBase b (Unlifted t m) where
liftBase :: b α -> Unlifted t m α
liftBase = m α -> Unlifted t m α
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m α -> Unlifted t m α) -> (b α -> m α) -> b α -> Unlifted t m α
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b α -> m α
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase
{-# INLINE liftBase #-}
instance (MonadBaseControl b m, MonadTrans t, ThreadsEff t (Unlift m),
Monad (t m))
=> MonadBaseControl b (Unlifted t m) where
type StM (Unlifted t m) a = StM m a
liftBaseWith :: (RunInBase (Unlifted t m) b -> b a) -> Unlifted t m a
liftBaseWith RunInBase (Unlifted t m) b -> b a
main =
t m a -> Unlifted t m a
forall k k (t :: k -> k -> *) (m :: k) (a :: k).
t m a -> Unlifted t m a
Unlifted (t m a -> Unlifted t m a) -> t m a -> Unlifted t m a
forall a b. (a -> b) -> a -> b
$ (forall x. Unlift m m x -> m x) -> Unlift m (t m) a -> t m a
forall (t :: (* -> *) -> * -> *) (e :: (* -> *) -> * -> *)
(m :: * -> *) a.
(ThreadsEff t e, Monad m) =>
(forall x. e m x -> m x) -> e (t m) a -> t m a
threadEff (\(Unlift main') -> (forall x. m x -> m x) -> m x
main' forall a. a -> a
forall x. m x -> m x
id) (Unlift m (t m) a -> t m a) -> Unlift m (t m) a -> t m a
forall a b. (a -> b) -> a -> b
$ ((forall x. t m x -> m x) -> m a) -> Unlift m (t m) a
forall (b :: * -> *) (m :: * -> *) a.
((forall x. m x -> b x) -> b a) -> Unlift b m a
Unlift (((forall x. t m x -> m x) -> m a) -> Unlift m (t m) a)
-> ((forall x. t m x -> m x) -> m a) -> Unlift m (t m) a
forall a b. (a -> b) -> a -> b
$ \forall x. t m x -> m x
lower ->
(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
run_it -> RunInBase (Unlifted t m) b -> b a
main (RunInBase (Unlifted t m) b -> b a)
-> RunInBase (Unlifted t m) b -> b a
forall a b. (a -> b) -> a -> b
$ m a -> b (StM m a)
RunInBase m b
run_it (m a -> b (StM m a)) -> (t m a -> m a) -> t m a -> b (StM m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t m a -> m a
forall x. t m x -> m x
lower (t m a -> b (StM m a))
-> (Unlifted t m a -> t m a) -> Unlifted t m a -> b (StM m a)
forall b a c. Coercible b a => (b -> c) -> (a -> b) -> a -> c
.# Unlifted t m a -> t m a
forall k k (t :: k -> k -> *) (m :: k) (a :: k).
Unlifted t m a -> t m a
unUnlifted
{-# INLINE liftBaseWith #-}
restoreM :: StM (Unlifted t m) a -> Unlifted t m a
restoreM = t m a -> Unlifted t m a
forall k k (t :: k -> k -> *) (m :: k) (a :: k).
t m a -> Unlifted t m a
Unlifted (t m a -> Unlifted t m a)
-> (StM m a -> t m a) -> StM m a -> Unlifted t m a
forall c b a. Coercible c b => (b -> c) -> (a -> b) -> a -> c
#. m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> t m a) -> (StM m a -> m a) -> StM m a -> t m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StM m a -> m a
forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
StM m a -> m a
restoreM
{-# INLINE restoreM #-}
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 #-}