{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE FlexibleInstances #-}
module Data.CategoryObject.Product where
import Data.Semigroup
import Data.Monoid hiding ((<>))
data ProductCatObj a b = ProductCatObj a b
type family LFactor t where
LFactor (ProductCatObj l r) = l
LFactor (a,b) = (LFactor a, LFactor b)
type family RFactor t where
RFactor (ProductCatObj l r) = r
RFactor (a,b) = (RFactor a, RFactor b)
class IsProduct t where
lfactorProj :: t -> LFactor t
rfactorProj :: t -> RFactor t
instance IsProduct (ProductCatObj a b) where
lfactorProj :: ProductCatObj a b -> LFactor (ProductCatObj a b)
lfactorProj (ProductCatObj a
x b
_) = a
x
rfactorProj :: ProductCatObj a b -> RFactor (ProductCatObj a b)
rfactorProj (ProductCatObj a
_ b
y) = b
y
instance (IsProduct a, IsProduct b) => IsProduct (a,b) where
lfactorProj :: (a, b) -> LFactor (a, b)
lfactorProj (a
x,b
y) = (forall t. IsProduct t => t -> LFactor t
lfactorProj a
x, forall t. IsProduct t => t -> LFactor t
lfactorProj b
y)
rfactorProj :: (a, b) -> RFactor (a, b)
rfactorProj (a
x,b
y) = (forall t. IsProduct t => t -> RFactor t
rfactorProj a
x, forall t. IsProduct t => t -> RFactor t
rfactorProj b
y)
instance (Semigroup a, Semigroup b) => Semigroup (ProductCatObj a b) where
ProductCatObj a
x b
y <> :: ProductCatObj a b -> ProductCatObj a b -> ProductCatObj a b
<> ProductCatObj a
w b
z = forall a b. a -> b -> ProductCatObj a b
ProductCatObj (a
xforall a. Semigroup a => a -> a -> a
<>a
w) (b
yforall a. Semigroup a => a -> a -> a
<>b
z)
instance (Monoid a, Monoid b) => Monoid (ProductCatObj a b) where
mempty :: ProductCatObj a b
mempty = forall a b. a -> b -> ProductCatObj a b
ProductCatObj forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty
mappend :: ProductCatObj a b -> ProductCatObj a b -> ProductCatObj a b
mappend (ProductCatObj a
x b
y) (ProductCatObj a
w b
z)
= forall a b. a -> b -> ProductCatObj a b
ProductCatObj (forall a. Monoid a => a -> a -> a
mappend a
x a
w) (forall a. Monoid a => a -> a -> a
mappend b
y b
z)