{-# 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
  , pureP, asEmpty, (>:<), replicateP, onlyOne
  , meander, eotFunList
  ) where

import Control.Lens
import Control.Lens.Internal.Context
import Control.Lens.PartialIso
import Data.Distributive
import GHC.IsList

-- 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) -- ^ first projection, e.g. `fst`
  -> (s -> c) -- ^ second projection, e.g. `snd`
  -> (b -> d -> t) -- ^ pairing function, e.g. @(,)@
  -> 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 a countable infinity of times;
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'

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

A `Traversable` & `Data.Distributive.Distributive` type
is a homogeneous countable product.
That means it is a static countable-length container,
so unlike `replicateP`, `ditraverse` doesn't need
an additional argument for number of repetitions.
-}
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)

{- | Lift a single bidirectional element
into a `Monoidal` & `Choice` structure.
Bidirectionality is encoded by `APrism`.
Singularity is encoded by the unit type @()@.
Bidirectional elements can be generated from
nilary constructors of algebraic datatypes using `makeNestedPrisms`,
from terms of a type with an `Eq` instance using `only`,
from nil elements using `_Empty`,
or from any `.`-composition of `Control.Lens.Prism.Prism`s
terminating with a bidirectional element.
-}
pureP
  :: (Monoidal p, Choice p)
  => APrism a b () () -- ^ bidirectional element
  -> p a b
pureP :: forall (p :: * -> * -> *) a b.
(Monoidal p, Choice p) =>
APrism a b () () -> p a b
pureP APrism a b () ()
pattern = APrism a b () ()
pattern APrism a b () () -> p () () -> p a b
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` nil combinator. -}
asEmpty :: (AsEmpty s, Monoidal p, Choice p) => p s s
asEmpty :: forall s (p :: * -> * -> *).
(AsEmpty s, Monoidal p, Choice p) =>
p s s
asEmpty = APrism s s () () -> p s s
forall (p :: * -> * -> *) a b.
(Monoidal p, Choice p) =>
APrism a b () () -> p a b
pureP APrism s s () ()
forall a. AsEmpty a => Prism' a ()
Prism' s ()
_Empty

{- | A `Monoidal` & `Choice` cons combinator. -}
(>:<) :: (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 >:<

{- | Use when `IsList` with `onlyOne` `Item`. -}
onlyOne
  :: (Monoidal p, Choice p, IsList s)
  => p (Item s) (Item s) -> p s s
onlyOne :: forall (p :: * -> * -> *) s.
(Monoidal p, Choice p, IsList s) =>
p (Item s) (Item s) -> p s s
onlyOne p (Item s) (Item s)
p = (s -> [Item s]) -> ([Item s] -> s) -> Iso s s [Item s] [Item s]
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso s -> [Item s]
forall l. IsList l => l -> [Item l]
toList (Int -> [Item s] -> s
forall l. IsList l => Int -> [Item l] -> l
fromListN Int
1) (Market [Item s] [Item s] [Item s] (Identity [Item s])
 -> Market [Item s] [Item s] s (Identity s))
-> p [Item s] [Item s] -> p s s
forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
>? p (Item s) (Item s)
p p (Item s) (Item s) -> p [Item s] [Item s] -> p [Item s] [Item s]
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 [Item s] [Item s]
forall s (p :: * -> * -> *).
(AsEmpty s, Monoidal p, Choice p) =>
p s s
asEmpty

{- | `replicateP` is analagous to `Control.Monad.replicateM`,
for `Monoidal` & `Choice` `Profunctor`s. When the number
of repetitions is less than or equal to 0, it returns `asEmpty`.
-}
replicateP
  :: (Monoidal p, Choice p, AsEmpty s, Cons s s a a)
  => Int {- ^ number of repetitions -} -> p a a -> p s s
replicateP :: forall (p :: * -> * -> *) s a.
(Monoidal p, Choice p, AsEmpty s, Cons s s a a) =>
Int -> p a a -> p s s
replicateP Int
n p a a
_ | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = p s s
forall s (p :: * -> * -> *).
(AsEmpty s, Monoidal p, Choice p) =>
p s s
asEmpty
replicateP Int
n p a a
a = p a a
a p a a -> p s s -> p s s
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 a -> p s s
forall (p :: * -> * -> *) s a.
(Monoidal p, Choice p, AsEmpty s, Cons s s a a) =>
Int -> p a a -> p s s
replicateP (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) p a a
a

{- | For any `Monoidal`, `Choice` & `Data.Profunctor.Strong` `Profunctor`,
`meander` is invertible and gives a default implementation for the
`Data.Profunctor.Traversing.wander`
method of `Data.Profunctor.Traversing.Traversing`,
though `Data.Profunctor.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) -> b -> (b -> t) -> t
forall a b c. (a -> b -> c) -> b -> a -> c
flip (b -> t) -> b -> t
forall a b. (a -> b) -> a -> b
($) (b -> (b -> t) -> t)
-> Bazaar (->) a b b -> Bazaar (->) a b ((b -> t) -> t)
forall (f :: * -> *) a b. Functor 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 Bazaar (->) a b ((b -> t) -> t)
-> Bazaar (->) a b (b -> t) -> 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
<*> Bazaar (->) a b (b -> t)
f
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)