module Data.Functor.Product (Product (..), type (:&:)) where

import Control.Functor.Covariant (Covariant ((<$>)))
import Control.Functor.Covariant.Extractable (Extractable (extract))
import Control.Functor.Polyvariant.Bicovariant (Bicovariant (bicomap))

infixr 1 :&:

data Product a b = a :&: b

type (:&:) = Product

instance Covariant (Product a) where
        f <$> (x :&: y) = x :&: f y

instance Extractable (Product a) where
        extract (x :&: y) = y

instance Bicovariant Product where
        bicomap f g (x :&: y) = f x :&: g y