-- TODO: merge with the Posta version. And release them as a standalone package
{-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -Wall -fwarn-tabs #-}
----------------------------------------------------------------
--                                                    2015.12.17
-- |
-- Module      :  Data.Number.Natural
-- Copyright   :  Copyright (c) 2016 the Hakaru team
-- License     :  BSD3
-- Maintainer  :  wren@community.haskell.org
-- Stability   :  experimental
-- Portability :  Haskell98 + CPP
--
-- A data type for natural numbers (aka non-negative integers).
----------------------------------------------------------------
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

----------------------------------------------------------------
----------------------------------------------------------------
-- | Natural numbers, with unbounded-width à la 'Integer'. N.B.,
-- the 'Num' instance will throw errors on subtraction, negation,
-- and 'fromInteger' when the result is not a natural number.
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

-- TODO: should we define our own Show instance, in order to just
-- show the Integer itself, relying on our 'fromInteger' definition
-- to preserve cut&paste-ability? If so, then we should ensure that
-- the Read instance is optional in whether the \"Natural\" is there
-- or not.

-- N.B., we cannot derive Read, since that would inject invalid numbers!
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)


-- | Safely convert a natural number to an integer.
fromNatural :: Natural -> Integer
fromNatural :: Natural -> Integer
fromNatural (Natural Integer
i) = Integer
i
{-# INLINE fromNatural #-}


-- | Safely convert an integer to a natural number. Returns @Nothing@
-- if the integer is negative.
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 #-}


-- | Unsafely convert an integer to a natural number. Throws an
-- error if the integer is negative.
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


----------------------------------------------------------------
-- TODO: come up with a more succinct name...
type NonNegativeRational = Ratio Natural

-- | Safely convert a non-negative rational to a rational.
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)
    -- TODO: can we use @(:%)@ directly?
{-# INLINE fromNonNegativeRational #-}


-- | Safely convert a rational to a non-negative rational. Returns
-- @Nothing@ if the argument is negative.
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)
    -- TODO: can we use @(:%)@ directly?
{-# INLINE toNonNegativeRational #-}


-- | Unsafely convert a rational to a non-negative rational. Throws
-- an error if the argument is negative.
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 #-}

----------------------------------------------------------------
----------------------------------------------------------- fin.