{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
#if __GLASGOW_HASKELL__ >= 707
{-# LANGUAGE DeriveDataTypeable #-}
#endif
#include "free-common.h"
module Control.Comonad.Trans.Coiter
(
CoiterT(..)
, Coiter, coiter, runCoiter
, unfold
, ComonadCofree(..)
) where
import Control.Arrow hiding (second)
import Control.Comonad
import Control.Comonad.Cofree.Class
import Control.Comonad.Env.Class
import Control.Comonad.Hoist.Class
import Control.Comonad.Store.Class
import Control.Comonad.Traced.Class
import Control.Comonad.Trans.Class
import Control.Category
import Data.Bifunctor
import Data.Bifoldable
import Data.Bitraversable
import Data.Data
import Data.Foldable
import Data.Functor.Classes.Compat
import Data.Functor.Identity
import Data.Traversable
import Prelude hiding (id,(.))
newtype CoiterT w a = CoiterT { CoiterT w a -> w (a, CoiterT w a)
runCoiterT :: w (a, CoiterT w a) }
#if __GLASGOW_HASKELL__ >= 707
deriving Typeable
#endif
#ifdef LIFTED_FUNCTOR_CLASSES
instance (Eq1 w) => Eq1 (CoiterT w) where
liftEq :: (a -> b -> Bool) -> CoiterT w a -> CoiterT w b -> Bool
liftEq eq :: a -> b -> Bool
eq = CoiterT w a -> CoiterT w b -> Bool
forall (f :: * -> *). Eq1 f => CoiterT f a -> CoiterT f b -> Bool
go
where
go :: CoiterT f a -> CoiterT f b -> Bool
go (CoiterT x :: f (a, CoiterT f a)
x) (CoiterT y :: f (b, CoiterT f b)
y) = ((a, CoiterT f a) -> (b, CoiterT f b) -> Bool)
-> f (a, CoiterT f a) -> f (b, CoiterT f b) -> Bool
forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq ((a -> b -> Bool)
-> (CoiterT f a -> CoiterT f b -> Bool)
-> (a, CoiterT f a)
-> (b, CoiterT f b)
-> Bool
forall (f :: * -> * -> *) a b c d.
Eq2 f =>
(a -> b -> Bool) -> (c -> d -> Bool) -> f a c -> f b d -> Bool
liftEq2 a -> b -> Bool
eq CoiterT f a -> CoiterT f b -> Bool
go) f (a, CoiterT f a)
x f (b, CoiterT f b)
y
#else
instance (Functor w, Eq1 w) => Eq1 (CoiterT w) where
eq1 = on eq1 (fmap (fmap Lift1) . runCoiterT)
#endif
#ifdef LIFTED_FUNCTOR_CLASSES
instance (Ord1 w) => Ord1 (CoiterT w) where
liftCompare :: (a -> b -> Ordering) -> CoiterT w a -> CoiterT w b -> Ordering
liftCompare cmp :: a -> b -> Ordering
cmp = CoiterT w a -> CoiterT w b -> Ordering
forall (f :: * -> *).
Ord1 f =>
CoiterT f a -> CoiterT f b -> Ordering
go
where
go :: CoiterT f a -> CoiterT f b -> Ordering
go (CoiterT x :: f (a, CoiterT f a)
x) (CoiterT y :: f (b, CoiterT f b)
y) = ((a, CoiterT f a) -> (b, CoiterT f b) -> Ordering)
-> f (a, CoiterT f a) -> f (b, CoiterT f b) -> Ordering
forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare ((a -> b -> Ordering)
-> (CoiterT f a -> CoiterT f b -> Ordering)
-> (a, CoiterT f a)
-> (b, CoiterT f b)
-> Ordering
forall (f :: * -> * -> *) a b c d.
Ord2 f =>
(a -> b -> Ordering)
-> (c -> d -> Ordering) -> f a c -> f b d -> Ordering
liftCompare2 a -> b -> Ordering
cmp CoiterT f a -> CoiterT f b -> Ordering
go) f (a, CoiterT f a)
x f (b, CoiterT f b)
y
#else
instance (Functor w, Ord1 w) => Ord1 (CoiterT w) where
compare1 = on compare1 (fmap (fmap Lift1) . runCoiterT)
#endif
#ifdef LIFTED_FUNCTOR_CLASSES
instance (Show1 w) => Show1 (CoiterT w) where
liftShowsPrec :: (Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> CoiterT w a -> ShowS
liftShowsPrec sp :: Int -> a -> ShowS
sp sl :: [a] -> ShowS
sl = Int -> CoiterT w a -> ShowS
go
where
goList :: [CoiterT w a] -> ShowS
goList = (Int -> a -> ShowS) -> ([a] -> ShowS) -> [CoiterT w a] -> ShowS
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> [f a] -> ShowS
liftShowList Int -> a -> ShowS
sp [a] -> ShowS
sl
go :: Int -> CoiterT w a -> ShowS
go d :: Int
d (CoiterT x :: w (a, CoiterT w a)
x) = (Int -> w (a, CoiterT w a) -> ShowS)
-> String -> Int -> w (a, CoiterT w a) -> ShowS
forall a. (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
showsUnaryWith
((Int -> (a, CoiterT w a) -> ShowS)
-> ([(a, CoiterT w a)] -> ShowS)
-> Int
-> w (a, CoiterT w a)
-> ShowS
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec ((Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> CoiterT w a -> ShowS)
-> ([CoiterT w a] -> ShowS)
-> Int
-> (a, CoiterT w a)
-> ShowS
forall (f :: * -> * -> *) a b.
Show2 f =>
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> f a b
-> ShowS
liftShowsPrec2 Int -> a -> ShowS
sp [a] -> ShowS
sl Int -> CoiterT w a -> ShowS
go [CoiterT w a] -> ShowS
goList) ((Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> CoiterT w a -> ShowS)
-> ([CoiterT w a] -> ShowS)
-> [(a, CoiterT w a)]
-> ShowS
forall (f :: * -> * -> *) a b.
Show2 f =>
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> [f a b]
-> ShowS
liftShowList2 Int -> a -> ShowS
sp [a] -> ShowS
sl Int -> CoiterT w a -> ShowS
go [CoiterT w a] -> ShowS
goList))
"CoiterT" Int
d w (a, CoiterT w a)
x
#else
instance (Functor w, Show1 w) => Show1 (CoiterT w) where
showsPrec1 d (CoiterT as) = showParen (d > 10) $
showString "CoiterT " . showsPrec1 11 (fmap (fmap Lift1) as)
#endif
#ifdef LIFTED_FUNCTOR_CLASSES
instance (Read1 w) => Read1 (CoiterT w) where
liftReadsPrec :: (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (CoiterT w a)
liftReadsPrec rp :: Int -> ReadS a
rp rl :: ReadS [a]
rl = Int -> ReadS (CoiterT w a)
go
where
goList :: ReadS [CoiterT w a]
goList = (Int -> ReadS a) -> ReadS [a] -> ReadS [CoiterT w a]
forall (f :: * -> *) a.
Read1 f =>
(Int -> ReadS a) -> ReadS [a] -> ReadS [f a]
liftReadList Int -> ReadS a
rp ReadS [a]
rl
go :: Int -> ReadS (CoiterT w a)
go = (String -> ReadS (CoiterT w a)) -> Int -> ReadS (CoiterT w a)
forall a. (String -> ReadS a) -> Int -> ReadS a
readsData ((String -> ReadS (CoiterT w a)) -> Int -> ReadS (CoiterT w a))
-> (String -> ReadS (CoiterT w a)) -> Int -> ReadS (CoiterT w a)
forall a b. (a -> b) -> a -> b
$ (Int -> ReadS (w (a, CoiterT w a)))
-> String
-> (w (a, CoiterT w a) -> CoiterT w a)
-> String
-> ReadS (CoiterT w a)
forall a t.
(Int -> ReadS a) -> String -> (a -> t) -> String -> ReadS t
readsUnaryWith
((Int -> ReadS (a, CoiterT w a))
-> ReadS [(a, CoiterT w a)] -> Int -> ReadS (w (a, CoiterT w a))
forall (f :: * -> *) a.
Read1 f =>
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (f a)
liftReadsPrec ((Int -> ReadS a)
-> ReadS [a]
-> (Int -> ReadS (CoiterT w a))
-> ReadS [CoiterT w a]
-> Int
-> ReadS (a, CoiterT w a)
forall (f :: * -> * -> *) a b.
Read2 f =>
(Int -> ReadS a)
-> ReadS [a]
-> (Int -> ReadS b)
-> ReadS [b]
-> Int
-> ReadS (f a b)
liftReadsPrec2 Int -> ReadS a
rp ReadS [a]
rl Int -> ReadS (CoiterT w a)
go ReadS [CoiterT w a]
goList) ((Int -> ReadS a)
-> ReadS [a]
-> (Int -> ReadS (CoiterT w a))
-> ReadS [CoiterT w a]
-> ReadS [(a, CoiterT w a)]
forall (f :: * -> * -> *) a b.
Read2 f =>
(Int -> ReadS a)
-> ReadS [a] -> (Int -> ReadS b) -> ReadS [b] -> ReadS [f a b]
liftReadList2 Int -> ReadS a
rp ReadS [a]
rl Int -> ReadS (CoiterT w a)
go ReadS [CoiterT w a]
goList))
"CoiterT" w (a, CoiterT w a) -> CoiterT w a
forall (w :: * -> *) a. w (a, CoiterT w a) -> CoiterT w a
CoiterT
#else
instance (Functor w, Read1 w) => Read1 (CoiterT w) where
readsPrec1 d = readParen (d > 10) $ \r ->
[ (CoiterT (fmap (fmap lower1) m),t) | ("CoiterT",s) <- lex r, (m,t) <- readsPrec1 11 s]
#endif
type Coiter = CoiterT Identity
coiter :: a -> Coiter a -> Coiter a
coiter :: a -> Coiter a -> Coiter a
coiter a :: a
a as :: Coiter a
as = Identity (a, Coiter a) -> Coiter a
forall (w :: * -> *) a. w (a, CoiterT w a) -> CoiterT w a
CoiterT (Identity (a, Coiter a) -> Coiter a)
-> Identity (a, Coiter a) -> Coiter a
forall a b. (a -> b) -> a -> b
$ (a, Coiter a) -> Identity (a, Coiter a)
forall a. a -> Identity a
Identity (a
a,Coiter a
as)
{-# INLINE coiter #-}
runCoiter :: Coiter a -> (a, Coiter a)
runCoiter :: Coiter a -> (a, Coiter a)
runCoiter = Identity (a, Coiter a) -> (a, Coiter a)
forall a. Identity a -> a
runIdentity (Identity (a, Coiter a) -> (a, Coiter a))
-> (Coiter a -> Identity (a, Coiter a))
-> Coiter a
-> (a, Coiter a)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Coiter a -> Identity (a, Coiter a)
forall (w :: * -> *) a. CoiterT w a -> w (a, CoiterT w a)
runCoiterT
{-# INLINE runCoiter #-}
instance Functor w => Functor (CoiterT w) where
fmap :: (a -> b) -> CoiterT w a -> CoiterT w b
fmap f :: a -> b
f = w (b, CoiterT w b) -> CoiterT w b
forall (w :: * -> *) a. w (a, CoiterT w a) -> CoiterT w a
CoiterT (w (b, CoiterT w b) -> CoiterT w b)
-> (CoiterT w a -> w (b, CoiterT w b))
-> CoiterT w a
-> CoiterT w b
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ((a, CoiterT w a) -> (b, CoiterT w b))
-> w (a, CoiterT w a) -> w (b, CoiterT w b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b)
-> (CoiterT w a -> CoiterT w b)
-> (a, CoiterT w a)
-> (b, CoiterT w b)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap a -> b
f ((a -> b) -> CoiterT w a -> CoiterT w b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f)) (w (a, CoiterT w a) -> w (b, CoiterT w b))
-> (CoiterT w a -> w (a, CoiterT w a))
-> CoiterT w a
-> w (b, CoiterT w b)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. CoiterT w a -> w (a, CoiterT w a)
forall (w :: * -> *) a. CoiterT w a -> w (a, CoiterT w a)
runCoiterT
instance Comonad w => Comonad (CoiterT w) where
extract :: CoiterT w a -> a
extract = (a, CoiterT w a) -> a
forall a b. (a, b) -> a
fst ((a, CoiterT w a) -> a)
-> (CoiterT w a -> (a, CoiterT w a)) -> CoiterT w a -> a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. w (a, CoiterT w a) -> (a, CoiterT w a)
forall (w :: * -> *) a. Comonad w => w a -> a
extract (w (a, CoiterT w a) -> (a, CoiterT w a))
-> (CoiterT w a -> w (a, CoiterT w a))
-> CoiterT w a
-> (a, CoiterT w a)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. CoiterT w a -> w (a, CoiterT w a)
forall (w :: * -> *) a. CoiterT w a -> w (a, CoiterT w a)
runCoiterT
{-# INLINE extract #-}
extend :: (CoiterT w a -> b) -> CoiterT w a -> CoiterT w b
extend f :: CoiterT w a -> b
f = w (b, CoiterT w b) -> CoiterT w b
forall (w :: * -> *) a. w (a, CoiterT w a) -> CoiterT w a
CoiterT (w (b, CoiterT w b) -> CoiterT w b)
-> (CoiterT w a -> w (b, CoiterT w b))
-> CoiterT w a
-> CoiterT w b
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (w (a, CoiterT w a) -> (b, CoiterT w b))
-> w (a, CoiterT w a) -> w (b, CoiterT w b)
forall (w :: * -> *) a b. Comonad w => (w a -> b) -> w a -> w b
extend (\w :: w (a, CoiterT w a)
w -> (CoiterT w a -> b
f (w (a, CoiterT w a) -> CoiterT w a
forall (w :: * -> *) a. w (a, CoiterT w a) -> CoiterT w a
CoiterT w (a, CoiterT w a)
w), (CoiterT w a -> b) -> CoiterT w a -> CoiterT w b
forall (w :: * -> *) a b. Comonad w => (w a -> b) -> w a -> w b
extend CoiterT w a -> b
f (CoiterT w a -> CoiterT w b) -> CoiterT w a -> CoiterT w b
forall a b. (a -> b) -> a -> b
$ (a, CoiterT w a) -> CoiterT w a
forall a b. (a, b) -> b
snd ((a, CoiterT w a) -> CoiterT w a)
-> (a, CoiterT w a) -> CoiterT w a
forall a b. (a -> b) -> a -> b
$ w (a, CoiterT w a) -> (a, CoiterT w a)
forall (w :: * -> *) a. Comonad w => w a -> a
extract w (a, CoiterT w a)
w)) (w (a, CoiterT w a) -> w (b, CoiterT w b))
-> (CoiterT w a -> w (a, CoiterT w a))
-> CoiterT w a
-> w (b, CoiterT w b)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. CoiterT w a -> w (a, CoiterT w a)
forall (w :: * -> *) a. CoiterT w a -> w (a, CoiterT w a)
runCoiterT
instance Foldable w => Foldable (CoiterT w) where
foldMap :: (a -> m) -> CoiterT w a -> m
foldMap f :: a -> m
f = ((a, CoiterT w a) -> m) -> w (a, CoiterT w a) -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((a -> m) -> (CoiterT w a -> m) -> (a, CoiterT w a) -> m
forall (p :: * -> * -> *) m a b.
(Bifoldable p, Monoid m) =>
(a -> m) -> (b -> m) -> p a b -> m
bifoldMap a -> m
f ((a -> m) -> CoiterT w a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f)) (w (a, CoiterT w a) -> m)
-> (CoiterT w a -> w (a, CoiterT w a)) -> CoiterT w a -> m
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. CoiterT w a -> w (a, CoiterT w a)
forall (w :: * -> *) a. CoiterT w a -> w (a, CoiterT w a)
runCoiterT
instance Traversable w => Traversable (CoiterT w) where
traverse :: (a -> f b) -> CoiterT w a -> f (CoiterT w b)
traverse f :: a -> f b
f = (w (b, CoiterT w b) -> CoiterT w b)
-> f (w (b, CoiterT w b)) -> f (CoiterT w b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap w (b, CoiterT w b) -> CoiterT w b
forall (w :: * -> *) a. w (a, CoiterT w a) -> CoiterT w a
CoiterT (f (w (b, CoiterT w b)) -> f (CoiterT w b))
-> (CoiterT w a -> f (w (b, CoiterT w b)))
-> CoiterT w a
-> f (CoiterT w b)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ((a, CoiterT w a) -> f (b, CoiterT w b))
-> w (a, CoiterT w a) -> f (w (b, CoiterT w b))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((a -> f b)
-> (CoiterT w a -> f (CoiterT w b))
-> (a, CoiterT w a)
-> f (b, CoiterT w b)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse a -> f b
f ((a -> f b) -> CoiterT w a -> f (CoiterT w b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f)) (w (a, CoiterT w a) -> f (w (b, CoiterT w b)))
-> (CoiterT w a -> w (a, CoiterT w a))
-> CoiterT w a
-> f (w (b, CoiterT w b))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. CoiterT w a -> w (a, CoiterT w a)
forall (w :: * -> *) a. CoiterT w a -> w (a, CoiterT w a)
runCoiterT
instance ComonadTrans CoiterT where
lower :: CoiterT w a -> w a
lower = ((a, CoiterT w a) -> a) -> w (a, CoiterT w a) -> w a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, CoiterT w a) -> a
forall a b. (a, b) -> a
fst (w (a, CoiterT w a) -> w a)
-> (CoiterT w a -> w (a, CoiterT w a)) -> CoiterT w a -> w a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. CoiterT w a -> w (a, CoiterT w a)
forall (w :: * -> *) a. CoiterT w a -> w (a, CoiterT w a)
runCoiterT
instance Comonad w => ComonadCofree Identity (CoiterT w) where
unwrap :: CoiterT w a -> Identity (CoiterT w a)
unwrap = CoiterT w a -> Identity (CoiterT w a)
forall a. a -> Identity a
Identity (CoiterT w a -> Identity (CoiterT w a))
-> (CoiterT w a -> CoiterT w a)
-> CoiterT w a
-> Identity (CoiterT w a)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (a, CoiterT w a) -> CoiterT w a
forall a b. (a, b) -> b
snd ((a, CoiterT w a) -> CoiterT w a)
-> (CoiterT w a -> (a, CoiterT w a)) -> CoiterT w a -> CoiterT w a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. w (a, CoiterT w a) -> (a, CoiterT w a)
forall (w :: * -> *) a. Comonad w => w a -> a
extract (w (a, CoiterT w a) -> (a, CoiterT w a))
-> (CoiterT w a -> w (a, CoiterT w a))
-> CoiterT w a
-> (a, CoiterT w a)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. CoiterT w a -> w (a, CoiterT w a)
forall (w :: * -> *) a. CoiterT w a -> w (a, CoiterT w a)
runCoiterT
{-# INLINE unwrap #-}
instance ComonadEnv e w => ComonadEnv e (CoiterT w) where
ask :: CoiterT w a -> e
ask = w a -> e
forall e (w :: * -> *) a. ComonadEnv e w => w a -> e
ask (w a -> e) -> (CoiterT w a -> w a) -> CoiterT w a -> e
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. CoiterT w a -> w a
forall (t :: (* -> *) -> * -> *) (w :: * -> *) a.
(ComonadTrans t, Comonad w) =>
t w a -> w a
lower
{-# INLINE ask #-}
instance ComonadHoist CoiterT where
cohoist :: (forall x. w x -> v x) -> CoiterT w a -> CoiterT v a
cohoist g :: forall x. w x -> v x
g = v (a, CoiterT v a) -> CoiterT v a
forall (w :: * -> *) a. w (a, CoiterT w a) -> CoiterT w a
CoiterT (v (a, CoiterT v a) -> CoiterT v a)
-> (CoiterT w a -> v (a, CoiterT v a))
-> CoiterT w a
-> CoiterT v a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ((a, CoiterT w a) -> (a, CoiterT v a))
-> v (a, CoiterT w a) -> v (a, CoiterT v a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((CoiterT w a -> CoiterT v a)
-> (a, CoiterT w a) -> (a, CoiterT v a)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ((forall x. w x -> v x) -> CoiterT w a -> CoiterT v a
forall (t :: (* -> *) -> * -> *) (w :: * -> *) (v :: * -> *) a.
(ComonadHoist t, Comonad w, Comonad v) =>
(forall x. w x -> v x) -> t w a -> t v a
cohoist forall x. w x -> v x
g)) (v (a, CoiterT w a) -> v (a, CoiterT v a))
-> (CoiterT w a -> v (a, CoiterT w a))
-> CoiterT w a
-> v (a, CoiterT v a)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. w (a, CoiterT w a) -> v (a, CoiterT w a)
forall x. w x -> v x
g (w (a, CoiterT w a) -> v (a, CoiterT w a))
-> (CoiterT w a -> w (a, CoiterT w a))
-> CoiterT w a
-> v (a, CoiterT w a)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. CoiterT w a -> w (a, CoiterT w a)
forall (w :: * -> *) a. CoiterT w a -> w (a, CoiterT w a)
runCoiterT
instance ComonadTraced m w => ComonadTraced m (CoiterT w) where
trace :: m -> CoiterT w a -> a
trace m :: m
m = m -> w a -> a
forall m (w :: * -> *) a. ComonadTraced m w => m -> w a -> a
trace m
m (w a -> a) -> (CoiterT w a -> w a) -> CoiterT w a -> a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. CoiterT w a -> w a
forall (t :: (* -> *) -> * -> *) (w :: * -> *) a.
(ComonadTrans t, Comonad w) =>
t w a -> w a
lower
{-# INLINE trace #-}
instance ComonadStore s w => ComonadStore s (CoiterT w) where
pos :: CoiterT w a -> s
pos = w a -> s
forall s (w :: * -> *) a. ComonadStore s w => w a -> s
pos (w a -> s) -> (CoiterT w a -> w a) -> CoiterT w a -> s
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. CoiterT w a -> w a
forall (t :: (* -> *) -> * -> *) (w :: * -> *) a.
(ComonadTrans t, Comonad w) =>
t w a -> w a
lower
peek :: s -> CoiterT w a -> a
peek s :: s
s = s -> w a -> a
forall s (w :: * -> *) a. ComonadStore s w => s -> w a -> a
peek s
s (w a -> a) -> (CoiterT w a -> w a) -> CoiterT w a -> a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. CoiterT w a -> w a
forall (t :: (* -> *) -> * -> *) (w :: * -> *) a.
(ComonadTrans t, Comonad w) =>
t w a -> w a
lower
peeks :: (s -> s) -> CoiterT w a -> a
peeks f :: s -> s
f = (s -> s) -> w a -> a
forall s (w :: * -> *) a. ComonadStore s w => (s -> s) -> w a -> a
peeks s -> s
f (w a -> a) -> (CoiterT w a -> w a) -> CoiterT w a -> a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. CoiterT w a -> w a
forall (t :: (* -> *) -> * -> *) (w :: * -> *) a.
(ComonadTrans t, Comonad w) =>
t w a -> w a
lower
seek :: s -> CoiterT w a -> CoiterT w a
seek = s -> CoiterT w a -> CoiterT w a
forall s (w :: * -> *) a. ComonadStore s w => s -> w a -> w a
seek
seeks :: (s -> s) -> CoiterT w a -> CoiterT w a
seeks = (s -> s) -> CoiterT w a -> CoiterT w a
forall s (w :: * -> *) a.
ComonadStore s w =>
(s -> s) -> w a -> w a
seeks
experiment :: (s -> f s) -> CoiterT w a -> f a
experiment f :: s -> f s
f = (s -> f s) -> w a -> f a
forall s (w :: * -> *) (f :: * -> *) a.
(ComonadStore s w, Functor f) =>
(s -> f s) -> w a -> f a
experiment s -> f s
f (w a -> f a) -> (CoiterT w a -> w a) -> CoiterT w a -> f a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. CoiterT w a -> w a
forall (t :: (* -> *) -> * -> *) (w :: * -> *) a.
(ComonadTrans t, Comonad w) =>
t w a -> w a
lower
{-# INLINE pos #-}
{-# INLINE peek #-}
{-# INLINE peeks #-}
{-# INLINE seek #-}
{-# INLINE seeks #-}
{-# INLINE experiment #-}
#ifdef LIFTED_FUNCTOR_CLASSES
instance (Show1 w, Show a) => Show (CoiterT w a) where
#else
instance (Functor w, Show1 w, Show a) => Show (CoiterT w a) where
#endif
showsPrec :: Int -> CoiterT w a -> ShowS
showsPrec = Int -> CoiterT w a -> ShowS
forall (f :: * -> *) a. (Show1 f, Show a) => Int -> f a -> ShowS
showsPrec1
#ifdef LIFTED_FUNCTOR_CLASSES
instance (Read1 w, Read a) => Read (CoiterT w a) where
#else
instance (Functor w, Read1 w, Read a) => Read (CoiterT w a) where
#endif
readsPrec :: Int -> ReadS (CoiterT w a)
readsPrec = Int -> ReadS (CoiterT w a)
forall (f :: * -> *) a. (Read1 f, Read a) => Int -> ReadS (f a)
readsPrec1
#ifdef LIFTED_FUNCTOR_CLASSES
instance (Eq1 w, Eq a) => Eq (CoiterT w a) where
#else
instance (Functor w, Eq1 w, Eq a) => Eq (CoiterT w a) where
#endif
== :: CoiterT w a -> CoiterT w a -> Bool
(==) = CoiterT w a -> CoiterT w a -> Bool
forall (f :: * -> *) a. (Eq1 f, Eq a) => f a -> f a -> Bool
eq1
{-# INLINE (==) #-}
#ifdef LIFTED_FUNCTOR_CLASSES
instance (Ord1 w, Ord a) => Ord (CoiterT w a) where
#else
instance (Functor w, Ord1 w, Ord a) => Ord (CoiterT w a) where
#endif
compare :: CoiterT w a -> CoiterT w a -> Ordering
compare = CoiterT w a -> CoiterT w a -> Ordering
forall (f :: * -> *) a. (Ord1 f, Ord a) => f a -> f a -> Ordering
compare1
{-# INLINE compare #-}
unfold :: Comonad w => (w a -> a) -> w a -> CoiterT w a
unfold :: (w a -> a) -> w a -> CoiterT w a
unfold psi :: w a -> a
psi = w (a, CoiterT w a) -> CoiterT w a
forall (w :: * -> *) a. w (a, CoiterT w a) -> CoiterT w a
CoiterT (w (a, CoiterT w a) -> CoiterT w a)
-> (w a -> w (a, CoiterT w a)) -> w a -> CoiterT w a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (w a -> (a, CoiterT w a)) -> w a -> w (a, CoiterT w a)
forall (w :: * -> *) a b. Comonad w => (w a -> b) -> w a -> w b
extend (w a -> a
forall (w :: * -> *) a. Comonad w => w a -> a
extract (w a -> a) -> (w a -> CoiterT w a) -> w a -> (a, CoiterT w a)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (w a -> a) -> w a -> CoiterT w a
forall (w :: * -> *) a.
Comonad w =>
(w a -> a) -> w a -> CoiterT w a
unfold w a -> a
psi (w a -> CoiterT w a) -> (w a -> w a) -> w a -> CoiterT w a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (w a -> a) -> w a -> w a
forall (w :: * -> *) a b. Comonad w => (w a -> b) -> w a -> w b
extend w a -> a
psi)
#if __GLASGOW_HASKELL__ < 707
instance Typeable1 w => Typeable1 (CoiterT w) where
typeOf1 t = mkTyConApp coiterTTyCon [typeOf1 (w t)] where
w :: CoiterT w a -> w a
w = undefined
coiterTTyCon :: TyCon
#if __GLASGOW_HASKELL__ < 704
coiterTTyCon = mkTyCon "Control.Comonad.Trans.Coiter.CoiterT"
#else
coiterTTyCon = mkTyCon3 "free" "Control.Comonad.Trans.Coiter" "CoiterT"
#endif
{-# NOINLINE coiterTTyCon #-}
#else
#define Typeable1 Typeable
#endif
instance
( Typeable1 w, Typeable a
, Data (w (a, CoiterT w a))
, Data a
) => Data (CoiterT w a) where
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CoiterT w a -> c (CoiterT w a)
gfoldl f :: forall d b. Data d => c (d -> b) -> d -> c b
f z :: forall g. g -> c g
z (CoiterT w :: w (a, CoiterT w a)
w) = (w (a, CoiterT w a) -> CoiterT w a)
-> c (w (a, CoiterT w a) -> CoiterT w a)
forall g. g -> c g
z w (a, CoiterT w a) -> CoiterT w a
forall (w :: * -> *) a. w (a, CoiterT w a) -> CoiterT w a
CoiterT c (w (a, CoiterT w a) -> CoiterT w a)
-> w (a, CoiterT w a) -> c (CoiterT w a)
forall d b. Data d => c (d -> b) -> d -> c b
`f` w (a, CoiterT w a)
w
toConstr :: CoiterT w a -> Constr
toConstr _ = Constr
coiterTConstr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (CoiterT w a)
gunfold k :: forall b r. Data b => c (b -> r) -> c r
k z :: forall r. r -> c r
z c :: Constr
c = case Constr -> Int
constrIndex Constr
c of
1 -> c (w (a, CoiterT w a) -> CoiterT w a) -> c (CoiterT w a)
forall b r. Data b => c (b -> r) -> c r
k ((w (a, CoiterT w a) -> CoiterT w a)
-> c (w (a, CoiterT w a) -> CoiterT w a)
forall r. r -> c r
z w (a, CoiterT w a) -> CoiterT w a
forall (w :: * -> *) a. w (a, CoiterT w a) -> CoiterT w a
CoiterT)
_ -> String -> c (CoiterT w a)
forall a. HasCallStack => String -> a
error "gunfold"
dataTypeOf :: CoiterT w a -> DataType
dataTypeOf _ = DataType
coiterTDataType
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c (CoiterT w a))
dataCast1 f :: forall d. Data d => c (t d)
f = c (t a) -> Maybe (c (CoiterT w a))
forall k1 k2 (c :: k1 -> *) (t :: k2 -> k1) (t' :: k2 -> k1)
(a :: k2).
(Typeable t, Typeable t') =>
c (t a) -> Maybe (c (t' a))
gcast1 c (t a)
forall d. Data d => c (t d)
f
coiterTConstr :: Constr
coiterTConstr :: Constr
coiterTConstr = DataType -> String -> [String] -> Fixity -> Constr
mkConstr DataType
coiterTDataType "CoiterT" [] Fixity
Prefix
{-# NOINLINE coiterTConstr #-}
coiterTDataType :: DataType
coiterTDataType :: DataType
coiterTDataType = String -> [Constr] -> DataType
mkDataType "Control.Comonad.Trans.Coiter.CoiterT" [Constr
coiterTConstr]
{-# NOINLINE coiterTDataType #-}