{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Algebra.RingUtils
  ( module Prelude
  , AbelianGroup(..)
  , AbelianGroupZ(..)
  , Ring(..)
  , RingP(..)
  , Pair(..), select, onlyLeft, onlyRight
  , O(..)
  , sum
  , mulDefault
  , module Data.Pair
  )
 where

import qualified Prelude as P
import Prelude hiding ( (+), (*), splitAt, sum )
import Control.Applicative
import Data.Pair

class AbelianGroup a where
    zero :: a
    (+)  :: a -> a -> a

instance AbelianGroup Int where
    zero :: Int
zero = Int
0
    + :: Int -> Int -> Int
(+)  = Int -> Int -> Int
forall a. Num a => a -> a -> a
(P.+)

class AbelianGroup a => AbelianGroupZ a where
    isZero :: a -> Bool

instance AbelianGroupZ Int where
    isZero :: Int -> Bool
isZero Int
x = Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0

class AbelianGroupZ a => Ring a where
    (*) :: a -> a -> a

class (AbelianGroupZ a) => RingP a where
    mul :: Bool -> a -> a -> Pair a
--    mul _ x y = pure $ x * y

mulDefault :: a -> a -> a
mulDefault a
x a
y = Pair a -> a
forall a. Pair a -> a
leftOf (Bool -> a -> a -> Pair a
forall a. RingP a => Bool -> a -> a -> Pair a
mul Bool
False a
x a
y)

onlyLeft :: [a] -> Pair [a]
onlyLeft  [a]
x = [a]
x  [a] -> [a] -> Pair [a]
forall a. a -> a -> Pair a
:/: []
onlyRight :: [a] -> Pair [a]
onlyRight [a]
x = [] [a] -> [a] -> Pair [a]
forall a. a -> a -> Pair a
:/: [a]
x

select :: Bool -> [a] -> Pair [a]
select Bool
p = if Bool
p then [a] -> Pair [a]
forall {a}. [a] -> Pair [a]
onlyRight else [a] -> Pair [a]
forall {a}. [a] -> Pair [a]
onlyLeft

newtype O f g a = O {forall (f :: * -> *) (g :: * -> *) a. O f g a -> f (g a)
fromO :: f (g a)}
  deriving (O f g a
O f g a -> O f g a -> O f g a
O f g a
-> (O f g a -> O f g a -> O f g a) -> AbelianGroup (O f g a)
forall a. a -> (a -> a -> a) -> AbelianGroup a
forall (f :: * -> *) (g :: * -> *) a.
AbelianGroup (f (g a)) =>
O f g a
forall (f :: * -> *) (g :: * -> *) a.
AbelianGroup (f (g a)) =>
O f g a -> O f g a -> O f g a
$czero :: forall (f :: * -> *) (g :: * -> *) a.
AbelianGroup (f (g a)) =>
O f g a
zero :: O f g a
$c+ :: forall (f :: * -> *) (g :: * -> *) a.
AbelianGroup (f (g a)) =>
O f g a -> O f g a -> O f g a
+ :: O f g a -> O f g a -> O f g a
AbelianGroup, AbelianGroup (O f g a)
O f g a -> Bool
AbelianGroup (O f g a) =>
(O f g a -> Bool) -> AbelianGroupZ (O f g a)
forall a. AbelianGroup a => (a -> Bool) -> AbelianGroupZ a
forall (f :: * -> *) (g :: * -> *) a.
AbelianGroupZ (f (g a)) =>
AbelianGroup (O f g a)
forall (f :: * -> *) (g :: * -> *) a.
AbelianGroupZ (f (g a)) =>
O f g a -> Bool
$cisZero :: forall (f :: * -> *) (g :: * -> *) a.
AbelianGroupZ (f (g a)) =>
O f g a -> Bool
isZero :: O f g a -> Bool
AbelianGroupZ, Int -> O f g a -> ShowS
[O f g a] -> ShowS
O f g a -> String
(Int -> O f g a -> ShowS)
-> (O f g a -> String) -> ([O f g a] -> ShowS) -> Show (O f g a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (f :: * -> *) (g :: * -> *) a.
Show (f (g a)) =>
Int -> O f g a -> ShowS
forall (f :: * -> *) (g :: * -> *) a.
Show (f (g a)) =>
[O f g a] -> ShowS
forall (f :: * -> *) (g :: * -> *) a.
Show (f (g a)) =>
O f g a -> String
$cshowsPrec :: forall (f :: * -> *) (g :: * -> *) a.
Show (f (g a)) =>
Int -> O f g a -> ShowS
showsPrec :: Int -> O f g a -> ShowS
$cshow :: forall (f :: * -> *) (g :: * -> *) a.
Show (f (g a)) =>
O f g a -> String
show :: O f g a -> String
$cshowList :: forall (f :: * -> *) (g :: * -> *) a.
Show (f (g a)) =>
[O f g a] -> ShowS
showList :: [O f g a] -> ShowS
Show)

instance (Functor f,Functor g) => Functor (O f g) where
   fmap :: forall a b. (a -> b) -> O f g a -> O f g b
fmap a -> b
f (O f (g a)
x) = f (g b) -> O f g b
forall (f :: * -> *) (g :: * -> *) a. f (g a) -> O f g a
O ((g a -> g b) -> f (g a) -> f (g b)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> g a -> g b
forall a b. (a -> b) -> g a -> g b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) f (g a)
x)

instance AbelianGroup a => AbelianGroup (Pair a) where
  zero :: Pair a
zero = (a
forall a. AbelianGroup a => a
zeroa -> a -> Pair a
forall a. a -> a -> Pair a
:/:a
forall a. AbelianGroup a => a
zero)
  (a
a:/:a
b) + :: Pair a -> Pair a -> Pair a
+ (a
x:/:a
y) = (a
aa -> a -> a
forall a. AbelianGroup a => a -> a -> a
+a
x) a -> a -> Pair a
forall a. a -> a -> Pair a
:/: (a
ba -> a -> a
forall a. AbelianGroup a => a -> a -> a
+a
y)

instance AbelianGroupZ a => AbelianGroupZ (Pair a) where
  isZero :: Pair a -> Bool
isZero (a
a:/:a
b)  = a -> Bool
forall a. AbelianGroupZ a => a -> Bool
isZero a
a Bool -> Bool -> Bool
&& a -> Bool
forall a. AbelianGroupZ a => a -> Bool
isZero a
b

instance Ring Int where
    * :: Int -> Int -> Int
(*)  = Int -> Int -> Int
forall a. Num a => a -> a -> a
(P.*)

infixl 7  *
infixl 6  +

sum :: AbelianGroup a => [a] -> a
sum :: forall a. AbelianGroup a => [a] -> a
sum = (a -> a -> a) -> a -> [a] -> a
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> a -> a
forall a. AbelianGroup a => a -> a -> a
(+) a
forall a. AbelianGroup a => a
zero

instance AbelianGroup Bool where
  zero :: Bool
zero = Bool
False
  + :: Bool -> Bool -> Bool
(+) = Bool -> Bool -> Bool
(||)