{-# OPTIONS -fno-warn-orphans #-} module Control.Monad.Ology.Specific.WriterT ( module Control.Monad.Trans.Writer , module Control.Monad.Ology.Specific.WriterT ) where import Control.Monad.Ology.General import Control.Monad.Trans.Writer hiding (liftCallCC, liftCatch) import Import collect :: (Monad m, Monoid w) => WriterT w m a -> WriterT w m (a, w) collect :: forall (m :: Type -> Type) w a. (Monad m, Monoid w) => WriterT w m a -> WriterT w m (a, w) collect WriterT w m a wmr = forall (m :: Type -> Type) w a. Monad m => (w -> w) -> WriterT w m a -> WriterT w m a censor (\w _ -> forall a. Monoid a => a mempty) forall a b. (a -> b) -> a -> b $ forall (m :: Type -> Type) w a. Monad m => WriterT w m a -> WriterT w m (a, w) listen WriterT w m a wmr evalWriterT :: Monad m => WriterT w m a -> m a evalWriterT :: forall (m :: Type -> Type) w a. Monad m => WriterT w m a -> m a evalWriterT WriterT w m a wma = forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b fmap forall a b. (a, b) -> a fst forall a b. (a -> b) -> a -> b $ forall w (m :: Type -> Type) a. WriterT w m a -> m (a, w) runWriterT WriterT w m a wma instance Monoid w => TransConstraint Functor (WriterT w) where hasTransConstraint :: forall (m :: Type -> Type). Functor m => Dict (Functor (WriterT w m)) hasTransConstraint = forall (a :: Constraint). a => Dict a Dict instance Monoid w => TransConstraint Applicative (WriterT w) where hasTransConstraint :: forall (m :: Type -> Type). Applicative m => Dict (Applicative (WriterT w m)) hasTransConstraint = forall (a :: Constraint). a => Dict a Dict instance Monoid w => TransConstraint Monad (WriterT w) where hasTransConstraint :: forall (m :: Type -> Type). Monad m => Dict (Monad (WriterT w m)) hasTransConstraint = forall (a :: Constraint). a => Dict a Dict instance Monoid w => TransConstraint MonadIO (WriterT w) where hasTransConstraint :: forall (m :: Type -> Type). MonadIO m => Dict (MonadIO (WriterT w m)) hasTransConstraint = forall (a :: Constraint). a => Dict a Dict instance Monoid w => TransConstraint MonadFail (WriterT w) where hasTransConstraint :: forall (m :: Type -> Type). MonadFail m => Dict (MonadFail (WriterT w m)) hasTransConstraint = forall (a :: Constraint). a => Dict a Dict instance Monoid w => TransConstraint MonadFix (WriterT w) where hasTransConstraint :: forall (m :: Type -> Type). MonadFix m => Dict (MonadFix (WriterT w m)) hasTransConstraint = forall (a :: Constraint). a => Dict a Dict instance Monoid w => TransConstraint MonadPlus (WriterT w) where hasTransConstraint :: forall (m :: Type -> Type). MonadPlus m => Dict (MonadPlus (WriterT w m)) hasTransConstraint = forall (a :: Constraint). a => Dict a Dict instance (MonadExtract m, Monoid w) => MonadExtract (WriterT w m) where mToValue :: Extract (WriterT w m) mToValue (WriterT m (a, w) maw) = forall a b. (a, b) -> a fst forall a b. (a -> b) -> a -> b $ forall (m :: Type -> Type). MonadExtract m => Extract m mToValue m (a, w) maw instance Monoid w => TransConstraint MonadExtract (WriterT w) where hasTransConstraint :: forall (m :: Type -> Type). MonadExtract m => Dict (MonadExtract (WriterT w m)) hasTransConstraint = forall (a :: Constraint). a => Dict a Dict instance (MonadInner m, Monoid w) => MonadInner (WriterT w m) where retrieveInner :: forall a. WriterT w m a -> Result (Exc (WriterT w m)) a retrieveInner (WriterT m (a, w) maw) = forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b fmap forall a b. (a, b) -> a fst forall a b. (a -> b) -> a -> b $ forall (m :: Type -> Type) a. MonadInner m => m a -> Result (Exc m) a retrieveInner m (a, w) maw instance Monoid w => TransConstraint MonadInner (WriterT w) where hasTransConstraint :: forall (m :: Type -> Type). MonadInner m => Dict (MonadInner (WriterT w m)) hasTransConstraint = forall (a :: Constraint). a => Dict a Dict instance Monoid w => MonadTransCoerce (WriterT w) where transCoerce :: forall (m1 :: Type -> Type) (m2 :: Type -> Type). Coercible m1 m2 => Dict (Coercible (WriterT w m1) (WriterT w m2)) transCoerce = forall (a :: Constraint). a => Dict a Dict instance (Monoid w, MonadException m) => MonadException (WriterT w m) where type Exc (WriterT w m) = Exc m throwExc :: forall a. Exc (WriterT w m) -> WriterT w m a throwExc Exc (WriterT w m) e = forall (t :: TransKind) (m :: Type -> Type) a. (MonadTrans t, Monad m) => m a -> t m a lift forall a b. (a -> b) -> a -> b $ forall (m :: Type -> Type) a. MonadException m => Exc m -> m a throwExc Exc (WriterT w m) e catchExc :: forall a. WriterT w m a -> (Exc (WriterT w m) -> WriterT w m a) -> WriterT w m a catchExc WriterT w m a tma Exc (WriterT w m) -> WriterT w m a handler = forall (t :: TransKind) (m :: Type -> Type) r. (MonadTransTunnel t, Monad m) => ((forall (m1 :: Type -> Type) a. Monad m1 => t m1 a -> m1 (Tunnel t a)) -> m (Tunnel t r)) -> t m r tunnel forall a b. (a -> b) -> a -> b $ \forall (m1 :: Type -> Type) a. Monad m1 => WriterT w m1 a -> m1 (Tunnel (WriterT w) a) unlift -> forall (m :: Type -> Type) a. MonadException m => m a -> (Exc m -> m a) -> m a catchExc (forall (m1 :: Type -> Type) a. Monad m1 => WriterT w m1 a -> m1 (Tunnel (WriterT w) a) unlift WriterT w m a tma) forall a b. (a -> b) -> a -> b $ \Exc m e -> forall (m1 :: Type -> Type) a. Monad m1 => WriterT w m1 a -> m1 (Tunnel (WriterT w) a) unlift forall a b. (a -> b) -> a -> b $ Exc (WriterT w m) -> WriterT w m a handler Exc m e instance Monoid w => TransConstraint MonadException (WriterT w) where hasTransConstraint :: forall (m :: Type -> Type). MonadException m => Dict (MonadException (WriterT w m)) hasTransConstraint = forall (a :: Constraint). a => Dict a Dict instance (MonadThrow e m, Monoid w) => MonadThrow e (WriterT w m) where throw :: forall a. e -> WriterT w m a throw e e = forall (t :: TransKind) (m :: Type -> Type) a. (MonadTrans t, Monad m) => m a -> t m a lift forall a b. (a -> b) -> a -> b $ forall e (m :: Type -> Type) a. MonadThrow e m => e -> m a throw e e instance Monoid w => TransConstraint (MonadThrow e) (WriterT w) where hasTransConstraint :: forall (m :: Type -> Type). MonadThrow e m => Dict (MonadThrow e (WriterT w m)) hasTransConstraint = forall (a :: Constraint). a => Dict a Dict instance (MonadCatch e m, Monoid w) => MonadCatch e (WriterT w m) where catch :: forall a. WriterT w m a -> (e -> WriterT w m a) -> WriterT w m a catch WriterT w m a ma e -> WriterT w m a handler = forall (t :: TransKind) (m :: Type -> Type) r. (MonadTransTunnel t, Monad m) => ((forall (m1 :: Type -> Type) a. Monad m1 => t m1 a -> m1 (Tunnel t a)) -> m (Tunnel t r)) -> t m r tunnel forall a b. (a -> b) -> a -> b $ \forall (m1 :: Type -> Type) a. Monad m1 => WriterT w m1 a -> m1 (Tunnel (WriterT w) a) unlift -> forall e (m :: Type -> Type) a. MonadCatch e m => m a -> (e -> m a) -> m a catch (forall (m1 :: Type -> Type) a. Monad m1 => WriterT w m1 a -> m1 (Tunnel (WriterT w) a) unlift WriterT w m a ma) forall a b. (a -> b) -> a -> b $ \e e -> forall (m1 :: Type -> Type) a. Monad m1 => WriterT w m1 a -> m1 (Tunnel (WriterT w) a) unlift forall a b. (a -> b) -> a -> b $ e -> WriterT w m a handler e e instance Monoid w => TransConstraint (MonadCatch e) (WriterT w) where hasTransConstraint :: forall (m :: Type -> Type). MonadCatch e m => Dict (MonadCatch e (WriterT w m)) hasTransConstraint = forall (a :: Constraint). a => Dict a Dict instance Monoid w => MonadTransHoist (WriterT w) where hoist :: forall (m1 :: Type -> Type) (m2 :: Type -> Type). (Monad m1, Monad m2) => (m1 --> m2) -> WriterT w m1 --> WriterT w m2 hoist = forall (t :: TransKind) (m1 :: Type -> Type) (m2 :: Type -> Type). (MonadTransTunnel t, Monad m1, Monad m2) => (m1 --> m2) -> t m1 --> t m2 tunnelHoist instance Monoid w => MonadTransTunnel (WriterT w) where type Tunnel (WriterT w) = (,) w tunnel :: forall (m :: Type -> Type) r. Monad m => ((forall (m1 :: Type -> Type) a. Monad m1 => WriterT w m1 a -> m1 (Tunnel (WriterT w) a)) -> m (Tunnel (WriterT w) r)) -> WriterT w m r tunnel (forall (m1 :: Type -> Type) a. Monad m1 => WriterT w m1 a -> m1 (Tunnel (WriterT w) a)) -> m (Tunnel (WriterT w) r) call = forall w (m :: Type -> Type) a. m (a, w) -> WriterT w m a WriterT forall a b. (a -> b) -> a -> b $ forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b fmap forall a b. (a, b) -> (b, a) swap forall a b. (a -> b) -> a -> b $ (forall (m1 :: Type -> Type) a. Monad m1 => WriterT w m1 a -> m1 (Tunnel (WriterT w) a)) -> m (Tunnel (WriterT w) r) call forall a b. (a -> b) -> a -> b $ \(WriterT m1 (a, w) mrs) -> forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b fmap forall a b. (a, b) -> (b, a) swap forall a b. (a -> b) -> a -> b $ m1 (a, w) mrs instance Monoid w => MonadTransUnlift (WriterT w) where liftWithUnlift :: forall (m :: Type -> Type) r. MonadIO m => (Unlift MonadTunnelIO (WriterT w) -> m r) -> WriterT w m r liftWithUnlift Unlift MonadTunnelIO (WriterT w) -> m r call = do MVar w var <- forall (m :: Type -> Type) a. MonadIO m => IO a -> m a liftIO forall a b. (a -> b) -> a -> b $ forall a. a -> IO (MVar a) newMVar forall a. Monoid a => a mempty r r <- forall (t :: TransKind) (m :: Type -> Type) a. (MonadTrans t, Monad m) => m a -> t m a lift forall a b. (a -> b) -> a -> b $ Unlift MonadTunnelIO (WriterT w) -> m r call forall a b. (a -> b) -> a -> b $ \(WriterT m (a, w) mrs) -> do (a r, w output) <- m (a, w) mrs forall (m :: Type -> Type) a. MonadIO m => IO a -> m a liftIO forall a b. (a -> b) -> a -> b $ forall a. MVar a -> (a -> IO a) -> IO () modifyMVar_ MVar w var forall a b. (a -> b) -> a -> b $ \w oldoutput -> forall (m :: Type -> Type) a. Monad m => a -> m a return forall a b. (a -> b) -> a -> b $ forall a. Monoid a => a -> a -> a mappend w oldoutput w output forall (m :: Type -> Type) a. Monad m => a -> m a return a r w totaloutput <- forall (m :: Type -> Type) a. MonadIO m => IO a -> m a liftIO forall a b. (a -> b) -> a -> b $ forall a. MVar a -> IO a takeMVar MVar w var forall (m :: Type -> Type) w. Monad m => w -> WriterT w m () tell w totaloutput forall (m :: Type -> Type) a. Monad m => a -> m a return r r