{-# LANGUAGE CPP #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
#if __GLASGOW_HASKELL__ >= 707
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE Safe #-}
#else
{-# LANGUAGE Trustworthy #-}
#endif
#include "free-common.h"
module Control.Comonad.Cofree
( Cofree(..)
, ComonadCofree(..)
, section
, coiter
, coiterW
, unfold
, unfoldM
, hoistCofree
, _extract
, _unwrap
, telescoped
, telescoped_
, shoots
, leaves
) 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.Store.Class as Class
import Control.Comonad.Traced.Class
import Control.Comonad.Hoist.Class
import Control.Category
import Control.Monad(ap, (>=>), liftM)
import Control.Monad.Zip
import Data.Functor.Bind
import Data.Functor.Classes.Compat
import Data.Functor.Extend
import Data.Functor.WithIndex
import Data.Data
import Data.Distributive
import Data.Foldable
import Data.Foldable.WithIndex
import Data.Semigroup
import Data.Traversable
import Data.Traversable.WithIndex
import Data.Semigroup.Foldable
import Data.Semigroup.Traversable
import Prelude hiding (id,(.))
#if __GLASGOW_HASKELL__ >= 707
import GHC.Generics hiding (Infix, Prefix)
#endif
infixr 5 :<
data Cofree f a = a :< f (Cofree f a)
#if __GLASGOW_HASKELL__ >= 707
deriving (Typeable, (forall x. Cofree f a -> Rep (Cofree f a) x)
-> (forall x. Rep (Cofree f a) x -> Cofree f a)
-> Generic (Cofree f a)
forall x. Rep (Cofree f a) x -> Cofree f a
forall x. Cofree f a -> Rep (Cofree f a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (f :: * -> *) a x. Rep (Cofree f a) x -> Cofree f a
forall (f :: * -> *) a x. Cofree f a -> Rep (Cofree f a) x
$cto :: forall (f :: * -> *) a x. Rep (Cofree f a) x -> Cofree f a
$cfrom :: forall (f :: * -> *) a x. Cofree f a -> Rep (Cofree f a) x
Generic, (forall a. Cofree f a -> Rep1 (Cofree f) a)
-> (forall a. Rep1 (Cofree f) a -> Cofree f a)
-> Generic1 (Cofree f)
forall a. Rep1 (Cofree f) a -> Cofree f a
forall a. Cofree f a -> Rep1 (Cofree f) a
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.
Functor f =>
Rep1 (Cofree f) a -> Cofree f a
forall (f :: * -> *) a.
Functor f =>
Cofree f a -> Rep1 (Cofree f) a
$cto1 :: forall (f :: * -> *) a.
Functor f =>
Rep1 (Cofree f) a -> Cofree f a
$cfrom1 :: forall (f :: * -> *) a.
Functor f =>
Cofree f a -> Rep1 (Cofree f) a
Generic1)
deriving instance (Typeable f, Data (f (Cofree f a)), Data a) => Data (Cofree f a)
#endif
coiter :: Functor f => (a -> f a) -> a -> Cofree f a
coiter :: (a -> f a) -> a -> Cofree f a
coiter a -> f a
psi a
a = a
a a -> f (Cofree f a) -> Cofree f a
forall (f :: * -> *) a. a -> f (Cofree f a) -> Cofree f a
:< ((a -> f a) -> a -> Cofree f a
forall (f :: * -> *) a. Functor f => (a -> f a) -> a -> Cofree f a
coiter a -> f a
psi (a -> Cofree f a) -> f a -> f (Cofree f a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f a
psi a
a)
coiterW :: (Comonad w, Functor f) => (w a -> f (w a)) -> w a -> Cofree f a
coiterW :: (w a -> f (w a)) -> w a -> Cofree f a
coiterW w a -> f (w a)
psi w a
a = w a -> a
forall (w :: * -> *) a. Comonad w => w a -> a
extract w a
a a -> f (Cofree f a) -> Cofree f a
forall (f :: * -> *) a. a -> f (Cofree f a) -> Cofree f a
:< ((w a -> f (w a)) -> w a -> Cofree f a
forall (w :: * -> *) (f :: * -> *) a.
(Comonad w, Functor f) =>
(w a -> f (w a)) -> w a -> Cofree f a
coiterW w a -> f (w a)
psi (w a -> Cofree f a) -> f (w a) -> f (Cofree f a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> w a -> f (w a)
psi w a
a)
unfold :: Functor f => (b -> (a, f b)) -> b -> Cofree f a
unfold :: (b -> (a, f b)) -> b -> Cofree f a
unfold b -> (a, f b)
f b
c = case b -> (a, f b)
f b
c of
(a
x, f b
d) -> a
x a -> f (Cofree f a) -> Cofree f a
forall (f :: * -> *) a. a -> f (Cofree f a) -> Cofree f a
:< (b -> Cofree f a) -> f b -> f (Cofree f a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((b -> (a, f b)) -> b -> Cofree f a
forall (f :: * -> *) b a.
Functor f =>
(b -> (a, f b)) -> b -> Cofree f a
unfold b -> (a, f b)
f) f b
d
unfoldM :: (Traversable f, Monad m) => (b -> m (a, f b)) -> b -> m (Cofree f a)
unfoldM :: (b -> m (a, f b)) -> b -> m (Cofree f a)
unfoldM b -> m (a, f b)
f = b -> m (a, f b)
f (b -> m (a, f b))
-> ((a, f b) -> m (Cofree f a)) -> b -> m (Cofree f a)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> \ (a
x, f b
t) -> (a
x a -> f (Cofree f a) -> Cofree f a
forall (f :: * -> *) a. a -> f (Cofree f a) -> Cofree f a
:<) (f (Cofree f a) -> Cofree f a)
-> m (f (Cofree f a)) -> m (Cofree f a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` (b -> m (Cofree f a)) -> f b -> m (f (Cofree f a))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
Data.Traversable.mapM ((b -> m (a, f b)) -> b -> m (Cofree f a)
forall (f :: * -> *) (m :: * -> *) b a.
(Traversable f, Monad m) =>
(b -> m (a, f b)) -> b -> m (Cofree f a)
unfoldM b -> m (a, f b)
f) f b
t
hoistCofree :: Functor f => (forall x . f x -> g x) -> Cofree f a -> Cofree g a
hoistCofree :: (forall x. f x -> g x) -> Cofree f a -> Cofree g a
hoistCofree forall x. f x -> g x
f (a
x :< f (Cofree f a)
y) = a
x a -> g (Cofree g a) -> Cofree g a
forall (f :: * -> *) a. a -> f (Cofree f a) -> Cofree f a
:< f (Cofree g a) -> g (Cofree g a)
forall x. f x -> g x
f ((forall x. f x -> g x) -> Cofree f a -> Cofree g a
forall (f :: * -> *) (g :: * -> *) a.
Functor f =>
(forall x. f x -> g x) -> Cofree f a -> Cofree g a
hoistCofree forall x. f x -> g x
f (Cofree f a -> Cofree g a) -> f (Cofree f a) -> f (Cofree g a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (Cofree f a)
y)
instance Functor f => ComonadCofree f (Cofree f) where
unwrap :: Cofree f a -> f (Cofree f a)
unwrap (a
_ :< f (Cofree f a)
as) = f (Cofree f a)
as
{-# INLINE unwrap #-}
instance Distributive f => Distributive (Cofree f) where
distribute :: f (Cofree f a) -> Cofree f (f a)
distribute f (Cofree f a)
w = (Cofree f a -> a) -> f (Cofree f a) -> f a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Cofree f a -> a
forall (w :: * -> *) a. Comonad w => w a -> a
extract f (Cofree f a)
w f a -> f (Cofree f (f a)) -> Cofree f (f a)
forall (f :: * -> *) a. a -> f (Cofree f a) -> Cofree f a
:< (f (Cofree f a) -> Cofree f (f a))
-> f (f (Cofree f a)) -> f (Cofree f (f a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f (Cofree f a) -> Cofree f (f a)
forall (g :: * -> *) (f :: * -> *) a.
(Distributive g, Functor f) =>
f (g a) -> g (f a)
distribute ((Cofree f a -> f (Cofree f a))
-> f (Cofree f a) -> f (f (Cofree f a))
forall (g :: * -> *) (f :: * -> *) a b.
(Distributive g, Functor f) =>
(a -> g b) -> f a -> g (f b)
collect Cofree f a -> f (Cofree f a)
forall (f :: * -> *) (w :: * -> *) a.
ComonadCofree f w =>
w a -> f (w a)
unwrap f (Cofree f a)
w)
instance Functor f => Functor (Cofree f) where
fmap :: (a -> b) -> Cofree f a -> Cofree f b
fmap a -> b
f (a
a :< f (Cofree f a)
as) = a -> b
f a
a b -> f (Cofree f b) -> Cofree f b
forall (f :: * -> *) a. a -> f (Cofree f a) -> Cofree f a
:< (Cofree f a -> Cofree f b) -> f (Cofree f a) -> f (Cofree f b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> Cofree f a -> Cofree f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) f (Cofree f a)
as
a
b <$ :: a -> Cofree f b -> Cofree f a
<$ (b
_ :< f (Cofree f b)
as) = a
b a -> f (Cofree f a) -> Cofree f a
forall (f :: * -> *) a. a -> f (Cofree f a) -> Cofree f a
:< (Cofree f b -> Cofree f a) -> f (Cofree f b) -> f (Cofree f a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a
b a -> Cofree f b -> Cofree f a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$) f (Cofree f b)
as
instance Functor f => Extend (Cofree f) where
extended :: (Cofree f a -> b) -> Cofree f a -> Cofree f b
extended = (Cofree f a -> b) -> Cofree f a -> Cofree f b
forall (w :: * -> *) a b. Comonad w => (w a -> b) -> w a -> w b
extend
{-# INLINE extended #-}
duplicated :: Cofree f a -> Cofree f (Cofree f a)
duplicated = Cofree f a -> Cofree f (Cofree f a)
forall (w :: * -> *) a. Comonad w => w a -> w (w a)
duplicate
{-# INLINE duplicated #-}
instance Functor f => Comonad (Cofree f) where
extend :: (Cofree f a -> b) -> Cofree f a -> Cofree f b
extend Cofree f a -> b
f Cofree f a
w = Cofree f a -> b
f Cofree f a
w b -> f (Cofree f b) -> Cofree f b
forall (f :: * -> *) a. a -> f (Cofree f a) -> Cofree f a
:< (Cofree f a -> Cofree f b) -> f (Cofree f a) -> f (Cofree f b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Cofree f a -> b) -> Cofree f a -> Cofree f b
forall (w :: * -> *) a b. Comonad w => (w a -> b) -> w a -> w b
extend Cofree f a -> b
f) (Cofree f a -> f (Cofree f a)
forall (f :: * -> *) (w :: * -> *) a.
ComonadCofree f w =>
w a -> f (w a)
unwrap Cofree f a
w)
duplicate :: Cofree f a -> Cofree f (Cofree f a)
duplicate Cofree f a
w = Cofree f a
w Cofree f a -> f (Cofree f (Cofree f a)) -> Cofree f (Cofree f a)
forall (f :: * -> *) a. a -> f (Cofree f a) -> Cofree f a
:< (Cofree f a -> Cofree f (Cofree f a))
-> f (Cofree f a) -> f (Cofree f (Cofree f a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Cofree f a -> Cofree f (Cofree f a)
forall (w :: * -> *) a. Comonad w => w a -> w (w a)
duplicate (Cofree f a -> f (Cofree f a)
forall (f :: * -> *) (w :: * -> *) a.
ComonadCofree f w =>
w a -> f (w a)
unwrap Cofree f a
w)
extract :: Cofree f a -> a
extract (a
a :< f (Cofree f a)
_) = a
a
{-# INLINE extract #-}
instance ComonadTrans Cofree where
lower :: Cofree w a -> w a
lower (a
_ :< w (Cofree w a)
as) = (Cofree w a -> a) -> w (Cofree w a) -> w a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Cofree w a -> a
forall (w :: * -> *) a. Comonad w => w a -> a
extract w (Cofree w a)
as
{-# INLINE lower #-}
instance Alternative f => Monad (Cofree f) where
return :: a -> Cofree f a
return = a -> Cofree f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
{-# INLINE return #-}
(a
a :< f (Cofree f a)
m) >>= :: Cofree f a -> (a -> Cofree f b) -> Cofree f b
>>= a -> Cofree f b
k = case a -> Cofree f b
k a
a of
b
b :< f (Cofree f b)
n -> b
b b -> f (Cofree f b) -> Cofree f b
forall (f :: * -> *) a. a -> f (Cofree f a) -> Cofree f a
:< (f (Cofree f b)
n f (Cofree f b) -> f (Cofree f b) -> f (Cofree f b)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Cofree f a -> Cofree f b) -> f (Cofree f a) -> f (Cofree f b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Cofree f a -> (a -> Cofree f b) -> Cofree f b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> Cofree f b
k) f (Cofree f a)
m)
instance (Alternative f, MonadZip f) => MonadZip (Cofree f) where
mzip :: Cofree f a -> Cofree f b -> Cofree f (a, b)
mzip (a
a :< f (Cofree f a)
as) (b
b :< f (Cofree f b)
bs) = (a
a, b
b) (a, b) -> f (Cofree f (a, b)) -> Cofree f (a, b)
forall (f :: * -> *) a. a -> f (Cofree f a) -> Cofree f a
:< ((Cofree f a, Cofree f b) -> Cofree f (a, b))
-> f (Cofree f a, Cofree f b) -> f (Cofree f (a, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Cofree f a -> Cofree f b -> Cofree f (a, b))
-> (Cofree f a, Cofree f b) -> Cofree f (a, b)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Cofree f a -> Cofree f b -> Cofree f (a, b)
forall (m :: * -> *) a b. MonadZip m => m a -> m b -> m (a, b)
mzip) (f (Cofree f a) -> f (Cofree f b) -> f (Cofree f a, Cofree f b)
forall (m :: * -> *) a b. MonadZip m => m a -> m b -> m (a, b)
mzip f (Cofree f a)
as f (Cofree f b)
bs)
section :: Comonad f => f a -> Cofree f a
section :: f a -> Cofree f a
section f a
as = f a -> a
forall (w :: * -> *) a. Comonad w => w a -> a
extract f a
as a -> f (Cofree f a) -> Cofree f a
forall (f :: * -> *) a. a -> f (Cofree f a) -> Cofree f a
:< (f a -> Cofree f a) -> f a -> f (Cofree f a)
forall (w :: * -> *) a b. Comonad w => (w a -> b) -> w a -> w b
extend f a -> Cofree f a
forall (f :: * -> *) a. Comonad f => f a -> Cofree f a
section f a
as
instance Apply f => Apply (Cofree f) where
(a -> b
f :< f (Cofree f (a -> b))
fs) <.> :: Cofree f (a -> b) -> Cofree f a -> Cofree f b
<.> (a
a :< f (Cofree f a)
as) = a -> b
f a
a b -> f (Cofree f b) -> Cofree f b
forall (f :: * -> *) a. a -> f (Cofree f a) -> Cofree f a
:< (Cofree f (a -> b) -> Cofree f a -> Cofree f b
forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
(<.>) (Cofree f (a -> b) -> Cofree f a -> Cofree f b)
-> f (Cofree f (a -> b)) -> f (Cofree f a -> Cofree f b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (Cofree f (a -> b))
fs f (Cofree f a -> Cofree f b) -> f (Cofree f a) -> f (Cofree f b)
forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
<.> f (Cofree f a)
as)
{-# INLINE (<.>) #-}
(a
f :< f (Cofree f a)
fs) <. :: Cofree f a -> Cofree f b -> Cofree f a
<. (b
_ :< f (Cofree f b)
as) = a
f a -> f (Cofree f a) -> Cofree f a
forall (f :: * -> *) a. a -> f (Cofree f a) -> Cofree f a
:< ((<. ) (Cofree f a -> Cofree f b -> Cofree f a)
-> f (Cofree f a) -> f (Cofree f b -> Cofree f a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (Cofree f a)
fs f (Cofree f b -> Cofree f a) -> f (Cofree f b) -> f (Cofree f a)
forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
<.> f (Cofree f b)
as)
{-# INLINE (<.) #-}
(a
_ :< f (Cofree f a)
fs) .> :: Cofree f a -> Cofree f b -> Cofree f b
.> (b
a :< f (Cofree f b)
as) = b
a b -> f (Cofree f b) -> Cofree f b
forall (f :: * -> *) a. a -> f (Cofree f a) -> Cofree f a
:< (( .>) (Cofree f a -> Cofree f b -> Cofree f b)
-> f (Cofree f a) -> f (Cofree f b -> Cofree f b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (Cofree f a)
fs f (Cofree f b -> Cofree f b) -> f (Cofree f b) -> f (Cofree f b)
forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
<.> f (Cofree f b)
as)
{-# INLINE (.>) #-}
instance ComonadApply f => ComonadApply (Cofree f) where
(a -> b
f :< f (Cofree f (a -> b))
fs) <@> :: Cofree f (a -> b) -> Cofree f a -> Cofree f b
<@> (a
a :< f (Cofree f a)
as) = a -> b
f a
a b -> f (Cofree f b) -> Cofree f b
forall (f :: * -> *) a. a -> f (Cofree f a) -> Cofree f a
:< (Cofree f (a -> b) -> Cofree f a -> Cofree f b
forall (w :: * -> *) a b.
ComonadApply w =>
w (a -> b) -> w a -> w b
(<@>) (Cofree f (a -> b) -> Cofree f a -> Cofree f b)
-> f (Cofree f (a -> b)) -> f (Cofree f a -> Cofree f b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (Cofree f (a -> b))
fs f (Cofree f a -> Cofree f b) -> f (Cofree f a) -> f (Cofree f b)
forall (w :: * -> *) a b.
ComonadApply w =>
w (a -> b) -> w a -> w b
<@> f (Cofree f a)
as)
{-# INLINE (<@>) #-}
(a
f :< f (Cofree f a)
fs) <@ :: Cofree f a -> Cofree f b -> Cofree f a
<@ (b
_ :< f (Cofree f b)
as) = a
f a -> f (Cofree f a) -> Cofree f a
forall (f :: * -> *) a. a -> f (Cofree f a) -> Cofree f a
:< ((<@ ) (Cofree f a -> Cofree f b -> Cofree f a)
-> f (Cofree f a) -> f (Cofree f b -> Cofree f a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (Cofree f a)
fs f (Cofree f b -> Cofree f a) -> f (Cofree f b) -> f (Cofree f a)
forall (w :: * -> *) a b.
ComonadApply w =>
w (a -> b) -> w a -> w b
<@> f (Cofree f b)
as)
{-# INLINE (<@) #-}
(a
_ :< f (Cofree f a)
fs) @> :: Cofree f a -> Cofree f b -> Cofree f b
@> (b
a :< f (Cofree f b)
as) = b
a b -> f (Cofree f b) -> Cofree f b
forall (f :: * -> *) a. a -> f (Cofree f a) -> Cofree f a
:< (( @>) (Cofree f a -> Cofree f b -> Cofree f b)
-> f (Cofree f a) -> f (Cofree f b -> Cofree f b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (Cofree f a)
fs f (Cofree f b -> Cofree f b) -> f (Cofree f b) -> f (Cofree f b)
forall (w :: * -> *) a b.
ComonadApply w =>
w (a -> b) -> w a -> w b
<@> f (Cofree f b)
as)
{-# INLINE (@>) #-}
instance Alternative f => Applicative (Cofree f) where
pure :: a -> Cofree f a
pure a
x = a
x a -> f (Cofree f a) -> Cofree f a
forall (f :: * -> *) a. a -> f (Cofree f a) -> Cofree f a
:< f (Cofree f a)
forall (f :: * -> *) a. Alternative f => f a
empty
{-# INLINE pure #-}
<*> :: Cofree f (a -> b) -> Cofree f a -> Cofree f b
(<*>) = Cofree f (a -> b) -> Cofree f a -> Cofree f b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
{-# INLINE (<*>) #-}
#ifdef LIFTED_FUNCTOR_CLASSES
instance (Show1 f) => Show1 (Cofree f) where
liftShowsPrec :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Cofree f a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl = Int -> Cofree f a -> ShowS
go
where
goList :: [Cofree f a] -> ShowS
goList = (Int -> a -> ShowS) -> ([a] -> ShowS) -> [Cofree f 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 -> Cofree f a -> ShowS
go Int
d (a
a :< f (Cofree f a)
as) = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
5) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
Int -> a -> ShowS
sp Int
6 a
a ShowS -> ShowS -> ShowS
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
" :< " ShowS -> ShowS -> ShowS
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Int -> Cofree f a -> ShowS)
-> ([Cofree f a] -> ShowS) -> Int -> f (Cofree f a) -> ShowS
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec Int -> Cofree f a -> ShowS
go [Cofree f a] -> ShowS
goList Int
5 f (Cofree f a)
as
#else
instance (Functor f, Show1 f) => Show1 (Cofree f) where
showsPrec1 d (a :< as) = showParen (d > 5) $
showsPrec 6 a . showString " :< " . showsPrec1 5 (fmap Lift1 as)
#endif
#ifdef LIFTED_FUNCTOR_CLASSES
instance (Show1 f, Show a) => Show (Cofree f a) where
#else
instance (Functor f, Show1 f, Show a) => Show (Cofree f a) where
#endif
showsPrec :: Int -> Cofree f a -> ShowS
showsPrec = Int -> Cofree f a -> ShowS
forall (f :: * -> *) a. (Show1 f, Show a) => Int -> f a -> ShowS
showsPrec1
#ifdef LIFTED_FUNCTOR_CLASSES
instance (Read1 f) => Read1 (Cofree f) where
liftReadsPrec :: (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (Cofree f a)
liftReadsPrec Int -> ReadS a
rp ReadS [a]
rl = Int -> ReadS (Cofree f a)
go
where
goList :: ReadS [Cofree f a]
goList = (Int -> ReadS a) -> ReadS [a] -> ReadS [Cofree f 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 (Cofree f a)
go Int
d String
r = Bool -> ReadS (Cofree f a) -> ReadS (Cofree f a)
forall a. Bool -> ReadS a -> ReadS a
readParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
5)
(\String
r' -> [(a
u a -> f (Cofree f a) -> Cofree f a
forall (f :: * -> *) a. a -> f (Cofree f a) -> Cofree f a
:< f (Cofree f a)
v, String
w) |
(a
u, String
s) <- Int -> ReadS a
rp Int
6 String
r',
(String
":<", String
t) <- ReadS String
lex String
s,
(f (Cofree f a)
v, String
w) <- (Int -> ReadS (Cofree f a))
-> ReadS [Cofree f a] -> Int -> ReadS (f (Cofree f a))
forall (f :: * -> *) a.
Read1 f =>
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (f a)
liftReadsPrec Int -> ReadS (Cofree f a)
go ReadS [Cofree f a]
goList Int
5 String
t]) String
r
#else
instance (Functor f, Read1 f) => Read1 (Cofree f) where
readsPrec1 d r = readParen (d > 5)
(\r' -> [(u :< fmap lower1 v,w) |
(u, s) <- readsPrec 6 r',
(":<", t) <- lex s,
(v, w) <- readsPrec1 5 t]) r
#endif
#ifdef LIFTED_FUNCTOR_CLASSES
instance (Read1 f, Read a) => Read (Cofree f a) where
#else
instance (Functor f, Read1 f, Read a) => Read (Cofree f a) where
#endif
readsPrec :: Int -> ReadS (Cofree f a)
readsPrec = Int -> ReadS (Cofree f a)
forall (f :: * -> *) a. (Read1 f, Read a) => Int -> ReadS (f a)
readsPrec1
#ifdef LIFTED_FUNCTOR_CLASSES
instance (Eq1 f, Eq a) => Eq (Cofree f a) where
#else
instance (Functor f, Eq1 f, Eq a) => Eq (Cofree f a) where
#endif
== :: Cofree f a -> Cofree f a -> Bool
(==) = Cofree f a -> Cofree f a -> Bool
forall (f :: * -> *) a. (Eq1 f, Eq a) => f a -> f a -> Bool
eq1
#ifdef LIFTED_FUNCTOR_CLASSES
instance (Eq1 f) => Eq1 (Cofree f) where
liftEq :: (a -> b -> Bool) -> Cofree f a -> Cofree f b -> Bool
liftEq a -> b -> Bool
eq = Cofree f a -> Cofree f b -> Bool
forall (f :: * -> *). Eq1 f => Cofree f a -> Cofree f b -> Bool
go
where
go :: Cofree f a -> Cofree f b -> Bool
go (a
a :< f (Cofree f a)
as) (b
b :< f (Cofree f b)
bs) = a -> b -> Bool
eq a
a b
b Bool -> Bool -> Bool
&& (Cofree f a -> Cofree f b -> Bool)
-> f (Cofree f a) -> f (Cofree f b) -> Bool
forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq Cofree f a -> Cofree f b -> Bool
go f (Cofree f a)
as f (Cofree f b)
bs
#else
instance (Functor f, Eq1 f) => Eq1 (Cofree f) where
#ifndef HLINT
eq1 (a :< as) (b :< bs) = a == b && eq1 (fmap Lift1 as) (fmap Lift1 bs)
#endif
#endif
#ifdef LIFTED_FUNCTOR_CLASSES
instance (Ord1 f, Ord a) => Ord (Cofree f a) where
#else
instance (Functor f, Ord1 f, Ord a) => Ord (Cofree f a) where
#endif
compare :: Cofree f a -> Cofree f a -> Ordering
compare = Cofree f a -> Cofree f a -> Ordering
forall (f :: * -> *) a. (Ord1 f, Ord a) => f a -> f a -> Ordering
compare1
#ifdef LIFTED_FUNCTOR_CLASSES
instance (Ord1 f) => Ord1 (Cofree f) where
liftCompare :: (a -> b -> Ordering) -> Cofree f a -> Cofree f b -> Ordering
liftCompare a -> b -> Ordering
cmp = Cofree f a -> Cofree f b -> Ordering
forall (f :: * -> *).
Ord1 f =>
Cofree f a -> Cofree f b -> Ordering
go
where
go :: Cofree f a -> Cofree f b -> Ordering
go (a
a :< f (Cofree f a)
as) (b
b :< f (Cofree f b)
bs) = a -> b -> Ordering
cmp a
a b
b Ordering -> Ordering -> Ordering
forall a. Monoid a => a -> a -> a
`mappend` (Cofree f a -> Cofree f b -> Ordering)
-> f (Cofree f a) -> f (Cofree f b) -> Ordering
forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare Cofree f a -> Cofree f b -> Ordering
go f (Cofree f a)
as f (Cofree f b)
bs
#else
instance (Functor f, Ord1 f) => Ord1 (Cofree f) where
compare1 (a :< as) (b :< bs) = case compare a b of
LT -> LT
EQ -> compare1 (fmap Lift1 as) (fmap Lift1 bs)
GT -> GT
#endif
instance Foldable f => Foldable (Cofree f) where
foldMap :: (a -> m) -> Cofree f a -> m
foldMap a -> m
f = Cofree f a -> m
forall (t :: * -> *). Foldable t => Cofree t a -> m
go where
go :: Cofree t a -> m
go (a
a :< t (Cofree t a)
as) = a -> m
f a
a m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` (Cofree t a -> m) -> t (Cofree t a) -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Cofree t a -> m
go t (Cofree t a)
as
{-# INLINE foldMap #-}
#if __GLASGOW_HASKELL__ >= 709
length :: Cofree f a -> Int
length = Int -> Cofree f a -> Int
forall (t :: * -> *) b a.
(Foldable t, Num b) =>
b -> Cofree t a -> b
go Int
0 where
go :: b -> Cofree t a -> b
go b
s (a
_ :< t (Cofree t a)
as) = (b -> Cofree t a -> b) -> b -> t (Cofree t a) -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' b -> Cofree t a -> b
go (b
s b -> b -> b
forall a. Num a => a -> a -> a
+ b
1) t (Cofree t a)
as
#endif
instance Foldable1 f => Foldable1 (Cofree f) where
foldMap1 :: (a -> m) -> Cofree f a -> m
foldMap1 a -> m
f = Cofree f a -> m
forall (t :: * -> *). Foldable1 t => Cofree t a -> m
go where
go :: Cofree t a -> m
go (a
a :< t (Cofree t a)
as) = a -> m
f a
a m -> m -> m
forall a. Semigroup a => a -> a -> a
<> (Cofree t a -> m) -> t (Cofree t a) -> m
forall (t :: * -> *) m a.
(Foldable1 t, Semigroup m) =>
(a -> m) -> t a -> m
foldMap1 Cofree t a -> m
go t (Cofree t a)
as
{-# INLINE foldMap1 #-}
instance Traversable f => Traversable (Cofree f) where
traverse :: (a -> f b) -> Cofree f a -> f (Cofree f b)
traverse a -> f b
f = Cofree f a -> f (Cofree f b)
forall (f :: * -> *). Traversable f => Cofree f a -> f (Cofree f b)
go where
go :: Cofree f a -> f (Cofree f b)
go (a
a :< f (Cofree f a)
as) = b -> f (Cofree f b) -> Cofree f b
forall (f :: * -> *) a. a -> f (Cofree f a) -> Cofree f a
(:<) (b -> f (Cofree f b) -> Cofree f b)
-> f b -> f (f (Cofree f b) -> Cofree f b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
a f (f (Cofree f b) -> Cofree f b)
-> f (f (Cofree f b)) -> f (Cofree f b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Cofree f a -> f (Cofree f b))
-> f (Cofree f a) -> f (f (Cofree f b))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Cofree f a -> f (Cofree f b)
go f (Cofree f a)
as
{-# INLINE traverse #-}
instance Traversable1 f => Traversable1 (Cofree f) where
traverse1 :: (a -> f b) -> Cofree f a -> f (Cofree f b)
traverse1 a -> f b
f = Cofree f a -> f (Cofree f b)
forall (f :: * -> *).
Traversable1 f =>
Cofree f a -> f (Cofree f b)
go where
go :: Cofree f a -> f (Cofree f b)
go (a
a :< f (Cofree f a)
as) = b -> f (Cofree f b) -> Cofree f b
forall (f :: * -> *) a. a -> f (Cofree f a) -> Cofree f a
(:<) (b -> f (Cofree f b) -> Cofree f b)
-> f b -> f (f (Cofree f b) -> Cofree f b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
a f (f (Cofree f b) -> Cofree f b)
-> f (f (Cofree f b)) -> f (Cofree f b)
forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
<.> (Cofree f a -> f (Cofree f b))
-> f (Cofree f a) -> f (f (Cofree f b))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable1 t, Apply f) =>
(a -> f b) -> t a -> f (t b)
traverse1 Cofree f a -> f (Cofree f b)
go f (Cofree f a)
as
{-# INLINE traverse1 #-}
instance FunctorWithIndex i f => FunctorWithIndex [i] (Cofree f) where
imap :: ([i] -> a -> b) -> Cofree f a -> Cofree f b
imap [i] -> a -> b
f (a
a :< f (Cofree f a)
as) = [i] -> a -> b
f [] a
a b -> f (Cofree f b) -> Cofree f b
forall (f :: * -> *) a. a -> f (Cofree f a) -> Cofree f a
:< (i -> Cofree f a -> Cofree f b) -> f (Cofree f a) -> f (Cofree f b)
forall i (f :: * -> *) a b.
FunctorWithIndex i f =>
(i -> a -> b) -> f a -> f b
imap (\i
i -> ([i] -> a -> b) -> Cofree f a -> Cofree f b
forall i (f :: * -> *) a b.
FunctorWithIndex i f =>
(i -> a -> b) -> f a -> f b
imap ([i] -> a -> b
f ([i] -> a -> b) -> ([i] -> [i]) -> [i] -> a -> b
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (:) i
i)) f (Cofree f a)
as
{-# INLINE imap #-}
instance FoldableWithIndex i f => FoldableWithIndex [i] (Cofree f) where
ifoldMap :: ([i] -> a -> m) -> Cofree f a -> m
ifoldMap [i] -> a -> m
f (a
a :< f (Cofree f a)
as) = [i] -> a -> m
f [] a
a m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` (i -> Cofree f a -> m) -> f (Cofree f a) -> m
forall i (f :: * -> *) m a.
(FoldableWithIndex i f, Monoid m) =>
(i -> a -> m) -> f a -> m
ifoldMap (\i
i -> ([i] -> a -> m) -> Cofree f a -> m
forall i (f :: * -> *) m a.
(FoldableWithIndex i f, Monoid m) =>
(i -> a -> m) -> f a -> m
ifoldMap ([i] -> a -> m
f ([i] -> a -> m) -> ([i] -> [i]) -> [i] -> a -> m
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (:) i
i)) f (Cofree f a)
as
{-# INLINE ifoldMap #-}
instance TraversableWithIndex i f => TraversableWithIndex [i] (Cofree f) where
itraverse :: ([i] -> a -> f b) -> Cofree f a -> f (Cofree f b)
itraverse [i] -> a -> f b
f (a
a :< f (Cofree f a)
as) = b -> f (Cofree f b) -> Cofree f b
forall (f :: * -> *) a. a -> f (Cofree f a) -> Cofree f a
(:<) (b -> f (Cofree f b) -> Cofree f b)
-> f b -> f (f (Cofree f b) -> Cofree f b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [i] -> a -> f b
f [] a
a f (f (Cofree f b) -> Cofree f b)
-> f (f (Cofree f b)) -> f (Cofree f b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (i -> Cofree f a -> f (Cofree f b))
-> f (Cofree f a) -> f (f (Cofree f b))
forall i (t :: * -> *) (f :: * -> *) a b.
(TraversableWithIndex i t, Applicative f) =>
(i -> a -> f b) -> t a -> f (t b)
itraverse (\i
i -> ([i] -> a -> f b) -> Cofree f a -> f (Cofree f b)
forall i (t :: * -> *) (f :: * -> *) a b.
(TraversableWithIndex i t, Applicative f) =>
(i -> a -> f b) -> t a -> f (t b)
itraverse ([i] -> a -> f b
f ([i] -> a -> f b) -> ([i] -> [i]) -> [i] -> a -> f b
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (:) i
i)) f (Cofree f a)
as
{-# INLINE itraverse #-}
#if __GLASGOW_HASKELL__ < 707
instance (Typeable1 f) => Typeable1 (Cofree f) where
typeOf1 dfa = mkTyConApp cofreeTyCon [typeOf1 (f dfa)]
where
f :: Cofree f a -> f a
f = undefined
instance (Typeable1 f, Typeable a) => Typeable (Cofree f a) where
typeOf = typeOfDefault
cofreeTyCon :: TyCon
#if __GLASGOW_HASKELL__ < 704
cofreeTyCon = mkTyCon "Control.Comonad.Cofree.Cofree"
#else
cofreeTyCon = mkTyCon3 "free" "Control.Comonad.Cofree" "Cofree"
#endif
{-# NOINLINE cofreeTyCon #-}
instance
( Typeable1 f
, Data (f (Cofree f a))
, Data a
) => Data (Cofree f a) where
gfoldl f z (a :< as) = z (:<) `f` a `f` as
toConstr _ = cofreeConstr
gunfold k z c = case constrIndex c of
1 -> k (k (z (:<)))
_ -> error "gunfold"
dataTypeOf _ = cofreeDataType
dataCast1 f = gcast1 f
cofreeConstr :: Constr
cofreeConstr = mkConstr cofreeDataType ":<" [] Infix
{-# NOINLINE cofreeConstr #-}
cofreeDataType :: DataType
cofreeDataType = mkDataType "Control.Comonad.Cofree.Cofree" [cofreeConstr]
{-# NOINLINE cofreeDataType #-}
#endif
instance ComonadHoist Cofree where
cohoist :: (forall x. w x -> v x) -> Cofree w a -> Cofree v a
cohoist = (forall x. w x -> v x) -> Cofree w a -> Cofree v a
forall (f :: * -> *) (g :: * -> *) a.
Functor f =>
(forall x. f x -> g x) -> Cofree f a -> Cofree g a
hoistCofree
instance ComonadEnv e w => ComonadEnv e (Cofree w) where
ask :: Cofree w a -> e
ask = w a -> e
forall e (w :: * -> *) a. ComonadEnv e w => w a -> e
ask (w a -> e) -> (Cofree w a -> w a) -> Cofree 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
. Cofree w a -> w a
forall (t :: (* -> *) -> * -> *) (w :: * -> *) a.
(ComonadTrans t, Comonad w) =>
t w a -> w a
lower
{-# INLINE ask #-}
instance ComonadStore s w => ComonadStore s (Cofree w) where
pos :: Cofree w a -> s
pos (a
_ :< w (Cofree w a)
as) = w (Cofree w a) -> s
forall s (w :: * -> *) a. ComonadStore s w => w a -> s
Class.pos w (Cofree w a)
as
{-# INLINE pos #-}
peek :: s -> Cofree w a -> a
peek s
s (a
_ :< w (Cofree w a)
as) = Cofree w a -> a
forall (w :: * -> *) a. Comonad w => w a -> a
extract (s -> w (Cofree w a) -> Cofree w a
forall s (w :: * -> *) a. ComonadStore s w => s -> w a -> a
Class.peek s
s w (Cofree w a)
as)
{-# INLINE peek #-}
instance ComonadTraced m w => ComonadTraced m (Cofree w) where
trace :: m -> Cofree 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) -> (Cofree w a -> w a) -> Cofree 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
. Cofree w a -> w a
forall (t :: (* -> *) -> * -> *) (w :: * -> *) a.
(ComonadTrans t, Comonad w) =>
t w a -> w a
lower
{-# INLINE trace #-}
_extract :: Functor f => (a -> f a) -> Cofree g a -> f (Cofree g a)
a -> f a
f (a
a :< g (Cofree g a)
as) = (a -> g (Cofree g a) -> Cofree g a
forall (f :: * -> *) a. a -> f (Cofree f a) -> Cofree f a
:< g (Cofree g a)
as) (a -> Cofree g a) -> f a -> f (Cofree g a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f a
f a
a
{-# INLINE _extract #-}
_unwrap :: Functor f => (g (Cofree g a) -> f (g (Cofree g a))) -> Cofree g a -> f (Cofree g a)
_unwrap :: (g (Cofree g a) -> f (g (Cofree g a)))
-> Cofree g a -> f (Cofree g a)
_unwrap g (Cofree g a) -> f (g (Cofree g a))
f (a
a :< g (Cofree g a)
as) = (a
a a -> g (Cofree g a) -> Cofree g a
forall (f :: * -> *) a. a -> f (Cofree f a) -> Cofree f a
:<) (g (Cofree g a) -> Cofree g a)
-> f (g (Cofree g a)) -> f (Cofree g a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> g (Cofree g a) -> f (g (Cofree g a))
f g (Cofree g a)
as
{-# INLINE _unwrap #-}
telescoped :: Functor f =>
[(Cofree g a -> f (Cofree g a)) -> g (Cofree g a) -> f (g (Cofree g a))] ->
(a -> f a) -> Cofree g a -> f (Cofree g a)
telescoped :: [(Cofree g a -> f (Cofree g a))
-> g (Cofree g a) -> f (g (Cofree g a))]
-> (a -> f a) -> Cofree g a -> f (Cofree g a)
telescoped = (((Cofree g a -> f (Cofree g a))
-> g (Cofree g a) -> f (g (Cofree g a)))
-> ((a -> f a) -> Cofree g a -> f (Cofree g a))
-> (a -> f a)
-> Cofree g a
-> f (Cofree g a))
-> ((a -> f a) -> Cofree g a -> f (Cofree g a))
-> [(Cofree g a -> f (Cofree g a))
-> g (Cofree g a) -> f (g (Cofree g a))]
-> (a -> f a)
-> Cofree g a
-> f (Cofree g a)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
Prelude.foldr (\(Cofree g a -> f (Cofree g a))
-> g (Cofree g a) -> f (g (Cofree g a))
l (a -> f a) -> Cofree g a -> f (Cofree g a)
r -> (g (Cofree g a) -> f (g (Cofree g a)))
-> Cofree g a -> f (Cofree g a)
forall (f :: * -> *) (g :: * -> *) a.
Functor f =>
(g (Cofree g a) -> f (g (Cofree g a)))
-> Cofree g a -> f (Cofree g a)
_unwrap ((g (Cofree g a) -> f (g (Cofree g a)))
-> Cofree g a -> f (Cofree g a))
-> ((a -> f a) -> g (Cofree g a) -> f (g (Cofree g a)))
-> (a -> f a)
-> Cofree g a
-> f (Cofree g a)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Cofree g a -> f (Cofree g a))
-> g (Cofree g a) -> f (g (Cofree g a))
l ((Cofree g a -> f (Cofree g a))
-> g (Cofree g a) -> f (g (Cofree g a)))
-> ((a -> f a) -> Cofree g a -> f (Cofree g a))
-> (a -> f a)
-> g (Cofree g a)
-> f (g (Cofree g a))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (a -> f a) -> Cofree g a -> f (Cofree g a)
r) (a -> f a) -> Cofree g a -> f (Cofree g a)
forall (f :: * -> *) a (g :: * -> *).
Functor f =>
(a -> f a) -> Cofree g a -> f (Cofree g a)
_extract
{-# INLINE telescoped #-}
telescoped_ :: Functor f =>
[(Cofree g a -> f (Cofree g a)) -> g (Cofree g a) -> f (g (Cofree g a))] ->
(Cofree g a -> f (Cofree g a)) -> Cofree g a -> f (Cofree g a)
telescoped_ :: [(Cofree g a -> f (Cofree g a))
-> g (Cofree g a) -> f (g (Cofree g a))]
-> (Cofree g a -> f (Cofree g a)) -> Cofree g a -> f (Cofree g a)
telescoped_ = (((Cofree g a -> f (Cofree g a))
-> g (Cofree g a) -> f (g (Cofree g a)))
-> ((Cofree g a -> f (Cofree g a)) -> Cofree g a -> f (Cofree g a))
-> (Cofree g a -> f (Cofree g a))
-> Cofree g a
-> f (Cofree g a))
-> ((Cofree g a -> f (Cofree g a)) -> Cofree g a -> f (Cofree g a))
-> [(Cofree g a -> f (Cofree g a))
-> g (Cofree g a) -> f (g (Cofree g a))]
-> (Cofree g a -> f (Cofree g a))
-> Cofree g a
-> f (Cofree g a)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
Prelude.foldr (\(Cofree g a -> f (Cofree g a))
-> g (Cofree g a) -> f (g (Cofree g a))
l (Cofree g a -> f (Cofree g a)) -> Cofree g a -> f (Cofree g a)
r -> (g (Cofree g a) -> f (g (Cofree g a)))
-> Cofree g a -> f (Cofree g a)
forall (f :: * -> *) (g :: * -> *) a.
Functor f =>
(g (Cofree g a) -> f (g (Cofree g a)))
-> Cofree g a -> f (Cofree g a)
_unwrap ((g (Cofree g a) -> f (g (Cofree g a)))
-> Cofree g a -> f (Cofree g a))
-> ((Cofree g a -> f (Cofree g a))
-> g (Cofree g a) -> f (g (Cofree g a)))
-> (Cofree g a -> f (Cofree g a))
-> Cofree g a
-> f (Cofree g a)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Cofree g a -> f (Cofree g a))
-> g (Cofree g a) -> f (g (Cofree g a))
l ((Cofree g a -> f (Cofree g a))
-> g (Cofree g a) -> f (g (Cofree g a)))
-> ((Cofree g a -> f (Cofree g a)) -> Cofree g a -> f (Cofree g a))
-> (Cofree g a -> f (Cofree g a))
-> g (Cofree g a)
-> f (g (Cofree g a))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Cofree g a -> f (Cofree g a)) -> Cofree g a -> f (Cofree g a)
r) (Cofree g a -> f (Cofree g a)) -> Cofree g a -> f (Cofree g a)
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
{-# INLINE telescoped_ #-}
shoots :: (Applicative f, Traversable g) => (a -> f a) -> Cofree g a -> f (Cofree g a)
shoots :: (a -> f a) -> Cofree g a -> f (Cofree g a)
shoots a -> f a
f = Cofree g a -> f (Cofree g a)
forall (f :: * -> *). Traversable f => Cofree f a -> f (Cofree f a)
go
where
#if __GLASGOW_HASKELL__ < 709
go xxs@(x :< xs) | null (toList xs) = pure xxs
#else
go :: Cofree f a -> f (Cofree f a)
go xxs :: Cofree f a
xxs@(a
x :< f (Cofree f a)
xs) | f (Cofree f a) -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null f (Cofree f a)
xs = Cofree f a -> f (Cofree f a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Cofree f a
xxs
#endif
| Bool
otherwise = a -> f (Cofree f a) -> Cofree f a
forall (f :: * -> *) a. a -> f (Cofree f a) -> Cofree f a
(:<) (a -> f (Cofree f a) -> Cofree f a)
-> f a -> f (f (Cofree f a) -> Cofree f a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f a
f a
x f (f (Cofree f a) -> Cofree f a)
-> f (f (Cofree f a)) -> f (Cofree f a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Cofree f a -> f (Cofree f a))
-> f (Cofree f a) -> f (f (Cofree f a))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Cofree f a -> f (Cofree f a)
go f (Cofree f a)
xs
{-# INLINE shoots #-}
leaves :: (Applicative f, Traversable g) => (a -> f a) -> Cofree g a -> f (Cofree g a)
leaves :: (a -> f a) -> Cofree g a -> f (Cofree g a)
leaves a -> f a
f = Cofree g a -> f (Cofree g a)
forall (f :: * -> *). Traversable f => Cofree f a -> f (Cofree f a)
go
where
#if __GLASGOW_HASKELL__ < 709
go (x :< xs) | null (toList xs) = (:< xs) <$> f x
#else
go :: Cofree f a -> f (Cofree f a)
go (a
x :< f (Cofree f a)
xs) | f (Cofree f a) -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null f (Cofree f a)
xs = (a -> f (Cofree f a) -> Cofree f a
forall (f :: * -> *) a. a -> f (Cofree f a) -> Cofree f a
:< f (Cofree f a)
xs) (a -> Cofree f a) -> f a -> f (Cofree f a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f a
f a
x
#endif
| Bool
otherwise = (a
x a -> f (Cofree f a) -> Cofree f a
forall (f :: * -> *) a. a -> f (Cofree f a) -> Cofree f a
:<) (f (Cofree f a) -> Cofree f a)
-> f (f (Cofree f a)) -> f (Cofree f a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Cofree f a -> f (Cofree f a))
-> f (Cofree f a) -> f (f (Cofree f a))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Cofree f a -> f (Cofree f a)
go f (Cofree f a)
xs
{-# INLINE leaves #-}