{-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -Wall -fwarn-tabs #-}
module Data.Number.Natural
( Natural()
, fromNatural
, toNatural
, unsafeNatural
, MaxNatural(..)
, NonNegativeRational
, fromNonNegativeRational
, toNonNegativeRational
, unsafeNonNegativeRational
) where
#if __GLASGOW_HASKELL__ < 710
import Data.Monoid (Monoid(..))
#endif
#if !(MIN_VERSION_base(4,11,0))
import Data.Semigroup
#endif
import Data.Ratio
newtype Natural = Natural Integer
deriving (Natural -> Natural -> Bool
(Natural -> Natural -> Bool)
-> (Natural -> Natural -> Bool) -> Eq Natural
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Natural -> Natural -> Bool
$c/= :: Natural -> Natural -> Bool
== :: Natural -> Natural -> Bool
$c== :: Natural -> Natural -> Bool
Eq, Eq Natural
Eq Natural
-> (Natural -> Natural -> Ordering)
-> (Natural -> Natural -> Bool)
-> (Natural -> Natural -> Bool)
-> (Natural -> Natural -> Bool)
-> (Natural -> Natural -> Bool)
-> (Natural -> Natural -> Natural)
-> (Natural -> Natural -> Natural)
-> Ord Natural
Natural -> Natural -> Bool
Natural -> Natural -> Ordering
Natural -> Natural -> Natural
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
min :: Natural -> Natural -> Natural
$cmin :: Natural -> Natural -> Natural
max :: Natural -> Natural -> Natural
$cmax :: Natural -> Natural -> Natural
>= :: Natural -> Natural -> Bool
$c>= :: Natural -> Natural -> Bool
> :: Natural -> Natural -> Bool
$c> :: Natural -> Natural -> Bool
<= :: Natural -> Natural -> Bool
$c<= :: Natural -> Natural -> Bool
< :: Natural -> Natural -> Bool
$c< :: Natural -> Natural -> Bool
compare :: Natural -> Natural -> Ordering
$ccompare :: Natural -> Natural -> Ordering
$cp1Ord :: Eq Natural
Ord)
instance Show Natural where
show :: Natural -> String
show (Natural Integer
i) = Integer -> String
forall a. Show a => a -> String
show Integer
i
instance Read Natural where
readsPrec :: Int -> ReadS Natural
readsPrec Int
d =
Bool -> ReadS Natural -> ReadS Natural
forall a. Bool -> ReadS a -> ReadS a
readParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ReadS Natural -> ReadS Natural) -> ReadS Natural -> ReadS Natural
forall a b. (a -> b) -> a -> b
$ \String
s0 -> do
(String
"Natural", String
s1) <- ReadS String
lex String
s0
(Integer
i, String
s2) <- Int -> ReadS Integer
forall a. Read a => Int -> ReadS a
readsPrec Int
11 String
s1
[(Natural, String)]
-> (Natural -> [(Natural, String)])
-> Maybe Natural
-> [(Natural, String)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Natural
n -> [(Natural
n,String
s2)]) (Integer -> Maybe Natural
toNatural Integer
i)
fromNatural :: Natural -> Integer
fromNatural :: Natural -> Integer
fromNatural (Natural Integer
i) = Integer
i
{-# INLINE fromNatural #-}
toNatural :: Integer -> Maybe Natural
toNatural :: Integer -> Maybe Natural
toNatural Integer
x
| Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 = Maybe Natural
forall a. Maybe a
Nothing
| Bool
otherwise = Natural -> Maybe Natural
forall a. a -> Maybe a
Just (Integer -> Natural
Natural Integer
x)
{-# INLINE toNatural #-}
unsafeNatural :: Integer -> Natural
unsafeNatural :: Integer -> Natural
unsafeNatural Integer
x
| Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 = String -> Natural
forall a. HasCallStack => String -> a
error String
_errmsg_unsafeNatural
| Bool
otherwise = Integer -> Natural
Natural Integer
x
{-# INLINE unsafeNatural #-}
instance Num Natural where
Natural Integer
i + :: Natural -> Natural -> Natural
+ Natural Integer
j = Integer -> Natural
Natural (Integer
i Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
j)
Natural Integer
i * :: Natural -> Natural -> Natural
* Natural Integer
j = Integer -> Natural
Natural (Integer
i Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
j)
Natural Integer
i - :: Natural -> Natural -> Natural
- Natural Integer
j
| Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
j = Integer -> Natural
Natural (Integer
i Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
j)
| Bool
otherwise = String -> Natural
forall a. HasCallStack => String -> a
error String
_errmsg_subtraction
negate :: Natural -> Natural
negate Natural
_ = String -> Natural
forall a. HasCallStack => String -> a
error String
_errmsg_negate
abs :: Natural -> Natural
abs Natural
n = Natural
n
signum :: Natural -> Natural
signum Natural
_ = Integer -> Natural
Natural Integer
1
fromInteger :: Integer -> Natural
fromInteger Integer
i
| Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0 Bool -> Bool -> Bool
&& Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0 = Integer -> Natural
Natural Integer
i
| Bool
otherwise = String -> Natural
forall a. HasCallStack => String -> a
error String
_errmsg_fromInteger
{-# INLINE (+) #-}
{-# INLINE (*) #-}
{-# INLINE (-) #-}
{-# INLINE negate #-}
{-# INLINE abs #-}
{-# INLINE signum #-}
{-# INLINE fromInteger #-}
instance Enum Natural where
succ :: Natural -> Natural
succ (Natural Integer
i) = Integer -> Natural
Natural (Integer
iInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
1)
pred :: Natural -> Natural
pred (Natural Integer
i)
| Integer
i Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
0 = Integer -> Natural
Natural (Integer
iInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
1)
| Bool
otherwise = String -> Natural
forall a. HasCallStack => String -> a
error String
_errmsg_pred
toEnum :: Int -> Natural
toEnum Int
n
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 = Integer -> Natural
Natural (Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
n)
| Bool
otherwise = String -> Natural
forall a. HasCallStack => String -> a
error String
_errmsg_toEnum
fromEnum :: Natural -> Int
fromEnum (Natural Integer
i) = Integer -> Int
forall a. Enum a => a -> Int
fromEnum Integer
i
enumFrom :: Natural -> [Natural]
enumFrom (Natural Integer
i) = (Integer -> Natural) -> [Integer] -> [Natural]
forall a b. (a -> b) -> [a] -> [b]
map Integer -> Natural
Natural (Integer -> [Integer]
forall a. Enum a => a -> [a]
enumFrom Integer
i)
enumFromThen :: Natural -> Natural -> [Natural]
enumFromThen (Natural Integer
i) (Natural Integer
j) = (Integer -> Natural) -> [Integer] -> [Natural]
forall a b. (a -> b) -> [a] -> [b]
map Integer -> Natural
Natural (Integer -> Integer -> [Integer]
forall a. Enum a => a -> a -> [a]
enumFromThen Integer
i Integer
j)
enumFromTo :: Natural -> Natural -> [Natural]
enumFromTo (Natural Integer
i) (Natural Integer
k) = (Integer -> Natural) -> [Integer] -> [Natural]
forall a b. (a -> b) -> [a] -> [b]
map Integer -> Natural
Natural (Integer -> Integer -> [Integer]
forall a. Enum a => a -> a -> [a]
enumFromTo Integer
i Integer
k)
enumFromThenTo :: Natural -> Natural -> Natural -> [Natural]
enumFromThenTo (Natural Integer
i) (Natural Integer
j) (Natural Integer
k) =
(Integer -> Natural) -> [Integer] -> [Natural]
forall a b. (a -> b) -> [a] -> [b]
map Integer -> Natural
Natural (Integer -> Integer -> Integer -> [Integer]
forall a. Enum a => a -> a -> a -> [a]
enumFromThenTo Integer
i Integer
j Integer
k)
{-# INLINE succ #-}
{-# INLINE pred #-}
{-# INLINE toEnum #-}
{-# INLINE fromEnum #-}
{-# INLINE enumFrom #-}
{-# INLINE enumFromThen #-}
{-# INLINE enumFromTo #-}
{-# INLINE enumFromThenTo #-}
instance Real Natural where
toRational :: Natural -> Rational
toRational (Natural Integer
i) = Integer -> Rational
forall a. Real a => a -> Rational
toRational Integer
i
{-# INLINE toRational #-}
instance Integral Natural where
quot :: Natural -> Natural -> Natural
quot (Natural Integer
i) (Natural Integer
j) = Integer -> Natural
Natural (Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
quot Integer
i Integer
j)
rem :: Natural -> Natural -> Natural
rem (Natural Integer
i) (Natural Integer
j) = Integer -> Natural
Natural (Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
rem Integer
i Integer
j)
quotRem :: Natural -> Natural -> (Natural, Natural)
quotRem (Natural Integer
i) (Natural Integer
j) =
case Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
quotRem Integer
i Integer
j of
(Integer
q,Integer
r) -> (Integer -> Natural
Natural Integer
q, Integer -> Natural
Natural Integer
r)
div :: Natural -> Natural -> Natural
div = Natural -> Natural -> Natural
forall a. Integral a => a -> a -> a
quot
mod :: Natural -> Natural -> Natural
mod = Natural -> Natural -> Natural
forall a. Integral a => a -> a -> a
rem
divMod :: Natural -> Natural -> (Natural, Natural)
divMod = Natural -> Natural -> (Natural, Natural)
forall a. Integral a => a -> a -> (a, a)
quotRem
toInteger :: Natural -> Integer
toInteger (Natural Integer
i) = Integer
i
{-# INLINE quot #-}
{-# INLINE rem #-}
{-# INLINE div #-}
{-# INLINE mod #-}
{-# INLINE quotRem #-}
{-# INLINE divMod #-}
{-# INLINE toInteger #-}
newtype MaxNatural = MaxNatural { MaxNatural -> Natural
unMaxNatural :: Natural }
instance Semigroup MaxNatural where
MaxNatural Natural
m <> :: MaxNatural -> MaxNatural -> MaxNatural
<> MaxNatural Natural
n = Natural -> MaxNatural
MaxNatural (Natural -> Natural -> Natural
forall a. Ord a => a -> a -> a
max Natural
m Natural
n)
instance Monoid MaxNatural where
mempty :: MaxNatural
mempty = Natural -> MaxNatural
MaxNatural Natural
0
#if !(MIN_VERSION_base(4,11,0))
mappend = (<>)
#endif
type NonNegativeRational = Ratio Natural
fromNonNegativeRational :: NonNegativeRational -> Rational
fromNonNegativeRational :: NonNegativeRational -> Rational
fromNonNegativeRational NonNegativeRational
x =
Natural -> Integer
fromNatural (NonNegativeRational -> Natural
forall a. Ratio a -> a
numerator NonNegativeRational
x) Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Natural -> Integer
fromNatural (NonNegativeRational -> Natural
forall a. Ratio a -> a
denominator NonNegativeRational
x)
{-# INLINE fromNonNegativeRational #-}
toNonNegativeRational :: Rational -> Maybe NonNegativeRational
toNonNegativeRational :: Rational -> Maybe NonNegativeRational
toNonNegativeRational Rational
x = do
Natural
n <- Integer -> Maybe Natural
toNatural (Rational -> Integer
forall a. Ratio a -> a
numerator Rational
x)
Natural
d <- Integer -> Maybe Natural
toNatural (Rational -> Integer
forall a. Ratio a -> a
denominator Rational
x)
NonNegativeRational -> Maybe NonNegativeRational
forall (m :: * -> *) a. Monad m => a -> m a
return (Natural
n Natural -> Natural -> NonNegativeRational
forall a. Integral a => a -> a -> Ratio a
% Natural
d)
{-# INLINE toNonNegativeRational #-}
unsafeNonNegativeRational :: Rational -> NonNegativeRational
unsafeNonNegativeRational :: Rational -> NonNegativeRational
unsafeNonNegativeRational Rational
x =
case Rational -> Maybe NonNegativeRational
toNonNegativeRational Rational
x of
Just NonNegativeRational
y -> NonNegativeRational
y
Maybe NonNegativeRational
Nothing -> String -> NonNegativeRational
forall a. HasCallStack => String -> a
error String
_errmsg_unsafeNonNegativeRational
{-# INLINE unsafeNonNegativeRational #-}
_errmsg_unsafeNatural, _errmsg_subtraction, _errmsg_negate, _errmsg_fromInteger, _errmsg_pred, _errmsg_toEnum, _errmsg_unsafeNonNegativeRational
:: String
_errmsg_unsafeNatural :: String
_errmsg_unsafeNatural = String
"unsafeNatural: negative input"
_errmsg_subtraction :: String
_errmsg_subtraction = String
"(-)@Natural: Num is a bad abstraction"
_errmsg_negate :: String
_errmsg_negate = String
"negate@Natural: Num is a bad abstraction"
_errmsg_fromInteger :: String
_errmsg_fromInteger = String
"fromInteger@Natural: Num is a bad abstraction"
_errmsg_pred :: String
_errmsg_pred = String
"pred@Natural: No predecessor of zero"
_errmsg_toEnum :: String
_errmsg_toEnum = String
"toEnum@Natural: negative input"
_errmsg_unsafeNonNegativeRational :: String
_errmsg_unsafeNonNegativeRational = String
"unsafeNonNegativeRational: negative input"
{-# NOINLINE _errmsg_unsafeNatural #-}
{-# NOINLINE _errmsg_subtraction #-}
{-# NOINLINE _errmsg_negate #-}
{-# NOINLINE _errmsg_fromInteger #-}
{-# NOINLINE _errmsg_pred #-}
{-# NOINLINE _errmsg_toEnum #-}
{-# NOINLINE _errmsg_unsafeNonNegativeRational #-}