Ring.hs

{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances, ScopedTypeVariables #-}

class (Monoid a) => Additive a
class (Monoid a) => Multiplicative a

class Iso a b where
  from :: b -> a
  to :: a -> b

class (Iso a b, Iso a c, Additive b, Multiplicative c) => Ring a b c | a -> b, a -> c  where
  zero, one :: a
  zero = from (mempty :: b)
  one = from (mempty :: c)

  add, mul :: a -> a -> a
  add l r = from $ mappend (to l :: b) (to r :: b)
  mul l r = from $ mappend (to l :: c) (to r :: c)

  neg :: a -> a

newtype Add a = Add { unAdd :: (Num a) => a }
instance (Num a) => Additive (Add a)
instance (Num a) => Monoid (Add a) where
  mempty = Add 0
  mappend l r = Add $ (unAdd l) + (unAdd r)
instance (Num a) => Iso a (Add a) where
  from = unAdd
  to n = Add n

newtype Mul a = Mul { unMul :: (Num a) => a }
instance (Num a) => Multiplicative (Mul a)
instance (Num a) => Monoid (Mul a) where
  mempty = Mul 1
  mappend l r = Mul $ (unMul l) * (unMul r)
instance (Num a) => Iso a (Mul a) where
  from = unMul
  to n = Mul n

instance (Num a) => Ring a (Add a) (Mul a) where
  neg n = -n