{-# LANGUAGE GeneralizedNewtypeDeriving #-} {- | A wrapper that provides instances of Haskell 98 and NumericPrelude numeric type classes for types that have Haskell 98 instances. -} module MathObj.Wrapper.Haskell98 where import qualified Algebra.Absolute as Absolute import qualified Algebra.Additive as Additive import qualified Algebra.Algebraic as Algebraic import qualified Algebra.Field as Field import qualified Algebra.FloatingPoint as Float import qualified Algebra.IntegralDomain as Integral import qualified Algebra.PrincipalIdealDomain as PID import qualified Algebra.RealField as RealField import qualified Algebra.RealIntegral as RealIntegral import qualified Algebra.RealRing as RealRing import qualified Algebra.RealTranscendental as RealTrans import qualified Algebra.Ring as Ring import qualified Algebra.ToInteger as ToInteger import qualified Algebra.ToRational as ToRational import qualified Algebra.Transcendental as Trans import qualified Algebra.Units as Units import qualified Algebra.ZeroTestable as ZeroTestable import qualified Number.Ratio as Ratio import qualified Algebra.RealRing98 as RealRing98 import Data.Ix (Ix, ) import Data.Tuple.HT (mapPair, ) {- | This makes a type usable in the NumericPrelude framework that was initially implemented for Haskell98 typeclasses. E.g. if @a@ is in class 'Num', then @T a@ is both in class 'Num' and in 'Ring.C'. You can even lift container types. If @Polynomial a@ is in 'Num' for all types @a@ that are in 'Num', then @T (Polynomial (MathObj.Wrapper.NumericPrelude.T a))@ is in 'Ring.C' for all types @a@ that are in 'Ring.C'. -} newtype T a = Cons {decons :: a} deriving (Show, Eq, Ord, Ix, Bounded, Enum, Num, Integral, Fractional, Floating, Real, RealFrac, RealFloat) {-# INLINE lift1 #-} lift1 :: (a -> b) -> T a -> T b lift1 f (Cons a) = Cons (f a) {-# INLINE lift2 #-} lift2 :: (a -> b -> c) -> T a -> T b -> T c lift2 f (Cons a) (Cons b) = Cons (f a b) {-# INLINE unliftF1 #-} unliftF1 :: Functor f => (f (T a) -> f (T b)) -> f a -> f b unliftF1 f a = fmap decons $ f (fmap Cons a) {-# INLINE unliftF2 #-} unliftF2 :: Functor f => (f (T a) -> f (T b) -> f (T c)) -> f a -> f b -> f c unliftF2 f a b = fmap decons $ f (fmap Cons a) (fmap Cons b) instance Functor T where {-# INLINE fmap #-} fmap f (Cons a) = Cons (f a) instance Num a => Additive.C (T a) where zero = 0 (+) = lift2 (+) (-) = lift2 (-) negate = lift1 negate instance (Num a) => Ring.C (T a) where fromInteger = Cons . fromInteger (*) = lift2 (*) (^) a n = lift1 (^n) a instance (Fractional a) => Field.C (T a) where fromRational' r = Cons (fromRational (Ratio.toRational98 r)) (/) = lift2 (/) recip = lift1 recip (^-) a n = lift1 (^^n) a instance (Floating a) => Algebraic.C (T a) where sqrt = lift1 sqrt (^/) a r = lift1 (** fromRational (Ratio.toRational98 r)) a root n a = lift1 (** recip (fromInteger n)) a instance (Floating a) => Trans.C (T a) where pi = Cons pi log = lift1 log exp = lift1 exp logBase = lift2 logBase (**) = lift2 (**) cos = lift1 cos tan = lift1 tan sin = lift1 sin acos = lift1 acos atan = lift1 atan asin = lift1 asin cosh = lift1 cosh tanh = lift1 tanh sinh = lift1 sinh acosh = lift1 acosh atanh = lift1 atanh asinh = lift1 asinh instance (Integral a) => Integral.C (T a) where div = lift2 div mod = lift2 mod divMod (Cons a) (Cons b) = mapPair (Cons, Cons) (divMod a b) instance (Integral a) => Units.C (T a) where isUnit = unimplemented "isUnit" stdAssociate = unimplemented "stdAssociate" stdUnit = unimplemented "stdUnit" stdUnitInv = unimplemented "stdUnitInv" instance (Integral a) => PID.C (T a) where gcd = gcd lcm = lcm instance (Eq a, Num a) => ZeroTestable.C (T a) where isZero (Cons a) = a==0 instance (Num a) => Absolute.C (T a) where abs = abs signum = signum instance (RealFrac a) => RealRing.C (T a) where splitFraction (Cons a) = mapPair (Ring.fromInteger, Cons) (RealRing98.fixSplitFraction (properFraction a)) fraction (Cons a) = Cons (RealRing98.fixFraction (RealRing98.signedFraction a)) ceiling (Cons a) = Ring.fromInteger (ceiling a) floor (Cons a) = Ring.fromInteger (floor a) truncate (Cons a) = Ring.fromInteger (truncate a) round (Cons a) = Ring.fromInteger (round a) instance (RealFrac a) => RealField.C (T a) where instance (RealFloat a) => RealTrans.C (T a) where atan2 = atan2 instance (Integral a) => RealIntegral.C (T a) where quot = lift2 quot rem = lift2 rem quotRem (Cons a) (Cons b) = mapPair (Cons, Cons) (quotRem a b) instance (Integral a) => ToInteger.C (T a) where toInteger (Cons a) = toInteger a instance (Real a) => ToRational.C (T a) where toRational (Cons a) = Field.fromRational (toRational a) instance (RealFloat a) => Float.C (T a) where radix = floatRadix . decons digits = floatDigits . decons range = floatRange . decons decode = decodeFloat . decons encode m = Cons . encodeFloat m exponent = exponent . decons significand = lift1 significand scale = lift1 . scaleFloat isNaN = isNaN . decons isInfinite = isInfinite . decons isDenormalized = isDenormalized . decons isNegativeZero = isNegativeZero . decons isIEEE = isIEEE . decons unimplemented :: String -> a unimplemented name = error (name ++ "cannot be implemented in terms of Haskell98 type classes")