{-# LANGUAGE CPP #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
#if __GLASGOW_HASKELL__ >= 707
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE Safe #-}
#else
-- Manual Typeable instances
{-# LANGUAGE Trustworthy #-}
#endif
#include "free-common.h"

-----------------------------------------------------------------------------
-- |
-- Module      :  Control.Comonad.Cofree
-- Copyright   :  (C) 2008-2013 Edward Kmett
-- License     :  BSD-style (see the file LICENSE)
--
-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
-- Stability   :  provisional
-- Portability :  MPTCs, fundeps
--
-- Cofree comonads
--
----------------------------------------------------------------------------
module Control.Comonad.Cofree
  ( Cofree(..)
  , ComonadCofree(..)
  , section
  , coiter
  , coiterW
  , unfold
  , unfoldM
  , hoistCofree
  -- * Lenses into cofree comonads
  , _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 :<

-- | The 'Cofree' 'Comonad' of a functor @f@.
--
-- /Formally/
--
-- A 'Comonad' @v@ is a cofree 'Comonad' for @f@ if every comonad homomorphism
-- from another comonad @w@ to @v@ is equivalent to a natural transformation
-- from @w@ to @f@.
--
-- A 'cofree' functor is right adjoint to a forgetful functor.
--
-- Cofree is a functor from the category of functors to the category of comonads
-- that is right adjoint to the forgetful functor from the category of comonads
-- to the category of functors that forgets how to 'extract' and
-- 'duplicate', leaving you with only a 'Functor'.
--
-- In practice, cofree comonads are quite useful for annotating syntax trees,
-- or talking about streams.
--
-- A number of common comonads arise directly as cofree comonads.
--
-- For instance,
--
-- * @'Cofree' 'Maybe'@ forms the comonad for a non-empty list.
--
-- * @'Cofree' ('Const' b)@ is a product.
--
-- * @'Cofree' 'Identity'@ forms an infinite stream.
--
-- * @'Cofree' ((->) b)'@ describes a Moore machine with states labeled with values of type a, and transitions on edges of type b.
--
-- Furthermore, if the functor @f@ forms a monoid (for example, by
-- being an instance of 'Alternative'), the resulting 'Comonad' is
-- also a 'Monad'. See
-- <http://www.cs.appstate.edu/~johannp/jfp06-revised.pdf Monadic Augment and Generalised Shortcut Fusion> by Neil Ghani et al., Section 4.3
-- for more details.
--
-- In particular, if @f a ≡ [a]@, the
-- resulting data structure is a <https://en.wikipedia.org/wiki/Rose_tree Rose tree>.
-- For a practical application, check
-- <https://web.archive.org/web/20161208002902/http://www.cs.le.ac.uk/people/ak155/Papers/CALCO-07/GK07.pdf Higher Dimensional Trees, Algebraically> by Neil Ghani et al.
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

-- | Use coiteration to generate a cofree comonad from a seed.
--
-- @'coiter' f = 'unfold' ('id' 'Control.Arrow.&&&' f)@
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)

-- | Like coiter for comonadic values.
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 a cofree comonad from a seed.
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

-- | Unfold a cofree comonad from a seed, monadically.
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 #-}

-- | This is not a true 'Comonad' transformer, but this instance is convenient.
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)

-- |
--
-- @'lower' . 'section' = 'id'@
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 #-}

-- | This is a lens that can be used to read or write from the target of 'extract'.
--
-- Using (^.) from the @lens@ package:
--
-- @foo ^. '_extract' == 'extract' foo@
--
-- For more on lenses see the @lens@ package on hackage
--
-- @'_extract' :: Lens' ('Cofree' g a) a@
_extract :: Functor f => (a -> f a) -> Cofree g a -> f (Cofree g a)
_extract :: (a -> f a) -> Cofree g a -> f (Cofree g a)
_extract 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 #-}

-- | This is a lens that can be used to read or write to the tails of a 'Cofree' 'Comonad'.
--
-- Using (^.) from the @lens@ package:
--
-- @foo ^. '_unwrap' == 'unwrap' foo@
--
-- For more on lenses see the @lens@ package on hackage
--
-- @'_unwrap' :: Lens' ('Cofree' g a) (g ('Cofree' g a))@
_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 #-}

-- | Construct an @Lens@ into a @'Cofree' g@ given a list of lenses into the base functor.
-- When the input list is empty, this is equivalent to '_extract'.
-- When the input list is non-empty, this composes the input lenses
-- with '_unwrap' to walk through the @'Cofree' g@ before using
-- '_extract' to get the element at the final location.
--
-- For more on lenses see the 'lens' package on hackage.
--
-- @telescoped :: [Lens' (g ('Cofree' g a)) ('Cofree' g a)]      -> Lens' ('Cofree' g a) a@
--
-- @telescoped :: [Traversal' (g ('Cofree' g a)) ('Cofree' g a)] -> Traversal' ('Cofree' g a) a@
--
-- @telescoped :: [Getter (g ('Cofree' g a)) ('Cofree' g a)]     -> Getter ('Cofree' g a) a@
--
-- @telescoped :: [Fold (g ('Cofree' g a)) ('Cofree' g a)]       -> Fold ('Cofree' g a) a@
--
-- @telescoped :: [Setter' (g ('Cofree' g a)) ('Cofree' g a)]    -> Setter' ('Cofree' g a) a@
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 #-}

-- not actually named 'eats'
-- | Construct an @Lens@ into a @'Cofree' g@ given a list of lenses into the base functor.
-- The only difference between this and 'telescoped' is that 'telescoped' focuses on a single value, but this focuses on the entire remaining subtree.
-- When the input list is empty, this is equivalent to 'id'.
-- When the input list is non-empty, this composes the input lenses
-- with '_unwrap' to walk through the @'Cofree' g@.
--
-- For more on lenses see the 'lens' package on hackage.
--
-- @telescoped :: [Lens' (g ('Cofree' g a)) ('Cofree' g a)]      -> Lens' ('Cofree' g a) ('Cofree' g a)@
--
-- @telescoped :: [Traversal' (g ('Cofree' g a)) ('Cofree' g a)] -> Traversal' ('Cofree' g a) ('Cofree' g a)@
--
-- @telescoped :: [Getter (g ('Cofree' g a)) ('Cofree' g a)]     -> Getter ('Cofree' g a) ('Cofree' g a)@
--
-- @telescoped :: [Fold (g ('Cofree' g a)) ('Cofree' g a)]       -> Fold ('Cofree' g a) ('Cofree' g a)@
--
-- @telescoped :: [Setter' (g ('Cofree' g a)) ('Cofree' g a)]    -> Setter' ('Cofree' g a) ('Cofree' g a)@
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_ #-}

-- | A @Traversal'@ that gives access to all non-leaf @a@ elements of a
-- @'Cofree' g@ a, where non-leaf is defined as @x@ from @(x :< xs)@ where
-- @null xs@ is @False@.
--
-- Because this doesn't give access to all values in the @'Cofree' g@,
-- it cannot be used to change types.
--
-- @shoots :: Traversable g => Traversal' (Cofree g a) a@
--
-- N.B. On GHC < 7.9, this is slightly less flexible, as it has to
-- use @null (toList xs)@ instead.
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 #-}

-- | A @Traversal'@ that gives access to all leaf @a@ elements of a
-- @'Cofree' g@ a, where leaf is defined as @x@ from @(x :< xs)@ where
-- @null xs@ is @True@.
--
-- Because this doesn't give access to all values in the @'Cofree' g@,
-- it cannot be used to change types.
--
-- @shoots :: Traversable g => Traversal' (Cofree g a) a@
--
-- N.B. On GHC < 7.9, this is slightly less flexible, as it has to
-- use @null (toList xs)@ instead.
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 #-}