rings-and-fields.hs

{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeFamilyDependencies #-}

import Data.Monoid


class (Monoid a) => Inverse a where
    inverseMaybe :: a -> Maybe a

    default inverseMaybe :: (Group a) => a -> Maybe a
    inverseMaybe = Just . inverse

instance Inverse (Sum Integer)

instance Inverse (Product Integer) where
    inverseMaybe (-1) = Just (-1)
    inverseMaybe 1 = Just 1
    inverseMaybe _ = Nothing

instance Inverse (Sum Rational)

instance Inverse (Product Rational)


class (Inverse a) => Group a where
    inverse :: a -> a

instance Group (Sum Integer) where
    inverse = negate

instance Group (Sum Rational) where
    inverse = negate

instance Group (Product Rational) where
    inverse = Product . recip . getProduct


class (Inverse (Add a)) => Additive a where
    type Add a = b | b -> a
    type Add a = Sum a

    toAdd :: a -> Add a
    default toAdd :: a -> Sum a
    toAdd = Sum

    fromAdd :: Add a -> a
    default fromAdd :: Sum a -> a
    fromAdd = getSum

instance Additive Integer
instance Additive Rational


class (Inverse (Mul a)) => Multiplicative a where
    type Mul a = b | b -> a
    type Mul a = Product a

    toMul :: a -> Mul a
    default toMul :: a -> Product a
    toMul = Product

    fromMul :: Mul a -> a
    default fromMul :: Product a -> a
    fromMul = getProduct

instance Multiplicative Integer
instance Multiplicative Rational


class (Additive a, Multiplicative a, Group (Add a)) => Ring a

instance Ring Integer
instance Ring Rational


class (Ring a, Group (Mul a)) => Field a

instance Field Rational


(.+) :: (Ring a) => a -> a -> a
x .+ y = fromAdd (toAdd x <> toAdd y)

(.*) :: (Ring a) => a -> a -> a
x .* y = fromMul (toMul x <> toMul y)

negate' :: (Ring a) => a -> a
negate' = fromAdd . inverse . toAdd

recipMaybe :: (Ring a) => a -> Maybe a
recipMaybe = fmap fromMul . inverseMaybe . toMul

recip' :: (Field a) => a -> a
recip' = fromMul . inverse . toMul