{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PolyKinds #-}
-----------------------------------------------------------------------------
-- |
-- Copyright   :  (C) 2011-2016 Edward Kmett
-- License     :  BSD-style (see the file LICENSE)
--
-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
-- Stability   :  provisional
-- Portability :  non-portable (rank-2 polymorphism)
--
-- Monads from Comonads
--
-- <http://comonad.com/reader/2011/monads-from-comonads/>
--
-- 'Co' can be viewed as a right Kan lift along a 'Comonad'.
--
-- In general you can \"sandwich\" a monad in between two halves of an adjunction.
-- That is to say, if you have an adjunction @F -| G : C -> D @ then not only does @GF@
-- form a monad, but @GMF@ forms a monad for @M@ a monad in @D@. Therefore if we
-- have an adjunction @F -| G : Hask -> Hask^op@ then we can lift a 'Comonad' in @Hask@
-- which is a 'Monad' in @Hask^op@ to a 'Monad' in 'Hask'.
--
-- For any @r@, the 'Contravariant' functor / presheaf @(-> r)@ :: Hask^op -> Hask is adjoint to the \"same\"
-- 'Contravariant' functor @(-> r) :: Hask -> Hask^op@. So we can sandwich a
-- Monad in Hask^op in the middle to obtain @w (a -> r-) -> r+@, and then take a coend over
-- @r@ to obtain @forall r. w (a -> r) -> r@. This gives rise to 'Co'. If we observe that
-- we didn't care what the choices we made for @r@ were to finish this construction, we can
-- upgrade to @forall r. w (a -> m r) -> m r@ in a manner similar to how @ContT@ is constructed
-- yielding 'CoT'.
--
-- We could consider unifying the definition of 'Co' and 'Rift', but
-- there are many other arguments for which 'Rift' can form a 'Monad', and this
-- wouldn't give rise to 'CoT'.
----------------------------------------------------------------------------
module Control.Monad.Co
  (
  -- * Monads from Comonads
    Co, co, runCo
  -- * Monad Transformers from Comonads
  , CoT(..)
  -- * Klesili from CoKleisli
  , liftCoT0, liftCoT0M, lowerCoT0, lowerCo0
  , liftCoT1, liftCoT1M, lowerCoT1, lowerCo1
  , diter, dctrlM
  , posW, peekW, peeksW
  , askW, asksW, traceW
  )where

import Control.Comonad
import Control.Comonad.Cofree
import Control.Comonad.Density
import Control.Comonad.Env.Class as Env
import Control.Comonad.Store.Class
import Control.Comonad.Traced.Class as Traced
import Control.Monad ((<=<), liftM)
import Control.Monad.Error.Class
import qualified Control.Monad.Fail as Fail
import Control.Monad.IO.Class
import Control.Monad.Identity (Identity(..))
import Control.Monad.Reader.Class as Reader
import Control.Monad.State.Class
import Control.Monad.Trans.Class
import Control.Monad.Writer.Class as Writer
import Data.Functor.Bind
import Data.Functor.Extend

type Co w = CoT w Identity

co :: Functor w => (forall r. w (a -> r) -> r) -> Co w a
co :: forall (w :: * -> *) a.
Functor w =>
(forall r. w (a -> r) -> r) -> Co w a
co forall r. w (a -> r) -> r
f = (forall r. w (a -> Identity r) -> Identity r) -> CoT w Identity a
forall {k} (w :: * -> *) (m :: k -> *) a.
(forall (r :: k). w (a -> m r) -> m r) -> CoT w m a
CoT (r -> Identity r
forall a. a -> Identity a
Identity (r -> Identity r)
-> (w (a -> Identity r) -> r) -> w (a -> Identity r) -> Identity r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. w (a -> r) -> r
forall r. w (a -> r) -> r
f (w (a -> r) -> r)
-> (w (a -> Identity r) -> w (a -> r)) -> w (a -> Identity r) -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a -> Identity r) -> a -> r) -> w (a -> Identity r) -> w (a -> r)
forall a b. (a -> b) -> w a -> w b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Identity r -> r) -> (a -> Identity r) -> a -> r
forall a b. (a -> b) -> (a -> a) -> a -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Identity r -> r
forall a. Identity a -> a
runIdentity))

runCo :: Functor w => Co w a -> w (a -> r) -> r
runCo :: forall (w :: * -> *) a r. Functor w => Co w a -> w (a -> r) -> r
runCo Co w a
m = Identity r -> r
forall a. Identity a -> a
runIdentity (Identity r -> r) -> (w (a -> r) -> Identity r) -> w (a -> r) -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Co w a -> forall r. w (a -> Identity r) -> Identity r
forall {k} (w :: * -> *) (m :: k -> *) a.
CoT w m a -> forall (r :: k). w (a -> m r) -> m r
runCoT Co w a
m (w (a -> Identity r) -> Identity r)
-> (w (a -> r) -> w (a -> Identity r)) -> w (a -> r) -> Identity r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a -> r) -> a -> Identity r) -> w (a -> r) -> w (a -> Identity r)
forall a b. (a -> b) -> w a -> w b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((r -> Identity r) -> (a -> r) -> a -> Identity r
forall a b. (a -> b) -> (a -> a) -> a -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap r -> Identity r
forall a. a -> Identity a
Identity)

-- |
-- @
-- 'Co' w a ~ 'Data.Functor.Kan.Rift.Rift' w 'Identity' a
-- @
newtype CoT w m a = CoT { forall {k} (w :: * -> *) (m :: k -> *) a.
CoT w m a -> forall (r :: k). w (a -> m r) -> m r
runCoT :: forall r. w (a -> m r) -> m r }

instance Functor w => Functor (CoT w m) where
  fmap :: forall a b. (a -> b) -> CoT w m a -> CoT w m b
fmap a -> b
f (CoT forall (r :: k). w (a -> m r) -> m r
w) = (forall (r :: k). w (b -> m r) -> m r) -> CoT w m b
forall {k} (w :: * -> *) (m :: k -> *) a.
(forall (r :: k). w (a -> m r) -> m r) -> CoT w m a
CoT (w (a -> m r) -> m r
forall (r :: k). w (a -> m r) -> m r
w (w (a -> m r) -> m r)
-> (w (b -> m r) -> w (a -> m r)) -> w (b -> m r) -> m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((b -> m r) -> a -> m r) -> w (b -> m r) -> w (a -> m r)
forall a b. (a -> b) -> w a -> w b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((b -> m r) -> (a -> b) -> a -> m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f))

instance Extend w => Apply (CoT w m) where
  CoT w m (a -> b)
mf <.> :: forall a b. CoT w m (a -> b) -> CoT w m a -> CoT w m b
<.> CoT w m a
ma = CoT w m (a -> b)
mf CoT w m (a -> b) -> ((a -> b) -> CoT w m b) -> CoT w m b
forall a b. CoT w m a -> (a -> CoT w m b) -> CoT w m b
forall (m :: * -> *) a b. Bind m => m a -> (a -> m b) -> m b
>>- \a -> b
f -> (a -> b) -> CoT w m a -> CoT w m b
forall a b. (a -> b) -> CoT w m a -> CoT w m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f CoT w m a
ma

instance Extend w => Bind (CoT w m) where
  CoT forall (r :: k). w (a -> m r) -> m r
k >>- :: forall a b. CoT w m a -> (a -> CoT w m b) -> CoT w m b
>>- a -> CoT w m b
f = (forall (r :: k). w (b -> m r) -> m r) -> CoT w m b
forall {k} (w :: * -> *) (m :: k -> *) a.
(forall (r :: k). w (a -> m r) -> m r) -> CoT w m a
CoT (w (a -> m r) -> m r
forall (r :: k). w (a -> m r) -> m r
k (w (a -> m r) -> m r)
-> (w (b -> m r) -> w (a -> m r)) -> w (b -> m r) -> m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (w (b -> m r) -> a -> m r) -> w (b -> m r) -> w (a -> m r)
forall a b. (w a -> b) -> w a -> w b
forall (w :: * -> *) a b. Extend w => (w a -> b) -> w a -> w b
extended (\w (b -> m r)
wa a
a -> CoT w m b -> forall (r :: k). w (b -> m r) -> m r
forall {k} (w :: * -> *) (m :: k -> *) a.
CoT w m a -> forall (r :: k). w (a -> m r) -> m r
runCoT (a -> CoT w m b
f a
a) w (b -> m r)
wa))

instance Comonad w => Applicative (CoT w m) where
  pure :: forall a. a -> CoT w m a
pure a
a = (forall (r :: k). w (a -> m r) -> m r) -> CoT w m a
forall {k} (w :: * -> *) (m :: k -> *) a.
(forall (r :: k). w (a -> m r) -> m r) -> CoT w m a
CoT (w (a -> m r) -> a -> m r
forall a. w a -> a
forall (w :: * -> *) a. Comonad w => w a -> a
`extract` a
a)
  CoT w m (a -> b)
mf <*> :: forall a b. CoT w m (a -> b) -> CoT w m a -> CoT w m b
<*> CoT w m a
ma = CoT w m (a -> b)
mf CoT w m (a -> b) -> ((a -> b) -> CoT w m b) -> CoT w m b
forall a b. CoT w m a -> (a -> CoT w m b) -> CoT w m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a -> b
f -> (a -> b) -> CoT w m a -> CoT w m b
forall a b. (a -> b) -> CoT w m a -> CoT w m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f CoT w m a
ma

instance Comonad w => Monad (CoT w m) where
  return :: forall a. a -> CoT w m a
return = a -> CoT w m a
forall a. a -> CoT w m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  CoT forall (r :: k). w (a -> m r) -> m r
k >>= :: forall a b. CoT w m a -> (a -> CoT w m b) -> CoT w m b
>>= a -> CoT w m b
f = (forall (r :: k). w (b -> m r) -> m r) -> CoT w m b
forall {k} (w :: * -> *) (m :: k -> *) a.
(forall (r :: k). w (a -> m r) -> m r) -> CoT w m a
CoT (w (a -> m r) -> m r
forall (r :: k). w (a -> m r) -> m r
k (w (a -> m r) -> m r)
-> (w (b -> m r) -> w (a -> m r)) -> w (b -> m r) -> m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (w (b -> m r) -> a -> m r) -> w (b -> m r) -> w (a -> m r)
forall a b. (w a -> b) -> w a -> w b
forall (w :: * -> *) a b. Comonad w => (w a -> b) -> w a -> w b
extend (\w (b -> m r)
wa a
a -> CoT w m b -> forall (r :: k). w (b -> m r) -> m r
forall {k} (w :: * -> *) (m :: k -> *) a.
CoT w m a -> forall (r :: k). w (a -> m r) -> m r
runCoT (a -> CoT w m b
f a
a) w (b -> m r)
wa))

instance (Comonad w, Fail.MonadFail m) => Fail.MonadFail (CoT w m) where
  fail :: forall a. String -> CoT w m a
fail String
msg = (forall r. w (a -> m r) -> m r) -> CoT w m a
forall {k} (w :: * -> *) (m :: k -> *) a.
(forall (r :: k). w (a -> m r) -> m r) -> CoT w m a
CoT ((forall r. w (a -> m r) -> m r) -> CoT w m a)
-> (forall r. w (a -> m r) -> m r) -> CoT w m a
forall a b. (a -> b) -> a -> b
$ \ w (a -> m r)
_ -> String -> m r
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail String
msg

instance Comonad w => MonadTrans (CoT w) where
  lift :: forall (m :: * -> *) a. Monad m => m a -> CoT w m a
lift m a
m = (forall r. w (a -> m r) -> m r) -> CoT w m a
forall {k} (w :: * -> *) (m :: k -> *) a.
(forall (r :: k). w (a -> m r) -> m r) -> CoT w m a
CoT (w (m r) -> m r
forall a. w a -> a
forall (w :: * -> *) a. Comonad w => w a -> a
extract (w (m r) -> m r)
-> (w (a -> m r) -> w (m r)) -> w (a -> m r) -> m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a -> m r) -> m r) -> w (a -> m r) -> w (m r)
forall a b. (a -> b) -> w a -> w b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (m a
m m a -> (a -> m r) -> m r
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=))

instance (Comonad w, MonadIO m) => MonadIO (CoT w m) where
  liftIO :: forall a. IO a -> CoT w m a
liftIO = m a -> CoT w m a
forall (m :: * -> *) a. Monad m => m a -> CoT w m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> CoT w m a) -> (IO a -> m a) -> IO a -> CoT w m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> m a
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO

liftCoT0 :: Comonad w => (forall a. w a -> s) -> CoT w m s
liftCoT0 :: forall {k} (w :: * -> *) s (m :: k -> *).
Comonad w =>
(forall a. w a -> s) -> CoT w m s
liftCoT0 forall a. w a -> s
f = (forall (r :: k). w (s -> m r) -> m r) -> CoT w m s
forall {k} (w :: * -> *) (m :: k -> *) a.
(forall (r :: k). w (a -> m r) -> m r) -> CoT w m a
CoT (w (s -> m r) -> s -> m r
forall a. w a -> a
forall (w :: * -> *) a. Comonad w => w a -> a
extract (w (s -> m r) -> s -> m r)
-> (w (s -> m r) -> s) -> w (s -> m r) -> m r
forall a b.
(w (s -> m r) -> a -> b)
-> (w (s -> m r) -> a) -> w (s -> m r) -> b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> w (s -> m r) -> s
forall a. w a -> s
f)

lowerCoT0 :: (Functor w, Monad m) => CoT w m s -> w a -> m s
lowerCoT0 :: forall (w :: * -> *) (m :: * -> *) s a.
(Functor w, Monad m) =>
CoT w m s -> w a -> m s
lowerCoT0 CoT w m s
m = CoT w m s -> forall r. w (s -> m r) -> m r
forall {k} (w :: * -> *) (m :: k -> *) a.
CoT w m a -> forall (r :: k). w (a -> m r) -> m r
runCoT CoT w m s
m (w (s -> m s) -> m s) -> (w a -> w (s -> m s)) -> w a -> m s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (s -> m s
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (s -> m s) -> w a -> w (s -> m s)
forall a b. a -> w b -> w a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$)

lowerCo0 :: Functor w => Co w s -> w a -> s
lowerCo0 :: forall (w :: * -> *) s a. Functor w => Co w s -> w a -> s
lowerCo0 Co w s
m = Identity s -> s
forall a. Identity a -> a
runIdentity (Identity s -> s) -> (w a -> Identity s) -> w a -> s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Co w s -> forall r. w (s -> Identity r) -> Identity r
forall {k} (w :: * -> *) (m :: k -> *) a.
CoT w m a -> forall (r :: k). w (a -> m r) -> m r
runCoT Co w s
m (w (s -> Identity s) -> Identity s)
-> (w a -> w (s -> Identity s)) -> w a -> Identity s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (s -> Identity s
forall a. a -> Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (s -> Identity s) -> w a -> w (s -> Identity s)
forall a b. a -> w b -> w a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$)

liftCoT1 :: (forall a. w a -> a) -> CoT w m ()
liftCoT1 :: forall {k} (w :: * -> *) (m :: k -> *).
(forall a. w a -> a) -> CoT w m ()
liftCoT1 forall a. w a -> a
f = (forall (r :: k). w (() -> m r) -> m r) -> CoT w m ()
forall {k} (w :: * -> *) (m :: k -> *) a.
(forall (r :: k). w (a -> m r) -> m r) -> CoT w m a
CoT (w (() -> m r) -> () -> m r
forall a. w a -> a
`f` ())

lowerCoT1 :: (Functor w, Monad m) => CoT w m () -> w a -> m a
lowerCoT1 :: forall (w :: * -> *) (m :: * -> *) a.
(Functor w, Monad m) =>
CoT w m () -> w a -> m a
lowerCoT1 CoT w m ()
m = CoT w m () -> forall r. w (() -> m r) -> m r
forall {k} (w :: * -> *) (m :: k -> *) a.
CoT w m a -> forall (r :: k). w (a -> m r) -> m r
runCoT CoT w m ()
m (w (() -> m a) -> m a) -> (w a -> w (() -> m a)) -> w a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> () -> m a) -> w a -> w (() -> m a)
forall a b. (a -> b) -> w a -> w b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (m a -> () -> m a
forall a b. a -> b -> a
const (m a -> () -> m a) -> (a -> m a) -> a -> () -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return)

lowerCo1 :: Functor w => Co w () -> w a -> a
lowerCo1 :: forall (w :: * -> *) a. Functor w => Co w () -> w a -> a
lowerCo1 Co w ()
m = Identity a -> a
forall a. Identity a -> a
runIdentity (Identity a -> a) -> (w a -> Identity a) -> w a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Co w () -> forall r. w (() -> Identity r) -> Identity r
forall {k} (w :: * -> *) (m :: k -> *) a.
CoT w m a -> forall (r :: k). w (a -> m r) -> m r
runCoT Co w ()
m (w (() -> Identity a) -> Identity a)
-> (w a -> w (() -> Identity a)) -> w a -> Identity a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> () -> Identity a) -> w a -> w (() -> Identity a)
forall a b. (a -> b) -> w a -> w b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Identity a -> () -> Identity a
forall a b. a -> b -> a
const (Identity a -> () -> Identity a)
-> (a -> Identity a) -> a -> () -> Identity a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Identity a
forall a. a -> Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return)

posW :: ComonadStore s w => CoT w m s
posW :: forall {k} s (w :: * -> *) (m :: k -> *).
ComonadStore s w =>
CoT w m s
posW = (forall a. w a -> s) -> CoT w m s
forall {k} (w :: * -> *) s (m :: k -> *).
Comonad w =>
(forall a. w a -> s) -> CoT w m s
liftCoT0 w a -> s
forall a. w a -> s
forall s (w :: * -> *) a. ComonadStore s w => w a -> s
pos

peekW :: ComonadStore s w => s -> CoT w m ()
peekW :: forall {k} s (w :: * -> *) (m :: k -> *).
ComonadStore s w =>
s -> CoT w m ()
peekW s
s = (forall a. w a -> a) -> CoT w m ()
forall {k} (w :: * -> *) (m :: k -> *).
(forall a. w a -> a) -> CoT w m ()
liftCoT1 (s -> w a -> a
forall a. s -> w a -> a
forall s (w :: * -> *) a. ComonadStore s w => s -> w a -> a
peek s
s)

peeksW :: ComonadStore s w => (s -> s) -> CoT w m ()
peeksW :: forall {k} s (w :: * -> *) (m :: k -> *).
ComonadStore s w =>
(s -> s) -> CoT w m ()
peeksW s -> s
f = (forall a. w a -> a) -> CoT w m ()
forall {k} (w :: * -> *) (m :: k -> *).
(forall a. w a -> a) -> CoT w m ()
liftCoT1 ((s -> s) -> w a -> a
forall a. (s -> s) -> w a -> a
forall s (w :: * -> *) a. ComonadStore s w => (s -> s) -> w a -> a
peeks s -> s
f)

askW :: ComonadEnv e w => CoT w m e
askW :: forall {k} e (w :: * -> *) (m :: k -> *).
ComonadEnv e w =>
CoT w m e
askW = (forall a. w a -> e) -> CoT w m e
forall {k} (w :: * -> *) s (m :: k -> *).
Comonad w =>
(forall a. w a -> s) -> CoT w m s
liftCoT0 (w a -> e
forall a. w a -> e
forall e (w :: * -> *) a. ComonadEnv e w => w a -> e
Env.ask)

asksW :: ComonadEnv e w => (e -> a) -> CoT w m a
asksW :: forall {k} e (w :: * -> *) a (m :: k -> *).
ComonadEnv e w =>
(e -> a) -> CoT w m a
asksW e -> a
f = (forall a. w a -> a) -> CoT w m a
forall {k} (w :: * -> *) s (m :: k -> *).
Comonad w =>
(forall a. w a -> s) -> CoT w m s
liftCoT0 ((e -> a) -> w a -> a
forall e (w :: * -> *) e' a.
ComonadEnv e w =>
(e -> e') -> w a -> e'
Env.asks e -> a
f)

traceW :: ComonadTraced e w => e -> CoT w m ()
traceW :: forall {k} e (w :: * -> *) (m :: k -> *).
ComonadTraced e w =>
e -> CoT w m ()
traceW e
e = (forall a. w a -> a) -> CoT w m ()
forall {k} (w :: * -> *) (m :: k -> *).
(forall a. w a -> a) -> CoT w m ()
liftCoT1 (e -> w a -> a
forall a. e -> w a -> a
forall m (w :: * -> *) a. ComonadTraced m w => m -> w a -> a
Traced.trace e
e)

liftCoT0M :: (Comonad w, Monad m) => (forall a. w a -> m s) -> CoT w m s
liftCoT0M :: forall (w :: * -> *) (m :: * -> *) s.
(Comonad w, Monad m) =>
(forall a. w a -> m s) -> CoT w m s
liftCoT0M forall a. w a -> m s
f = (forall r. w (s -> m r) -> m r) -> CoT w m s
forall {k} (w :: * -> *) (m :: k -> *) a.
(forall (r :: k). w (a -> m r) -> m r) -> CoT w m a
CoT (\w (s -> m r)
wa -> w (s -> m r) -> s -> m r
forall a. w a -> a
forall (w :: * -> *) a. Comonad w => w a -> a
extract w (s -> m r)
wa (s -> m r) -> m s -> m r
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< w (s -> m r) -> m s
forall a. w a -> m s
f w (s -> m r)
wa)

liftCoT1M :: Monad m => (forall a. w a -> m a) -> CoT w m ()
liftCoT1M :: forall (m :: * -> *) (w :: * -> *).
Monad m =>
(forall a. w a -> m a) -> CoT w m ()
liftCoT1M forall a. w a -> m a
f = (forall r. w (() -> m r) -> m r) -> CoT w m ()
forall {k} (w :: * -> *) (m :: k -> *) a.
(forall (r :: k). w (a -> m r) -> m r) -> CoT w m a
CoT (((() -> m r) -> () -> m r
forall a b. (a -> b) -> a -> b
$ ()) ((() -> m r) -> m r)
-> (w (() -> m r) -> m (() -> m r)) -> w (() -> m r) -> m r
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< w (() -> m r) -> m (() -> m r)
forall a. w a -> m a
f)

diter :: Functor f => a -> (a -> f a) -> Density (Cofree f) a
diter :: forall (f :: * -> *) a.
Functor f =>
a -> (a -> f a) -> Density (Cofree f) a
diter a
x a -> f a
y = Cofree f a -> Density (Cofree f) a
forall (w :: * -> *) a. Comonad w => w a -> Density w a
liftDensity (Cofree f a -> Density (Cofree f) a)
-> (a -> Cofree f a) -> a -> Density (Cofree f) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> f a) -> a -> Cofree f a
forall (f :: * -> *) a. Functor f => (a -> f a) -> a -> Cofree f a
coiter a -> f a
y (a -> Density (Cofree f) a) -> a -> Density (Cofree f) a
forall a b. (a -> b) -> a -> b
$ a
x

dctrlM :: Monad m => (forall a. w a -> m (w a)) -> CoT (Density w) m ()
dctrlM :: forall {k} (m :: * -> *) (w :: k -> *).
Monad m =>
(forall (a :: k). w a -> m (w a)) -> CoT (Density w) m ()
dctrlM forall (a :: k). w a -> m (w a)
k = (forall a. Density w a -> m a) -> CoT (Density w) m ()
forall (m :: * -> *) (w :: * -> *).
Monad m =>
(forall a. w a -> m a) -> CoT w m ()
liftCoT1M (\(Density w b -> a
w w b
a) -> (w b -> a) -> m (w b) -> m a
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM w b -> a
w (w b -> m (w b)
forall (a :: k). w a -> m (w a)
k w b
a))

instance (Comonad w, MonadReader e m) => MonadReader e (CoT w m) where
  ask :: CoT w m e
ask = m e -> CoT w m e
forall (m :: * -> *) a. Monad m => m a -> CoT w m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m e
forall r (m :: * -> *). MonadReader r m => m r
Reader.ask
  local :: forall a. (e -> e) -> CoT w m a -> CoT w m a
local e -> e
f CoT w m a
m = (forall r. w (a -> m r) -> m r) -> CoT w m a
forall {k} (w :: * -> *) (m :: k -> *) a.
(forall (r :: k). w (a -> m r) -> m r) -> CoT w m a
CoT ((e -> e) -> m r -> m r
forall a. (e -> e) -> m a -> m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local e -> e
f (m r -> m r) -> (w (a -> m r) -> m r) -> w (a -> m r) -> m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CoT w m a -> forall r. w (a -> m r) -> m r
forall {k} (w :: * -> *) (m :: k -> *) a.
CoT w m a -> forall (r :: k). w (a -> m r) -> m r
runCoT CoT w m a
m)

instance (Comonad w, MonadState s m) => MonadState s (CoT w m) where
  get :: CoT w m s
get = m s -> CoT w m s
forall (m :: * -> *) a. Monad m => m a -> CoT w m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m s
forall s (m :: * -> *). MonadState s m => m s
get
  put :: s -> CoT w m ()
put = m () -> CoT w m ()
forall (m :: * -> *) a. Monad m => m a -> CoT w m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> CoT w m ()) -> (s -> m ()) -> s -> CoT w m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put

instance (Comonad w, MonadWriter e m) => MonadWriter e (CoT w m) where
  tell :: e -> CoT w m ()
tell = m () -> CoT w m ()
forall (m :: * -> *) a. Monad m => m a -> CoT w m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> CoT w m ()) -> (e -> m ()) -> e -> CoT w m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell
  pass :: forall a. CoT w m (a, e -> e) -> CoT w m a
pass CoT w m (a, e -> e)
m = (forall r. w (a -> m r) -> m r) -> CoT w m a
forall {k} (w :: * -> *) (m :: k -> *) a.
(forall (r :: k). w (a -> m r) -> m r) -> CoT w m a
CoT (m (r, e -> e) -> m r
forall a. m (a, e -> e) -> m a
forall w (m :: * -> *) a. MonadWriter w m => m (a, w -> w) -> m a
pass (m (r, e -> e) -> m r)
-> (w (a -> m r) -> m (r, e -> e)) -> w (a -> m r) -> m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CoT w m (a, e -> e) -> forall r. w ((a, e -> e) -> m r) -> m r
forall {k} (w :: * -> *) (m :: k -> *) a.
CoT w m a -> forall (r :: k). w (a -> m r) -> m r
runCoT CoT w m (a, e -> e)
m (w ((a, e -> e) -> m (r, e -> e)) -> m (r, e -> e))
-> (w (a -> m r) -> w ((a, e -> e) -> m (r, e -> e)))
-> w (a -> m r)
-> m (r, e -> e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a -> m r) -> (a, e -> e) -> m (r, e -> e))
-> w (a -> m r) -> w ((a, e -> e) -> m (r, e -> e))
forall a b. (a -> b) -> w a -> w b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> m r) -> (a, e -> e) -> m (r, e -> e)
forall {m :: * -> *} {t} {a} {b}.
Monad m =>
(t -> m a) -> (t, b) -> m (a, b)
aug) where
    aug :: (t -> m a) -> (t, b) -> m (a, b)
aug t -> m a
f (t
a,b
e) = (a -> (a, b)) -> m a -> m (a, b)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (\a
r -> (a
r,b
e)) (t -> m a
f t
a)
  listen :: forall a. CoT w m a -> CoT w m (a, e)
listen = String -> CoT w m a -> CoT w m (a, e)
forall a. HasCallStack => String -> a
error String
"Control.Monad.Co.listen: TODO"

instance (Comonad w, MonadError e m) => MonadError e (CoT w m) where
  throwError :: forall a. e -> CoT w m a
throwError = m a -> CoT w m a
forall (m :: * -> *) a. Monad m => m a -> CoT w m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> CoT w m a) -> (e -> m a) -> e -> CoT w m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> m a
forall a. e -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
  catchError :: forall a. CoT w m a -> (e -> CoT w m a) -> CoT w m a
catchError = String -> CoT w m a -> (e -> CoT w m a) -> CoT w m a
forall a. HasCallStack => String -> a
error String
"Control.Monad.Co.catchError: TODO"