{-# LANGUAGE CPP #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE Safe #-}
module Data.Profunctor.Traversing
  ( Traversing(..)
  , CofreeTraversing(..)
  , FreeTraversing(..)
  -- * Profunctor in terms of Traversing
  , dimapWandering
  , lmapWandering
  , rmapWandering
  -- * Strong in terms of Traversing
  , firstTraversing
  , secondTraversing
  -- * Choice in terms of Traversing
  , leftTraversing
  , rightTraversing
  ) where

import Control.Applicative
import Control.Arrow (Kleisli(..))
import Data.Bifunctor.Tannen
import Data.Functor.Compose
import Data.Functor.Identity
import Data.Orphans ()
import Data.Profunctor.Choice
import Data.Profunctor.Monad
import Data.Profunctor.Strong
import Data.Profunctor.Types
import Data.Profunctor.Unsafe
import Data.Traversable
import Data.Tuple (swap)

#if __GLASGOW_HASKELL__ < 710
import Data.Monoid (Monoid)
import Data.Foldable
import Prelude hiding (mapM)
#endif

firstTraversing :: Traversing p => p a b -> p (a, c) (b, c)
firstTraversing :: forall (p :: * -> * -> *) a b c.
Traversing p =>
p a b -> p (a, c) (b, c)
firstTraversing = forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap forall a b. (a, b) -> (b, a)
swap forall a b. (a, b) -> (b, a)
swap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) a b.
(Traversing p, Traversable f) =>
p a b -> p (f a) (f b)
traverse'

secondTraversing :: Traversing p => p a b -> p (c, a) (c, b)
secondTraversing :: forall (p :: * -> * -> *) a b c.
Traversing p =>
p a b -> p (c, a) (c, b)
secondTraversing = forall (p :: * -> * -> *) (f :: * -> *) a b.
(Traversing p, Traversable f) =>
p a b -> p (f a) (f b)
traverse'

swapE :: Either a b -> Either b a
swapE :: forall a b. Either a b -> Either b a
swapE = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a b. b -> Either a b
Right forall a b. a -> Either a b
Left

-- | A definition of 'dimap' for 'Traversing' instances that define
-- an explicit 'wander'.
dimapWandering :: Traversing p => (a' -> a) -> (b -> b') -> p a b -> p a' b'
dimapWandering :: forall (p :: * -> * -> *) a' a b b'.
Traversing p =>
(a' -> a) -> (b -> b') -> p a b -> p a' b'
dimapWandering a' -> a
f b -> b'
g = forall (p :: * -> * -> *) a b s t.
Traversing p =>
(forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t)
-> p a b -> p s t
wander (\a -> f b
afb a'
a' -> b -> b'
g forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
afb (a' -> a
f a'
a'))

-- | 'lmapWandering' may be a more efficient implementation
-- of 'lmap' than the default produced from 'dimapWandering'.
lmapWandering :: Traversing p => (a -> b) -> p b c -> p a c
lmapWandering :: forall (p :: * -> * -> *) a b c.
Traversing p =>
(a -> b) -> p b c -> p a c
lmapWandering a -> b
f = forall (p :: * -> * -> *) a b s t.
Traversing p =>
(forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t)
-> p a b -> p s t
wander (\b -> f c
afb a
a' -> b -> f c
afb (a -> b
f a
a'))

-- | 'rmapWandering' is the same as the default produced from
-- 'dimapWandering'.
rmapWandering :: Traversing p => (b -> c) -> p a b -> p a c
rmapWandering :: forall (p :: * -> * -> *) b c a.
Traversing p =>
(b -> c) -> p a b -> p a c
rmapWandering b -> c
g = forall (p :: * -> * -> *) a b s t.
Traversing p =>
(forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t)
-> p a b -> p s t
wander (\a -> f b
afb a
a' -> b -> c
g forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
afb a
a')

leftTraversing :: Traversing p => p a b -> p (Either a c) (Either b c)
leftTraversing :: forall (p :: * -> * -> *) a b c.
Traversing p =>
p a b -> p (Either a c) (Either b c)
leftTraversing = forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap forall a b. Either a b -> Either b a
swapE forall a b. Either a b -> Either b a
swapE forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) a b.
(Traversing p, Traversable f) =>
p a b -> p (f a) (f b)
traverse'

rightTraversing :: Traversing p => p a b -> p (Either c a) (Either c b)
rightTraversing :: forall (p :: * -> * -> *) a b c.
Traversing p =>
p a b -> p (Either c a) (Either c b)
rightTraversing = forall (p :: * -> * -> *) (f :: * -> *) a b.
(Traversing p, Traversable f) =>
p a b -> p (f a) (f b)
traverse'

newtype Bazaar a b t = Bazaar { forall a b t.
Bazaar a b t
-> forall (f :: * -> *). Applicative f => (a -> f b) -> f t
runBazaar :: forall f. Applicative f => (a -> f b) -> f t }
  deriving forall a b. a -> Bazaar a b b -> Bazaar a b a
forall a b. (a -> b) -> Bazaar a b a -> Bazaar a b b
forall a b a b. a -> Bazaar a b b -> Bazaar a b a
forall a b a b. (a -> b) -> Bazaar a b a -> Bazaar a b b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Bazaar a b b -> Bazaar a b a
$c<$ :: forall a b a b. a -> Bazaar a b b -> Bazaar a b a
fmap :: forall a b. (a -> b) -> Bazaar a b a -> Bazaar a b b
$cfmap :: forall a b a b. (a -> b) -> Bazaar a b a -> Bazaar a b b
Functor

instance Applicative (Bazaar a b) where
  pure :: forall a. a -> Bazaar a b a
pure a
a = forall a b t.
(forall (f :: * -> *). Applicative f => (a -> f b) -> f t)
-> Bazaar a b t
Bazaar forall a b. (a -> b) -> a -> b
$ \a -> f b
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
  Bazaar a b (a -> b)
mf <*> :: forall a b. Bazaar a b (a -> b) -> Bazaar a b a -> Bazaar a b b
<*> Bazaar a b a
ma = forall a b t.
(forall (f :: * -> *). Applicative f => (a -> f b) -> f t)
-> Bazaar a b t
Bazaar forall a b. (a -> b) -> a -> b
$ \a -> f b
k -> forall a b t.
Bazaar a b t
-> forall (f :: * -> *). Applicative f => (a -> f b) -> f t
runBazaar Bazaar a b (a -> b)
mf a -> f b
k forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a b t.
Bazaar a b t
-> forall (f :: * -> *). Applicative f => (a -> f b) -> f t
runBazaar Bazaar a b a
ma a -> f b
k

instance Profunctor (Bazaar a) where
  dimap :: forall a b c d.
(a -> b) -> (c -> d) -> Bazaar a b c -> Bazaar a a d
dimap a -> b
f c -> d
g Bazaar a b c
m = forall a b t.
(forall (f :: * -> *). Applicative f => (a -> f b) -> f t)
-> Bazaar a b t
Bazaar forall a b. (a -> b) -> a -> b
$ \a -> f a
k -> c -> d
g forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b t.
Bazaar a b t
-> forall (f :: * -> *). Applicative f => (a -> f b) -> f t
runBazaar Bazaar a b c
m (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> f a
k)

sell :: a -> Bazaar a b b
sell :: forall a b. a -> Bazaar a b b
sell a
a = forall a b t.
(forall (f :: * -> *). Applicative f => (a -> f b) -> f t)
-> Bazaar a b t
Bazaar forall a b. (a -> b) -> a -> b
$ \a -> f b
k -> a -> f b
k a
a

newtype Baz t b a = Baz { forall t b a.
Baz t b a
-> forall (f :: * -> *). Applicative f => (a -> f b) -> f t
runBaz :: forall f. Applicative f => (a -> f b) -> f t }
  deriving forall a b. a -> Baz t b b -> Baz t b a
forall a b. (a -> b) -> Baz t b a -> Baz t b b
forall t b a b. a -> Baz t b b -> Baz t b a
forall t b a b. (a -> b) -> Baz t b a -> Baz t b b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Baz t b b -> Baz t b a
$c<$ :: forall t b a b. a -> Baz t b b -> Baz t b a
fmap :: forall a b. (a -> b) -> Baz t b a -> Baz t b b
$cfmap :: forall t b a b. (a -> b) -> Baz t b a -> Baz t b b
Functor

-- bsell :: a -> Baz b b a
-- bsell a = Baz $ \k -> k a

-- aar :: Bazaar a b t -> Baz t b a
-- aar (Bazaar f) = Baz f

sold :: Baz t a a -> t
sold :: forall t a. Baz t a a -> t
sold Baz t a a
m = forall a. Identity a -> a
runIdentity (forall t b a.
Baz t b a
-> forall (f :: * -> *). Applicative f => (a -> f b) -> f t
runBaz Baz t a a
m forall a. a -> Identity a
Identity)

instance Foldable (Baz t b) where
  foldMap :: forall m a. Monoid m => (a -> m) -> Baz t b a -> m
foldMap = forall (t :: * -> *) m a.
(Traversable t, Monoid m) =>
(a -> m) -> t a -> m
foldMapDefault

instance Traversable (Baz t b) where
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Baz t b a -> f (Baz t b b)
traverse a -> f b
f Baz t b a
bz = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Bazaar b b t
m -> forall t b a.
(forall (f :: * -> *). Applicative f => (a -> f b) -> f t)
-> Baz t b a
Baz (forall a b t.
Bazaar a b t
-> forall (f :: * -> *). Applicative f => (a -> f b) -> f t
runBazaar Bazaar b b t
m)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t b a.
Baz t b a
-> forall (f :: * -> *). Applicative f => (a -> f b) -> f t
runBaz Baz t b a
bz forall a b. (a -> b) -> a -> b
$ \a
x -> forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose forall a b. (a -> b) -> a -> b
$ forall a b. a -> Bazaar a b b
sell forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
x

instance Profunctor (Baz t) where
  dimap :: forall a b c d. (a -> b) -> (c -> d) -> Baz t b c -> Baz t a d
dimap a -> b
f c -> d
g Baz t b c
m = forall t b a.
(forall (f :: * -> *). Applicative f => (a -> f b) -> f t)
-> Baz t b a
Baz forall a b. (a -> b) -> a -> b
$ \d -> f a
k -> forall t b a.
Baz t b a
-> forall (f :: * -> *). Applicative f => (a -> f b) -> f t
runBaz Baz t b c
m (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. d -> f a
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> d
g)

-- | Note: Definitions in terms of 'wander' are much more efficient!
class (Choice p, Strong p) => Traversing p where
  -- | Laws:
  --
  -- @
  -- 'traverse'' ≡ 'wander' 'traverse'
  -- 'traverse'' '.' 'rmap' f ≡ 'rmap' ('fmap' f) '.' 'traverse''
  -- 'traverse'' '.' 'traverse'' ≡ 'dimap' 'Compose' 'getCompose' '.' 'traverse''
  -- 'dimap' 'Identity' 'runIdentity' '.' 'traverse'' ≡ 'id'
  -- @
  traverse' :: Traversable f => p a b -> p (f a) (f b)
  traverse' = forall (p :: * -> * -> *) a b s t.
Traversing p =>
(forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t)
-> p a b -> p s t
wander forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse

  -- | This combinator is mutually defined in terms of 'traverse''
  wander :: (forall f. Applicative f => (a -> f b) -> s -> f t) -> p a b -> p s t
  wander forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t
f p a b
pab = forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap (\s
s -> forall t b a.
(forall (f :: * -> *). Applicative f => (a -> f b) -> f t)
-> Baz t b a
Baz forall a b. (a -> b) -> a -> b
$ \a -> f b
afb -> forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t
f a -> f b
afb s
s) forall t a. Baz t a a -> t
sold (forall (p :: * -> * -> *) (f :: * -> *) a b.
(Traversing p, Traversable f) =>
p a b -> p (f a) (f b)
traverse' p a b
pab)

  {-# MINIMAL wander | traverse' #-}

instance Traversing (->) where
  traverse' :: forall (f :: * -> *) a b. Traversable f => (a -> b) -> f a -> f b
traverse' = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
  wander :: forall a b s t.
(forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t)
-> (a -> b) -> s -> t
wander forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t
f a -> b
ab = forall a. Identity a -> a
runIdentity forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t
f (forall a. a -> Identity a
Identity forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. a -> b
ab)

instance Monoid m => Traversing (Forget m) where
  traverse' :: forall (f :: * -> *) a b.
Traversable f =>
Forget m a b -> Forget m (f a) (f b)
traverse' (Forget a -> m
h) = forall {k} r a (b :: k). (a -> r) -> Forget r a b
Forget (forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
h)
  wander :: forall a b s t.
(forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t)
-> Forget m a b -> Forget m s t
wander forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t
f (Forget a -> m
h) = forall {k} r a (b :: k). (a -> r) -> Forget r a b
Forget (forall {k} a (b :: k). Const a b -> a
getConst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t
f (forall {k} a (b :: k). a -> Const a b
Const forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m
h))

instance Monad m => Traversing (Kleisli m) where
  traverse' :: forall (f :: * -> *) a b.
Traversable f =>
Kleisli m a b -> Kleisli m (f a) (f b)
traverse' (Kleisli a -> m b
m) = forall (m :: * -> *) a b. (a -> m b) -> Kleisli m a b
Kleisli (forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM a -> m b
m)
  wander :: forall a b s t.
(forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t)
-> Kleisli m a b -> Kleisli m s t
wander forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t
f (Kleisli a -> m b
amb) = forall (m :: * -> *) a b. (a -> m b) -> Kleisli m a b
Kleisli forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. WrappedMonad m a -> m a
unwrapMonad forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t
f (forall (m :: * -> *) a. m a -> WrappedMonad m a
WrapMonad forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. a -> m b
amb)

instance Applicative m => Traversing (Star m) where
  traverse' :: forall (f :: * -> *) a b.
Traversable f =>
Star m a b -> Star m (f a) (f b)
traverse' (Star a -> m b
m) = forall {k} (f :: k -> *) d (c :: k). (d -> f c) -> Star f d c
Star (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> m b
m)
  wander :: forall a b s t.
(forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t)
-> Star m a b -> Star m s t
wander forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t
f (Star a -> m b
amb) = forall {k} (f :: k -> *) d (c :: k). (d -> f c) -> Star f d c
Star (forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t
f a -> m b
amb)

instance (Functor f, Traversing p) => Traversing (Tannen f p) where
  traverse' :: forall (f :: * -> *) a b.
Traversable f =>
Tannen f p a b -> Tannen f p (f a) (f b)
traverse' = forall {k} {k1} {k2} (f :: k -> *) (p :: k1 -> k2 -> k) (a :: k1)
       (b :: k2).
f (p a b) -> Tannen f p a b
Tannen forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (p :: * -> * -> *) (f :: * -> *) a b.
(Traversing p, Traversable f) =>
p a b -> p (f a) (f b)
traverse' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k1} {k2} {k3} (f :: k1 -> *) (p :: k2 -> k3 -> k1)
       (a :: k2) (b :: k3).
Tannen f p a b -> f (p a b)
runTannen

newtype CofreeTraversing p a b = CofreeTraversing { forall (p :: * -> * -> *) a b.
CofreeTraversing p a b
-> forall (f :: * -> *). Traversable f => p (f a) (f b)
runCofreeTraversing :: forall f. Traversable f => p (f a) (f b) }

instance Profunctor p => Profunctor (CofreeTraversing p) where
  lmap :: forall a b c.
(a -> b) -> CofreeTraversing p b c -> CofreeTraversing p a c
lmap a -> b
f (CofreeTraversing forall (f :: * -> *). Traversable f => p (f b) (f c)
p) = forall (p :: * -> * -> *) a b.
(forall (f :: * -> *). Traversable f => p (f a) (f b))
-> CofreeTraversing p a b
CofreeTraversing (forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) forall (f :: * -> *). Traversable f => p (f b) (f c)
p)
  rmap :: forall b c a.
(b -> c) -> CofreeTraversing p a b -> CofreeTraversing p a c
rmap b -> c
g (CofreeTraversing forall (f :: * -> *). Traversable f => p (f a) (f b)
p) = forall (p :: * -> * -> *) a b.
(forall (f :: * -> *). Traversable f => p (f a) (f b))
-> CofreeTraversing p a b
CofreeTraversing (forall (p :: * -> * -> *) b c a.
Profunctor p =>
(b -> c) -> p a b -> p a c
rmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> c
g) forall (f :: * -> *). Traversable f => p (f a) (f b)
p)
  dimap :: forall a b c d.
(a -> b)
-> (c -> d) -> CofreeTraversing p b c -> CofreeTraversing p a d
dimap a -> b
f c -> d
g (CofreeTraversing forall (f :: * -> *). Traversable f => p (f b) (f c)
p) = forall (p :: * -> * -> *) a b.
(forall (f :: * -> *). Traversable f => p (f a) (f b))
-> CofreeTraversing p a b
CofreeTraversing (forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap c -> d
g) forall (f :: * -> *). Traversable f => p (f b) (f c)
p)

instance Profunctor p => Strong (CofreeTraversing p) where
  second' :: forall a b c.
CofreeTraversing p a b -> CofreeTraversing p (c, a) (c, b)
second' = forall (p :: * -> * -> *) (f :: * -> *) a b.
(Traversing p, Traversable f) =>
p a b -> p (f a) (f b)
traverse'

instance Profunctor p => Choice (CofreeTraversing p) where
  right' :: forall a b c.
CofreeTraversing p a b
-> CofreeTraversing p (Either c a) (Either c b)
right' = forall (p :: * -> * -> *) (f :: * -> *) a b.
(Traversing p, Traversable f) =>
p a b -> p (f a) (f b)
traverse'

instance Profunctor p => Traversing (CofreeTraversing p) where
  -- !@(#*&() Compose isn't representational in its second arg or we could use #. and .#
  traverse' :: forall (f :: * -> *) a b.
Traversable f =>
CofreeTraversing p a b -> CofreeTraversing p (f a) (f b)
traverse' (CofreeTraversing forall (f :: * -> *). Traversable f => p (f a) (f b)
p) = forall (p :: * -> * -> *) a b.
(forall (f :: * -> *). Traversable f => p (f a) (f b))
-> CofreeTraversing p a b
CofreeTraversing (forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose forall (f :: * -> *). Traversable f => p (f a) (f b)
p)

instance ProfunctorFunctor CofreeTraversing where
  promap :: forall (p :: * -> * -> *) (q :: * -> * -> *).
Profunctor p =>
(p :-> q) -> CofreeTraversing p :-> CofreeTraversing q
promap p :-> q
f (CofreeTraversing forall (f :: * -> *). Traversable f => p (f a) (f b)
p) = forall (p :: * -> * -> *) a b.
(forall (f :: * -> *). Traversable f => p (f a) (f b))
-> CofreeTraversing p a b
CofreeTraversing (p :-> q
f forall (f :: * -> *). Traversable f => p (f a) (f b)
p)

instance ProfunctorComonad CofreeTraversing where
  proextract :: forall (p :: * -> * -> *). Profunctor p => CofreeTraversing p :-> p
proextract (CofreeTraversing forall (f :: * -> *). Traversable f => p (f a) (f b)
p) = forall a. Identity a -> a
runIdentity forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. forall (f :: * -> *). Traversable f => p (f a) (f b)
p forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible b a) =>
p b c -> q a b -> p a c
.# forall a. a -> Identity a
Identity
  produplicate :: forall (p :: * -> * -> *).
Profunctor p =>
CofreeTraversing p :-> CofreeTraversing (CofreeTraversing p)
produplicate (CofreeTraversing forall (f :: * -> *). Traversable f => p (f a) (f b)
p) = forall (p :: * -> * -> *) a b.
(forall (f :: * -> *). Traversable f => p (f a) (f b))
-> CofreeTraversing p a b
CofreeTraversing (forall (p :: * -> * -> *) a b.
(forall (f :: * -> *). Traversable f => p (f a) (f b))
-> CofreeTraversing p a b
CofreeTraversing (forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose forall (f :: * -> *). Traversable f => p (f a) (f b)
p))

-- | @FreeTraversing -| CofreeTraversing@
data FreeTraversing p a b where
  FreeTraversing :: Traversable f => (f y -> b) -> p x y -> (a -> f x) -> FreeTraversing p a b

instance Functor (FreeTraversing p a) where
  fmap :: forall a b.
(a -> b) -> FreeTraversing p a a -> FreeTraversing p a b
fmap a -> b
f (FreeTraversing f y -> a
l p x y
m a -> f x
r) = forall (f :: * -> *) y b (p :: * -> * -> *) x a.
Traversable f =>
(f y -> b) -> p x y -> (a -> f x) -> FreeTraversing p a b
FreeTraversing (a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. f y -> a
l) p x y
m a -> f x
r

instance Profunctor (FreeTraversing p) where
  lmap :: forall a b c.
(a -> b) -> FreeTraversing p b c -> FreeTraversing p a c
lmap a -> b
f (FreeTraversing f y -> c
l p x y
m b -> f x
r) = forall (f :: * -> *) y b (p :: * -> * -> *) x a.
Traversable f =>
(f y -> b) -> p x y -> (a -> f x) -> FreeTraversing p a b
FreeTraversing f y -> c
l p x y
m (b -> f x
r forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)
  rmap :: forall b c a.
(b -> c) -> FreeTraversing p a b -> FreeTraversing p a c
rmap b -> c
g (FreeTraversing f y -> b
l p x y
m a -> f x
r) = forall (f :: * -> *) y b (p :: * -> * -> *) x a.
Traversable f =>
(f y -> b) -> p x y -> (a -> f x) -> FreeTraversing p a b
FreeTraversing (b -> c
g forall b c a. (b -> c) -> (a -> b) -> a -> c
. f y -> b
l) p x y
m a -> f x
r
  dimap :: forall a b c d.
(a -> b)
-> (c -> d) -> FreeTraversing p b c -> FreeTraversing p a d
dimap a -> b
f c -> d
g (FreeTraversing f y -> c
l p x y
m b -> f x
r) = forall (f :: * -> *) y b (p :: * -> * -> *) x a.
Traversable f =>
(f y -> b) -> p x y -> (a -> f x) -> FreeTraversing p a b
FreeTraversing (c -> d
g forall b c a. (b -> c) -> (a -> b) -> a -> c
. f y -> c
l) p x y
m (b -> f x
r forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)
  q b c
g #. :: forall a b c (q :: * -> * -> *).
Coercible c b =>
q b c -> FreeTraversing p a b -> FreeTraversing p a c
#. FreeTraversing f y -> b
l p x y
m a -> f x
r = forall (f :: * -> *) y b (p :: * -> * -> *) x a.
Traversable f =>
(f y -> b) -> p x y -> (a -> f x) -> FreeTraversing p a b
FreeTraversing (q b c
g forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. f y -> b
l) p x y
m a -> f x
r
  FreeTraversing f y -> c
l p x y
m b -> f x
r .# :: forall a b c (q :: * -> * -> *).
Coercible b a =>
FreeTraversing p b c -> q a b -> FreeTraversing p a c
.# q a b
f = forall (f :: * -> *) y b (p :: * -> * -> *) x a.
Traversable f =>
(f y -> b) -> p x y -> (a -> f x) -> FreeTraversing p a b
FreeTraversing f y -> c
l p x y
m (b -> f x
r forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible b a) =>
p b c -> q a b -> p a c
.# q a b
f)

instance Strong (FreeTraversing p) where
  second' :: forall a b c.
FreeTraversing p a b -> FreeTraversing p (c, a) (c, b)
second' = forall (p :: * -> * -> *) (f :: * -> *) a b.
(Traversing p, Traversable f) =>
p a b -> p (f a) (f b)
traverse'

instance Choice (FreeTraversing p) where
  right' :: forall a b c.
FreeTraversing p a b -> FreeTraversing p (Either c a) (Either c b)
right' = forall (p :: * -> * -> *) (f :: * -> *) a b.
(Traversing p, Traversable f) =>
p a b -> p (f a) (f b)
traverse'

instance Traversing (FreeTraversing p) where
  traverse' :: forall (f :: * -> *) a b.
Traversable f =>
FreeTraversing p a b -> FreeTraversing p (f a) (f b)
traverse' (FreeTraversing f y -> b
l p x y
m a -> f x
r) = forall (f :: * -> *) y b (p :: * -> * -> *) x a.
Traversable f =>
(f y -> b) -> p x y -> (a -> f x) -> FreeTraversing p a b
FreeTraversing (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f y -> b
l forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible b a) =>
p b c -> q a b -> p a c
.# forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose) p x y
m (forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> f x
r)

instance ProfunctorFunctor FreeTraversing where
  promap :: forall (p :: * -> * -> *) (q :: * -> * -> *).
Profunctor p =>
(p :-> q) -> FreeTraversing p :-> FreeTraversing q
promap p :-> q
f (FreeTraversing f y -> b
l p x y
m a -> f x
r) = forall (f :: * -> *) y b (p :: * -> * -> *) x a.
Traversable f =>
(f y -> b) -> p x y -> (a -> f x) -> FreeTraversing p a b
FreeTraversing f y -> b
l (p :-> q
f p x y
m) a -> f x
r

instance ProfunctorMonad FreeTraversing where
  proreturn :: forall (p :: * -> * -> *). Profunctor p => p :-> FreeTraversing p
proreturn p a b
p = forall (f :: * -> *) y b (p :: * -> * -> *) x a.
Traversable f =>
(f y -> b) -> p x y -> (a -> f x) -> FreeTraversing p a b
FreeTraversing forall a. Identity a -> a
runIdentity p a b
p forall a. a -> Identity a
Identity
  projoin :: forall (p :: * -> * -> *).
Profunctor p =>
FreeTraversing (FreeTraversing p) :-> FreeTraversing p
projoin (FreeTraversing f y -> b
l (FreeTraversing f y -> y
l' p x y
m x -> f x
r') a -> f x
r) = forall (f :: * -> *) y b (p :: * -> * -> *) x a.
Traversable f =>
(f y -> b) -> p x y -> (a -> f x) -> FreeTraversing p a b
FreeTraversing ((f y -> b
l forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f y -> y
l') forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible b a) =>
p b c -> q a b -> p a c
.# forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose) p x y
m (forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap x -> f x
r' forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> f x
r))