{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
#if __GLASGOW_HASKELL__ >= 800
{-# LANGUAGE UndecidableSuperClasses #-}
#endif
module Control.Monad.Trans.Unlift
(
MonadTransUnlift
, Unlift (..)
, askUnlift
, askRun
, MonadBaseUnlift
, UnliftBase (..)
, askUnliftBase
, askRunBase
, MonadTrans (..)
, MonadBase (..)
, MonadTransControl (..)
, MonadBaseControl (..)
) where
import Control.Monad (liftM)
import Control.Monad.Base (MonadBase (..))
import Control.Monad.Trans.Class (MonadTrans (..))
import Control.Monad.Trans.Control (MonadBaseControl (..),
MonadTransControl (..))
import Data.Constraint ((:-), (\\))
import Data.Constraint.Forall (Forall, inst)
newtype Unlift t = Unlift { Unlift t -> forall a (n :: * -> *). Monad n => t n a -> n a
unlift :: forall a n. Monad n => t n a -> n a }
class (StT t a ~ a) => Identical t a
instance (StT t a ~ a) => Identical t a
class (MonadTransControl t, Forall (Identical t)) => MonadTransUnlift t
instance (MonadTransControl t, Forall (Identical t)) => MonadTransUnlift t
mkUnlift :: forall t m a . (Forall (Identical t), Monad m)
=> (forall n b. Monad n => t n b -> n (StT t b)) -> t m a -> m a
mkUnlift :: (forall (n :: * -> *) b. Monad n => t n b -> n (StT t b))
-> t m a -> m a
mkUnlift r :: forall (n :: * -> *) b. Monad n => t n b -> n (StT t b)
r act :: t m a
act = t m a -> m (StT t a)
forall (n :: * -> *) b. Monad n => t n b -> n (StT t b)
r t m a
act (Identical t a => m a)
-> (Forall_ (Identical t) :- Identical t a) -> m a
forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ (Forall (Identical t) :- Identical t a
forall k (p :: k -> Constraint) (a :: k). Forall p :- p a
inst :: Forall (Identical t) :- Identical t a)
askUnlift :: forall t m. (MonadTransUnlift t, Monad m) => t m (Unlift t)
askUnlift :: t m (Unlift t)
askUnlift = (Run t -> m (Unlift t)) -> t m (Unlift t)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
(Run t -> m a) -> t m a
liftWith Run t -> m (Unlift t)
unlifter
where
unlifter :: (forall n b. Monad n => t n b -> n (StT t b)) -> m (Unlift t)
unlifter :: Run t -> m (Unlift t)
unlifter r :: Run t
r = Unlift t -> m (Unlift t)
forall (m :: * -> *) a. Monad m => a -> m a
return (Unlift t -> m (Unlift t)) -> Unlift t -> m (Unlift t)
forall a b. (a -> b) -> a -> b
$ (forall a (n :: * -> *). Monad n => t n a -> n a) -> Unlift t
forall (t :: (* -> *) -> * -> *).
(forall a (n :: * -> *). Monad n => t n a -> n a) -> Unlift t
Unlift (Run t -> t n a -> n a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(Forall (Identical t), Monad m) =>
(forall (n :: * -> *) b. Monad n => t n b -> n (StT t b))
-> t m a -> m a
mkUnlift Run t
r)
askRun :: (MonadTransUnlift t, Monad (t m), Monad m) => t m (t m a -> m a)
askRun :: t m (t m a -> m a)
askRun = (Unlift t -> t m a -> m a) -> t m (Unlift t) -> t m (t m a -> m a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Unlift t -> t m a -> m a
forall (t :: (* -> *) -> * -> *).
Unlift t -> forall a (n :: * -> *). Monad n => t n a -> n a
unlift t m (Unlift t)
forall (t :: (* -> *) -> * -> *) (m :: * -> *).
(MonadTransUnlift t, Monad m) =>
t m (Unlift t)
askUnlift
{-# INLINE askRun #-}
newtype UnliftBase b m = UnliftBase { UnliftBase b m -> forall a. m a -> b a
unliftBase :: forall a. m a -> b a }
class (StM m a ~ a) => IdenticalBase m a
instance (StM m a ~ a) => IdenticalBase m a
class (MonadBaseControl b m, Forall (IdenticalBase m)) => MonadBaseUnlift b m | m -> b
instance (MonadBaseControl b m, Forall (IdenticalBase m)) => MonadBaseUnlift b m
mkUnliftBase :: forall m a b. (Forall (IdenticalBase m), Monad b)
=> (forall c. m c -> b (StM m c)) -> m a -> b a
mkUnliftBase :: (forall c. m c -> b (StM m c)) -> m a -> b a
mkUnliftBase r :: forall c. m c -> b (StM m c)
r act :: m a
act = m a -> b (StM m a)
forall c. m c -> b (StM m c)
r m a
act (IdenticalBase m a => b a)
-> (Forall_ (IdenticalBase m) :- IdenticalBase m a) -> b a
forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ (Forall (IdenticalBase m) :- IdenticalBase m a
forall k (p :: k -> Constraint) (a :: k). Forall p :- p a
inst :: Forall (IdenticalBase m) :- IdenticalBase m a)
askUnliftBase :: forall b m. (MonadBaseUnlift b m) => m (UnliftBase b m)
askUnliftBase :: m (UnliftBase b m)
askUnliftBase = (RunInBase m b -> b (UnliftBase b m)) -> m (UnliftBase b m)
forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
(RunInBase m b -> b a) -> m a
liftBaseWith RunInBase m b -> b (UnliftBase b m)
unlifter
where
unlifter :: (forall c. m c -> b (StM m c)) -> b (UnliftBase b m)
unlifter :: RunInBase m b -> b (UnliftBase b m)
unlifter r :: RunInBase m b
r = UnliftBase b m -> b (UnliftBase b m)
forall (m :: * -> *) a. Monad m => a -> m a
return (UnliftBase b m -> b (UnliftBase b m))
-> UnliftBase b m -> b (UnliftBase b m)
forall a b. (a -> b) -> a -> b
$ (forall a. m a -> b a) -> UnliftBase b m
forall (b :: * -> *) (m :: * -> *).
(forall a. m a -> b a) -> UnliftBase b m
UnliftBase (RunInBase m b -> m a -> b a
forall (m :: * -> *) a (b :: * -> *).
(Forall (IdenticalBase m), Monad b) =>
(forall c. m c -> b (StM m c)) -> m a -> b a
mkUnliftBase RunInBase m b
r)
askRunBase :: (MonadBaseUnlift b m)
=> m (m a -> b a)
askRunBase :: m (m a -> b a)
askRunBase = (UnliftBase b m -> m a -> b a)
-> m (UnliftBase b m) -> m (m a -> b a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM UnliftBase b m -> m a -> b a
forall (b :: * -> *) (m :: * -> *).
UnliftBase b m -> forall a. m a -> b a
unliftBase m (UnliftBase b m)
forall (b :: * -> *) (m :: * -> *).
MonadBaseUnlift b m =>
m (UnliftBase b m)
askUnliftBase
{-# INLINE askRunBase #-}