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