{-# LANGUAGE CPP #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE PolyKinds #-}
 -----------------------------------------------------------------------------
-- |
-- Module      :  Control.Comonad
-- Copyright   :  (C) 2008-2015 Edward Kmett,
--                (C) 2004 Dave Menendez
-- License     :  BSD-style (see the file LICENSE)
--
-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
-- Stability   :  provisional
-- Portability :  portable
--
----------------------------------------------------------------------------
module Control.Comonad (
  -- * Comonads
    Comonad(..)
  , liftW     -- :: Comonad w => (a -> b) -> w a -> w b
  , wfix      -- :: Comonad w => w (w a -> a) -> a
  , cfix      -- :: Comonad w => (w a -> a) -> w a
  , kfix      -- :: ComonadApply w => w (w a -> a) -> w a
  , (=>=)
  , (=<=)
  , (<<=)
  , (=>>)
  -- * Combining Comonads
  , ComonadApply(..)
  , (<@@>)    -- :: ComonadApply w => w a -> w (a -> b) -> w b
  , liftW2    -- :: ComonadApply w => (a -> b -> c) -> w a -> w b -> w c
  , liftW3    -- :: ComonadApply w => (a -> b -> c -> d) -> w a -> w b -> w c -> w d
  -- * Cokleisli Arrows
  , Cokleisli(..)
  -- * Functors
  , Functor(..)
  , (<$>)     -- :: Functor f => (a -> b) -> f a -> f b
  , ($>)      -- :: Functor f => f a -> b -> f b
  ) where

-- import _everything_
import Data.Functor
import Control.Applicative
import Control.Arrow
import Control.Category
import Control.Monad (ap)
import Control.Monad.Trans.Identity
import Data.Functor.Identity
import qualified Data.Functor.Sum as FSum
import Data.List.NonEmpty hiding (map)
import Data.Semigroup hiding (Product)
import Data.Tagged
import Prelude hiding (id, (.))
import Control.Monad.Fix

#ifdef MIN_VERSION_containers
import Data.Tree
#endif

infixl 4 <@, @>, <@@>, <@>
infixl 1 =>>
infixr 1 <<=, =<=, =>=

{- |

There are two ways to define a comonad:

I. Provide definitions for 'extract' and 'extend'
satisfying these laws:

@
'extend' 'extract'      = 'id'
'extract' . 'extend' f  = f
'extend' f . 'extend' g = 'extend' (f . 'extend' g)
@

In this case, you may simply set 'fmap' = 'liftW'.

These laws are directly analogous to the laws for monads
and perhaps can be made clearer by viewing them as laws stating
that Cokleisli composition must be associative, and has extract for
a unit:

@
f '=>=' 'extract'   = f
'extract' '=>=' f   = f
(f '=>=' g) '=>=' h = f '=>=' (g '=>=' h)
@

II. Alternately, you may choose to provide definitions for 'fmap',
'extract', and 'duplicate' satisfying these laws:

@
'extract' . 'duplicate'      = 'id'
'fmap' 'extract' . 'duplicate' = 'id'
'duplicate' . 'duplicate'    = 'fmap' 'duplicate' . 'duplicate'
@

In this case you may not rely on the ability to define 'fmap' in
terms of 'liftW'.

You may of course, choose to define both 'duplicate' /and/ 'extend'.
In that case you must also satisfy these laws:

@
'extend' f  = 'fmap' f . 'duplicate'
'duplicate' = 'extend' id
'fmap' f    = 'extend' (f . 'extract')
@

These are the default definitions of 'extend' and 'duplicate' and
the definition of 'liftW' respectively.

-}

class Functor w => Comonad w where
  -- |
  -- @
  -- 'extract' . 'fmap' f = f . 'extract'
  -- @
  extract :: w a -> a

  -- |
  -- @
  -- 'duplicate' = 'extend' 'id'
  -- 'fmap' ('fmap' f) . 'duplicate' = 'duplicate' . 'fmap' f
  -- @
  duplicate :: w a -> w (w a)
  duplicate = forall (w :: * -> *) a b. Comonad w => (w a -> b) -> w a -> w b
extend forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id

  -- |
  -- @
  -- 'extend' f = 'fmap' f . 'duplicate'
  -- @
  extend :: (w a -> b) -> w a -> w b
  extend w a -> b
f = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap w 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 (w :: * -> *) a. Comonad w => w a -> w (w a)
duplicate

  {-# MINIMAL extract, (duplicate | extend) #-}


instance Comonad ((,)e) where
  duplicate :: forall a. (e, a) -> (e, (e, a))
duplicate (e, a)
p = (forall a b. (a, b) -> a
fst (e, a)
p, (e, a)
p)
  {-# INLINE duplicate #-}
  extract :: forall a. (e, a) -> a
extract = forall e a. (e, a) -> a
snd
  {-# INLINE extract #-}

instance Comonad (Arg e) where
  duplicate :: forall a. Arg e a -> Arg e (Arg e a)
duplicate w :: Arg e a
w@(Arg e
a a
_) = forall a b. a -> b -> Arg a b
Arg e
a Arg e a
w
  {-# INLINE duplicate #-}
  extend :: forall a b. (Arg e a -> b) -> Arg e a -> Arg e b
extend Arg e a -> b
f w :: Arg e a
w@(Arg e
a a
_) = forall a b. a -> b -> Arg a b
Arg e
a (Arg e a -> b
f Arg e a
w)
  {-# INLINE extend #-}
  extract :: forall a. Arg e a -> a
extract (Arg e
_ a
b) = a
b
  {-# INLINE extract #-}

instance Monoid m => Comonad ((->)m) where
  duplicate :: forall a. (m -> a) -> m -> (m -> a)
duplicate m -> a
f m
m = m -> a
f forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. Monoid a => a -> a -> a
mappend m
m
  {-# INLINE duplicate #-}
  extract :: forall a. (m -> a) -> a
extract m -> a
f = m -> a
f forall a. Monoid a => a
mempty
  {-# INLINE extract #-}

instance Comonad Identity where
  duplicate :: forall a. Identity a -> Identity (Identity a)
duplicate = forall a. a -> Identity a
Identity
  {-# INLINE duplicate #-}
  extract :: forall a. Identity a -> a
extract = forall a. Identity a -> a
runIdentity
  {-# INLINE extract #-}

-- $
-- The variable `s` can have any kind.
-- For example, here it has kind `Bool`:
-- >>> :set -XDataKinds
-- >>> import Data.Tagged
-- >>> extract (Tagged 42 :: Tagged 'True Integer)
-- 42
instance Comonad (Tagged s) where
  duplicate :: forall a. Tagged s a -> Tagged s (Tagged s a)
duplicate = forall {k} (s :: k) b. b -> Tagged s b
Tagged
  {-# INLINE duplicate #-}
  extract :: forall a. Tagged s a -> a
extract = forall k (s :: k) a. Tagged s a -> a
unTagged
  {-# INLINE extract #-}

instance Comonad w => Comonad (IdentityT w) where
  extend :: forall a b. (IdentityT w a -> b) -> IdentityT w a -> IdentityT w b
extend IdentityT w a -> b
f (IdentityT w a
m) = forall {k} (f :: k -> *) (a :: k). f a -> IdentityT f a
IdentityT (forall (w :: * -> *) a b. Comonad w => (w a -> b) -> w a -> w b
extend (IdentityT w 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 {k} (f :: k -> *) (a :: k). f a -> IdentityT f a
IdentityT) w a
m)
  extract :: forall a. IdentityT w a -> a
extract = 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 {k} (f :: k -> *) (a :: k). IdentityT f a -> f a
runIdentityT
  {-# INLINE extract #-}

#ifdef MIN_VERSION_containers
instance Comonad Tree where
  duplicate :: forall a. Tree a -> Tree (Tree a)
duplicate w :: Tree a
w@(Node a
_ [Tree a]
as) = forall a. a -> [Tree a] -> Tree a
Node Tree a
w (forall a b. (a -> b) -> [a] -> [b]
map forall (w :: * -> *) a. Comonad w => w a -> w (w a)
duplicate [Tree a]
as)
  extract :: forall a. Tree a -> a
extract (Node a
a [Tree a]
_) = a
a
  {-# INLINE extract #-}
#endif

instance Comonad NonEmpty where
  extend :: forall a b. (NonEmpty a -> b) -> NonEmpty a -> NonEmpty b
extend NonEmpty a -> b
f w :: NonEmpty a
w@(~(a
_ :| [a]
aas)) =
    NonEmpty a -> b
f NonEmpty a
w forall a. a -> [a] -> NonEmpty a
:| case [a]
aas of
      []     -> []
      (a
a:[a]
as) -> forall a. NonEmpty a -> [a]
toList (forall (w :: * -> *) a b. Comonad w => (w a -> b) -> w a -> w b
extend NonEmpty a -> b
f (a
a forall a. a -> [a] -> NonEmpty a
:| [a]
as))
  extract :: forall a. NonEmpty a -> a
extract ~(a
a :| [a]
_) = a
a
  {-# INLINE extract #-}

coproduct :: (f a -> b) -> (g a -> b) -> FSum.Sum f g a -> b
coproduct :: forall {k} (f :: k -> *) (a :: k) b (g :: k -> *).
(f a -> b) -> (g a -> b) -> Sum f g a -> b
coproduct f a -> b
f g a -> b
_ (FSum.InL f a
x) = f a -> b
f f a
x
coproduct f a -> b
_ g a -> b
g (FSum.InR g a
y) = g a -> b
g g a
y
{-# INLINE coproduct #-}

instance (Comonad f, Comonad g) => Comonad (FSum.Sum f g) where
  extend :: forall a b. (Sum f g a -> b) -> Sum f g a -> Sum f g b
extend Sum f g a -> b
f = forall {k} (f :: k -> *) (a :: k) b (g :: k -> *).
(f a -> b) -> (g a -> b) -> Sum f g a -> b
coproduct
               (forall {k} (f :: k -> *) (g :: k -> *) (a :: k). f a -> Sum f g a
FSum.InL 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 (Sum f g 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 {k} (f :: k -> *) (g :: k -> *) (a :: k). f a -> Sum f g a
FSum.InL))
               (forall {k} (f :: k -> *) (g :: k -> *) (a :: k). g a -> Sum f g a
FSum.InR 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 (Sum f g 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 {k} (f :: k -> *) (g :: k -> *) (a :: k). g a -> Sum f g a
FSum.InR))
  extract :: forall a. Sum f g a -> a
extract = forall {k} (f :: k -> *) (a :: k) b (g :: k -> *).
(f a -> b) -> (g a -> b) -> Sum f g a -> b
coproduct forall (w :: * -> *) a. Comonad w => w a -> a
extract forall (w :: * -> *) a. Comonad w => w a -> a
extract
  {-# INLINE extract #-}


-- | @ComonadApply@ is to @Comonad@ like @Applicative@ is to @Monad@.
--
-- Mathematically, it is a strong lax symmetric semi-monoidal comonad on the
-- category @Hask@ of Haskell types. That it to say that @w@ is a strong lax
-- symmetric semi-monoidal functor on Hask, where both 'extract' and 'duplicate' are
-- symmetric monoidal natural transformations.
--
-- Laws:
--
-- @
-- ('.') '<$>' u '<@>' v '<@>' w = u '<@>' (v '<@>' w)
-- 'extract' (p '<@>' q) = 'extract' p ('extract' q)
-- 'duplicate' (p '<@>' q) = ('<@>') '<$>' 'duplicate' p '<@>' 'duplicate' q
-- @
--
-- If our type is both a 'ComonadApply' and 'Applicative' we further require
--
-- @
-- ('<*>') = ('<@>')
-- @
--
-- Finally, if you choose to define ('<@') and ('@>'), the results of your
-- definitions should match the following laws:
--
-- @
-- a '@>' b = 'const' 'id' '<$>' a '<@>' b
-- a '<@' b = 'const' '<$>' a '<@>' b
-- @

class Comonad w => ComonadApply w where
  (<@>) :: w (a -> b) -> w a -> w b
  default (<@>) :: Applicative w => w (a -> b) -> w a -> w b
  (<@>) = forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>)

  (@>) :: w a -> w b -> w b
  w a
a @> w b
b = forall a b. a -> b -> a
const forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> w a
a forall (w :: * -> *) a b.
ComonadApply w =>
w (a -> b) -> w a -> w b
<@> w b
b

  (<@) :: w a -> w b -> w a
  w a
a <@ w b
b = forall a b. a -> b -> a
const forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> w a
a forall (w :: * -> *) a b.
ComonadApply w =>
w (a -> b) -> w a -> w b
<@> w b
b

instance Semigroup m => ComonadApply ((,)m) where
  (m
m, a -> b
f) <@> :: forall a b. (m, a -> b) -> (m, a) -> (m, b)
<@> (m
n, a
a) = (m
m forall a. Semigroup a => a -> a -> a
<> m
n, a -> b
f a
a)
  (m
m, a
a) <@ :: forall a b. (m, a) -> (m, b) -> (m, a)
<@  (m
n, b
_) = (m
m forall a. Semigroup a => a -> a -> a
<> m
n, a
a)
  (m
m, a
_)  @> :: forall a b. (m, a) -> (m, b) -> (m, b)
@> (m
n, b
b) = (m
m forall a. Semigroup a => a -> a -> a
<> m
n, b
b)

instance ComonadApply NonEmpty where
  <@> :: forall a b. NonEmpty (a -> b) -> NonEmpty a -> NonEmpty b
(<@>) = forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

instance Monoid m => ComonadApply ((->)m) where
  <@> :: forall a b. (m -> (a -> b)) -> (m -> a) -> m -> b
(<@>) = forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>)
  (<@ ) = (<* )
  ( @>) = ( *>)

instance ComonadApply Identity where
  <@> :: forall a b. Identity (a -> b) -> Identity a -> Identity b
(<@>) = forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>)
  (<@ ) = (<* )
  ( @>) = ( *>)

instance ComonadApply w => ComonadApply (IdentityT w) where
  IdentityT w (a -> b)
wa <@> :: forall a b. IdentityT w (a -> b) -> IdentityT w a -> IdentityT w b
<@> IdentityT w a
wb = forall {k} (f :: k -> *) (a :: k). f a -> IdentityT f a
IdentityT (w (a -> b)
wa forall (w :: * -> *) a b.
ComonadApply w =>
w (a -> b) -> w a -> w b
<@> w a
wb)

#ifdef MIN_VERSION_containers
instance ComonadApply Tree where
  <@> :: forall a b. Tree (a -> b) -> Tree a -> Tree b
(<@>) = forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>)
  (<@ ) = (<* )
  ( @>) = ( *>)
#endif

-- | A suitable default definition for 'fmap' for a 'Comonad'.
-- Promotes a function to a comonad.
--
-- You can only safely use 'liftW' to define 'fmap' if your 'Comonad'
-- defines 'extend', not just 'duplicate', since defining
-- 'extend' in terms of duplicate uses 'fmap'!
--
-- @
-- 'fmap' f = 'liftW' f = 'extend' (f . 'extract')
-- @
liftW :: Comonad w => (a -> b) -> w a -> w b
liftW :: forall (w :: * -> *) a b. Comonad w => (a -> b) -> w a -> w b
liftW a -> b
f = forall (w :: * -> *) a b. Comonad w => (w a -> b) -> w a -> w b
extend (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 (w :: * -> *) a. Comonad w => w a -> a
extract)
{-# INLINE liftW #-}

-- | Comonadic fixed point à la David Menendez
wfix :: Comonad w => w (w a -> a) -> a
wfix :: forall (w :: * -> *) a. Comonad w => w (w a -> a) -> a
wfix w (w a -> a)
w = forall (w :: * -> *) a. Comonad w => w a -> a
extract w (w a -> a)
w (forall (w :: * -> *) a b. Comonad w => (w a -> b) -> w a -> w b
extend forall (w :: * -> *) a. Comonad w => w (w a -> a) -> a
wfix w (w a -> a)
w)

-- | Comonadic fixed point à la Dominic Orchard
cfix :: Comonad w => (w a -> a) -> w a
cfix :: forall (w :: * -> *) a. Comonad w => (w a -> a) -> w a
cfix w a -> a
f = forall a. (a -> a) -> a
fix (forall (w :: * -> *) a b. Comonad w => (w a -> b) -> w a -> w b
extend w a -> a
f)
{-# INLINE cfix #-}

-- | Comonadic fixed point à la Kenneth Foner:
--
-- This is the @evaluate@ function from his <https://www.youtube.com/watch?v=F7F-BzOB670 "Getting a Quick Fix on Comonads"> talk.
kfix :: ComonadApply w => w (w a -> a) -> w a
kfix :: forall (w :: * -> *) a. ComonadApply w => w (w a -> a) -> w a
kfix w (w a -> a)
w = forall a. (a -> a) -> a
fix forall a b. (a -> b) -> a -> b
$ \w a
u -> w (w a -> a)
w forall (w :: * -> *) a b.
ComonadApply w =>
w (a -> b) -> w a -> w b
<@> forall (w :: * -> *) a. Comonad w => w a -> w (w a)
duplicate w a
u
{-# INLINE kfix #-}

-- | 'extend' with the arguments swapped. Dual to '>>=' for a 'Monad'.
(=>>) :: Comonad w => w a -> (w a -> b) -> w b
=>> :: forall (w :: * -> *) a b. Comonad w => w a -> (w a -> b) -> w b
(=>>) = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (w :: * -> *) a b. Comonad w => (w a -> b) -> w a -> w b
extend
{-# INLINE (=>>) #-}

-- | 'extend' in operator form
(<<=) :: Comonad w => (w a -> b) -> w a -> w b
<<= :: forall (w :: * -> *) a b. Comonad w => (w a -> b) -> w a -> w b
(<<=) = forall (w :: * -> *) a b. Comonad w => (w a -> b) -> w a -> w b
extend
{-# INLINE (<<=) #-}

-- | Right-to-left 'Cokleisli' composition
(=<=) :: Comonad w => (w b -> c) -> (w a -> b) -> w a -> c
w b -> c
f =<= :: forall (w :: * -> *) b c a.
Comonad w =>
(w b -> c) -> (w a -> b) -> w a -> c
=<= w a -> b
g = w b -> c
f 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 -> b
g
{-# INLINE (=<=) #-}

-- | Left-to-right 'Cokleisli' composition
(=>=) :: Comonad w => (w a -> b) -> (w b -> c) -> w a -> c
w a -> b
f =>= :: forall (w :: * -> *) a b c.
Comonad w =>
(w a -> b) -> (w b -> c) -> w a -> c
=>= w b -> c
g = w b -> c
g 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 -> b
f
{-# INLINE (=>=) #-}

-- | A variant of '<@>' with the arguments reversed.
(<@@>) :: ComonadApply w => w a -> w (a -> b) -> w b
<@@> :: forall (w :: * -> *) a b.
ComonadApply w =>
w a -> w (a -> b) -> w b
(<@@>) = forall (w :: * -> *) a b c.
ComonadApply w =>
(a -> b -> c) -> w a -> w b -> w c
liftW2 (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id)
{-# INLINE (<@@>) #-}

-- | Lift a binary function into a 'Comonad' with zipping
liftW2 :: ComonadApply w => (a -> b -> c) -> w a -> w b -> w c
liftW2 :: forall (w :: * -> *) a b c.
ComonadApply w =>
(a -> b -> c) -> w a -> w b -> w c
liftW2 a -> b -> c
f w a
a w b
b = a -> b -> c
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> w a
a forall (w :: * -> *) a b.
ComonadApply w =>
w (a -> b) -> w a -> w b
<@> w b
b
{-# INLINE liftW2 #-}

-- | Lift a ternary function into a 'Comonad' with zipping
liftW3 :: ComonadApply w => (a -> b -> c -> d) -> w a -> w b -> w c -> w d
liftW3 :: forall (w :: * -> *) a b c d.
ComonadApply w =>
(a -> b -> c -> d) -> w a -> w b -> w c -> w d
liftW3 a -> b -> c -> d
f w a
a w b
b w c
c = a -> b -> c -> d
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> w a
a forall (w :: * -> *) a b.
ComonadApply w =>
w (a -> b) -> w a -> w b
<@> w b
b forall (w :: * -> *) a b.
ComonadApply w =>
w (a -> b) -> w a -> w b
<@> w c
c
{-# INLINE liftW3 #-}

-- | The 'Cokleisli' 'Arrow's of a given 'Comonad'
newtype Cokleisli w a b = Cokleisli { forall {k} (w :: k -> *) (a :: k) b. Cokleisli w a b -> w a -> b
runCokleisli :: w a -> b }

instance Comonad w => Category (Cokleisli w) where
  id :: forall a. Cokleisli w a a
id = forall {k} (w :: k -> *) (a :: k) b. (w a -> b) -> Cokleisli w a b
Cokleisli forall (w :: * -> *) a. Comonad w => w a -> a
extract
  Cokleisli w b -> c
f . :: forall b c a. Cokleisli w b c -> Cokleisli w a b -> Cokleisli w a c
. Cokleisli w a -> b
g = forall {k} (w :: k -> *) (a :: k) b. (w a -> b) -> Cokleisli w a b
Cokleisli (w b -> c
f forall (w :: * -> *) b c a.
Comonad w =>
(w b -> c) -> (w a -> b) -> w a -> c
=<= w a -> b
g)

instance Comonad w => Arrow (Cokleisli w) where
  arr :: forall b c. (b -> c) -> Cokleisli w b c
arr b -> c
f = forall {k} (w :: k -> *) (a :: k) b. (w a -> b) -> Cokleisli w a b
Cokleisli (b -> c
f 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)
  first :: forall b c d. Cokleisli w b c -> Cokleisli w (b, d) (c, d)
first Cokleisli w b c
f = Cokleisli w b c
f forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
  second :: forall b c d. Cokleisli w b c -> Cokleisli w (d, b) (d, c)
second Cokleisli w b c
f = forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** Cokleisli w b c
f
  Cokleisli w b -> c
f *** :: forall b c b' c'.
Cokleisli w b c -> Cokleisli w b' c' -> Cokleisli w (b, b') (c, c')
*** Cokleisli w b' -> c'
g = forall {k} (w :: k -> *) (a :: k) b. (w a -> b) -> Cokleisli w a b
Cokleisli (w b -> c
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 :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& w b' -> c'
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 :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall e a. (e, a) -> a
snd)
  Cokleisli w b -> c
f &&& :: forall b c c'.
Cokleisli w b c -> Cokleisli w b c' -> Cokleisli w b (c, c')
&&& Cokleisli w b -> c'
g = forall {k} (w :: k -> *) (a :: k) b. (w a -> b) -> Cokleisli w a b
Cokleisli (w b -> c
f forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& w b -> c'
g)

instance Comonad w => ArrowApply (Cokleisli w) where
  app :: forall b c. Cokleisli w (Cokleisli w b c, b) c
app = forall {k} (w :: k -> *) (a :: k) b. (w a -> b) -> Cokleisli w a b
Cokleisli forall a b. (a -> b) -> a -> b
$ \w (Cokleisli w b c, b)
w -> forall {k} (w :: k -> *) (a :: k) b. Cokleisli w a b -> w a -> b
runCokleisli (forall a b. (a, b) -> a
fst (forall (w :: * -> *) a. Comonad w => w a -> a
extract w (Cokleisli w b c, b)
w)) (forall e a. (e, a) -> a
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> w (Cokleisli w b c, b)
w)

instance Comonad w => ArrowChoice (Cokleisli w) where
  left :: forall b c d.
Cokleisli w b c -> Cokleisli w (Either b d) (Either c d)
left = forall (a :: * -> * -> *) b c d.
ArrowApply a =>
a b c -> a (Either b d) (Either c d)
leftApp

instance ComonadApply w => ArrowLoop (Cokleisli w) where
  loop :: forall b d c. Cokleisli w (b, d) (c, d) -> Cokleisli w b c
loop (Cokleisli w (b, d) -> (c, d)
f) = forall {k} (w :: k -> *) (a :: k) b. (w a -> b) -> Cokleisli w a b
Cokleisli (forall a b. (a, b) -> a
fst 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 (w a -> a) -> a
wfix 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 forall {a}. w b -> w (a, d) -> (c, d)
f') where
    f' :: w b -> w (a, d) -> (c, d)
f' w b
wa w (a, d)
wb = w (b, d) -> (c, d)
f ((,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> w b
wa forall (w :: * -> *) a b.
ComonadApply w =>
w (a -> b) -> w a -> w b
<@> (forall e a. (e, a) -> a
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> w (a, d)
wb))

instance Functor (Cokleisli w a) where
  fmap :: forall a b. (a -> b) -> Cokleisli w a a -> Cokleisli w a b
fmap a -> b
f (Cokleisli w a -> a
g) = forall {k} (w :: k -> *) (a :: k) b. (w a -> b) -> Cokleisli w a b
Cokleisli (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
. w a -> a
g)

instance Applicative (Cokleisli w a) where
  pure :: forall a. a -> Cokleisli w a a
pure = forall {k} (w :: k -> *) (a :: k) b. (w a -> b) -> Cokleisli w a b
Cokleisli forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. a -> b -> a
const
  Cokleisli w a -> a -> b
f <*> :: forall a b.
Cokleisli w a (a -> b) -> Cokleisli w a a -> Cokleisli w a b
<*> Cokleisli w a -> a
a = forall {k} (w :: k -> *) (a :: k) b. (w a -> b) -> Cokleisli w a b
Cokleisli (\w a
w -> w a -> a -> b
f w a
w (w a -> a
a w a
w))

instance Monad (Cokleisli w a) where
  return :: forall a. a -> Cokleisli w a a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure
  Cokleisli w a -> a
k >>= :: forall a b.
Cokleisli w a a -> (a -> Cokleisli w a b) -> Cokleisli w a b
>>= a -> Cokleisli w a b
f = forall {k} (w :: k -> *) (a :: k) b. (w a -> b) -> Cokleisli w a b
Cokleisli forall a b. (a -> b) -> a -> b
$ \w a
w -> forall {k} (w :: k -> *) (a :: k) b. Cokleisli w a b -> w a -> b
runCokleisli (a -> Cokleisli w a b
f (w a -> a
k w a
w)) w a
w