{- |
Copyright   :  (c) Henning Thielemann 2007-2010

Maintainer  :  [email protected]
Stability   :  stable
Portability :  Haskell 98

A type for non-negative numbers.
It performs a run-time check at construction time (i.e. at run-time)
and is a member of the non-negative number type class
'Numeric.NonNegative.Class.C'.
-}
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 Data.Monoid (Monoid(mempty, mappend, mconcat))
import Data.Semigroup (Semigroup(sconcat, (<>)))
import Data.List.NonEmpty (NonEmpty((:|)))

import Test.QuickCheck (Arbitrary(arbitrary, shrink))
import Data.Tuple.HT (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 {forall a. T a -> a
unwrap :: a}
   deriving (T a -> T a -> Bool
(T a -> T a -> Bool) -> (T a -> T a -> Bool) -> Eq (T a)
forall a. Eq a => T a -> T a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => T a -> T a -> Bool
== :: T a -> T a -> Bool
$c/= :: forall a. Eq a => T a -> T a -> Bool
/= :: T a -> T a -> Bool
Eq, Eq (T a)
Eq (T a) =>
(T a -> T a -> Ordering)
-> (T a -> T a -> Bool)
-> (T a -> T a -> Bool)
-> (T a -> T a -> Bool)
-> (T a -> T a -> Bool)
-> (T a -> T a -> T a)
-> (T a -> T a -> T a)
-> Ord (T a)
T a -> T a -> Bool
T a -> T a -> Ordering
T a -> T a -> T a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (T a)
forall a. Ord a => T a -> T a -> Bool
forall a. Ord a => T a -> T a -> Ordering
forall a. Ord a => T a -> T a -> T a
$ccompare :: forall a. Ord a => T a -> T a -> Ordering
compare :: T a -> T a -> Ordering
$c< :: forall a. Ord a => T a -> T a -> Bool
< :: T a -> T a -> Bool
$c<= :: forall a. Ord a => T a -> T a -> Bool
<= :: T a -> T a -> Bool
$c> :: forall a. Ord a => T a -> T a -> Bool
> :: T a -> T a -> Bool
$c>= :: forall a. Ord a => T a -> T a -> Bool
>= :: T a -> T a -> Bool
$cmax :: forall a. Ord a => T a -> T a -> T a
max :: T a -> T a -> T a
$cmin :: forall a. Ord a => T a -> T a -> T a
min :: T a -> T a -> T a
Ord)

instance Show a => Show (T a) where
   showsPrec :: Int -> T a -> ShowS
showsPrec Int
p (Cons a
a) = Int -> a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
p a
a


{- |
Convert a number to a non-negative number.
If a negative number is given, an error is raised.
-}
fromNumber :: (Ord a, Num a) =>
      a
   -> T a
fromNumber :: forall a. (Ord a, Num a) => a -> T a
fromNumber = String -> a -> T a
forall a. (Ord a, Num a) => String -> a -> T a
fromNumberMsg String
"fromNumber"

fromNumberMsg :: (Ord a, Num a) =>
      String  {- ^ name of the calling function to be used in the error message -}
   -> a
   -> T a
fromNumberMsg :: forall a. (Ord a, Num a) => String -> a -> T a
fromNumberMsg String
funcName a
x =
   if a
xa -> a -> Bool
forall a. Ord a => a -> a -> Bool
>=a
0
     then a -> T a
forall a. a -> T a
Cons a
x
     else String -> T a
forall a. HasCallStack => String -> a
error (String
funcNameString -> ShowS
forall a. [a] -> [a] -> [a]
++String
": negative number")

fromNumberWrap :: (Ord a, Num a) =>
      String
   -> a
   -> T a
fromNumberWrap :: forall a. (Ord a, Num a) => String -> a -> T a
fromNumberWrap String
funcName =
   String -> a -> T a
forall a. (Ord a, Num a) => String -> a -> T a
fromNumberMsg (String
"NonNegative.Wrapper."String -> ShowS
forall a. [a] -> [a] -> [a]
++String
funcName)

{- |
Convert a number to a non-negative number.
A negative number will be replaced by zero.
Use this function with care since it may hide bugs.
-}
fromNumberClip :: (Ord a, Num a) =>
      a
   -> T a
fromNumberClip :: forall a. (Ord a, Num a) => a -> T a
fromNumberClip = a -> T a
forall a. a -> T a
Cons (a -> T a) -> (a -> a) -> a -> T a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a -> a
forall a. Ord a => a -> a -> a
max a
0

{- |
Wrap a number into a non-negative number without doing checks.
This routine exists entirely for efficiency reasons
and must be used only in cases where you are absolutely sure,
that the input number is non-negative.
-}
fromNumberUnsafe ::
      a
   -> T a
fromNumberUnsafe :: forall a. a -> T a
fromNumberUnsafe = a -> T a
forall a. a -> T a
Cons

{-
export only this in order to disable direct access to the record field
by record update syntax
-}
toNumber :: T a -> a
toNumber :: forall a. T a -> a
toNumber = T a -> a
forall a. T a -> a
unwrap


{- |
Results are not checked for positivity.
-}
lift :: (a -> a) -> (T a -> T a)
lift :: forall a. (a -> a) -> T a -> T a
lift a -> a
f = a -> T a
forall a. a -> T a
Cons (a -> T a) -> (T a -> a) -> T a -> T a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
f (a -> a) -> (T a -> a) -> T a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T a -> a
forall a. T a -> a
toNumber

liftWrap :: (Ord a, Num a) => String -> (a -> a) -> (T a -> T a)
liftWrap :: forall a. (Ord a, Num a) => String -> (a -> a) -> T a -> T a
liftWrap String
msg a -> a
f = String -> a -> T a
forall a. (Ord a, Num a) => String -> a -> T a
fromNumberWrap String
msg (a -> T a) -> (T a -> a) -> T a -> T a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
f (a -> a) -> (T a -> a) -> T a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T a -> a
forall a. T a -> a
toNumber


{- |
Results are not checked for positivity.
-}
lift2 :: (a -> a -> a) -> (T a -> T a -> T a)
lift2 :: forall a. (a -> a -> a) -> T a -> T a -> T a
lift2 a -> a -> a
f (Cons a
x) (Cons a
y) = a -> T a
forall a. a -> T a
Cons (a -> T a) -> a -> T a
forall a b. (a -> b) -> a -> b
$ a -> a -> a
f a
x a
y


instance (Num a) => Semigroup (T a) where
   Cons a
x <> :: T a -> T a -> T a
<> Cons a
y = a -> T a
forall a. a -> T a
Cons (a
xa -> a -> a
forall a. Num a => a -> a -> a
+a
y)
   sconcat :: NonEmpty (T a) -> T a
sconcat (T a
x :| [T a]
xs) = a -> T a
forall a. a -> T a
Cons (a -> T a) -> a -> T a
forall a b. (a -> b) -> a -> b
$ T a -> a
forall a. T a -> a
toNumber T a
x a -> a -> a
forall a. Num a => a -> a -> a
+ [a] -> a
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((T a -> a) -> [T a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map T a -> a
forall a. T a -> a
toNumber [T a]
xs)

instance (Num a) => Monoid (T a) where
   mempty :: T a
mempty = a -> T a
forall a. a -> T a
Cons a
0
   mappend :: T a -> T a -> T a
mappend (Cons a
x) (Cons a
y) = a -> T a
forall a. a -> T a
Cons (a
xa -> a -> a
forall a. Num a => a -> a -> a
+a
y)
   mconcat :: [T a] -> T a
mconcat = a -> T a
forall a. a -> T a
Cons (a -> T a) -> ([T a] -> a) -> [T a] -> T a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> a
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([a] -> a) -> ([T a] -> [a]) -> [T a] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (T a -> a) -> [T a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map T a -> a
forall a. T a -> a
toNumber

instance (Ord a, Num a) => NonNeg.C (T a) where
   split :: T a -> T a -> (T a, (Bool, T a))
split = (T a -> a) -> (a -> T a) -> T a -> T a -> (T a, (Bool, T a))
forall b a.
(Ord b, Num b) =>
(a -> b) -> (b -> a) -> a -> a -> (a, (Bool, a))
NonNeg.splitDefault T a -> a
forall a. T a -> a
toNumber a -> T a
forall a. a -> T a
Cons

instance (Ord a, Num a) => Num (T a) where
   + :: T a -> T a -> T a
(+)    = (a -> a -> a) -> T a -> T a -> T a
forall a. (a -> a -> a) -> T a -> T a -> T a
lift2 a -> a -> a
forall a. Num a => a -> a -> a
(+)
   (Cons a
x) - :: T a -> T a -> T a
- (Cons a
y) = String -> a -> T a
forall a. (Ord a, Num a) => String -> a -> T a
fromNumberWrap String
"-" (a
xa -> a -> a
forall a. Num a => a -> a -> a
-a
y)
   negate :: T a -> T a
negate = String -> (a -> a) -> T a -> T a
forall a. (Ord a, Num a) => String -> (a -> a) -> T a -> T a
liftWrap String
"negate" a -> a
forall a. Num a => a -> a
negate
   fromInteger :: Integer -> T a
fromInteger Integer
x = String -> a -> T a
forall a. (Ord a, Num a) => String -> a -> T a
fromNumberWrap String
"fromInteger" (Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
x)
   * :: T a -> T a -> T a
(*)    = (a -> a -> a) -> T a -> T a -> T a
forall a. (a -> a -> a) -> T a -> T a -> T a
lift2 a -> a -> a
forall a. Num a => a -> a -> a
(*)
   abs :: T a -> T a
abs    = (a -> a) -> T a -> T a
forall a. (a -> a) -> T a -> T a
lift a -> a
forall a. Num a => a -> a
abs
   signum :: T a -> T a
signum = (a -> a) -> T a -> T a
forall a. (a -> a) -> T a -> T a
lift a -> a
forall a. Num a => a -> a
signum

instance Real a => Real (T a) where
   toRational :: T a -> Rational
toRational = a -> Rational
forall a. Real a => a -> Rational
toRational (a -> Rational) -> (T a -> a) -> T a -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T a -> a
forall a. T a -> a
toNumber

{- required for Integral instance -}
instance (Ord a, Num a, Enum a) => Enum (T a) where
   toEnum :: Int -> T a
toEnum   = String -> a -> T a
forall a. (Ord a, Num a) => String -> a -> T a
fromNumberWrap String
"toEnum" (a -> T a) -> (Int -> a) -> Int -> T a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a
forall a. Enum a => Int -> a
toEnum
   fromEnum :: T a -> Int
fromEnum = a -> Int
forall a. Enum a => a -> Int
fromEnum (a -> Int) -> (T a -> a) -> T a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T a -> a
forall a. T a -> a
toNumber

instance (Ord a, Num a, Bounded a) => Bounded (T a) where
   minBound :: T a
minBound = a -> T a
forall a. (Ord a, Num a) => a -> T a
fromNumberClip a
forall a. Bounded a => a
minBound
   maxBound :: T a
maxBound = String -> a -> T a
forall a. (Ord a, Num a) => String -> a -> T a
fromNumberWrap String
"maxBound" a
forall a. Bounded a => a
maxBound

instance Integral a => Integral (T a) where
   toInteger :: T a -> Integer
toInteger = a -> Integer
forall a. Integral a => a -> Integer
toInteger (a -> Integer) -> (T a -> a) -> T a -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T a -> a
forall a. T a -> a
toNumber
   quot :: T a -> T a -> T a
quot = (a -> a -> a) -> T a -> T a -> T a
forall a. (a -> a -> a) -> T a -> T a -> T a
lift2 a -> a -> a
forall a. Integral a => a -> a -> a
quot
   rem :: T a -> T a -> T a
rem  = (a -> a -> a) -> T a -> T a -> T a
forall a. (a -> a -> a) -> T a -> T a -> T a
lift2 a -> a -> a
forall a. Integral a => a -> a -> a
rem
   quotRem :: T a -> T a -> (T a, T a)
quotRem (Cons a
x) (Cons a
y) =
      (a -> T a, a -> T a) -> (a, a) -> (T a, T a)
forall a c b d. (a -> c, b -> d) -> (a, b) -> (c, d)
mapPair (a -> T a
forall a. a -> T a
Cons, a -> T a
forall a. a -> T a
Cons) (a -> a -> (a, a)
forall a. Integral a => a -> a -> (a, a)
quotRem a
x a
y)
   div :: T a -> T a -> T a
div  = (a -> a -> a) -> T a -> T a -> T a
forall a. (a -> a -> a) -> T a -> T a -> T a
lift2 a -> a -> a
forall a. Integral a => a -> a -> a
div
   mod :: T a -> T a -> T a
mod  = (a -> a -> a) -> T a -> T a -> T a
forall a. (a -> a -> a) -> T a -> T a -> T a
lift2 a -> a -> a
forall a. Integral a => a -> a -> a
mod
   divMod :: T a -> T a -> (T a, T a)
divMod (Cons a
x) (Cons a
y) =
      (a -> T a, a -> T a) -> (a, a) -> (T a, T a)
forall a c b d. (a -> c, b -> d) -> (a, b) -> (c, d)
mapPair (a -> T a
forall a. a -> T a
Cons, a -> T a
forall a. a -> T a
Cons) (a -> a -> (a, a)
forall a. Integral a => a -> a -> (a, a)
divMod a
x a
y)

instance (Ord a, Fractional a) => Fractional (T a) where
   fromRational :: Rational -> T a
fromRational = String -> a -> T a
forall a. (Ord a, Num a) => String -> a -> T a
fromNumberWrap String
"fromRational" (a -> T a) -> (Rational -> a) -> Rational -> T a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> a
forall a. Fractional a => Rational -> a
fromRational
   / :: T a -> T a -> T a
(/) = (a -> a -> a) -> T a -> T a -> T a
forall a. (a -> a -> a) -> T a -> T a -> T a
lift2 a -> a -> a
forall a. Fractional a => a -> a -> a
(/)


instance (RealFrac a) => RealFrac (T a) where
   properFraction :: forall b. Integral b => T a -> (b, T a)
properFraction = (a -> T a) -> (b, a) -> (b, T a)
forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd a -> T a
forall a. a -> T a
fromNumberUnsafe ((b, a) -> (b, T a)) -> (T a -> (b, a)) -> T a -> (b, T a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> (b, a)
forall b. Integral b => a -> (b, a)
forall a b. (RealFrac a, Integral b) => a -> (b, a)
properFraction (a -> (b, a)) -> (T a -> a) -> T a -> (b, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T a -> a
forall a. T a -> a
toNumber
   truncate :: forall b. Integral b => T a -> b
truncate = a -> b
forall b. Integral b => a -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate (a -> b) -> (T a -> a) -> T a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T a -> a
forall a. T a -> a
toNumber
   round :: forall b. Integral b => T a -> b
round    = a -> b
forall b. Integral b => a -> b
forall a b. (RealFrac a, Integral b) => a -> b
round    (a -> b) -> (T a -> a) -> T a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T a -> a
forall a. T a -> a
toNumber
   ceiling :: forall b. Integral b => T a -> b
ceiling  = a -> b
forall b. Integral b => a -> b
forall a b. (RealFrac a, Integral b) => a -> b
ceiling  (a -> b) -> (T a -> a) -> T a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T a -> a
forall a. T a -> a
toNumber
   floor :: forall b. Integral b => T a -> b
floor    = a -> b
forall b. Integral b => a -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor    (a -> b) -> (T a -> a) -> T a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T a -> a
forall a. T a -> a
toNumber

instance (Ord a, Floating a) => Floating (T a) where
   pi :: T a
pi = a -> T a
forall a. (Ord a, Num a) => a -> T a
fromNumber a
forall a. Floating a => a
pi
   exp :: T a -> T a
exp  = (a -> a) -> T a -> T a
forall a. (a -> a) -> T a -> T a
lift a -> a
forall a. Floating a => a -> a
exp
   sqrt :: T a -> T a
sqrt = (a -> a) -> T a -> T a
forall a. (a -> a) -> T a -> T a
lift a -> a
forall a. Floating a => a -> a
sqrt
   log :: T a -> T a
log  = String -> (a -> a) -> T a -> T a
forall a. (Ord a, Num a) => String -> (a -> a) -> T a -> T a
liftWrap String
"log" a -> a
forall a. Floating a => a -> a
log
   ** :: T a -> T a -> T a
(**) = (a -> a -> a) -> T a -> T a -> T a
forall a. (a -> a -> a) -> T a -> T a -> T a
lift2 a -> a -> a
forall a. Floating a => a -> a -> a
(**)
   logBase :: T a -> T a -> T a
logBase (Cons a
x) = String -> (a -> a) -> T a -> T a
forall a. (Ord a, Num a) => String -> (a -> a) -> T a -> T a
liftWrap String
"logBase" (a -> a -> a
forall a. Floating a => a -> a -> a
logBase a
x)
   sin :: T a -> T a
sin = String -> (a -> a) -> T a -> T a
forall a. (Ord a, Num a) => String -> (a -> a) -> T a -> T a
liftWrap String
"sin" a -> a
forall a. Floating a => a -> a
sin
   tan :: T a -> T a
tan = String -> (a -> a) -> T a -> T a
forall a. (Ord a, Num a) => String -> (a -> a) -> T a -> T a
liftWrap String
"tan" a -> a
forall a. Floating a => a -> a
tan
   cos :: T a -> T a
cos = String -> (a -> a) -> T a -> T a
forall a. (Ord a, Num a) => String -> (a -> a) -> T a -> T a
liftWrap String
"cos" a -> a
forall a. Floating a => a -> a
cos
   asin :: T a -> T a
asin = String -> (a -> a) -> T a -> T a
forall a. (Ord a, Num a) => String -> (a -> a) -> T a -> T a
liftWrap String
"asin" a -> a
forall a. Floating a => a -> a
asin
   atan :: T a -> T a
atan = String -> (a -> a) -> T a -> T a
forall a. (Ord a, Num a) => String -> (a -> a) -> T a -> T a
liftWrap String
"atan" a -> a
forall a. Floating a => a -> a
atan
   acos :: T a -> T a
acos = String -> (a -> a) -> T a -> T a
forall a. (Ord a, Num a) => String -> (a -> a) -> T a -> T a
liftWrap String
"acos" a -> a
forall a. Floating a => a -> a
acos
   sinh :: T a -> T a
sinh = String -> (a -> a) -> T a -> T a
forall a. (Ord a, Num a) => String -> (a -> a) -> T a -> T a
liftWrap String
"sinh" a -> a
forall a. Floating a => a -> a
sinh
   tanh :: T a -> T a
tanh = String -> (a -> a) -> T a -> T a
forall a. (Ord a, Num a) => String -> (a -> a) -> T a -> T a
liftWrap String
"tanh" a -> a
forall a. Floating a => a -> a
tanh
   cosh :: T a -> T a
cosh = String -> (a -> a) -> T a -> T a
forall a. (Ord a, Num a) => String -> (a -> a) -> T a -> T a
liftWrap String
"cosh" a -> a
forall a. Floating a => a -> a
cosh
   asinh :: T a -> T a
asinh = String -> (a -> a) -> T a -> T a
forall a. (Ord a, Num a) => String -> (a -> a) -> T a -> T a
liftWrap String
"asinh" a -> a
forall a. Floating a => a -> a
asinh
   atanh :: T a -> T a
atanh = String -> (a -> a) -> T a -> T a
forall a. (Ord a, Num a) => String -> (a -> a) -> T a -> T a
liftWrap String
"atanh" a -> a
forall a. Floating a => a -> a
atanh
   acosh :: T a -> T a
acosh = String -> (a -> a) -> T a -> T a
forall a. (Ord a, Num a) => String -> (a -> a) -> T a -> T a
liftWrap String
"acosh" a -> a
forall a. Floating a => a -> a
acosh


instance (Num a, Arbitrary a) => Arbitrary (T a) where
   arbitrary :: Gen (T a)
arbitrary = (a -> T a) -> Gen a -> Gen (T a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (a -> T a
forall a. a -> T a
Cons (a -> T a) -> (a -> a) -> a -> T a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
forall a. Num a => a -> a
abs) Gen a
forall a. Arbitrary a => Gen a
arbitrary
   shrink :: T a -> [T a]
shrink (Cons a
xs) = (a -> T a) -> [a] -> [T a]
forall a b. (a -> b) -> [a] -> [b]
map (a -> T a
forall a. a -> T a
Cons (a -> T a) -> (a -> a) -> a -> T a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
forall a. Num a => a -> a
abs) ([a] -> [T a]) -> [a] -> [T a]
forall a b. (a -> b) -> a -> b
$ a -> [a]
forall a. Arbitrary a => a -> [a]
shrink a
xs


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