module Data.Ranges
(range, ranges, Range, Ranges, inRange, inRanges, toSet, single, addRange)
where
import Data.Set (Set)
import qualified Data.Set as Set
data Ord a => Range a = Single !a | Range !a !a
instance (Ord a, Show a) => Show (Range a) where
show (Single x) = concat ["(", show x, ")"]
show (Range x y) = concat ["(", show x, "–", show y, ")"]
newtype Ord a => Ranges a = Ranges [Range a] deriving Show
instance (Ord a) => Eq (Range a) where
(Single x) == (Single y) = x == y
(Single a) == (Range x y) = x <= a && a <= y
(Range x y) == (Single a) = x <= a && a <= y
(Range lx ux) == (Range ly uy) = (lx <= uy && ux >= ly) || (ly <= ux && uy >= lx)
instance (Ord a) => Ord (Range a) where
(Single x) <= (Single y) = x <= y
(Single x) <= (Range y _) = x <= y
(Range _ x) <= (Single y) = x <= y
(Range _ x) <= (Range y _) = x <= y
single :: (Ord a) => a -> Range a
single x = Single x
range :: (Ord a) => a -> a -> Range a
range l u
| l <= u = Range l u
| otherwise = error "lower bound must be smaller than upper bound"
ranges :: (Ord a) => [(a,a)] -> Ranges a
ranges = Ranges . foldr (flip mergeRanges) [] . map (uncurry range)
inRange :: (Ord a) => a -> Range a -> Bool
inRange x y = Single x == y
inRanges :: (Ord a) => a -> Ranges a -> Bool
inRanges x (Ranges xs) = or . map (x `inRange`) $ xs
mergeRange :: (Ord a) => Range a -> Range a -> Either (Range a) (Range a)
mergeRange x y =
if x == y
then Right $ minMax x y
else Left $ x
minMax :: (Ord a) => Range a -> Range a -> Range a
minMax (Range lx ux) (Range ly uy) = Range (min lx ly) (max ux uy)
minMax (Single _) y = y
minMax x@(Range _ _) (Single _) = x
toSet :: (Ord a) => Ranges a -> Set (Range a)
toSet (Ranges x) = Set.fromList x
addRange :: (Ord a) => Ranges a -> Range a -> Ranges a
addRange (Ranges x) = Ranges . mergeRanges x
mergeRanges :: (Ord a) => [Range a] -> Range a -> [Range a]
mergeRanges [] y = [y]
mergeRanges (x:xs) y = case mergeRange x y of
Right z -> mergeRanges xs z
Left x -> x : (mergeRanges xs y)