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