{-# 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 :: p a b -> p (a, c) (b, c)
firstTraversing = ((a, c) -> (c, a))
-> ((c, b) -> (b, c)) -> p (c, a) (c, b) -> p (a, c) (b, c)
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap (a, c) -> (c, a)
forall a b. (a, b) -> (b, a)
swap (c, b) -> (b, c)
forall a b. (a, b) -> (b, a)
swap (p (c, a) (c, b) -> p (a, c) (b, c))
-> (p a b -> p (c, a) (c, b)) -> p a b -> p (a, c) (b, c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p a b -> p (c, a) (c, b)
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 :: p a b -> p (c, a) (c, b)
secondTraversing = p a b -> p (c, a) (c, b)
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 :: Either a b -> Either b a
swapE = (a -> Either b a) -> (b -> Either b a) -> Either a b -> Either b a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either a -> Either b a
forall a b. b -> Either a b
Right b -> Either b a
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 :: (a' -> a) -> (b -> b') -> p a b -> p a' b'
dimapWandering a' -> a
f b -> b'
g = (forall (f :: * -> *). Applicative f => (a -> f b) -> a' -> f b')
-> p a b -> p a' b'
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 (b -> b') -> f b -> f b'
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 :: (a -> b) -> p b c -> p a c
lmapWandering a -> b
f = (forall (f :: * -> *). Applicative f => (b -> f c) -> a -> f c)
-> p b c -> p a c
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 :: (b -> c) -> p a b -> p a c
rmapWandering b -> c
g = (forall (f :: * -> *). Applicative f => (a -> f b) -> a -> f c)
-> p a b -> p a c
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 (b -> c) -> f b -> f c
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 :: p a b -> p (Either a c) (Either b c)
leftTraversing = (Either a c -> Either c a)
-> (Either c b -> Either b c)
-> p (Either c a) (Either c b)
-> p (Either a c) (Either b c)
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap Either a c -> Either c a
forall a b. Either a b -> Either b a
swapE Either c b -> Either b c
forall a b. Either a b -> Either b a
swapE (p (Either c a) (Either c b) -> p (Either a c) (Either b c))
-> (p a b -> p (Either c a) (Either c b))
-> p a b
-> p (Either a c) (Either b c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p a b -> p (Either c a) (Either c b)
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 :: p a b -> p (Either c a) (Either c b)
rightTraversing = p a b -> p (Either c a) (Either c b)
forall (p :: * -> * -> *) (f :: * -> *) a b.
(Traversing p, Traversable f) =>
p a b -> p (f a) (f b)
traverse'

newtype Bazaar a b t = Bazaar { Bazaar a b t
-> forall (f :: * -> *). Applicative f => (a -> f b) -> f t
runBazaar :: forall f. Applicative f => (a -> f b) -> f t }
  deriving a -> Bazaar a b b -> Bazaar a b a
(a -> b) -> Bazaar a b a -> Bazaar a b b
(forall a b. (a -> b) -> Bazaar a b a -> Bazaar a b b)
-> (forall a b. a -> Bazaar a b b -> Bazaar a b a)
-> Functor (Bazaar a b)
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
<$ :: 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 :: (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 :: a -> Bazaar a b a
pure a
a = (forall (f :: * -> *). Applicative f => (a -> f b) -> f a)
-> Bazaar a b a
forall a b t.
(forall (f :: * -> *). Applicative f => (a -> f b) -> f t)
-> Bazaar a b t
Bazaar ((forall (f :: * -> *). Applicative f => (a -> f b) -> f a)
 -> Bazaar a b a)
-> (forall (f :: * -> *). Applicative f => (a -> f b) -> f a)
-> Bazaar a b a
forall a b. (a -> b) -> a -> b
$ \a -> f b
_ -> a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
  Bazaar a b (a -> b)
mf <*> :: Bazaar a b (a -> b) -> Bazaar a b a -> Bazaar a b b
<*> Bazaar a b a
ma = (forall (f :: * -> *). Applicative f => (a -> f b) -> f b)
-> Bazaar a b b
forall a b t.
(forall (f :: * -> *). Applicative f => (a -> f b) -> f t)
-> Bazaar a b t
Bazaar ((forall (f :: * -> *). Applicative f => (a -> f b) -> f b)
 -> Bazaar a b b)
-> (forall (f :: * -> *). Applicative f => (a -> f b) -> f b)
-> Bazaar a b b
forall a b. (a -> b) -> a -> b
$ \a -> f b
k -> Bazaar a b (a -> b) -> (a -> f b) -> f (a -> b)
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 f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bazaar a b a -> (a -> f b) -> f a
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 :: (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 (f :: * -> *). Applicative f => (a -> f a) -> f d)
-> Bazaar a a d
forall a b t.
(forall (f :: * -> *). Applicative f => (a -> f b) -> f t)
-> Bazaar a b t
Bazaar ((forall (f :: * -> *). Applicative f => (a -> f a) -> f d)
 -> Bazaar a a d)
-> (forall (f :: * -> *). Applicative f => (a -> f a) -> f d)
-> Bazaar a a d
forall a b. (a -> b) -> a -> b
$ \a -> f a
k -> c -> d
g (c -> d) -> f c -> f d
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bazaar a b c -> (a -> f b) -> f c
forall a b t.
Bazaar a b t
-> forall (f :: * -> *). Applicative f => (a -> f b) -> f t
runBazaar Bazaar a b c
m ((a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (f a -> f b) -> (a -> f a) -> a -> f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> f a
k)

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

newtype Baz t b a = Baz { Baz t b a
-> forall (f :: * -> *). Applicative f => (a -> f b) -> f t
runBaz :: forall f. Applicative f => (a -> f b) -> f t }
  deriving a -> Baz t b b -> Baz t b a
(a -> b) -> Baz t b a -> Baz t b b
(forall a b. (a -> b) -> Baz t b a -> Baz t b b)
-> (forall a b. a -> Baz t b b -> Baz t b a) -> Functor (Baz t b)
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
<$ :: 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 :: (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 :: Baz t a a -> t
sold Baz t a a
m = Identity t -> t
forall a. Identity a -> a
runIdentity (Baz t a a -> (a -> Identity a) -> Identity t
forall t b a.
Baz t b a
-> forall (f :: * -> *). Applicative f => (a -> f b) -> f t
runBaz Baz t a a
m a -> Identity a
forall a. a -> Identity a
Identity)

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

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

instance Profunctor (Baz t) where
  dimap :: (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 (f :: * -> *). Applicative f => (d -> f a) -> f t)
-> Baz t a d
forall t b a.
(forall (f :: * -> *). Applicative f => (a -> f b) -> f t)
-> Baz t b a
Baz ((forall (f :: * -> *). Applicative f => (d -> f a) -> f t)
 -> Baz t a d)
-> (forall (f :: * -> *). Applicative f => (d -> f a) -> f t)
-> Baz t a d
forall a b. (a -> b) -> a -> b
$ \d -> f a
k -> Baz t b c -> (c -> f b) -> f t
forall t b a.
Baz t b a
-> forall (f :: * -> *). Applicative f => (a -> f b) -> f t
runBaz Baz t b c
m ((a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (f a -> f b) -> (c -> f a) -> c -> f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. d -> f a
k (d -> f a) -> (c -> d) -> c -> f a
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 (f :: * -> *).
 Applicative f =>
 (a -> f b) -> f a -> f (f b))
-> p a b -> p (f a) (f b)
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 (f :: * -> *). Applicative f => (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

  -- | 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 = (s -> Baz t b a)
-> (Baz t b b -> t) -> p (Baz t b a) (Baz t b b) -> p s t
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap (\s
s -> (forall (f :: * -> *). Applicative f => (a -> f b) -> f t)
-> Baz t b a
forall t b a.
(forall (f :: * -> *). Applicative f => (a -> f b) -> f t)
-> Baz t b a
Baz ((forall (f :: * -> *). Applicative f => (a -> f b) -> f t)
 -> Baz t b a)
-> (forall (f :: * -> *). Applicative f => (a -> f b) -> f t)
-> Baz t b a
forall a b. (a -> b) -> a -> b
$ \a -> f b
afb -> (a -> f b) -> s -> f t
forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t
f a -> f b
afb s
s) Baz t b b -> t
forall t a. Baz t a a -> t
sold (p a b -> p (Baz t b a) (Baz t b b)
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' :: (a -> b) -> f a -> f b
traverse' = (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
  wander :: (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 = Identity t -> t
forall a. Identity a -> a
runIdentity (Identity t -> t) -> (s -> Identity t) -> s -> t
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. (a -> Identity b) -> s -> Identity t
forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t
f (b -> Identity b
forall a. a -> Identity a
Identity (b -> Identity b) -> (a -> b) -> a -> Identity b
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' :: Forget m a b -> Forget m (f a) (f b)
traverse' (Forget a -> m
h) = (f a -> m) -> Forget m (f a) (f b)
forall k r a (b :: k). (a -> r) -> Forget r a b
Forget ((a -> m) -> f a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
h)
  wander :: (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) = (s -> m) -> Forget m s t
forall k r a (b :: k). (a -> r) -> Forget r a b
Forget (Const m t -> m
forall a k (b :: k). Const a b -> a
getConst (Const m t -> m) -> (s -> Const m t) -> s -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Const m b) -> s -> Const m t
forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t
f (m -> Const m b
forall k a (b :: k). a -> Const a b
Const (m -> Const m b) -> (a -> m) -> a -> Const m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m
h))

instance Monad m => Traversing (Kleisli m) where
  traverse' :: Kleisli m a b -> Kleisli m (f a) (f b)
traverse' (Kleisli a -> m b
m) = (f a -> m (f b)) -> Kleisli m (f a) (f b)
forall (m :: * -> *) a b. (a -> m b) -> Kleisli m a b
Kleisli ((a -> m b) -> f a -> m (f b)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM a -> m b
m)
  wander :: (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) = (s -> m t) -> Kleisli m s t
forall (m :: * -> *) a b. (a -> m b) -> Kleisli m a b
Kleisli ((s -> m t) -> Kleisli m s t) -> (s -> m t) -> Kleisli m s t
forall a b. (a -> b) -> a -> b
$ WrappedMonad m t -> m t
forall (m :: * -> *) a. WrappedMonad m a -> m a
unwrapMonad (WrappedMonad m t -> m t) -> (s -> WrappedMonad m t) -> s -> m t
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. (a -> WrappedMonad m b) -> s -> WrappedMonad m t
forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t
f (m b -> WrappedMonad m b
forall (m :: * -> *) a. m a -> WrappedMonad m a
WrapMonad (m b -> WrappedMonad m b) -> (a -> m b) -> a -> WrappedMonad m b
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' :: Star m a b -> Star m (f a) (f b)
traverse' (Star a -> m b
m) = (f a -> m (f b)) -> Star m (f a) (f b)
forall k (f :: k -> *) d (c :: k). (d -> f c) -> Star f d c
Star ((a -> m b) -> f a -> m (f b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> m b
m)
  wander :: (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) = (s -> m t) -> Star m s t
forall k (f :: k -> *) d (c :: k). (d -> f c) -> Star f d c
Star ((a -> m b) -> s -> m t
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' :: Tannen f p a b -> Tannen f p (f a) (f b)
traverse' = f (p (f a) (f b)) -> Tannen f p (f a) (f b)
forall k k1 k2 (f :: k -> *) (p :: k1 -> k2 -> k) (a :: k1)
       (b :: k2).
f (p a b) -> Tannen f p a b
Tannen (f (p (f a) (f b)) -> Tannen f p (f a) (f b))
-> (Tannen f p a b -> f (p (f a) (f b)))
-> Tannen f p a b
-> Tannen f p (f a) (f b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (p a b -> p (f a) (f b)) -> f (p a b) -> f (p (f a) (f b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap p a b -> p (f a) (f b)
forall (p :: * -> * -> *) (f :: * -> *) a b.
(Traversing p, Traversable f) =>
p a b -> p (f a) (f b)
traverse' (f (p a b) -> f (p (f a) (f b)))
-> (Tannen f p a b -> f (p a b))
-> Tannen f p a b
-> f (p (f a) (f b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tannen f p a b -> f (p a b)
forall k1 (f :: k1 -> *) k2 k3 (p :: k2 -> k3 -> k1) (a :: k2)
       (b :: k3).
Tannen f p a b -> f (p a b)
runTannen

newtype CofreeTraversing p a b = CofreeTraversing { 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 :: (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 (f :: * -> *). Traversable f => p (f a) (f c))
-> CofreeTraversing p a c
forall (p :: * -> * -> *) a b.
(forall (f :: * -> *). Traversable f => p (f a) (f b))
-> CofreeTraversing p a b
CofreeTraversing ((f a -> f b) -> p (f b) (f c) -> p (f a) (f c)
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap ((a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) p (f b) (f c)
forall (f :: * -> *). Traversable f => p (f b) (f c)
p)
  rmap :: (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 (f :: * -> *). Traversable f => p (f a) (f c))
-> CofreeTraversing p a c
forall (p :: * -> * -> *) a b.
(forall (f :: * -> *). Traversable f => p (f a) (f b))
-> CofreeTraversing p a b
CofreeTraversing ((f b -> f c) -> p (f a) (f b) -> p (f a) (f c)
forall (p :: * -> * -> *) b c a.
Profunctor p =>
(b -> c) -> p a b -> p a c
rmap ((b -> c) -> f b -> f c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> c
g) p (f a) (f b)
forall (f :: * -> *). Traversable f => p (f a) (f b)
p)
  dimap :: (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 (f :: * -> *). Traversable f => p (f a) (f d))
-> CofreeTraversing p a d
forall (p :: * -> * -> *) a b.
(forall (f :: * -> *). Traversable f => p (f a) (f b))
-> CofreeTraversing p a b
CofreeTraversing ((f a -> f b) -> (f c -> f d) -> p (f b) (f c) -> p (f a) (f d)
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap ((a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) ((c -> d) -> f c -> f d
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap c -> d
g) p (f b) (f c)
forall (f :: * -> *). Traversable f => p (f b) (f c)
p)

instance Profunctor p => Strong (CofreeTraversing p) where
  second' :: CofreeTraversing p a b -> CofreeTraversing p (c, a) (c, b)
second' = CofreeTraversing p a b -> CofreeTraversing p (c, a) (c, b)
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' :: CofreeTraversing p a b
-> CofreeTraversing p (Either c a) (Either c b)
right' = CofreeTraversing p a b
-> CofreeTraversing p (Either c a) (Either c b)
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' :: CofreeTraversing p a b -> CofreeTraversing p (f a) (f b)
traverse' (CofreeTraversing forall (f :: * -> *). Traversable f => p (f a) (f b)
p) = (forall (f :: * -> *). Traversable f => p (f (f a)) (f (f b)))
-> CofreeTraversing p (f a) (f b)
forall (p :: * -> * -> *) a b.
(forall (f :: * -> *). Traversable f => p (f a) (f b))
-> CofreeTraversing p a b
CofreeTraversing ((f (f a) -> Compose f f a)
-> (Compose f f b -> f (f b))
-> p (Compose f f a) (Compose f f b)
-> p (f (f a)) (f (f b))
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap f (f a) -> Compose f f a
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose Compose f f b -> f (f b)
forall k1 (f :: k1 -> *) k2 (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose p (Compose f f a) (Compose f f b)
forall (f :: * -> *). Traversable f => p (f a) (f b)
p)

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

instance ProfunctorComonad CofreeTraversing where
  proextract :: CofreeTraversing p :-> p
proextract (CofreeTraversing forall (f :: * -> *). Traversable f => p (f a) (f b)
p) = Identity b -> b
forall a. Identity a -> a
runIdentity (Identity b -> b)
-> p (Identity a) (Identity b) -> p (Identity a) b
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. p (Identity a) (Identity b)
forall (f :: * -> *). Traversable f => p (f a) (f b)
p p (Identity a) b -> (a -> Identity a) -> p a b
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible b a) =>
p b c -> q a b -> p a c
.# a -> Identity a
forall a. a -> Identity a
Identity
  produplicate :: CofreeTraversing p :-> CofreeTraversing (CofreeTraversing p)
produplicate (CofreeTraversing forall (f :: * -> *). Traversable f => p (f a) (f b)
p) = (forall (f :: * -> *).
 Traversable f =>
 CofreeTraversing p (f a) (f b))
-> CofreeTraversing (CofreeTraversing p) a b
forall (p :: * -> * -> *) a b.
(forall (f :: * -> *). Traversable f => p (f a) (f b))
-> CofreeTraversing p a b
CofreeTraversing ((forall (f :: * -> *). Traversable f => p (f (f a)) (f (f b)))
-> CofreeTraversing p (f a) (f b)
forall (p :: * -> * -> *) a b.
(forall (f :: * -> *). Traversable f => p (f a) (f b))
-> CofreeTraversing p a b
CofreeTraversing ((f (f a) -> Compose f f a)
-> (Compose f f b -> f (f b))
-> p (Compose f f a) (Compose f f b)
-> p (f (f a)) (f (f b))
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap f (f a) -> Compose f f a
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose Compose f f b -> f (f b)
forall k1 (f :: k1 -> *) k2 (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose p (Compose f f a) (Compose f f b)
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 :: (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) = (f y -> b) -> p x y -> (a -> f x) -> FreeTraversing p a b
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 (a -> b) -> (f y -> a) -> f y -> b
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 :: (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) = (f y -> c) -> p x y -> (a -> f x) -> FreeTraversing p a c
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 (b -> f x) -> (a -> b) -> a -> f x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)
  rmap :: (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) = (f y -> c) -> p x y -> (a -> f x) -> FreeTraversing p a c
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 (b -> c) -> (f y -> b) -> f y -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f y -> b
l) p x y
m a -> f x
r
  dimap :: (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) = (f y -> d) -> p x y -> (a -> f x) -> FreeTraversing p a d
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 (c -> d) -> (f y -> c) -> f y -> d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f y -> c
l) p x y
m (b -> f x
r (b -> f x) -> (a -> b) -> a -> f x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)
  q b c
g #. :: q b c -> FreeTraversing p a b -> FreeTraversing p a c
#. FreeTraversing f y -> b
l p x y
m a -> f x
r = (f y -> c) -> p x y -> (a -> f x) -> FreeTraversing p a c
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 q b c -> (f y -> b) -> f y -> c
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 .# :: FreeTraversing p b c -> q a b -> FreeTraversing p a c
.# q a b
f = (f y -> c) -> p x y -> (a -> f x) -> FreeTraversing p a c
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 (b -> f x) -> q a b -> a -> f x
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' :: FreeTraversing p a b -> FreeTraversing p (c, a) (c, b)
second' = FreeTraversing p a b -> FreeTraversing p (c, a) (c, b)
forall (p :: * -> * -> *) (f :: * -> *) a b.
(Traversing p, Traversable f) =>
p a b -> p (f a) (f b)
traverse'

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

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

instance ProfunctorFunctor FreeTraversing where
  promap :: (p :-> q) -> FreeTraversing p :-> FreeTraversing q
promap p :-> q
f (FreeTraversing f y -> b
l p x y
m a -> f x
r) = (f y -> b) -> q x y -> (a -> f x) -> FreeTraversing q a b
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 x y -> q x y
p :-> q
f p x y
m) a -> f x
r

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