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

{-# OPTIONS_GHC -Wno-orphans #-}

module Data.Profunctor.Distributor
  ( -- * Monoidal
    Monoidal, oneP, (>*<), (>*), (*<), dimap2, foreverP, replicateP, meander, (>:<)
    -- * Distributor
  , Distributor (zeroP, (>+<), optionalP, manyP), dialt, Homogeneous (homogeneously)
    -- * Alternator/Filtrator
  , Alternator (alternate, someP), Filtrator (filtrate)
    -- * SepBy
  , SepBy (..), sepBy, noSep, zeroOrMore, oneOrMore, chainl1, chainr1, chainl, chainr
    -- * Tokenized
  , Tokenized (anyToken), satisfy, token, tokens
    -- * Printor/Parsor
  , Printor (..), Parsor (..)
  ) 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.Context
import Control.Lens.Internal.Iso
import Control.Lens.Internal.Prism
import Control.Lens.Internal.Profunctor
import Control.Lens.PartialIso
import Control.Monad
import Data.Bifunctor.Clown
import Data.Bifunctor.Joker
import Data.Bifunctor.Product
import Data.Distributive
import Data.Functor.Adjunction
import Data.Functor.Compose
import Data.Functor.Contravariant.Divisible
import qualified Data.Functor.Product as Functor
import qualified Data.Functor.Sum as Functor
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.Yoneda
import Data.String
import Data.Void
import GHC.Generics
import Witherable

-- Monoidal --

{- | A lax `Monoidal` product `Profunctor` has unit `oneP`
and product `>*<` lax monoidal structure morphisms.
This is equivalent to the `Profunctor` also being `Applicative`.

Laws:

>>> let (f >< g) (a,c) = (f a, g c)
>>> let lunit = dimap (\((),a) -> a) (\a -> ((),a))
>>> let runit = dimap (\(a,()) -> a) (\a -> (a,()))
>>> let assoc = dimap (\(a,(b,c)) -> ((a,b),c)) (\((a,b),c) -> (a,(b,c)))
prop> dimap (f >< g) (h >< i) (p >*< q) = dimap f h p >*< dimap g i q
prop> oneP >*< p = lunit p
prop> p >*< oneP = runit p
prop> p >*< q >*< r = assoc ((p >*< q) >*< r)

-}
type Monoidal p = (Profunctor p, forall x. Applicative (p x))

{- | `oneP` is the unit of a `Monoidal` `Profunctor`. -}
oneP :: Monoidal p => p () ()
oneP :: forall (p :: * -> * -> *). Monoidal p => p () ()
oneP = () -> p () ()
forall a. a -> p () a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

{- | `>*<` is the product of a `Monoidal` `Profunctor`. -}
(>*<) :: Monoidal p => p a b -> p c d -> p (a,c) (b,d)
>*< :: forall (p :: * -> * -> *) a b c d.
Monoidal p =>
p a b -> p c d -> p (a, c) (b, d)
(>*<) = ((a, c) -> a)
-> ((a, c) -> c)
-> (b -> d -> (b, d))
-> p a b
-> p c d
-> p (a, c) (b, d)
forall (p :: * -> * -> *) s a c b d t.
Monoidal p =>
(s -> a) -> (s -> c) -> (b -> d -> t) -> p a b -> p c d -> p s t
dimap2 (a, c) -> a
forall a b. (a, b) -> a
fst (a, c) -> c
forall a b. (a, b) -> b
snd (,)
infixr 6 >*<

{- | `>*` sequences actions, discarding the value of the first argument;
analagous to `*>`, extending it to `Monoidal`.

prop> oneP >* p = p

-}
(>*) :: Monoidal p => p () c -> p a b -> p a b
p () c
x >* :: forall (p :: * -> * -> *) c a b.
Monoidal p =>
p () c -> p a b -> p a b
>* p a b
y = (a -> ()) -> p () c -> p a c
forall a b c. (a -> b) -> p b c -> p a c
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap (() -> a -> ()
forall a b. a -> b -> a
const ()) p () c
x p a c -> p a b -> p a b
forall a b. p a a -> p a b -> p a b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> p a b
y
infixl 5 >*

{- | `*<` sequences actions, discarding the value of the first argument;
analagous to `<*`, extending it to `Monoidal`.

prop> p *< oneP = p

-}
(*<) :: Monoidal p => p a b -> p () c -> p a b
p a b
x *< :: forall (p :: * -> * -> *) a b c.
Monoidal p =>
p a b -> p () c -> p a b
*< p () c
y = p a b
x p a b -> p a c -> p a b
forall a b. p a a -> p a b -> p a a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (a -> ()) -> p () c -> p a c
forall a b c. (a -> b) -> p b c -> p a c
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap (() -> a -> ()
forall a b. a -> b -> a
const ()) p () c
y
infixl 5 *<

{- | `dimap2` is a curried, functionalized form of `>*<`,
analagous to `liftA2`. -}
dimap2
  :: Monoidal p
  => (s -> a)
  -> (s -> c)
  -> (b -> d -> t)
  -> p a b -> p c d -> p s t
dimap2 :: forall (p :: * -> * -> *) s a c b d t.
Monoidal p =>
(s -> a) -> (s -> c) -> (b -> d -> t) -> p a b -> p c d -> p s t
dimap2 s -> a
f s -> c
g b -> d -> t
h p a b
p p c d
q = (b -> d -> t) -> p s b -> p s d -> p s t
forall a b c. (a -> b -> c) -> p s a -> p s b -> p s c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 b -> d -> t
h ((s -> a) -> p a b -> p s b
forall a b c. (a -> b) -> p b c -> p a c
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap s -> a
f p a b
p) ((s -> c) -> p c d -> p s d
forall a b c. (a -> b) -> p b c -> p a c
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap s -> c
g p c d
q)

{- | `foreverP` repeats an action indefinitely;
analagous to `forever`, extending it to `Monoidal`. -}
foreverP :: Monoidal p => p () c -> p a b
foreverP :: forall (p :: * -> * -> *) c a b. Monoidal p => p () c -> p a b
foreverP p () c
a = let a' :: p a b
a' = p () c
a p () c -> p a b -> p a b
forall (p :: * -> * -> *) c a b.
Monoidal p =>
p () c -> p a b -> p a b
>* p a b
a' in p a b
a'

{- | Thanks to Fy on Monoidal Café Discord.

`replicateP` is roughly analagous to `replicateM`,
repeating an action a number of times.
However, instead of an `Int` term, it expects
a `Traversable` & `Distributive` type. Such a
type is a homogeneous countable product.
-}
replicateP
  :: (Traversable t, Distributive t, Monoidal p)
  => p a b -> p (t a) (t b)
replicateP :: forall (t :: * -> *) (p :: * -> * -> *) a b.
(Traversable t, Distributive t, Monoidal p) =>
p a b -> p (t a) (t b)
replicateP p a b
p = ((t a -> a) -> p (t a) b) -> t (t a -> a) -> p (t a) (t 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) -> t a -> f (t b)
traverse (\t a -> a
f -> (t a -> a) -> p a b -> p (t a) b
forall a b c. (a -> b) -> p b c -> p a c
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap t a -> a
f p a b
p) ((t a -> t a) -> t (t a -> a)
forall (g :: * -> *) (f :: * -> *) a.
(Distributive g, Functor f) =>
f (g a) -> g (f a)
forall (f :: * -> *) a. Functor f => f (t a) -> t (f a)
distribute t a -> t a
forall a. a -> a
id)

{- | `meander` gives a default implementation for the
`Data.Profunctor.Traversing.wander`
method of `Data.Profunctor.Traversing.Traversing`
for any `Monoidal`, `Choice` & `Strong` `Profunctor`.

It is invertible when @p@ is `Strong`,
though it's not needed for its definition.

See Pickering, Gibbons & Wu,
[Profunctor Optics - Modular Data Accessors](https://arxiv.org/abs/1703.10857)
-}
meander
  :: (Monoidal p, Choice p)
  => ATraversal s t a b -> p a b -> p s t
meander :: forall (p :: * -> * -> *) s t a b.
(Monoidal p, Choice p) =>
ATraversal s t a b -> p a b -> p s t
meander ATraversal s t a b
f = (s -> Bazaar (->) a b t)
-> (Bazaar (->) b b t -> t)
-> p (Bazaar (->) a b t) (Bazaar (->) b b t)
-> 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 (ATraversal s t a b
f a -> Bazaar (->) a b b
forall a b. a -> Bazaar (->) a b b
forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a b.
Sellable p w =>
p a (w a b b)
sell) Bazaar (->) b b t -> t
forall a t. Bazaar (->) a a t -> t
forall (w :: * -> * -> * -> *) a t.
IndexedComonad w =>
w a a t -> t
iextract (p (Bazaar (->) a b t) (Bazaar (->) b b t) -> p s t)
-> (p a b -> p (Bazaar (->) a b t) (Bazaar (->) b b t))
-> p a b
-> p s t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p a b -> p (Bazaar (->) a b t) (Bazaar (->) b b t)
forall (q :: * -> * -> *) u v w x.
(Monoidal q, Choice q) =>
q u v -> q (Bazaar (->) u w x) (Bazaar (->) v w x)
trav
  where
    trav
      :: (Monoidal q, Choice q)
      => q u v -> q (Bazaar (->) u w x) (Bazaar (->) v w x)
    trav :: forall (q :: * -> * -> *) u v w x.
(Monoidal q, Choice q) =>
q u v -> q (Bazaar (->) u w x) (Bazaar (->) v w x)
trav q u v
q = AnIso
  (Bazaar (->) u w x)
  (Bazaar (->) v w x)
  (Either x (u, Bazaar (->) u w (w -> x)))
  (Either x (v, Bazaar (->) v w (w -> x)))
-> q (Either x (u, Bazaar (->) u w (w -> x)))
     (Either x (v, Bazaar (->) v w (w -> x)))
-> q (Bazaar (->) u w x) (Bazaar (->) v w x)
forall (p :: * -> * -> *) s t a b.
Profunctor p =>
AnIso s t a b -> p a b -> p s t
mapIso AnIso
  (Bazaar (->) u w x)
  (Bazaar (->) v w x)
  (Either x (u, Bazaar (->) u w (w -> x)))
  (Either x (v, Bazaar (->) v w (w -> x)))
forall a1 b1 t1 a2 b2 t2 (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p (Either t1 (a1, Bazaar (->) a1 b1 (b1 -> t1)))
  (f (Either t2 (a2, Bazaar (->) a2 b2 (b2 -> t2))))
-> p (Bazaar (->) a1 b1 t1) (f (Bazaar (->) a2 b2 t2))
funListEot (q (Either x (u, Bazaar (->) u w (w -> x)))
   (Either x (v, Bazaar (->) v w (w -> x)))
 -> q (Bazaar (->) u w x) (Bazaar (->) v w x))
-> q (Either x (u, Bazaar (->) u w (w -> x)))
     (Either x (v, Bazaar (->) v w (w -> x)))
-> q (Bazaar (->) u w x) (Bazaar (->) v w x)
forall a b. (a -> b) -> a -> b
$ q (u, Bazaar (->) u w (w -> x)) (v, Bazaar (->) v w (w -> x))
-> q (Either x (u, Bazaar (->) u w (w -> x)))
     (Either x (v, Bazaar (->) v w (w -> x)))
forall a b c. q a b -> q (Either c a) (Either c b)
forall (p :: * -> * -> *) a b c.
Choice p =>
p a b -> p (Either c a) (Either c b)
right' (q u v
q q u v
-> q (Bazaar (->) u w (w -> x)) (Bazaar (->) v w (w -> x))
-> q (u, Bazaar (->) u w (w -> x)) (v, Bazaar (->) v w (w -> x))
forall (p :: * -> * -> *) a b c d.
Monoidal p =>
p a b -> p c d -> p (a, c) (b, d)
>*< q u v -> q (Bazaar (->) u w (w -> x)) (Bazaar (->) v w (w -> x))
forall (q :: * -> * -> *) u v w x.
(Monoidal q, Choice q) =>
q u v -> q (Bazaar (->) u w x) (Bazaar (->) v w x)
trav q u v
q)

{- | A `Monoidal` `Cons` operator. -}
(>:<) :: (Monoidal p, Choice p, Cons s t a b) => p a b -> p s t -> p s t
p a b
x >:< :: forall (p :: * -> * -> *) s t a b.
(Monoidal p, Choice p, Cons s t a b) =>
p a b -> p s t -> p s t
>:< p s t
xs = Market (a, s) (b, t) (a, s) (Identity (b, t))
-> Market (a, s) (b, t) s (Identity t)
forall s t a b. Cons s t a b => Prism s t (a, s) (b, t)
Prism s t (a, s) (b, t)
_Cons (Market (a, s) (b, t) (a, s) (Identity (b, t))
 -> Market (a, s) (b, t) s (Identity t))
-> p (a, s) (b, t) -> p s t
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? p a b
x p a b -> p s t -> p (a, s) (b, t)
forall (p :: * -> * -> *) a b c d.
Monoidal p =>
p a b -> p c d -> p (a, c) (b, d)
>*< p s t
xs
infixr 5 >:<

-- 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 f |+| g = either (Left . f) (Right . g)
    lunit = dimap (either absurd id) Right
    runit = dimap (either id absurd) Left
    assoc = dimap
      (either (Left . Left) (either (Left . Right) Right))
      (either (either Left (Right . Left)) (Right . Right))
:}
prop> dimap (f |+| g) (h |+| i) (p >+< q) = dimap f h p >+< dimap g i q
prop> zeroP >+< p = lunit p
prop> p >+< zeroP = runit p
prop> p >+< q >+< r = assoc ((p >+< q) >+< r)

-}
class Monoidal p => Distributor p where

  {- | The zero structure morphism of a `Distributor`. -}
  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`. -}
  (>+<) :: 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 = AnIso (Maybe a) (Maybe b) (Either () a) (Either () 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
mapIso AnIso (Maybe a) (Maybe b) (Either () a) (Either () b)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p (Either () a) (f (Either () b)) -> p (Maybe a) (f (Maybe b))
maybeEot (p () ()
forall (p :: * -> * -> *). Monoidal p => p () ()
oneP p () () -> p a b -> 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 a b
p)

  {- | Zero or more. -}
  manyP :: p a b -> p [a] [b]
  manyP p a b
p = AnIso [a] [b] (Either () (a, [a])) (Either () (b, [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
mapIso AnIso [a] [b] (Either () (a, [a])) (Either () (b, [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]))
listEot (p () ()
forall (p :: * -> * -> *). Monoidal p => p () ()
oneP p () ()
-> p (a, [a]) (b, [b])
-> 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 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)

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)

{- | A class of `Homogeneous`
countable sums of countable products.
-}
class Traversable t => Homogeneous t where
  {- | Sequences actions `homogeneously`.

  prop> homogeneously @Maybe = optionalP
  prop> homogeneously @[] = manyP
  
  Any `Traversable` & `Distributive` countable product
  can be given a default implementation for the `homogeneously` method.

  prop> homogeneously = replicateP

  And any user-defined homogeneous algebraic datatype has
  a default instance for `Homogeneous`, by deriving `Generic1`.
  -}
  homogeneously :: Distributor p => p a b -> p (t a) (t b)
  default homogeneously
    :: (Generic1 t, Homogeneous (Rep1 t), Distributor p)
    => p a b -> p (t a) (t b)
  homogeneously = (t a -> Rep1 t a)
-> (Rep1 t b -> t b) -> p (Rep1 t a) (Rep1 t b) -> p (t a) (t b)
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 t a -> Rep1 t a
forall a. t a -> Rep1 t a
forall k (f :: k -> *) (a :: k). Generic1 f => f a -> Rep1 f a
from1 Rep1 t b -> t b
forall a. Rep1 t a -> t a
forall k (f :: k -> *) (a :: k). Generic1 f => Rep1 f a -> f a
to1 (p (Rep1 t a) (Rep1 t b) -> p (t a) (t b))
-> (p a b -> p (Rep1 t a) (Rep1 t b)) -> p a b -> p (t a) (t b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p a b -> p (Rep1 t a) (Rep1 t b)
forall (t :: * -> *) (p :: * -> * -> *) a b.
(Homogeneous t, Distributor p) =>
p a b -> p (t a) (t b)
forall (p :: * -> * -> *) a b.
Distributor p =>
p a b -> p (Rep1 t a) (Rep1 t b)
homogeneously
instance Homogeneous Par1 where
  homogeneously :: forall (p :: * -> * -> *) a b.
Distributor p =>
p a b -> p (Par1 a) (Par1 b)
homogeneously = (Par1 a -> a) -> (b -> Par1 b) -> p a b -> p (Par1 a) (Par1 b)
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 Par1 a -> a
forall p. Par1 p -> p
unPar1 b -> Par1 b
forall p. p -> Par1 p
Par1
instance Homogeneous Identity where
  homogeneously :: forall (p :: * -> * -> *) a b.
Distributor p =>
p a b -> p (Identity a) (Identity b)
homogeneously = (Identity a -> a)
-> (b -> Identity b) -> p a b -> p (Identity a) (Identity b)
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 Identity a -> a
forall a. Identity a -> a
runIdentity b -> Identity b
forall a. a -> Identity a
Identity
instance (Homogeneous s, Homogeneous t)
  => Homogeneous (s :.: t) where
    homogeneously :: forall (p :: * -> * -> *) a b.
Distributor p =>
p a b -> p ((:.:) s t a) ((:.:) s t b)
homogeneously
      = ((:.:) s t a -> s (t a))
-> (s (t b) -> (:.:) s t b)
-> p (s (t a)) (s (t b))
-> p ((:.:) s t a) ((:.:) s t b)
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 t a -> s (t a)
forall k2 k1 (f :: k2 -> *) (g :: k1 -> k2) (p :: k1).
(:.:) f g p -> f (g p)
unComp1 s (t b) -> (:.:) s t b
forall k2 k1 (f :: k2 -> *) (g :: k1 -> k2) (p :: k1).
f (g p) -> (:.:) f g p
Comp1
      (p (s (t a)) (s (t b)) -> p ((:.:) s t a) ((:.:) s t b))
-> (p a b -> p (s (t a)) (s (t b)))
-> p a b
-> p ((:.:) s t a) ((:.:) s t b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p (t a) (t b) -> p (s (t a)) (s (t b))
forall (t :: * -> *) (p :: * -> * -> *) a b.
(Homogeneous t, Distributor p) =>
p a b -> p (t a) (t b)
forall (p :: * -> * -> *) a b.
Distributor p =>
p a b -> p (s a) (s b)
homogeneously (p (t a) (t b) -> p (s (t a)) (s (t b)))
-> (p a b -> p (t a) (t b)) -> p a b -> p (s (t a)) (s (t b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p a b -> p (t a) (t b)
forall (t :: * -> *) (p :: * -> * -> *) a b.
(Homogeneous t, Distributor p) =>
p a b -> p (t a) (t b)
forall (p :: * -> * -> *) a b.
Distributor p =>
p a b -> p (t a) (t b)
homogeneously
instance (Homogeneous s, Homogeneous t)
  => Homogeneous (Compose s t) where
    homogeneously :: forall (p :: * -> * -> *) a b.
Distributor p =>
p a b -> p (Compose s t a) (Compose s t b)
homogeneously
      = (Compose s t a -> s (t a))
-> (s (t b) -> Compose s t b)
-> p (s (t a)) (s (t b))
-> p (Compose s t a) (Compose s t b)
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 Compose s t a -> s (t a)
forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose s (t b) -> Compose s t b
forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose
      (p (s (t a)) (s (t b)) -> p (Compose s t a) (Compose s t b))
-> (p a b -> p (s (t a)) (s (t b)))
-> p a b
-> p (Compose s t a) (Compose s t b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p (t a) (t b) -> p (s (t a)) (s (t b))
forall (t :: * -> *) (p :: * -> * -> *) a b.
(Homogeneous t, Distributor p) =>
p a b -> p (t a) (t b)
forall (p :: * -> * -> *) a b.
Distributor p =>
p a b -> p (s a) (s b)
homogeneously (p (t a) (t b) -> p (s (t a)) (s (t b)))
-> (p a b -> p (t a) (t b)) -> p a b -> p (s (t a)) (s (t b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p a b -> p (t a) (t b)
forall (t :: * -> *) (p :: * -> * -> *) a b.
(Homogeneous t, Distributor p) =>
p a b -> p (t a) (t b)
forall (p :: * -> * -> *) a b.
Distributor p =>
p a b -> p (t a) (t b)
homogeneously
instance Homogeneous U1 where
  homogeneously :: forall (p :: * -> * -> *) a b.
Distributor p =>
p a b -> p (U1 a) (U1 b)
homogeneously p a b
_ = (U1 a -> ()) -> (() -> U1 b) -> p () () -> p (U1 a) (U1 b)
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 (() -> U1 a -> ()
forall a b. a -> b -> a
const ()) (U1 b -> () -> U1 b
forall a b. a -> b -> a
const U1 b
forall k (p :: k). U1 p
U1) p () ()
forall (p :: * -> * -> *). Monoidal p => p () ()
oneP
instance Homogeneous (K1 i ()) where
  homogeneously :: forall (p :: * -> * -> *) a b.
Distributor p =>
p a b -> p (K1 i () a) (K1 i () b)
homogeneously p a b
_ = (K1 i () a -> ())
-> (() -> K1 i () b) -> p () () -> p (K1 i () a) (K1 i () b)
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 (() -> K1 i () a -> ()
forall a b. a -> b -> a
const ()) (K1 i () b -> () -> K1 i () b
forall a b. a -> b -> a
const (() -> K1 i () b
forall k i c (p :: k). c -> K1 i c p
K1 ())) p () ()
forall (p :: * -> * -> *). Monoidal p => p () ()
oneP
instance Homogeneous (Const ()) where
  homogeneously :: forall (p :: * -> * -> *) a b.
Distributor p =>
p a b -> p (Const () a) (Const () b)
homogeneously p a b
_ = (Const () a -> ())
-> (() -> Const () b) -> p () () -> p (Const () a) (Const () b)
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 (() -> Const () a -> ()
forall a b. a -> b -> a
const ()) (Const () b -> () -> Const () b
forall a b. a -> b -> a
const (() -> Const () b
forall {k} a (b :: k). a -> Const a b
Const ())) p () ()
forall (p :: * -> * -> *). Monoidal p => p () ()
oneP
instance (Homogeneous s, Homogeneous t)
  => Homogeneous (s :*: t) where
    homogeneously :: forall (p :: * -> * -> *) a b.
Distributor p =>
p a b -> p ((:*:) s t a) ((:*:) s t b)
homogeneously p a b
p = ((:*:) s t a -> s a)
-> ((:*:) s t a -> t a)
-> (s b -> t b -> (:*:) s t b)
-> p (s a) (s b)
-> p (t a) (t b)
-> p ((:*:) s t a) ((:*:) s t b)
forall (p :: * -> * -> *) s a c b d t.
Monoidal p =>
(s -> a) -> (s -> c) -> (b -> d -> t) -> p a b -> p c d -> p s t
dimap2
      (\(s a
s :*: t a
_) -> s a
s)
      (\(s a
_ :*: t a
t) -> t a
t)
      s b -> t b -> (:*:) s t b
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:)
      (p a b -> p (s a) (s b)
forall (t :: * -> *) (p :: * -> * -> *) a b.
(Homogeneous t, Distributor p) =>
p a b -> p (t a) (t b)
forall (p :: * -> * -> *) a b.
Distributor p =>
p a b -> p (s a) (s b)
homogeneously p a b
p)
      (p a b -> p (t a) (t b)
forall (t :: * -> *) (p :: * -> * -> *) a b.
(Homogeneous t, Distributor p) =>
p a b -> p (t a) (t b)
forall (p :: * -> * -> *) a b.
Distributor p =>
p a b -> p (t a) (t b)
homogeneously p a b
p)
instance (Homogeneous s, Homogeneous t)
  => Homogeneous (Functor.Product s t) where
    homogeneously :: forall (p :: * -> * -> *) a b.
Distributor p =>
p a b -> p (Product s t a) (Product s t b)
homogeneously p a b
p = (Product s t a -> s a)
-> (Product s t a -> t a)
-> (s b -> t b -> Product s t b)
-> p (s a) (s b)
-> p (t a) (t b)
-> p (Product s t a) (Product s t b)
forall (p :: * -> * -> *) s a c b d t.
Monoidal p =>
(s -> a) -> (s -> c) -> (b -> d -> t) -> p a b -> p c d -> p s t
dimap2
      (\(Functor.Pair s a
s t a
_) -> s a
s)
      (\(Functor.Pair s a
_ t a
t) -> t a
t)
      s b -> t b -> Product s t b
forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Functor.Pair
      (p a b -> p (s a) (s b)
forall (t :: * -> *) (p :: * -> * -> *) a b.
(Homogeneous t, Distributor p) =>
p a b -> p (t a) (t b)
forall (p :: * -> * -> *) a b.
Distributor p =>
p a b -> p (s a) (s b)
homogeneously p a b
p)
      (p a b -> p (t a) (t b)
forall (t :: * -> *) (p :: * -> * -> *) a b.
(Homogeneous t, Distributor p) =>
p a b -> p (t a) (t b)
forall (p :: * -> * -> *) a b.
Distributor p =>
p a b -> p (t a) (t b)
homogeneously p a b
p)
instance Homogeneous V1 where
  homogeneously :: forall (p :: * -> * -> *) a b.
Distributor p =>
p a b -> p (V1 a) (V1 b)
homogeneously p a b
_ = (V1 a -> Void) -> (Void -> V1 b) -> p Void Void -> p (V1 a) (V1 b)
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 (V1 a -> Void
\case) (Void -> V1 b
\case) p Void Void
forall (p :: * -> * -> *). Distributor p => p Void Void
zeroP
instance (Homogeneous s, Homogeneous t)
  => Homogeneous (s :+: t) where
    homogeneously :: forall (p :: * -> * -> *) a b.
Distributor p =>
p a b -> p ((:+:) s t a) ((:+:) s t b)
homogeneously p a b
p = ((:+:) s t a -> Either (s a) (t a))
-> (s b -> (:+:) s t b)
-> (t b -> (:+:) s t b)
-> p (s a) (s b)
-> p (t a) (t b)
-> p ((:+:) s t a) ((:+:) s t b)
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
      (\case {L1 s a
s -> s a -> Either (s a) (t a)
forall a b. a -> Either a b
Left s a
s; R1 t a
t -> t a -> Either (s a) (t a)
forall a b. b -> Either a b
Right t a
t})
      s b -> (:+:) s t b
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1
      t b -> (:+:) s t b
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1
      (p a b -> p (s a) (s b)
forall (t :: * -> *) (p :: * -> * -> *) a b.
(Homogeneous t, Distributor p) =>
p a b -> p (t a) (t b)
forall (p :: * -> * -> *) a b.
Distributor p =>
p a b -> p (s a) (s b)
homogeneously p a b
p)
      (p a b -> p (t a) (t b)
forall (t :: * -> *) (p :: * -> * -> *) a b.
(Homogeneous t, Distributor p) =>
p a b -> p (t a) (t b)
forall (p :: * -> * -> *) a b.
Distributor p =>
p a b -> p (t a) (t b)
homogeneously p a b
p)
instance (Homogeneous s, Homogeneous t)
  => Homogeneous (Functor.Sum s t) where
    homogeneously :: forall (p :: * -> * -> *) a b.
Distributor p =>
p a b -> p (Sum s t a) (Sum s t b)
homogeneously p a b
p = (Sum s t a -> Either (s a) (t a))
-> (s b -> Sum s t b)
-> (t b -> Sum s t b)
-> p (s a) (s b)
-> p (t a) (t b)
-> p (Sum s t a) (Sum s t b)
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
      (\case {Functor.InL s a
s -> s a -> Either (s a) (t a)
forall a b. a -> Either a b
Left s a
s; Functor.InR t a
t -> t a -> Either (s a) (t a)
forall a b. b -> Either a b
Right t a
t})
      s b -> Sum s t b
forall {k} (f :: k -> *) (g :: k -> *) (a :: k). f a -> Sum f g a
Functor.InL
      t b -> Sum s t b
forall {k} (f :: k -> *) (g :: k -> *) (a :: k). g a -> Sum f g a
Functor.InR
      (p a b -> p (s a) (s b)
forall (t :: * -> *) (p :: * -> * -> *) a b.
(Homogeneous t, Distributor p) =>
p a b -> p (t a) (t b)
forall (p :: * -> * -> *) a b.
Distributor p =>
p a b -> p (s a) (s b)
homogeneously p a b
p)
      (p a b -> p (t a) (t b)
forall (t :: * -> *) (p :: * -> * -> *) a b.
(Homogeneous t, Distributor p) =>
p a b -> p (t a) (t b)
forall (p :: * -> * -> *) a b.
Distributor p =>
p a b -> p (t a) (t b)
homogeneously p a b
p)
instance Homogeneous t
  => Homogeneous (M1 i c t) where
    homogeneously :: forall (p :: * -> * -> *) a b.
Distributor p =>
p a b -> p (M1 i c t a) (M1 i c t b)
homogeneously p a b
p = (M1 i c t a -> t a)
-> (t b -> M1 i c t b)
-> p (t a) (t b)
-> p (M1 i c t a) (M1 i c t b)
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 M1 i c t a -> t a
forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1 t b -> M1 i c t b
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (p a b -> p (t a) (t b)
forall (t :: * -> *) (p :: * -> * -> *) a b.
(Homogeneous t, Distributor p) =>
p a b -> p (t a) (t b)
forall (p :: * -> * -> *) a b.
Distributor p =>
p a b -> p (t a) (t b)
homogeneously p a b
p)
instance Homogeneous Maybe where
  homogeneously :: forall (p :: * -> * -> *) a b.
Distributor p =>
p a b -> p (Maybe a) (Maybe b)
homogeneously = 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
instance Homogeneous [] where
  homogeneously :: forall (p :: * -> * -> *) a b. Distributor p => p a b -> p [a] [b]
homogeneously = 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

-- Alternator/Filtrator --

{- | 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.

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.
-}
class (Choice p, Distributor p, forall x. Alternative (p x))
  => Alternator p where

    {- |
    prop> left' = alternate . Left
    prop> right' = alternate . Right
    prop> zeroP = empty
    prop> x >+< y = alternate (Left x) <|> alternate (Right y)

    `alternate` has a default when `Cochoice`.
    -}
    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
p = Market (a, [a]) (b, [b]) (a, [a]) (Identity (b, [b]))
-> Market (a, [a]) (b, [b]) [a] (Identity [b])
forall s t a b. Cons s t a b => Prism s t (a, s) (b, t)
Prism [a] [b] (a, [a]) (b, [b])
_Cons (Market (a, [a]) (b, [b]) (a, [a]) (Identity (b, [b]))
 -> Market (a, [a]) (b, [b]) [a] (Identity [b]))
-> p (a, [a]) (b, [b]) -> p [a] [b]
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism 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

instance (Alternator p, Alternative 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))
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
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

{- | The `Filtrator` class extends `Cochoice`,
as well as `Filterable`, adding the `filtrate` method,
which is an oplax monoidal structure morphism dual to `>+<`.
-}
class (Cochoice p, forall x. Filterable (p x))
  => Filtrator p where

    {- |
    prop> unleft = fst . filtrate
    prop> unright = snd . filtrate

    `filtrate` is a distant relative to `Data.Either.partitionEithers`.

    `filtrate` has a default when `Choice`.
    -}
    filtrate
      :: p (Either a c) (Either b d)
      -> (p a b, p c d)
    default filtrate
      :: Choice p
      => p (Either a c) (Either b d)
      -> (p a b, p c d)
    filtrate =
      (a -> Maybe (Either a c))
-> (Either b d -> Maybe b) -> p (Either a c) (Either b d) -> p a b
forall (p :: * -> * -> *) s a b t.
(Choice p, Cochoice p) =>
(s -> Maybe a) -> (b -> Maybe t) -> p a b -> p s t
dimapMaybe (Either a c -> Maybe (Either a c)
forall a. a -> Maybe a
Just (Either a c -> Maybe (Either a c))
-> (a -> Either a c) -> a -> Maybe (Either a c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either a c
forall a b. a -> Either a b
Left) ((b -> Maybe b) -> (d -> Maybe b) -> Either b d -> Maybe b
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either b -> Maybe b
forall a. a -> Maybe a
Just (Maybe b -> d -> Maybe b
forall a. a -> d -> a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe b
forall a. Maybe a
Nothing))
      (p (Either a c) (Either b d) -> p a b)
-> (p (Either a c) (Either b d) -> p c d)
-> p (Either a c) (Either b d)
-> (p a b, p c d)
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&&
      (c -> Maybe (Either a c))
-> (Either b d -> Maybe d) -> p (Either a c) (Either b d) -> p c d
forall (p :: * -> * -> *) s a b t.
(Choice p, Cochoice p) =>
(s -> Maybe a) -> (b -> Maybe t) -> p a b -> p s t
dimapMaybe (Either a c -> Maybe (Either a c)
forall a. a -> Maybe a
Just (Either a c -> Maybe (Either a c))
-> (c -> Either a c) -> c -> Maybe (Either a c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> Either a c
forall a b. b -> Either a b
Right) ((b -> Maybe d) -> (d -> Maybe d) -> Either b d -> Maybe d
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe d -> b -> Maybe d
forall a. a -> b -> a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe d
forall a. Maybe a
Nothing) d -> Maybe d
forall a. a -> Maybe a
Just)

instance (Filtrator p, Filterable f)
  => Filtrator (WrappedPafb f p) where
    filtrate :: forall a c b d.
WrappedPafb f p (Either a c) (Either b d)
-> (WrappedPafb f p a b, WrappedPafb f p c d)
filtrate (WrapPafb p (Either a c) (f (Either b d))
p) =
      let
        fL :: f (Either b b) -> Either (f b) b
fL = f b -> Either (f b) b
forall a b. a -> Either a b
Left (f b -> Either (f b) b)
-> (f (Either b b) -> f b) -> f (Either b b) -> Either (f b) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either b b -> Maybe b) -> f (Either b b) -> f b
forall a b. (a -> Maybe b) -> f a -> f b
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe ((b -> Maybe b) -> (b -> Maybe b) -> Either b b -> Maybe b
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either b -> Maybe b
forall a. a -> Maybe a
Just (Maybe b -> b -> Maybe b
forall a b. a -> b -> a
const Maybe b
forall a. Maybe a
Nothing))
        fR :: f (Either b b) -> Either a (f b)
fR = f b -> Either a (f b)
forall a b. b -> Either a b
Right (f b -> Either a (f b))
-> (f (Either b b) -> f b) -> f (Either b b) -> Either a (f b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either b b -> Maybe b) -> f (Either b b) -> f b
forall a b. (a -> Maybe b) -> f a -> f b
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe ((b -> Maybe b) -> (b -> Maybe b) -> Either b b -> Maybe b
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe b -> b -> Maybe b
forall a b. a -> b -> a
const Maybe b
forall a. Maybe a
Nothing) b -> Maybe b
forall a. a -> Maybe a
Just)
        (p a (f b)
pL,p c Any
_) = p (Either a c) (Either (f b) Any) -> (p a (f b), p c Any)
forall a c b d. p (Either a c) (Either b d) -> (p a b, p c d)
forall (p :: * -> * -> *) a c b d.
Filtrator p =>
p (Either a c) (Either b d) -> (p a b, p c d)
filtrate ((f (Either b d) -> Either (f b) Any)
-> p (Either a c) (f (Either b d))
-> p (Either a c) (Either (f b) Any)
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 (Either b d) -> Either (f b) Any
forall {b} {b} {b}. f (Either b b) -> Either (f b) b
fL p (Either a c) (f (Either b d))
p)
        (p a Any
_,p c (f d)
pR) = p (Either a c) (Either Any (f d)) -> (p a Any, p c (f d))
forall a c b d. p (Either a c) (Either b d) -> (p a b, p c d)
forall (p :: * -> * -> *) a c b d.
Filtrator p =>
p (Either a c) (Either b d) -> (p a b, p c d)
filtrate ((f (Either b d) -> Either Any (f d))
-> p (Either a c) (f (Either b d))
-> p (Either a c) (Either Any (f d))
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 (Either b d) -> Either Any (f d)
forall {b} {b} {a}. f (Either b b) -> Either a (f b)
fR p (Either a c) (f (Either b d))
p)
      in
        ( p a (f b) -> WrappedPafb f p a b
forall (f :: * -> *) (p :: * -> * -> *) a b.
p a (f b) -> WrappedPafb f p a b
WrapPafb p a (f b)
pL
        , p c (f d) -> WrappedPafb f p c d
forall (f :: * -> *) (p :: * -> * -> *) a b.
p a (f b) -> WrappedPafb f p a b
WrapPafb p c (f d)
pR
        )
instance Filtrator p => Filtrator (Coyoneda p) where
  filtrate :: forall a c b d.
Coyoneda p (Either a c) (Either b d)
-> (Coyoneda p a b, Coyoneda p c d)
filtrate Coyoneda p (Either a c) (Either b d)
p =
    let (p a b
q,p c d
r) = p (Either a c) (Either b d) -> (p a b, p c d)
forall a c b d. p (Either a c) (Either b d) -> (p a b, p c d)
forall (p :: * -> * -> *) a c b d.
Filtrator p =>
p (Either a c) (Either b d) -> (p a b, p c d)
filtrate (Coyoneda p (Either a c) (Either b d) -> p (Either a c) (Either b d)
Coyoneda p :-> p
forall (p :: * -> * -> *). Profunctor p => Coyoneda p :-> p
forall (t :: (* -> * -> *) -> * -> * -> *) (p :: * -> * -> *).
(ProfunctorComonad t, Profunctor p) =>
t p :-> p
proextract Coyoneda p (Either a c) (Either b d)
p)
    in (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
q, p c d -> Coyoneda p c d
p :-> Coyoneda p
forall (p :: * -> * -> *). Profunctor p => p :-> Coyoneda p
forall (t :: (* -> * -> *) -> * -> * -> *) (p :: * -> * -> *).
(ProfunctorMonad t, Profunctor p) =>
p :-> t p
proreturn p c d
r)
instance Filtrator p => Filtrator (Yoneda p) where
  filtrate :: forall a c b d.
Yoneda p (Either a c) (Either b d) -> (Yoneda p a b, Yoneda p c d)
filtrate Yoneda p (Either a c) (Either b d)
p =
    let (p a b
q,p c d
r) = p (Either a c) (Either b d) -> (p a b, p c d)
forall a c b d. p (Either a c) (Either b d) -> (p a b, p c d)
forall (p :: * -> * -> *) a c b d.
Filtrator p =>
p (Either a c) (Either b d) -> (p a b, p c d)
filtrate (Yoneda p (Either a c) (Either b d) -> p (Either a c) (Either b d)
Yoneda p :-> p
forall (p :: * -> * -> *). Profunctor p => Yoneda p :-> p
forall (t :: (* -> * -> *) -> * -> * -> *) (p :: * -> * -> *).
(ProfunctorComonad t, Profunctor p) =>
t p :-> p
proextract Yoneda p (Either a c) (Either b d)
p)
    in (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
q, p c d -> Yoneda p c d
p :-> Yoneda p
forall (p :: * -> * -> *). Profunctor p => p :-> Yoneda p
forall (t :: (* -> * -> *) -> * -> * -> *) (p :: * -> * -> *).
(ProfunctorMonad t, Profunctor p) =>
p :-> t p
proreturn p c d
r)
instance Filtrator (Forget r) where
  filtrate :: forall a c b d.
Forget r (Either a c) (Either b d) -> (Forget r a b, Forget r c d)
filtrate (Forget Either a c -> r
f) = ((a -> r) -> Forget r a b
forall {k} r a (b :: k). (a -> r) -> Forget r a b
Forget (Either a c -> r
f (Either a c -> r) -> (a -> Either a c) -> a -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either a c
forall a b. a -> Either a b
Left), (c -> r) -> Forget r c d
forall {k} r a (b :: k). (a -> r) -> Forget r a b
Forget (Either a c -> r
f (Either a c -> r) -> (c -> Either a c) -> c -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> Either a c
forall a b. b -> Either a b
Right))
instance (Filterable f, Traversable f) => Filtrator (Star f) where
  filtrate :: forall a c b d.
Star f (Either a c) (Either b d) -> (Star f a b, Star f c d)
filtrate (Star Either a c -> f (Either b d)
f) =
    ( (a -> f b) -> Star f a b
forall {k} (f :: k -> *) d (c :: k). (d -> f c) -> Star f d c
Star ((Either b d -> Maybe b) -> f (Either b d) -> f b
forall a b. (a -> Maybe b) -> f a -> f b
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe ((b -> Maybe b) -> (d -> Maybe b) -> Either b d -> Maybe b
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either b -> Maybe b
forall a. a -> Maybe a
Just (Maybe b -> d -> Maybe b
forall a b. a -> b -> a
const Maybe b
forall a. Maybe a
Nothing)) (f (Either b d) -> f b) -> (a -> f (Either b d)) -> a -> f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either a c -> f (Either b d)
f (Either a c -> f (Either b d))
-> (a -> Either a c) -> a -> f (Either b d)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either a c
forall a b. a -> Either a b
Left)
    , (c -> f d) -> Star f c d
forall {k} (f :: k -> *) d (c :: k). (d -> f c) -> Star f d c
Star ((Either b d -> Maybe d) -> f (Either b d) -> f d
forall a b. (a -> Maybe b) -> f a -> f b
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe ((b -> Maybe d) -> (d -> Maybe d) -> Either b d -> Maybe d
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe d -> b -> Maybe d
forall a b. a -> b -> a
const Maybe d
forall a. Maybe a
Nothing) d -> Maybe d
forall a. a -> Maybe a
Just) (f (Either b d) -> f d) -> (c -> f (Either b d)) -> c -> f d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either a c -> f (Either b d)
f (Either a c -> f (Either b d))
-> (c -> Either a c) -> c -> f (Either b d)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> Either a c
forall a b. b -> Either a b
Right)
    )
instance Filtrator (PartialExchange a b) where
  filtrate :: forall a c b d.
PartialExchange a b (Either a c) (Either b d)
-> (PartialExchange a b a b, PartialExchange a b c d)
filtrate (PartialExchange Either a c -> Maybe a
f b -> Maybe (Either b d)
g) =
    ( (a -> Maybe a) -> (b -> Maybe b) -> PartialExchange a b a b
forall a b s t.
(s -> Maybe a) -> (b -> Maybe t) -> PartialExchange a b s t
PartialExchange (Either a c -> Maybe a
f (Either a c -> Maybe a) -> (a -> Either a c) -> a -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either a c
forall a b. a -> Either a b
Left) ((b -> Maybe b) -> (d -> Maybe b) -> Either b d -> Maybe b
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either b -> Maybe b
forall a. a -> Maybe a
Just (Maybe b -> d -> Maybe b
forall a. a -> d -> a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe b
forall a. Maybe a
Nothing) (Either b d -> Maybe b)
-> (b -> Maybe (Either b d)) -> b -> Maybe b
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< b -> Maybe (Either b d)
g)
    , (c -> Maybe a) -> (b -> Maybe d) -> PartialExchange a b c d
forall a b s t.
(s -> Maybe a) -> (b -> Maybe t) -> PartialExchange a b s t
PartialExchange (Either a c -> Maybe a
f (Either a c -> Maybe a) -> (c -> Either a c) -> c -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> Either a c
forall a b. b -> Either a b
Right) ((b -> Maybe d) -> (d -> Maybe d) -> Either b d -> Maybe d
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe d -> b -> Maybe d
forall a. a -> b -> a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe d
forall a. Maybe a
Nothing) d -> Maybe d
forall a. a -> Maybe a
Just (Either b d -> Maybe d)
-> (b -> Maybe (Either b d)) -> b -> Maybe d
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< b -> Maybe (Either b d)
g)
    )

-- SepBy --

{- | Used to sequence multiple times,
separated by a `separateBy`,
begun by a `beginBy`,
and ended by an `endBy`. -}
data SepBy p = SepBy
  { forall (p :: * -> * -> *). SepBy p -> p () ()
beginBy :: p () ()
  , forall (p :: * -> * -> *). SepBy p -> p () ()
endBy :: p () ()
  , forall (p :: * -> * -> *). SepBy p -> p () ()
separateBy :: p () ()
  }

{- | A default `SepBy` constructor which can be modified
by updating `beginBy`, or `endBy` fields -}
sepBy :: Monoidal p => p () () -> SepBy p
sepBy :: forall (p :: * -> * -> *). Monoidal p => p () () -> SepBy p
sepBy = p () () -> p () () -> p () () -> SepBy p
forall (p :: * -> * -> *). p () () -> p () () -> p () () -> SepBy p
SepBy p () ()
forall (p :: * -> * -> *). Monoidal p => p () ()
oneP p () ()
forall (p :: * -> * -> *). Monoidal p => p () ()
oneP

{- | No separator, beginning or ending delimiters. -}
noSep :: Monoidal p => SepBy p
noSep :: forall (p :: * -> * -> *). Monoidal p => SepBy p
noSep = p () () -> SepBy p
forall (p :: * -> * -> *). Monoidal p => p () () -> SepBy p
sepBy p () ()
forall (p :: * -> * -> *). Monoidal p => p () ()
oneP

{- |
prop> zeroOrMore (sepBy noSep) = manyP
-}
zeroOrMore
  :: Distributor p
  => SepBy p -> p a b -> p [a] [b]
zeroOrMore :: forall (p :: * -> * -> *) a b.
Distributor p =>
SepBy p -> p a b -> p [a] [b]
zeroOrMore SepBy p
sep p a b
p = AnIso [a] [b] (Either () (a, [a])) (Either () (b, [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
mapIso AnIso [a] [b] (Either () (a, [a])) (Either () (b, [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]))
listEot (p (Either () (a, [a])) (Either () (b, [b])) -> p [a] [b])
-> p (Either () (a, [a])) (Either () (b, [b])) -> p [a] [b]
forall a b. (a -> b) -> a -> b
$
  SepBy p -> p () ()
forall (p :: * -> * -> *). SepBy p -> p () ()
beginBy SepBy p
sep p () () -> p () () -> p () ()
forall (p :: * -> * -> *) c a b.
Monoidal p =>
p () c -> p a b -> p a b
>* p () ()
forall (p :: * -> * -> *). Monoidal p => p () ()
oneP p () ()
-> p (a, [a]) (b, [b])
-> 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 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 (SepBy p -> p () ()
forall (p :: * -> * -> *). SepBy p -> p () ()
separateBy SepBy p
sep p () () -> p a b -> p a b
forall (p :: * -> * -> *) c a b.
Monoidal p =>
p () c -> p a b -> p a b
>* p a b
p) p (a, [a]) (b, [b]) -> p () () -> p (a, [a]) (b, [b])
forall (p :: * -> * -> *) a b c.
Monoidal p =>
p a b -> p () c -> p a b
*< SepBy p -> p () ()
forall (p :: * -> * -> *). SepBy p -> p () ()
endBy SepBy p
sep

{- |
prop> oneOrMore (sepBy noSep) = someP
-}
oneOrMore
  :: Alternator p
  => SepBy p -> p a b -> p [a] [b]
oneOrMore :: forall (p :: * -> * -> *) a b.
Alternator p =>
SepBy p -> p a b -> p [a] [b]
oneOrMore SepBy p
sep p a b
p = Market (a, [a]) (b, [b]) (a, [a]) (Identity (b, [b]))
-> Market (a, [a]) (b, [b]) [a] (Identity [b])
forall s t a b. Cons s t a b => Prism s t (a, s) (b, t)
Prism [a] [b] (a, [a]) (b, [b])
_Cons (Market (a, [a]) (b, [b]) (a, [a]) (Identity (b, [b]))
 -> Market (a, [a]) (b, [b]) [a] (Identity [b]))
-> p (a, [a]) (b, [b]) -> p [a] [b]
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>?
  SepBy p -> p () ()
forall (p :: * -> * -> *). SepBy p -> p () ()
beginBy SepBy p
sep p () () -> p (a, [a]) (b, [b]) -> p (a, [a]) (b, [b])
forall (p :: * -> * -> *) c a b.
Monoidal p =>
p () c -> p a b -> p a b
>* 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 (SepBy p -> p () ()
forall (p :: * -> * -> *). SepBy p -> p () ()
separateBy SepBy p
sep p () () -> p a b -> p a b
forall (p :: * -> * -> *) c a b.
Monoidal p =>
p () c -> p a b -> p a b
>* p a b
p) p (a, [a]) (b, [b]) -> p () () -> p (a, [a]) (b, [b])
forall (p :: * -> * -> *) a b c.
Monoidal p =>
p a b -> p () c -> p a b
*< SepBy p -> p () ()
forall (p :: * -> * -> *). SepBy p -> p () ()
endBy SepBy p
sep

{- |
Left associate a binary constructor pattern to sequence one or more times.
-}
chainl1
  :: (Choice p, Cochoice p, Distributor p)
  => APartialIso a b (a,a) (b,b) -- ^ binary constructor pattern
  -> SepBy p -> p a b -> p a b
chainl1 :: forall (p :: * -> * -> *) a b.
(Choice p, Cochoice p, Distributor p) =>
APartialIso a b (a, a) (b, b) -> SepBy p -> p a b -> p a b
chainl1 APartialIso a b (a, a) (b, b)
pat SepBy p
sep p a b
p =
  APartialIso (b, [b]) (a, [a]) b a
-> PartialIso a b (a, [a]) (b, [b])
forall b a t s. APartialIso b a t s -> PartialIso s t a b
coPartialIso (APartialIso (b, b) (a, a) b a -> PartialIso (b, [b]) (a, [a]) b a
forall s t a b c d.
(AsEmpty s, AsEmpty t, Cons s t a b) =>
APartialIso (c, a) (d, b) c d -> PartialIso (c, s) (d, t) c d
difoldl (APartialIso a b (a, a) (b, b) -> PartialIso (b, b) (a, a) b a
forall b a t s. APartialIso b a t s -> PartialIso s t a b
coPartialIso APartialIso a b (a, a) (b, b)
pat)) (PartialExchange (a, [a]) (b, [b]) (a, [a]) (Maybe (b, [b]))
 -> PartialExchange (a, [a]) (b, [b]) a (Maybe b))
-> p (a, [a]) (b, [b]) -> p a b
forall (p :: * -> * -> *) s t a b.
(Choice p, Cochoice p) =>
APartialIso s t a b -> p a b -> p s t
>?<
    SepBy p -> p () ()
forall (p :: * -> * -> *). SepBy p -> p () ()
beginBy SepBy p
sep p () () -> p (a, [a]) (b, [b]) -> p (a, [a]) (b, [b])
forall (p :: * -> * -> *) c a b.
Monoidal p =>
p () c -> p a b -> p a b
>* 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 (SepBy p -> p () ()
forall (p :: * -> * -> *). SepBy p -> p () ()
separateBy SepBy p
sep p () () -> p a b -> p a b
forall (p :: * -> * -> *) c a b.
Monoidal p =>
p () c -> p a b -> p a b
>* p a b
p) p (a, [a]) (b, [b]) -> p () () -> p (a, [a]) (b, [b])
forall (p :: * -> * -> *) a b c.
Monoidal p =>
p a b -> p () c -> p a b
*< SepBy p -> p () ()
forall (p :: * -> * -> *). SepBy p -> p () ()
endBy SepBy p
sep

{- |
Right associate a binary constructor pattern to sequence one or more times.
-}
chainr1
  :: (Choice p, Cochoice p, Distributor p)
  => APartialIso a b (a,a) (b,b) -- ^ binary constructor pattern
  -> SepBy p -> p a b -> p a b
chainr1 :: forall (p :: * -> * -> *) a b.
(Choice p, Cochoice p, Distributor p) =>
APartialIso a b (a, a) (b, b) -> SepBy p -> p a b -> p a b
chainr1 APartialIso a b (a, a) (b, b)
c2 SepBy p
sep p a b
p =
  APartialIso ([b], b) ([a], a) b a
-> PartialIso a b ([a], a) ([b], b)
forall b a t s. APartialIso b a t s -> PartialIso s t a b
coPartialIso (APartialIso (b, b) (a, a) b a -> PartialIso ([b], b) ([a], a) b a
forall s t a b c d.
(AsEmpty s, AsEmpty t, Cons s t a b) =>
APartialIso (a, c) (b, d) c d -> PartialIso (s, c) (t, d) c d
difoldr (APartialIso a b (a, a) (b, b) -> PartialIso (b, b) (a, a) b a
forall b a t s. APartialIso b a t s -> PartialIso s t a b
coPartialIso APartialIso a b (a, a) (b, b)
c2)) (PartialExchange ([a], a) ([b], b) ([a], a) (Maybe ([b], b))
 -> PartialExchange ([a], a) ([b], b) a (Maybe b))
-> p ([a], a) ([b], b) -> p a b
forall (p :: * -> * -> *) s t a b.
(Choice p, Cochoice p) =>
APartialIso s t a b -> p a b -> p s t
>?<
    SepBy p -> p () ()
forall (p :: * -> * -> *). SepBy p -> p () ()
beginBy SepBy p
sep p () () -> p ([a], a) ([b], b) -> p ([a], a) ([b], b)
forall (p :: * -> * -> *) c a b.
Monoidal p =>
p () c -> p a b -> p a b
>* 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 b -> p () () -> p a b
forall (p :: * -> * -> *) a b c.
Monoidal p =>
p a b -> p () c -> p a b
*< SepBy p -> p () ()
forall (p :: * -> * -> *). SepBy p -> p () ()
separateBy SepBy p
sep) 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 p ([a], a) ([b], b) -> p () () -> p ([a], a) ([b], b)
forall (p :: * -> * -> *) a b c.
Monoidal p =>
p a b -> p () c -> p a b
*< SepBy p -> p () ()
forall (p :: * -> * -> *). SepBy p -> p () ()
endBy SepBy p
sep

{- |
Left associate a binary constructor pattern to sequence one or more times,
or use a nilary constructor pattern to sequence zero times.
-}
chainl
  :: (Alternator p, Filtrator p)
  => APartialIso a b (a,a) (b,b) -- ^ binary constructor pattern
  -> APartialIso a b () () -- ^ nilary constructor pattern
  -> SepBy p -> p a b -> p a b
chainl :: forall (p :: * -> * -> *) a b.
(Alternator p, Filtrator p) =>
APartialIso a b (a, a) (b, b)
-> APartialIso a b () () -> SepBy p -> p a b -> p a b
chainl APartialIso a b (a, a) (b, b)
c2 APartialIso a b () ()
c0 SepBy p
sep p a b
p =
  SepBy p -> p () ()
forall (p :: * -> * -> *). SepBy p -> p () ()
beginBy SepBy p
sep p () () -> p a b -> p a b
forall (p :: * -> * -> *) c a b.
Monoidal p =>
p () c -> p a b -> p a b
>*
  (APartialIso a b () ()
c0 APartialIso a b () () -> p () () -> p a b
forall (p :: * -> * -> *) s t a b.
(Choice p, Cochoice p) =>
APartialIso s t a b -> p a b -> p s t
>?< p () ()
forall (p :: * -> * -> *). Monoidal p => p () ()
oneP 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
<|> APartialIso a b (a, a) (b, b) -> SepBy p -> p a b -> p a b
forall (p :: * -> * -> *) a b.
(Choice p, Cochoice p, Distributor p) =>
APartialIso a b (a, a) (b, b) -> SepBy p -> p a b -> p a b
chainl1 APartialIso a b (a, a) (b, b)
c2 (p () () -> SepBy p
forall (p :: * -> * -> *). Monoidal p => p () () -> SepBy p
sepBy (SepBy p -> p () ()
forall (p :: * -> * -> *). SepBy p -> p () ()
separateBy SepBy p
sep)) p a b
p)
  p a b -> p () () -> p a b
forall (p :: * -> * -> *) a b c.
Monoidal p =>
p a b -> p () c -> p a b
*< SepBy p -> p () ()
forall (p :: * -> * -> *). SepBy p -> p () ()
endBy SepBy p
sep

{- |
Right associate a binary constructor pattern to sequence one or more times,
or use a nilary constructor pattern to sequence zero times.
-}
chainr
  :: (Alternator p, Filtrator p)
  => APartialIso a b (a,a) (b,b) -- ^ binary constructor pattern
  -> APartialIso a b () () -- ^ nilary constructor pattern
  -> SepBy p -> p a b -> p a b
chainr :: forall (p :: * -> * -> *) a b.
(Alternator p, Filtrator p) =>
APartialIso a b (a, a) (b, b)
-> APartialIso a b () () -> SepBy p -> p a b -> p a b
chainr APartialIso a b (a, a) (b, b)
c2 APartialIso a b () ()
c0 SepBy p
sep p a b
p =
  SepBy p -> p () ()
forall (p :: * -> * -> *). SepBy p -> p () ()
beginBy SepBy p
sep p () () -> p a b -> p a b
forall (p :: * -> * -> *) c a b.
Monoidal p =>
p () c -> p a b -> p a b
>*
  (APartialIso a b () ()
c0 APartialIso a b () () -> p () () -> p a b
forall (p :: * -> * -> *) s t a b.
(Choice p, Cochoice p) =>
APartialIso s t a b -> p a b -> p s t
>?< p () ()
forall (p :: * -> * -> *). Monoidal p => p () ()
oneP 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
<|> APartialIso a b (a, a) (b, b) -> SepBy p -> p a b -> p a b
forall (p :: * -> * -> *) a b.
(Choice p, Cochoice p, Distributor p) =>
APartialIso a b (a, a) (b, b) -> SepBy p -> p a b -> p a b
chainr1 APartialIso a b (a, a) (b, b)
c2 (p () () -> SepBy p
forall (p :: * -> * -> *). Monoidal p => p () () -> SepBy p
sepBy (SepBy p -> p () ()
forall (p :: * -> * -> *). SepBy p -> p () ()
separateBy SepBy p
sep)) p a b
p)
  p a b -> p () () -> p a b
forall (p :: * -> * -> *) a b c.
Monoidal p =>
p a b -> p () c -> p a b
*< SepBy p -> p () ()
forall (p :: * -> * -> *). SepBy p -> p () ()
endBy SepBy p
sep

-- Tokenized --

{- | `Tokenized` serves two different purposes.
The `anyToken` method is used

* by token-stream printer/parsers, to sequence a single token;
* and for concrete optics, as an identity morphism.

In the former case the associated input and output token types
are same. In the latter case, observe that `Identical` is
a free `Tokenized`.
-}
class Tokenized a b p | p -> a, p -> b where
  anyToken :: p a b
instance Tokenized a b (Identical a b) where
  anyToken :: Identical a b a b
anyToken = Identical a b a b
forall {k} {k1} (a :: k) (b :: k1). Identical a b a b
Identical
instance Tokenized a b (Exchange a b) where
  anyToken :: Exchange a b a b
anyToken = (a -> a) -> (b -> b) -> Exchange a b a b
forall a b s t. (s -> a) -> (b -> t) -> Exchange a b s t
Exchange a -> a
forall a. a -> a
id b -> b
forall a. a -> a
id
instance Tokenized a b (Market a b) where
  anyToken :: Market a b a b
anyToken = (b -> b) -> (a -> Either b a) -> Market a b a b
forall a b s t. (b -> t) -> (s -> Either t a) -> Market a b s t
Market b -> b
forall a. a -> a
id a -> Either b a
forall a b. b -> Either a b
Right
instance Tokenized a b (PartialExchange a b) where
  anyToken :: PartialExchange a b a b
anyToken = (a -> Maybe a) -> (b -> Maybe b) -> PartialExchange a b a b
forall a b s t.
(s -> Maybe a) -> (b -> Maybe t) -> PartialExchange a b s t
PartialExchange a -> Maybe a
forall a. a -> Maybe a
Just b -> Maybe b
forall a. a -> Maybe a
Just

{- | Sequences a single token that satisfies a predicate. -}
satisfy :: (Choice p, Cochoice p, Tokenized c c p) => (c -> Bool) -> p c c
satisfy :: forall (p :: * -> * -> *) c.
(Choice p, Cochoice p, Tokenized c c p) =>
(c -> Bool) -> p c c
satisfy c -> Bool
f = (c -> Bool) -> PartialIso' c c
forall a. (a -> Bool) -> PartialIso' a a
satisfied c -> Bool
f (PartialExchange c c c (Maybe c)
 -> PartialExchange c c c (Maybe c))
-> p c c -> p c c
forall (p :: * -> * -> *) s t a b.
(Choice p, Cochoice p) =>
APartialIso s t a b -> p a b -> p s t
>?< p c c
forall a b (p :: * -> * -> *). Tokenized a b p => p a b
anyToken

{- | Sequences a single specified `token`. -}
token :: (Cochoice p, Eq c, Tokenized c c p) => c -> p () ()
token :: forall (p :: * -> * -> *) c.
(Cochoice p, Eq c, Tokenized c c p) =>
c -> p () ()
token c
c = c -> Prism' c ()
forall a. Eq a => a -> Prism' a ()
only c
c (Market () () () (Identity ()) -> Market () () c (Identity c))
-> p c c -> p () ()
forall (p :: * -> * -> *) b a t s.
Cochoice p =>
APrism b a t s -> p a b -> p s t
?< p c c
forall a b (p :: * -> * -> *). Tokenized a b p => p a b
anyToken

{- | Sequences a specified stream of `tokens`.
It can be used as a default definition for the `fromString`
method of `IsString` when `Tokenized` `Char` `Char`.
-}
tokens :: (Cochoice p, Monoidal p, Eq c, Tokenized c c p) => [c] -> p () ()
tokens :: forall (p :: * -> * -> *) c.
(Cochoice p, Monoidal p, Eq c, Tokenized c c p) =>
[c] -> p () ()
tokens [] = p () ()
forall (p :: * -> * -> *). Monoidal p => p () ()
oneP
tokens (c
c:[c]
cs) = c -> p () ()
forall (p :: * -> * -> *) c.
(Cochoice p, Eq c, Tokenized c c p) =>
c -> p () ()
token c
c p () () -> p () () -> p () ()
forall a b. p () a -> p () b -> p () b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [c] -> p () ()
forall (p :: * -> * -> *) c.
(Cochoice p, Monoidal p, Eq c, Tokenized c c p) =>
[c] -> p () ()
tokens [c]
cs

-- Printor/Parsor --

{- | A function from things to containers of
functions of strings to strings.
`Printor` is a degenerate `Profunctor` which
is constant in its covariant argument.
-}
newtype Printor s f a b = Printor {forall s (f :: * -> *) a b. Printor s f a b -> a -> f (s -> s)
runPrintor :: a -> f (s -> s)}
  deriving (forall a b. (a -> b) -> Printor s f a a -> Printor s f a b)
-> (forall a b. a -> Printor s f a b -> Printor s f a a)
-> Functor (Printor s f a)
forall a b. a -> Printor s f a b -> Printor s f a a
forall a b. (a -> b) -> Printor s f a a -> Printor s f a b
forall s (f :: * -> *) a a b.
a -> Printor s f a b -> Printor s f a a
forall s (f :: * -> *) a a b.
(a -> b) -> Printor s f a a -> Printor s f a b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall s (f :: * -> *) a a b.
(a -> b) -> Printor s f a a -> Printor s f a b
fmap :: forall a b. (a -> b) -> Printor s f a a -> Printor s f a b
$c<$ :: forall s (f :: * -> *) a a b.
a -> Printor s f a b -> Printor s f a a
<$ :: forall a b. a -> Printor s f a b -> Printor s f a a
Functor
instance Contravariant (Printor s f a) where
  contramap :: forall a' a. (a' -> a) -> Printor s f a a -> Printor s f a a'
contramap a' -> a
_ (Printor a -> f (s -> s)
p) = (a -> f (s -> s)) -> Printor s f a a'
forall s (f :: * -> *) a b. (a -> f (s -> s)) -> Printor s f a b
Printor a -> f (s -> s)
p
instance Applicative f => Applicative (Printor s f a) where
  pure :: forall a. a -> Printor s f a a
pure a
_ = (a -> f (s -> s)) -> Printor s f a a
forall s (f :: * -> *) a b. (a -> f (s -> s)) -> Printor s f a b
Printor (\a
_ -> (s -> s) -> f (s -> s)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure s -> s
forall a. a -> a
id)
  Printor a -> f (s -> s)
p <*> :: forall a b.
Printor s f a (a -> b) -> Printor s f a a -> Printor s f a b
<*> Printor a -> f (s -> s)
q = (a -> f (s -> s)) -> Printor s f a b
forall s (f :: * -> *) a b. (a -> f (s -> s)) -> Printor s f a b
Printor (\a
a -> (s -> s) -> (s -> s) -> s -> s
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) ((s -> s) -> (s -> s) -> s -> s)
-> f (s -> s) -> f ((s -> s) -> s -> s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f (s -> s)
p a
a f ((s -> s) -> s -> s) -> f (s -> s) -> f (s -> s)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f (s -> s)
q a
a)
instance Alternative f => Alternative (Printor s f a) where
  empty :: forall a. Printor s f a a
empty = (a -> f (s -> s)) -> Printor s f a a
forall s (f :: * -> *) a b. (a -> f (s -> s)) -> Printor s f a b
Printor (\a
_ -> f (s -> s)
forall a. f a
forall (f :: * -> *) a. Alternative f => f a
empty)
  Printor a -> f (s -> s)
p <|> :: forall a. Printor s f a a -> Printor s f a a -> Printor s f a a
<|> Printor a -> f (s -> s)
q = (a -> f (s -> s)) -> Printor s f a a
forall s (f :: * -> *) a b. (a -> f (s -> s)) -> Printor s f a b
Printor (\a
a -> a -> f (s -> s)
p a
a f (s -> s) -> f (s -> s) -> f (s -> s)
forall a. f a -> f a -> f a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> a -> f (s -> s)
q a
a)
instance Filterable (Printor s f a) where
  mapMaybe :: forall a b. (a -> Maybe b) -> Printor s f a a -> Printor s f a b
mapMaybe a -> Maybe b
_ (Printor a -> f (s -> s)
p) = (a -> f (s -> s)) -> Printor s f a b
forall s (f :: * -> *) a b. (a -> f (s -> s)) -> Printor s f a b
Printor a -> f (s -> s)
p
instance Profunctor (Printor s f) where
  dimap :: forall a b c d.
(a -> b) -> (c -> d) -> Printor s f b c -> Printor s f a d
dimap a -> b
f c -> d
_ (Printor b -> f (s -> s)
p) = (a -> f (s -> s)) -> Printor s f a d
forall s (f :: * -> *) a b. (a -> f (s -> s)) -> Printor s f a b
Printor (b -> f (s -> s)
p (b -> f (s -> s)) -> (a -> b) -> a -> f (s -> s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)
instance Alternative f => Choice (Printor s f) where
  left' :: forall a b c.
Printor s f a b -> Printor s f (Either a c) (Either b c)
left' = Either (Printor s f a b) (Printor s f c c)
-> Printor s f (Either a c) (Either b c)
forall a b c d.
Either (Printor s f a b) (Printor s f c d)
-> Printor s f (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 (Printor s f a b) (Printor s f c c)
 -> Printor s f (Either a c) (Either b c))
-> (Printor s f a b -> Either (Printor s f a b) (Printor s f c c))
-> Printor s f a b
-> Printor s f (Either a c) (Either b c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Printor s f a b -> Either (Printor s f a b) (Printor s f c c)
forall a b. a -> Either a b
Left
  right' :: forall a b c.
Printor s f a b -> Printor s f (Either c a) (Either c b)
right' = Either (Printor s f c c) (Printor s f a b)
-> Printor s f (Either c a) (Either c b)
forall a b c d.
Either (Printor s f a b) (Printor s f c d)
-> Printor s f (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 (Printor s f c c) (Printor s f a b)
 -> Printor s f (Either c a) (Either c b))
-> (Printor s f a b -> Either (Printor s f c c) (Printor s f a b))
-> Printor s f a b
-> Printor s f (Either c a) (Either c b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Printor s f a b -> Either (Printor s f c c) (Printor s f a b)
forall a b. b -> Either a b
Right
instance Cochoice (Printor s f) where
  unleft :: forall a d b.
Printor s f (Either a d) (Either b d) -> Printor s f a b
unleft = (Printor s f a b, Printor s f d d) -> Printor s f a b
forall a b. (a, b) -> a
fst ((Printor s f a b, Printor s f d d) -> Printor s f a b)
-> (Printor s f (Either a d) (Either b d)
    -> (Printor s f a b, Printor s f d d))
-> Printor s f (Either a d) (Either b d)
-> Printor s f a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Printor s f (Either a d) (Either b d)
-> (Printor s f a b, Printor s f d d)
forall a c b d.
Printor s f (Either a c) (Either b d)
-> (Printor s f a b, Printor s f c d)
forall (p :: * -> * -> *) a c b d.
Filtrator p =>
p (Either a c) (Either b d) -> (p a b, p c d)
filtrate
  unright :: forall d a b.
Printor s f (Either d a) (Either d b) -> Printor s f a b
unright = (Printor s f d d, Printor s f a b) -> Printor s f a b
forall a b. (a, b) -> b
snd ((Printor s f d d, Printor s f a b) -> Printor s f a b)
-> (Printor s f (Either d a) (Either d b)
    -> (Printor s f d d, Printor s f a b))
-> Printor s f (Either d a) (Either d b)
-> Printor s f a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Printor s f (Either d a) (Either d b)
-> (Printor s f d d, Printor s f a b)
forall a c b d.
Printor s f (Either a c) (Either b d)
-> (Printor s f a b, Printor s f c d)
forall (p :: * -> * -> *) a c b d.
Filtrator p =>
p (Either a c) (Either b d) -> (p a b, p c d)
filtrate
instance Applicative f => Distributor (Printor s f) where
  zeroP :: Printor s f Void Void
zeroP = (Void -> f (s -> s)) -> Printor s f Void Void
forall s (f :: * -> *) a b. (a -> f (s -> s)) -> Printor s f a b
Printor Void -> f (s -> s)
forall a. Void -> a
absurd
  Printor a -> f (s -> s)
p >+< :: forall a b c d.
Printor s f a b
-> Printor s f c d -> Printor s f (Either a c) (Either b d)
>+< Printor c -> f (s -> s)
q = (Either a c -> f (s -> s)) -> Printor s f (Either a c) (Either b d)
forall s (f :: * -> *) a b. (a -> f (s -> s)) -> Printor s f a b
Printor ((a -> f (s -> s)) -> (c -> f (s -> s)) -> Either a c -> f (s -> s)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either a -> f (s -> s)
p c -> f (s -> s)
q)
instance Alternative f => Alternator (Printor s f) where
  alternate :: forall a b c d.
Either (Printor s f a b) (Printor s f c d)
-> Printor s f (Either a c) (Either b d)
alternate = \case
    Left (Printor a -> f (s -> s)
p) -> (Either a c -> f (s -> s)) -> Printor s f (Either a c) (Either b d)
forall s (f :: * -> *) a b. (a -> f (s -> s)) -> Printor s f a b
Printor ((a -> f (s -> s)) -> (c -> f (s -> s)) -> Either a c -> f (s -> s)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either a -> f (s -> s)
p (\c
_ -> f (s -> s)
forall a. f a
forall (f :: * -> *) a. Alternative f => f a
empty))
    Right (Printor c -> f (s -> s)
p) -> (Either a c -> f (s -> s)) -> Printor s f (Either a c) (Either b d)
forall s (f :: * -> *) a b. (a -> f (s -> s)) -> Printor s f a b
Printor ((a -> f (s -> s)) -> (c -> f (s -> s)) -> Either a c -> f (s -> s)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\a
_ -> f (s -> s)
forall a. f a
forall (f :: * -> *) a. Alternative f => f a
empty) c -> f (s -> s)
p)
instance Filtrator (Printor s f) where
  filtrate :: forall a c b d.
Printor s f (Either a c) (Either b d)
-> (Printor s f a b, Printor s f c d)
filtrate (Printor Either a c -> f (s -> s)
p) = ((a -> f (s -> s)) -> Printor s f a b
forall s (f :: * -> *) a b. (a -> f (s -> s)) -> Printor s f a b
Printor (Either a c -> f (s -> s)
p (Either a c -> f (s -> s)) -> (a -> Either a c) -> a -> f (s -> s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either a c
forall a b. a -> Either a b
Left), (c -> f (s -> s)) -> Printor s f c d
forall s (f :: * -> *) a b. (a -> f (s -> s)) -> Printor s f a b
Printor (Either a c -> f (s -> s)
p (Either a c -> f (s -> s)) -> (c -> Either a c) -> c -> f (s -> s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> Either a c
forall a b. b -> Either a b
Right))
instance (Applicative f, Cons s s c c)
  => Tokenized c c (Printor s f) where
    anyToken :: Printor s f c c
anyToken = (c -> f (s -> s)) -> Printor s f c c
forall s (f :: * -> *) a b. (a -> f (s -> s)) -> Printor s f a b
Printor ((s -> s) -> f (s -> s)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((s -> s) -> f (s -> s)) -> (c -> s -> s) -> c -> f (s -> s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> s -> s
forall s a. Cons s s a a => a -> s -> s
cons)
instance (Applicative f, Cons s s Char Char)
  => IsString (Printor s f () ()) where
    fromString :: String -> Printor s f () ()
fromString = String -> Printor s f () ()
forall (p :: * -> * -> *) c.
(Cochoice p, Monoidal p, Eq c, Tokenized c c p) =>
[c] -> p () ()
tokens

{- | A function from strings to containers of
pairs of things and strings.
`Parsor` is a degenerate `Profunctor` which
is constant in its contravariant argument.
-}
newtype Parsor s f a b = Parsor {forall s (f :: * -> *) a b. Parsor s f a b -> s -> f (b, s)
runParsor :: s -> f (b,s)}
  deriving (forall a b. (a -> b) -> Parsor s f a a -> Parsor s f a b)
-> (forall a b. a -> Parsor s f a b -> Parsor s f a a)
-> Functor (Parsor s f a)
forall a b. a -> Parsor s f a b -> Parsor s f a a
forall a b. (a -> b) -> Parsor s f a a -> Parsor s f a b
forall s (f :: * -> *) a a b.
Functor f =>
a -> Parsor s f a b -> Parsor s f a a
forall s (f :: * -> *) a a b.
Functor f =>
(a -> b) -> Parsor s f a a -> Parsor s f a b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall s (f :: * -> *) a a b.
Functor f =>
(a -> b) -> Parsor s f a a -> Parsor s f a b
fmap :: forall a b. (a -> b) -> Parsor s f a a -> Parsor s f a b
$c<$ :: forall s (f :: * -> *) a a b.
Functor f =>
a -> Parsor s f a b -> Parsor s f a a
<$ :: forall a b. a -> Parsor s f a b -> Parsor s f a a
Functor
instance Monad f => Applicative (Parsor s f a) where
  pure :: forall a. a -> Parsor s f a a
pure a
b = (s -> f (a, s)) -> Parsor s f a a
forall s (f :: * -> *) a b. (s -> f (b, s)) -> Parsor s f a b
Parsor (\s
str -> (a, s) -> f (a, s)
forall a. a -> f a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
b,s
str))
  Parsor s -> f (a -> b, s)
x <*> :: forall a b.
Parsor s f a (a -> b) -> Parsor s f a a -> Parsor s f a b
<*> Parsor s -> f (a, s)
y = (s -> f (b, s)) -> Parsor s f a b
forall s (f :: * -> *) a b. (s -> f (b, s)) -> Parsor s f a b
Parsor ((s -> f (b, s)) -> Parsor s f a b)
-> (s -> f (b, s)) -> Parsor s f a b
forall a b. (a -> b) -> a -> b
$ \s
str -> do
    (a -> b
f, s
str') <- s -> f (a -> b, s)
x s
str
    (a
a, s
str'') <- s -> f (a, s)
y s
str'
    (b, s) -> f (b, s)
forall a. a -> f a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> b
f a
a, s
str'')
instance (Alternative f, Monad f) => Alternative (Parsor s f a) where
  empty :: forall a. Parsor s f a a
empty = (s -> f (a, s)) -> Parsor s f a a
forall s (f :: * -> *) a b. (s -> f (b, s)) -> Parsor s f a b
Parsor (\s
_ -> f (a, s)
forall a. f a
forall (f :: * -> *) a. Alternative f => f a
empty)
  Parsor s -> f (a, s)
p <|> :: forall a. Parsor s f a a -> Parsor s f a a -> Parsor s f a a
<|> Parsor s -> f (a, s)
q = (s -> f (a, s)) -> Parsor s f a a
forall s (f :: * -> *) a b. (s -> f (b, s)) -> Parsor s f a b
Parsor (\s
str -> s -> f (a, s)
p s
str f (a, s) -> f (a, s) -> f (a, s)
forall a. f a -> f a -> f a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> s -> f (a, s)
q s
str)
instance Filterable f => Filterable (Parsor s f a) where
  mapMaybe :: forall a b. (a -> Maybe b) -> Parsor s f a a -> Parsor s f a b
mapMaybe a -> Maybe b
f (Parsor s -> f (a, s)
p) = (s -> f (b, s)) -> Parsor s f a b
forall s (f :: * -> *) a b. (s -> f (b, s)) -> Parsor s f a b
Parsor (((a, s) -> Maybe (b, s)) -> f (a, s) -> f (b, s)
forall a b. (a -> Maybe b) -> f a -> f b
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe (\(a
a,s
str) -> (,s
str) (b -> (b, s)) -> Maybe b -> Maybe (b, s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> Maybe b
f a
a) (f (a, s) -> f (b, s)) -> (s -> f (a, s)) -> s -> f (b, s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> f (a, s)
p)
instance Functor f => Bifunctor (Parsor s f) where
  bimap :: forall a b c d.
(a -> b) -> (c -> d) -> Parsor s f a c -> Parsor s f b d
bimap a -> b
_ c -> d
g (Parsor s -> f (c, s)
p) = (s -> f (d, s)) -> Parsor s f b d
forall s (f :: * -> *) a b. (s -> f (b, s)) -> Parsor s f a b
Parsor (((c, s) -> (d, s)) -> f (c, s) -> f (d, s)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(c
c,s
str) -> (c -> d
g c
c, s
str)) (f (c, s) -> f (d, s)) -> (s -> f (c, s)) -> s -> f (d, s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> f (c, s)
p)
instance Functor f => Profunctor (Parsor s f) where
  dimap :: forall a b c d.
(a -> b) -> (c -> d) -> Parsor s f b c -> Parsor s f a d
dimap a -> b
_ c -> d
g (Parsor s -> f (c, s)
p) = (s -> f (d, s)) -> Parsor s f a d
forall s (f :: * -> *) a b. (s -> f (b, s)) -> Parsor s f a b
Parsor (((c, s) -> (d, s)) -> f (c, s) -> f (d, s)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(c
c,s
str) -> (c -> d
g c
c, s
str)) (f (c, s) -> f (d, s)) -> (s -> f (c, s)) -> s -> f (d, s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> f (c, s)
p)
instance (Monad f, Alternative f) => Choice (Parsor s f) where
  left' :: forall a b c.
Parsor s f a b -> Parsor s f (Either a c) (Either b c)
left' = Either (Parsor s f a b) (Parsor s f c c)
-> Parsor s f (Either a c) (Either b c)
forall a b c d.
Either (Parsor s f a b) (Parsor s f c d)
-> Parsor s f (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 (Parsor s f a b) (Parsor s f c c)
 -> Parsor s f (Either a c) (Either b c))
-> (Parsor s f a b -> Either (Parsor s f a b) (Parsor s f c c))
-> Parsor s f a b
-> Parsor s f (Either a c) (Either b c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parsor s f a b -> Either (Parsor s f a b) (Parsor s f c c)
forall a b. a -> Either a b
Left
  right' :: forall a b c.
Parsor s f a b -> Parsor s f (Either c a) (Either c b)
right' = Either (Parsor s f c c) (Parsor s f a b)
-> Parsor s f (Either c a) (Either c b)
forall a b c d.
Either (Parsor s f a b) (Parsor s f c d)
-> Parsor s f (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 (Parsor s f c c) (Parsor s f a b)
 -> Parsor s f (Either c a) (Either c b))
-> (Parsor s f a b -> Either (Parsor s f c c) (Parsor s f a b))
-> Parsor s f a b
-> Parsor s f (Either c a) (Either c b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parsor s f a b -> Either (Parsor s f c c) (Parsor s f a b)
forall a b. b -> Either a b
Right
instance Filterable f => Cochoice (Parsor s f) where
  unleft :: forall a d b.
Parsor s f (Either a d) (Either b d) -> Parsor s f a b
unleft = (Parsor s f a b, Parsor s f d d) -> Parsor s f a b
forall a b. (a, b) -> a
fst ((Parsor s f a b, Parsor s f d d) -> Parsor s f a b)
-> (Parsor s f (Either a d) (Either b d)
    -> (Parsor s f a b, Parsor s f d d))
-> Parsor s f (Either a d) (Either b d)
-> Parsor s f a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parsor s f (Either a d) (Either b d)
-> (Parsor s f a b, Parsor s f d d)
forall a c b d.
Parsor s f (Either a c) (Either b d)
-> (Parsor s f a b, Parsor s f c d)
forall (p :: * -> * -> *) a c b d.
Filtrator p =>
p (Either a c) (Either b d) -> (p a b, p c d)
filtrate
  unright :: forall d a b.
Parsor s f (Either d a) (Either d b) -> Parsor s f a b
unright = (Parsor s f d d, Parsor s f a b) -> Parsor s f a b
forall a b. (a, b) -> b
snd ((Parsor s f d d, Parsor s f a b) -> Parsor s f a b)
-> (Parsor s f (Either d a) (Either d b)
    -> (Parsor s f d d, Parsor s f a b))
-> Parsor s f (Either d a) (Either d b)
-> Parsor s f a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parsor s f (Either d a) (Either d b)
-> (Parsor s f d d, Parsor s f a b)
forall a c b d.
Parsor s f (Either a c) (Either b d)
-> (Parsor s f a b, Parsor s f c d)
forall (p :: * -> * -> *) a c b d.
Filtrator p =>
p (Either a c) (Either b d) -> (p a b, p c d)
filtrate
instance (Monad f, Alternative f) => Distributor (Parsor s f) where
  zeroP :: Parsor s f Void Void
zeroP = (s -> f (Void, s)) -> Parsor s f Void Void
forall s (f :: * -> *) a b. (s -> f (b, s)) -> Parsor s f a b
Parsor (\s
_ -> f (Void, s)
forall a. f a
forall (f :: * -> *) a. Alternative f => f a
empty)
  Parsor s -> f (b, s)
p >+< :: forall a b c d.
Parsor s f a b
-> Parsor s f c d -> Parsor s f (Either a c) (Either b d)
>+< Parsor s -> f (d, s)
q = (s -> f (Either b d, s)) -> Parsor s f (Either a c) (Either b d)
forall s (f :: * -> *) a b. (s -> f (b, s)) -> Parsor s f a b
Parsor ((s -> f (Either b d, s)) -> Parsor s f (Either a c) (Either b d))
-> (s -> f (Either b d, s)) -> Parsor s f (Either a c) (Either b d)
forall a b. (a -> b) -> a -> b
$ \s
str ->
    (\(b
b,s
str') -> (b -> Either b d
forall a b. a -> Either a b
Left b
b, s
str')) ((b, s) -> (Either b d, s)) -> f (b, s) -> f (Either b d, s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> f (b, s)
p s
str
    f (Either b d, s) -> f (Either b d, s) -> f (Either b d, s)
forall a. f a -> f a -> f a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
    (\(d
d,s
str') -> (d -> Either b d
forall a b. b -> Either a b
Right d
d, s
str')) ((d, s) -> (Either b d, s)) -> f (d, s) -> f (Either b d, s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> f (d, s)
q s
str
instance (Monad f, Alternative f) => Alternator (Parsor s f) where
  alternate :: forall a b c d.
Either (Parsor s f a b) (Parsor s f c d)
-> Parsor s f (Either a c) (Either b d)
alternate = \case
    Left (Parsor s -> f (b, s)
p) -> (s -> f (Either b d, s)) -> Parsor s f (Either a c) (Either b d)
forall s (f :: * -> *) a b. (s -> f (b, s)) -> Parsor s f a b
Parsor (((b, s) -> (Either b d, s)) -> f (b, s) -> f (Either b d, s)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(b
b, s
str) -> (b -> Either b d
forall a b. a -> Either a b
Left b
b, s
str)) (f (b, s) -> f (Either b d, s))
-> (s -> f (b, s)) -> s -> f (Either b d, s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> f (b, s)
p)
    Right (Parsor s -> f (d, s)
p) -> (s -> f (Either b d, s)) -> Parsor s f (Either a c) (Either b d)
forall s (f :: * -> *) a b. (s -> f (b, s)) -> Parsor s f a b
Parsor (((d, s) -> (Either b d, s)) -> f (d, s) -> f (Either b d, s)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(d
b, s
str) -> (d -> Either b d
forall a b. b -> Either a b
Right d
b, s
str)) (f (d, s) -> f (Either b d, s))
-> (s -> f (d, s)) -> s -> f (Either b d, s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> f (d, s)
p)
instance Filterable f => Filtrator (Parsor s f) where
  filtrate :: forall a c b d.
Parsor s f (Either a c) (Either b d)
-> (Parsor s f a b, Parsor s f c d)
filtrate (Parsor s -> f (Either b d, s)
p) =
    ( (s -> f (b, s)) -> Parsor s f a b
forall s (f :: * -> *) a b. (s -> f (b, s)) -> Parsor s f a b
Parsor (((Either b d, s) -> Maybe (b, s)) -> f (Either b d, s) -> f (b, s)
forall a b. (a -> Maybe b) -> f a -> f b
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe (Either b d, s) -> Maybe (b, s)
forall {a} {b} {b}. (Either a b, b) -> Maybe (a, b)
leftMay (f (Either b d, s) -> f (b, s))
-> (s -> f (Either b d, s)) -> s -> f (b, s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> f (Either b d, s)
p)
    , (s -> f (d, s)) -> Parsor s f c d
forall s (f :: * -> *) a b. (s -> f (b, s)) -> Parsor s f a b
Parsor (((Either b d, s) -> Maybe (d, s)) -> f (Either b d, s) -> f (d, s)
forall a b. (a -> Maybe b) -> f a -> f b
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe (Either b d, s) -> Maybe (d, s)
forall {a} {a} {b}. (Either a a, b) -> Maybe (a, b)
rightMay (f (Either b d, s) -> f (d, s))
-> (s -> f (Either b d, s)) -> s -> f (d, s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> f (Either b d, s)
p)
    ) where
      leftMay :: (Either a b, b) -> Maybe (a, b)
leftMay (Either a b
e, b
str) = (a -> Maybe (a, b))
-> (b -> Maybe (a, b)) -> Either a b -> Maybe (a, b)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\a
b -> (a, b) -> Maybe (a, b)
forall a. a -> Maybe a
Just (a
b, b
str)) (\b
_ -> Maybe (a, b)
forall a. Maybe a
Nothing) Either a b
e
      rightMay :: (Either a a, b) -> Maybe (a, b)
rightMay (Either a a
e, b
str) = (a -> Maybe (a, b))
-> (a -> Maybe (a, b)) -> Either a a -> Maybe (a, b)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\a
_ -> Maybe (a, b)
forall a. Maybe a
Nothing) (\a
b -> (a, b) -> Maybe (a, b)
forall a. a -> Maybe a
Just (a
b, b
str)) Either a a
e
instance (Alternative f, Cons s s c c)
  => Tokenized c c (Parsor s f) where
    anyToken :: Parsor s f c c
anyToken = (s -> f (c, s)) -> Parsor s f c c
forall s (f :: * -> *) a b. (s -> f (b, s)) -> Parsor s f a b
Parsor (\s
str -> f (c, s) -> ((c, s) -> f (c, s)) -> Maybe (c, s) -> f (c, s)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe f (c, s)
forall a. f a
forall (f :: * -> *) a. Alternative f => f a
empty (c, s) -> f (c, s)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (s -> Maybe (c, s)
forall s a. Cons s s a a => s -> Maybe (a, s)
uncons s
str))
instance (Alternative f, Filterable f, Monad f, Cons s s Char Char)
  => IsString (Parsor s f () ()) where
    fromString :: String -> Parsor s f () ()
fromString = String -> Parsor s f () ()
forall (p :: * -> * -> *) c.
(Cochoice p, Monoidal p, Eq c, Tokenized c c p) =>
[c] -> p () ()
tokens

-- FunList --

{- |
`FunList` is isomorphic to `Bazaar` @(->)@.
It's needed to define `meander`.

See van Laarhoven, A non-regular data type challenge
[https://twanvl.nl/blog/haskell/non-regular1]
-}
data FunList a b t
  = DoneFun t
  | MoreFun a (Bazaar (->) a b (b -> t))
instance Functor (FunList a b) where
  fmap :: forall a b. (a -> b) -> FunList a b a -> FunList a b b
fmap a -> b
f = \case
    DoneFun a
t -> b -> FunList a b b
forall a b t. t -> FunList a b t
DoneFun (a -> b
f a
t)
    MoreFun a
a Bazaar (->) a b (b -> a)
h -> a -> Bazaar (->) a b (b -> b) -> FunList a b b
forall a b t. a -> Bazaar (->) a b (b -> t) -> FunList a b t
MoreFun a
a (((b -> a) -> b -> b)
-> Bazaar (->) a b (b -> a) -> Bazaar (->) a b (b -> b)
forall a b. (a -> b) -> Bazaar (->) a b a -> Bazaar (->) a b b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> b
f (a -> b) -> (b -> a) -> b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) Bazaar (->) a b (b -> a)
h)
instance Applicative (FunList a b) where
  pure :: forall a. a -> FunList a b a
pure = a -> FunList a b a
forall a b t. t -> FunList a b t
DoneFun
  <*> :: forall a b. FunList a b (a -> b) -> FunList a b a -> FunList a b b
(<*>) = \case
    DoneFun a -> b
t -> (a -> b) -> FunList a b a -> FunList a b b
forall a b. (a -> b) -> FunList a b a -> FunList a b b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
t
    MoreFun a
a Bazaar (->) a b (b -> a -> b)
h -> \FunList a b a
l ->
      a -> Bazaar (->) a b (b -> b) -> FunList a b b
forall a b t. a -> Bazaar (->) a b (b -> t) -> FunList a b t
MoreFun a
a ((b -> a -> b) -> a -> b -> b
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((b -> a -> b) -> a -> b -> b)
-> Bazaar (->) a b (b -> a -> b) -> Bazaar (->) a b (a -> b -> b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bazaar (->) a b (b -> a -> b)
h Bazaar (->) a b (a -> b -> b)
-> Bazaar (->) a b a -> Bazaar (->) a b (b -> b)
forall a b.
Bazaar (->) a b (a -> b) -> Bazaar (->) a b a -> Bazaar (->) a b b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FunList a b a -> Bazaar (->) a b a
forall a b t. FunList a b t -> Bazaar (->) a b t
fromFun FunList a b a
l)
instance Sellable (->) FunList where sell :: forall a b. a -> FunList a b b
sell a
b = a -> Bazaar (->) a b (b -> b) -> FunList a b b
forall a b t. a -> Bazaar (->) a b (b -> t) -> FunList a b t
MoreFun a
b ((b -> b) -> Bazaar (->) a b (b -> b)
forall a. a -> Bazaar (->) a b a
forall (f :: * -> *) a. Applicative f => a -> f a
pure b -> b
forall a. a -> a
id)

toFun :: Bazaar (->) a b t -> FunList a b t
toFun :: forall a b t. Bazaar (->) a b t -> FunList a b t
toFun (Bazaar forall (f :: * -> *). Applicative f => (a -> f b) -> f t
f) = (a -> FunList a b b) -> FunList a b t
forall (f :: * -> *). Applicative f => (a -> f b) -> f t
f a -> FunList a b b
forall a b. a -> FunList a b b
forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a b.
Sellable p w =>
p a (w a b b)
sell

fromFun :: FunList a b t -> Bazaar (->) a b t
fromFun :: forall a b t. FunList a b t -> Bazaar (->) a b t
fromFun = \case
  DoneFun t
t -> t -> Bazaar (->) a b t
forall a. a -> Bazaar (->) a b a
forall (f :: * -> *) a. Applicative f => a -> f a
pure t
t
  MoreFun a
a Bazaar (->) a b (b -> t)
f -> (b -> t) -> b -> t
forall a b. (a -> b) -> a -> b
($) ((b -> t) -> b -> t)
-> Bazaar (->) a b (b -> t) -> Bazaar (->) a b (b -> t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bazaar (->) a b (b -> t)
f Bazaar (->) a b (b -> t) -> Bazaar (->) a b b -> Bazaar (->) a b t
forall a b.
Bazaar (->) a b (a -> b) -> Bazaar (->) a b a -> Bazaar (->) a b b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> Bazaar (->) a b b
forall a b. a -> Bazaar (->) a b b
forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a b.
Sellable p w =>
p a (w a b b)
sell a
a

funListEot :: Iso
  (Bazaar (->) a1 b1 t1) (Bazaar (->) a2 b2 t2)
  (Either t1 (a1, Bazaar (->) a1 b1 (b1 -> t1)))
  (Either t2 (a2, Bazaar (->) a2 b2 (b2 -> t2)))
funListEot :: forall a1 b1 t1 a2 b2 t2 (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p (Either t1 (a1, Bazaar (->) a1 b1 (b1 -> t1)))
  (f (Either t2 (a2, Bazaar (->) a2 b2 (b2 -> t2))))
-> p (Bazaar (->) a1 b1 t1) (f (Bazaar (->) a2 b2 t2))
funListEot = (Bazaar (->) a1 b1 t1 -> FunList a1 b1 t1)
-> (FunList a2 b2 t2 -> Bazaar (->) a2 b2 t2)
-> Iso
     (Bazaar (->) a1 b1 t1)
     (Bazaar (->) a2 b2 t2)
     (FunList a1 b1 t1)
     (FunList a2 b2 t2)
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso Bazaar (->) a1 b1 t1 -> FunList a1 b1 t1
forall a b t. Bazaar (->) a b t -> FunList a b t
toFun FunList a2 b2 t2 -> Bazaar (->) a2 b2 t2
forall a b t. FunList a b t -> Bazaar (->) a b t
fromFun (p (FunList a1 b1 t1) (f (FunList a2 b2 t2))
 -> p (Bazaar (->) a1 b1 t1) (f (Bazaar (->) a2 b2 t2)))
-> (p (Either t1 (a1, Bazaar (->) a1 b1 (b1 -> t1)))
      (f (Either t2 (a2, Bazaar (->) a2 b2 (b2 -> t2))))
    -> p (FunList a1 b1 t1) (f (FunList a2 b2 t2)))
-> p (Either t1 (a1, Bazaar (->) a1 b1 (b1 -> t1)))
     (f (Either t2 (a2, Bazaar (->) a2 b2 (b2 -> t2))))
-> p (Bazaar (->) a1 b1 t1) (f (Bazaar (->) a2 b2 t2))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FunList a1 b1 t1 -> Either t1 (a1, Bazaar (->) a1 b1 (b1 -> t1)))
-> (Either t2 (a2, Bazaar (->) a2 b2 (b2 -> t2))
    -> FunList a2 b2 t2)
-> Iso
     (FunList a1 b1 t1)
     (FunList a2 b2 t2)
     (Either t1 (a1, Bazaar (->) a1 b1 (b1 -> t1)))
     (Either t2 (a2, Bazaar (->) a2 b2 (b2 -> t2)))
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso FunList a1 b1 t1 -> Either t1 (a1, Bazaar (->) a1 b1 (b1 -> t1))
forall {a} {b} {t}.
FunList a b t -> Either t (a, Bazaar (->) a b (b -> t))
f Either t2 (a2, Bazaar (->) a2 b2 (b2 -> t2)) -> FunList a2 b2 t2
forall {a} {a} {b}.
Either a (a, Bazaar (->) a b (b -> a)) -> FunList a b a
g where
  f :: FunList a b t -> Either t (a, Bazaar (->) a b (b -> t))
f = \case
    DoneFun t
t -> t -> Either t (a, Bazaar (->) a b (b -> t))
forall a b. a -> Either a b
Left t
t
    MoreFun a
a Bazaar (->) a b (b -> t)
baz -> (a, Bazaar (->) a b (b -> t))
-> Either t (a, Bazaar (->) a b (b -> t))
forall a b. b -> Either a b
Right (a
a, Bazaar (->) a b (b -> t)
baz)
  g :: Either a (a, Bazaar (->) a b (b -> a)) -> FunList a b a
g = \case
    Left a
t -> a -> FunList a b a
forall a b t. t -> FunList a b t
DoneFun a
t
    Right (a
a, Bazaar (->) a b (b -> a)
baz) -> a -> Bazaar (->) a b (b -> a) -> FunList a b a
forall a b t. a -> Bazaar (->) a b (b -> t) -> FunList a b t
MoreFun a
a Bazaar (->) a b (b -> a)
baz

-- Orphanage --

instance Monoid r => Applicative (Forget r a) where
  pure :: forall a. a -> Forget r a a
pure a
_ = (a -> r) -> Forget r a a
forall {k} r a (b :: k). (a -> r) -> Forget r a b
Forget a -> r
forall a. Monoid a => a
mempty
  Forget a -> r
f <*> :: forall a b. Forget r a (a -> b) -> Forget r a a -> Forget r a b
<*> Forget a -> r
g = (a -> r) -> Forget r a b
forall {k} r a (b :: k). (a -> r) -> Forget r a b
Forget (a -> r
f (a -> r) -> (a -> r) -> a -> r
forall a. Semigroup a => a -> a -> a
<> a -> r
g)
instance Decidable f => Applicative (Clown f a) where
  pure :: forall a. a -> Clown f a a
pure a
_ = f a -> Clown f a a
forall {k} {k1} (f :: k -> *) (a :: k) (b :: k1).
f a -> Clown f a b
Clown f a
forall a. f a
forall (f :: * -> *) a. Divisible f => f a
conquer
  Clown f a
x <*> :: forall a b. Clown f a (a -> b) -> Clown f a a -> Clown f a b
<*> Clown f a
y = f a -> Clown f a b
forall {k} {k1} (f :: k -> *) (a :: k) (b :: k1).
f a -> Clown f a b
Clown ((a -> (a, a)) -> f a -> f a -> f a
forall a b c. (a -> (b, c)) -> f b -> f c -> f a
forall (f :: * -> *) a b c.
Divisible f =>
(a -> (b, c)) -> f b -> f c -> f a
divide (a -> a
forall a. a -> a
id (a -> a) -> (a -> a) -> a -> (a, a)
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& a -> a
forall a. a -> a
id) f a
x f a
y)
deriving newtype instance Applicative f => Applicative (Joker f a)
deriving via Compose (p a) f instance
  (Profunctor p, Applicative (p a), Applicative f)
    => Applicative (WrappedPafb f p a)
deriving via Compose (p a) f instance
  (Profunctor p, Alternative (p a), Applicative f)
    => Alternative (WrappedPafb f p a)
instance (Closed p, Distributive f)
  => Closed (WrappedPafb f p) where
    closed :: forall a b x.
WrappedPafb f p a b -> WrappedPafb f p (x -> a) (x -> b)
closed (WrapPafb p a (f b)
p) = p (x -> a) (f (x -> b)) -> WrappedPafb f p (x -> a) (x -> b)
forall (f :: * -> *) (p :: * -> * -> *) a b.
p a (f b) -> WrappedPafb f p a b
WrapPafb (((x -> f b) -> f (x -> b))
-> p (x -> a) (x -> f b) -> p (x -> a) (f (x -> 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 (x -> f b) -> f (x -> b)
forall (g :: * -> *) (f :: * -> *) a.
(Distributive g, Functor f) =>
f (g a) -> g (f a)
forall (f :: * -> *) a. Functor f => f (f a) -> f (f a)
distribute (p a (f b) -> p (x -> a) (x -> f b)
forall a b x. p a b -> p (x -> a) (x -> b)
forall (p :: * -> * -> *) a b x.
Closed p =>
p a b -> p (x -> a) (x -> b)
closed p a (f b)
p))
deriving via (Ap.WrappedArrow p a) instance Arrow p
  => Functor (Pro.WrappedArrow p a)
deriving via (Ap.WrappedArrow p a) instance Arrow p
  => Applicative (Pro.WrappedArrow p a)
deriving via (Pro.WrappedArrow p) instance Arrow p
  => Profunctor (Ap.WrappedArrow p)
instance (Monoidal p, Applicative (q a))
  => Applicative (Procompose p q a) where
    pure :: forall a. a -> Procompose p q a a
pure a
b = p a a -> q a a -> Procompose p q a a
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 (a -> p a a
forall a. a -> p a a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
b) (a -> q a a
forall a. a -> q a a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
b)
    Procompose p x (a -> b)
wb q a x
aw <*> :: forall a b.
Procompose p q a (a -> b)
-> Procompose p q a a -> Procompose p q a b
<*> Procompose p x a
vb q a x
av = p (x, x) b -> q a (x, 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
      (((x, x) -> x)
-> ((x, x) -> x)
-> ((a -> b) -> a -> b)
-> p x (a -> b)
-> p x a
-> p (x, x) b
forall (p :: * -> * -> *) s a c b d t.
Monoidal p =>
(s -> a) -> (s -> c) -> (b -> d -> t) -> p a b -> p c d -> p s t
dimap2 (x, x) -> x
forall a b. (a, b) -> a
fst (x, x) -> x
forall a b. (a, b) -> b
snd (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
($) p x (a -> b)
wb p x a
vb)
      ((x -> x -> (x, x)) -> q a x -> q a x -> q a (x, x)
forall a b c. (a -> b -> c) -> q a a -> q a b -> q a c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) q a x
aw q a x
av)
instance (Monoidal p, Monoidal q)
  => Applicative (Product p q a) where
    pure :: forall a. a -> Product p q a a
pure a
b = p a a -> q a a -> Product p q a a
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 (a -> p a a
forall a. a -> p a a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
b) (a -> q a a
forall a. a -> q a a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
b)
    Pair p a (a -> b)
x0 q a (a -> b)
y0 <*> :: forall a b.
Product p q a (a -> b) -> Product p q a a -> Product p q a b
<*> Pair p a a
x1 q a a
y1 = 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 (a -> b)
x0 p a (a -> b) -> p a a -> p a b
forall a b. p a (a -> b) -> p a a -> p a b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> p a a
x1) (q a (a -> b)
y0 q a (a -> b) -> q a a -> q a b
forall a b. q a (a -> b) -> q a a -> q a b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> q a a
y1)
instance (Functor f, Functor (p a)) => Functor (Cayley f p a) where
  fmap :: forall a b. (a -> b) -> Cayley f p a a -> Cayley f p a b
fmap a -> b
f (Cayley f (p a a)
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 a -> p a b) -> f (p a a) -> f (p 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 -> b) -> p a a -> p a b
forall a b. (a -> b) -> p a a -> p a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) f (p a a)
x)
instance (Applicative f, Applicative (p a)) => Applicative (Cayley f p a) where
  pure :: forall a. a -> Cayley f p a a
pure a
b = f (p a a) -> Cayley f p a a
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 a -> f (p a a)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> p a a
forall a. a -> p a a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
b))
  Cayley f (p a (a -> b))
x <*> :: forall a b.
Cayley f p a (a -> b) -> Cayley f p a a -> Cayley f p a b
<*> Cayley f (p a a)
y = 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 (a -> b) -> p a a -> p a b
forall a b. p a (a -> b) -> p a a -> p a b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>) (p a (a -> b) -> p a a -> p a b)
-> f (p a (a -> b)) -> f (p a a -> p a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (p a (a -> b))
x f (p a a -> p a b) -> f (p a a) -> f (p a b)
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 a a)
y)
instance (Profunctor p, Applicative (p a))
  => Applicative (Yoneda p a) where
    pure :: forall a. a -> Yoneda p a a
pure = p a a -> Yoneda p a a
p :-> Yoneda p
forall (p :: * -> * -> *). Profunctor p => p :-> Yoneda p
forall (t :: (* -> * -> *) -> * -> * -> *) (p :: * -> * -> *).
(ProfunctorMonad t, Profunctor p) =>
p :-> t p
proreturn (p a a -> Yoneda p a a) -> (a -> p a a) -> a -> Yoneda p a a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> p a a
forall a. a -> p a a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    Yoneda p a (a -> b)
ab <*> :: forall a b. Yoneda p a (a -> b) -> Yoneda p a a -> Yoneda p a b
<*> Yoneda p a a
cd = 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 (Yoneda p a (a -> b) -> p a (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 (a -> b)
ab p a (a -> b) -> p a a -> p a b
forall a b. p a (a -> b) -> p a a -> p a b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Yoneda p a a -> p a a
Yoneda p :-> p
forall (p :: * -> * -> *). Profunctor p => Yoneda p :-> p
forall (t :: (* -> * -> *) -> * -> * -> *) (p :: * -> * -> *).
(ProfunctorComonad t, Profunctor p) =>
t p :-> p
proextract Yoneda p a a
cd)
instance (Profunctor p, Applicative (p a))
  => Applicative (Coyoneda p a) where
    pure :: forall a. a -> Coyoneda p a a
pure = p a a -> Coyoneda p a a
p :-> Coyoneda p
forall (p :: * -> * -> *). Profunctor p => p :-> Coyoneda p
forall (t :: (* -> * -> *) -> * -> * -> *) (p :: * -> * -> *).
(ProfunctorMonad t, Profunctor p) =>
p :-> t p
proreturn (p a a -> Coyoneda p a a) -> (a -> p a a) -> a -> Coyoneda p a a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> p a a
forall a. a -> p a a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    Coyoneda p a (a -> b)
ab <*> :: forall a b.
Coyoneda p a (a -> b) -> Coyoneda p a a -> Coyoneda p a b
<*> Coyoneda p a a
cd = 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 (Coyoneda p a (a -> b) -> p a (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 (a -> b)
ab p a (a -> b) -> p a a -> p a b
forall a b. p a (a -> b) -> p a a -> p a b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Coyoneda p a a -> p a a
Coyoneda p :-> p
forall (p :: * -> * -> *). Profunctor p => Coyoneda p :-> p
forall (t :: (* -> * -> *) -> * -> * -> *) (p :: * -> * -> *).
(ProfunctorComonad t, Profunctor p) =>
t p :-> p
proextract Coyoneda p a a
cd)

instance (Profunctor p, Alternative (p a))
  => Alternative (Yoneda p a) where
    empty :: forall a. Yoneda p a a
empty = p a a -> Yoneda p a a
p :-> Yoneda p
forall (p :: * -> * -> *). Profunctor p => p :-> Yoneda p
forall (t :: (* -> * -> *) -> * -> * -> *) (p :: * -> * -> *).
(ProfunctorMonad t, Profunctor p) =>
p :-> t p
proreturn p a a
forall a. p a a
forall (f :: * -> *) a. Alternative f => f a
empty
    Yoneda p a a
ab <|> :: forall a. Yoneda p a a -> Yoneda p a a -> Yoneda p a a
<|> Yoneda p a a
cd = p a a -> Yoneda p a a
p :-> Yoneda p
forall (p :: * -> * -> *). Profunctor p => p :-> Yoneda p
forall (t :: (* -> * -> *) -> * -> * -> *) (p :: * -> * -> *).
(ProfunctorMonad t, Profunctor p) =>
p :-> t p
proreturn (Yoneda p a a -> p a a
Yoneda p :-> p
forall (p :: * -> * -> *). Profunctor p => Yoneda p :-> p
forall (t :: (* -> * -> *) -> * -> * -> *) (p :: * -> * -> *).
(ProfunctorComonad t, Profunctor p) =>
t p :-> p
proextract Yoneda p a a
ab p a a -> p a a -> p a a
forall a. p a a -> p a a -> p a a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Yoneda p a a -> p a a
Yoneda p :-> p
forall (p :: * -> * -> *). Profunctor p => Yoneda p :-> p
forall (t :: (* -> * -> *) -> * -> * -> *) (p :: * -> * -> *).
(ProfunctorComonad t, Profunctor p) =>
t p :-> p
proextract Yoneda p a a
cd)
    many :: forall a. Yoneda p a a -> Yoneda p a [a]
many = p a [a] -> Yoneda p a [a]
p :-> Yoneda p
forall (p :: * -> * -> *). Profunctor p => p :-> Yoneda p
forall (t :: (* -> * -> *) -> * -> * -> *) (p :: * -> * -> *).
(ProfunctorMonad t, Profunctor p) =>
p :-> t p
proreturn (p a [a] -> Yoneda p a [a])
-> (Yoneda p a a -> p a [a]) -> Yoneda p a a -> Yoneda p a [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p a a -> p a [a]
forall a. p a a -> p a [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (p a a -> p a [a])
-> (Yoneda p a a -> p a a) -> Yoneda p a a -> p a [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Yoneda p a a -> p a a
Yoneda p :-> p
forall (p :: * -> * -> *). Profunctor p => Yoneda p :-> p
forall (t :: (* -> * -> *) -> * -> * -> *) (p :: * -> * -> *).
(ProfunctorComonad t, Profunctor p) =>
t p :-> p
proextract
instance (Profunctor p, Alternative (p a))
  => Alternative (Coyoneda p a) where
    empty :: forall a. Coyoneda p a a
empty = p a a -> Coyoneda p a a
p :-> Coyoneda p
forall (p :: * -> * -> *). Profunctor p => p :-> Coyoneda p
forall (t :: (* -> * -> *) -> * -> * -> *) (p :: * -> * -> *).
(ProfunctorMonad t, Profunctor p) =>
p :-> t p
proreturn p a a
forall a. p a a
forall (f :: * -> *) a. Alternative f => f a
empty
    Coyoneda p a a
ab <|> :: forall a. Coyoneda p a a -> Coyoneda p a a -> Coyoneda p a a
<|> Coyoneda p a a
cd = p a a -> Coyoneda p a a
p :-> Coyoneda p
forall (p :: * -> * -> *). Profunctor p => p :-> Coyoneda p
forall (t :: (* -> * -> *) -> * -> * -> *) (p :: * -> * -> *).
(ProfunctorMonad t, Profunctor p) =>
p :-> t p
proreturn (Coyoneda p a a -> p a a
Coyoneda p :-> p
forall (p :: * -> * -> *). Profunctor p => Coyoneda p :-> p
forall (t :: (* -> * -> *) -> * -> * -> *) (p :: * -> * -> *).
(ProfunctorComonad t, Profunctor p) =>
t p :-> p
proextract Coyoneda p a a
ab p a a -> p a a -> p a a
forall a. p a a -> p a a -> p a a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Coyoneda p a a -> p a a
Coyoneda p :-> p
forall (p :: * -> * -> *). Profunctor p => Coyoneda p :-> p
forall (t :: (* -> * -> *) -> * -> * -> *) (p :: * -> * -> *).
(ProfunctorComonad t, Profunctor p) =>
t p :-> p
proextract Coyoneda p a a
cd)
    many :: forall a. Coyoneda p a a -> Coyoneda p a [a]
many = p a [a] -> Coyoneda p a [a]
p :-> Coyoneda p
forall (p :: * -> * -> *). Profunctor p => p :-> Coyoneda p
forall (t :: (* -> * -> *) -> * -> * -> *) (p :: * -> * -> *).
(ProfunctorMonad t, Profunctor p) =>
p :-> t p
proreturn (p a [a] -> Coyoneda p a [a])
-> (Coyoneda p a a -> p a [a])
-> Coyoneda p a a
-> Coyoneda p a [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p a a -> p a [a]
forall a. p a a -> p a [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (p a a -> p a [a])
-> (Coyoneda p a a -> p a a) -> Coyoneda p a a -> p a [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coyoneda p a a -> p a a
Coyoneda p :-> p
forall (p :: * -> * -> *). Profunctor p => Coyoneda p :-> p
forall (t :: (* -> * -> *) -> * -> * -> *) (p :: * -> * -> *).
(ProfunctorComonad t, Profunctor p) =>
t p :-> p
proextract