{-# LANGUAGE FlexibleInstances #-}
module Data.Ranges 
(range, ranges, Range, Ranges, inRange, inRanges)
where

newtype Ord a => Range a = Range { unRange :: (a, a) }
newtype Ord a => Ranges a = Ranges [Range a]

-- | Construct a 'Range' from a lower and upper bound.
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"

-- | Construct a 'Ranges' from a list of lower and upper bounds.
ranges :: (Ord a) => [(a,a)] -> Ranges a
ranges = Ranges . map Range . foldr (\x xs -> map unRange $ mergeRanges (map Range xs) (uncurry range x)) []

-- | Tests if a given range contains a particular value.
inRange :: (Ord a) => a -> Range a -> Bool
inRange x (Range (l,u)) = x >= l && x <= u

-- | Tests if any of the ranges contains a particular value.
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
	| lx <= uy && ux >= ly ||
	  ly <= ux && uy >= lx = Right $ Range (min lx ly, max ux uy)
	| otherwise = Left $ x
	where 
	(lx,ux) = unRange x
	(ly,uy) = unRange y

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)