--Licence:GPL
module MapRing (Semigroup(..), MapRing, singleMapRing) where

import qualified Data.Map as DM (Map,filter, unionWith, map, singleton, fromAscList, toAscList)

class Eq a=>Semigroup a where
    semigroupOperation::a->a->a
    semigroupIdentity::a

data (Eq a, Ord a, Semigroup a)=>MapRing a = MapRing (DM.Map a Integer)
                        deriving (Eq,Show)

ringAddition, ringMultiplication::(Eq a, Ord a, Semigroup a)=>(MapRing a)->(MapRing a)->(MapRing a)
ringAddition (MapRing x) (MapRing y) = MapRing (nonzeroterms (DM.unionWith (+) x y))
                                       where nonzeroterms = DM.filter (not .( 0==))

ringMultiplication (MapRing x) (MapRing y) = foldl ringAddition ringZero  [ singleMapRing (xvalue*yvalue) (xkey `semigroupOperation` ykey) | (xkey, xvalue)<- (DM.toAscList x) , (ykey, yvalue)<- (DM.toAscList y)]

ringZero, ringOne::(Eq a, Ord a, Semigroup a)=>(MapRing a)
ringZero = singleMapRing 0 semigroupIdentity 
ringOne = singleMapRing 1 semigroupIdentity 

ringNegate::(Eq a, Ord a, Semigroup a)=>(MapRing a)->(MapRing a)
ringNegate (MapRing dictionary) = MapRing (DM.map negate dictionary)

zaction::(Eq a, Ord a, Semigroup a)=>Integer->(MapRing a)->(MapRing a)
zaction n (MapRing dictionary) = MapRing (DM.map (*n) dictionary)

singleMapRing c m = MapRing (DM.singleton m c)
--just unpacking the underlying Map
mapRingfmap f (MapRing dictionary) = MapRing (DM.fromAscList (f dictionary))

instance (Show a, Eq a, Ord a, Semigroup a)=>Num (MapRing a) where
    (+) = ringAddition
    (*) = ringMultiplication
    negate = ringNegate
    fromInteger n = zaction n (ringOne::(MapRing a))