Skip to content

Instantly share code, notes, and snippets.

@kl0tl
Created May 1, 2017 13:03
Show Gist options
  • Save kl0tl/e415906b5c213b6655b3911481e3979d to your computer and use it in GitHub Desktop.
Save kl0tl/e415906b5c213b6655b3911481e3979d to your computer and use it in GitHub Desktop.
{-# 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
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment