{-# 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (f :: * -> *) a b.
(Eq a, Eq (f b)) =>
CofreeF f a b -> CofreeF f a b -> Bool
/= :: CofreeF f a b -> CofreeF f a b -> Bool
$c/= :: forall (f :: * -> *) a b.
(Eq a, Eq (f b)) =>
CofreeF f a b -> CofreeF f a b -> Bool
== :: CofreeF f a b -> CofreeF f a b -> Bool
$c== :: forall (f :: * -> *) a b.
(Eq a, Eq (f b)) =>
CofreeF f a b -> CofreeF f a b -> Bool
Eq,CofreeF f a b -> CofreeF f a b -> Bool
CofreeF f a b -> CofreeF f a b -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {f :: * -> *} {a} {b}.
(Ord a, Ord (f b)) =>
Eq (CofreeF f a b)
forall (f :: * -> *) a b.
(Ord a, Ord (f b)) =>
CofreeF f a b -> CofreeF f a b -> Bool
forall (f :: * -> *) a b.
(Ord a, Ord (f b)) =>
CofreeF f a b -> CofreeF f a b -> Ordering
forall (f :: * -> *) a b.
(Ord a, Ord (f b)) =>
CofreeF f a b -> CofreeF f a b -> CofreeF f a b
min :: CofreeF f a b -> CofreeF f a b -> CofreeF f a b
$cmin :: forall (f :: * -> *) a b.
(Ord a, Ord (f b)) =>
CofreeF f a b -> CofreeF f a b -> CofreeF f a b
max :: CofreeF f a b -> CofreeF f a b -> CofreeF f a b
$cmax :: forall (f :: * -> *) a b.
(Ord a, Ord (f b)) =>
CofreeF f a b -> CofreeF f a b -> CofreeF f a b
>= :: CofreeF f a b -> CofreeF f a b -> Bool
$c>= :: forall (f :: * -> *) a b.
(Ord a, Ord (f b)) =>
CofreeF f a b -> CofreeF f a b -> Bool
> :: CofreeF f a b -> CofreeF f a b -> Bool
$c> :: forall (f :: * -> *) a b.
(Ord a, Ord (f b)) =>
CofreeF f a b -> CofreeF f a b -> Bool
<= :: CofreeF f a b -> CofreeF f a b -> Bool
$c<= :: forall (f :: * -> *) a b.
(Ord a, Ord (f b)) =>
CofreeF f a b -> CofreeF f a b -> Bool
< :: CofreeF f a b -> CofreeF f a b -> Bool
$c< :: forall (f :: * -> *) a b.
(Ord a, Ord (f b)) =>
CofreeF f a b -> CofreeF f a b -> Bool
compare :: CofreeF f a b -> CofreeF f a b -> Ordering
$ccompare :: forall (f :: * -> *) a b.
(Ord a, Ord (f b)) =>
CofreeF f a b -> CofreeF f a b -> Ordering
Ord,Int -> CofreeF f a b -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (f :: * -> *) a b.
(Show a, Show (f b)) =>
Int -> CofreeF f a b -> ShowS
forall (f :: * -> *) a b.
(Show a, Show (f b)) =>
[CofreeF f a b] -> ShowS
forall (f :: * -> *) a b.
(Show a, Show (f b)) =>
CofreeF f a b -> String
showList :: [CofreeF f a b] -> ShowS
$cshowList :: forall (f :: * -> *) a b.
(Show a, Show (f b)) =>
[CofreeF f a b] -> ShowS
show :: CofreeF f a b -> String
$cshow :: forall (f :: * -> *) a b.
(Show a, Show (f b)) =>
CofreeF f a b -> String
showsPrec :: Int -> CofreeF f a b -> ShowS
$cshowsPrec :: forall (f :: * -> *) a b.
(Show a, Show (f b)) =>
Int -> CofreeF f a b -> ShowS
Show,ReadPrec [CofreeF f a b]
ReadPrec (CofreeF f a b)
ReadS [CofreeF f a b]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall (f :: * -> *) a b.
(Read a, Read (f b)) =>
ReadPrec [CofreeF f a b]
forall (f :: * -> *) a b.
(Read a, Read (f b)) =>
ReadPrec (CofreeF f a b)
forall (f :: * -> *) a b.
(Read a, Read (f b)) =>
Int -> ReadS (CofreeF f a b)
forall (f :: * -> *) a b.
(Read a, Read (f b)) =>
ReadS [CofreeF f a b]
readListPrec :: ReadPrec [CofreeF f a b]
$creadListPrec :: forall (f :: * -> *) a b.
(Read a, Read (f b)) =>
ReadPrec [CofreeF f a b]
readPrec :: ReadPrec (CofreeF f a b)
$creadPrec :: forall (f :: * -> *) a b.
(Read a, Read (f b)) =>
ReadPrec (CofreeF f a b)
readList :: ReadS [CofreeF f a b]
$creadList :: forall (f :: * -> *) a b.
(Read a, Read (f b)) =>
ReadS [CofreeF f a b]
readsPrec :: Int -> ReadS (CofreeF f a b)
$creadsPrec :: forall (f :: * -> *) a b.
(Read a, Read (f b)) =>
Int -> ReadS (CofreeF f a b)
Read,forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (f :: * -> *) a b x. Rep (CofreeF f a b) x -> CofreeF f a b
forall (f :: * -> *) a b x. CofreeF f a b -> Rep (CofreeF f a b) x
$cto :: forall (f :: * -> *) a b x. Rep (CofreeF f a b) x -> CofreeF f a b
$cfrom :: forall (f :: * -> *) a b x. CofreeF f a b -> Rep (CofreeF f a b) x
Generic,forall k (f :: k -> *).
(forall (a :: k). f a -> Rep1 f a)
-> (forall (a :: k). Rep1 f a -> f a) -> Generic1 f
forall (f :: * -> *) a a. Rep1 (CofreeF f a) a -> CofreeF f a a
forall (f :: * -> *) a a. CofreeF f a a -> Rep1 (CofreeF f a) a
$cto1 :: forall (f :: * -> *) a a. Rep1 (CofreeF f a) a -> CofreeF f a a
$cfrom1 :: forall (f :: * -> *) a a. CofreeF f a a -> Rep1 (CofreeF f a) a
Generic1)

instance Show1 f => Show2 (CofreeF f) where
  liftShowsPrec2 :: forall a b.
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> CofreeF f a b
-> ShowS
liftShowsPrec2 Int -> a -> ShowS
spa [a] -> ShowS
_sla Int -> b -> ShowS
spb [b] -> ShowS
slb Int
d (a
a :< f b
fb) =
    Bool -> ShowS -> ShowS
showParen (Int
d forall a. Ord a => a -> a -> Bool
> Int
5) forall a b. (a -> b) -> a -> b
$
      Int -> a -> ShowS
spa Int
6 a
a forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> ShowS
showString String
" :< " forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec Int -> b -> ShowS
spb [b] -> ShowS
slb Int
6 f b
fb

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

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

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

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

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

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

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

-- | 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 forall (f :: * -> *) a b. a -> f b -> CofreeF f a b
:< forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f f a
as

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

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

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

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

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

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

-- | 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 = forall (f :: * -> *) (w :: * -> *) a.
w (CofreeF f a (CofreeT f w a)) -> CofreeT f w a
CofreeT forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. a -> Identity a
Identity
{-# INLINE cofree #-}


{- |
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 = forall a. Identity a -> a
runIdentity forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) (w :: * -> *) a.
CofreeT f w a -> w (CofreeF f a (CofreeT f w a))
runCofreeT
{-# INLINE runCofree #-}

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

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

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

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

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

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

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

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

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

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

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

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

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


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

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

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

-- | 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 = forall (f :: * -> *) (w :: * -> *) a.
w (CofreeF f a (CofreeT f w a)) -> CofreeT f w a
CofreeT forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (w :: * -> *) a b. Comonad w => (a -> b) -> w a -> w b
liftW (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (g :: * -> *) (w :: * -> *) (f :: * -> *) a.
(Functor g, Comonad w) =>
(forall x. f x -> g x) -> CofreeT f w a -> CofreeT g w a
transCofreeT forall x. f x -> g x
t) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) (g :: * -> *) a b.
(forall x. f x -> g x) -> CofreeF f a b -> CofreeF g a b
transCofreeF forall x. f x -> g x
t) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) (w :: * -> *) a.
CofreeT f w a -> w (CofreeF f a (CofreeT f w a))
runCofreeT

-- | 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 = forall (f :: * -> *) (w :: * -> *) a.
w (CofreeF f a (CofreeT f w a)) -> CofreeT f w a
CofreeT forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (w :: * -> *) a b. Comonad w => (w a -> b) -> w a -> w b
extend (\w a
w -> forall (w :: * -> *) a. Comonad w => w a -> a
extract w a
w forall (f :: * -> *) a b. a -> f b -> CofreeF f a b
:< forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) (w :: * -> *) a.
(Functor f, Comonad w) =>
(w a -> f (w a)) -> w a -> CofreeT f w a
coiterT w a -> f (w a)
psi) (w a -> f (w a)
psi w a
w))

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