-- |
-- 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
LFactor (ProductCatObj a b)
x
  rfactorProj :: ProductCatObj a b -> RFactor (ProductCatObj a b)
rfactorProj (ProductCatObj a
_ b
y) = b
RFactor (ProductCatObj a b)
y

instance (IsProduct a, IsProduct b) => IsProduct (a,b) where
  lfactorProj :: (a, b) -> LFactor (a, b)
lfactorProj (a
x,b
y) = (a -> LFactor a
forall t. IsProduct t => t -> LFactor t
lfactorProj a
x, b -> LFactor b
forall t. IsProduct t => t -> LFactor t
lfactorProj b
y)
  rfactorProj :: (a, b) -> RFactor (a, b)
rfactorProj (a
x,b
y) = (a -> RFactor a
forall t. IsProduct t => t -> RFactor t
rfactorProj a
x, b -> RFactor b
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 = a -> b -> ProductCatObj a b
forall a b. a -> b -> ProductCatObj a b
ProductCatObj (a
xa -> a -> a
forall a. Semigroup a => a -> a -> a
<>a
w) (b
yb -> b -> b
forall a. Semigroup a => a -> a -> a
<>b
z)

instance (Monoid a, Monoid b) => Monoid (ProductCatObj a b) where
  mempty :: ProductCatObj a b
mempty = a -> b -> ProductCatObj a b
forall a b. a -> b -> ProductCatObj a b
ProductCatObj a
forall a. Monoid a => a
mempty b
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)
       = a -> b -> ProductCatObj a b
forall a b. a -> b -> ProductCatObj a b
ProductCatObj (a -> a -> a
forall a. Monoid a => a -> a -> a
mappend a
x a
w) (b -> b -> b
forall a. Monoid a => a -> a -> a
mappend b
y b
z)