{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
#if __GLASGOW_HASKELL__ >= 707
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE Safe #-}
#else
{-# LANGUAGE Trustworthy #-}
#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 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 f (a, CoiterT f a)
x) (CoiterT 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 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 f (a, CoiterT f a)
x) (CoiterT 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 Int -> a -> ShowS
sp [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 Int
d (CoiterT 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))
String
"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 Int -> ReadS a
rp 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))
String
"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 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 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 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 (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 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 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 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 -> 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 -> 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 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 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 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 forall d b. Data d => c (d -> b) -> d -> c b
f forall g. g -> c g
z (CoiterT 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 CoiterT w a
_ = Constr
coiterTConstr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (CoiterT w a)
gunfold forall b r. Data b => c (b -> r) -> c r
k forall r. r -> c r
z Constr
c = case Constr -> Int
constrIndex Constr
c of
Int
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)
Int
_ -> String -> c (CoiterT w a)
forall a. HasCallStack => String -> a
error String
"gunfold"
dataTypeOf :: CoiterT w a -> DataType
dataTypeOf CoiterT w a
_ = DataType
coiterTDataType
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c (CoiterT w a))
dataCast1 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 String
"CoiterT" [] Fixity
Prefix
{-# NOINLINE coiterTConstr #-}
coiterTDataType :: DataType
coiterTDataType :: DataType
coiterTDataType = String -> [Constr] -> DataType
mkDataType String
"Control.Comonad.Trans.Coiter.CoiterT" [Constr
coiterTConstr]
{-# NOINLINE coiterTDataType #-}