From 52bbcd992848b6b2cf48248e736571d347dba931 Mon Sep 17 00:00:00 2001
From: solomon <ssbothwell@gmail.com>
Date: Wed, 10 Jan 2024 01:06:37 -0800
Subject: [PATCH] Adds biapplicative operations.

---
 src/Data/Bifunctor/Monoidal/Specialized.hs | 20 +++++++++++++++++++-
 1 file changed, 19 insertions(+), 1 deletion(-)

diff --git a/src/Data/Bifunctor/Monoidal/Specialized.hs b/src/Data/Bifunctor/Monoidal/Specialized.hs
index e381dcf..67b16b9 100644
--- a/src/Data/Bifunctor/Monoidal/Specialized.hs
+++ b/src/Data/Bifunctor/Monoidal/Specialized.hs
@@ -2,15 +2,19 @@
 
 module Data.Bifunctor.Monoidal.Specialized where
 
+--------------------------------------------------------------------------------
+
 import Control.Category.Cartesian
 import Control.Category.Tensor ()
+import Data.Bifunctor
 import Data.Bifunctor.Monoidal
 import Data.Functor.Contravariant
 import Data.Profunctor
-import Data.These
 import Data.Void
 import Prelude hiding ((&&), (||))
 
+--------------------------------------------------------------------------------
+
 -- | Split the input between the two arguments and multiply their outputs.
 mux :: Semigroupal (->) (,) (,) (,) p => p a b -> p c d -> p (a, c) (b, d)
 mux = curry combine
@@ -147,3 +151,17 @@ split' = split @(->) @(,)
 
 merge' :: Either a a -> a
 merge' = merge @(->) @Either
+
+bipure :: (Bifunctor p, Unital (->) () () () p) => a -> b -> p a b 
+bipure a b = bimap (const a) (const b) $ introduce @_ @() @() ()
+
+biliftA2' :: (Bifunctor m, Semigroupal (->) (,) (,) (,) m) => (a -> b -> c) -> (d -> e -> f) -> m a d -> m b e -> m c f
+biliftA2' f g m1 m2 = bimap (uncurry f) (uncurry g) $ combine (m1, m2)
+
+biapply :: (Bifunctor p, Semigroupal (->) (,) (,) (,) p) => p (a -> b) (c -> d) -> p a c -> p b d
+biapply = fmap (bimap (uncurry ($)) (uncurry ($))) . mux
+
+infixl 4 <<*>>
+
+(<<*>>) :: (Bifunctor p, Semigroupal (->) (,) (,) (,) p) => p (a -> b) (c -> d) -> p a c -> p b d 
+(<<*>>) = biapply