[Haskell-cafe] Product Profunctor and Contravariant
Tom Ellis
tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk
Wed Nov 20 16:57:44 UTC 2013
On Sun, Sep 29, 2013 at 10:44:15AM +0100, Tom Ellis wrote:
> Does anyone recognise these typeclasses:
>
> import Data.Profunctor (Profunctor)
> import Data.Functor.Contravariant (Contravariant)
>
> class Profunctor p => ProductProfunctor p where
> empty :: p () ()
> (***!) :: p a b -> p a' b' -> p (a, a') (b, b')
>
> class Contravariant f => ProductContravariant f where
> point :: f ()
> (***<) :: f a -> f b -> f (a, b)
It now seems to me that these are equivalent to Profunctor with Applicative,
and Contravariant with Monoid respectively:
import Data.Profunctor
import Control.Applicative hiding (empty)
import Data.Functor.Contravariant
import Data.Monoid
empty :: (Applicative (p ())) => p () ()
empty = pure ()
(***!) :: (Applicative (p (a, a')), Profunctor p) =>
p a b -> p a' b' -> p (a, a') (b, b')
p ***! p' = (,) <$> lmap fst p <*> lmap snd p'
point :: Monoid (f ()) => f ()
point = mempty
(***<) :: (Monoid (f (a, b)), Contravariant f) =>
f a -> f b -> f (a, b)
p ***< p' = contramap fst p <> contramap snd p'
So my question becomes: are there standard definitions of these somewhere?
Thanks,
Tom
More information about the Haskell-Cafe
mailing list