-- | The implementations of all functions except for rem, quot, div, mod are 
--   supposed to be as non-strict as possible.
module Data.Number.NatO 
  ( 
    -- * Datatype
    NatO(..), 
    -- * Helper Functions
    cmpNatOLT, fromNatO, toNatO,

    -- * Example Implementations using NatO
    length, take, drop, replicate,
    -- * Example Implementations using Num
    lengthNum, takeNum, dropNum, replicateNum
    
  ) where


import Prelude hiding ( length, take, drop, replicate )
import Data.Number.Nat
import Data.Ratio ( (%) )


-- | Natural numbers and zero
data NatO
  -- | Constructor representing zero
  = Zero  
  -- | A natural number 
  | Nat Nat
  deriving Eq


instance Show NatO where
  show Zero = "0"
  show (Nat n) = show n


instance Read NatO where
  readsPrec n = map (\(x,str) -> (toEnum x,str)) . readsPrec n  


instance Ord NatO where
  compare Zero Zero = EQ
  compare Zero _    = LT
  compare _    Zero = GT
  compare (Nat m) (Nat n) = compare m n

  -- these instances are lazier than the standard implementation
  -- for example Zero <= _|_ = True
  -- while the standard implementation yields _|_
  x < y  = cmpNatOLT y x == GT
  x >  y = cmpNatOLT x y == GT
  x <= y = cmpNatOLT x y == LT
  x >= y = cmpNatOLT y x == LT

-- | This function is used to implement lazy instances of compare and (\<), 
--   (\<=), (\>), (\>=). It is used to transfer information to more significant
--   bits. Instead of yielding EQ it yields LT if the numbers are equal.
cmpNatOLT :: NatO -> NatO -> Ordering
cmpNatOLT Zero  _    = LT
cmpNatOLT _     Zero = GT
cmpNatOLT (Nat m) (Nat n) = cmpNatLT m n


instance Enum NatO where
  succ = Nat . succ'
   where
    succ' Zero    = IHi
    succ' (Nat n) = succ n

  pred Zero      = error "predecessor of Zero"
  pred (Nat IHi) = Zero
  pred (Nat n)   = Nat (pred n)

  toEnum = toNatO

  fromEnum = fromNatO


instance Num NatO where
  Zero + n = n
  n + Zero = n
  Nat m + Nat n = Nat (m+n) 

  Zero - Nat _ = error "negative result in (-)"
  n    - Zero = n
  Nat m - Nat n = pred (Nat (minusNat m n))

  Zero  * _     = Zero
  _     * Zero  = Zero
  Nat m * Nat n = Nat (m*n)

  negate Zero = Zero
  negate _    = error "negative result in negate"
  
  signum Zero    = Zero
  signum (Nat _) = Nat IHi

  abs = id

  fromInteger = toNatO


instance Integral NatO where
  div m n = fst $ divmodNatO m n

  mod m n = snd $ divmodNatO m n

  quotRem = divmodNatO

  toInteger = fromNatO


-- | This is used for the implementation of toInteger and fromEnum.
fromNatO :: Num n => NatO -> n
fromNatO Zero    = 0
fromNatO (Nat n) = fromNat n

-- | This is used for the implementation of fromInteger and toEnum.
toNatO :: (Integral n,Num n) => n -> NatO
toNatO n 
  | n<0       = error "negative argument in fromInteger"
  | n==0      = Zero
  | otherwise = Nat (toNat n)


instance Real NatO where
  toRational n = toInteger n % 1


divmodNatO :: NatO -> NatO -> (NatO,NatO)
divmodNatO _ Zero = error "divide by zero"
divmodNatO x y    = divmodNatO' x y

divmodNatO' :: NatO -> NatO -> (NatO,NatO)
divmodNatO' x y
  | x<y       = (Zero,x)
  | otherwise = (succ q,r)
 where
  (q,r) = divmodNatO' (x-y) y


-- example functions

length :: [a] -> NatO
length []     = Zero
length (_:xs) = succ (length xs)

take :: NatO -> [a] -> [a]
take Zero _      = []
take _    []     = []
take n    (x:xs) = x:take (pred n) xs

drop :: NatO -> [a] -> [a]
drop Zero xs     = xs
drop _    []     = []
drop n    (_:xs) = drop (pred n) xs

replicate :: NatO -> a -> [a]
replicate n = take n . repeat


lengthNum :: (Enum n,Num n) => [a] -> n
lengthNum []     = 0
lengthNum (_:xs) = succ (lengthNum xs)

takeNum :: (Enum n,Num n) => n -> [a] -> [a]
takeNum n l
  | n==0      = []
  | otherwise = takeNum' l 
 where 
  takeNum' []     = []
  takeNum' (x:xs) = x:takeNum (pred n) xs

dropNum :: (Enum n,Num n) => n -> [a] -> [a]
dropNum n l
  | n==0      = l
  | otherwise = dropNum' l
 where
  dropNum' []     = []
  dropNum' (_:xs) = dropNum (pred n) xs

replicateNum :: (Enum n,Num n) => n -> a -> [a]
replicateNum n = takeNum n . repeat


-- examples

-- lazy :: String
-- lazy =
--   if length [1::Int ..]>0 then "long"
--                          else "short"