-- |
-- Module      : Data.CategoryObject.Product
-- Copyright   : (c) Justus Sagemüller 2021
-- License     : GPL v3
-- 
-- Maintainer  : (@) jsag $ hvl.no
-- Stability   : experimental
-- Portability : portable
-- 

{-# 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)