{-# LANGUAGE FlexibleInstances #-}
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 :: Range a -> String
show (Single a
x) = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"(", forall a. Show a => a -> String
show a
x, String
")"]
	show (Range a
x a
y) = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"(", forall a. Show a => a -> String
show a
x, String
"–", forall a. Show a => a -> String
show a
y, String
")"]

newtype Ord a => Ranges a = Ranges [Range a] deriving Int -> Ranges a -> ShowS
forall a. (Ord a, Show a) => Int -> Ranges a -> ShowS
forall a. (Ord a, Show a) => [Ranges a] -> ShowS
forall a. (Ord a, Show a) => Ranges a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Ranges a] -> ShowS
$cshowList :: forall a. (Ord a, Show a) => [Ranges a] -> ShowS
show :: Ranges a -> String
$cshow :: forall a. (Ord a, Show a) => Ranges a -> String
showsPrec :: Int -> Ranges a -> ShowS
$cshowsPrec :: forall a. (Ord a, Show a) => Int -> Ranges a -> ShowS
Show

-- | A rather hacked-up instance.
--   This is to support fast lookups using 'Data.Set' (see 'toSet').
instance (Ord a) => Eq (Range a) where
	(Single a
x) == :: Range a -> Range a -> Bool
== (Single a
y) = a
x forall a. Eq a => a -> a -> Bool
== a
y
	(Single a
a) == (Range a
x a
y) = a
x forall a. Ord a => a -> a -> Bool
<= a
a Bool -> Bool -> Bool
&& a
a forall a. Ord a => a -> a -> Bool
<= a
y
	(Range a
x a
y) == (Single a
a) = a
x forall a. Ord a => a -> a -> Bool
<= a
a Bool -> Bool -> Bool
&& a
a forall a. Ord a => a -> a -> Bool
<= a
y
	(Range a
lx a
ux) == (Range a
ly a
uy) = (a
lx forall a. Ord a => a -> a -> Bool
<= a
uy Bool -> Bool -> Bool
&& a
ux forall a. Ord a => a -> a -> Bool
>= a
ly) Bool -> Bool -> Bool
|| (a
ly forall a. Ord a => a -> a -> Bool
<= a
ux Bool -> Bool -> Bool
&& a
uy forall a. Ord a => a -> a -> Bool
>= a
lx)

instance (Ord a) => Ord (Range a) where
	(Single a
x) <= :: Range a -> Range a -> Bool
<= (Single a
y) = a
x forall a. Ord a => a -> a -> Bool
<= a
y
	(Single a
x) <= (Range a
y a
_) = a
x forall a. Ord a => a -> a -> Bool
<= a
y
	(Range a
_ a
x) <= (Single a
y) = a
x forall a. Ord a => a -> a -> Bool
<= a
y
	(Range a
_ a
x) <= (Range a
y a
_) = a
x forall a. Ord a => a -> a -> Bool
<= a
y

-- | A range consisting of a single value.
single :: (Ord a) => a -> Range a
single :: forall a. Ord a => a -> Range a
single a
x = forall a. a -> Range a
Single a
x

-- | Construct a 'Range' from a lower and upper bound.
range :: (Ord a) => a -> a -> Range a
range :: forall a. Ord a => a -> a -> Range a
range a
l a
u
	| a
l forall a. Ord a => a -> a -> Bool
<= a
u = forall a. a -> a -> Range a
Range a
l a
u
	| Bool
otherwise = forall a. HasCallStack => String -> a
error String
"lower bound must be smaller than upper bound"

-- | Construct a 'Ranges' from a list of lower and upper bounds.
ranges :: (Ord a) => [Range a] -> Ranges a
ranges :: forall a. Ord a => [Range a] -> Ranges a
ranges = forall a. [Range a] -> Ranges a
Ranges forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Ord a => [Range a] -> Range a -> [Range a]
mergeRanges) []

-- | Tests if a given range contains a particular value.
inRange :: (Ord a) => a -> Range a -> Bool
inRange :: forall a. Ord a => a -> Range a -> Bool
inRange a
x Range a
y = forall a. a -> Range a
Single a
x forall a. Eq a => a -> a -> Bool
== Range a
y

-- | Tests if any of the ranges contains a particular value.
inRanges :: (Ord a) => a -> Ranges a -> Bool
inRanges :: forall a. Ord a => a -> Ranges a -> Bool
inRanges a
x (Ranges [Range a]
xs) = forall (t :: * -> *). Foldable t => t Bool -> Bool
or forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (a
x forall a. Ord a => a -> Range a -> Bool
`inRange`) forall a b. (a -> b) -> a -> b
$ [Range a]
xs

mergeRange :: (Ord a) => Range a -> Range a -> Either (Range a) (Range a)
mergeRange :: forall a. Ord a => Range a -> Range a -> Either (Range a) (Range a)
mergeRange Range a
x Range a
y =
	if Range a
x forall a. Eq a => a -> a -> Bool
== Range a
y
		then forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall a. Ord a => Range a -> Range a -> Range a
minMax Range a
x Range a
y
		else forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Range a
x

minMax :: (Ord a) => Range a -> Range a -> Range a
minMax :: forall a. Ord a => Range a -> Range a -> Range a
minMax (Range a
lx a
ux) (Range a
ly a
uy) = forall a. a -> a -> Range a
Range (forall a. Ord a => a -> a -> a
min a
lx a
ly) (forall a. Ord a => a -> a -> a
max a
ux a
uy)
minMax (Single a
_) Range a
y = Range a
y
minMax x :: Range a
x@(Range a
_ a
_) (Single a
_) = Range a
x

-- | Allows quick lookups using ranges.
toSet :: (Ord a) => Ranges a -> Set (Range a)
toSet :: forall a. Ord a => Ranges a -> Set (Range a)
toSet (Ranges [Range a]
x) = forall a. Ord a => [a] -> Set a
Set.fromList [Range a]
x

addRange :: (Ord a) => Ranges a -> Range a -> Ranges a
addRange :: forall a. Ord a => Ranges a -> Range a -> Ranges a
addRange (Ranges [Range a]
x) = forall a. [Range a] -> Ranges a
Ranges forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [Range a] -> Range a -> [Range a]
mergeRanges [Range a]
x

mergeRanges :: (Ord a) => [Range a] -> Range a -> [Range a]
mergeRanges :: forall a. Ord a => [Range a] -> Range a -> [Range a]
mergeRanges [] Range a
y = [Range a
y]
mergeRanges (Range a
x:[Range a]
xs) Range a
y = case forall a. Ord a => Range a -> Range a -> Either (Range a) (Range a)
mergeRange Range a
x Range a
y of
		Right Range a
z -> forall a. Ord a => [Range a] -> Range a -> [Range a]
mergeRanges [Range a]
xs Range a
z
		Left Range a
x -> Range a
x forall a. a -> [a] -> [a]
: (forall a. Ord a => [Range a] -> Range a -> [Range a]
mergeRanges [Range a]
xs Range a
y)