{-# 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
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
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
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"
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) []
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
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
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)