{- |
Copyright   :  (c) Henning Thielemann 2008-2010

Maintainer  :  haskell@henning-thielemann.de
Stability   :  stable
Portability :  Haskell 98

This module contains internal functions (*Unsafe)
that I had liked to re-use in the NumericPrelude type hierarchy.
However since the Eq and Ord instance already require the Num class,
we cannot use that in the NumericPrelude.
-}
module Numeric.NonNegative.ChunkyPrivate
   (T, fromChunks, fromNumber, toChunks, toNumber,
    zero, normalize, isNull, isPositive,
    minMaxDiff,
    divModStrict,
    fromChunksUnsafe, toChunksUnsafe, ) where

import qualified Numeric.NonNegative.Class as NonNeg
import Numeric.NonNegative.Class ((-|), )
import Control.Monad (liftM, liftM2)

import qualified Data.Monoid as Mn
import Test.QuickCheck (Arbitrary(arbitrary))

{- |
A chunky non-negative number is a list of non-negative numbers.
It represents the sum of the list elements.
It is possible to represent a finite number with infinitely many chunks
by using an infinite number of zeros.

Note the following problems:

Addition is commutative only for finite representations.
E.g. @let y = min (1+y) 2 in y@ is defined,
@let y = min (y+1) 2 in y@ is not.
-}
newtype T a = Cons {decons :: [a]}


fromChunks :: NonNeg.C a => [a] -> T a
fromChunks = Cons

fromNumber :: NonNeg.C a => a -> T a
fromNumber = fromChunks . (:[])


{- |
This routine exposes the inner structure of the lazy number.
-}
toChunks :: T a -> [a]
toChunks = decons

toNumber :: NonNeg.C a => T a -> a
toNumber =  sum . decons


instance (Show a) => Show (T a) where
   showsPrec p x =
      showParen (p>10)
         (showString "Chunky.fromChunks " . showsPrec 10 (decons x))


lift2 :: ([a] -> [a] -> [a]) -> (T a -> T a -> T a)
lift2 f (Cons x) (Cons y) = Cons $ f x y

zero :: T a
zero = Cons []

{- |
Remove zero chunks.
-}
normalize :: NonNeg.C a => T a -> T a
normalize = Cons . filter (>0) . decons

isNullList :: NonNeg.C a => [a] -> Bool
isNullList = null . filter (>0)

isNull :: NonNeg.C a => T a -> Bool
isNull = isNullList . decons
  -- null . decons . normalize

isPositive :: NonNeg.C a => T a -> Bool
isPositive = not . isNull

check :: String -> Bool -> a -> a
check funcName b x =
   if b
     then x
     else error ("Numeric.NonNegative.Chunky."++funcName++": negative number")


glue :: (NonNeg.C a) => [a] -> [a] -> ([a], [a], Bool)
glue [] ys = ([], ys, True)
glue xs [] = ([], xs, False)
glue (x:xs) (y:ys) =
   let (z,(zs,rs,b)) =
           case compare x y of
              LT -> (x, glue xs ((y-|x):ys))
              GT -> (y, glue ((x-|y):xs) ys)
              EQ -> (x, glue xs ys)
   in  (z:zs,rs,b)

{- |
In @minMaxDiff x y == (z,r,b)@
@z@ represents @min x y@,
@r@ represents @max x y - min x y@,
and @x<y  ==>  b@ or @x>y  ==>  not b@,
 for @x==y@ the value of b is arbitrary.
-}
minMaxDiff :: (NonNeg.C a) => T a -> T a -> (T a, T a, Bool)
minMaxDiff (Cons xs) (Cons ys) =
   let (zs, rs, b) = glue xs ys
   in  (Cons zs, Cons rs, b)

equalList :: (NonNeg.C a) => [a] -> [a] -> Bool
equalList x y =
   let (_,r,_) = glue x y
   in  isNullList r

compareList :: (NonNeg.C a) => [a] -> [a] -> Ordering
compareList x y =
   let (_,r,b) = glue x y
   in  if isNullList r
         then EQ
         else if b then LT else GT

minList :: (NonNeg.C a) => [a] -> [a] -> [a]
minList x y =
   let (z,_,_) = glue x y in z

maxList :: (NonNeg.C a) => [a] -> [a] -> [a]
maxList x y =
   let (z,r,_) = glue x y in z++r


instance (NonNeg.C a) => Eq (T a) where
   (Cons x) == (Cons y) = equalList x y

instance (NonNeg.C a) => Ord (T a) where
   compare (Cons x) (Cons y) = compareList x y
   min = lift2 minList
   max = lift2 maxList


instance (NonNeg.C a) => NonNeg.C (T a) where
   (Cons x) -| (Cons w) =
      let sub _ [] = []
          sub z (y:ys) =
             if z<y then (y-|z):ys else sub (z-|y) ys
      in  Cons (foldr sub x w)

instance (NonNeg.C a) => Num (T a) where
   (+)    = Mn.mappend
   (Cons x) - (Cons y) =
      let (_,d,b) = glue x y
          d' = Cons d
      in check "-" (not b || isNull d') d'
   negate x = check "negate" (isNull x) x
   fromInteger = fromNumber . fromInteger
   (*)    = lift2 (liftM2 (*))
   abs    = id
   signum = fromNumber . (\b -> if b then 1 else 0) . isPositive


instance (Real a, NonNeg.C a) => Real (T a) where
   toRational = toRational . toNumber

{- required for Integral instance -}
instance (Enum a, NonNeg.C a) => Enum (T a) where
   toEnum   = fromNumber . toEnum
   fromEnum = fromEnum . toNumber

instance (Integral a, NonNeg.C a) => Integral (T a) where
   toInteger = toInteger . toNumber
   quot = div
   rem  = mod
   quotRem = divMod
   divMod x y =
      case divModStrict x (toNumber y) of
         (q,r) -> (q, fromNumber r)

divModStrict ::
   (Integral a, NonNeg.C a) =>
   T a -> a -> (T a, a)
divModStrict x0 y =
   let recourse [] r = ([], r)
       recourse (x:xs) r0 =
          let (q1,r1) = divMod (x+r0) y
              (q2,r2) = recourse xs r1
          in  (q1:q2,r2)
       (cs,rm) = recourse (toChunks x0) 0
   in  (fromChunks cs, rm)


instance Mn.Monoid (T a) where
   mempty = zero
   mappend = lift2 (++)

instance (NonNeg.C a, Arbitrary a) => Arbitrary (T a) where
   arbitrary = liftM Cons arbitrary


{- * Functions that may break invariants -}

fromChunksUnsafe :: [a] -> T a
fromChunksUnsafe = Cons

{- |
This routine exposes the inner structure of the lazy number
and is actually the same as 'toChunks'.
It was considered dangerous,
but you can observe the lazy structure
in tying-the-knot applications anyway.
So the explicit revelation of the chunks seems not to be worse.
-}
toChunksUnsafe :: T a -> [a]
toChunksUnsafe = decons