{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE Safe #-}
module Data.RangeSet.Map (
RSet
, (\\)
, null
, isFull
, size
, member
, notMember
, lookupLT
, lookupGT
, lookupLE
, lookupGE
, containsRange
, isSubsetOf
, valid
, empty
, full
, singleton
, singletonRange
, insert
, insertRange
, delete
, deleteRange
, union
, difference
, intersection
, split
, splitMember
, findMin
, findMax
, complement
, elems
, toList
, fromList
, fromAscList
, toAscList
, toRangeList
, fromRangeList
, fromRList
, toRList
, fromNormalizedRangeList
) where
import Prelude hiding (filter, foldl, foldr, map, null)
import Control.DeepSeq (NFData (..))
import qualified Data.Foldable as Fold
import Data.Functor ((<$>))
import qualified Data.Map.Strict as Map
import Data.Monoid (Monoid (..), getSum)
import Data.Semigroup (Semigroup (..))
import Data.Typeable (Typeable)
import Data.RangeSet.Internal
import qualified Data.RangeSet.List as RList
newtype RSet a = RSet (Map.Map a a)
deriving (Eq, Ord, Typeable)
instance Show a => Show (RSet a) where
show x = "fromRangeList " ++ show (toRangeList x)
instance (Ord a, Enum a) => Semigroup (RSet a) where
(<>) = union
instance (Ord a, Enum a) => Monoid (RSet a) where
mempty = empty
mappend = union
instance NFData a => NFData (RSet a) where
rnf (RSet xs) = rnf xs
infixl 9 \\
(\\) :: (Ord a, Enum a) => RSet a -> RSet a -> RSet a
m1 \\ m2 = difference m1 m2
null :: RSet a -> Bool
null (RSet m) = Map.null m
isFull :: (Eq a, Bounded a) => RSet a -> Bool
isFull = (==) full
size :: Enum a => RSet a -> Int
size (RSet xm) = getSum $ Map.foldMapWithKey rangeSize xm
contains' :: Ord a => a -> a -> RSet a -> Bool
contains' x y (RSet xm) = Fold.any ((y <=) . snd) $ Map.lookupLE x xm
member :: Ord a => a -> RSet a -> Bool
member x = contains' x x
notMember :: Ord a => a -> RSet a -> Bool
notMember a r = not $ member a r
lookupLT :: (Ord a, Enum a) => a -> RSet a -> Maybe a
lookupLT x (RSet xm) = min (pred x) . snd <$> Map.lookupLT x xm
lookupGT :: (Ord a, Enum a) => a -> RSet a -> Maybe a
lookupGT x (RSet xm)
| Just (_, b) <- Map.lookupLE x xm, x < b = Just (succ x)
| otherwise = fst <$> Map.lookupGT x xm
lookupLE :: Ord a => a -> RSet a -> Maybe a
lookupLE x (RSet xm) = min x . snd <$> Map.lookupLE x xm
lookupGE :: Ord a => a -> RSet a -> Maybe a
lookupGE x (RSet xm)
| Just (_, b) <- Map.lookupLE x xm, x <= b = Just x
| otherwise = fst <$> Map.lookupGT x xm
containsRange :: Ord a => (a, a) -> RSet a -> Bool
containsRange (x,y) s
| x <= y = contains' x y s
| otherwise = True
isSubsetOf :: Ord a => RSet a -> RSet a -> Bool
isSubsetOf x y = isSubsetRangeList (toRangeList x) (toRangeList y)
empty :: RSet a
empty = RSet Map.empty
full :: Bounded a => RSet a
full = singletonRange' minBound maxBound
singletonRange' :: a -> a -> RSet a
singletonRange' x y = RSet $ Map.singleton x y
singleton :: a -> RSet a
singleton x = singletonRange' x x
singletonRange :: Ord a => (a, a) -> RSet a
singletonRange (x, y) | x > y = empty
| otherwise = singletonRange' x y
insertRange' :: (Ord a, Enum a) => a -> a -> RSet a -> RSet a
insertRange' x y s = unRangeList $ insertRangeList x y $ toRangeList s
insert :: (Ord a, Enum a) => a -> RSet a -> RSet a
insert x = insertRange' x x
insertRange :: (Ord a, Enum a) => (a, a) -> RSet a -> RSet a
insertRange (x, y) set
| x > y = set
| otherwise = insertRange' x y set
deleteRange' :: (Ord a, Enum a) => a -> a -> RSet a -> RSet a
deleteRange' x y = unRangeList . deleteRangeList x y . toRangeList
delete :: (Ord a, Enum a) => a -> RSet a -> RSet a
delete x = deleteRange' x x
deleteRange :: (Ord a, Enum a) => (a, a) -> RSet a -> RSet a
deleteRange (x, y) set
| x > y = set
| otherwise = deleteRange' x y set
union :: (Ord a, Enum a) => RSet a -> RSet a -> RSet a
union x y = unRangeList $ unionRangeList (toRangeList x) (toRangeList y)
difference :: (Ord a, Enum a) => RSet a -> RSet a -> RSet a
difference x y = unRangeList $ differenceRangeList (toRangeList x) (toRangeList y)
intersection :: (Ord a, Enum a) => RSet a -> RSet a -> RSet a
intersection x y = unRangeList $ intersectRangeList (toRangeList x) (toRangeList y)
complement :: (Ord a, Enum a, Bounded a) => RSet a -> RSet a
complement = unRangeList . complementRangeList . toRangeList
split :: (Ord a, Enum a) => a -> RSet a -> (RSet a, RSet a)
split x s = (l, r) where (l, _, r) = splitMember x s
splitMember :: (Ord a, Enum a) => a -> RSet a -> (RSet a, Bool, RSet a)
splitMember x (RSet xm)
| Just y <- xv = (RSet ml, True, RSet $ insertIf (x < y) (succ x) y mr)
| Just ((u,v), ml') <- Map.maxViewWithKey ml =
if v < x
then (RSet ml, False, RSet mr)
else (RSet $ insertIf (u < x) u (pred x) ml', True, RSet $ insertIf (x < v) (succ x) v mr)
| otherwise = (RSet ml , False, RSet xm)
where
(ml, xv, mr) = Map.splitLookup x xm
insertIf False _ _ = id
insertIf True a b = Map.insert a b
findMin :: RSet a -> a
findMin (RSet m) = fst $ Map.findMin m
findMax :: RSet a -> a
findMax (RSet m) = snd $ Map.findMax m
unRangeList :: [(a, a)] -> RSet a
unRangeList = RSet . Map.fromDistinctAscList
elems :: Enum a => RSet a -> [a]
elems = toAscList
toList :: Enum a => RSet a -> [a]
toList (RSet xm) = Map.foldMapWithKey enumFromTo xm
fromList :: (Ord a, Enum a) => [a] -> RSet a
fromList = unRangeList . fromElemList
fromAscList :: (Ord a, Enum a) => [a] -> RSet a
fromAscList = unRangeList . fromAscElemList
toAscList :: Enum a => RSet a -> [a]
toAscList (RSet xm) = Map.foldrWithKey (\a -> (++) . enumFromTo a) [] xm
toRangeList :: RSet a -> [(a, a)]
toRangeList (RSet xs) = Map.toAscList xs
fromRangeList :: (Ord a, Enum a) => [(a, a)] -> RSet a
fromRangeList = unRangeList . normalizeRangeList
fromRList :: RList.RSet a -> RSet a
fromRList = fromNormalizedRangeList . RList.toRangeList
toRList :: RSet a -> RList.RSet a
toRList = RList.fromNormalizedRangeList . toRangeList
fromNormalizedRangeList :: [(a, a)] -> RSet a
fromNormalizedRangeList = RSet . Map.fromDistinctAscList
valid :: (Ord a, Enum a, Bounded a) => RSet a -> Bool
valid (RSet xm) = Map.valid xm && validRangeList (Map.toAscList xm)