{-# LANGUAGE CPP #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
#if __GLASGOW_HASKELL__ >= 707
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE StandaloneDeriving #-}
#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.Data
import Data.Distributive
import Data.Foldable
import Data.Semigroup
import Data.Traversable
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 #-}
#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 #-}