{-|
  The Natural module attempts to provide a representation of natural numbers
  (non-positive integers) which behave as much as possible like normal Integers.
  All calculations which would normally return a negative number result in an
  Indeterminate value. Once a Natural becomes Indeterminate, it will remain
  indeterminate in subsequent calculations. Such a calculation has, in effect,
  been errored-out in a safe manner.

  This is not a type-level representation of naturals as in some packages. It is
  basically a wrapper around the Integer type, using pattern-based rewriting.

  Naturals are created with the safe constructors natural or indeterm. Note that
  for practical reasons Indeterminate values are considered equal, which allows
  easy detection of an errored-out calculation via comparison.

  Feel free to send me an e-mail if you find the package useful, or if you have
  any suggestions or code to share.
-}
module Data.Natural ( Natural()
                    , natural
                    , indeterm
                    ) where

import Data.Ratio ((%))

data Natural = Natural Integer | Indeterminate deriving (Show)

{-|
  Constructs a Natural number, which is defined here as all non-negative
  integers, including zero. Passing in a negative integer will result in an
  Indeterminate value.

  >>> natural 10
  Natural 10
  >>> natural 0
  Natural 0
  >>> natural (-1)
  Indeterminate
-}
natural :: Integer -> Natural
natural n | n < 0 = Indeterminate
natural n = Natural n

{-|
  Constructs a Natural number with an Indeterminate value. Useful for detecting
  an Indeterminate value through comparison.

  >>> natural 3 - natural 4 == indeterm
  True
-}
indeterm :: Natural
indeterm = Indeterminate

instance Eq Natural where

  -- equality of Indeterminate values is necessary to satisfy signum law
  (==) Indeterminate Indeterminate = True
  (==) Indeterminate _             = False
  (==) _             Indeterminate = False
  (==) (Natural a)   (Natural b) = a == b

instance Num Natural where

  Indeterminate + _             = Indeterminate
  _             + Indeterminate = Indeterminate
  (Natural a)   + (Natural b)   = Natural (a+b)

  Indeterminate - _             = Indeterminate
  _             - Indeterminate = Indeterminate
  (Natural a)   - (Natural b) | a < b     = Indeterminate
                              | otherwise = Natural (a-b)

  Indeterminate * _             = Indeterminate
  _             * Indeterminate = Indeterminate
  (Natural a)   * (Natural b) = Natural (a*b)

  abs Indeterminate = Indeterminate
  abs (Natural a)   = Natural a

  signum Indeterminate = Indeterminate
  signum (Natural 0) = Natural 0
  signum (Natural _) = Natural 1

  fromInteger = natural

instance Ord Natural where 

  compare Indeterminate Indeterminate = EQ
  compare _             Indeterminate = GT
  compare Indeterminate _             = LT
  compare (Natural a)   (Natural b)   = compare a b

instance Real Natural where

  toRational Indeterminate = error $ "Natural of Indeterminate value cannot be"
                                     ++ " converted to a Rational"
  toRational (Natural a)   = a % 1

instance Enum Natural where

  succ Indeterminate = Indeterminate
  succ (Natural a)   = Natural (a+1)

  pred Indeterminate = Indeterminate
  pred (Natural 0)   = Indeterminate
  pred (Natural a)   = Natural (a-1)

  toEnum a = natural (toInteger a)

  fromEnum Indeterminate = error $ "Natural of Indeterminant value cannot be"
                                   ++ " converted to an Int"
  fromEnum (Natural a) = fromInteger a :: Int

instance Integral Natural where

  quotRem Indeterminate _             = (Indeterminate, Indeterminate)
  quotRem _             Indeterminate = (Indeterminate, Indeterminate)
  quotRem (Natural a)   (Natural b)   = ( natural $ quot a b
                                        , natural $ rem  a b )

  toInteger Indeterminate = error $ "Natural of Indeterminate value cannot be"
                                    ++ " converted to an Integer"
  toInteger (Natural a)   = a