module Numeric.NonNegative.Wrapper
(T, fromNumber, fromNumberMsg, fromNumberClip, fromNumberUnsafe, toNumber,
Int, Integer, Float, Double, Ratio, Rational) where
import qualified Numeric.NonNegative.Class as NonNeg
import Test.QuickCheck (Arbitrary(..))
import Numeric.NonNegative.Utility(mapPair, mapSnd)
import Control.Monad (liftM)
import qualified Data.Ratio as R
import qualified Prelude as P
import Prelude hiding (Int, Integer, Float, Double, Rational)
newtype T a = Cons {unwrap :: a}
deriving (Eq, Ord)
instance Show a => Show (T a) where
showsPrec p (Cons a) = showsPrec p a
fromNumber :: (Ord a, Num a) =>
a
-> T a
fromNumber = fromNumberMsg "fromNumber"
fromNumberMsg :: (Ord a, Num a) =>
String
-> a
-> T a
fromNumberMsg funcName x =
if x>=0
then Cons x
else error (funcName++": negative number")
fromNumberWrap :: (Ord a, Num a) =>
String
-> a
-> T a
fromNumberWrap funcName =
fromNumberMsg ("NonNegative.Wrapper."++funcName)
fromNumberClip :: (Ord a, Num a) =>
a
-> T a
fromNumberClip = Cons . max 0
fromNumberUnsafe ::
a
-> T a
fromNumberUnsafe = Cons
toNumber :: T a -> a
toNumber = unwrap
lift :: (a -> a) -> (T a -> T a)
lift f = Cons . f . toNumber
liftWrap :: (Ord a, Num a) => String -> (a -> a) -> (T a -> T a)
liftWrap msg f = fromNumberWrap msg . f . toNumber
lift2 :: (a -> a -> a) -> (T a -> T a -> T a)
lift2 f (Cons x) (Cons y) = Cons $ f x y
instance (Ord a, Num a) => NonNeg.C (T a) where
(Cons x) -| (Cons y) = fromNumberClip (xy)
instance (Ord a, Num a) => Num (T a) where
(+) = lift2 (+)
(Cons x) (Cons y) = fromNumberWrap "-" (xy)
negate = liftWrap "negate" negate
fromInteger x = fromNumberWrap "fromInteger" (fromInteger x)
(*) = lift2 (*)
abs = lift abs
signum = lift signum
instance Real a => Real (T a) where
toRational = toRational . toNumber
instance (Ord a, Num a, Enum a) => Enum (T a) where
toEnum = fromNumberWrap "toEnum" . toEnum
fromEnum = fromEnum . toNumber
instance (Ord a, Num a, Bounded a) => Bounded (T a) where
minBound = fromNumberClip minBound
maxBound = fromNumberWrap "maxBound" maxBound
instance Integral a => Integral (T a) where
toInteger = toInteger . toNumber
quot = lift2 quot
rem = lift2 rem
quotRem (Cons x) (Cons y) =
mapPair (Cons, Cons) (quotRem x y)
div = lift2 div
mod = lift2 mod
divMod (Cons x) (Cons y) =
mapPair (Cons, Cons) (divMod x y)
instance (Ord a, Fractional a) => Fractional (T a) where
fromRational = fromNumberWrap "fromRational" . fromRational
(/) = lift2 (/)
instance (RealFrac a) => RealFrac (T a) where
properFraction = mapSnd fromNumberUnsafe . properFraction . toNumber
truncate = truncate . toNumber
round = round . toNumber
ceiling = ceiling . toNumber
floor = floor . toNumber
instance (Ord a, Floating a) => Floating (T a) where
pi = fromNumber pi
exp = lift exp
sqrt = lift sqrt
log = liftWrap "log" log
(**) = lift2 (**)
logBase (Cons x) = liftWrap "logBase" (logBase x)
sin = liftWrap "sin" sin
tan = liftWrap "tan" tan
cos = liftWrap "cos" cos
asin = liftWrap "asin" asin
atan = liftWrap "atan" atan
acos = liftWrap "acos" acos
sinh = liftWrap "sinh" sinh
tanh = liftWrap "tanh" tanh
cosh = liftWrap "cosh" cosh
asinh = liftWrap "asinh" asinh
atanh = liftWrap "atanh" atanh
acosh = liftWrap "acosh" acosh
instance (Num a, Arbitrary a) => Arbitrary (T a) where
arbitrary = liftM (Cons . abs) arbitrary
coarbitrary = undefined
type Int = T P.Int
type Integer = T P.Integer
type Ratio a = T (R.Ratio a)
type Rational = T P.Rational
type Float = T P.Float
type Double = T P.Double