module Data.RangeSet.List (
RSet
, (\\)
, null
, member
, notMember
, empty
, full
, singleton
, singletonRange
, insert
, insertRange
, delete
, deleteRange
, union
, difference
, intersection
, complement
, elems
, toList
, fromList
, toRangeList
, fromRangeList
) where
import Prelude hiding (filter,foldl,foldr,null,map)
import qualified Prelude
import Data.Monoid (Monoid(..))
newtype RSet a = RSet [(a, a)]
deriving (Eq, Ord)
instance Show a => Show (RSet a) where
show (RSet xs) = "fromRangeList " ++ show xs
instance (Ord a, Enum a) => Monoid (RSet a) where
mempty = empty
mappend = union
infixl 9 \\
(\\) :: (Ord a, Enum a) => RSet a -> RSet a -> RSet a
m1 \\ m2 = difference m1 m2
null :: RSet a -> Bool
null = Prelude.null . toRangeList
member :: (Ord a, Enum a) => a -> RSet a -> Bool
member x (RSet xs) = any f $ takeWhile g xs
where f (a, b) = a <= x && x <= b
g (a,_) = a <= x
notMember :: (Ord a, Enum a) => a -> RSet a -> Bool
notMember a r = not $ member a r
empty :: RSet a
empty = RSet []
full :: Bounded a => RSet a
full = RSet [(minBound, maxBound)]
singleton :: a -> RSet a
singleton x = RSet [(x, x)]
singletonRange :: Ord a => (a, a) -> RSet a
singletonRange (x, y) | x > y = empty
| otherwise = RSet [(x, y)]
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 r@(x, y) set@(RSet xs)
| x > y = set
| otherwise = RSet $ insertRange' r xs
insertRange' :: (Ord a, Enum a) => (a, a) -> [(a, a)] -> [(a, a)]
insertRange' r [] = [r]
insertRange' r@(x, y) set@(s@(u, v) : xs)
| y < u && succ y /= u = r : set
| v < x && succ v /= x = s : insertRange' r xs
| otherwise = insertRange' (min x u, max y v) xs
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 r@(x, y) set@(RSet xs)
| x > y = set
| otherwise = RSet $ deleteRange' r xs
deleteRange' :: (Ord a, Enum a) => (a, a) -> [(a, a)] -> [(a, a)]
deleteRange' _ [] = []
deleteRange' r@(x, y) set@(s@(u, v) : xs)
| y < u = set
| v < x = s : deleteRange' r xs
| u < x && y < v = (u, pred x) : (succ y, v) : xs
| y < v = (succ y, v) : xs
| u < x = (u, pred x) : deleteRange' r xs
| otherwise = deleteRange' r xs
union :: (Ord a, Enum a) => RSet a -> RSet a -> RSet a
union set (RSet xs) = Prelude.foldr insertRange set xs
difference :: (Ord a, Enum a) => RSet a -> RSet a -> RSet a
difference set (RSet xs) = Prelude.foldr deleteRange set xs
intersection :: (Ord a, Enum a) => RSet a -> RSet a -> RSet a
intersection a b = a \\ (a \\ b)
complement :: (Ord a, Enum a, Bounded a) => RSet a -> RSet a
complement a = full `difference` a
elems :: Enum a => RSet a -> [a]
elems = toList
toList :: Enum a => RSet a -> [a]
toList (RSet xs) = concatMap (uncurry enumFromTo) xs
fromList :: (Ord a, Enum a) => [a] -> RSet a
fromList = fromRangeList . Prelude.map f
where f a = (a, a)
toRangeList :: RSet a -> [(a, a)]
toRangeList (RSet xs) = xs
fromRangeList :: (Ord a, Enum a) => [(a, a)] -> RSet a
fromRangeList = Prelude.foldr insertRange empty