module Data.SizeCompare((|==|),(|<|),(|<=|),(|>|),(|>=|),Sizeable(..)) where
import Prelude
import Data.Map as M
import Data.Set as S

-- | Provides functionality for smartly measuring the size of a container
class Sizeable a where
    -- | Returns (Just size) for containers with O(1) size lookup, otherwise Nothing
    cSize :: a -> Maybe Int
    -- | Reduces a container by 1 element, resulting in Nothing when finished
    reduce :: a -> Maybe a
    

infix 5 |==|
infix 5 |<|
infix 5 |<=|
infix 5 |>|
infix 5 |>=|

-- | Equality on the size of containers
(|==|)::(Sizeable a, Sizeable b) => a -> b -> Bool
x |==| y = case cSize x of 
             Nothing -> case cSize y of
                         Nothing   -> findEqBoth (reduce x) (reduce y)
                         (Just yt) -> findEqLeft (reduce x) yt
             Just xt -> case cSize y of
                         Nothing   -> findEqRight xt (reduce y)
                         (Just yt) -> xt == yt
    where findEqLeft::(Sizeable a) => Maybe a -> Int -> Bool
          findEqLeft Nothing   yt = yt == 0
          findEqLeft (Just xt) yt = findEqLeft (reduce xt) (yt-1)
          
          findEqRight::(Sizeable b) => Int -> Maybe b -> Bool
          findEqRight xt Nothing   = xt == 0
          findEqRight xt (Just yt) = findEqRight (xt-1) (reduce yt) 

          findEqBoth::(Sizeable a, Sizeable b) => Maybe a -> Maybe b -> Bool
          findEqBoth Nothing   Nothing   = True
          findEqBoth (Just xt) (Just yt) = findEqBoth (reduce xt) (reduce yt)
          findEqBoth _         _         = False

-- | Defines Smaller Than on the size of containers
(|<|)::(Sizeable a, Sizeable b) => a -> b -> Bool
x |<| y = case cSize x of 
             Nothing -> case cSize y of
                         Nothing   -> findLtBoth (reduce x) (reduce y)
                         (Just yt) -> findLtLeft (reduce x) yt
             Just xt -> case cSize y of
                         Nothing   -> findLtRight xt (reduce y)
                         (Just yt) -> xt < yt
    where findLtLeft::(Sizeable a) => Maybe a -> Int -> Bool
          findLtLeft _         0  = False
          findLtLeft Nothing   _  = True
          findLtLeft (Just xt) yt = findLtLeft (reduce xt) (yt-1)
          
          findLtRight::(Sizeable b) => Int -> Maybe b -> Bool
          findLtRight _  Nothing   = False   
          findLtRight 0  _         = True
          findLtRight xt (Just yt) = findLtRight (xt-1) (reduce yt) 

          findLtBoth::(Sizeable a, Sizeable b) => Maybe a -> Maybe b -> Bool
          findLtBoth _         Nothing = False
          findLtBoth Nothing   _       = True          
          findLtBoth (Just xt) (Just yt) = findLtBoth (reduce xt) (reduce yt)

-- | Defines Smaller Than or Equal on the size of containers
(|<=|)::(Sizeable a, Sizeable b) => a -> b -> Bool
x |<=| y = case cSize x of 
             Nothing -> case cSize y of
                         Nothing   -> findLtEBoth (reduce x) (reduce y)
                         (Just yt) -> findLtELeft (reduce x) yt
             Just xt -> case cSize y of
                         Nothing   -> findLtERight xt (reduce y)
                         (Just yt) -> xt <= yt
    where findLtELeft::(Sizeable a) => Maybe a -> Int -> Bool          
          findLtELeft Nothing   _  = True
          findLtELeft _         0  = False
          findLtELeft (Just xt) yt = findLtELeft (reduce xt) (yt-1)
          
          findLtERight::(Sizeable b) => Int -> Maybe b -> Bool
          findLtERight 0  _         = True
          findLtERight _  Nothing   = False
          findLtERight xt (Just yt) = findLtERight (xt-1) (reduce yt) 

          findLtEBoth::(Sizeable a, Sizeable b) => Maybe a -> Maybe b -> Bool
          findLtEBoth Nothing   _       = True
          findLtEBoth _         Nothing = False
          findLtEBoth (Just xt) (Just yt) = findLtEBoth (reduce xt) (reduce yt)

-- | Defines Greater Than on the size of containers
(|>|)::(Sizeable a, Sizeable b) => a -> b -> Bool
x |>| y = case cSize x of 
             Nothing -> case cSize y of
                         Nothing   -> findGtBoth (reduce x) (reduce y)
                         (Just yt) -> findGtLeft (reduce x) yt
             Just xt -> case cSize y of
                         Nothing   -> findGtRight xt (reduce y)
                         (Just yt) -> xt > yt
    where findGtLeft::(Sizeable a) => Maybe a -> Int -> Bool
          findGtLeft Nothing   _  = False
          findGtLeft _         0  = True
          findGtLeft (Just xt) yt = findGtLeft (reduce xt) (yt-1)
          
          findGtRight::(Sizeable b) => Int -> Maybe b -> Bool
          findGtRight 0  _         = False   
          findGtRight _  Nothing   = True
          findGtRight xt (Just yt) = findGtRight (xt-1) (reduce yt) 

          findGtBoth::(Sizeable a, Sizeable b) => Maybe a -> Maybe b -> Bool
          findGtBoth Nothing   _       = False
          findGtBoth _         Nothing = True             
          findGtBoth (Just xt) (Just yt) = findGtBoth (reduce xt) (reduce yt)

-- | Defines Greate Than or Equal on the size of containers
(|>=|)::(Sizeable a, Sizeable b) => a -> b -> Bool
x |>=| y = case cSize x of 
             Nothing -> case cSize y of
                         Nothing   -> findGtEBoth (reduce x) (reduce y)
                         (Just yt) -> findGtELeft (reduce x) yt
             Just xt -> case cSize y of
                         Nothing   -> findGtERight xt (reduce y)
                         (Just yt) -> xt >= yt
    where findGtELeft::(Sizeable a) => Maybe a -> Int -> Bool          
          findGtELeft _         0  = True
          findGtELeft Nothing   _  = False
          findGtELeft (Just xt) yt = findGtELeft (reduce xt) (yt-1)
          
          findGtERight::(Sizeable b) => Int -> Maybe b -> Bool
          findGtERight _  Nothing   = True
          findGtERight 0  _         = False          
          findGtERight xt (Just yt) = findGtERight (xt-1) (reduce yt) 

          findGtEBoth::(Sizeable a, Sizeable b) => Maybe a -> Maybe b -> Bool
          findGtEBoth _         Nothing = True
          findGtEBoth Nothing   _       = False          
          findGtEBoth (Just xt) (Just yt) = findGtEBoth (reduce xt) (reduce yt)

-- | Sizeable instance for Int, make sure to add typing to integer constants, like: (0::Int).
instance Sizeable Int where   
    reduce 0 = Nothing
    reduce x = Just (x-1)
    cSize  x = Just (max x (-1))

-- | Sizeable for Lists
instance Sizeable [a] where
    reduce []     = Nothing
    reduce (_:xs) = Just xs
    cSize _ = Nothing

-- | Sizeable for Sets
instance Sizeable (S.Set a) where
    reduce s | S.null s    = Nothing
             | otherwise = Just (S.deleteMin s)
    cSize = Just . S.size

-- | Sizeable for Maps
instance Sizeable (M.Map a b) where
    reduce m | M.null m    = Nothing
             | otherwise   = Just (M.deleteAt 0 m) 
    cSize = Just . M.size