{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveFunctor, GeneralizedNewtypeDeriving #-}
module NumHask.Data where
import Data.Coerce (coerce)
import GHC.Generics
import NumHask.Algebra
import Prelude hiding (Num(..), sum, recip)
#if !MIN_VERSION_base(4,11,0)
import Data.Semigroup ((<>), Semigroup)
#endif
newtype Sum a = Sum { getSum :: a }
deriving (Eq, Ord, Read, Show, Bounded, Generic, Generic1, Functor)
instance Applicative Sum where
pure = Sum
(<*>) = coerce
instance Monad Sum where
m >>= k = k (getSum m)
instance AdditiveMagma a => AdditiveMagma (Sum a) where
(Sum x) `plus` (Sum y) = Sum (x `plus` y)
instance AdditiveUnital a => AdditiveUnital (Sum a) where
zero = Sum zero
instance AdditiveMagma a => AdditiveAssociative (Sum a)
instance AdditiveInvertible a => AdditiveInvertible (Sum a) where
negate (Sum x) = Sum (negate x)
instance AdditiveMagma a => AdditiveCommutative (Sum a) where
instance (AdditiveUnital a, AdditiveMagma a) => Additive (Sum a) where
instance (AdditiveInvertible a, AdditiveUnital a) => AdditiveGroup (Sum a) where
instance AdditiveMagma a => Semigroup (Sum a) where
(Sum x) <> (Sum y) = Sum $ x `plus` y
instance AdditiveUnital a => Monoid (Sum a) where
mempty = Sum zero
newtype Product a = Product { getProduct :: a }
deriving (Eq, Ord, Read, Show, Bounded, Generic, Generic1, Functor)
instance Applicative Product where
pure = Product
(<*>) = coerce
instance Monad Product where
m >>= k = k (getProduct m)
instance MultiplicativeMagma a => MultiplicativeMagma (Product a) where
(Product x) `times` (Product y) = Product (x `times` y)
instance MultiplicativeUnital a => MultiplicativeUnital (Product a) where
one = Product one
instance MultiplicativeMagma a => MultiplicativeAssociative (Product a)
instance MultiplicativeInvertible a => MultiplicativeInvertible (Product a) where
recip (Product x) = Product (recip x)
instance MultiplicativeMagma a => MultiplicativeCommutative (Product a)
instance MultiplicativeUnital a => Multiplicative (Product a) where
instance (MultiplicativeUnital a, MultiplicativeInvertible a) => MultiplicativeGroup (Product a) where
instance MultiplicativeMagma a => Semigroup (Product a) where
(Product x) <> (Product y) = Product $ x `times` y
instance MultiplicativeUnital a => Monoid (Product a) where
mempty = Product one