{-# LANGUAGE Safe #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ConstraintKinds #-}
module Data.Semimodule.Basis (
type Basis
, type Basis2
, type Basis3
, E1(..), e1, fillE1
, E2(..), e2, fillE2
, E3(..), e3, fillE3
, E4(..), e4, fillE4
) where
import safe Data.Functor.Rep
import safe Data.Semiring
import safe Data.Semimodule
import safe Prelude hiding (Num(..), Fractional(..), negate, sum, product)
import safe Control.Monad as M
type Basis b f = (Free f, Rep f ~ b, Eq b)
type Basis2 b c f g = (Basis b f, Basis c g)
type Basis3 b c d f g h = (Basis b f, Basis c g, Basis d h)
data E1 = E11 deriving (Eq, Ord, Show)
e1 :: a -> E1 -> a
e1 = const
fillE1 :: Basis E1 f => a -> f a
fillE1 x = tabulate $ e1 x
instance Semiring r => Algebra r E1 where
joined = M.join
instance Semiring r => Unital r E1 where
unital = const
instance Semiring r => Coalgebra r E1 where
cojoined f E11 E11 = f E11
instance Semiring r => Counital r E1 where
counital f = f E11
instance Semiring r => Bialgebra r E1
data E2 = E21 | E22 deriving (Eq, Ord, Show)
e2 :: a -> a -> E2 -> a
e2 x _ E21 = x
e2 _ y E22 = y
fillE2 :: Basis E2 f => a -> a -> f a
fillE2 x y = tabulate $ e2 x y
instance Semiring r => Algebra r E2 where
joined = M.join
instance Semiring r => Unital r E2 where
unital = const
instance Semiring r => Coalgebra r E2 where
cojoined f E21 E21 = f E21
cojoined f E22 E22 = f E22
cojoined _ _ _ = zero
instance Semiring r => Counital r E2 where
counital f = f E21 + f E22
instance Semiring r => Bialgebra r E2
data E3 = E31 | E32 | E33 deriving (Eq, Ord, Show)
e3 :: a -> a -> a -> E3 -> a
e3 x _ _ E31 = x
e3 _ y _ E32 = y
e3 _ _ z E33 = z
fillE3 :: Basis E3 f => a -> a -> a -> f a
fillE3 x y z = tabulate $ e3 x y z
instance Semiring r => Algebra r E3 where
joined = M.join
instance Semiring r => Unital r E3 where
unital = const
instance Semiring r => Coalgebra r E3 where
cojoined f E31 E31 = f E31
cojoined f E32 E32 = f E32
cojoined f E33 E33 = f E33
cojoined _ _ _ = zero
instance Semiring r => Counital r E3 where
counital f = f E31 + f E32 + f E33
instance Semiring r => Bialgebra r E3
data E4 = E41 | E42 | E43 | E44 deriving (Eq, Ord, Show)
e4 :: a -> a -> a -> a -> E4 -> a
e4 x _ _ _ E41 = x
e4 _ y _ _ E42 = y
e4 _ _ z _ E43 = z
e4 _ _ _ w E44 = w
fillE4 :: Basis E4 f => a -> a -> a -> a -> f a
fillE4 x y z w = tabulate $ e4 x y z w
instance Semiring r => Algebra r E4 where
joined = M.join
instance Semiring r => Unital r E4 where
unital = const
instance Semiring r => Coalgebra r E4 where
cojoined f E41 E41 = f E41
cojoined f E42 E42 = f E42
cojoined f E43 E43 = f E43
cojoined f E44 E44 = f E44
cojoined _ _ _ = zero
instance Semiring r => Counital r E4 where
counital f = f E41 + f E42 + f E43 + f E44
instance Semiring r => Bialgebra r E4