{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE Rank2Types #-}
#if __GLASGOW_HASKELL__ >= 707
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE Safe #-}
#else
{-# LANGUAGE Trustworthy #-}
#endif
#include "free-common.h"
module Control.Comonad.Trans.Cofree
( CofreeT(..)
, Cofree, cofree, runCofree
, CofreeF(..)
, ComonadCofree(..)
, headF
, tailF
, transCofreeT
, coiterT
) where
import Control.Applicative
import Control.Comonad
import Control.Comonad.Trans.Class
import Control.Comonad.Cofree.Class
import Control.Comonad.Env.Class
import Control.Comonad.Hoist.Class
import Control.Category
import Data.Bifunctor
import Data.Bifoldable
import Data.Bitraversable
import Data.Foldable
import Data.Functor.Classes
import Data.Functor.Identity
import Data.Traversable
import Control.Monad (liftM)
import Control.Monad.Trans
import Control.Monad.Zip
import Prelude hiding (id,(.))
import Data.Data
#if __GLASGOW_HASKELL__ >= 707
import GHC.Generics hiding (Infix, Prefix)
#endif
#if !(MIN_VERSION_base(4,8,0))
import Data.Monoid
#endif
infixr 5 :<
data CofreeF f a b = a :< f b
deriving (CofreeF f a b -> CofreeF f a b -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (f :: * -> *) a b.
(Eq a, Eq (f b)) =>
CofreeF f a b -> CofreeF f a b -> Bool
/= :: CofreeF f a b -> CofreeF f a b -> Bool
$c/= :: forall (f :: * -> *) a b.
(Eq a, Eq (f b)) =>
CofreeF f a b -> CofreeF f a b -> Bool
== :: CofreeF f a b -> CofreeF f a b -> Bool
$c== :: forall (f :: * -> *) a b.
(Eq a, Eq (f b)) =>
CofreeF f a b -> CofreeF f a b -> Bool
Eq,CofreeF f a b -> CofreeF f a b -> Bool
CofreeF f a b -> CofreeF f a b -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {f :: * -> *} {a} {b}.
(Ord a, Ord (f b)) =>
Eq (CofreeF f a b)
forall (f :: * -> *) a b.
(Ord a, Ord (f b)) =>
CofreeF f a b -> CofreeF f a b -> Bool
forall (f :: * -> *) a b.
(Ord a, Ord (f b)) =>
CofreeF f a b -> CofreeF f a b -> Ordering
forall (f :: * -> *) a b.
(Ord a, Ord (f b)) =>
CofreeF f a b -> CofreeF f a b -> CofreeF f a b
min :: CofreeF f a b -> CofreeF f a b -> CofreeF f a b
$cmin :: forall (f :: * -> *) a b.
(Ord a, Ord (f b)) =>
CofreeF f a b -> CofreeF f a b -> CofreeF f a b
max :: CofreeF f a b -> CofreeF f a b -> CofreeF f a b
$cmax :: forall (f :: * -> *) a b.
(Ord a, Ord (f b)) =>
CofreeF f a b -> CofreeF f a b -> CofreeF f a b
>= :: CofreeF f a b -> CofreeF f a b -> Bool
$c>= :: forall (f :: * -> *) a b.
(Ord a, Ord (f b)) =>
CofreeF f a b -> CofreeF f a b -> Bool
> :: CofreeF f a b -> CofreeF f a b -> Bool
$c> :: forall (f :: * -> *) a b.
(Ord a, Ord (f b)) =>
CofreeF f a b -> CofreeF f a b -> Bool
<= :: CofreeF f a b -> CofreeF f a b -> Bool
$c<= :: forall (f :: * -> *) a b.
(Ord a, Ord (f b)) =>
CofreeF f a b -> CofreeF f a b -> Bool
< :: CofreeF f a b -> CofreeF f a b -> Bool
$c< :: forall (f :: * -> *) a b.
(Ord a, Ord (f b)) =>
CofreeF f a b -> CofreeF f a b -> Bool
compare :: CofreeF f a b -> CofreeF f a b -> Ordering
$ccompare :: forall (f :: * -> *) a b.
(Ord a, Ord (f b)) =>
CofreeF f a b -> CofreeF f a b -> Ordering
Ord,Int -> CofreeF f a b -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (f :: * -> *) a b.
(Show a, Show (f b)) =>
Int -> CofreeF f a b -> ShowS
forall (f :: * -> *) a b.
(Show a, Show (f b)) =>
[CofreeF f a b] -> ShowS
forall (f :: * -> *) a b.
(Show a, Show (f b)) =>
CofreeF f a b -> String
showList :: [CofreeF f a b] -> ShowS
$cshowList :: forall (f :: * -> *) a b.
(Show a, Show (f b)) =>
[CofreeF f a b] -> ShowS
show :: CofreeF f a b -> String
$cshow :: forall (f :: * -> *) a b.
(Show a, Show (f b)) =>
CofreeF f a b -> String
showsPrec :: Int -> CofreeF f a b -> ShowS
$cshowsPrec :: forall (f :: * -> *) a b.
(Show a, Show (f b)) =>
Int -> CofreeF f a b -> ShowS
Show,ReadPrec [CofreeF f a b]
ReadPrec (CofreeF f a b)
ReadS [CofreeF f a b]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall (f :: * -> *) a b.
(Read a, Read (f b)) =>
ReadPrec [CofreeF f a b]
forall (f :: * -> *) a b.
(Read a, Read (f b)) =>
ReadPrec (CofreeF f a b)
forall (f :: * -> *) a b.
(Read a, Read (f b)) =>
Int -> ReadS (CofreeF f a b)
forall (f :: * -> *) a b.
(Read a, Read (f b)) =>
ReadS [CofreeF f a b]
readListPrec :: ReadPrec [CofreeF f a b]
$creadListPrec :: forall (f :: * -> *) a b.
(Read a, Read (f b)) =>
ReadPrec [CofreeF f a b]
readPrec :: ReadPrec (CofreeF f a b)
$creadPrec :: forall (f :: * -> *) a b.
(Read a, Read (f b)) =>
ReadPrec (CofreeF f a b)
readList :: ReadS [CofreeF f a b]
$creadList :: forall (f :: * -> *) a b.
(Read a, Read (f b)) =>
ReadS [CofreeF f a b]
readsPrec :: Int -> ReadS (CofreeF f a b)
$creadsPrec :: forall (f :: * -> *) a b.
(Read a, Read (f b)) =>
Int -> ReadS (CofreeF f a b)
Read
#if __GLASGOW_HASKELL__ >= 707
,Typeable, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (f :: * -> *) a b x. Rep (CofreeF f a b) x -> CofreeF f a b
forall (f :: * -> *) a b x. CofreeF f a b -> Rep (CofreeF f a b) x
$cto :: forall (f :: * -> *) a b x. Rep (CofreeF f a b) x -> CofreeF f a b
$cfrom :: forall (f :: * -> *) a b x. CofreeF f a b -> Rep (CofreeF f a b) x
Generic, forall k (f :: k -> *).
(forall (a :: k). f a -> Rep1 f a)
-> (forall (a :: k). Rep1 f a -> f a) -> Generic1 f
forall (f :: * -> *) a a. Rep1 (CofreeF f a) a -> CofreeF f a a
forall (f :: * -> *) a a. CofreeF f a a -> Rep1 (CofreeF f a) a
$cto1 :: forall (f :: * -> *) a a. Rep1 (CofreeF f a) a -> CofreeF f a a
$cfrom1 :: forall (f :: * -> *) a a. CofreeF f a a -> Rep1 (CofreeF f a) a
Generic1
#endif
)
#ifdef LIFTED_FUNCTOR_CLASSES
instance Show1 f => Show2 (CofreeF f) where
liftShowsPrec2 :: forall a b.
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> CofreeF f a b
-> ShowS
liftShowsPrec2 Int -> a -> ShowS
spa [a] -> ShowS
_sla Int -> b -> ShowS
spb [b] -> ShowS
slb Int
d (a
a :< f b
fb) =
Bool -> ShowS -> ShowS
showParen (Int
d forall a. Ord a => a -> a -> Bool
> Int
5) forall a b. (a -> b) -> a -> b
$
Int -> a -> ShowS
spa Int
6 a
a forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> ShowS
showString String
" :< " forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec Int -> b -> ShowS
spb [b] -> ShowS
slb Int
6 f b
fb
instance (Show1 f, Show a) => Show1 (CofreeF f a) where
liftShowsPrec :: forall a.
(Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> CofreeF f a a -> ShowS
liftShowsPrec = forall (f :: * -> * -> *) a b.
Show2 f =>
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> f a b
-> ShowS
liftShowsPrec2 forall a. Show a => Int -> a -> ShowS
showsPrec forall a. Show a => [a] -> ShowS
showList
#else
instance (Functor f, Show1 f, Show a) => Show1 (CofreeF f a) where
showsPrec1 d (a :< fb) = showParen (d > 5) $
showsPrec 6 a . showString " :< " . showsPrec1 6 fb
#endif
#ifdef LIFTED_FUNCTOR_CLASSES
instance Read1 f => Read2 (CofreeF f) where
liftReadsPrec2 :: forall a b.
(Int -> ReadS a)
-> ReadS [a]
-> (Int -> ReadS b)
-> ReadS [b]
-> Int
-> ReadS (CofreeF f a b)
liftReadsPrec2 Int -> ReadS a
rpa ReadS [a]
_rla Int -> ReadS b
rpb ReadS [b]
rlb Int
d =
forall a. Bool -> ReadS a -> ReadS a
readParen (Int
d forall a. Ord a => a -> a -> Bool
> Int
5) forall a b. (a -> b) -> a -> b
$
(\String
r' -> [ (a
u forall (f :: * -> *) a b. a -> f b -> CofreeF f a b
:< f b
v, String
w)
| (a
u, String
s) <- Int -> ReadS a
rpa Int
6 String
r'
, (String
":<", String
t) <- ReadS String
lex String
s
, (f b
v, String
w) <- forall (f :: * -> *) a.
Read1 f =>
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (f a)
liftReadsPrec Int -> ReadS b
rpb ReadS [b]
rlb Int
6 String
t
])
instance (Read1 f, Read a) => Read1 (CofreeF f a) where
liftReadsPrec :: forall a.
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (CofreeF f a a)
liftReadsPrec = forall (f :: * -> * -> *) a b.
Read2 f =>
(Int -> ReadS a)
-> ReadS [a]
-> (Int -> ReadS b)
-> ReadS [b]
-> Int
-> ReadS (f a b)
liftReadsPrec2 forall a. Read a => Int -> ReadS a
readsPrec forall a. Read a => ReadS [a]
readList
#else
instance (Read1 f, Read a) => Read1 (CofreeF f a) where
readsPrec1 d =
readParen (d > 5) $
(\r' -> [ (u :< v,w)
| (u, s) <- readsPrec 6 r'
, (":<", t) <- lex s
, (v, w) <- readsPrec1 6 t
])
#endif
#ifdef LIFTED_FUNCTOR_CLASSES
instance Eq1 f => Eq2 (CofreeF f) where
liftEq2 :: forall a b c d.
(a -> b -> Bool)
-> (c -> d -> Bool) -> CofreeF f a c -> CofreeF f b d -> Bool
liftEq2 a -> b -> Bool
eqa c -> d -> Bool
eqfb (a
a :< f c
fb) (b
a' :< f d
fb') = a -> b -> Bool
eqa a
a b
a' Bool -> Bool -> Bool
&& forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq c -> d -> Bool
eqfb f c
fb f d
fb'
instance (Eq1 f, Eq a) => Eq1 (CofreeF f a) where
liftEq :: forall a b.
(a -> b -> Bool) -> CofreeF f a a -> CofreeF f a b -> Bool
liftEq = forall (f :: * -> * -> *) a b c d.
Eq2 f =>
(a -> b -> Bool) -> (c -> d -> Bool) -> f a c -> f b d -> Bool
liftEq2 forall a. Eq a => a -> a -> Bool
(==)
#else
instance (Eq1 f, Eq a) => Eq1 (CofreeF f a) where
eq1 (a :< fb) (a' :< fb') = a == a' && eq1 fb fb'
#endif
#ifdef LIFTED_FUNCTOR_CLASSES
instance Ord1 f => Ord2 (CofreeF f) where
liftCompare2 :: forall a b c d.
(a -> b -> Ordering)
-> (c -> d -> Ordering)
-> CofreeF f a c
-> CofreeF f b d
-> Ordering
liftCompare2 a -> b -> Ordering
cmpa c -> d -> Ordering
cmpfb (a
a :< f c
fb) (b
a' :< f d
fb') =
case a -> b -> Ordering
cmpa a
a b
a' of
Ordering
LT -> Ordering
LT
Ordering
EQ -> forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare c -> d -> Ordering
cmpfb f c
fb f d
fb'
Ordering
GT -> Ordering
GT
instance (Ord1 f, Ord a) => Ord1 (CofreeF f a) where
liftCompare :: forall a b.
(a -> b -> Ordering) -> CofreeF f a a -> CofreeF f a b -> Ordering
liftCompare = forall (f :: * -> * -> *) a b c d.
Ord2 f =>
(a -> b -> Ordering)
-> (c -> d -> Ordering) -> f a c -> f b d -> Ordering
liftCompare2 forall a. Ord a => a -> a -> Ordering
compare
#else
instance (Ord1 f, Ord a) => Ord1 (CofreeF f a) where
compare1 (a :< fb) (a' :< fb') =
case compare a a' of
LT -> LT
EQ -> compare1 fb fb'
GT -> GT
#endif
headF :: CofreeF f a b -> a
headF :: forall (f :: * -> *) a b. CofreeF f a b -> a
headF (a
a :< f b
_) = a
a
tailF :: CofreeF f a b -> f b
tailF :: forall (f :: * -> *) a b. CofreeF f a b -> f b
tailF (a
_ :< f b
as) = f b
as
instance Functor f => Functor (CofreeF f a) where
fmap :: forall a b. (a -> b) -> CofreeF f a a -> CofreeF f a b
fmap a -> b
f (a
a :< f a
as) = a
a forall (f :: * -> *) a b. a -> f b -> CofreeF f a b
:< forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f f a
as
instance Foldable f => Foldable (CofreeF f a) where
foldMap :: forall m a. Monoid m => (a -> m) -> CofreeF f a a -> m
foldMap a -> m
f (a
_ :< f a
as) = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f f a
as
instance Traversable f => Traversable (CofreeF f a) where
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> CofreeF f a a -> f (CofreeF f a b)
traverse a -> f b
f (a
a :< f a
as) = (a
a forall (f :: * -> *) a b. a -> f b -> CofreeF f a b
:<) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f f a
as
instance Functor f => Bifunctor (CofreeF f) where
bimap :: forall a b c d.
(a -> b) -> (c -> d) -> CofreeF f a c -> CofreeF f b d
bimap a -> b
f c -> d
g (a
a :< f c
as) = a -> b
f a
a forall (f :: * -> *) a b. a -> f b -> CofreeF f a b
:< forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap c -> d
g f c
as
instance Foldable f => Bifoldable (CofreeF f) where
bifoldMap :: forall m a b.
Monoid m =>
(a -> m) -> (b -> m) -> CofreeF f a b -> m
bifoldMap a -> m
f b -> m
g (a
a :< f b
as) = a -> m
f a
a forall a. Monoid a => a -> a -> a
`mappend` forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap b -> m
g f b
as
instance Traversable f => Bitraversable (CofreeF f) where
bitraverse :: forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> CofreeF f a b -> f (CofreeF f c d)
bitraverse a -> f c
f b -> f d
g (a
a :< f b
as) = forall (f :: * -> *) a b. a -> f b -> CofreeF f a b
(:<) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f c
f a
a forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse b -> f d
g f b
as
transCofreeF :: (forall x. f x -> g x) -> CofreeF f a b -> CofreeF g a b
transCofreeF :: forall (f :: * -> *) (g :: * -> *) a b.
(forall x. f x -> g x) -> CofreeF f a b -> CofreeF g a b
transCofreeF forall x. f x -> g x
t (a
a :< f b
fb) = a
a forall (f :: * -> *) a b. a -> f b -> CofreeF f a b
:< forall x. f x -> g x
t f b
fb
{-# INLINE transCofreeF #-}
newtype CofreeT f w a = CofreeT { forall (f :: * -> *) (w :: * -> *) a.
CofreeT f w a -> w (CofreeF f a (CofreeT f w a))
runCofreeT :: w (CofreeF f a (CofreeT f w a)) }
#if __GLASGOW_HASKELL__ >= 707
deriving Typeable
#endif
type Cofree f = CofreeT f Identity
cofree :: CofreeF f a (Cofree f a) -> Cofree f a
cofree :: forall (f :: * -> *) a. CofreeF f a (Cofree f a) -> Cofree f a
cofree = forall (f :: * -> *) (w :: * -> *) a.
w (CofreeF f a (CofreeT f w a)) -> CofreeT f w a
CofreeT forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. a -> Identity a
Identity
{-# INLINE cofree #-}
runCofree :: Cofree f a -> CofreeF f a (Cofree f a)
runCofree :: forall (f :: * -> *) a. Cofree f a -> CofreeF f a (Cofree f a)
runCofree = forall a. Identity a -> a
runIdentity forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) (w :: * -> *) a.
CofreeT f w a -> w (CofreeF f a (CofreeT f w a))
runCofreeT
{-# INLINE runCofree #-}
instance (Functor f, Functor w) => Functor (CofreeT f w) where
fmap :: forall a b. (a -> b) -> CofreeT f w a -> CofreeT f w b
fmap a -> b
f = forall (f :: * -> *) (w :: * -> *) a.
w (CofreeF f a (CofreeT f w a)) -> CofreeT f w a
CofreeT forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap a -> b
f (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f)) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) (w :: * -> *) a.
CofreeT f w a -> w (CofreeF f a (CofreeT f w a))
runCofreeT
instance (Functor f, Comonad w) => Comonad (CofreeT f w) where
extract :: forall a. CofreeT f w a -> a
extract = forall (f :: * -> *) a b. CofreeF f a b -> a
headF forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (w :: * -> *) a. Comonad w => w a -> a
extract forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) (w :: * -> *) a.
CofreeT f w a -> w (CofreeF f a (CofreeT f w a))
runCofreeT
extend :: forall a b. (CofreeT f w a -> b) -> CofreeT f w a -> CofreeT f w b
extend CofreeT f w a -> b
f = forall (f :: * -> *) (w :: * -> *) a.
w (CofreeF f a (CofreeT f w a)) -> CofreeT f w a
CofreeT forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (w :: * -> *) a b. Comonad w => (w a -> b) -> w a -> w b
extend (\w (CofreeF f a (CofreeT f w a))
w -> CofreeT f w a -> b
f (forall (f :: * -> *) (w :: * -> *) a.
w (CofreeF f a (CofreeT f w a)) -> CofreeT f w a
CofreeT w (CofreeF f a (CofreeT f w a))
w) forall (f :: * -> *) a b. a -> f b -> CofreeF f a b
:< (forall (w :: * -> *) a b. Comonad w => (w a -> b) -> w a -> w b
extend CofreeT f w a -> b
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a b. CofreeF f a b -> f b
tailF (forall (w :: * -> *) a. Comonad w => w a -> a
extract w (CofreeF f a (CofreeT f w a))
w))) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) (w :: * -> *) a.
CofreeT f w a -> w (CofreeF f a (CofreeT f w a))
runCofreeT
instance (Foldable f, Foldable w) => Foldable (CofreeT f w) where
foldMap :: forall m a. Monoid m => (a -> m) -> CofreeT f w a -> m
foldMap a -> m
f = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall (p :: * -> * -> *) m a b.
(Bifoldable p, Monoid m) =>
(a -> m) -> (b -> m) -> p a b -> m
bifoldMap a -> m
f (forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f)) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) (w :: * -> *) a.
CofreeT f w a -> w (CofreeF f a (CofreeT f w a))
runCofreeT
instance (Traversable f, Traversable w) => Traversable (CofreeT f w) where
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> CofreeT f w a -> f (CofreeT f w b)
traverse a -> f b
f = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (f :: * -> *) (w :: * -> *) a.
w (CofreeF f a (CofreeT f w a)) -> CofreeT f w a
CofreeT forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (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 (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f)) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) (w :: * -> *) a.
CofreeT f w a -> w (CofreeF f a (CofreeT f w a))
runCofreeT
instance ComonadTrans (CofreeT f) where
lower :: forall (w :: * -> *) a. Comonad w => CofreeT f w a -> w a
lower = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (f :: * -> *) a b. CofreeF f a b -> a
headF forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) (w :: * -> *) a.
CofreeT f w a -> w (CofreeF f a (CofreeT f w a))
runCofreeT
instance (Functor f, Comonad w) => ComonadCofree f (CofreeT f w) where
unwrap :: forall a. CofreeT f w a -> f (CofreeT f w a)
unwrap = forall (f :: * -> *) a b. CofreeF f a b -> f b
tailF forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (w :: * -> *) a. Comonad w => w a -> a
extract forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) (w :: * -> *) a.
CofreeT f w a -> w (CofreeF f a (CofreeT f w a))
runCofreeT
instance (Functor f, ComonadEnv e w) => ComonadEnv e (CofreeT f w) where
ask :: forall a. CofreeT f w a -> e
ask = forall e (w :: * -> *) a. ComonadEnv e w => w a -> e
ask forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (t :: (* -> *) -> * -> *) (w :: * -> *) a.
(ComonadTrans t, Comonad w) =>
t w a -> w a
lower
{-# INLINE ask #-}
instance Functor f => ComonadHoist (CofreeT f) where
cohoist :: forall (w :: * -> *) (v :: * -> *) a.
(Comonad w, Comonad v) =>
(forall x. w x -> v x) -> CofreeT f w a -> CofreeT f v a
cohoist forall x. w x -> v x
g = forall (f :: * -> *) (w :: * -> *) a.
w (CofreeF f a (CofreeT f w a)) -> CofreeT f w a
CofreeT forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (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)) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall x. w x -> v x
g forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) (w :: * -> *) a.
CofreeT f w a -> w (CofreeF f a (CofreeT f w a))
runCofreeT
instance Show (w (CofreeF f a (CofreeT f w a))) => Show (CofreeT f w a) where
showsPrec :: Int -> CofreeT f w a -> ShowS
showsPrec Int
d (CofreeT w (CofreeF f a (CofreeT f w a))
w) = Bool -> ShowS -> ShowS
showParen (Int
d forall a. Ord a => a -> a -> Bool
> Int
10) forall a b. (a -> b) -> a -> b
$
String -> ShowS
showString String
"CofreeT " forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 w (CofreeF f a (CofreeT f w a))
w
instance Read (w (CofreeF f a (CofreeT f w a))) => Read (CofreeT f w a) where
readsPrec :: Int -> ReadS (CofreeT f w a)
readsPrec Int
d = forall a. Bool -> ReadS a -> ReadS a
readParen (Int
d forall a. Ord a => a -> a -> Bool
> Int
10) forall a b. (a -> b) -> a -> b
$ \String
r ->
[(forall (f :: * -> *) (w :: * -> *) a.
w (CofreeF f a (CofreeT f w a)) -> CofreeT f w a
CofreeT w (CofreeF f a (CofreeT f w a))
w, String
t) | (String
"CofreeT", String
s) <- ReadS String
lex String
r, (w (CofreeF f a (CofreeT f w a))
w, String
t) <- forall a. Read a => Int -> ReadS a
readsPrec Int
11 String
s]
instance Eq (w (CofreeF f a (CofreeT f w a))) => Eq (CofreeT f w a) where
CofreeT w (CofreeF f a (CofreeT f w a))
a == :: CofreeT f w a -> CofreeT f w a -> Bool
== CofreeT w (CofreeF f a (CofreeT f w a))
b = w (CofreeF f a (CofreeT f w a))
a forall a. Eq a => a -> a -> Bool
== w (CofreeF f a (CofreeT f w a))
b
instance Ord (w (CofreeF f a (CofreeT f w a))) => Ord (CofreeT f w a) where
compare :: CofreeT f w a -> CofreeT f w a -> Ordering
compare (CofreeT w (CofreeF f a (CofreeT f w a))
a) (CofreeT w (CofreeF f a (CofreeT f w a))
b) = forall a. Ord a => a -> a -> Ordering
compare w (CofreeF f a (CofreeT f w a))
a w (CofreeF f a (CofreeT f w a))
b
instance (Alternative f, Monad w) => Monad (CofreeT f w) where
#if __GLASGOW_HASKELL__ < 710
return = CofreeT . return . (:< empty)
{-# INLINE return #-}
#endif
CofreeT w (CofreeF f a (CofreeT f w a))
cx >>= :: forall a b. CofreeT f w a -> (a -> CofreeT f w b) -> CofreeT f w b
>>= a -> CofreeT f w b
f = forall (f :: * -> *) (w :: * -> *) a.
w (CofreeF f a (CofreeT f w a)) -> CofreeT f w a
CofreeT forall a b. (a -> b) -> a -> b
$ do
a
a :< f (CofreeT f w a)
m <- w (CofreeF f a (CofreeT f w a))
cx
b
b :< f (CofreeT f w b)
n <- forall (f :: * -> *) (w :: * -> *) a.
CofreeT f w a -> w (CofreeF f a (CofreeT f w a))
runCofreeT forall a b. (a -> b) -> a -> b
$ a -> CofreeT f w b
f a
a
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ b
b forall (f :: * -> *) a b. a -> f b -> CofreeF f a b
:< (f (CofreeT f w b)
n forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> CofreeT f w b
f) f (CofreeT f w a)
m)
instance (Alternative f, Applicative w) => Applicative (CofreeT f w) where
pure :: forall a. a -> CofreeT f w a
pure = forall (f :: * -> *) (w :: * -> *) a.
w (CofreeF f a (CofreeT f w a)) -> CofreeT f w a
CofreeT forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (forall (f :: * -> *) a b. a -> f b -> CofreeF f a b
:< forall (f :: * -> *) a. Alternative f => f a
empty)
{-# INLINE pure #-}
CofreeT f w (a -> b)
wf <*> :: forall a b. CofreeT f w (a -> b) -> CofreeT f w a -> CofreeT f w b
<*> CofreeT f w a
wa = forall (f :: * -> *) (w :: * -> *) a.
w (CofreeF f a (CofreeT f w a)) -> CofreeT f w a
CofreeT forall a b. (a -> b) -> a -> b
$ forall {f :: * -> *} {a} {a}.
Alternative f =>
CofreeF f (a -> a) (CofreeT f w (a -> a))
-> CofreeF f a (CofreeT f w a) -> CofreeF f a (CofreeT f w a)
go forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) (w :: * -> *) a.
CofreeT f w a -> w (CofreeF f a (CofreeT f w a))
runCofreeT CofreeT f w (a -> b)
wf forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) (w :: * -> *) a.
CofreeT f w a -> w (CofreeF f a (CofreeT f w a))
runCofreeT CofreeT f w a
wa where
go :: CofreeF f (a -> a) (CofreeT f w (a -> a))
-> CofreeF f a (CofreeT f w a) -> CofreeF f a (CofreeT f w a)
go (a -> a
f :< f (CofreeT f w (a -> a))
t) CofreeF f a (CofreeT f w a)
a = case forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap a -> a
f (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
f) CofreeF f a (CofreeT f w a)
a of
a
b :< f (CofreeT f w a)
n -> a
b forall (f :: * -> *) a b. a -> f b -> CofreeF f a b
:< (f (CofreeT f w a)
n forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> CofreeT f w a
wa) f (CofreeT f w (a -> a))
t)
{-# INLINE (<*>) #-}
instance Alternative f => MonadTrans (CofreeT f) where
lift :: forall (m :: * -> *) a. Monad m => m a -> CofreeT f m a
lift = forall (f :: * -> *) (w :: * -> *) a.
w (CofreeF f a (CofreeT f w a)) -> CofreeT f w a
CofreeT forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (forall (f :: * -> *) a b. a -> f b -> CofreeF f a b
:< forall (f :: * -> *) a. Alternative f => f a
empty)
instance (Alternative f, MonadZip f, MonadZip m) => MonadZip (CofreeT f m) where
mzip :: forall a b. CofreeT f m a -> CofreeT f m b -> CofreeT f m (a, b)
mzip (CofreeT m (CofreeF f a (CofreeT f m a))
ma) (CofreeT m (CofreeF f b (CofreeT f m b))
mb) = forall (f :: * -> *) (w :: * -> *) a.
w (CofreeF f a (CofreeT f w a)) -> CofreeT f w a
CofreeT forall a b. (a -> b) -> a -> b
$ do
(a
a :< f (CofreeT f m a)
fa, b
b :< f (CofreeT f m b)
fb) <- forall (m :: * -> *) a b. MonadZip m => m a -> m b -> m (a, b)
mzip m (CofreeF f a (CofreeT f m a))
ma m (CofreeF f b (CofreeT f m b))
mb
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (a
a, b
b) forall (f :: * -> *) a b. a -> f b -> CofreeF f a b
:< (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall (m :: * -> *) a b. MonadZip m => m a -> m b -> m (a, b)
mzip forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a b. MonadZip m => m a -> m b -> m (a, b)
mzip f (CofreeT f m a)
fa f (CofreeT f m b)
fb)
transCofreeT :: (Functor g, Comonad w) => (forall x. f x -> g x) -> CofreeT f w a -> CofreeT g w a
transCofreeT :: forall (g :: * -> *) (w :: * -> *) (f :: * -> *) a.
(Functor g, Comonad w) =>
(forall x. f x -> g x) -> CofreeT f w a -> CofreeT g w a
transCofreeT forall x. f x -> g x
t = forall (f :: * -> *) (w :: * -> *) a.
w (CofreeF f a (CofreeT f w a)) -> CofreeT f w a
CofreeT forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (w :: * -> *) a b. Comonad w => (a -> b) -> w a -> w b
liftW (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (g :: * -> *) (w :: * -> *) (f :: * -> *) a.
(Functor g, Comonad w) =>
(forall x. f x -> g x) -> CofreeT f w a -> CofreeT g w a
transCofreeT forall x. f x -> g x
t) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) (g :: * -> *) a b.
(forall x. f x -> g x) -> CofreeF f a b -> CofreeF g a b
transCofreeF forall x. f x -> g x
t) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) (w :: * -> *) a.
CofreeT f w a -> w (CofreeF f a (CofreeT f w a))
runCofreeT
coiterT :: (Functor f, Comonad w) => (w a -> f (w a)) -> w a -> CofreeT f w a
coiterT :: forall (f :: * -> *) (w :: * -> *) a.
(Functor f, Comonad w) =>
(w a -> f (w a)) -> w a -> CofreeT f w a
coiterT w a -> f (w a)
psi = forall (f :: * -> *) (w :: * -> *) a.
w (CofreeF f a (CofreeT f w a)) -> CofreeT f w a
CofreeT forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (w :: * -> *) a b. Comonad w => (w a -> b) -> w a -> w b
extend (\w a
w -> forall (w :: * -> *) a. Comonad w => w a -> a
extract w a
w forall (f :: * -> *) a b. a -> f b -> CofreeF f a b
:< forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) (w :: * -> *) a.
(Functor f, Comonad w) =>
(w a -> f (w a)) -> w a -> CofreeT f w a
coiterT w a -> f (w a)
psi) (w a -> f (w a)
psi w a
w))
#if __GLASGOW_HASKELL__ < 707
instance Typeable1 f => Typeable2 (CofreeF f) where
typeOf2 t = mkTyConApp cofreeFTyCon [typeOf1 (f t)] where
f :: CofreeF f a b -> f a
f = undefined
instance (Typeable1 f, Typeable1 w) => Typeable1 (CofreeT f w) where
typeOf1 t = mkTyConApp cofreeTTyCon [typeOf1 (f t), typeOf1 (w t)] where
f :: CofreeT f w a -> f a
f = undefined
w :: CofreeT f w a -> w a
w = undefined
cofreeFTyCon, cofreeTTyCon :: TyCon
#if __GLASGOW_HASKELL__ < 704
cofreeTTyCon = mkTyCon "Control.Comonad.Trans.Cofree.CofreeT"
cofreeFTyCon = mkTyCon "Control.Comonad.Trans.Cofree.CofreeF"
#else
cofreeTTyCon = mkTyCon3 "free" "Control.Comonad.Trans.Cofree" "CofreeT"
cofreeFTyCon = mkTyCon3 "free" "Control.Comonad.Trans.Cofree" "CofreeF"
#endif
{-# NOINLINE cofreeTTyCon #-}
{-# NOINLINE cofreeFTyCon #-}
#else
#define Typeable1 Typeable
#endif
instance
( Typeable1 f, Typeable a, Typeable b
, Data a, Data (f b), Data b
) => Data (CofreeF f a b) where
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CofreeF f a b -> c (CofreeF f a b)
gfoldl forall d b. Data d => c (d -> b) -> d -> c b
f forall g. g -> c g
z (a
a :< f b
as) = forall g. g -> c g
z forall (f :: * -> *) a b. a -> f b -> CofreeF f a b
(:<) forall d b. Data d => c (d -> b) -> d -> c b
`f` a
a forall d b. Data d => c (d -> b) -> d -> c b
`f` f b
as
toConstr :: CofreeF f a b -> Constr
toConstr CofreeF f a b
_ = Constr
cofreeFConstr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (CofreeF f a b)
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 -> forall b r. Data b => c (b -> r) -> c r
k (forall b r. Data b => c (b -> r) -> c r
k (forall r. r -> c r
z forall (f :: * -> *) a b. a -> f b -> CofreeF f a b
(:<)))
Int
_ -> forall a. HasCallStack => String -> a
error String
"gunfold"
dataTypeOf :: CofreeF f a b -> DataType
dataTypeOf CofreeF f a b
_ = DataType
cofreeFDataType
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (CofreeF f a b))
dataCast1 forall d. Data d => c (t d)
f = 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 forall d. Data d => c (t d)
f
instance
( Typeable1 f, Typeable1 w, Typeable a
, Data (w (CofreeF f a (CofreeT f w a)))
, Data a
) => Data (CofreeT f w a) where
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CofreeT f w a -> c (CofreeT f w a)
gfoldl forall d b. Data d => c (d -> b) -> d -> c b
f forall g. g -> c g
z (CofreeT w (CofreeF f a (CofreeT f w a))
w) = forall g. g -> c g
z forall (f :: * -> *) (w :: * -> *) a.
w (CofreeF f a (CofreeT f w a)) -> CofreeT f w a
CofreeT forall d b. Data d => c (d -> b) -> d -> c b
`f` w (CofreeF f a (CofreeT f w a))
w
toConstr :: CofreeT f w a -> Constr
toConstr CofreeT f w a
_ = Constr
cofreeTConstr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (CofreeT f 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 -> forall b r. Data b => c (b -> r) -> c r
k (forall r. r -> c r
z forall (f :: * -> *) (w :: * -> *) a.
w (CofreeF f a (CofreeT f w a)) -> CofreeT f w a
CofreeT)
Int
_ -> forall a. HasCallStack => String -> a
error String
"gunfold"
dataTypeOf :: CofreeT f w a -> DataType
dataTypeOf CofreeT f w a
_ = DataType
cofreeTDataType
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (CofreeT f w a))
dataCast1 forall d. Data d => c (t d)
f = 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 forall d. Data d => c (t d)
f
cofreeFConstr, cofreeTConstr :: Constr
cofreeFConstr :: Constr
cofreeFConstr = DataType -> String -> [String] -> Fixity -> Constr
mkConstr DataType
cofreeFDataType String
":<" [] Fixity
Infix
cofreeTConstr :: Constr
cofreeTConstr = DataType -> String -> [String] -> Fixity -> Constr
mkConstr DataType
cofreeTDataType String
"CofreeT" [] Fixity
Prefix
{-# NOINLINE cofreeFConstr #-}
{-# NOINLINE cofreeTConstr #-}
cofreeFDataType, cofreeTDataType :: DataType
cofreeFDataType :: DataType
cofreeFDataType = String -> [Constr] -> DataType
mkDataType String
"Control.Comonad.Trans.Cofree.CofreeF" [Constr
cofreeFConstr]
cofreeTDataType :: DataType
cofreeTDataType = String -> [Constr] -> DataType
mkDataType String
"Control.Comonad.Trans.Cofree.CofreeT" [Constr
cofreeTConstr]
{-# NOINLINE cofreeFDataType #-}
{-# NOINLINE cofreeTDataType #-}