{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE Rank2Types #-}
#if __GLASGOW_HASKELL__ >= 707
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE Safe #-}
#else
-- Manual Typeable instances

{-# LANGUAGE Trustworthy #-}
#endif
#include "free-common.h"

-----------------------------------------------------------------------------

-- |

-- 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
#if __GLASGOW_HASKELL__ >= 707
import GHC.Generics hiding (Infix, Prefix)
#endif

#if !(MIN_VERSION_base(4,8,0))
import Data.Monoid
#endif

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
/= :: 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,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
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
$cp1Ord :: forall (f :: * -> *) a b. (Ord a, Ord (f b)) => Eq (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
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)
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]
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
#if __GLASGOW_HASKELL__ >= 707
           ,Typeable, (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
$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 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
$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
#endif
           )

#ifdef LIFTED_FUNCTOR_CLASSES
instance Show1 f => Show2 (CofreeF f) where
  liftShowsPrec2 :: (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 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 -> b -> ShowS) -> ([b] -> ShowS) -> Int -> f b -> 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 :: (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 (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

#else
instance (Functor f, Show1 f, Show a) => Show1 (CofreeF f a) where
  showsPrec1 d (a :< fb) = showParen (d > 5) $
    showsPrec 6 a .  showString " :< " . showsPrec1 6 fb
#endif

#ifdef LIFTED_FUNCTOR_CLASSES
instance Read1 f => Read2 (CofreeF f) where
  liftReadsPrec2 :: (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 (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 :: (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 (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
#else
instance (Read1 f, Read a) => Read1 (CofreeF f a) where
  readsPrec1 d =
    readParen (d > 5) $
      (\r' -> [ (u :< v,w)
              | (u, s) <- readsPrec 6 r'
              , (":<", t) <- lex s
              , (v, w) <- readsPrec1 6 t
              ])
#endif

#ifdef LIFTED_FUNCTOR_CLASSES
instance Eq1 f => Eq2 (CofreeF f) where
  liftEq2 :: (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 (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 :: (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 (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
(==)
#else
instance (Eq1 f, Eq a) => Eq1 (CofreeF f a) where
  eq1 (a :< fb) (a' :< fb') = a == a' && eq1 fb fb'
#endif

#ifdef LIFTED_FUNCTOR_CLASSES
instance Ord1 f => Ord2 (CofreeF f) where
  liftCompare2 :: (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 (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 :: (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 (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
#else
instance (Ord1 f, Ord a) => Ord1 (CofreeF f a) where
  compare1 (a :< fb) (a' :< fb') =
    case compare a a' of
      LT -> LT
      EQ -> compare1 fb fb'
      GT -> GT
#endif

-- | Extract the head of the base functor

headF :: CofreeF f a b -> a
headF :: 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 :: CofreeF f a b -> f b
tailF (a
_ :< f b
as) = f b
as

instance Functor f => Functor (CofreeF f a) where
  fmap :: (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 (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 :: (a -> m) -> CofreeF f a a -> m
foldMap a -> m
f (a
_ :< f a
as) = (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 :: (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)
traverse a -> f b
f f a
as

instance Functor f => Bifunctor (CofreeF f) where
  bimap :: (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 (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 :: (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 (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 :: (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 (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)
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 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 { CofreeT f w a -> w (CofreeF f a (CofreeT f w a))
runCofreeT :: w (CofreeF f a (CofreeT f w a)) }
#if __GLASGOW_HASKELL__ >= 707
  deriving Typeable
#endif

-- | 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 :: 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 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 :: 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 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 :: (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 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 (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 (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 (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 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 :: 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 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 (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 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 :: (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 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 (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 (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 (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 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 :: (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 (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 (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 (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 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 :: (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 (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 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)
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 (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)
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 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 :: 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 (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 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 :: 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 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 (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 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 :: CofreeT f w a -> e
ask = 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 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 (t :: (* -> *) -> * -> *) (w :: * -> *) a.
(ComonadTrans t, Comonad w) =>
t w a -> w a
lower
  {-# INLINE ask #-}

instance Functor f => ComonadHoist (CofreeT f) where
  cohoist :: (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 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 (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 (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 (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)) (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 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 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 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
#if __GLASGOW_HASKELL__ < 710
  return = CofreeT . return . (:< empty)
  {-# INLINE return #-}
#endif
  CofreeT w (CofreeF f a (CofreeT f w a))
cx >>= :: 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 (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 (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 (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 (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 :: 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 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 (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 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 (f :: * -> *) a. Alternative f => f a
empty)
  {-# INLINE pure #-}
  CofreeT f w (a -> b)
wf <*> :: 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 (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 (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 (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 (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 (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 (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 :: 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 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 (f :: * -> *) a. Alternative f => f a
empty)

instance (Alternative f, MonadZip f, MonadZip m) => MonadZip (CofreeT f m) where
  mzip :: 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 (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 (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 (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 (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 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 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 (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 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 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 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 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 :: (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 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 (w :: * -> *) a b. Comonad w => (w a -> b) -> w a -> w b
extend (\w a
w -> 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 (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))

#if __GLASGOW_HASKELL__ < 707

instance Typeable1 f => Typeable2 (CofreeF f) where
  typeOf2 t = mkTyConApp cofreeFTyCon [typeOf1 (f t)] where
    f :: CofreeF f a b -> f a
    f = undefined

instance (Typeable1 f, Typeable1 w) => Typeable1 (CofreeT f w) where
  typeOf1 t = mkTyConApp cofreeTTyCon [typeOf1 (f t), typeOf1 (w t)] where
    f :: CofreeT f w a -> f a
    f = undefined
    w :: CofreeT f w a -> w a
    w = undefined

cofreeFTyCon, cofreeTTyCon :: TyCon
#if __GLASGOW_HASKELL__ < 704
cofreeTTyCon = mkTyCon "Control.Comonad.Trans.Cofree.CofreeT"
cofreeFTyCon = mkTyCon "Control.Comonad.Trans.Cofree.CofreeF"
#else
cofreeTTyCon = mkTyCon3 "free" "Control.Comonad.Trans.Cofree" "CofreeT"
cofreeFTyCon = mkTyCon3 "free" "Control.Comonad.Trans.Cofree" "CofreeF"
#endif
{-# NOINLINE cofreeTTyCon #-}
{-# NOINLINE cofreeFTyCon #-}

#else
#define Typeable1 Typeable
#endif

instance
  ( Typeable1 f, Typeable a, Typeable b
  , Data a, Data (f b), Data b
  ) => Data (CofreeF f a b) where
    gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CofreeF f a b -> c (CofreeF f a b)
gfoldl forall d b. Data d => c (d -> b) -> d -> c b
f forall g. g -> c g
z (a
a :< f b
as) = (a -> f b -> CofreeF f a b) -> c (a -> f b -> CofreeF f a b)
forall g. g -> c g
z a -> f b -> CofreeF f a b
forall (f :: * -> *) a b. a -> f b -> CofreeF f a b
(:<) c (a -> f b -> CofreeF f a b) -> a -> c (f b -> CofreeF f a b)
forall d b. Data d => c (d -> b) -> d -> c b
`f` a
a c (f b -> CofreeF f a b) -> f b -> c (CofreeF f a b)
forall d b. Data d => c (d -> b) -> d -> c b
`f` f b
as
    toConstr :: CofreeF f a b -> Constr
toConstr CofreeF f a b
_ = Constr
cofreeFConstr
    gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (CofreeF f a b)
gunfold forall b r. Data b => c (b -> r) -> c r
k forall r. r -> c r
z Constr
c = case Constr -> Int
constrIndex Constr
c of
        Int
1 -> c (f b -> CofreeF f a b) -> c (CofreeF f a b)
forall b r. Data b => c (b -> r) -> c r
k (c (a -> f b -> CofreeF f a b) -> c (f b -> CofreeF f a b)
forall b r. Data b => c (b -> r) -> c r
k ((a -> f b -> CofreeF f a b) -> c (a -> f b -> CofreeF f a b)
forall r. r -> c r
z a -> f b -> CofreeF f a b
forall (f :: * -> *) a b. a -> f b -> CofreeF f a b
(:<)))
        Int
_ -> String -> c (CofreeF f a b)
forall a. HasCallStack => String -> a
error String
"gunfold"
    dataTypeOf :: CofreeF f a b -> DataType
dataTypeOf CofreeF f a b
_ = DataType
cofreeFDataType
    dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c (CofreeF f a b))
dataCast1 forall d. Data d => c (t d)
f = c (t b) -> Maybe (c (CofreeF f a b))
forall k1 k2 (c :: k1 -> *) (t :: k2 -> k1) (t' :: k2 -> k1)
       (a :: k2).
(Typeable t, Typeable t') =>
c (t a) -> Maybe (c (t' a))
gcast1 c (t b)
forall d. Data d => c (t d)
f

instance
  ( Typeable1 f, Typeable1 w, Typeable a
  , Data (w (CofreeF f a (CofreeT f w a)))
  , Data a
  ) => Data (CofreeT f w a) where
    gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CofreeT f w a -> c (CofreeT f w a)
gfoldl forall d b. Data d => c (d -> b) -> d -> c b
f forall g. g -> c g
z (CofreeT w (CofreeF f a (CofreeT f w a))
w) = (w (CofreeF f a (CofreeT f w a)) -> CofreeT f w a)
-> c (w (CofreeF f a (CofreeT f w a)) -> CofreeT f w a)
forall g. g -> c g
z 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 c (w (CofreeF f a (CofreeT f w a)) -> CofreeT f w a)
-> w (CofreeF f a (CofreeT f w a)) -> c (CofreeT f w a)
forall d b. Data d => c (d -> b) -> d -> c b
`f` w (CofreeF f a (CofreeT f w a))
w
    toConstr :: CofreeT f w a -> Constr
toConstr CofreeT f w a
_ = Constr
cofreeTConstr
    gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (CofreeT f w a)
gunfold forall b r. Data b => c (b -> r) -> c r
k forall r. r -> c r
z Constr
c = case Constr -> Int
constrIndex Constr
c of
        Int
1 -> c (w (CofreeF f a (CofreeT f w a)) -> CofreeT f w a)
-> c (CofreeT f w a)
forall b r. Data b => c (b -> r) -> c r
k ((w (CofreeF f a (CofreeT f w a)) -> CofreeT f w a)
-> c (w (CofreeF f a (CofreeT f w a)) -> CofreeT f w a)
forall r. r -> c r
z 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)
        Int
_ -> String -> c (CofreeT f w a)
forall a. HasCallStack => String -> a
error String
"gunfold"
    dataTypeOf :: CofreeT f w a -> DataType
dataTypeOf CofreeT f w a
_ = DataType
cofreeTDataType
    dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c (CofreeT f w a))
dataCast1 forall d. Data d => c (t d)
f = c (t a) -> Maybe (c (CofreeT f w a))
forall k1 k2 (c :: k1 -> *) (t :: k2 -> k1) (t' :: k2 -> k1)
       (a :: k2).
(Typeable t, Typeable t') =>
c (t a) -> Maybe (c (t' a))
gcast1 c (t a)
forall d. Data d => c (t d)
f

cofreeFConstr, cofreeTConstr :: Constr
cofreeFConstr :: Constr
cofreeFConstr = DataType -> String -> [String] -> Fixity -> Constr
mkConstr DataType
cofreeFDataType String
":<" [] Fixity
Infix
cofreeTConstr :: Constr
cofreeTConstr = DataType -> String -> [String] -> Fixity -> Constr
mkConstr DataType
cofreeTDataType String
"CofreeT" [] Fixity
Prefix
{-# NOINLINE cofreeFConstr #-}
{-# NOINLINE cofreeTConstr #-}

cofreeFDataType, cofreeTDataType :: DataType
cofreeFDataType :: DataType
cofreeFDataType = String -> [Constr] -> DataType
mkDataType String
"Control.Comonad.Trans.Cofree.CofreeF" [Constr
cofreeFConstr]
cofreeTDataType :: DataType
cofreeTDataType = String -> [Constr] -> DataType
mkDataType String
"Control.Comonad.Trans.Cofree.CofreeT" [Constr
cofreeTConstr]
{-# NOINLINE cofreeFDataType #-}
{-# NOINLINE cofreeTDataType #-}

-- lowerF :: (Functor f, Comonad w) => CofreeT f w a -> f a

-- lowerF = fmap extract . unwrap