{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE StandaloneDeriving #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Control.Comonad.Trans.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
--
-- The cofree comonad transformer
----------------------------------------------------------------------------
module Control.Comonad.Trans.Cofree
  ( CofreeT(..)
  , Cofree, cofree, runCofree
  , CofreeF(..)
  , ComonadCofree(..)
  , headF
  , tailF
  , transCofreeT
  , coiterT
  ) where

import Control.Applicative
import Control.Comonad
import Control.Comonad.Trans.Class
import Control.Comonad.Cofree.Class
import Control.Comonad.Env.Class
import Control.Comonad.Hoist.Class
import Control.Category
import Data.Bifunctor
import Data.Bifoldable
import Data.Bitraversable
import Data.Foldable
import Data.Functor.Classes
import Data.Functor.Identity
import Data.Traversable
import Control.Monad (liftM)
import Control.Monad.Trans
import Control.Monad.Zip
import Prelude hiding (id,(.))
import Data.Data
import GHC.Generics hiding (Infix, Prefix)

infixr 5 :<

-- | This is the base functor of the cofree comonad transformer.
data CofreeF f a b = a :< f b
  deriving (CofreeF f a b -> CofreeF f a b -> Bool
(CofreeF f a b -> CofreeF f a b -> Bool)
-> (CofreeF f a b -> CofreeF f a b -> Bool) -> Eq (CofreeF f a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (f :: * -> *) a b.
(Eq a, Eq (f b)) =>
CofreeF f a b -> CofreeF f a b -> Bool
$c== :: forall (f :: * -> *) a b.
(Eq a, Eq (f b)) =>
CofreeF f a b -> CofreeF f a b -> Bool
== :: CofreeF f a b -> CofreeF f a b -> Bool
$c/= :: forall (f :: * -> *) a b.
(Eq a, Eq (f b)) =>
CofreeF f a b -> CofreeF f a b -> Bool
/= :: CofreeF f a b -> CofreeF f a b -> Bool
Eq,Eq (CofreeF f a b)
Eq (CofreeF f a b) =>
(CofreeF f a b -> CofreeF f a b -> Ordering)
-> (CofreeF f a b -> CofreeF f a b -> Bool)
-> (CofreeF f a b -> CofreeF f a b -> Bool)
-> (CofreeF f a b -> CofreeF f a b -> Bool)
-> (CofreeF f a b -> CofreeF f a b -> Bool)
-> (CofreeF f a b -> CofreeF f a b -> CofreeF f a b)
-> (CofreeF f a b -> CofreeF f a b -> CofreeF f a b)
-> Ord (CofreeF f a b)
CofreeF f a b -> CofreeF f a b -> Bool
CofreeF f a b -> CofreeF f a b -> Ordering
CofreeF f a b -> CofreeF f a b -> CofreeF f a b
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall (f :: * -> *) a b. (Ord a, Ord (f b)) => Eq (CofreeF f a b)
forall (f :: * -> *) a b.
(Ord a, Ord (f b)) =>
CofreeF f a b -> CofreeF f a b -> Bool
forall (f :: * -> *) a b.
(Ord a, Ord (f b)) =>
CofreeF f a b -> CofreeF f a b -> Ordering
forall (f :: * -> *) a b.
(Ord a, Ord (f b)) =>
CofreeF f a b -> CofreeF f a b -> CofreeF f a b
$ccompare :: forall (f :: * -> *) a b.
(Ord a, Ord (f b)) =>
CofreeF f a b -> CofreeF f a b -> Ordering
compare :: CofreeF f a b -> CofreeF f a b -> Ordering
$c< :: forall (f :: * -> *) a b.
(Ord a, Ord (f b)) =>
CofreeF f a b -> CofreeF f a b -> Bool
< :: CofreeF f a b -> CofreeF f a b -> Bool
$c<= :: forall (f :: * -> *) a b.
(Ord a, Ord (f b)) =>
CofreeF f a b -> CofreeF f a b -> Bool
<= :: CofreeF f a b -> CofreeF f a b -> Bool
$c> :: forall (f :: * -> *) a b.
(Ord a, Ord (f b)) =>
CofreeF f a b -> CofreeF f a b -> Bool
> :: CofreeF f a b -> CofreeF f a b -> Bool
$c>= :: forall (f :: * -> *) a b.
(Ord a, Ord (f b)) =>
CofreeF f a b -> CofreeF f a b -> Bool
>= :: CofreeF f a b -> CofreeF f a b -> Bool
$cmax :: forall (f :: * -> *) a b.
(Ord a, Ord (f b)) =>
CofreeF f a b -> CofreeF f a b -> CofreeF f a b
max :: CofreeF f a b -> CofreeF f a b -> CofreeF f a b
$cmin :: forall (f :: * -> *) a b.
(Ord a, Ord (f b)) =>
CofreeF f a b -> CofreeF f a b -> CofreeF f a b
min :: CofreeF f a b -> CofreeF f a b -> CofreeF f a b
Ord,Int -> CofreeF f a b -> ShowS
[CofreeF f a b] -> ShowS
CofreeF f a b -> String
(Int -> CofreeF f a b -> ShowS)
-> (CofreeF f a b -> String)
-> ([CofreeF f a b] -> ShowS)
-> Show (CofreeF f a b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (f :: * -> *) a b.
(Show a, Show (f b)) =>
Int -> CofreeF f a b -> ShowS
forall (f :: * -> *) a b.
(Show a, Show (f b)) =>
[CofreeF f a b] -> ShowS
forall (f :: * -> *) a b.
(Show a, Show (f b)) =>
CofreeF f a b -> String
$cshowsPrec :: forall (f :: * -> *) a b.
(Show a, Show (f b)) =>
Int -> CofreeF f a b -> ShowS
showsPrec :: Int -> CofreeF f a b -> ShowS
$cshow :: forall (f :: * -> *) a b.
(Show a, Show (f b)) =>
CofreeF f a b -> String
show :: CofreeF f a b -> String
$cshowList :: forall (f :: * -> *) a b.
(Show a, Show (f b)) =>
[CofreeF f a b] -> ShowS
showList :: [CofreeF f a b] -> ShowS
Show,ReadPrec [CofreeF f a b]
ReadPrec (CofreeF f a b)
Int -> ReadS (CofreeF f a b)
ReadS [CofreeF f a b]
(Int -> ReadS (CofreeF f a b))
-> ReadS [CofreeF f a b]
-> ReadPrec (CofreeF f a b)
-> ReadPrec [CofreeF f a b]
-> Read (CofreeF f a b)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall (f :: * -> *) a b.
(Read a, Read (f b)) =>
ReadPrec [CofreeF f a b]
forall (f :: * -> *) a b.
(Read a, Read (f b)) =>
ReadPrec (CofreeF f a b)
forall (f :: * -> *) a b.
(Read a, Read (f b)) =>
Int -> ReadS (CofreeF f a b)
forall (f :: * -> *) a b.
(Read a, Read (f b)) =>
ReadS [CofreeF f a b]
$creadsPrec :: forall (f :: * -> *) a b.
(Read a, Read (f b)) =>
Int -> ReadS (CofreeF f a b)
readsPrec :: Int -> ReadS (CofreeF f a b)
$creadList :: forall (f :: * -> *) a b.
(Read a, Read (f b)) =>
ReadS [CofreeF f a b]
readList :: ReadS [CofreeF f a b]
$creadPrec :: forall (f :: * -> *) a b.
(Read a, Read (f b)) =>
ReadPrec (CofreeF f a b)
readPrec :: ReadPrec (CofreeF f a b)
$creadListPrec :: forall (f :: * -> *) a b.
(Read a, Read (f b)) =>
ReadPrec [CofreeF f a b]
readListPrec :: ReadPrec [CofreeF f a b]
Read,(forall x. CofreeF f a b -> Rep (CofreeF f a b) x)
-> (forall x. Rep (CofreeF f a b) x -> CofreeF f a b)
-> Generic (CofreeF f a b)
forall x. Rep (CofreeF f a b) x -> CofreeF f a b
forall x. CofreeF f a b -> Rep (CofreeF f a b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (f :: * -> *) a b x. Rep (CofreeF f a b) x -> CofreeF f a b
forall (f :: * -> *) a b x. CofreeF f a b -> Rep (CofreeF f a b) x
$cfrom :: forall (f :: * -> *) a b x. CofreeF f a b -> Rep (CofreeF f a b) x
from :: forall x. CofreeF f a b -> Rep (CofreeF f a b) x
$cto :: forall (f :: * -> *) a b x. Rep (CofreeF f a b) x -> CofreeF f a b
to :: forall x. Rep (CofreeF f a b) x -> CofreeF f a b
Generic,(forall a. CofreeF f a a -> Rep1 (CofreeF f a) a)
-> (forall a. Rep1 (CofreeF f a) a -> CofreeF f a a)
-> Generic1 (CofreeF f a)
forall a. Rep1 (CofreeF f a) a -> CofreeF f a a
forall a. CofreeF f a a -> Rep1 (CofreeF f a) 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 a. Rep1 (CofreeF f a) a -> CofreeF f a a
forall (f :: * -> *) a a. CofreeF f a a -> Rep1 (CofreeF f a) a
$cfrom1 :: forall (f :: * -> *) a a. CofreeF f a a -> Rep1 (CofreeF f a) a
from1 :: forall a. CofreeF f a a -> Rep1 (CofreeF f a) a
$cto1 :: forall (f :: * -> *) a a. Rep1 (CofreeF f a) a -> CofreeF f a a
to1 :: forall a. Rep1 (CofreeF f a) a -> CofreeF f a a
Generic1)

instance Show1 f => Show2 (CofreeF f) where
  liftShowsPrec2 :: forall a b.
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> CofreeF f a b
-> ShowS
liftShowsPrec2 Int -> a -> ShowS
spa [a] -> ShowS
_sla Int -> b -> ShowS
spb [b] -> ShowS
slb Int
d (a
a :< f b
fb) =
    Bool -> ShowS -> ShowS
showParen (Int
d 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
spa Int
6 a
a ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
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 b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Int -> b -> ShowS) -> ([b] -> ShowS) -> Int -> f b -> ShowS
forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec Int -> b -> ShowS
spb [b] -> ShowS
slb Int
6 f b
fb

instance (Show1 f, Show a) => Show1 (CofreeF f a) where
  liftShowsPrec :: forall a.
(Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> CofreeF f a a -> ShowS
liftShowsPrec = (Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> a -> ShowS)
-> ([a] -> ShowS)
-> Int
-> CofreeF f a a
-> ShowS
forall a b.
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> CofreeF f a b
-> ShowS
forall (f :: * -> * -> *) a b.
Show2 f =>
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> f a b
-> ShowS
liftShowsPrec2 Int -> a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec [a] -> ShowS
forall a. Show a => [a] -> ShowS
showList

instance Read1 f => Read2 (CofreeF f) where
  liftReadsPrec2 :: forall a b.
(Int -> ReadS a)
-> ReadS [a]
-> (Int -> ReadS b)
-> ReadS [b]
-> Int
-> ReadS (CofreeF f a b)
liftReadsPrec2 Int -> ReadS a
rpa ReadS [a]
_rla Int -> ReadS b
rpb ReadS [b]
rlb Int
d =
    Bool -> ReadS (CofreeF f a b) -> ReadS (CofreeF f a b)
forall a. Bool -> ReadS a -> ReadS a
readParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
5) (ReadS (CofreeF f a b) -> ReadS (CofreeF f a b))
-> ReadS (CofreeF f a b) -> ReadS (CofreeF f a b)
forall a b. (a -> b) -> a -> b
$
      (\String
r' -> [ (a
u a -> f b -> CofreeF f a b
forall (f :: * -> *) a b. a -> f b -> CofreeF f a b
:< f b
v, String
w)
              | (a
u, String
s) <- Int -> ReadS a
rpa Int
6 String
r'
              , (String
":<", String
t) <- ReadS String
lex String
s
              , (f b
v, String
w) <- (Int -> ReadS b) -> ReadS [b] -> Int -> ReadS (f b)
forall a. (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (f a)
forall (f :: * -> *) a.
Read1 f =>
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (f a)
liftReadsPrec Int -> ReadS b
rpb ReadS [b]
rlb Int
6 String
t
              ])

instance (Read1 f, Read a) => Read1 (CofreeF f a) where
  liftReadsPrec :: forall a.
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (CofreeF f a a)
liftReadsPrec = (Int -> ReadS a)
-> ReadS [a]
-> (Int -> ReadS a)
-> ReadS [a]
-> Int
-> ReadS (CofreeF f a a)
forall a b.
(Int -> ReadS a)
-> ReadS [a]
-> (Int -> ReadS b)
-> ReadS [b]
-> Int
-> ReadS (CofreeF f a b)
forall (f :: * -> * -> *) a b.
Read2 f =>
(Int -> ReadS a)
-> ReadS [a]
-> (Int -> ReadS b)
-> ReadS [b]
-> Int
-> ReadS (f a b)
liftReadsPrec2 Int -> ReadS a
forall a. Read a => Int -> ReadS a
readsPrec ReadS [a]
forall a. Read a => ReadS [a]
readList

instance Eq1 f => Eq2 (CofreeF f) where
  liftEq2 :: forall a b c d.
(a -> b -> Bool)
-> (c -> d -> Bool) -> CofreeF f a c -> CofreeF f b d -> Bool
liftEq2 a -> b -> Bool
eqa c -> d -> Bool
eqfb (a
a :< f c
fb) (b
a' :< f d
fb') = a -> b -> Bool
eqa a
a b
a' Bool -> Bool -> Bool
&& (c -> d -> Bool) -> f c -> f d -> Bool
forall a b. (a -> b -> Bool) -> f a -> f b -> Bool
forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq c -> d -> Bool
eqfb f c
fb f d
fb'

instance (Eq1 f, Eq a) => Eq1 (CofreeF f a) where
  liftEq :: forall a b.
(a -> b -> Bool) -> CofreeF f a a -> CofreeF f a b -> Bool
liftEq = (a -> a -> Bool)
-> (a -> b -> Bool) -> CofreeF f a a -> CofreeF f a b -> Bool
forall a b c d.
(a -> b -> Bool)
-> (c -> d -> Bool) -> CofreeF f a c -> CofreeF f b d -> Bool
forall (f :: * -> * -> *) a b c d.
Eq2 f =>
(a -> b -> Bool) -> (c -> d -> Bool) -> f a c -> f b d -> Bool
liftEq2 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==)

instance Ord1 f => Ord2 (CofreeF f) where
  liftCompare2 :: forall a b c d.
(a -> b -> Ordering)
-> (c -> d -> Ordering)
-> CofreeF f a c
-> CofreeF f b d
-> Ordering
liftCompare2 a -> b -> Ordering
cmpa c -> d -> Ordering
cmpfb (a
a :< f c
fb) (b
a' :< f d
fb') =
    case a -> b -> Ordering
cmpa a
a b
a' of
      Ordering
LT -> Ordering
LT
      Ordering
EQ -> (c -> d -> Ordering) -> f c -> f d -> Ordering
forall a b. (a -> b -> Ordering) -> f a -> f b -> Ordering
forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare c -> d -> Ordering
cmpfb f c
fb f d
fb'
      Ordering
GT -> Ordering
GT

instance (Ord1 f, Ord a) => Ord1 (CofreeF f a) where
  liftCompare :: forall a b.
(a -> b -> Ordering) -> CofreeF f a a -> CofreeF f a b -> Ordering
liftCompare = (a -> a -> Ordering)
-> (a -> b -> Ordering)
-> CofreeF f a a
-> CofreeF f a b
-> Ordering
forall a b c d.
(a -> b -> Ordering)
-> (c -> d -> Ordering)
-> CofreeF f a c
-> CofreeF f b d
-> Ordering
forall (f :: * -> * -> *) a b c d.
Ord2 f =>
(a -> b -> Ordering)
-> (c -> d -> Ordering) -> f a c -> f b d -> Ordering
liftCompare2 a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare

-- | Extract the head of the base functor
headF :: CofreeF f a b -> a
headF :: forall (f :: * -> *) a b. CofreeF f a b -> a
headF (a
a :< f b
_) = a
a

-- | Extract the tails of the base functor
tailF :: CofreeF f a b -> f b
tailF :: forall (f :: * -> *) a b. CofreeF f a b -> f b
tailF (a
_ :< f b
as) = f b
as

instance Functor f => Functor (CofreeF f a) where
  fmap :: forall a b. (a -> b) -> CofreeF f a a -> CofreeF f a b
fmap a -> b
f (a
a :< f a
as)  = a
a a -> f b -> CofreeF f a b
forall (f :: * -> *) a b. a -> f b -> CofreeF f a b
:< (a -> b) -> f a -> f b
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f f a
as

instance Foldable f => Foldable (CofreeF f a) where
  foldMap :: forall m a. Monoid m => (a -> m) -> CofreeF f a a -> m
foldMap a -> m
f (a
_ :< f a
as) = (a -> m) -> f a -> m
forall m a. Monoid m => (a -> m) -> f a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f f a
as

instance Traversable f => Traversable (CofreeF f a) where
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> CofreeF f a a -> f (CofreeF f a b)
traverse a -> f b
f (a
a :< f a
as) = (a
a a -> f b -> CofreeF f a b
forall (f :: * -> *) a b. a -> f b -> CofreeF f a b
:<) (f b -> CofreeF f a b) -> f (f b) -> f (CofreeF f a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> f a -> f (f b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> f a -> f (f b)
traverse a -> f b
f f a
as

instance Functor f => Bifunctor (CofreeF f) where
  bimap :: forall a b c d.
(a -> b) -> (c -> d) -> CofreeF f a c -> CofreeF f b d
bimap a -> b
f c -> d
g (a
a :< f c
as)  = a -> b
f a
a b -> f d -> CofreeF f b d
forall (f :: * -> *) a b. a -> f b -> CofreeF f a b
:< (c -> d) -> f c -> f d
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap c -> d
g f c
as

instance Foldable f => Bifoldable (CofreeF f) where
  bifoldMap :: forall m a b.
Monoid m =>
(a -> m) -> (b -> m) -> CofreeF f a b -> m
bifoldMap a -> m
f b -> m
g (a
a :< f b
as)  = a -> m
f a
a m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` (b -> m) -> f b -> m
forall m a. Monoid m => (a -> m) -> f a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap b -> m
g f b
as

instance Traversable f => Bitraversable (CofreeF f) where
  bitraverse :: forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> CofreeF f a b -> f (CofreeF f c d)
bitraverse a -> f c
f b -> f d
g (a
a :< f b
as) = c -> f d -> CofreeF f c d
forall (f :: * -> *) a b. a -> f b -> CofreeF f a b
(:<) (c -> f d -> CofreeF f c d) -> f c -> f (f d -> CofreeF f c d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f c
f a
a f (f d -> CofreeF f c d) -> f (f d) -> f (CofreeF f c d)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (b -> f d) -> f b -> f (f d)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> f a -> f (f b)
traverse b -> f d
g f b
as

transCofreeF :: (forall x. f x -> g x) -> CofreeF f a b -> CofreeF g a b
transCofreeF :: forall (f :: * -> *) (g :: * -> *) a b.
(forall x. f x -> g x) -> CofreeF f a b -> CofreeF g a b
transCofreeF forall x. f x -> g x
t (a
a :< f b
fb) = a
a a -> g b -> CofreeF g a b
forall (f :: * -> *) a b. a -> f b -> CofreeF f a b
:< f b -> g b
forall x. f x -> g x
t f b
fb
{-# INLINE transCofreeF #-}

-- | This is a cofree comonad of some functor @f@, with a comonad @w@ threaded through it at each level.
newtype CofreeT f w a = CofreeT { forall (f :: * -> *) (w :: * -> *) a.
CofreeT f w a -> w (CofreeF f a (CofreeT f w a))
runCofreeT :: w (CofreeF f a (CofreeT f w a)) }

-- | The cofree `Comonad` of a functor @f@.
type Cofree f = CofreeT f Identity

{- |
Wrap another layer around a cofree comonad value.

@cofree@ is a right inverse of `runCofree`.

@
runCofree . cofree == id
@
-}
cofree :: CofreeF f a (Cofree f a) -> Cofree f a
cofree :: forall (f :: * -> *) a. CofreeF f a (Cofree f a) -> Cofree f a
cofree = Identity (CofreeF f a (Cofree f a)) -> Cofree f a
forall (f :: * -> *) (w :: * -> *) a.
w (CofreeF f a (CofreeT f w a)) -> CofreeT f w a
CofreeT (Identity (CofreeF f a (Cofree f a)) -> Cofree f a)
-> (CofreeF f a (Cofree f a)
    -> Identity (CofreeF f a (Cofree f a)))
-> CofreeF f a (Cofree f a)
-> Cofree f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. CofreeF f a (Cofree f a) -> Identity (CofreeF f a (Cofree f a))
forall a. a -> Identity a
Identity
{-# INLINE cofree #-}


{- |
Unpeel the first layer off a cofree comonad value.

@runCofree@ is a right inverse of `cofree`.

@
cofree . runCofree == id
@
-}
runCofree :: Cofree f a -> CofreeF f a (Cofree f a)
runCofree :: forall (f :: * -> *) a. Cofree f a -> CofreeF f a (Cofree f a)
runCofree = Identity (CofreeF f a (Cofree f a)) -> CofreeF f a (Cofree f a)
forall a. Identity a -> a
runIdentity (Identity (CofreeF f a (Cofree f a)) -> CofreeF f a (Cofree f a))
-> (Cofree f a -> Identity (CofreeF f a (Cofree f a)))
-> Cofree f a
-> CofreeF f a (Cofree f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Cofree f a -> Identity (CofreeF f a (Cofree f a))
forall (f :: * -> *) (w :: * -> *) a.
CofreeT f w a -> w (CofreeF f a (CofreeT f w a))
runCofreeT
{-# INLINE runCofree #-}

instance (Functor f, Functor w) => Functor (CofreeT f w) where
  fmap :: forall a b. (a -> b) -> CofreeT f w a -> CofreeT f w b
fmap a -> b
f = w (CofreeF f b (CofreeT f w b)) -> CofreeT f w b
forall (f :: * -> *) (w :: * -> *) a.
w (CofreeF f a (CofreeT f w a)) -> CofreeT f w a
CofreeT (w (CofreeF f b (CofreeT f w b)) -> CofreeT f w b)
-> (CofreeT f w a -> w (CofreeF f b (CofreeT f w b)))
-> CofreeT f w a
-> CofreeT f w b
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (CofreeF f a (CofreeT f w a) -> CofreeF f b (CofreeT f w b))
-> w (CofreeF f a (CofreeT f w a))
-> w (CofreeF f b (CofreeT f w b))
forall a b. (a -> b) -> w a -> w b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b)
-> (CofreeT f w a -> CofreeT f w b)
-> CofreeF f a (CofreeT f w a)
-> CofreeF f b (CofreeT f w b)
forall a b c d.
(a -> b) -> (c -> d) -> CofreeF f a c -> CofreeF f b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap a -> b
f ((a -> b) -> CofreeT f w a -> CofreeT f w b
forall a b. (a -> b) -> CofreeT f w a -> CofreeT f w b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f)) (w (CofreeF f a (CofreeT f w a))
 -> w (CofreeF f b (CofreeT f w b)))
-> (CofreeT f w a -> w (CofreeF f a (CofreeT f w a)))
-> CofreeT f w a
-> w (CofreeF f b (CofreeT f w b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. CofreeT f w a -> w (CofreeF f a (CofreeT f w a))
forall (f :: * -> *) (w :: * -> *) a.
CofreeT f w a -> w (CofreeF f a (CofreeT f w a))
runCofreeT

instance (Functor f, Comonad w) => Comonad (CofreeT f w) where
  extract :: forall a. CofreeT f w a -> a
extract = CofreeF f a (CofreeT f w a) -> a
forall (f :: * -> *) a b. CofreeF f a b -> a
headF (CofreeF f a (CofreeT f w a) -> a)
-> (CofreeT f w a -> CofreeF f a (CofreeT f w a))
-> CofreeT f w a
-> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. w (CofreeF f a (CofreeT f w a)) -> CofreeF f a (CofreeT f w a)
forall a. w a -> a
forall (w :: * -> *) a. Comonad w => w a -> a
extract (w (CofreeF f a (CofreeT f w a)) -> CofreeF f a (CofreeT f w a))
-> (CofreeT f w a -> w (CofreeF f a (CofreeT f w a)))
-> CofreeT f w a
-> CofreeF f a (CofreeT f w a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. CofreeT f w a -> w (CofreeF f a (CofreeT f w a))
forall (f :: * -> *) (w :: * -> *) a.
CofreeT f w a -> w (CofreeF f a (CofreeT f w a))
runCofreeT
  extend :: forall a b. (CofreeT f w a -> b) -> CofreeT f w a -> CofreeT f w b
extend CofreeT f w a -> b
f = w (CofreeF f b (CofreeT f w b)) -> CofreeT f w b
forall (f :: * -> *) (w :: * -> *) a.
w (CofreeF f a (CofreeT f w a)) -> CofreeT f w a
CofreeT (w (CofreeF f b (CofreeT f w b)) -> CofreeT f w b)
-> (CofreeT f w a -> w (CofreeF f b (CofreeT f w b)))
-> CofreeT f w a
-> CofreeT f w b
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (w (CofreeF f a (CofreeT f w a)) -> CofreeF f b (CofreeT f w b))
-> w (CofreeF f a (CofreeT f w a))
-> w (CofreeF f b (CofreeT f w b))
forall a b. (w a -> b) -> w a -> w b
forall (w :: * -> *) a b. Comonad w => (w a -> b) -> w a -> w b
extend (\w (CofreeF f a (CofreeT f w a))
w -> CofreeT f w a -> b
f (w (CofreeF f a (CofreeT f w a)) -> CofreeT f w a
forall (f :: * -> *) (w :: * -> *) a.
w (CofreeF f a (CofreeT f w a)) -> CofreeT f w a
CofreeT w (CofreeF f a (CofreeT f w a))
w) b -> f (CofreeT f w b) -> CofreeF f b (CofreeT f w b)
forall (f :: * -> *) a b. a -> f b -> CofreeF f a b
:< ((CofreeT f w a -> b) -> CofreeT f w a -> CofreeT f w b
forall a b. (CofreeT f w a -> b) -> CofreeT f w a -> CofreeT f w b
forall (w :: * -> *) a b. Comonad w => (w a -> b) -> w a -> w b
extend CofreeT f w a -> b
f (CofreeT f w a -> CofreeT f w b)
-> f (CofreeT f w a) -> f (CofreeT f w b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CofreeF f a (CofreeT f w a) -> f (CofreeT f w a)
forall (f :: * -> *) a b. CofreeF f a b -> f b
tailF (w (CofreeF f a (CofreeT f w a)) -> CofreeF f a (CofreeT f w a)
forall a. w a -> a
forall (w :: * -> *) a. Comonad w => w a -> a
extract w (CofreeF f a (CofreeT f w a))
w))) (w (CofreeF f a (CofreeT f w a))
 -> w (CofreeF f b (CofreeT f w b)))
-> (CofreeT f w a -> w (CofreeF f a (CofreeT f w a)))
-> CofreeT f w a
-> w (CofreeF f b (CofreeT f w b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. CofreeT f w a -> w (CofreeF f a (CofreeT f w a))
forall (f :: * -> *) (w :: * -> *) a.
CofreeT f w a -> w (CofreeF f a (CofreeT f w a))
runCofreeT

instance (Foldable f, Foldable w) => Foldable (CofreeT f w) where
  foldMap :: forall m a. Monoid m => (a -> m) -> CofreeT f w a -> m
foldMap a -> m
f = (CofreeF f a (CofreeT f w a) -> m)
-> w (CofreeF f a (CofreeT f w a)) -> m
forall m a. Monoid m => (a -> m) -> w a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((a -> m)
-> (CofreeT f w a -> m) -> CofreeF f a (CofreeT f w a) -> m
forall m a b.
Monoid m =>
(a -> m) -> (b -> m) -> CofreeF f a b -> m
forall (p :: * -> * -> *) m a b.
(Bifoldable p, Monoid m) =>
(a -> m) -> (b -> m) -> p a b -> m
bifoldMap a -> m
f ((a -> m) -> CofreeT f w a -> m
forall m a. Monoid m => (a -> m) -> CofreeT f w a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f)) (w (CofreeF f a (CofreeT f w a)) -> m)
-> (CofreeT f w a -> w (CofreeF f a (CofreeT f w a)))
-> CofreeT f w a
-> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. CofreeT f w a -> w (CofreeF f a (CofreeT f w a))
forall (f :: * -> *) (w :: * -> *) a.
CofreeT f w a -> w (CofreeF f a (CofreeT f w a))
runCofreeT

instance (Traversable f, Traversable w) => Traversable (CofreeT f w) where
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> CofreeT f w a -> f (CofreeT f w b)
traverse a -> f b
f = (w (CofreeF f b (CofreeT f w b)) -> CofreeT f w b)
-> f (w (CofreeF f b (CofreeT f w b))) -> f (CofreeT f w b)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap w (CofreeF f b (CofreeT f w b)) -> CofreeT f w b
forall (f :: * -> *) (w :: * -> *) a.
w (CofreeF f a (CofreeT f w a)) -> CofreeT f w a
CofreeT (f (w (CofreeF f b (CofreeT f w b))) -> f (CofreeT f w b))
-> (CofreeT f w a -> f (w (CofreeF f b (CofreeT f w b))))
-> CofreeT f w a
-> f (CofreeT f w b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (CofreeF f a (CofreeT f w a) -> f (CofreeF f b (CofreeT f w b)))
-> w (CofreeF f a (CofreeT f w a))
-> f (w (CofreeF f b (CofreeT f w b)))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> w a -> f (w b)
traverse ((a -> f b)
-> (CofreeT f w a -> f (CofreeT f w b))
-> CofreeF f a (CofreeT f w a)
-> f (CofreeF f b (CofreeT f w b))
forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> CofreeF f a b -> f (CofreeF f c d)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse a -> f b
f ((a -> f b) -> CofreeT f w a -> f (CofreeT f w b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> CofreeT f w a -> f (CofreeT f w b)
traverse a -> f b
f)) (w (CofreeF f a (CofreeT f w a))
 -> f (w (CofreeF f b (CofreeT f w b))))
-> (CofreeT f w a -> w (CofreeF f a (CofreeT f w a)))
-> CofreeT f w a
-> f (w (CofreeF f b (CofreeT f w b)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. CofreeT f w a -> w (CofreeF f a (CofreeT f w a))
forall (f :: * -> *) (w :: * -> *) a.
CofreeT f w a -> w (CofreeF f a (CofreeT f w a))
runCofreeT

instance ComonadTrans (CofreeT f) where
  lower :: forall (w :: * -> *) a. Comonad w => CofreeT f w a -> w a
lower = (CofreeF f a (CofreeT f w a) -> a)
-> w (CofreeF f a (CofreeT f w a)) -> w a
forall a b. (a -> b) -> w a -> w b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CofreeF f a (CofreeT f w a) -> a
forall (f :: * -> *) a b. CofreeF f a b -> a
headF (w (CofreeF f a (CofreeT f w a)) -> w a)
-> (CofreeT f w a -> w (CofreeF f a (CofreeT f w a)))
-> CofreeT f w a
-> w a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. CofreeT f w a -> w (CofreeF f a (CofreeT f w a))
forall (f :: * -> *) (w :: * -> *) a.
CofreeT f w a -> w (CofreeF f a (CofreeT f w a))
runCofreeT

instance (Functor f, Comonad w) => ComonadCofree f (CofreeT f w) where
  unwrap :: forall a. CofreeT f w a -> f (CofreeT f w a)
unwrap = CofreeF f a (CofreeT f w a) -> f (CofreeT f w a)
forall (f :: * -> *) a b. CofreeF f a b -> f b
tailF (CofreeF f a (CofreeT f w a) -> f (CofreeT f w a))
-> (CofreeT f w a -> CofreeF f a (CofreeT f w a))
-> CofreeT f w a
-> f (CofreeT f w a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. w (CofreeF f a (CofreeT f w a)) -> CofreeF f a (CofreeT f w a)
forall a. w a -> a
forall (w :: * -> *) a. Comonad w => w a -> a
extract (w (CofreeF f a (CofreeT f w a)) -> CofreeF f a (CofreeT f w a))
-> (CofreeT f w a -> w (CofreeF f a (CofreeT f w a)))
-> CofreeT f w a
-> CofreeF f a (CofreeT f w a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. CofreeT f w a -> w (CofreeF f a (CofreeT f w a))
forall (f :: * -> *) (w :: * -> *) a.
CofreeT f w a -> w (CofreeF f a (CofreeT f w a))
runCofreeT

instance (Functor f, ComonadEnv e w) => ComonadEnv e (CofreeT f w) where
  ask :: forall a. CofreeT f w a -> e
ask = w a -> e
forall a. w a -> e
forall e (w :: * -> *) a. ComonadEnv e w => w a -> e
ask (w a -> e) -> (CofreeT f w a -> w a) -> CofreeT f w a -> e
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. CofreeT f w a -> w a
forall (w :: * -> *) a. Comonad w => CofreeT f w a -> w a
forall (t :: (* -> *) -> * -> *) (w :: * -> *) a.
(ComonadTrans t, Comonad w) =>
t w a -> w a
lower
  {-# INLINE ask #-}

instance Functor f => ComonadHoist (CofreeT f) where
  cohoist :: forall (w :: * -> *) (v :: * -> *) a.
(Comonad w, Comonad v) =>
(forall x. w x -> v x) -> CofreeT f w a -> CofreeT f v a
cohoist forall x. w x -> v x
g = v (CofreeF f a (CofreeT f v a)) -> CofreeT f v a
forall (f :: * -> *) (w :: * -> *) a.
w (CofreeF f a (CofreeT f w a)) -> CofreeT f w a
CofreeT (v (CofreeF f a (CofreeT f v a)) -> CofreeT f v a)
-> (CofreeT f w a -> v (CofreeF f a (CofreeT f v a)))
-> CofreeT f w a
-> CofreeT f v a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (CofreeF f a (CofreeT f w a) -> CofreeF f a (CofreeT f v a))
-> v (CofreeF f a (CofreeT f w a))
-> v (CofreeF f a (CofreeT f v a))
forall a b. (a -> b) -> v a -> v b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((CofreeT f w a -> CofreeT f v a)
-> CofreeF f a (CofreeT f w a) -> CofreeF f a (CofreeT f v a)
forall b c a. (b -> c) -> CofreeF f a b -> CofreeF f a c
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ((forall x. w x -> v x) -> CofreeT f w a -> CofreeT f v a
forall (w :: * -> *) (v :: * -> *) a.
(Comonad w, Comonad v) =>
(forall x. w x -> v x) -> CofreeT f w a -> CofreeT f v a
forall (t :: (* -> *) -> * -> *) (w :: * -> *) (v :: * -> *) a.
(ComonadHoist t, Comonad w, Comonad v) =>
(forall x. w x -> v x) -> t w a -> t v a
cohoist w x -> v x
forall x. w x -> v x
g)) (v (CofreeF f a (CofreeT f w a))
 -> v (CofreeF f a (CofreeT f v a)))
-> (CofreeT f w a -> v (CofreeF f a (CofreeT f w a)))
-> CofreeT f w a
-> v (CofreeF f a (CofreeT f v a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. w (CofreeF f a (CofreeT f w a)) -> v (CofreeF f a (CofreeT f w a))
forall x. w x -> v x
g (w (CofreeF f a (CofreeT f w a))
 -> v (CofreeF f a (CofreeT f w a)))
-> (CofreeT f w a -> w (CofreeF f a (CofreeT f w a)))
-> CofreeT f w a
-> v (CofreeF f a (CofreeT f w a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. CofreeT f w a -> w (CofreeF f a (CofreeT f w a))
forall (f :: * -> *) (w :: * -> *) a.
CofreeT f w a -> w (CofreeF f a (CofreeT f w a))
runCofreeT

instance Show (w (CofreeF f a (CofreeT f w a))) => Show (CofreeT f w a) where
  showsPrec :: Int -> CofreeT f w a -> ShowS
showsPrec Int
d (CofreeT w (CofreeF f a (CofreeT f w a))
w) = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
    String -> ShowS
showString String
"CofreeT " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int -> w (CofreeF f a (CofreeT f w a)) -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 w (CofreeF f a (CofreeT f w a))
w

instance Read (w (CofreeF f a (CofreeT f w a))) => Read (CofreeT f w a) where
  readsPrec :: Int -> ReadS (CofreeT f w a)
readsPrec Int
d = Bool -> ReadS (CofreeT f w a) -> ReadS (CofreeT f w a)
forall a. Bool -> ReadS a -> ReadS a
readParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ReadS (CofreeT f w a) -> ReadS (CofreeT f w a))
-> ReadS (CofreeT f w a) -> ReadS (CofreeT f w a)
forall a b. (a -> b) -> a -> b
$ \String
r ->
     [(w (CofreeF f a (CofreeT f w a)) -> CofreeT f w a
forall (f :: * -> *) (w :: * -> *) a.
w (CofreeF f a (CofreeT f w a)) -> CofreeT f w a
CofreeT w (CofreeF f a (CofreeT f w a))
w, String
t) | (String
"CofreeT", String
s) <- ReadS String
lex String
r, (w (CofreeF f a (CofreeT f w a))
w, String
t) <- Int -> ReadS (w (CofreeF f a (CofreeT f w a)))
forall a. Read a => Int -> ReadS a
readsPrec Int
11 String
s]

instance Eq (w (CofreeF f a (CofreeT f w a))) => Eq (CofreeT f w a) where
  CofreeT w (CofreeF f a (CofreeT f w a))
a == :: CofreeT f w a -> CofreeT f w a -> Bool
== CofreeT w (CofreeF f a (CofreeT f w a))
b = w (CofreeF f a (CofreeT f w a))
a w (CofreeF f a (CofreeT f w a))
-> w (CofreeF f a (CofreeT f w a)) -> Bool
forall a. Eq a => a -> a -> Bool
== w (CofreeF f a (CofreeT f w a))
b

instance Ord (w (CofreeF f a (CofreeT f w a))) => Ord (CofreeT f w a) where
  compare :: CofreeT f w a -> CofreeT f w a -> Ordering
compare (CofreeT w (CofreeF f a (CofreeT f w a))
a) (CofreeT w (CofreeF f a (CofreeT f w a))
b) = w (CofreeF f a (CofreeT f w a))
-> w (CofreeF f a (CofreeT f w a)) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare w (CofreeF f a (CofreeT f w a))
a w (CofreeF f a (CofreeT f w a))
b

instance (Alternative f, Monad w) => Monad (CofreeT f w) where
  CofreeT w (CofreeF f a (CofreeT f w a))
cx >>= :: forall a b. CofreeT f w a -> (a -> CofreeT f w b) -> CofreeT f w b
>>= a -> CofreeT f w b
f = w (CofreeF f b (CofreeT f w b)) -> CofreeT f w b
forall (f :: * -> *) (w :: * -> *) a.
w (CofreeF f a (CofreeT f w a)) -> CofreeT f w a
CofreeT (w (CofreeF f b (CofreeT f w b)) -> CofreeT f w b)
-> w (CofreeF f b (CofreeT f w b)) -> CofreeT f w b
forall a b. (a -> b) -> a -> b
$ do
    a
a :< f (CofreeT f w a)
m <- w (CofreeF f a (CofreeT f w a))
cx
    b
b :< f (CofreeT f w b)
n <- CofreeT f w b -> w (CofreeF f b (CofreeT f w b))
forall (f :: * -> *) (w :: * -> *) a.
CofreeT f w a -> w (CofreeF f a (CofreeT f w a))
runCofreeT (CofreeT f w b -> w (CofreeF f b (CofreeT f w b)))
-> CofreeT f w b -> w (CofreeF f b (CofreeT f w b))
forall a b. (a -> b) -> a -> b
$ a -> CofreeT f w b
f a
a
    CofreeF f b (CofreeT f w b) -> w (CofreeF f b (CofreeT f w b))
forall a. a -> w a
forall (m :: * -> *) a. Monad m => a -> m a
return (CofreeF f b (CofreeT f w b) -> w (CofreeF f b (CofreeT f w b)))
-> CofreeF f b (CofreeT f w b) -> w (CofreeF f b (CofreeT f w b))
forall a b. (a -> b) -> a -> b
$ b
b b -> f (CofreeT f w b) -> CofreeF f b (CofreeT f w b)
forall (f :: * -> *) a b. a -> f b -> CofreeF f a b
:< (f (CofreeT f w b)
n f (CofreeT f w b) -> f (CofreeT f w b) -> f (CofreeT f w b)
forall a. f a -> f a -> f a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (CofreeT f w a -> CofreeT f w b)
-> f (CofreeT f w a) -> f (CofreeT f w b)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (CofreeT f w a -> (a -> CofreeT f w b) -> CofreeT f w b
forall a b. CofreeT f w a -> (a -> CofreeT f w b) -> CofreeT f w b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> CofreeT f w b
f) f (CofreeT f w a)
m)


instance (Alternative f, Applicative w) => Applicative (CofreeT f w) where
  pure :: forall a. a -> CofreeT f w a
pure = w (CofreeF f a (CofreeT f w a)) -> CofreeT f w a
forall (f :: * -> *) (w :: * -> *) a.
w (CofreeF f a (CofreeT f w a)) -> CofreeT f w a
CofreeT (w (CofreeF f a (CofreeT f w a)) -> CofreeT f w a)
-> (a -> w (CofreeF f a (CofreeT f w a))) -> a -> CofreeT f w a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. CofreeF f a (CofreeT f w a) -> w (CofreeF f a (CofreeT f w a))
forall a. a -> w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CofreeF f a (CofreeT f w a) -> w (CofreeF f a (CofreeT f w a)))
-> (a -> CofreeF f a (CofreeT f w a))
-> a
-> w (CofreeF f a (CofreeT f w a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (a -> f (CofreeT f w a) -> CofreeF f a (CofreeT f w a)
forall (f :: * -> *) a b. a -> f b -> CofreeF f a b
:< f (CofreeT f w a)
forall a. f a
forall (f :: * -> *) a. Alternative f => f a
empty)
  {-# INLINE pure #-}
  CofreeT f w (a -> b)
wf <*> :: forall a b. CofreeT f w (a -> b) -> CofreeT f w a -> CofreeT f w b
<*> CofreeT f w a
wa = w (CofreeF f b (CofreeT f w b)) -> CofreeT f w b
forall (f :: * -> *) (w :: * -> *) a.
w (CofreeF f a (CofreeT f w a)) -> CofreeT f w a
CofreeT (w (CofreeF f b (CofreeT f w b)) -> CofreeT f w b)
-> w (CofreeF f b (CofreeT f w b)) -> CofreeT f w b
forall a b. (a -> b) -> a -> b
$ CofreeF f (a -> b) (CofreeT f w (a -> b))
-> CofreeF f a (CofreeT f w a) -> CofreeF f b (CofreeT f w b)
forall {f :: * -> *} {a} {a}.
Alternative f =>
CofreeF f (a -> a) (CofreeT f w (a -> a))
-> CofreeF f a (CofreeT f w a) -> CofreeF f a (CofreeT f w a)
go (CofreeF f (a -> b) (CofreeT f w (a -> b))
 -> CofreeF f a (CofreeT f w a) -> CofreeF f b (CofreeT f w b))
-> w (CofreeF f (a -> b) (CofreeT f w (a -> b)))
-> w (CofreeF f a (CofreeT f w a) -> CofreeF f b (CofreeT f w b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CofreeT f w (a -> b)
-> w (CofreeF f (a -> b) (CofreeT f w (a -> b)))
forall (f :: * -> *) (w :: * -> *) a.
CofreeT f w a -> w (CofreeF f a (CofreeT f w a))
runCofreeT CofreeT f w (a -> b)
wf w (CofreeF f a (CofreeT f w a) -> CofreeF f b (CofreeT f w b))
-> w (CofreeF f a (CofreeT f w a))
-> w (CofreeF f b (CofreeT f w b))
forall a b. w (a -> b) -> w a -> w b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> CofreeT f w a -> w (CofreeF f a (CofreeT f w a))
forall (f :: * -> *) (w :: * -> *) a.
CofreeT f w a -> w (CofreeF f a (CofreeT f w a))
runCofreeT CofreeT f w a
wa where
    go :: CofreeF f (a -> a) (CofreeT f w (a -> a))
-> CofreeF f a (CofreeT f w a) -> CofreeF f a (CofreeT f w a)
go (a -> a
f :< f (CofreeT f w (a -> a))
t) CofreeF f a (CofreeT f w a)
a = case (a -> a)
-> (CofreeT f w a -> CofreeT f w a)
-> CofreeF f a (CofreeT f w a)
-> CofreeF f a (CofreeT f w a)
forall a b c d.
(a -> b) -> (c -> d) -> CofreeF f a c -> CofreeF f b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap a -> a
f ((a -> a) -> CofreeT f w a -> CofreeT f w a
forall a b. (a -> b) -> CofreeT f w a -> CofreeT f w b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
f) CofreeF f a (CofreeT f w a)
a of
      a
b :< f (CofreeT f w a)
n -> a
b a -> f (CofreeT f w a) -> CofreeF f a (CofreeT f w a)
forall (f :: * -> *) a b. a -> f b -> CofreeF f a b
:< (f (CofreeT f w a)
n f (CofreeT f w a) -> f (CofreeT f w a) -> f (CofreeT f w a)
forall a. f a -> f a -> f a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (CofreeT f w (a -> a) -> CofreeT f w a)
-> f (CofreeT f w (a -> a)) -> f (CofreeT f w a)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (CofreeT f w (a -> a) -> CofreeT f w a -> CofreeT f w a
forall a b. CofreeT f w (a -> b) -> CofreeT f w a -> CofreeT f w b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> CofreeT f w a
wa) f (CofreeT f w (a -> a))
t)
  {-# INLINE (<*>) #-}

instance Alternative f => MonadTrans (CofreeT f) where
  lift :: forall (m :: * -> *) a. Monad m => m a -> CofreeT f m a
lift = m (CofreeF f a (CofreeT f m a)) -> CofreeT f m a
forall (f :: * -> *) (w :: * -> *) a.
w (CofreeF f a (CofreeT f w a)) -> CofreeT f w a
CofreeT (m (CofreeF f a (CofreeT f m a)) -> CofreeT f m a)
-> (m a -> m (CofreeF f a (CofreeT f m a))) -> m a -> CofreeT f m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (a -> CofreeF f a (CofreeT f m a))
-> m a -> m (CofreeF f a (CofreeT f m a))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (a -> f (CofreeT f m a) -> CofreeF f a (CofreeT f m a)
forall (f :: * -> *) a b. a -> f b -> CofreeF f a b
:< f (CofreeT f m a)
forall a. f a
forall (f :: * -> *) a. Alternative f => f a
empty)

instance (Alternative f, MonadZip f, MonadZip m) => MonadZip (CofreeT f m) where
  mzip :: forall a b. CofreeT f m a -> CofreeT f m b -> CofreeT f m (a, b)
mzip (CofreeT m (CofreeF f a (CofreeT f m a))
ma) (CofreeT m (CofreeF f b (CofreeT f m b))
mb) = m (CofreeF f (a, b) (CofreeT f m (a, b))) -> CofreeT f m (a, b)
forall (f :: * -> *) (w :: * -> *) a.
w (CofreeF f a (CofreeT f w a)) -> CofreeT f w a
CofreeT (m (CofreeF f (a, b) (CofreeT f m (a, b))) -> CofreeT f m (a, b))
-> m (CofreeF f (a, b) (CofreeT f m (a, b))) -> CofreeT f m (a, b)
forall a b. (a -> b) -> a -> b
$ do
                                     (a
a :< f (CofreeT f m a)
fa, b
b :< f (CofreeT f m b)
fb) <- m (CofreeF f a (CofreeT f m a))
-> m (CofreeF f b (CofreeT f m b))
-> m (CofreeF f a (CofreeT f m a), CofreeF f b (CofreeT f m b))
forall a b. m a -> m b -> m (a, b)
forall (m :: * -> *) a b. MonadZip m => m a -> m b -> m (a, b)
mzip m (CofreeF f a (CofreeT f m a))
ma m (CofreeF f b (CofreeT f m b))
mb
                                     CofreeF f (a, b) (CofreeT f m (a, b))
-> m (CofreeF f (a, b) (CofreeT f m (a, b)))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CofreeF f (a, b) (CofreeT f m (a, b))
 -> m (CofreeF f (a, b) (CofreeT f m (a, b))))
-> CofreeF f (a, b) (CofreeT f m (a, b))
-> m (CofreeF f (a, b) (CofreeT f m (a, b)))
forall a b. (a -> b) -> a -> b
$ (a
a, b
b) (a, b)
-> f (CofreeT f m (a, b)) -> CofreeF f (a, b) (CofreeT f m (a, b))
forall (f :: * -> *) a b. a -> f b -> CofreeF f a b
:< ((CofreeT f m a -> CofreeT f m b -> CofreeT f m (a, b))
-> (CofreeT f m a, CofreeT f m b) -> CofreeT f m (a, b)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry CofreeT f m a -> CofreeT f m b -> CofreeT f m (a, b)
forall a b. CofreeT f m a -> CofreeT f m b -> CofreeT f m (a, b)
forall (m :: * -> *) a b. MonadZip m => m a -> m b -> m (a, b)
mzip ((CofreeT f m a, CofreeT f m b) -> CofreeT f m (a, b))
-> f (CofreeT f m a, CofreeT f m b) -> f (CofreeT f m (a, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (CofreeT f m a)
-> f (CofreeT f m b) -> f (CofreeT f m a, CofreeT f m b)
forall a b. f a -> f b -> f (a, b)
forall (m :: * -> *) a b. MonadZip m => m a -> m b -> m (a, b)
mzip f (CofreeT f m a)
fa f (CofreeT f m b)
fb)

-- | Lift a natural transformation from @f@ to @g@ into a comonad homomorphism from @'CofreeT' f w@ to @'CofreeT' g w@
transCofreeT :: (Functor g, Comonad w) => (forall x. f x -> g x) -> CofreeT f w a -> CofreeT g w a
transCofreeT :: forall (g :: * -> *) (w :: * -> *) (f :: * -> *) a.
(Functor g, Comonad w) =>
(forall x. f x -> g x) -> CofreeT f w a -> CofreeT g w a
transCofreeT forall x. f x -> g x
t = w (CofreeF g a (CofreeT g w a)) -> CofreeT g w a
forall (f :: * -> *) (w :: * -> *) a.
w (CofreeF f a (CofreeT f w a)) -> CofreeT f w a
CofreeT (w (CofreeF g a (CofreeT g w a)) -> CofreeT g w a)
-> (CofreeT f w a -> w (CofreeF g a (CofreeT g w a)))
-> CofreeT f w a
-> CofreeT g w a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (CofreeF f a (CofreeT f w a) -> CofreeF g a (CofreeT g w a))
-> w (CofreeF f a (CofreeT f w a))
-> w (CofreeF g a (CofreeT g w a))
forall (w :: * -> *) a b. Comonad w => (a -> b) -> w a -> w b
liftW ((CofreeT f w a -> CofreeT g w a)
-> CofreeF g a (CofreeT f w a) -> CofreeF g a (CofreeT g w a)
forall a b. (a -> b) -> CofreeF g a a -> CofreeF g a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((forall x. f x -> g x) -> CofreeT f w a -> CofreeT g w a
forall (g :: * -> *) (w :: * -> *) (f :: * -> *) a.
(Functor g, Comonad w) =>
(forall x. f x -> g x) -> CofreeT f w a -> CofreeT g w a
transCofreeT f x -> g x
forall x. f x -> g x
t) (CofreeF g a (CofreeT f w a) -> CofreeF g a (CofreeT g w a))
-> (CofreeF f a (CofreeT f w a) -> CofreeF g a (CofreeT f w a))
-> CofreeF f a (CofreeT f w a)
-> CofreeF g a (CofreeT g w a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (forall x. f x -> g x)
-> CofreeF f a (CofreeT f w a) -> CofreeF g a (CofreeT f w a)
forall (f :: * -> *) (g :: * -> *) a b.
(forall x. f x -> g x) -> CofreeF f a b -> CofreeF g a b
transCofreeF f x -> g x
forall x. f x -> g x
t) (w (CofreeF f a (CofreeT f w a))
 -> w (CofreeF g a (CofreeT g w a)))
-> (CofreeT f w a -> w (CofreeF f a (CofreeT f w a)))
-> CofreeT f w a
-> w (CofreeF g a (CofreeT g w a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. CofreeT f w a -> w (CofreeF f a (CofreeT f w a))
forall (f :: * -> *) (w :: * -> *) a.
CofreeT f w a -> w (CofreeF f a (CofreeT f w a))
runCofreeT

-- | Unfold a @CofreeT@ comonad transformer from a coalgebra and an initial comonad.
coiterT :: (Functor f, Comonad w) => (w a -> f (w a)) -> w a -> CofreeT f w a
coiterT :: forall (f :: * -> *) (w :: * -> *) a.
(Functor f, Comonad w) =>
(w a -> f (w a)) -> w a -> CofreeT f w a
coiterT w a -> f (w a)
psi = w (CofreeF f a (CofreeT f w a)) -> CofreeT f w a
forall (f :: * -> *) (w :: * -> *) a.
w (CofreeF f a (CofreeT f w a)) -> CofreeT f w a
CofreeT (w (CofreeF f a (CofreeT f w a)) -> CofreeT f w a)
-> (w a -> w (CofreeF f a (CofreeT f w a))) -> w a -> CofreeT f w a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (w a -> CofreeF f a (CofreeT f w a))
-> w a -> w (CofreeF f a (CofreeT f w a))
forall a b. (w a -> b) -> w a -> w b
forall (w :: * -> *) a b. Comonad w => (w a -> b) -> w a -> w b
extend (\w a
w -> w a -> a
forall a. w a -> a
forall (w :: * -> *) a. Comonad w => w a -> a
extract w a
w a -> f (CofreeT f w a) -> CofreeF f a (CofreeT f w a)
forall (f :: * -> *) a b. a -> f b -> CofreeF f a b
:< (w a -> CofreeT f w a) -> f (w a) -> f (CofreeT f w a)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((w a -> f (w a)) -> w a -> CofreeT f w a
forall (f :: * -> *) (w :: * -> *) a.
(Functor f, Comonad w) =>
(w a -> f (w a)) -> w a -> CofreeT f w a
coiterT w a -> f (w a)
psi) (w a -> f (w a)
psi w a
w))

deriving instance
  ( Typeable f
  , Data a, Data (f b), Data b
  ) => Data (CofreeF f a b)

deriving instance
  ( Typeable f, Typeable w
  , Data (w (CofreeF f a (CofreeT f w a)))
  , Data a
  ) => Data (CofreeT f w a)

-- lowerF :: (Functor f, Comonad w) => CofreeT f w a -> f a
-- lowerF = fmap extract . unwrap