Product.hs

module Control.Category.Product ((:×:) (..)) where

import Control.Category
import Control.Category.Groupoid
import Data.Type.Equality

data ((s :: αₛ -> αₛ -> *) :×: (t :: αₜ -> αₜ -> *)) :: (αₛ, αₜ) -> (αₛ, αₜ) -> * where
    (:×:) :: s aₛ bₛ -> t aₜ bₜ -> (s :×: t) '(aₛ, aₜ) '(bₛ, bₜ)

instance (Category s, Category t) => Category (s :×: t) where
    id :: ∀ a . (s :×: t) a a
    id = pair `gcastWith` (id :×: id) where pair = pair :: a :~: '(Fst a, Snd a)
    (fₛ :×: fₜ) . (gₛ :×: gₜ) = (fₛ . gₛ) :×: (fₜ . gₜ)

type family Fst a where Fst '(a, b) = a
type family Snd a where Snd '(a, b) = b

instance (Groupoid s, Groupoid t) => Groupoid (s :×: t) where
    invert (f :×: g) = invert f :×: invert g