{- |
A chunky lazy size type that resembles the NonNegative.Chunky type.
-}
module Data.StorableVector.LazySize where

import Data.StorableVector.Lazy
   (ChunkSize(ChunkSize), chunkSize, defaultChunkSize, )
import Control.Monad (liftM, liftM2, )
import Data.List (genericReplicate, )

import Test.QuickCheck (Arbitrary(..))


newtype T = Cons {decons :: [ChunkSize]}

intFromChunkSize :: ChunkSize -> Int
intFromChunkSize (ChunkSize x) = x



fromInt :: Int -> T
fromInt x = Cons [chunkSize x]

fromInts :: [Int] -> T
fromInts = Cons . map chunkSize

toInt :: T -> Int
toInt = sum . map intFromChunkSize . decons



instance Show T where
   showsPrec p x =
      showParen (p>10)
         (showString "LazySize.Cons " .
          showsPrec 10 (map intFromChunkSize $ decons x))

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

{- |
Remove zero chunks.
-}
normalize :: T -> T
normalize = Cons . filter (\(ChunkSize x) -> x>0) . decons

isNullList :: [ChunkSize] -> Bool
isNullList = null . filter (\(ChunkSize x) -> x>0)

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

isPositive :: T -> 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")


{- |
In @glue 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.
-}
glue :: [ChunkSize] -> [ChunkSize] -> ([ChunkSize], [ChunkSize], Bool)
glue [] ys = ([], ys, True)
glue xs [] = ([], xs, False)
glue (x@(ChunkSize x0) : xs) (y@(ChunkSize y0) : ys) =
   let (z,(zs,rs,b)) =
           case compare x0 y0 of
              LT -> (x, glue xs (ChunkSize (y0-x0) : ys))
              GT -> (y, glue (ChunkSize (x0-y0) : xs) ys)
              EQ -> (x, glue xs ys)
   in  (z:zs,rs,b)


equalList :: [ChunkSize] -> [ChunkSize] -> Bool
equalList x y =
   let (_,r,_) = glue x y
   in  isNullList r

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

minList :: [ChunkSize] -> [ChunkSize] -> [ChunkSize]
minList x y =
   let (z,_,_) = glue x y in z

maxList :: [ChunkSize] -> [ChunkSize] -> [ChunkSize]
maxList x y =
   let (z,r,_) = glue x y in z++r


instance Eq T where
   (Cons x) == (Cons y) = equalList x y

instance Ord T where
   compare (Cons x) (Cons y) = compareList x y
   min = lift2 minList
   max = lift2 maxList

instance Num T where
   (+)    = lift2 (++)
   (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 x =
      let (q,r) = divMod x (fromIntegral $ intFromChunkSize defaultChunkSize)
      in  Cons $ genericReplicate q defaultChunkSize ++ [ChunkSize (fromInteger r)]
   (*)    = lift2 (liftM2 (\(ChunkSize x) (ChunkSize y) -> ChunkSize (x*y)))
   abs    = id
   signum = fromInt . (\b -> if b then 1 else 0) . isPositive

instance Arbitrary T where
   arbitrary = liftM (normalize . Cons . map (ChunkSize . abs)) arbitrary
   coarbitrary = undefined

decrementLimit :: ChunkSize -> T -> T
decrementLimit (ChunkSize x) =
   let sub _ [] = []
       sub z (ChunkSize y : ys) =
          if z<y then ChunkSize (y-z) : ys else sub (z-y) ys
   in  Cons . sub x . decons