module Control.Monad.Ology.Specific.WithT where import Control.Monad.Ology.Data import Control.Monad.Ology.General import Import type WithT :: forall k. (k -> Type) -> Type -> Type newtype WithT m a = MkWithT { forall k (m :: k -> Type) a. WithT m a -> With m a unWithT :: With m a } instance Functor (WithT m) where fmap :: forall a b. (a -> b) -> WithT m a -> WithT m b fmap a -> b ab (MkWithT With m a aff) = forall k (m :: k -> Type) a. With m a -> WithT m a MkWithT forall a b. (a -> b) -> a -> b $ \b -> m r bf -> With m a aff forall a b. (a -> b) -> a -> b $ b -> m r bf forall {k} (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k). Category cat => cat b c -> cat a b -> cat a c . a -> b ab instance TransConstraint Functor WithT where hasTransConstraint :: forall (m :: Type -> Type). Functor m => Dict (Functor (WithT m)) hasTransConstraint = forall (a :: Constraint). a => Dict a Dict instance Applicative (WithT m) where pure :: forall a. a -> WithT m a pure a a = forall k (m :: k -> Type) a. With m a -> WithT m a MkWithT forall a b. (a -> b) -> a -> b $ \a -> m r af -> a -> m r af a a MkWithT With m (a -> b) f <*> :: forall a b. WithT m (a -> b) -> WithT m a -> WithT m b <*> MkWithT With m a x = forall k (m :: k -> Type) a. With m a -> WithT m a MkWithT forall a b. (a -> b) -> a -> b $ \b -> m r bf -> With m (a -> b) f forall a b. (a -> b) -> a -> b $ \a -> b ab -> With m a x (b -> m r bf forall {k} (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k). Category cat => cat b c -> cat a b -> cat a c . a -> b ab) instance TransConstraint Applicative WithT where hasTransConstraint :: forall (m :: Type -> Type). Applicative m => Dict (Applicative (WithT m)) hasTransConstraint = forall (a :: Constraint). a => Dict a Dict instance Monad (WithT m) where return :: forall a. a -> WithT m a return = forall (f :: Type -> Type) a. Applicative f => a -> f a pure MkWithT With m a m >>= :: forall a b. WithT m a -> (a -> WithT m b) -> WithT m b >>= a -> WithT m b f = forall k (m :: k -> Type) a. With m a -> WithT m a MkWithT forall a b. (a -> b) -> a -> b $ \b -> m r bf -> With m a m (\a a -> forall k (m :: k -> Type) a. WithT m a -> With m a unWithT (a -> WithT m b f a a) b -> m r bf) instance TransConstraint Monad WithT where hasTransConstraint :: forall (m :: Type -> Type). Monad m => Dict (Monad (WithT m)) hasTransConstraint = forall (a :: Constraint). a => Dict a Dict instance MonadTrans WithT where lift :: forall (m :: Type -> Type) a. Monad m => m a -> WithT m a lift m a m = forall k (m :: k -> Type) a. With m a -> WithT m a MkWithT forall a b. (a -> b) -> a -> b $ \a -> m r af -> m a m forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b >>= a -> m r af instance MonadIO m => MonadIO (WithT m) where liftIO :: forall a. IO a -> WithT m a liftIO = forall (t :: TransKind) (m :: Type -> Type) a. (MonadTrans t, Monad m) => m a -> t m a lift forall {k} (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k). Category cat => cat b c -> cat a b -> cat a c . forall (m :: Type -> Type) a. MonadIO m => IO a -> m a liftIO instance TransConstraint MonadIO WithT where hasTransConstraint :: forall (m :: Type -> Type). MonadIO m => Dict (MonadIO (WithT m)) hasTransConstraint = forall (a :: Constraint). a => Dict a Dict instance Semigroup a => Semigroup (WithT m a) where <> :: WithT m a -> WithT m a -> WithT m a (<>) = forall (f :: Type -> Type) a b c. Applicative f => (a -> b -> c) -> f a -> f b -> f c liftA2 forall a. Semigroup a => a -> a -> a (<>) instance Monoid a => Monoid (WithT m a) where mempty :: WithT m a mempty = forall (f :: Type -> Type) a. Applicative f => a -> f a pure forall a. Monoid a => a mempty instance MonadFix m => MonadFix (WithT m) where mfix :: forall a. (a -> WithT m a) -> WithT m a mfix a -> WithT m a ama = forall k (m :: k -> Type) a. With m a -> WithT m a MkWithT forall a b. (a -> b) -> a -> b $ \a -> m r amr -> do rec (~(a olda, r r')) <- forall k (m :: k -> Type) a. WithT m a -> With m a unWithT (a -> WithT m a ama a olda) forall a b. (a -> b) -> a -> b $ \a newa -> do r r <- a -> m r amr a newa forall (m :: Type -> Type) a. Monad m => a -> m a return (a newa, r r) forall (m :: Type -> Type) a. Monad m => a -> m a return r r' instance MonadException m => MonadException (WithT m) where type Exc (WithT m) = Exc m throwExc :: forall a. Exc (WithT m) -> WithT m a throwExc Exc (WithT m) e = forall k (m :: k -> Type) a. With m a -> WithT m a MkWithT forall a b. (a -> b) -> a -> b $ \a -> m r _ -> forall (m :: Type -> Type) a. MonadException m => Exc m -> m a throwExc Exc (WithT m) e catchExc :: forall a. WithT m a -> (Exc (WithT m) -> WithT m a) -> WithT m a catchExc (MkWithT With m a afrfr) Exc (WithT m) -> WithT m a cc = forall k (m :: k -> Type) a. With m a -> WithT m a MkWithT forall a b. (a -> b) -> a -> b $ \a -> m r afr -> forall (m :: Type -> Type) a. MonadException m => m a -> (Exc m -> m a) -> m a catchExc (With m a afrfr a -> m r afr) forall a b. (a -> b) -> a -> b $ \Exc m e -> forall k (m :: k -> Type) a. WithT m a -> With m a unWithT (Exc (WithT m) -> WithT m a cc Exc m e) a -> m r afr instance MonadThrow e m => MonadThrow e (WithT m) where throw :: forall a. e -> WithT m a throw e e = forall k (m :: k -> Type) a. With m a -> WithT m a MkWithT forall a b. (a -> b) -> a -> b $ \a -> m r _ -> forall e (m :: Type -> Type) a. MonadThrow e m => e -> m a throw e e instance MonadCatch e m => MonadCatch e (WithT m) where catch :: forall a. WithT m a -> (e -> WithT m a) -> WithT m a catch (MkWithT With m a afrfr) e -> WithT m a cc = forall k (m :: k -> Type) a. With m a -> WithT m a MkWithT forall a b. (a -> b) -> a -> b $ \a -> m r afr -> forall e (m :: Type -> Type) a. MonadCatch e m => m a -> (e -> m a) -> m a catch (With m a afrfr a -> m r afr) forall a b. (a -> b) -> a -> b $ \e e -> forall k (m :: k -> Type) a. WithT m a -> With m a unWithT (e -> WithT m a cc e e) a -> m r afr unpickWithT :: forall m a. MonadCoroutine m => WithT m a -> m (a, m ()) unpickWithT :: forall (m :: Type -> Type) a. MonadCoroutine m => WithT m a -> m (a, m ()) unpickWithT (MkWithT With m a w) = forall (m :: Type -> Type) a. MonadCoroutine m => With m a -> m (a, m ()) unpickWith With m a w pickWithT :: forall m a. Monad m => m (a, m ()) -> WithT m a pickWithT :: forall (m :: Type -> Type) a. Monad m => m (a, m ()) -> WithT m a pickWithT m (a, m ()) mm = forall k (m :: k -> Type) a. With m a -> WithT m a MkWithT forall a b. (a -> b) -> a -> b $ forall (m :: Type -> Type) a. Monad m => m (a, m ()) -> With m a pickWith m (a, m ()) mm instance {-# OVERLAPPING #-} (MonadHoistIO m, MonadCoroutine m) => MonadHoistIO (WithT m) where hoistIO :: (IO --> IO) -> WithT m --> WithT m hoistIO IO --> IO f WithT m a wma = forall (m :: Type -> Type) a. Monad m => m (a, m ()) -> WithT m a pickWithT forall a b. (a -> b) -> a -> b $ forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b fmap (forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b fmap forall a b. (a -> b) -> a -> b $ forall (m :: Type -> Type). MonadHoistIO m => (IO --> IO) -> m --> m hoistIO IO --> IO f) forall a b. (a -> b) -> a -> b $ forall (m :: Type -> Type). MonadHoistIO m => (IO --> IO) -> m --> m hoistIO IO --> IO f forall a b. (a -> b) -> a -> b $ forall (m :: Type -> Type) a. MonadCoroutine m => WithT m a -> m (a, m ()) unpickWithT WithT m a wma mapWithT :: (m --> m) -> WithT m () mapWithT :: forall {k} (m :: k -> Type). (m --> m) -> WithT m () mapWithT m --> m ff = forall k (m :: k -> Type) a. With m a -> WithT m a MkWithT forall a b. (a -> b) -> a -> b $ \() -> m r uf -> m --> m ff forall a b. (a -> b) -> a -> b $ () -> m r uf () postWithT :: Monad m => m () -> WithT m () postWithT :: forall (m :: Type -> Type). Monad m => m () -> WithT m () postWithT m () mu = forall {k} (m :: k -> Type). (m --> m) -> WithT m () mapWithT forall a b. (a -> b) -> a -> b $ \m a mr -> do a r <- m a mr m () mu forall (m :: Type -> Type) a. Monad m => a -> m a return a r withTMap :: WithT m () -> m --> m withTMap :: forall {k} (m :: k -> Type). WithT m () -> m --> m withTMap (MkWithT With m () uff) m a f = With m () uff forall a b. (a -> b) -> a -> b $ \() -> m a f execMapWithT :: Monad m => m (WithT m a) -> WithT m a execMapWithT :: forall (m :: Type -> Type) a. Monad m => m (WithT m a) -> WithT m a execMapWithT m (WithT m a) ffa = forall k (m :: k -> Type) a. With m a -> WithT m a MkWithT forall a b. (a -> b) -> a -> b $ \a -> m r af -> do MkWithT With m a aff <- m (WithT m a) ffa With m a aff a -> m r af withParamRef :: forall m. Monad m => Param m --> Ref (WithT m) withParamRef :: forall (m :: Type -> Type). Monad m => Param m --> Ref (WithT m) withParamRef (Param m a param :: _ a) = let refGet :: WithT m a refGet :: WithT m a refGet = forall k (m :: k -> Type) a. With m a -> WithT m a MkWithT forall a b. (a -> b) -> a -> b $ \a -> m r afr -> do a a <- forall (m :: Type -> Type) a. Param m a -> m a paramAsk Param m a param a -> m r afr a a refPut :: a -> WithT m () refPut :: a -> WithT m () refPut a a = forall k (m :: k -> Type) a. With m a -> WithT m a MkWithT forall a b. (a -> b) -> a -> b $ \() -> m r ufr -> forall (m :: Type -> Type) a. Param m a -> a -> m --> m paramWith Param m a param a a forall a b. (a -> b) -> a -> b $ () -> m r ufr () in MkRef {WithT m a a -> WithT m () refPut :: a -> WithT m () refGet :: WithT m a refPut :: a -> WithT m () refGet :: WithT m a ..} liftWithT :: forall t m. (MonadTransUnlift t, MonadTunnelIO m) => WithT m --> WithT (t m) liftWithT :: forall (t :: TransKind) (m :: Type -> Type). (MonadTransUnlift t, MonadTunnelIO m) => WithT m --> WithT (t m) liftWithT (MkWithT With m a aff) = forall k (m :: k -> Type) a. With m a -> WithT m a MkWithT forall a b. (a -> b) -> a -> b $ \a -> t m r atf -> forall (t :: TransKind) (m :: Type -> Type) r. (MonadTransUnlift t, MonadIO m) => (Unlift MonadTunnelIO t -> m r) -> t m r liftWithUnlift forall a b. (a -> b) -> a -> b $ \Unlift MonadTunnelIO t unlift -> With m a aff forall a b. (a -> b) -> a -> b $ Unlift MonadTunnelIO t unlift forall {k} (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k). Category cat => cat b c -> cat a b -> cat a c . a -> t m r atf