{-# 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 x :: a
x) = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ["(", a -> String
forall a. Show a => a -> String
show a
x, ")"]
show (Range x :: a
x y :: a
y) = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ["(", a -> String
forall a. Show a => a -> String
show a
x, "–", a -> String
forall a. Show a => a -> String
show a
y, ")"]
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
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 x :: a
x) == :: Range a -> Range a -> Bool
== (Single y :: a
y) = a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y
(Single a :: a
a) == (Range x :: a
x y :: 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 x :: a
x y :: a
y) == (Single a :: 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 lx :: a
lx ux :: a
ux) == (Range ly :: a
ly uy :: 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 x :: a
x) <= :: Range a -> Range a -> Bool
<= (Single y :: a
y) = a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
y
(Single x :: a
x) <= (Range y :: a
y _) = a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
y
(Range _ x :: a
x) <= (Single y :: a
y) = a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
y
(Range _ x :: a
x) <= (Range y :: a
y _) = a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
y
single :: (Ord a) => a -> Range a
single :: a -> Range a
single x :: a
x = a -> Range a
forall a. a -> Range a
Single a
x
range :: (Ord a) => a -> a -> Range a
range :: a -> a -> Range a
range l :: a
l u :: a
u
| a
l a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
u = a -> a -> Range a
forall a. a -> a -> Range a
Range a
l a
u
| Bool
otherwise = String -> Range a
forall a. HasCallStack => String -> a
error "lower bound must be smaller than upper bound"
ranges :: (Ord a) => [Range a] -> Ranges a
ranges :: [Range a] -> Ranges a
ranges = [Range a] -> Ranges a
forall 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 (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 :: a -> Range a -> Bool
inRange x :: a
x y :: Range a
y = a -> Range a
forall 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 :: a -> Ranges a -> Bool
inRanges x :: a
x (Ranges xs :: [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 :: Range a -> Range a -> Either (Range a) (Range a)
mergeRange x :: Range a
x y :: 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 :: Range a -> Range a -> Range a
minMax (Range lx :: a
lx ux :: a
ux) (Range ly :: a
ly uy :: a
uy) = a -> a -> Range a
forall 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 _) y :: Range a
y = Range a
y
minMax x :: Range a
x@(Range _ _) (Single _) = Range a
x
toSet :: (Ord a) => Ranges a -> Set (Range a)
toSet :: Ranges a -> Set (Range a)
toSet (Ranges x :: [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 :: Ranges a -> Range a -> Ranges a
addRange (Ranges x :: [Range a]
x) = [Range a] -> Ranges a
forall 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 :: [Range a] -> Range a -> [Range a]
mergeRanges [] y :: Range a
y = [Range a
y]
mergeRanges (x :: Range a
x:xs :: [Range a]
xs) y :: 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 z :: 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 x :: 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)