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

-----------------------------------------------------------------------------
-- |
-- Module      :  Control.Comonad.Trans.Coiter
-- 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 coiterative comonad generated by a comonad
----------------------------------------------------------------------------
module Control.Comonad.Trans.Coiter
  (
  -- |
  -- Coiterative comonads represent non-terminating, productive computations.
  --
  -- They are the dual notion of iterative monads. While iterative computations
  -- produce no values or eventually terminate with one, coiterative
  -- computations constantly produce values and they never terminate.
  --
  -- It's simpler form, 'Coiter', is an infinite stream of data. 'CoiterT'
  -- extends this so that each step of the computation can be performed in
  -- a comonadic context.

  -- * The coiterative comonad transformer
    CoiterT(..)
  -- * The coiterative comonad
  , Coiter, coiter, runCoiter
  -- * Generating coiterative comonads
  , unfold
  -- * Cofree comonads
  , ComonadCofree(..)
  -- * Examples
  -- $example
  ) where

import Control.Arrow hiding (second)
import Control.Comonad
import Control.Comonad.Cofree.Class
import Control.Comonad.Env.Class
import Control.Comonad.Hoist.Class
import Control.Comonad.Store.Class
import Control.Comonad.Traced.Class
import Control.Comonad.Trans.Class
import Control.Category
import Data.Bifunctor
import Data.Bifoldable
import Data.Bitraversable
import Data.Data
import Data.Foldable
import Data.Functor.Classes
import Data.Functor.Identity
import Data.Traversable
import Prelude hiding (id,(.))

-- | This is the coiterative comonad generated by a comonad
newtype CoiterT w a = CoiterT { forall (w :: * -> *) a. CoiterT w a -> w (a, CoiterT w a)
runCoiterT :: w (a, CoiterT w a) }

instance (Eq1 w) => Eq1 (CoiterT w) where
  liftEq :: forall a b. (a -> b -> Bool) -> CoiterT w a -> CoiterT w b -> Bool
liftEq a -> b -> Bool
eq = CoiterT w a -> CoiterT w b -> Bool
forall {f :: * -> *}. Eq1 f => CoiterT f a -> CoiterT f b -> Bool
go
    where
      go :: CoiterT f a -> CoiterT f b -> Bool
go (CoiterT f (a, CoiterT f a)
x) (CoiterT f (b, CoiterT f b)
y) = ((a, CoiterT f a) -> (b, CoiterT f b) -> Bool)
-> f (a, CoiterT f a) -> f (b, CoiterT f b) -> 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 ((a -> b -> Bool)
-> (CoiterT f a -> CoiterT f b -> Bool)
-> (a, CoiterT f a)
-> (b, CoiterT f b)
-> Bool
forall a b c d.
(a -> b -> Bool) -> (c -> d -> Bool) -> (a, c) -> (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 -> b -> Bool
eq CoiterT f a -> CoiterT f b -> Bool
go) f (a, CoiterT f a)
x f (b, CoiterT f b)
y

instance (Ord1 w) => Ord1 (CoiterT w) where
  liftCompare :: forall a b.
(a -> b -> Ordering) -> CoiterT w a -> CoiterT w b -> Ordering
liftCompare a -> b -> Ordering
cmp = CoiterT w a -> CoiterT w b -> Ordering
forall {f :: * -> *}.
Ord1 f =>
CoiterT f a -> CoiterT f b -> Ordering
go
    where
      go :: CoiterT f a -> CoiterT f b -> Ordering
go (CoiterT f (a, CoiterT f a)
x) (CoiterT f (b, CoiterT f b)
y) = ((a, CoiterT f a) -> (b, CoiterT f b) -> Ordering)
-> f (a, CoiterT f a) -> f (b, CoiterT f b) -> 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 ((a -> b -> Ordering)
-> (CoiterT f a -> CoiterT f b -> Ordering)
-> (a, CoiterT f a)
-> (b, CoiterT f b)
-> Ordering
forall a b c d.
(a -> b -> Ordering)
-> (c -> d -> Ordering) -> (a, c) -> (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 -> b -> Ordering
cmp CoiterT f a -> CoiterT f b -> Ordering
go) f (a, CoiterT f a)
x f (b, CoiterT f b)
y

instance (Show1 w) => Show1 (CoiterT w) where
  liftShowsPrec :: forall a.
(Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> CoiterT w a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl = Int -> CoiterT w a -> ShowS
go
    where
      goList :: [CoiterT w a] -> ShowS
goList = (Int -> a -> ShowS) -> ([a] -> ShowS) -> [CoiterT w a] -> ShowS
forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> [CoiterT w a] -> ShowS
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> [f a] -> ShowS
liftShowList Int -> a -> ShowS
sp [a] -> ShowS
sl
      go :: Int -> CoiterT w a -> ShowS
go Int
d (CoiterT w (a, CoiterT w a)
x) = (Int -> w (a, CoiterT w a) -> ShowS)
-> String -> Int -> w (a, CoiterT w a) -> ShowS
forall a. (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
showsUnaryWith
        ((Int -> (a, CoiterT w a) -> ShowS)
-> ([(a, CoiterT w a)] -> ShowS)
-> Int
-> w (a, CoiterT w a)
-> ShowS
forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> w a -> ShowS
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec ((Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> CoiterT w a -> ShowS)
-> ([CoiterT w a] -> ShowS)
-> Int
-> (a, CoiterT w a)
-> ShowS
forall a b.
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> (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
sp [a] -> ShowS
sl Int -> CoiterT w a -> ShowS
go [CoiterT w a] -> ShowS
goList) ((Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> CoiterT w a -> ShowS)
-> ([CoiterT w a] -> ShowS)
-> [(a, CoiterT w a)]
-> ShowS
forall a b.
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> [(a, b)]
-> ShowS
forall (f :: * -> * -> *) a b.
Show2 f =>
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> [f a b]
-> ShowS
liftShowList2 Int -> a -> ShowS
sp [a] -> ShowS
sl Int -> CoiterT w a -> ShowS
go [CoiterT w a] -> ShowS
goList))
        String
"CoiterT" Int
d w (a, CoiterT w a)
x

instance (Read1 w) => Read1 (CoiterT w) where
  liftReadsPrec :: forall a.
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (CoiterT w a)
liftReadsPrec Int -> ReadS a
rp ReadS [a]
rl = Int -> ReadS (CoiterT w a)
go
    where
      goList :: ReadS [CoiterT w a]
goList = (Int -> ReadS a) -> ReadS [a] -> ReadS [CoiterT w a]
forall a. (Int -> ReadS a) -> ReadS [a] -> ReadS [CoiterT w a]
forall (f :: * -> *) a.
Read1 f =>
(Int -> ReadS a) -> ReadS [a] -> ReadS [f a]
liftReadList Int -> ReadS a
rp ReadS [a]
rl
      go :: Int -> ReadS (CoiterT w a)
go = (String -> ReadS (CoiterT w a)) -> Int -> ReadS (CoiterT w a)
forall a. (String -> ReadS a) -> Int -> ReadS a
readsData ((String -> ReadS (CoiterT w a)) -> Int -> ReadS (CoiterT w a))
-> (String -> ReadS (CoiterT w a)) -> Int -> ReadS (CoiterT w a)
forall a b. (a -> b) -> a -> b
$ (Int -> ReadS (w (a, CoiterT w a)))
-> String
-> (w (a, CoiterT w a) -> CoiterT w a)
-> String
-> ReadS (CoiterT w a)
forall a t.
(Int -> ReadS a) -> String -> (a -> t) -> String -> ReadS t
readsUnaryWith
        ((Int -> ReadS (a, CoiterT w a))
-> ReadS [(a, CoiterT w a)] -> Int -> ReadS (w (a, CoiterT w a))
forall a. (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (w a)
forall (f :: * -> *) a.
Read1 f =>
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (f a)
liftReadsPrec ((Int -> ReadS a)
-> ReadS [a]
-> (Int -> ReadS (CoiterT w a))
-> ReadS [CoiterT w a]
-> Int
-> ReadS (a, CoiterT w a)
forall a b.
(Int -> ReadS a)
-> ReadS [a]
-> (Int -> ReadS b)
-> ReadS [b]
-> Int
-> ReadS (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
rp ReadS [a]
rl Int -> ReadS (CoiterT w a)
go ReadS [CoiterT w a]
goList) ((Int -> ReadS a)
-> ReadS [a]
-> (Int -> ReadS (CoiterT w a))
-> ReadS [CoiterT w a]
-> ReadS [(a, CoiterT w a)]
forall a b.
(Int -> ReadS a)
-> ReadS [a] -> (Int -> ReadS b) -> ReadS [b] -> ReadS [(a, b)]
forall (f :: * -> * -> *) a b.
Read2 f =>
(Int -> ReadS a)
-> ReadS [a] -> (Int -> ReadS b) -> ReadS [b] -> ReadS [f a b]
liftReadList2 Int -> ReadS a
rp ReadS [a]
rl Int -> ReadS (CoiterT w a)
go ReadS [CoiterT w a]
goList))
        String
"CoiterT" w (a, CoiterT w a) -> CoiterT w a
forall (w :: * -> *) a. w (a, CoiterT w a) -> CoiterT w a
CoiterT

-- | The coiterative comonad
type Coiter = CoiterT Identity

-- | Prepends a result to a coiterative computation.
--
-- prop> runCoiter . uncurry coiter == id
coiter :: a -> Coiter a -> Coiter a
coiter :: forall a. a -> Coiter a -> Coiter a
coiter a
a Coiter a
as = Identity (a, Coiter a) -> Coiter a
forall (w :: * -> *) a. w (a, CoiterT w a) -> CoiterT w a
CoiterT (Identity (a, Coiter a) -> Coiter a)
-> Identity (a, Coiter a) -> Coiter a
forall a b. (a -> b) -> a -> b
$ (a, Coiter a) -> Identity (a, Coiter a)
forall a. a -> Identity a
Identity (a
a,Coiter a
as)
{-# INLINE coiter #-}

-- | Extracts the first result from a coiterative computation.
--
-- prop> uncurry coiter . runCoiter == id
runCoiter :: Coiter a -> (a, Coiter a)
runCoiter :: forall a. Coiter a -> (a, Coiter a)
runCoiter = Identity (a, Coiter a) -> (a, Coiter a)
forall a. Identity a -> a
runIdentity (Identity (a, Coiter a) -> (a, Coiter a))
-> (Coiter a -> Identity (a, Coiter a))
-> Coiter a
-> (a, Coiter 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
. Coiter a -> Identity (a, Coiter a)
forall (w :: * -> *) a. CoiterT w a -> w (a, CoiterT w a)
runCoiterT
{-# INLINE runCoiter #-}

instance Functor w => Functor (CoiterT w) where
  fmap :: forall a b. (a -> b) -> CoiterT w a -> CoiterT w b
fmap a -> b
f = w (b, CoiterT w b) -> CoiterT w b
forall (w :: * -> *) a. w (a, CoiterT w a) -> CoiterT w a
CoiterT (w (b, CoiterT w b) -> CoiterT w b)
-> (CoiterT w a -> w (b, CoiterT w b))
-> CoiterT w a
-> CoiterT 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
. ((a, CoiterT w a) -> (b, CoiterT w b))
-> w (a, CoiterT w a) -> w (b, CoiterT 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)
-> (CoiterT w a -> CoiterT w b)
-> (a, CoiterT w a)
-> (b, CoiterT w b)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (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) -> CoiterT w a -> CoiterT w b
forall a b. (a -> b) -> CoiterT w a -> CoiterT w b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f)) (w (a, CoiterT w a) -> w (b, CoiterT w b))
-> (CoiterT w a -> w (a, CoiterT w a))
-> CoiterT w a
-> w (b, CoiterT 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
. CoiterT w a -> w (a, CoiterT w a)
forall (w :: * -> *) a. CoiterT w a -> w (a, CoiterT w a)
runCoiterT

instance Comonad w => Comonad (CoiterT w) where
  extract :: forall a. CoiterT w a -> a
extract = (a, CoiterT w a) -> a
forall a b. (a, b) -> a
fst ((a, CoiterT w a) -> a)
-> (CoiterT w a -> (a, CoiterT w a)) -> CoiterT 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 (a, CoiterT w a) -> (a, CoiterT w a)
forall a. w a -> a
forall (w :: * -> *) a. Comonad w => w a -> a
extract (w (a, CoiterT w a) -> (a, CoiterT w a))
-> (CoiterT w a -> w (a, CoiterT w a))
-> CoiterT w a
-> (a, CoiterT 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
. CoiterT w a -> w (a, CoiterT w a)
forall (w :: * -> *) a. CoiterT w a -> w (a, CoiterT w a)
runCoiterT
  {-# INLINE extract #-}
  extend :: forall a b. (CoiterT w a -> b) -> CoiterT w a -> CoiterT w b
extend CoiterT w a -> b
f = w (b, CoiterT w b) -> CoiterT w b
forall (w :: * -> *) a. w (a, CoiterT w a) -> CoiterT w a
CoiterT (w (b, CoiterT w b) -> CoiterT w b)
-> (CoiterT w a -> w (b, CoiterT w b))
-> CoiterT w a
-> CoiterT 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 (a, CoiterT w a) -> (b, CoiterT w b))
-> w (a, CoiterT w a) -> w (b, CoiterT 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 (a, CoiterT w a)
w -> (CoiterT w a -> b
f (w (a, CoiterT w a) -> CoiterT w a
forall (w :: * -> *) a. w (a, CoiterT w a) -> CoiterT w a
CoiterT w (a, CoiterT w a)
w), (CoiterT w a -> b) -> CoiterT w a -> CoiterT w b
forall a b. (CoiterT w a -> b) -> CoiterT w a -> CoiterT w b
forall (w :: * -> *) a b. Comonad w => (w a -> b) -> w a -> w b
extend CoiterT w a -> b
f (CoiterT w a -> CoiterT w b) -> CoiterT w a -> CoiterT w b
forall a b. (a -> b) -> a -> b
$ (a, CoiterT w a) -> CoiterT w a
forall a b. (a, b) -> b
snd ((a, CoiterT w a) -> CoiterT w a)
-> (a, CoiterT w a) -> CoiterT w a
forall a b. (a -> b) -> a -> b
$ w (a, CoiterT w a) -> (a, CoiterT w a)
forall a. w a -> a
forall (w :: * -> *) a. Comonad w => w a -> a
extract w (a, CoiterT w a)
w)) (w (a, CoiterT w a) -> w (b, CoiterT w b))
-> (CoiterT w a -> w (a, CoiterT w a))
-> CoiterT w a
-> w (b, CoiterT 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
. CoiterT w a -> w (a, CoiterT w a)
forall (w :: * -> *) a. CoiterT w a -> w (a, CoiterT w a)
runCoiterT

instance Foldable w => Foldable (CoiterT w) where
  foldMap :: forall m a. Monoid m => (a -> m) -> CoiterT w a -> m
foldMap a -> m
f = ((a, CoiterT w a) -> m) -> w (a, CoiterT 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) -> (CoiterT w a -> m) -> (a, CoiterT w a) -> m
forall m a b. Monoid m => (a -> m) -> (b -> m) -> (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) -> CoiterT w a -> m
forall m a. Monoid m => (a -> m) -> CoiterT w a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f)) (w (a, CoiterT w a) -> m)
-> (CoiterT w a -> w (a, CoiterT w a)) -> CoiterT 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
. CoiterT w a -> w (a, CoiterT w a)
forall (w :: * -> *) a. CoiterT w a -> w (a, CoiterT w a)
runCoiterT

instance Traversable w => Traversable (CoiterT w) where
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> CoiterT w a -> f (CoiterT w b)
traverse a -> f b
f = (w (b, CoiterT w b) -> CoiterT w b)
-> f (w (b, CoiterT w b)) -> f (CoiterT 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 (b, CoiterT w b) -> CoiterT w b
forall (w :: * -> *) a. w (a, CoiterT w a) -> CoiterT w a
CoiterT (f (w (b, CoiterT w b)) -> f (CoiterT w b))
-> (CoiterT w a -> f (w (b, CoiterT w b)))
-> CoiterT w a
-> f (CoiterT 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
. ((a, CoiterT w a) -> f (b, CoiterT w b))
-> w (a, CoiterT w a) -> f (w (b, CoiterT 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)
-> (CoiterT w a -> f (CoiterT w b))
-> (a, CoiterT w a)
-> f (b, CoiterT w b)
forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> (a, b) -> 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) -> CoiterT w a -> f (CoiterT 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) -> CoiterT w a -> f (CoiterT w b)
traverse a -> f b
f)) (w (a, CoiterT w a) -> f (w (b, CoiterT w b)))
-> (CoiterT w a -> w (a, CoiterT w a))
-> CoiterT w a
-> f (w (b, CoiterT 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
. CoiterT w a -> w (a, CoiterT w a)
forall (w :: * -> *) a. CoiterT w a -> w (a, CoiterT w a)
runCoiterT

instance ComonadTrans CoiterT where
  lower :: forall (w :: * -> *) a. Comonad w => CoiterT w a -> w a
lower = ((a, CoiterT w a) -> a) -> w (a, CoiterT 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 (a, CoiterT w a) -> a
forall a b. (a, b) -> a
fst (w (a, CoiterT w a) -> w a)
-> (CoiterT w a -> w (a, CoiterT w a)) -> CoiterT 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
. CoiterT w a -> w (a, CoiterT w a)
forall (w :: * -> *) a. CoiterT w a -> w (a, CoiterT w a)
runCoiterT

instance Comonad w => ComonadCofree Identity (CoiterT w) where
  unwrap :: forall a. CoiterT w a -> Identity (CoiterT w a)
unwrap = CoiterT w a -> Identity (CoiterT w a)
forall a. a -> Identity a
Identity (CoiterT w a -> Identity (CoiterT w a))
-> (CoiterT w a -> CoiterT w a)
-> CoiterT w a
-> Identity (CoiterT 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, CoiterT w a) -> CoiterT w a
forall a b. (a, b) -> b
snd ((a, CoiterT w a) -> CoiterT w a)
-> (CoiterT w a -> (a, CoiterT w a)) -> CoiterT w a -> CoiterT 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, CoiterT w a) -> (a, CoiterT w a)
forall a. w a -> a
forall (w :: * -> *) a. Comonad w => w a -> a
extract (w (a, CoiterT w a) -> (a, CoiterT w a))
-> (CoiterT w a -> w (a, CoiterT w a))
-> CoiterT w a
-> (a, CoiterT 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
. CoiterT w a -> w (a, CoiterT w a)
forall (w :: * -> *) a. CoiterT w a -> w (a, CoiterT w a)
runCoiterT
  {-# INLINE unwrap #-}

instance ComonadEnv e w => ComonadEnv e (CoiterT w) where
  ask :: forall a. CoiterT 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) -> (CoiterT w a -> w a) -> CoiterT 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
. CoiterT w a -> w a
forall (w :: * -> *) a. Comonad w => CoiterT w a -> w a
forall (t :: (* -> *) -> * -> *) (w :: * -> *) a.
(ComonadTrans t, Comonad w) =>
t w a -> w a
lower
  {-# INLINE ask #-}

instance ComonadHoist CoiterT where
  cohoist :: forall (w :: * -> *) (v :: * -> *) a.
(Comonad w, Comonad v) =>
(forall x. w x -> v x) -> CoiterT w a -> CoiterT v a
cohoist forall x. w x -> v x
g = v (a, CoiterT v a) -> CoiterT v a
forall (w :: * -> *) a. w (a, CoiterT w a) -> CoiterT w a
CoiterT (v (a, CoiterT v a) -> CoiterT v a)
-> (CoiterT w a -> v (a, CoiterT v a))
-> CoiterT w a
-> CoiterT 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
. ((a, CoiterT w a) -> (a, CoiterT v a))
-> v (a, CoiterT w a) -> v (a, CoiterT v a)
forall a b. (a -> b) -> v a -> v b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((CoiterT w a -> CoiterT v a)
-> (a, CoiterT w a) -> (a, CoiterT v a)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ((forall x. w x -> v x) -> CoiterT w a -> CoiterT v a
forall (w :: * -> *) (v :: * -> *) a.
(Comonad w, Comonad v) =>
(forall x. w x -> v x) -> CoiterT w a -> CoiterT 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 (a, CoiterT w a) -> v (a, CoiterT v a))
-> (CoiterT w a -> v (a, CoiterT w a))
-> CoiterT w a
-> v (a, CoiterT 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 (a, CoiterT w a) -> v (a, CoiterT w a)
forall x. w x -> v x
g (w (a, CoiterT w a) -> v (a, CoiterT w a))
-> (CoiterT w a -> w (a, CoiterT w a))
-> CoiterT w a
-> v (a, CoiterT 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
. CoiterT w a -> w (a, CoiterT w a)
forall (w :: * -> *) a. CoiterT w a -> w (a, CoiterT w a)
runCoiterT

instance ComonadTraced m w => ComonadTraced m (CoiterT w) where
  trace :: forall a. m -> CoiterT w a -> a
trace m
m = m -> w a -> a
forall a. m -> w a -> a
forall m (w :: * -> *) a. ComonadTraced m w => m -> w a -> a
trace m
m (w a -> a) -> (CoiterT w a -> w a) -> CoiterT 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
. CoiterT w a -> w a
forall (w :: * -> *) a. Comonad w => CoiterT w a -> w a
forall (t :: (* -> *) -> * -> *) (w :: * -> *) a.
(ComonadTrans t, Comonad w) =>
t w a -> w a
lower
  {-# INLINE trace #-}

instance ComonadStore s w => ComonadStore s (CoiterT w) where
  pos :: forall a. CoiterT w a -> s
pos = w a -> s
forall a. w a -> s
forall s (w :: * -> *) a. ComonadStore s w => w a -> s
pos (w a -> s) -> (CoiterT w a -> w a) -> CoiterT w a -> s
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
. CoiterT w a -> w a
forall (w :: * -> *) a. Comonad w => CoiterT w a -> w a
forall (t :: (* -> *) -> * -> *) (w :: * -> *) a.
(ComonadTrans t, Comonad w) =>
t w a -> w a
lower
  peek :: forall a. s -> CoiterT w a -> a
peek s
s = s -> w a -> a
forall a. s -> w a -> a
forall s (w :: * -> *) a. ComonadStore s w => s -> w a -> a
peek s
s (w a -> a) -> (CoiterT w a -> w a) -> CoiterT 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
. CoiterT w a -> w a
forall (w :: * -> *) a. Comonad w => CoiterT w a -> w a
forall (t :: (* -> *) -> * -> *) (w :: * -> *) a.
(ComonadTrans t, Comonad w) =>
t w a -> w a
lower
  peeks :: forall a. (s -> s) -> CoiterT w a -> a
peeks s -> s
f = (s -> s) -> w a -> a
forall a. (s -> s) -> w a -> a
forall s (w :: * -> *) a. ComonadStore s w => (s -> s) -> w a -> a
peeks s -> s
f (w a -> a) -> (CoiterT w a -> w a) -> CoiterT 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
. CoiterT w a -> w a
forall (w :: * -> *) a. Comonad w => CoiterT w a -> w a
forall (t :: (* -> *) -> * -> *) (w :: * -> *) a.
(ComonadTrans t, Comonad w) =>
t w a -> w a
lower
  seek :: forall a. s -> CoiterT w a -> CoiterT w a
seek = s -> CoiterT w a -> CoiterT w a
forall a. s -> CoiterT w a -> CoiterT w a
forall s (w :: * -> *) a. ComonadStore s w => s -> w a -> w a
seek
  seeks :: forall a. (s -> s) -> CoiterT w a -> CoiterT w a
seeks = (s -> s) -> CoiterT w a -> CoiterT w a
forall a. (s -> s) -> CoiterT w a -> CoiterT w a
forall s (w :: * -> *) a.
ComonadStore s w =>
(s -> s) -> w a -> w a
seeks
  experiment :: forall (f :: * -> *) a.
Functor f =>
(s -> f s) -> CoiterT w a -> f a
experiment s -> f s
f = (s -> f s) -> w a -> f a
forall s (w :: * -> *) (f :: * -> *) a.
(ComonadStore s w, Functor f) =>
(s -> f s) -> w a -> f a
forall (f :: * -> *) a. Functor f => (s -> f s) -> w a -> f a
experiment s -> f s
f (w a -> f a) -> (CoiterT w a -> w a) -> CoiterT w a -> 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
. CoiterT w a -> w a
forall (w :: * -> *) a. Comonad w => CoiterT w a -> w a
forall (t :: (* -> *) -> * -> *) (w :: * -> *) a.
(ComonadTrans t, Comonad w) =>
t w a -> w a
lower
  {-# INLINE pos #-}
  {-# INLINE peek #-}
  {-# INLINE peeks #-}
  {-# INLINE seek #-}
  {-# INLINE seeks #-}
  {-# INLINE experiment #-}

instance (Show1 w, Show a) => Show (CoiterT w a) where
  showsPrec :: Int -> CoiterT w a -> ShowS
showsPrec = Int -> CoiterT w a -> ShowS
forall (f :: * -> *) a. (Show1 f, Show a) => Int -> f a -> ShowS
showsPrec1

instance (Read1 w, Read a) => Read (CoiterT w a) where
  readsPrec :: Int -> ReadS (CoiterT w a)
readsPrec = Int -> ReadS (CoiterT w a)
forall (f :: * -> *) a. (Read1 f, Read a) => Int -> ReadS (f a)
readsPrec1

instance (Eq1 w, Eq a) => Eq (CoiterT w a) where
  == :: CoiterT w a -> CoiterT w a -> Bool
(==) = CoiterT w a -> CoiterT w a -> Bool
forall (f :: * -> *) a. (Eq1 f, Eq a) => f a -> f a -> Bool
eq1
  {-# INLINE (==) #-}

instance (Ord1 w, Ord a) => Ord (CoiterT w a) where
  compare :: CoiterT w a -> CoiterT w a -> Ordering
compare = CoiterT w a -> CoiterT w a -> Ordering
forall (f :: * -> *) a. (Ord1 f, Ord a) => f a -> f a -> Ordering
compare1
  {-# INLINE compare #-}

-- | Unfold a @CoiterT@ comonad transformer from a cokleisli arrow and an initial comonadic seed.
unfold :: Comonad w => (w a -> a) -> w a -> CoiterT w a
unfold :: forall (w :: * -> *) a.
Comonad w =>
(w a -> a) -> w a -> CoiterT w a
unfold w a -> a
psi = w (a, CoiterT w a) -> CoiterT w a
forall (w :: * -> *) a. w (a, CoiterT w a) -> CoiterT w a
CoiterT (w (a, CoiterT w a) -> CoiterT w a)
-> (w a -> w (a, CoiterT w a)) -> w a -> CoiterT 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 -> (a, CoiterT w a)) -> w a -> w (a, CoiterT 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 -> a
forall a. w a -> a
forall (w :: * -> *) a. Comonad w => w a -> a
extract (w a -> a) -> (w a -> CoiterT w a) -> w a -> (a, CoiterT w a)
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (w a -> a) -> w a -> CoiterT w a
forall (w :: * -> *) a.
Comonad w =>
(w a -> a) -> w a -> CoiterT w a
unfold w a -> a
psi (w a -> CoiterT w a) -> (w a -> w a) -> w a -> CoiterT 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 -> a) -> w a -> 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 -> a
psi)

deriving instance
  ( Typeable w
  , Data (w (a, CoiterT w a))
  , Data a
  ) => Data (CoiterT w a)

{- $example

<examples/NewtonCoiter.lhs Newton's method>

-}