-- Hoogle documentation, generated by Haddock -- See Hoogle, http://www.haskell.org/hoogle/ -- | Comonad transformers -- -- Comonad transformers @package comonad-transformers @version 1.6.3 module Data.Functor.Composition -- | We often need to distinguish between various forms of Functor-like -- composition in Haskell in order to please the type system. This lets -- us work with these representations uniformly. class Composition o decompose :: Composition o => o f g x -> f (g x) compose :: Composition o => f (g x) -> o f g x instance Composition Compose module Data.Functor.Coproduct newtype Coproduct f g a Coproduct :: Either (f a) (g a) -> Coproduct f g a getCoproduct :: Coproduct f g a -> Either (f a) (g a) left :: f a -> Coproduct f g a right :: g a -> Coproduct f g a coproduct :: (f a -> b) -> (g a -> b) -> Coproduct f g a -> b instance (Contravariant f, Contravariant g) => Contravariant (Coproduct f g) instance (Comonad f, Comonad g) => Comonad (Coproduct f g) instance (Extend f, Extend g) => Extend (Coproduct f g) instance (Traversable1 f, Traversable1 g) => Traversable1 (Coproduct f g) instance (Traversable f, Traversable g) => Traversable (Coproduct f g) instance (Foldable1 f, Foldable1 g) => Foldable1 (Coproduct f g) instance (Foldable f, Foldable g) => Foldable (Coproduct f g) instance (Functor f, Functor g) => Functor (Coproduct f g) module Control.Comonad.Trans.Identity -- | The trivial monad transformer, which maps a monad to an equivalent -- monad. newtype IdentityT m :: (* -> *) a :: (* -> *) -> * -> * IdentityT :: m a -> IdentityT a runIdentityT :: IdentityT a -> m a module Control.Comonad.Trans.Class class ComonadTrans t lower :: (ComonadTrans t, Extend w) => t w a -> w a instance ComonadTrans IdentityT -- | Discont is the density comonad of a constant functor, just as -- Cont is a Codensity monad of a constant functor. (For the -- definition of Density and Codensity, see the non-Haskell 98 -- adjunctions package) -- -- Note that while Discont and Store are isomorphic, -- DiscontT and StoreT are not. module Control.Comonad.Trans.Discont.Lazy type Discont s = DiscontT s Identity discont :: (s -> a) -> s -> Discont s a runDiscont :: Discont s a -> (s -> a, s) data DiscontT s w a DiscontT :: (w s -> a) -> (w s) -> DiscontT s w a runDiscontT :: DiscontT s w a -> (w s -> a, w s) callCV :: DiscontT s w (DiscontT s w (DiscontT s w a -> a) -> b) -> b label :: Comonad w => DiscontT s w a -> s instance ComonadTrans (DiscontT s) instance Comonad (DiscontT s w) instance Extend (DiscontT s w) instance Functor (DiscontT s w) instance (Typeable s, Typeable1 w) => Typeable1 (DiscontT s w) -- | The discontinuation comonad transformer. This version is lazy; for a -- strict version, see Control.Comonad.Trans.Discont.Strict, which -- has the same interface. module Control.Comonad.Trans.Discont -- | Discont is the density comonad of a constant functor, just as -- Cont is a Codensity monad of a constant functor. (For the -- definition of Density and Codensity, see the non-Haskell 98 -- adjunctions package) -- -- Note that while Discont and Store are isomorphic, -- DiscontT and StoreT are not. module Control.Comonad.Trans.Discont.Strict type Discont s = DiscontT s Identity discont :: (s -> a) -> s -> Discont s a runDiscont :: Discont s a -> (s -> a, s) data DiscontT s w a DiscontT :: (w s -> a) -> (w s) -> DiscontT s w a runDiscontT :: DiscontT s w a -> (w s -> a, w s) callCV :: DiscontT s w (DiscontT s w (DiscontT s w a -> a) -> b) -> b label :: Comonad w => DiscontT s w a -> s instance ComonadTrans (DiscontT s) instance Comonad (DiscontT s w) instance Extend (DiscontT s w) instance Functor (DiscontT s w) instance (Typeable s, Typeable1 w) => Typeable1 (DiscontT s w) -- | Discont is the density comonad of a constant functor, just as -- Cont is a Codensity monad of a constant functor. (For the -- definition of Density and Codensity, see the non-Haskell 98 -- adjunctions package) -- -- Note that while Discont and Store are isomorphic, -- DiscontT and StoreT are not. -- -- Like the memoizing store comonad, version memoizes the result of -- applying the continuation to the current context. module Control.Comonad.Trans.Discont.Memo type Discont s = DiscontT s Identity discont :: (s -> a) -> s -> Discont s a runDiscont :: Discont s a -> (s -> a, s) data DiscontT s w a discontT :: (w s -> a) -> w s -> DiscontT s w a runDiscontT :: DiscontT s w a -> (w s -> a, w s) callCV :: DiscontT s w (DiscontT s w (DiscontT s w a -> a) -> b) -> b label :: Comonad w => DiscontT s w a -> s instance ComonadTrans (DiscontT s) instance Comonad (DiscontT s w) instance Extend (DiscontT s w) instance Functor (DiscontT s w) instance (Typeable s, Typeable1 w) => Typeable1 (DiscontT s w) module Control.Comonad.Hoist.Class class ComonadHoist t cohoist :: (ComonadHoist t, Comonad w) => t w a -> t Identity a instance ComonadHoist IdentityT -- | The environment comonad transformer (aka coreader). This adds an extra -- value that can be accessed in the environment. -- -- Left adjoint to the reader comonad. module Control.Comonad.Trans.Env.Lazy type Env e = EnvT e Identity env :: e -> a -> Env e a runEnv :: Env e a -> (e, a) data EnvT e w a EnvT :: e -> (w a) -> EnvT e w a runEnvT :: EnvT e w a -> (e, w a) lowerEnvT :: EnvT e w a -> w a ask :: EnvT e w a -> e asks :: (e -> f) -> EnvT e w a -> f local :: (e -> e) -> EnvT e w a -> EnvT e w a instance Traversable w => Traversable (EnvT e w) instance Foldable w => Foldable (EnvT e w) instance ComonadHoist (EnvT e) instance ComonadTrans (EnvT e) instance (Semigroup e, Apply w) => Apply (EnvT e w) instance Comonad w => Comonad (EnvT e w) instance Extend w => Extend (EnvT e w) instance Functor w => Functor (EnvT e w) instance (Data e, Typeable1 w, Data (w a), Data a) => Data (EnvT e w a) instance (Typeable s, Typeable1 w, Typeable a) => Typeable (EnvT s w a) instance (Typeable s, Typeable1 w) => Typeable1 (EnvT s w) -- | The environment comonad transformer (aka coreader). This version is -- lazy; for a strict version, see -- Control.Comonad.Trans.Env.Strict, which has the same interface. module Control.Comonad.Trans.Env -- | The environment comonad transformer (aka coreader). This adds an extra -- value that can be accessed in the environment. -- -- Left adjoint to the reader comonad. module Control.Comonad.Trans.Env.Strict type Env e = EnvT e Identity env :: e -> a -> Env e a runEnv :: Env e a -> (e, a) data EnvT e w a EnvT :: e -> (w a) -> EnvT e w a runEnvT :: EnvT e w a -> (e, w a) lowerEnvT :: EnvT e w a -> w a ask :: EnvT e w a -> e asks :: (e -> f) -> EnvT e w a -> f local :: (e -> e) -> EnvT e w a -> EnvT e w a instance Traversable w => Traversable (EnvT e w) instance Foldable w => Foldable (EnvT e w) instance (Semigroup e, Apply w) => Apply (EnvT e w) instance ComonadHoist (EnvT e) instance ComonadTrans (EnvT e) instance Comonad w => Comonad (EnvT e w) instance Extend w => Extend (EnvT e w) instance Functor w => Functor (EnvT e w) instance (Data e, Typeable1 w, Data (w a), Data a) => Data (EnvT e w a) instance (Typeable s, Typeable1 w, Typeable a) => Typeable (EnvT s w a) instance (Typeable s, Typeable1 w) => Typeable1 (EnvT s w) -- | The lazy store (state-in-context/costate) comonad transformer is -- subject to the laws: -- --
--   x = seek (pos x) x
--   y = pos (seek y x)
--   seek y x = seek y (seek z x)
--   
-- -- Thanks go to Russell O'Connor and Daniel Peebles for their help -- formulating and proving the laws for this comonad transformer. module Control.Comonad.Trans.Store.Lazy type Store s = StoreT s Identity store :: (s -> a) -> s -> Store s a runStore :: Store s a -> (s -> a, s) data StoreT s w a StoreT :: (w (s -> a)) -> s -> StoreT s w a runStoreT :: StoreT s w a -> (w (s -> a), s) -- | Read the current position pos :: StoreT s w a -> s -- | Seek to an absolute location -- --
--   seek s = peek s . duplicate
--   
seek :: Comonad w => s -> StoreT s w a -> StoreT s w a -- | Seek to a relative location -- --
--   seeks f = peeks f . duplicate
--   
seeks :: Comonad w => (s -> s) -> StoreT s w a -> StoreT s w a -- | Peek at a value at a given absolute location -- --
--   peek x . extend (peek y) = peek y
--   
peek :: Comonad w => s -> StoreT s w a -> a -- | Peek at a value at a given relative location peeks :: Comonad w => (s -> s) -> StoreT s w a -> a instance ComonadHoist (StoreT s) instance ComonadTrans (StoreT s) instance Comonad w => Comonad (StoreT s w) instance Extend w => Extend (StoreT s w) instance (Applicative w, Semigroup s, Monoid s) => Applicative (StoreT s w) instance (Apply w, Semigroup s) => Apply (StoreT s w) instance Functor w => Functor (StoreT s w) instance (Typeable s, Typeable1 w, Typeable a) => Typeable (StoreT s w a) instance (Typeable s, Typeable1 w) => Typeable1 (StoreT s w) -- | The store comonad transformer (aka costate). This version is lazy; for -- a strict version, see Control.Comonad.Trans.Store.Strict, which -- has the same interface. module Control.Comonad.Trans.Store module Data.Lens.Common newtype Lens a b Lens :: (a -> Store b a) -> Lens a b runLens :: Lens a b -> a -> Store b a -- | build a lens out of a getter and setter lens :: (a -> b) -> (b -> a -> a) -> Lens a b -- | build a lens out of an isomorphism iso :: (a -> b) -> (b -> a) -> Lens a b (^$) :: Lens a b -> a -> b -- | functional getter (^$!) :: Lens a b -> a -> b (^.) :: a -> Lens a b -> b -- | functional getter, which acts like a field accessor (^!) :: a -> Lens a b -> b (^=) :: Lens a b -> b -> a -> a -- | functional setter (^!=) :: Lens a b -> b -> a -> a (^%=) :: Lens a b -> (b -> b) -> a -> a -- | functional modify (^!%=) :: Lens a b -> (b -> b) -> a -> a -- | functorial modify (^%%=) :: Functor f => Lens a b -> (b -> f b) -> a -> f a (^+=) :: Num b => Lens a b -> b -> a -> a (^!+=) :: Num b => Lens a b -> b -> a -> a (^-=) :: Num b => Lens a b -> b -> a -> a (^!-=) :: Num b => Lens a b -> b -> a -> a (^*=) :: Num b => Lens a b -> b -> a -> a (^!*=) :: Num b => Lens a b -> b -> a -> a (^/=) :: Fractional b => Lens a b -> b -> a -> a (^!/=) :: Fractional b => Lens a b -> b -> a -> a fstLens :: Lens (a, b) a sndLens :: Lens (a, b) b mapLens :: Ord k => k -> Lens (Map k v) (Maybe v) intMapLens :: Int -> Lens (IntMap v) (Maybe v) setLens :: Ord k => k -> Lens (Set k) Bool intSetLens :: Int -> Lens IntSet Bool instance Category Lens instance Semigroupoid Lens module Data.Lens.Lazy -- | get the value of a lens into state access :: Monad m => Lens a b -> StateT a m b (~=) :: Monad m => Lens a b -> b -> StateT a m b -- | set a value using a lens into state (!=) :: Monad m => Lens a b -> b -> StateT a m b (%=) :: Monad m => Lens a b -> (b -> b) -> StateT a m b -- | infix modification a value through a lens into state (!%=) :: Monad m => Lens a b -> (b -> b) -> StateT a m b (%%=) :: Monad m => Lens a b -> (b -> (c, b)) -> StateT a m c -- | infix modification of a value through a lens into state with a -- supplemental response (!%%=) :: Monad m => Lens a b -> (b -> (c, b)) -> StateT a m c (+=) :: (Monad m, Num b) => Lens a b -> b -> StateT a m b (!+=) :: (Monad m, Num b) => Lens a b -> b -> StateT a m b (-=) :: (Monad m, Num b) => Lens a b -> b -> StateT a m b (!-=) :: (Monad m, Num b) => Lens a b -> b -> StateT a m b (*=) :: (Monad m, Num b) => Lens a b -> b -> StateT a m b (!*=) :: (Monad m, Num b) => Lens a b -> b -> StateT a m b (//=) :: (Monad m, Fractional b) => Lens a b -> b -> StateT a m b (!/=) :: (Monad m, Fractional b) => Lens a b -> b -> StateT a m b (&&=) :: Monad m => Lens a Bool -> Bool -> StateT a m Bool (!&&=) :: Monad m => Lens a Bool -> Bool -> StateT a m Bool (||=) :: Monad m => Lens a Bool -> Bool -> StateT a m Bool (!||=) :: Monad m => Lens a Bool -> Bool -> StateT a m Bool focus :: Monad m => Lens a b -> StateT b m c -> StateT a m c module Data.Lens.Strict -- | get the value of a lens into state access :: Monad m => Lens a b -> StateT a m b (~=) :: Monad m => Lens a b -> b -> StateT a m b -- | set a value using a lens into state (!=) :: Monad m => Lens a b -> b -> StateT a m b (%=) :: Monad m => Lens a b -> (b -> b) -> StateT a m b -- | infix modification a value through a lens into state (!%=) :: Monad m => Lens a b -> (b -> b) -> StateT a m b (%%=) :: Monad m => Lens a b -> (b -> (c, b)) -> StateT a m c -- | infix modification of a value through a lens into state with a -- supplemental response (!%%=) :: Monad m => Lens a b -> (b -> (c, b)) -> StateT a m c (+=) :: (Monad m, Num b) => Lens a b -> b -> StateT a m b (!+=) :: (Monad m, Num b) => Lens a b -> b -> StateT a m b (-=) :: (Monad m, Num b) => Lens a b -> b -> StateT a m b (!-=) :: (Monad m, Num b) => Lens a b -> b -> StateT a m b (*=) :: (Monad m, Num b) => Lens a b -> b -> StateT a m b (!*=) :: (Monad m, Num b) => Lens a b -> b -> StateT a m b (//=) :: (Monad m, Fractional b) => Lens a b -> b -> StateT a m b (!/=) :: (Monad m, Fractional b) => Lens a b -> b -> StateT a m b (&&=) :: Monad m => Lens a Bool -> Bool -> StateT a m Bool (!&&=) :: Monad m => Lens a Bool -> Bool -> StateT a m Bool (||=) :: Monad m => Lens a Bool -> Bool -> StateT a m Bool (!||=) :: Monad m => Lens a Bool -> Bool -> StateT a m Bool focus :: Monad m => Lens a b -> StateT b m c -> StateT a m c -- | The strict store (state-in-context/costate) comonad transformer is -- subject to the laws: -- --
--   x = seek (pos x) x
--   y = pos (seek y x)
--   seek y x = seek y (seek z x)
--   
-- -- Thanks go to Russell O'Connor and Daniel Peebles for their help -- formulating and proving the laws for this comonad transformer. module Control.Comonad.Trans.Store.Strict type Store s = StoreT s Identity store :: (s -> a) -> s -> Store s a runStore :: Store s a -> (s -> a, s) data StoreT s w a StoreT :: (w (s -> a)) -> s -> StoreT s w a runStoreT :: StoreT s w a -> (w (s -> a), s) -- | Read the current position pos :: StoreT s w a -> s -- | Seek to an absolute location -- --
--   seek s = peek s . duplicate
--   
seek :: Comonad w => s -> StoreT s w a -> StoreT s w a -- | Seek to a relative location -- --
--   seeks f = peeks f . duplicate
--   
seeks :: Comonad w => (s -> s) -> StoreT s w a -> StoreT s w a -- | Peek at a value at a given absolute location -- --
--   peek x . extend (peek y) = peek y
--   
peek :: Comonad w => s -> StoreT s w a -> a -- | Peek at a value at a given relative location peeks :: Comonad w => (s -> s) -> StoreT s w a -> a instance ComonadHoist (StoreT s) instance ComonadTrans (StoreT s) instance Comonad w => Comonad (StoreT s w) instance Extend w => Extend (StoreT s w) instance (Applicative w, Semigroup s, Monoid s) => Applicative (StoreT s w) instance (Apply w, Semigroup s) => Apply (StoreT s w) instance Functor w => Functor (StoreT s w) instance (Typeable s, Typeable1 w, Typeable a) => Typeable (StoreT s w a) instance (Typeable s, Typeable1 w) => Typeable1 (StoreT s w) -- | The memoizing store (state-in-context/costate) comonad transformer is -- subject to the laws: -- --
--   x = seek (pos x) x
--   y = pos (seek y x)
--   seek y x = seek y (seek z x)
--   
-- -- This version of the transformer lazily memoizes the result of applying -- the comonad to the current state. This can be useful for avoiding -- redundant computation if you reuse the same StoreT object multiple -- times. module Control.Comonad.Trans.Store.Memo type Store s = StoreT s Identity store :: (s -> a) -> s -> Store s a runStore :: Store s a -> (s -> a, s) data StoreT s w a storeT :: Functor w => w (s -> a) -> s -> StoreT s w a runStoreT :: StoreT s w a -> (w (s -> a), s) lowerStoreT :: StoreT s w a -> w a -- | Read the current position pos :: StoreT s w a -> s -- | Seek to an absolute location -- --
--   seek s = peek s . duplicate
--   
seek :: Comonad w => s -> StoreT s w a -> StoreT s w a -- | Seek to a relative location -- --
--   seeks f = peeks f . duplicate
--   
seeks :: Comonad w => (s -> s) -> StoreT s w a -> StoreT s w a -- | Peek at a value at a given absolute location -- --
--   peek x . extend (peek y) = peek y
--   
peek :: Comonad w => s -> StoreT s w a -> a -- | Peek at a value at a given relative location peeks :: Comonad w => (s -> s) -> StoreT s w a -> a instance ComonadHoist (StoreT s) instance ComonadTrans (StoreT s) instance Comonad w => Comonad (StoreT s w) instance Extend w => Extend (StoreT s w) instance (Applicative w, Semigroup s, Monoid s) => Applicative (StoreT s w) instance (Apply w, Semigroup s) => Apply (StoreT s w) instance Functor w => Functor (StoreT s w) instance (Typeable s, Typeable1 w, Typeable a) => Typeable (StoreT s w a) instance (Typeable s, Typeable1 w) => Typeable1 (StoreT s w) -- | The trace comonad transformer (aka the cowriter or exponential comonad -- transformer). module Control.Comonad.Trans.Traced type Traced m = TracedT m Identity traced :: (m -> a) -> Traced m a runTraced :: Traced m a -> m -> a newtype TracedT m w a TracedT :: w (m -> a) -> TracedT m w a runTracedT :: TracedT m w a -> w (m -> a) trace :: (Comonad w, Monoid m) => m -> TracedT m w a -> a listen :: Functor w => TracedT m w a -> TracedT m w (a, m) listens :: Functor w => (m -> b) -> TracedT m w a -> TracedT m w (a, b) censor :: Functor w => (m -> m) -> TracedT m w a -> TracedT m w a instance (Typeable s, Typeable1 w) => Typeable1 (TracedT s w) instance Distributive w => Distributive (TracedT m w) instance (Semigroup m, Monoid m) => ComonadHoist (TracedT m) instance (Semigroup m, Monoid m) => ComonadTrans (TracedT m) instance (Comonad w, Semigroup m, Monoid m) => Comonad (TracedT m w) instance (Extend w, Semigroup m) => Extend (TracedT m w) instance Applicative w => Applicative (TracedT m w) instance Apply w => Apply (TracedT m w) instance Functor w => Functor (TracedT m w) -- | The memoized traced comonad transformer (aka the cowriter or -- exponential comonad transformer). module Control.Comonad.Trans.Traced.Memo type Traced m = TracedT m Identity traced :: Monoid m => (m -> a) -> Traced m a runTraced :: Traced m a -> m -> a data TracedT m w a tracedT :: (Functor w, Monoid m) => w (m -> a) -> TracedT m w a runTracedT :: TracedT m w a -> w (m -> a) trace :: (Comonad w, Monoid m) => m -> TracedT m w a -> a listen :: (Functor w, Monoid m) => TracedT m w a -> TracedT m w (a, m) listens :: (Functor w, Monoid m) => (m -> b) -> TracedT m w a -> TracedT m w (a, b) censor :: (Functor w, Monoid m) => (m -> m) -> TracedT m w a -> TracedT m w a instance (Typeable s, Typeable1 w) => Typeable1 (TracedT s w) instance ComonadHoist (TracedT m) instance ComonadTrans (TracedT m) instance (Comonad w, Monoid m) => Comonad (TracedT m w) instance (Extend w, Monoid m) => Extend (TracedT m w) instance Applicative w => Applicative (TracedT m w) instance Apply w => Apply (TracedT m w) instance Functor w => Functor (TracedT m w) -- | The f-branching stream comonad, aka the cofree comonad for a Functor -- f. -- -- Provided here as a comonad-transformer version of the 'ListT done -- right' monad transformer. module Control.Comonad.Trans.Stream -- | Isomorphic to the definition: -- --
--   data Stream f a = a :< f (Stream f a)
--   
type Stream f = StreamT f Identity -- | cons onto an f-branching stream stream :: a -> f (Stream f a) -> Stream f a -- | uncons from an f-branching stream runStream :: Stream f a -> (a, f (Stream f a)) -- | unfold a stream from a seed. unfolds :: Functor f => (a -> (b, f a)) -> a -> Stream f b -- | The f-branching stream comonad transformer is a comonadic version of -- the "ListT done Right" monad transformer. You can extract the -- underlying comonadic value by using lower or runStream data StreamT f w a StreamT :: w (Node f w a) -> StreamT f w a runStreamT :: StreamT f w a -> w (Node f w a) tails :: Comonad w => StreamT f w a -> f (StreamT f w a) unfoldsW :: (Comonad w, Functor f) => (w a -> (b, f a)) -> w a -> StreamT f w b data Node f w a (:<) :: a -> f (StreamT f w a) -> Node f w a instance (Typeable1 f, Typeable1 w, Data (w (Node f w a)), Data (Node f w a), Data (f (StreamT f w a)), Data a) => Data (StreamT f w a) instance (Typeable1 f, Typeable1 w, Data a, Data (f (StreamT f w a)), Data (StreamT f w a)) => Data (Node f w a) instance (Typeable1 f, Typeable1 w, Typeable a) => Typeable (StreamT f w a) instance (Typeable1 f, Typeable1 w) => Typeable1 (StreamT f w) instance (Typeable1 f, Typeable1 w, Typeable a) => Typeable (Node f w a) instance (Typeable1 f, Typeable1 w) => Typeable1 (Node f w) instance (Traversable w, Traversable f) => Traversable (StreamT f w) instance (Foldable w, Foldable f) => Foldable (StreamT f w) instance Functor f => ComonadHoist (StreamT f) instance Functor f => ComonadTrans (StreamT f) instance (Comonad w, Apply w, Apply f) => Apply (StreamT f w) instance (Comonad w, Functor f) => Comonad (StreamT f w) instance (Comonad w, Functor f) => Extend (StreamT f w) instance (Functor w, Functor f) => Functor (StreamT f w) instance (Show (w (Node f w a)), Show (Node f w a), Show a, Show (f (StreamT f w a))) => Show (StreamT f w a) instance (Show a, Show (StreamT f w a), Show (f (StreamT f w a)), Show (w (Node f w a))) => Show (Node f w a) instance (Functor w, Functor f) => Functor (Node f w)