{-|
Module      : Data.Profunctor.Distributor
Description : distributors
Copyright   : (C) 2026 - Eitan Chatav
License     : BSD-style (see the file LICENSE)
Maintainer  : Eitan Chatav <eitan.chatav@gmail.com>
Stability   : provisional
Portability : non-portable
-}

module Data.Profunctor.Distributor
  ( -- * Distributor
    Distributor (..)
  , dialt
    -- * Alternator
  , Alternator (..)
  , choice
  ) where

import Control.Applicative hiding (WrappedArrow)
import Control.Applicative qualified as Ap (WrappedArrow)
import Control.Arrow
import Control.Lens hiding (chosen)
import Control.Lens.Internal.Profunctor
import Control.Lens.PartialIso
import Data.Bifunctor.Clown
import Data.Bifunctor.Joker
import Data.Bifunctor.Product
import Data.Foldable hiding (toList)
import Data.Functor.Adjunction
import Data.Functor.Contravariant.Divisible
import Data.Profunctor hiding (WrappedArrow)
import Data.Profunctor qualified as Pro (WrappedArrow)
import Data.Profunctor.Cayley
import Data.Profunctor.Composition
import Data.Profunctor.Monad
import Data.Profunctor.Monoidal
import Data.Profunctor.Yoneda
import Data.Void

-- Distributor --

{- | A `Distributor`, or lax distributive profunctor,
respects [distributive category]
(https://ncatlab.org/nlab/show/distributive+category)
structure, that is nilary and binary products and coproducts,
@()@, @(,)@, `Void` and `Either`. It has zero `zeroP`
and sum `>+<` lax monoidal structure morphisms.

In addition to the product laws for `Monoidal`, we have
sum laws for `Distributor`.

Laws:

>>> let lunit = dimap (either absurd id) Right
>>> let runit = dimap (either id absurd) Left
>>> :{
let assoc = dimap
      (either (Left . Left) (either (Left . Right) Right))
      (either (either Left (Right . Left)) (Right . Right))
:}

prop> zeroP >+< p = lunit p
prop> p >+< zeroP = runit p
prop> p >+< q >+< r = assoc ((p >+< q) >+< r)
prop> dimap (f >+< g) (h >+< i) (p >+< q) = dimap f h p >+< dimap g i q

`Distributor` additionally has methods `manyP` & `optionalP`,
distributing an action over @[]@ and `Maybe` datatypes,
which generalize to `Data.Traversable.Homogeneous.homogeneously`
distributing an action over
`Data.Traversable.Homogeneous.Homogeneous`
sum-of-products datatypes.

-}
class Monoidal p => Distributor p where

  {- | The zero structure morphism of a `Distributor`.

  `zeroP` has a default for `Alternator`s.

  prop> zeroP = empty
  -}
  zeroP :: p Void Void
  default zeroP :: Alternator p => p Void Void
  zeroP = p Void Void
forall a. p Void a
forall (f :: * -> *) a. Alternative f => f a
empty

  {- | The sum structure morphism of a `Distributor`.

  `>+<` has a default for `Alternator`s.

  prop> x >+< y = alternate (Left x) <|> alternate (Right y)
  -}
  (>+<) :: p a b -> p c d -> p (Either a c) (Either b d)
  default (>+<)
    :: Alternator p
    => p a b -> p c d -> p (Either a c) (Either b d)
  p a b
x >+< p c d
y = Either (p a b) (p c d) -> p (Either a c) (Either b d)
forall a b c d.
Either (p a b) (p c d) -> p (Either a c) (Either b d)
forall (p :: * -> * -> *) a b c d.
Alternator p =>
Either (p a b) (p c d) -> p (Either a c) (Either b d)
alternate (p a b -> Either (p a b) (p c d)
forall a b. a -> Either a b
Left p a b
x) p (Either a c) (Either b d)
-> p (Either a c) (Either b d) -> p (Either a c) (Either b d)
forall a. p (Either a c) a -> p (Either a c) a -> p (Either a c) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Either (p a b) (p c d) -> p (Either a c) (Either b d)
forall a b c d.
Either (p a b) (p c d) -> p (Either a c) (Either b d)
forall (p :: * -> * -> *) a b c d.
Alternator p =>
Either (p a b) (p c d) -> p (Either a c) (Either b d)
alternate (p c d -> Either (p a b) (p c d)
forall a b. b -> Either a b
Right p c d
y)
  infixr 3 >+<

  {- | One or none. -}
  optionalP :: p a b -> p (Maybe a) (Maybe b)
  optionalP p a b
p = Exchange
  (Either a ()) (Either b ()) (Either a ()) (Identity (Either b ()))
-> Exchange
     (Either a ()) (Either b ()) (Maybe a) (Identity (Maybe b))
forall a b (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p (Either a ()) (f (Either b ())) -> p (Maybe a) (f (Maybe b))
eotMaybe (Exchange
   (Either a ()) (Either b ()) (Either a ()) (Identity (Either b ()))
 -> Exchange
      (Either a ()) (Either b ()) (Maybe a) (Identity (Maybe b)))
-> p (Either a ()) (Either b ()) -> p (Maybe a) (Maybe b)
forall (p :: * -> * -> *) s t a b.
Profunctor p =>
AnIso s t a b -> p a b -> p s t
>~ p a b
p p a b -> p () () -> p (Either a ()) (Either b ())
forall a b c d. p a b -> p c d -> p (Either a c) (Either b d)
forall (p :: * -> * -> *) a b c d.
Distributor p =>
p a b -> p c d -> p (Either a c) (Either b d)
>+< p () ()
forall (p :: * -> * -> *). Monoidal p => p () ()
oneP

  {- | Zero or more. -}
  manyP :: p a b -> p [a] [b]
  manyP p a b
p = Exchange
  (Either (a, [a]) ())
  (Either (b, [b]) ())
  (Either (a, [a]) ())
  (Identity (Either (b, [b]) ()))
-> Exchange
     (Either (a, [a]) ()) (Either (b, [b]) ()) [a] (Identity [b])
forall s a t b.
(Cons s s a a, AsEmpty t, Cons t t b b) =>
Iso s t (Either (a, s) ()) (Either (b, t) ())
Iso [a] [b] (Either (a, [a]) ()) (Either (b, [b]) ())
eotList (Exchange
   (Either (a, [a]) ())
   (Either (b, [b]) ())
   (Either (a, [a]) ())
   (Identity (Either (b, [b]) ()))
 -> Exchange
      (Either (a, [a]) ()) (Either (b, [b]) ()) [a] (Identity [b]))
-> p (Either (a, [a]) ()) (Either (b, [b]) ()) -> p [a] [b]
forall (p :: * -> * -> *) s t a b.
Profunctor p =>
AnIso s t a b -> p a b -> p s t
>~ p a b
p p a b -> p [a] [b] -> p (a, [a]) (b, [b])
forall (p :: * -> * -> *) a b c d.
Monoidal p =>
p a b -> p c d -> p (a, c) (b, d)
>*< p a b -> p [a] [b]
forall a b. p a b -> p [a] [b]
forall (p :: * -> * -> *) a b. Distributor p => p a b -> p [a] [b]
manyP p a b
p p (a, [a]) (b, [b])
-> p () () -> p (Either (a, [a]) ()) (Either (b, [b]) ())
forall a b c d. p a b -> p c d -> p (Either a c) (Either b d)
forall (p :: * -> * -> *) a b c d.
Distributor p =>
p a b -> p c d -> p (Either a c) (Either b d)
>+< p () ()
forall (p :: * -> * -> *). Monoidal p => p () ()
oneP

instance Distributor (->) where
  zeroP :: Void -> Void
zeroP = Void -> Void
forall a. a -> a
id
  >+< :: forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
(>+<) = (a -> b) -> (c -> d) -> Either a c -> Either b d
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (a :: * -> * -> *) b c b' c'.
ArrowChoice a =>
a b c -> a b' c' -> a (Either b b') (Either c c')
(+++)
instance Monoid s => Distributor (Forget s) where
  zeroP :: Forget s Void Void
zeroP = (Void -> s) -> Forget s Void Void
forall {k} r a (b :: k). (a -> r) -> Forget r a b
Forget Void -> s
forall a. Void -> a
absurd
  Forget a -> s
kL >+< :: forall a b c d.
Forget s a b -> Forget s c d -> Forget s (Either a c) (Either b d)
>+< Forget c -> s
kR = (Either a c -> s) -> Forget s (Either a c) (Either b d)
forall {k} r a (b :: k). (a -> r) -> Forget r a b
Forget ((a -> s) -> (c -> s) -> Either a c -> s
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either a -> s
kL c -> s
kR)
instance Decidable f => Distributor (Clown f) where
  zeroP :: Clown f Void Void
zeroP = f Void -> Clown f Void Void
forall {k} {k1} (f :: k -> *) (a :: k) (b :: k1).
f a -> Clown f a b
Clown f Void
forall (f :: * -> *). Decidable f => f Void
lost
  Clown f a
x >+< :: forall a b c d.
Clown f a b -> Clown f c d -> Clown f (Either a c) (Either b d)
>+< Clown f c
y = f (Either a c) -> Clown f (Either a c) (Either b d)
forall {k} {k1} (f :: k -> *) (a :: k) (b :: k1).
f a -> Clown f a b
Clown (f a -> f c -> f (Either a c)
forall (f :: * -> *) b c.
Decidable f =>
f b -> f c -> f (Either b c)
chosen f a
x f c
y)
instance Alternative f => Distributor (Joker f) where
  zeroP :: Joker f Void Void
zeroP = f Void -> Joker f Void Void
forall {k} {k1} (g :: k -> *) (a :: k1) (b :: k).
g b -> Joker g a b
Joker f Void
forall a. f a
forall (f :: * -> *) a. Alternative f => f a
empty
  Joker f b
x >+< :: forall a b c d.
Joker f a b -> Joker f c d -> Joker f (Either a c) (Either b d)
>+< Joker f d
y = f (Either b d) -> Joker f (Either a c) (Either b d)
forall {k} {k1} (g :: k -> *) (a :: k1) (b :: k).
g b -> Joker g a b
Joker (b -> Either b d
forall a b. a -> Either a b
Left (b -> Either b d) -> f b -> f (Either b d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f b
x f (Either b d) -> f (Either b d) -> f (Either b d)
forall a. f a -> f a -> f a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> d -> Either b d
forall a b. b -> Either a b
Right (d -> Either b d) -> f d -> f (Either b d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f d
y)
  optionalP :: forall a b. Joker f a b -> Joker f (Maybe a) (Maybe b)
optionalP (Joker f b
x) = f (Maybe b) -> Joker f (Maybe a) (Maybe b)
forall {k} {k1} (g :: k -> *) (a :: k1) (b :: k).
g b -> Joker g a b
Joker (f b -> f (Maybe b)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional f b
x)
  manyP :: forall a b. Joker f a b -> Joker f [a] [b]
manyP (Joker f b
x) = f [b] -> Joker f [a] [b]
forall {k} {k1} (g :: k -> *) (a :: k1) (b :: k).
g b -> Joker g a b
Joker (f b -> f [b]
forall a. f a -> f [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many f b
x)
instance (Distributor p, Applicative f)
  => Distributor (WrappedPafb f p) where
    zeroP :: WrappedPafb f p Void Void
zeroP = p Void (f Void) -> WrappedPafb f p Void Void
forall (f :: * -> *) (p :: * -> * -> *) a b.
p a (f b) -> WrappedPafb f p a b
WrapPafb ((Void -> f Void) -> p Void Void -> p Void (f Void)
forall b c a. (b -> c) -> p a b -> p a c
forall (p :: * -> * -> *) b c a.
Profunctor p =>
(b -> c) -> p a b -> p a c
rmap Void -> f Void
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure p Void Void
forall (p :: * -> * -> *). Distributor p => p Void Void
zeroP)
    WrapPafb p a (f b)
x >+< :: forall a b c d.
WrappedPafb f p a b
-> WrappedPafb f p c d -> WrappedPafb f p (Either a c) (Either b d)
>+< WrapPafb p c (f d)
y = p (Either a c) (f (Either b d))
-> WrappedPafb f p (Either a c) (Either b d)
forall (f :: * -> *) (p :: * -> * -> *) a b.
p a (f b) -> WrappedPafb f p a b
WrapPafb (p (Either a c) (f (Either b d))
 -> WrappedPafb f p (Either a c) (Either b d))
-> p (Either a c) (f (Either b d))
-> WrappedPafb f p (Either a c) (Either b d)
forall a b. (a -> b) -> a -> b
$
      (Either a c -> Either a c)
-> (f b -> f (Either b d))
-> (f d -> f (Either b d))
-> p a (f b)
-> p c (f d)
-> p (Either a c) (f (Either b d))
forall (p :: * -> * -> *) s a c b t d.
Distributor p =>
(s -> Either a c)
-> (b -> t) -> (d -> t) -> p a b -> p c d -> p s t
dialt Either a c -> Either a c
forall a. a -> a
id ((b -> Either b d) -> f b -> f (Either b d)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> Either b d
forall a b. a -> Either a b
Left) ((d -> Either b d) -> f d -> f (Either b d)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap d -> Either b d
forall a b. b -> Either a b
Right) p a (f b)
x p c (f d)
y
    manyP :: forall a b. WrappedPafb f p a b -> WrappedPafb f p [a] [b]
manyP (WrapPafb p a (f b)
x) = p [a] (f [b]) -> WrappedPafb f p [a] [b]
forall (f :: * -> *) (p :: * -> * -> *) a b.
p a (f b) -> WrappedPafb f p a b
WrapPafb (([f b] -> f [b]) -> p [a] [f b] -> p [a] (f [b])
forall b c a. (b -> c) -> p a b -> p a c
forall (p :: * -> * -> *) b c a.
Profunctor p =>
(b -> c) -> p a b -> p a c
rmap [f b] -> f [b]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA (p a (f b) -> p [a] [f b]
forall a b. p a b -> p [a] [b]
forall (p :: * -> * -> *) a b. Distributor p => p a b -> p [a] [b]
manyP p a (f b)
x))
    optionalP :: forall a b.
WrappedPafb f p a b -> WrappedPafb f p (Maybe a) (Maybe b)
optionalP (WrapPafb p a (f b)
x) = p (Maybe a) (f (Maybe b)) -> WrappedPafb f p (Maybe a) (Maybe b)
forall (f :: * -> *) (p :: * -> * -> *) a b.
p a (f b) -> WrappedPafb f p a b
WrapPafb ((Maybe (f b) -> f (Maybe b))
-> p (Maybe a) (Maybe (f b)) -> p (Maybe a) (f (Maybe b))
forall b c a. (b -> c) -> p a b -> p a c
forall (p :: * -> * -> *) b c a.
Profunctor p =>
(b -> c) -> p a b -> p a c
rmap Maybe (f b) -> f (Maybe b)
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => Maybe (f a) -> f (Maybe a)
sequenceA (p a (f b) -> p (Maybe a) (Maybe (f b))
forall a b. p a b -> p (Maybe a) (Maybe b)
forall (p :: * -> * -> *) a b.
Distributor p =>
p a b -> p (Maybe a) (Maybe b)
optionalP p a (f b)
x))
instance Applicative f => Distributor (Star f) where
  zeroP :: Star f Void Void
zeroP = (Void -> f Void) -> Star f Void Void
forall {k} (f :: k -> *) d (c :: k). (d -> f c) -> Star f d c
Star Void -> f Void
forall a. Void -> a
absurd
  Star a -> f b
f >+< :: forall a b c d.
Star f a b -> Star f c d -> Star f (Either a c) (Either b d)
>+< Star c -> f d
g =
    (Either a c -> f (Either b d)) -> Star f (Either a c) (Either b d)
forall {k} (f :: k -> *) d (c :: k). (d -> f c) -> Star f d c
Star ((a -> f (Either b d))
-> (c -> f (Either b d)) -> Either a c -> f (Either b d)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ((b -> Either b d) -> f b -> f (Either b d)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> Either b d
forall a b. a -> Either a b
Left (f b -> f (Either b d)) -> (a -> f b) -> a -> f (Either b d)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> f b
f) ((d -> Either b d) -> f d -> f (Either b d)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap d -> Either b d
forall a b. b -> Either a b
Right (f d -> f (Either b d)) -> (c -> f d) -> c -> f (Either b d)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> f d
g))
  optionalP :: forall a b. Star f a b -> Star f (Maybe a) (Maybe b)
optionalP (Star a -> f b
f) = (Maybe a -> f (Maybe b)) -> Star f (Maybe a) (Maybe b)
forall {k} (f :: k -> *) d (c :: k). (d -> f c) -> Star f d c
Star ((a -> f b) -> Maybe a -> f (Maybe 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) -> Maybe a -> f (Maybe b)
traverse a -> f b
f)
  manyP :: forall a b. Star f a b -> Star f [a] [b]
manyP (Star a -> f b
f) = ([a] -> f [b]) -> Star f [a] [b]
forall {k} (f :: k -> *) d (c :: k). (d -> f c) -> Star f d c
Star ((a -> f b) -> [a] -> f [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) -> [a] -> f [b]
traverse a -> f b
f)
deriving via (Star m) instance Monad m => Distributor (Kleisli m)
instance Adjunction f u => Distributor (Costar f) where
  zeroP :: Costar f Void Void
zeroP = (f Void -> Void) -> Costar f Void Void
forall {k} (f :: k -> *) (d :: k) c. (f d -> c) -> Costar f d c
Costar f Void -> Void
forall (f :: * -> *) (u :: * -> *).
Adjunction f u =>
f Void -> Void
unabsurdL
  Costar f a -> b
f >+< :: forall a b c d.
Costar f a b -> Costar f c d -> Costar f (Either a c) (Either b d)
>+< Costar f c -> d
g = (f (Either a c) -> Either b d)
-> Costar f (Either a c) (Either b d)
forall {k} (f :: k -> *) (d :: k) c. (f d -> c) -> Costar f d c
Costar ((f a -> b) -> (f c -> d) -> Either (f a) (f c) -> Either b d
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap f a -> b
f f c -> d
g (Either (f a) (f c) -> Either b d)
-> (f (Either a c) -> Either (f a) (f c))
-> f (Either a c)
-> Either b d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Either a c) -> Either (f a) (f c)
forall (f :: * -> *) (u :: * -> *) a b.
Adjunction f u =>
f (Either a b) -> Either (f a) (f b)
cozipL)
instance (Applicative f, Distributor p)
  => Distributor (Cayley f p) where
    zeroP :: Cayley f p Void Void
zeroP = f (p Void Void) -> Cayley f p Void Void
forall {k} {k1} {k2} (f :: k -> *) (p :: k1 -> k2 -> k) (a :: k1)
       (b :: k2).
f (p a b) -> Cayley f p a b
Cayley (p Void Void -> f (p Void Void)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure p Void Void
forall (p :: * -> * -> *). Distributor p => p Void Void
zeroP)
    Cayley f (p a b)
x >+< :: forall a b c d.
Cayley f p a b
-> Cayley f p c d -> Cayley f p (Either a c) (Either b d)
>+< Cayley f (p c d)
y = f (p (Either a c) (Either b d))
-> Cayley f p (Either a c) (Either b d)
forall {k} {k1} {k2} (f :: k -> *) (p :: k1 -> k2 -> k) (a :: k1)
       (b :: k2).
f (p a b) -> Cayley f p a b
Cayley (p a b -> p c d -> p (Either a c) (Either b d)
forall a b c d. p a b -> p c d -> p (Either a c) (Either b d)
forall (p :: * -> * -> *) a b c d.
Distributor p =>
p a b -> p c d -> p (Either a c) (Either b d)
(>+<) (p a b -> p c d -> p (Either a c) (Either b d))
-> f (p a b) -> f (p c d -> p (Either a c) (Either b d))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (p a b)
x f (p c d -> p (Either a c) (Either b d))
-> f (p c d) -> f (p (Either a c) (Either b d))
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f (p c d)
y)
    optionalP :: forall a b. Cayley f p a b -> Cayley f p (Maybe a) (Maybe b)
optionalP (Cayley f (p a b)
x) = f (p (Maybe a) (Maybe b)) -> Cayley f p (Maybe a) (Maybe b)
forall {k} {k1} {k2} (f :: k -> *) (p :: k1 -> k2 -> k) (a :: k1)
       (b :: k2).
f (p a b) -> Cayley f p a b
Cayley (p a b -> p (Maybe a) (Maybe b)
forall a b. p a b -> p (Maybe a) (Maybe b)
forall (p :: * -> * -> *) a b.
Distributor p =>
p a b -> p (Maybe a) (Maybe b)
optionalP (p a b -> p (Maybe a) (Maybe b))
-> f (p a b) -> f (p (Maybe a) (Maybe b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (p a b)
x)
    manyP :: forall a b. Cayley f p a b -> Cayley f p [a] [b]
manyP (Cayley f (p a b)
x) = f (p [a] [b]) -> Cayley f p [a] [b]
forall {k} {k1} {k2} (f :: k -> *) (p :: k1 -> k2 -> k) (a :: k1)
       (b :: k2).
f (p a b) -> Cayley f p a b
Cayley (p a b -> p [a] [b]
forall a b. p a b -> p [a] [b]
forall (p :: * -> * -> *) a b. Distributor p => p a b -> p [a] [b]
manyP (p a b -> p [a] [b]) -> f (p a b) -> f (p [a] [b])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (p a b)
x)
instance (ArrowZero p, ArrowChoice p)
  => Distributor (Pro.WrappedArrow p) where
    zeroP :: WrappedArrow p Void Void
zeroP = WrappedArrow p Void Void
forall b c. WrappedArrow p b c
forall (a :: * -> * -> *) b c. ArrowZero a => a b c
zeroArrow
    >+< :: forall a b c d.
WrappedArrow p a b
-> WrappedArrow p c d -> WrappedArrow p (Either a c) (Either b d)
(>+<) = WrappedArrow p a b
-> WrappedArrow p c d -> WrappedArrow p (Either a c) (Either b d)
forall a b c d.
WrappedArrow p a b
-> WrappedArrow p c d -> WrappedArrow p (Either a c) (Either b d)
forall (a :: * -> * -> *) b c b' c'.
ArrowChoice a =>
a b c -> a b' c' -> a (Either b b') (Either c c')
(+++)
deriving via (Pro.WrappedArrow p)
  instance (ArrowZero p, ArrowChoice p)
    => Distributor (Ap.WrappedArrow p)
instance (Distributor p, Distributor q)
  => Distributor (Procompose p q) where
    zeroP :: Procompose p q Void Void
zeroP = p Void Void -> q Void Void -> Procompose p q Void Void
forall {k} {k1} {k2} (p :: k -> k1 -> *) (x :: k) (c :: k1)
       (q :: k2 -> k -> *) (d :: k2).
p x c -> q d x -> Procompose p q d c
Procompose p Void Void
forall (p :: * -> * -> *). Distributor p => p Void Void
zeroP q Void Void
forall (p :: * -> * -> *). Distributor p => p Void Void
zeroP
    Procompose p x b
xL q a x
yL >+< :: forall a b c d.
Procompose p q a b
-> Procompose p q c d -> Procompose p q (Either a c) (Either b d)
>+< Procompose p x d
xR q c x
yR =
      p (Either x x) (Either b d)
-> q (Either a c) (Either x x)
-> Procompose p q (Either a c) (Either b d)
forall {k} {k1} {k2} (p :: k -> k1 -> *) (x :: k) (c :: k1)
       (q :: k2 -> k -> *) (d :: k2).
p x c -> q d x -> Procompose p q d c
Procompose (p x b
xL p x b -> p x d -> p (Either x x) (Either b d)
forall a b c d. p a b -> p c d -> p (Either a c) (Either b d)
forall (p :: * -> * -> *) a b c d.
Distributor p =>
p a b -> p c d -> p (Either a c) (Either b d)
>+< p x d
xR) (q a x
yL q a x -> q c x -> q (Either a c) (Either x x)
forall a b c d. q a b -> q c d -> q (Either a c) (Either b d)
forall (p :: * -> * -> *) a b c d.
Distributor p =>
p a b -> p c d -> p (Either a c) (Either b d)
>+< q c x
yR)
    optionalP :: forall a b.
Procompose p q a b -> Procompose p q (Maybe a) (Maybe b)
optionalP (Procompose p x b
f q a x
g) =
      p (Maybe x) (Maybe b)
-> q (Maybe a) (Maybe x) -> Procompose p q (Maybe a) (Maybe b)
forall {k} {k1} {k2} (p :: k -> k1 -> *) (x :: k) (c :: k1)
       (q :: k2 -> k -> *) (d :: k2).
p x c -> q d x -> Procompose p q d c
Procompose (p x b -> p (Maybe x) (Maybe b)
forall a b. p a b -> p (Maybe a) (Maybe b)
forall (p :: * -> * -> *) a b.
Distributor p =>
p a b -> p (Maybe a) (Maybe b)
optionalP p x b
f) (q a x -> q (Maybe a) (Maybe x)
forall a b. q a b -> q (Maybe a) (Maybe b)
forall (p :: * -> * -> *) a b.
Distributor p =>
p a b -> p (Maybe a) (Maybe b)
optionalP q a x
g)
    manyP :: forall a b. Procompose p q a b -> Procompose p q [a] [b]
manyP (Procompose p x b
f q a x
g) =
      p [x] [b] -> q [a] [x] -> Procompose p q [a] [b]
forall {k} {k1} {k2} (p :: k -> k1 -> *) (x :: k) (c :: k1)
       (q :: k2 -> k -> *) (d :: k2).
p x c -> q d x -> Procompose p q d c
Procompose (p x b -> p [x] [b]
forall a b. p a b -> p [a] [b]
forall (p :: * -> * -> *) a b. Distributor p => p a b -> p [a] [b]
manyP p x b
f) (q a x -> q [a] [x]
forall a b. q a b -> q [a] [b]
forall (p :: * -> * -> *) a b. Distributor p => p a b -> p [a] [b]
manyP q a x
g)
instance (Distributor p, Distributor q)
  => Distributor (Product p q) where
    zeroP :: Product p q Void Void
zeroP = p Void Void -> q Void Void -> Product p q Void Void
forall {k} {k1} (f :: k -> k1 -> *) (g :: k -> k1 -> *) (a :: k)
       (b :: k1).
f a b -> g a b -> Product f g a b
Pair p Void Void
forall (p :: * -> * -> *). Distributor p => p Void Void
zeroP q Void Void
forall (p :: * -> * -> *). Distributor p => p Void Void
zeroP
    Pair p a b
x0 q a b
y0 >+< :: forall a b c d.
Product p q a b
-> Product p q c d -> Product p q (Either a c) (Either b d)
>+< Pair p c d
x1 q c d
y1 = p (Either a c) (Either b d)
-> q (Either a c) (Either b d)
-> Product p q (Either a c) (Either b d)
forall {k} {k1} (f :: k -> k1 -> *) (g :: k -> k1 -> *) (a :: k)
       (b :: k1).
f a b -> g a b -> Product f g a b
Pair (p a b
x0 p a b -> p c d -> p (Either a c) (Either b d)
forall a b c d. p a b -> p c d -> p (Either a c) (Either b d)
forall (p :: * -> * -> *) a b c d.
Distributor p =>
p a b -> p c d -> p (Either a c) (Either b d)
>+< p c d
x1) (q a b
y0 q a b -> q c d -> q (Either a c) (Either b d)
forall a b c d. q a b -> q c d -> q (Either a c) (Either b d)
forall (p :: * -> * -> *) a b c d.
Distributor p =>
p a b -> p c d -> p (Either a c) (Either b d)
>+< q c d
y1)
    optionalP :: forall a b. Product p q a b -> Product p q (Maybe a) (Maybe b)
optionalP (Pair p a b
f q a b
g) =
      p (Maybe a) (Maybe b)
-> q (Maybe a) (Maybe b) -> Product p q (Maybe a) (Maybe b)
forall {k} {k1} (f :: k -> k1 -> *) (g :: k -> k1 -> *) (a :: k)
       (b :: k1).
f a b -> g a b -> Product f g a b
Pair (p a b -> p (Maybe a) (Maybe b)
forall a b. p a b -> p (Maybe a) (Maybe b)
forall (p :: * -> * -> *) a b.
Distributor p =>
p a b -> p (Maybe a) (Maybe b)
optionalP p a b
f) (q a b -> q (Maybe a) (Maybe b)
forall a b. q a b -> q (Maybe a) (Maybe b)
forall (p :: * -> * -> *) a b.
Distributor p =>
p a b -> p (Maybe a) (Maybe b)
optionalP q a b
g)
    manyP :: forall a b. Product p q a b -> Product p q [a] [b]
manyP (Pair p a b
f q a b
g) =
      p [a] [b] -> q [a] [b] -> Product p q [a] [b]
forall {k} {k1} (f :: k -> k1 -> *) (g :: k -> k1 -> *) (a :: k)
       (b :: k1).
f a b -> g a b -> Product f g a b
Pair (p a b -> p [a] [b]
forall a b. p a b -> p [a] [b]
forall (p :: * -> * -> *) a b. Distributor p => p a b -> p [a] [b]
manyP p a b
f) (q a b -> q [a] [b]
forall a b. q a b -> q [a] [b]
forall (p :: * -> * -> *) a b. Distributor p => p a b -> p [a] [b]
manyP q a b
g)
instance Distributor p => Distributor (Yoneda p) where
  zeroP :: Yoneda p Void Void
zeroP = p Void Void -> Yoneda p Void Void
p :-> Yoneda p
forall (p :: * -> * -> *). Profunctor p => p :-> Yoneda p
forall (t :: (* -> * -> *) -> * -> * -> *) (p :: * -> * -> *).
(ProfunctorMonad t, Profunctor p) =>
p :-> t p
proreturn p Void Void
forall (p :: * -> * -> *). Distributor p => p Void Void
zeroP
  Yoneda p a b
ab >+< :: forall a b c d.
Yoneda p a b -> Yoneda p c d -> Yoneda p (Either a c) (Either b d)
>+< Yoneda p c d
cd = p (Either a c) (Either b d) -> Yoneda p (Either a c) (Either b d)
p :-> Yoneda p
forall (p :: * -> * -> *). Profunctor p => p :-> Yoneda p
forall (t :: (* -> * -> *) -> * -> * -> *) (p :: * -> * -> *).
(ProfunctorMonad t, Profunctor p) =>
p :-> t p
proreturn (Yoneda p a b -> p a b
Yoneda p :-> p
forall (p :: * -> * -> *). Profunctor p => Yoneda p :-> p
forall (t :: (* -> * -> *) -> * -> * -> *) (p :: * -> * -> *).
(ProfunctorComonad t, Profunctor p) =>
t p :-> p
proextract Yoneda p a b
ab p a b -> p c d -> p (Either a c) (Either b d)
forall a b c d. p a b -> p c d -> p (Either a c) (Either b d)
forall (p :: * -> * -> *) a b c d.
Distributor p =>
p a b -> p c d -> p (Either a c) (Either b d)
>+< Yoneda p c d -> p c d
Yoneda p :-> p
forall (p :: * -> * -> *). Profunctor p => Yoneda p :-> p
forall (t :: (* -> * -> *) -> * -> * -> *) (p :: * -> * -> *).
(ProfunctorComonad t, Profunctor p) =>
t p :-> p
proextract Yoneda p c d
cd)
  optionalP :: forall a b. Yoneda p a b -> Yoneda p (Maybe a) (Maybe b)
optionalP = p (Maybe a) (Maybe b) -> Yoneda p (Maybe a) (Maybe b)
p :-> Yoneda p
forall (p :: * -> * -> *). Profunctor p => p :-> Yoneda p
forall (t :: (* -> * -> *) -> * -> * -> *) (p :: * -> * -> *).
(ProfunctorMonad t, Profunctor p) =>
p :-> t p
proreturn (p (Maybe a) (Maybe b) -> Yoneda p (Maybe a) (Maybe b))
-> (Yoneda p a b -> p (Maybe a) (Maybe b))
-> Yoneda p a b
-> Yoneda p (Maybe a) (Maybe b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p a b -> p (Maybe a) (Maybe b)
forall a b. p a b -> p (Maybe a) (Maybe b)
forall (p :: * -> * -> *) a b.
Distributor p =>
p a b -> p (Maybe a) (Maybe b)
optionalP (p a b -> p (Maybe a) (Maybe b))
-> (Yoneda p a b -> p a b) -> Yoneda p a b -> p (Maybe a) (Maybe b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Yoneda p a b -> p a b
Yoneda p :-> p
forall (p :: * -> * -> *). Profunctor p => Yoneda p :-> p
forall (t :: (* -> * -> *) -> * -> * -> *) (p :: * -> * -> *).
(ProfunctorComonad t, Profunctor p) =>
t p :-> p
proextract
  manyP :: forall a b. Yoneda p a b -> Yoneda p [a] [b]
manyP = p [a] [b] -> Yoneda p [a] [b]
p :-> Yoneda p
forall (p :: * -> * -> *). Profunctor p => p :-> Yoneda p
forall (t :: (* -> * -> *) -> * -> * -> *) (p :: * -> * -> *).
(ProfunctorMonad t, Profunctor p) =>
p :-> t p
proreturn (p [a] [b] -> Yoneda p [a] [b])
-> (Yoneda p a b -> p [a] [b]) -> Yoneda p a b -> Yoneda p [a] [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p a b -> p [a] [b]
forall a b. p a b -> p [a] [b]
forall (p :: * -> * -> *) a b. Distributor p => p a b -> p [a] [b]
manyP (p a b -> p [a] [b])
-> (Yoneda p a b -> p a b) -> Yoneda p a b -> p [a] [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Yoneda p a b -> p a b
Yoneda p :-> p
forall (p :: * -> * -> *). Profunctor p => Yoneda p :-> p
forall (t :: (* -> * -> *) -> * -> * -> *) (p :: * -> * -> *).
(ProfunctorComonad t, Profunctor p) =>
t p :-> p
proextract
instance Distributor p => Distributor (Coyoneda p) where
  zeroP :: Coyoneda p Void Void
zeroP = p Void Void -> Coyoneda p Void Void
p :-> Coyoneda p
forall (p :: * -> * -> *). Profunctor p => p :-> Coyoneda p
forall (t :: (* -> * -> *) -> * -> * -> *) (p :: * -> * -> *).
(ProfunctorMonad t, Profunctor p) =>
p :-> t p
proreturn p Void Void
forall (p :: * -> * -> *). Distributor p => p Void Void
zeroP
  Coyoneda p a b
ab >+< :: forall a b c d.
Coyoneda p a b
-> Coyoneda p c d -> Coyoneda p (Either a c) (Either b d)
>+< Coyoneda p c d
cd = p (Either a c) (Either b d) -> Coyoneda p (Either a c) (Either b d)
p :-> Coyoneda p
forall (p :: * -> * -> *). Profunctor p => p :-> Coyoneda p
forall (t :: (* -> * -> *) -> * -> * -> *) (p :: * -> * -> *).
(ProfunctorMonad t, Profunctor p) =>
p :-> t p
proreturn (Coyoneda p a b -> p a b
Coyoneda p :-> p
forall (p :: * -> * -> *). Profunctor p => Coyoneda p :-> p
forall (t :: (* -> * -> *) -> * -> * -> *) (p :: * -> * -> *).
(ProfunctorComonad t, Profunctor p) =>
t p :-> p
proextract Coyoneda p a b
ab p a b -> p c d -> p (Either a c) (Either b d)
forall a b c d. p a b -> p c d -> p (Either a c) (Either b d)
forall (p :: * -> * -> *) a b c d.
Distributor p =>
p a b -> p c d -> p (Either a c) (Either b d)
>+< Coyoneda p c d -> p c d
Coyoneda p :-> p
forall (p :: * -> * -> *). Profunctor p => Coyoneda p :-> p
forall (t :: (* -> * -> *) -> * -> * -> *) (p :: * -> * -> *).
(ProfunctorComonad t, Profunctor p) =>
t p :-> p
proextract Coyoneda p c d
cd)
  optionalP :: forall a b. Coyoneda p a b -> Coyoneda p (Maybe a) (Maybe b)
optionalP = p (Maybe a) (Maybe b) -> Coyoneda p (Maybe a) (Maybe b)
p :-> Coyoneda p
forall (p :: * -> * -> *). Profunctor p => p :-> Coyoneda p
forall (t :: (* -> * -> *) -> * -> * -> *) (p :: * -> * -> *).
(ProfunctorMonad t, Profunctor p) =>
p :-> t p
proreturn (p (Maybe a) (Maybe b) -> Coyoneda p (Maybe a) (Maybe b))
-> (Coyoneda p a b -> p (Maybe a) (Maybe b))
-> Coyoneda p a b
-> Coyoneda p (Maybe a) (Maybe b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p a b -> p (Maybe a) (Maybe b)
forall a b. p a b -> p (Maybe a) (Maybe b)
forall (p :: * -> * -> *) a b.
Distributor p =>
p a b -> p (Maybe a) (Maybe b)
optionalP (p a b -> p (Maybe a) (Maybe b))
-> (Coyoneda p a b -> p a b)
-> Coyoneda p a b
-> p (Maybe a) (Maybe b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coyoneda p a b -> p a b
Coyoneda p :-> p
forall (p :: * -> * -> *). Profunctor p => Coyoneda p :-> p
forall (t :: (* -> * -> *) -> * -> * -> *) (p :: * -> * -> *).
(ProfunctorComonad t, Profunctor p) =>
t p :-> p
proextract
  manyP :: forall a b. Coyoneda p a b -> Coyoneda p [a] [b]
manyP = p [a] [b] -> Coyoneda p [a] [b]
p :-> Coyoneda p
forall (p :: * -> * -> *). Profunctor p => p :-> Coyoneda p
forall (t :: (* -> * -> *) -> * -> * -> *) (p :: * -> * -> *).
(ProfunctorMonad t, Profunctor p) =>
p :-> t p
proreturn (p [a] [b] -> Coyoneda p [a] [b])
-> (Coyoneda p a b -> p [a] [b])
-> Coyoneda p a b
-> Coyoneda p [a] [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p a b -> p [a] [b]
forall a b. p a b -> p [a] [b]
forall (p :: * -> * -> *) a b. Distributor p => p a b -> p [a] [b]
manyP (p a b -> p [a] [b])
-> (Coyoneda p a b -> p a b) -> Coyoneda p a b -> p [a] [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coyoneda p a b -> p a b
Coyoneda p :-> p
forall (p :: * -> * -> *). Profunctor p => Coyoneda p :-> p
forall (t :: (* -> * -> *) -> * -> * -> *) (p :: * -> * -> *).
(ProfunctorComonad t, Profunctor p) =>
t p :-> p
proextract

{- | `dialt` is a functionalized form of `>+<`. -}
dialt
  :: Distributor p
  => (s -> Either a c)
  -> (b -> t)
  -> (d -> t)
  -> p a b -> p c d -> p s t
dialt :: forall (p :: * -> * -> *) s a c b t d.
Distributor p =>
(s -> Either a c)
-> (b -> t) -> (d -> t) -> p a b -> p c d -> p s t
dialt s -> Either a c
f b -> t
g d -> t
h p a b
p p c d
q = (s -> Either a c)
-> (Either b d -> t) -> p (Either a c) (Either b d) -> p s t
forall a b c d. (a -> b) -> (c -> d) -> p b c -> p a d
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap s -> Either a c
f ((b -> t) -> (d -> t) -> Either b d -> t
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either b -> t
g d -> t
h) (p a b
p p a b -> p c d -> p (Either a c) (Either b d)
forall a b c d. p a b -> p c d -> p (Either a c) (Either b d)
forall (p :: * -> * -> *) a b c d.
Distributor p =>
p a b -> p c d -> p (Either a c) (Either b d)
>+< p c d
q)

-- Alternator --

{- | The `Alternator` class co-extends `Choice` and `Distributor`,
as well as `Alternative`, adding the `alternate` method,
which is a lax monoidal structure morphism on sums,
and methods `someP` & `optionP`,
with these these laws relating them.

prop> left' = alternate . Left
prop> right' = alternate . Right
prop> zeroP = empty
prop> x >+< y = alternate (Left x) <|> alternate (Right y)
prop> manyP p = optionP _Empty (someP p)
prop> optionalP p = optionP _Nothing (_Just >? p)
prop> someP p = p >:< manyP p

For the case of `Functor`s, the analog of `alternate` can be defined
without any other constraint, but the case of `Profunctor`s turns
out to be slighly more complex, necessitating `Alternator`.

>>> :{
alternateF :: Functor f => Either (f a) (f b) -> f (Either a b)
alternateF = either (fmap Left) (fmap Right)
:}

Not all `Distributor`s are `Alternator`s, in particular @(->)@ is
a `Distributor` but cannot be `Alternative`,
because there is no general polymorphic function @empty :: a -> b@,
so @(->)@ isn't an `Alternator`.

-}
class (Choice p, Distributor p, forall x. Alternative (p x))
  => Alternator p where

    {- | The structure morphism for an `Alternator`,
    `alternate` has a default for `Choice` & `Cochoice` partial distributors.
    -}
    alternate
      :: Either (p a b) (p c d)
      -> p (Either a c) (Either b d)
    default alternate
      :: Cochoice p
      => Either (p a b) (p c d)
      -> p (Either a c) (Either b d)
    alternate =
      (Either a c -> Maybe a)
-> (b -> Maybe (Either b d))
-> p a b
-> p (Either a c) (Either b d)
forall (p :: * -> * -> *) s a b t.
(Choice p, Cochoice p) =>
(s -> Maybe a) -> (b -> Maybe t) -> p a b -> p s t
dimapMaybe ((a -> Maybe a) -> (c -> Maybe a) -> Either a c -> Maybe a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either a -> Maybe a
forall a. a -> Maybe a
Just (Maybe a -> c -> Maybe a
forall a. a -> c -> a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing)) (Either b d -> Maybe (Either b d)
forall a. a -> Maybe a
Just (Either b d -> Maybe (Either b d))
-> (b -> Either b d) -> b -> Maybe (Either b d)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Either b d
forall a b. a -> Either a b
Left)
      (p a b -> p (Either a c) (Either b d))
-> (p c d -> p (Either a c) (Either b d))
-> Either (p a b) (p c d)
-> p (Either a c) (Either b d)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
forall (a :: * -> * -> *) b d c.
ArrowChoice a =>
a b d -> a c d -> a (Either b c) d
|||
      (Either a c -> Maybe c)
-> (d -> Maybe (Either b d))
-> p c d
-> p (Either a c) (Either b d)
forall (p :: * -> * -> *) s a b t.
(Choice p, Cochoice p) =>
(s -> Maybe a) -> (b -> Maybe t) -> p a b -> p s t
dimapMaybe ((a -> Maybe c) -> (c -> Maybe c) -> Either a c -> Maybe c
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe c -> a -> Maybe c
forall a. a -> a -> a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe c
forall a. Maybe a
Nothing) c -> Maybe c
forall a. a -> Maybe a
Just) (Either b d -> Maybe (Either b d)
forall a. a -> Maybe a
Just (Either b d -> Maybe (Either b d))
-> (d -> Either b d) -> d -> Maybe (Either b d)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. d -> Either b d
forall a b. b -> Either a b
Right)

    {- | One or more. -}
    someP :: p a b -> p [a] [b]
    someP p a b
x = p a b
x p a b -> p [a] [b] -> p [a] [b]
forall s t a b (p :: * -> * -> *).
(Cons s t a b, Monoidal p, Choice p) =>
p a b -> p s t -> p s t
>:< p a b -> p [a] [b]
forall a b. p a b -> p [a] [b]
forall (p :: * -> * -> *) a b. Distributor p => p a b -> p [a] [b]
manyP p a b
x

    {- | One or zero-with-default. -}
    optionP :: APrism a b () () {- ^ default -} -> p a b -> p a b
    optionP APrism a b () ()
def p a b
p = p a b
p p a b -> p a b -> p a b
forall a. p a a -> p a a -> p a a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> APrism a b () () -> p a b
forall (p :: * -> * -> *) a b.
(Monoidal p, Choice p) =>
APrism a b () () -> p a b
pureP APrism a b () ()
def

-- | Combines all `Alternative` choices in the specified list.
choice :: (Foldable f, Alternative p) => f (p a) -> p a
choice :: forall (f :: * -> *) (p :: * -> *) a.
(Foldable f, Alternative p) =>
f (p a) -> p a
choice = (p a -> p a -> p a) -> p a -> f (p a) -> p a
forall b a. (b -> a -> b) -> b -> f a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' p a -> p a -> p a
forall a. p a -> p a -> p a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) p a
forall a. p a
forall (f :: * -> *) a. Alternative f => f a
empty

instance (Alternator p, Applicative f)
  => Alternator (WrappedPafb f p) where
    alternate :: forall a b c d.
Either (WrappedPafb f p a b) (WrappedPafb f p c d)
-> WrappedPafb f p (Either a c) (Either b d)
alternate =
      let
        f :: WrappedPafb f p a a -> WrappedPafb f p (Either a c) (Either a b)
f = p (Either a c) (f (Either a b))
-> WrappedPafb f p (Either a c) (Either a b)
forall (f :: * -> *) (p :: * -> * -> *) a b.
p a (f b) -> WrappedPafb f p a b
WrapPafb
          (p (Either a c) (f (Either a b))
 -> WrappedPafb f p (Either a c) (Either a b))
-> (WrappedPafb f p a a -> p (Either a c) (f (Either a b)))
-> WrappedPafb f p a a
-> WrappedPafb f p (Either a c) (Either a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either (f a) (Either a b) -> f (Either a b))
-> p (Either a c) (Either (f a) (Either a b))
-> p (Either a c) (f (Either a b))
forall b c a. (b -> c) -> p a b -> p a c
forall (p :: * -> * -> *) b c a.
Profunctor p =>
(b -> c) -> p a b -> p a c
rmap ((f a -> f (Either a b))
-> (Either a b -> f (Either a b))
-> Either (f a) (Either a b)
-> f (Either a b)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ((a -> Either a b) -> f a -> f (Either a b)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Either a b
forall a b. a -> Either a b
Left) Either a b -> f (Either a b)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure)
          (p (Either a c) (Either (f a) (Either a b))
 -> p (Either a c) (f (Either a b)))
-> (WrappedPafb f p a a
    -> p (Either a c) (Either (f a) (Either a b)))
-> WrappedPafb f p a a
-> p (Either a c) (f (Either a b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either (p a (f a)) (p c (Either a b))
-> p (Either a c) (Either (f a) (Either a b))
forall a b c d.
Either (p a b) (p c d) -> p (Either a c) (Either b d)
forall (p :: * -> * -> *) a b c d.
Alternator p =>
Either (p a b) (p c d) -> p (Either a c) (Either b d)
alternate
          (Either (p a (f a)) (p c (Either a b))
 -> p (Either a c) (Either (f a) (Either a b)))
-> (WrappedPafb f p a a -> Either (p a (f a)) (p c (Either a b)))
-> WrappedPafb f p a a
-> p (Either a c) (Either (f a) (Either a b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p a (f a) -> Either (p a (f a)) (p c (Either a b))
forall a b. a -> Either a b
Left
          (p a (f a) -> Either (p a (f a)) (p c (Either a b)))
-> (WrappedPafb f p a a -> p a (f a))
-> WrappedPafb f p a a
-> Either (p a (f a)) (p c (Either a b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WrappedPafb f p a a -> p a (f a)
forall (f :: * -> *) (p :: * -> * -> *) a b.
WrappedPafb f p a b -> p a (f b)
unwrapPafb
        g :: WrappedPafb f p c b -> WrappedPafb f p (Either a c) (Either a b)
g = p (Either a c) (f (Either a b))
-> WrappedPafb f p (Either a c) (Either a b)
forall (f :: * -> *) (p :: * -> * -> *) a b.
p a (f b) -> WrappedPafb f p a b
WrapPafb
          (p (Either a c) (f (Either a b))
 -> WrappedPafb f p (Either a c) (Either a b))
-> (WrappedPafb f p c b -> p (Either a c) (f (Either a b)))
-> WrappedPafb f p c b
-> WrappedPafb f p (Either a c) (Either a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either (Either a b) (f b) -> f (Either a b))
-> p (Either a c) (Either (Either a b) (f b))
-> p (Either a c) (f (Either a b))
forall b c a. (b -> c) -> p a b -> p a c
forall (p :: * -> * -> *) b c a.
Profunctor p =>
(b -> c) -> p a b -> p a c
rmap ((Either a b -> f (Either a b))
-> (f b -> f (Either a b))
-> Either (Either a b) (f b)
-> f (Either a b)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Either a b -> f (Either a b)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((b -> Either a b) -> f b -> f (Either a b)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> Either a b
forall a b. b -> Either a b
Right))
          (p (Either a c) (Either (Either a b) (f b))
 -> p (Either a c) (f (Either a b)))
-> (WrappedPafb f p c b
    -> p (Either a c) (Either (Either a b) (f b)))
-> WrappedPafb f p c b
-> p (Either a c) (f (Either a b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either (p a (Either a b)) (p c (f b))
-> p (Either a c) (Either (Either a b) (f b))
forall a b c d.
Either (p a b) (p c d) -> p (Either a c) (Either b d)
forall (p :: * -> * -> *) a b c d.
Alternator p =>
Either (p a b) (p c d) -> p (Either a c) (Either b d)
alternate
          (Either (p a (Either a b)) (p c (f b))
 -> p (Either a c) (Either (Either a b) (f b)))
-> (WrappedPafb f p c b -> Either (p a (Either a b)) (p c (f b)))
-> WrappedPafb f p c b
-> p (Either a c) (Either (Either a b) (f b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p c (f b) -> Either (p a (Either a b)) (p c (f b))
forall a b. b -> Either a b
Right
          (p c (f b) -> Either (p a (Either a b)) (p c (f b)))
-> (WrappedPafb f p c b -> p c (f b))
-> WrappedPafb f p c b
-> Either (p a (Either a b)) (p c (f b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WrappedPafb f p c b -> p c (f b)
forall (f :: * -> *) (p :: * -> * -> *) a b.
WrappedPafb f p a b -> p a (f b)
unwrapPafb
      in
        (WrappedPafb f p a b -> WrappedPafb f p (Either a c) (Either b d))
-> (WrappedPafb f p c d
    -> WrappedPafb f p (Either a c) (Either b d))
-> Either (WrappedPafb f p a b) (WrappedPafb f p c d)
-> WrappedPafb f p (Either a c) (Either b d)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either WrappedPafb f p a b -> WrappedPafb f p (Either a c) (Either b d)
forall {a} {a} {c} {b}.
WrappedPafb f p a a -> WrappedPafb f p (Either a c) (Either a b)
f WrappedPafb f p c d -> WrappedPafb f p (Either a c) (Either b d)
forall {c} {b} {a} {a}.
WrappedPafb f p c b -> WrappedPafb f p (Either a c) (Either a b)
g
    someP :: forall a b. WrappedPafb f p a b -> WrappedPafb f p [a] [b]
someP (WrapPafb p a (f b)
x) = p [a] (f [b]) -> WrappedPafb f p [a] [b]
forall (f :: * -> *) (p :: * -> * -> *) a b.
p a (f b) -> WrappedPafb f p a b
WrapPafb (([f b] -> f [b]) -> p [a] [f b] -> p [a] (f [b])
forall b c a. (b -> c) -> p a b -> p a c
forall (p :: * -> * -> *) b c a.
Profunctor p =>
(b -> c) -> p a b -> p a c
rmap [f b] -> f [b]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA (p a (f b) -> p [a] [f b]
forall a b. p a b -> p [a] [b]
forall (p :: * -> * -> *) a b. Alternator p => p a b -> p [a] [b]
someP p a (f b)
x))
    optionP :: forall a b.
APrism a b () () -> WrappedPafb f p a b -> WrappedPafb f p a b
optionP APrism a b () ()
def (WrapPafb p a (f b)
x) = p a (f b) -> WrappedPafb f p a b
forall (f :: * -> *) (p :: * -> * -> *) a b.
p a (f b) -> WrappedPafb f p a b
WrapPafb (APrism a (f b) () () -> p a (f b) -> p a (f b)
forall a b. APrism a b () () -> p a b -> p a b
forall (p :: * -> * -> *) a b.
Alternator p =>
APrism a b () () -> p a b -> p a b
optionP ((b -> f b) -> (a -> Either (f b) a) -> Prism a (f b) a b
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism b -> f b
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a -> Either (f b) a
forall a. a -> Either (f b) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Market () () a (Identity b) -> Market () () a (Identity (f b)))
-> APrism a b () () -> APrism a (f b) () ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. APrism a b () ()
def) p a (f b)
x)
instance Alternator p => Alternator (Coyoneda p) where
  alternate :: forall a b c d.
Either (Coyoneda p a b) (Coyoneda p c d)
-> Coyoneda p (Either a c) (Either b d)
alternate (Left Coyoneda p a b
p) = p (Either a c) (Either b d) -> Coyoneda p (Either a c) (Either b d)
p :-> Coyoneda p
forall (p :: * -> * -> *). Profunctor p => p :-> Coyoneda p
forall (t :: (* -> * -> *) -> * -> * -> *) (p :: * -> * -> *).
(ProfunctorMonad t, Profunctor p) =>
p :-> t p
proreturn (Either (p a b) (p c d) -> p (Either a c) (Either b d)
forall a b c d.
Either (p a b) (p c d) -> p (Either a c) (Either b d)
forall (p :: * -> * -> *) a b c d.
Alternator p =>
Either (p a b) (p c d) -> p (Either a c) (Either b d)
alternate (p a b -> Either (p a b) (p c d)
forall a b. a -> Either a b
Left (Coyoneda p a b -> p a b
Coyoneda p :-> p
forall (p :: * -> * -> *). Profunctor p => Coyoneda p :-> p
forall (t :: (* -> * -> *) -> * -> * -> *) (p :: * -> * -> *).
(ProfunctorComonad t, Profunctor p) =>
t p :-> p
proextract Coyoneda p a b
p)))
  alternate (Right Coyoneda p c d
p) = p (Either a c) (Either b d) -> Coyoneda p (Either a c) (Either b d)
p :-> Coyoneda p
forall (p :: * -> * -> *). Profunctor p => p :-> Coyoneda p
forall (t :: (* -> * -> *) -> * -> * -> *) (p :: * -> * -> *).
(ProfunctorMonad t, Profunctor p) =>
p :-> t p
proreturn (Either (p a b) (p c d) -> p (Either a c) (Either b d)
forall a b c d.
Either (p a b) (p c d) -> p (Either a c) (Either b d)
forall (p :: * -> * -> *) a b c d.
Alternator p =>
Either (p a b) (p c d) -> p (Either a c) (Either b d)
alternate (p c d -> Either (p a b) (p c d)
forall a b. b -> Either a b
Right (Coyoneda p c d -> p c d
Coyoneda p :-> p
forall (p :: * -> * -> *). Profunctor p => Coyoneda p :-> p
forall (t :: (* -> * -> *) -> * -> * -> *) (p :: * -> * -> *).
(ProfunctorComonad t, Profunctor p) =>
t p :-> p
proextract Coyoneda p c d
p)))
  someP :: forall a b. Coyoneda p a b -> Coyoneda p [a] [b]
someP = p [a] [b] -> Coyoneda p [a] [b]
p :-> Coyoneda p
forall (p :: * -> * -> *). Profunctor p => p :-> Coyoneda p
forall (t :: (* -> * -> *) -> * -> * -> *) (p :: * -> * -> *).
(ProfunctorMonad t, Profunctor p) =>
p :-> t p
proreturn (p [a] [b] -> Coyoneda p [a] [b])
-> (Coyoneda p a b -> p [a] [b])
-> Coyoneda p a b
-> Coyoneda p [a] [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p a b -> p [a] [b]
forall a b. p a b -> p [a] [b]
forall (p :: * -> * -> *) a b. Alternator p => p a b -> p [a] [b]
someP (p a b -> p [a] [b])
-> (Coyoneda p a b -> p a b) -> Coyoneda p a b -> p [a] [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coyoneda p a b -> p a b
Coyoneda p :-> p
forall (p :: * -> * -> *). Profunctor p => Coyoneda p :-> p
forall (t :: (* -> * -> *) -> * -> * -> *) (p :: * -> * -> *).
(ProfunctorComonad t, Profunctor p) =>
t p :-> p
proextract
  optionP :: forall a b. APrism a b () () -> Coyoneda p a b -> Coyoneda p a b
optionP APrism a b () ()
def = p a b -> Coyoneda p a b
p :-> Coyoneda p
forall (p :: * -> * -> *). Profunctor p => p :-> Coyoneda p
forall (t :: (* -> * -> *) -> * -> * -> *) (p :: * -> * -> *).
(ProfunctorMonad t, Profunctor p) =>
p :-> t p
proreturn (p a b -> Coyoneda p a b)
-> (Coyoneda p a b -> p a b) -> Coyoneda p a b -> Coyoneda p a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. APrism a b () () -> p a b -> p a b
forall a b. APrism a b () () -> p a b -> p a b
forall (p :: * -> * -> *) a b.
Alternator p =>
APrism a b () () -> p a b -> p a b
optionP APrism a b () ()
def (p a b -> p a b)
-> (Coyoneda p a b -> p a b) -> Coyoneda p a b -> p a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coyoneda p a b -> p a b
Coyoneda p :-> p
forall (p :: * -> * -> *). Profunctor p => Coyoneda p :-> p
forall (t :: (* -> * -> *) -> * -> * -> *) (p :: * -> * -> *).
(ProfunctorComonad t, Profunctor p) =>
t p :-> p
proextract
instance Alternator p => Alternator (Yoneda p) where
  alternate :: forall a b c d.
Either (Yoneda p a b) (Yoneda p c d)
-> Yoneda p (Either a c) (Either b d)
alternate (Left Yoneda p a b
p) = p (Either a c) (Either b d) -> Yoneda p (Either a c) (Either b d)
p :-> Yoneda p
forall (p :: * -> * -> *). Profunctor p => p :-> Yoneda p
forall (t :: (* -> * -> *) -> * -> * -> *) (p :: * -> * -> *).
(ProfunctorMonad t, Profunctor p) =>
p :-> t p
proreturn (Either (p a b) (p c d) -> p (Either a c) (Either b d)
forall a b c d.
Either (p a b) (p c d) -> p (Either a c) (Either b d)
forall (p :: * -> * -> *) a b c d.
Alternator p =>
Either (p a b) (p c d) -> p (Either a c) (Either b d)
alternate (p a b -> Either (p a b) (p c d)
forall a b. a -> Either a b
Left (Yoneda p a b -> p a b
Yoneda p :-> p
forall (p :: * -> * -> *). Profunctor p => Yoneda p :-> p
forall (t :: (* -> * -> *) -> * -> * -> *) (p :: * -> * -> *).
(ProfunctorComonad t, Profunctor p) =>
t p :-> p
proextract Yoneda p a b
p)))
  alternate (Right Yoneda p c d
p) = p (Either a c) (Either b d) -> Yoneda p (Either a c) (Either b d)
p :-> Yoneda p
forall (p :: * -> * -> *). Profunctor p => p :-> Yoneda p
forall (t :: (* -> * -> *) -> * -> * -> *) (p :: * -> * -> *).
(ProfunctorMonad t, Profunctor p) =>
p :-> t p
proreturn (Either (p a b) (p c d) -> p (Either a c) (Either b d)
forall a b c d.
Either (p a b) (p c d) -> p (Either a c) (Either b d)
forall (p :: * -> * -> *) a b c d.
Alternator p =>
Either (p a b) (p c d) -> p (Either a c) (Either b d)
alternate (p c d -> Either (p a b) (p c d)
forall a b. b -> Either a b
Right (Yoneda p c d -> p c d
Yoneda p :-> p
forall (p :: * -> * -> *). Profunctor p => Yoneda p :-> p
forall (t :: (* -> * -> *) -> * -> * -> *) (p :: * -> * -> *).
(ProfunctorComonad t, Profunctor p) =>
t p :-> p
proextract Yoneda p c d
p)))
  someP :: forall a b. Yoneda p a b -> Yoneda p [a] [b]
someP = p [a] [b] -> Yoneda p [a] [b]
p :-> Yoneda p
forall (p :: * -> * -> *). Profunctor p => p :-> Yoneda p
forall (t :: (* -> * -> *) -> * -> * -> *) (p :: * -> * -> *).
(ProfunctorMonad t, Profunctor p) =>
p :-> t p
proreturn (p [a] [b] -> Yoneda p [a] [b])
-> (Yoneda p a b -> p [a] [b]) -> Yoneda p a b -> Yoneda p [a] [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p a b -> p [a] [b]
forall a b. p a b -> p [a] [b]
forall (p :: * -> * -> *) a b. Alternator p => p a b -> p [a] [b]
someP (p a b -> p [a] [b])
-> (Yoneda p a b -> p a b) -> Yoneda p a b -> p [a] [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Yoneda p a b -> p a b
Yoneda p :-> p
forall (p :: * -> * -> *). Profunctor p => Yoneda p :-> p
forall (t :: (* -> * -> *) -> * -> * -> *) (p :: * -> * -> *).
(ProfunctorComonad t, Profunctor p) =>
t p :-> p
proextract
  optionP :: forall a b. APrism a b () () -> Yoneda p a b -> Yoneda p a b
optionP APrism a b () ()
def = p a b -> Yoneda p a b
p :-> Yoneda p
forall (p :: * -> * -> *). Profunctor p => p :-> Yoneda p
forall (t :: (* -> * -> *) -> * -> * -> *) (p :: * -> * -> *).
(ProfunctorMonad t, Profunctor p) =>
p :-> t p
proreturn (p a b -> Yoneda p a b)
-> (Yoneda p a b -> p a b) -> Yoneda p a b -> Yoneda p a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. APrism a b () () -> p a b -> p a b
forall a b. APrism a b () () -> p a b -> p a b
forall (p :: * -> * -> *) a b.
Alternator p =>
APrism a b () () -> p a b -> p a b
optionP APrism a b () ()
def (p a b -> p a b)
-> (Yoneda p a b -> p a b) -> Yoneda p a b -> p a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Yoneda p a b -> p a b
Yoneda p :-> p
forall (p :: * -> * -> *). Profunctor p => Yoneda p :-> p
forall (t :: (* -> * -> *) -> * -> * -> *) (p :: * -> * -> *).
(ProfunctorComonad t, Profunctor p) =>
t p :-> p
proextract
instance Alternative f => Alternator (Joker f) where
  alternate :: forall a b c d.
Either (Joker f a b) (Joker f c d)
-> Joker f (Either a c) (Either b d)
alternate (Left (Joker f b
x)) = f (Either b d) -> Joker f (Either a c) (Either b d)
forall {k} {k1} (g :: k -> *) (a :: k1) (b :: k).
g b -> Joker g a b
Joker (b -> Either b d
forall a b. a -> Either a b
Left (b -> Either b d) -> f b -> f (Either b d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f b
x)
  alternate (Right (Joker f d
y)) = f (Either b d) -> Joker f (Either a c) (Either b d)
forall {k} {k1} (g :: k -> *) (a :: k1) (b :: k).
g b -> Joker g a b
Joker (d -> Either b d
forall a b. b -> Either a b
Right (d -> Either b d) -> f d -> f (Either b d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f d
y)
  someP :: forall a b. Joker f a b -> Joker f [a] [b]
someP (Joker f b
x) = f [b] -> Joker f [a] [b]
forall {k} {k1} (g :: k -> *) (a :: k1) (b :: k).
g b -> Joker g a b
Joker (f b -> f [b]
forall a. f a -> f [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some f b
x)
  optionP :: forall a b. APrism a b () () -> Joker f a b -> Joker f a b
optionP APrism a b () ()
def (Joker f b
x) =
    f b -> Joker f a b
forall {k} {k1} (g :: k -> *) (a :: k1) (b :: k).
g b -> Joker g a b
Joker (f b
x f b -> f b -> f b
forall a. f a -> f a -> f a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> APrism a b () () -> ((() -> b) -> (a -> Either b ()) -> f b) -> f b
forall s t a b r.
APrism s t a b -> ((b -> t) -> (s -> Either t a) -> r) -> r
withPrism APrism a b () ()
def (\() -> b
f a -> Either b ()
_ -> b -> f b
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> b
f ())))