{-# OPTIONS_GHC -Wno-orphans #-}

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

module Data.Profunctor.Monoidal
  ( -- * Monoidal
    Monoidal
  , oneP, (>*<), (>*), (*<)
  , dimap2, foreverP, ditraverse
    -- * Monoidal & Choice
  , replicateP, (>:<), asEmpty
  , meander, eotFunList
  ) 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.Profunctor
import Control.Lens.PartialIso
import Data.Bifunctor.Clown
import Data.Bifunctor.Joker
import Data.Bifunctor.Product
import Data.Distributive
import Data.Functor.Compose
import Data.Functor.Contravariant.Divisible
import Data.Profunctor hiding (WrappedArrow)
import Data.Profunctor qualified as Pro (WrappedArrow)
import Data.Profunctor.Cayley
import Data.Profunctor.Composition
import Data.Profunctor.Monad
import Data.Profunctor.Yoneda

-- 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 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> oneP >*< p = lunit p
prop> p >*< oneP = runit p
prop> p >*< q >*< r = assoc ((p >*< q) >*< r)
prop> dimap (f >*< g) (h >*< i) (p >*< q) = dimap f h p >*< dimap g i q

-}
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 5 >*<

{- | `>*` 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 6 >*

{- | `*<` sequences actions, discarding the value of the second 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 6 *<

{- | `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 `Control.Monad.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'

{- | A `Monoidal` & `Choice` nil operator. -}
asEmpty :: (AsEmpty s, Monoidal p, Choice p) => p s s
asEmpty :: forall s (p :: * -> * -> *).
(AsEmpty s, Monoidal p, Choice p) =>
p s s
asEmpty = Market () () () (Identity ()) -> Market () () s (Identity s)
forall a. AsEmpty a => Prism' a ()
Prism' s ()
_Empty (Market () () () (Identity ()) -> Market () () s (Identity s))
-> p () () -> p s s
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? p () ()
forall (p :: * -> * -> *). Monoidal p => p () ()
oneP

{- | A `Monoidal` & `Choice` cons operator. -}
(>:<) :: (Cons s t a b, Monoidal p, Choice p) => p a b -> p s t -> p s t
p a b
x >:< :: forall s t a b (p :: * -> * -> *).
(Cons s t a b, Monoidal p, Choice p) =>
p a b -> p s t -> p s t
>:< p 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 >:<

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

A `Traversable` & `Data.Distributive.Distributive` type
is a homogeneous countable product.
That means it is a static length container, so unlike `replicateP`,
`ditraverse` does not need an `Int` argument.
-}
ditraverse
  :: (Traversable t, Distributive t, Monoidal p)
  => p a b -> p (t a) (t b)
ditraverse :: forall (t :: * -> *) (p :: * -> * -> *) a b.
(Traversable t, Distributive t, Monoidal p) =>
p a b -> p (t a) (t b)
ditraverse 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)

{- | `replicateP` is analagous to `Control.Monad.replicateM`,
for `Monoidal` & `Choice` `Profunctor`s. -}
replicateP
  :: (Monoidal p, Choice p, AsEmpty s, AsEmpty t, Cons s t a b)
  => Int -> p a b -> p s t
replicateP :: forall (p :: * -> * -> *) s t a b.
(Monoidal p, Choice p, AsEmpty s, AsEmpty t, Cons s t a b) =>
Int -> p a b -> p s t
replicateP Int
n p a b
_ | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = (s -> t) -> p t t -> p s t
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 -> s -> t
forall a b. a -> b -> a
const t
forall s. AsEmpty s => s
Empty) p t t
forall s (p :: * -> * -> *).
(AsEmpty s, Monoidal p, Choice p) =>
p s s
asEmpty
replicateP Int
n p a b
a = p a b
a p a b -> p s t -> p s t
forall s t a b (p :: * -> * -> *).
(Cons s t a b, Monoidal p, Choice p) =>
p a b -> p s t -> p s t
>:< Int -> p a b -> p s t
forall (p :: * -> * -> *) s t a b.
(Monoidal p, Choice p, AsEmpty s, AsEmpty t, Cons s t a b) =>
Int -> p a b -> p s t
replicateP (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) p a b
a

{- | For any `Monoidal`, `Choice` & `Strong` `Profunctor`,
`meander` is invertible and gives a default implementation for the
`Data.Profunctor.Traversing.wander`
method of `Data.Profunctor.Traversing.Traversing`,
though `Strong` is 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)
meandering
  where
    meandering
      :: (Monoidal q, Choice q)
      => q u v -> q (Bazaar (->) u w x) (Bazaar (->) v w x)
    meandering :: forall (q :: * -> * -> *) u v w x.
(Monoidal q, Choice q) =>
q u v -> q (Bazaar (->) u w x) (Bazaar (->) v w x)
meandering q u v
q = Exchange
  (Either x (u, Bazaar (->) u w (w -> x)))
  (Either x (v, Bazaar (->) v w (w -> x)))
  (Either x (u, Bazaar (->) u w (w -> x)))
  (Identity (Either x (v, Bazaar (->) v w (w -> x))))
-> Exchange
     (Either x (u, Bazaar (->) u w (w -> x)))
     (Either x (v, Bazaar (->) v w (w -> x)))
     (Bazaar (->) u w x)
     (Identity (Bazaar (->) v 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))
eotFunList (Exchange
   (Either x (u, Bazaar (->) u w (w -> x)))
   (Either x (v, Bazaar (->) v w (w -> x)))
   (Either x (u, Bazaar (->) u w (w -> x)))
   (Identity (Either x (v, Bazaar (->) v w (w -> x))))
 -> Exchange
      (Either x (u, Bazaar (->) u w (w -> x)))
      (Either x (v, Bazaar (->) v w (w -> x)))
      (Bazaar (->) u w x)
      (Identity (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 (p :: * -> * -> *) s t a b.
Profunctor p =>
AnIso s t a b -> p a b -> p s t
>~ 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)
meandering q u v
q)

{- |
`eotFunList` is used to define `meander`.
See van Laarhoven, [A non-regular data type challenge]
(https://twanvl.nl/blog/haskell/non-regular1),
both post and comments, for details.
-}
eotFunList :: 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)))
eotFunList :: 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))
eotFunList = (Bazaar (->) a1 b1 t1
 -> Either t1 (a1, Bazaar (->) a1 b1 (b1 -> t1)))
-> (Either t2 (a2, Bazaar (->) a2 b2 (b2 -> t2))
    -> Bazaar (->) a2 b2 t2)
-> 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)))
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 (FunList a1 b1 t1 -> Either t1 (a1, Bazaar (->) a1 b1 (b1 -> t1)))
-> (Bazaar (->) a1 b1 t1 -> FunList a1 b1 t1)
-> Bazaar (->) a1 b1 t1
-> Either t1 (a1, Bazaar (->) a1 b1 (b1 -> t1))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 (FunList a2 b2 t2 -> Bazaar (->) a2 b2 t2)
-> (Either t2 (a2, Bazaar (->) a2 b2 (b2 -> t2))
    -> FunList a2 b2 t2)
-> Either t2 (a2, Bazaar (->) a2 b2 (b2 -> t2))
-> Bazaar (->) a2 b2 t2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
data FunList a b t
  = DoneFun t
  | MoreFun a (Bazaar (->) a b (b -> t))
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
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)

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