diff --git a/src/Data/Profunctor/Kleisli/Linear.hs b/src/Data/Profunctor/Kleisli/Linear.hs index 69ba3794..70539d6e 100644 --- a/src/Data/Profunctor/Kleisli/Linear.hs +++ b/src/Data/Profunctor/Kleisli/Linear.hs @@ -43,6 +43,10 @@ instance Control.Applicative f => Strong Either Void (Kleisli f) where first (Kleisli f) = Kleisli (either (Data.fmap Left . f) (Control.pure . Right)) second (Kleisli g) = Kleisli (either (Control.pure . Left) (Data.fmap Right . g)) +instance Control.Applicative f => Monoidal (,) () (Kleisli f) where + Kleisli f *** Kleisli g = Kleisli $ \(x,y) -> (,) Control.<$> f x Control.<*> g y + unit = Kleisli Control.pure + instance Control.Applicative f => Wandering (Kleisli f) where wander (Kleisli f) = Kleisli (Data.traverse f) diff --git a/src/Data/Profunctor/Linear.hs b/src/Data/Profunctor/Linear.hs index ca924896..b2fff9f1 100644 --- a/src/Data/Profunctor/Linear.hs +++ b/src/Data/Profunctor/Linear.hs @@ -80,6 +80,10 @@ instance Strong Either Void LinearArrow where first (LA f) = LA $ either (Left . f) Right second (LA g) = LA $ either Left (Right . g) +instance Monoidal (,) () LinearArrow where + LA f *** LA g = LA $ \(a,x) -> (f a, g x) + unit = LA id + instance Profunctor (->) where dimap f g h x = g (h (f x)) instance Strong (,) () (->) where @@ -87,6 +91,9 @@ instance Strong (,) () (->) where instance Strong Either Void (->) where first f (Left x) = Left (f x) first _ (Right y) = Right y +instance Monoidal (,) () (->) where + (f *** g) (a,x) = (f a, g x) + unit () = () data Exchange a b s t = Exchange (s #-> a) (b #-> t) instance Profunctor (Exchange a b) where @@ -104,6 +111,10 @@ instance Prelude.Applicative f => Strong Either Void (Kleisli f) where Left x -> Prelude.fmap Left (f x) Right y -> Prelude.pure (Right y) +instance Prelude.Applicative f => Monoidal (,) () (Kleisli f) where + Kleisli f *** Kleisli g = Kleisli (\(x,y) -> (,) Prelude.<$> f x Prelude.<*> g y) + unit = Kleisli Prelude.pure + data Market a b s t = Market (b #-> t) (s #-> Either t a) runMarket :: Market a b s t #-> (b #-> t, s #-> Either t a) runMarket (Market f g) = (f, g)