{-# 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) = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"(", a -> String
forall a. Show a => a -> String
show a
x, String
")"]
show (Range a
x a
y) = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"(", a -> String
forall a. Show a => a -> String
show a
x, String
"–", a -> String
forall a. Show a => a -> String
show a
y, String
")"]
newtype Ord a => Ranges a = Ranges [Range a] deriving Int -> Ranges a -> ShowS
[Ranges a] -> ShowS
Ranges a -> String
(Int -> Ranges a -> ShowS)
-> (Ranges a -> String) -> ([Ranges a] -> ShowS) -> Show (Ranges a)
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
$cshowsPrec :: forall a. (Ord a, Show a) => Int -> Ranges a -> ShowS
showsPrec :: Int -> Ranges a -> ShowS
$cshow :: forall a. (Ord a, Show a) => Ranges a -> String
show :: Ranges a -> String
$cshowList :: forall a. (Ord a, Show a) => [Ranges a] -> ShowS
showList :: [Ranges a] -> ShowS
Show
instance (Ord a) => Eq (Range a) where
(Single a
x) == :: Range a -> Range a -> Bool
== (Single a
y) = a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y
(Single a
a) == (Range a
x a
y) = a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
a Bool -> Bool -> Bool
&& a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
y
(Range a
x a
y) == (Single a
a) = a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
a Bool -> Bool -> Bool
&& a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
y
(Range a
lx a
ux) == (Range a
ly a
uy) = (a
lx a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
uy Bool -> Bool -> Bool
&& a
ux a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
ly) Bool -> Bool -> Bool
|| (a
ly a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
ux Bool -> Bool -> Bool
&& a
uy a -> a -> Bool
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 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
y
(Single a
x) <= (Range a
y a
_) = a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
y
(Range a
_ a
x) <= (Single a
y) = a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
y
(Range a
_ a
x) <= (Range a
y a
_) = a
x a -> a -> Bool
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 = a -> Range a
forall a. Ord 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 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
u = a -> a -> Range a
forall a. Ord a => a -> a -> Range a
Range a
l a
u
| Bool
otherwise = String -> Range a
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 = [Range a] -> Ranges a
forall a. Ord a => [Range a] -> Ranges a
Ranges ([Range a] -> Ranges a)
-> ([Range a] -> [Range a]) -> [Range a] -> Ranges a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Range a -> [Range a] -> [Range a])
-> [Range a] -> [Range a] -> [Range a]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (([Range a] -> Range a -> [Range a])
-> Range a -> [Range a] -> [Range a]
forall a b c. (a -> b -> c) -> b -> a -> c
flip [Range a] -> Range a -> [Range a]
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 = a -> Range a
forall a. Ord a => a -> Range a
Single a
x Range a -> Range a -> Bool
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) = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or ([Bool] -> Bool) -> ([Range a] -> [Bool]) -> [Range a] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Range a -> Bool) -> [Range a] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map (a
x a -> Range a -> Bool
forall a. Ord a => a -> Range a -> Bool
`inRange`) ([Range a] -> Bool) -> [Range a] -> Bool
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 Range a -> Range a -> Bool
forall a. Eq a => a -> a -> Bool
== Range a
y
then Range a -> Either (Range a) (Range a)
forall a b. b -> Either a b
Right (Range a -> Either (Range a) (Range a))
-> Range a -> Either (Range a) (Range a)
forall a b. (a -> b) -> a -> b
$ Range a -> Range a -> Range a
forall a. Ord a => Range a -> Range a -> Range a
minMax Range a
x Range a
y
else Range a -> Either (Range a) (Range a)
forall a b. a -> Either a b
Left (Range a -> Either (Range a) (Range a))
-> Range a -> Either (Range a) (Range a)
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) = a -> a -> Range a
forall a. Ord a => a -> a -> Range a
Range (a -> a -> a
forall a. Ord a => a -> a -> a
min a
lx a
ly) (a -> a -> a
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) = [Range a] -> Set (Range a)
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) = [Range a] -> Ranges a
forall a. Ord a => [Range a] -> Ranges a
Ranges ([Range a] -> Ranges a)
-> (Range a -> [Range a]) -> Range a -> Ranges a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Range a] -> Range a -> [Range a]
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 Range a -> Range a -> Either (Range a) (Range a)
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 -> [Range a] -> Range a -> [Range a]
forall a. Ord a => [Range a] -> Range a -> [Range a]
mergeRanges [Range a]
xs Range a
z
Left Range a
x -> Range a
x Range a -> [Range a] -> [Range a]
forall a. a -> [a] -> [a]
: ([Range a] -> Range a -> [Range a]
forall a. Ord a => [Range a] -> Range a -> [Range a]
mergeRanges [Range a]
xs Range a
y)