{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Data.Range.Typed
(
(+=+),
(+=*),
(*=+),
(*=*),
lbi,
lbe,
ubi,
ube,
inf,
empty,
singleton,
anyRange,
anyRangeFor,
withRange,
compareLower,
compareHigher,
compareLowerIntersection,
compareHigherIntersection,
compareUpperToLower,
minBounds,
maxBounds,
minBoundsIntersection,
maxBoundsIntersection,
insertionSort,
invertBound,
isEmptySpan,
removeEmptySpans,
boundsOverlapType,
orOverlapType,
pointJoinType,
boundCmp,
boundIsBetween,
singletonInSpan,
againstLowerBound,
againstUpperBound,
lowestValueInLowerBound,
highestValueInUpperBound,
boundValue,
boundValueNormalized,
boundIsInclusive,
inRange,
inRanges,
aboveRange,
aboveRanges,
belowRange,
belowRanges,
rangesOverlap,
rangesAdjoin,
mergeRanges,
union,
intersection,
difference,
invert,
fromRanges,
joinRanges,
Bound (..),
AnyRangeFor (..),
Range (..),
AnyRange,
AnyRangeConstraint,
WithLowerBound (..),
WithUpperBound (..),
WithAllBounds,
)
where
import qualified Data.Range.Typed.Algebra as Alg
import Data.Range.Typed.Data
import Data.Range.Typed.Operators
import Data.Range.Typed.RangeInternal
import Data.Range.Typed.Util
union :: (Ord a) => [AnyRange a] -> [AnyRange a] -> [AnyRange a]
union :: forall a. Ord a => [AnyRange a] -> [AnyRange a] -> [AnyRange a]
union [AnyRange a]
a [AnyRange a]
b = Algebra RangeExpr [AnyRange a]
forall a. RangeAlgebra a => Algebra RangeExpr a
Alg.eval Algebra RangeExpr [AnyRange a] -> Algebra RangeExpr [AnyRange a]
forall a b. (a -> b) -> a -> b
$ RangeExpr [AnyRange a]
-> RangeExpr [AnyRange a] -> RangeExpr [AnyRange a]
forall a. RangeExpr a -> RangeExpr a -> RangeExpr a
Alg.union ([AnyRange a] -> RangeExpr [AnyRange a]
forall a. a -> RangeExpr a
Alg.const [AnyRange a]
a) ([AnyRange a] -> RangeExpr [AnyRange a]
forall a. a -> RangeExpr a
Alg.const [AnyRange a]
b)
{-# INLINE union #-}
intersection :: (Ord a) => [AnyRange a] -> [AnyRange a] -> [AnyRange a]
intersection :: forall a. Ord a => [AnyRange a] -> [AnyRange a] -> [AnyRange a]
intersection [AnyRange a]
a [AnyRange a]
b = Algebra RangeExpr [AnyRange a]
forall a. RangeAlgebra a => Algebra RangeExpr a
Alg.eval Algebra RangeExpr [AnyRange a] -> Algebra RangeExpr [AnyRange a]
forall a b. (a -> b) -> a -> b
$ RangeExpr [AnyRange a]
-> RangeExpr [AnyRange a] -> RangeExpr [AnyRange a]
forall a. RangeExpr a -> RangeExpr a -> RangeExpr a
Alg.intersection ([AnyRange a] -> RangeExpr [AnyRange a]
forall a. a -> RangeExpr a
Alg.const [AnyRange a]
a) ([AnyRange a] -> RangeExpr [AnyRange a]
forall a. a -> RangeExpr a
Alg.const [AnyRange a]
b)
{-# INLINE intersection #-}
difference :: (Ord a) => [AnyRange a] -> [AnyRange a] -> [AnyRange a]
difference :: forall a. Ord a => [AnyRange a] -> [AnyRange a] -> [AnyRange a]
difference [AnyRange a]
a [AnyRange a]
b = Algebra RangeExpr [AnyRange a]
forall a. RangeAlgebra a => Algebra RangeExpr a
Alg.eval Algebra RangeExpr [AnyRange a] -> Algebra RangeExpr [AnyRange a]
forall a b. (a -> b) -> a -> b
$ RangeExpr [AnyRange a]
-> RangeExpr [AnyRange a] -> RangeExpr [AnyRange a]
forall a. RangeExpr a -> RangeExpr a -> RangeExpr a
Alg.difference ([AnyRange a] -> RangeExpr [AnyRange a]
forall a. a -> RangeExpr a
Alg.const [AnyRange a]
a) ([AnyRange a] -> RangeExpr [AnyRange a]
forall a. a -> RangeExpr a
Alg.const [AnyRange a]
b)
{-# INLINE difference #-}
invert :: (Ord a) => [AnyRange a] -> [AnyRange a]
invert :: forall a. Ord a => [AnyRange a] -> [AnyRange a]
invert = Algebra RangeExpr [AnyRange a]
forall a. RangeAlgebra a => Algebra RangeExpr a
Alg.eval Algebra RangeExpr [AnyRange a]
-> ([AnyRange a] -> RangeExpr [AnyRange a])
-> [AnyRange a]
-> [AnyRange a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RangeExpr [AnyRange a] -> RangeExpr [AnyRange a]
forall a. RangeExpr a -> RangeExpr a
Alg.invert (RangeExpr [AnyRange a] -> RangeExpr [AnyRange a])
-> ([AnyRange a] -> RangeExpr [AnyRange a])
-> [AnyRange a]
-> RangeExpr [AnyRange a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [AnyRange a] -> RangeExpr [AnyRange a]
forall a. a -> RangeExpr a
Alg.const
{-# INLINE invert #-}
rangesOverlap :: (Ord a) => Range l0 h0 a -> Range l1 h1 a -> Bool
rangesOverlap :: forall a (l0 :: Bool) (h0 :: Bool) (l1 :: Bool) (h1 :: Bool).
Ord a =>
Range l0 h0 a -> Range l1 h1 a -> Bool
rangesOverlap Range l0 h0 a
a Range l1 h1 a
b = OverlapType
Overlap OverlapType -> OverlapType -> Bool
forall a. Eq a => a -> a -> Bool
== Range l0 h0 a -> Range l1 h1 a -> OverlapType
forall a (l0 :: Bool) (h0 :: Bool) (l1 :: Bool) (h1 :: Bool).
Ord a =>
Range l0 h0 a -> Range l1 h1 a -> OverlapType
rangesOverlapType Range l0 h0 a
a Range l1 h1 a
b
rangesOverlapType :: (Ord a) => Range l0 h0 a -> Range l1 h1 a -> OverlapType
rangesOverlapType :: forall a (l0 :: Bool) (h0 :: Bool) (l1 :: Bool) (h1 :: Bool).
Ord a =>
Range l0 h0 a -> Range l1 h1 a -> OverlapType
rangesOverlapType (SingletonRange a
a) Range l1 h1 a
x = Range 'True 'True a -> Range l1 h1 a -> OverlapType
forall a (l0 :: Bool) (h0 :: Bool) (l1 :: Bool) (h1 :: Bool).
Ord a =>
Range l0 h0 a -> Range l1 h1 a -> OverlapType
rangesOverlapType (Bound a -> Bound a -> Range 'True 'True a
forall a. Bound a -> Bound a -> Range 'True 'True a
SpanRange Bound a
b Bound a
b) Range l1 h1 a
x
where
b :: Bound a
b = a -> Bound a
forall a. a -> Bound a
InclusiveBound a
a
rangesOverlapType (SpanRange Bound a
x Bound a
y) (SpanRange Bound a
a Bound a
b) = (Bound a, Bound a) -> (Bound a, Bound a) -> OverlapType
forall a.
Ord a =>
(Bound a, Bound a) -> (Bound a, Bound a) -> OverlapType
boundsOverlapType (Bound a
x, Bound a
y) (Bound a
a, Bound a
b)
rangesOverlapType (SpanRange Bound a
_ Bound a
y) (LowerBoundRange Bound a
lower) = Bound a -> Bound a -> OverlapType
forall a. Ord a => Bound a -> Bound a -> OverlapType
againstLowerBound Bound a
y Bound a
lower
rangesOverlapType (SpanRange Bound a
x Bound a
_) (UpperBoundRange Bound a
upper) = Bound a -> Bound a -> OverlapType
forall a. Ord a => Bound a -> Bound a -> OverlapType
againstUpperBound Bound a
x Bound a
upper
rangesOverlapType (LowerBoundRange Bound a
_) (LowerBoundRange Bound a
_) = OverlapType
Overlap
rangesOverlapType (LowerBoundRange Bound a
lower) (UpperBoundRange Bound a
upper) = Bound a -> Bound a -> OverlapType
forall a. Ord a => Bound a -> Bound a -> OverlapType
againstUpperBound Bound a
lower Bound a
upper
rangesOverlapType (UpperBoundRange Bound a
_) (UpperBoundRange Bound a
_) = OverlapType
Overlap
rangesOverlapType Range l0 h0 a
InfiniteRange Range l1 h1 a
_ = OverlapType
Overlap
rangesOverlapType Range l0 h0 a
EmptyRange Range l1 h1 a
EmptyRange = OverlapType
Overlap
rangesOverlapType Range l0 h0 a
EmptyRange Range l1 h1 a
_ = OverlapType
Separate
rangesOverlapType Range l0 h0 a
a Range l1 h1 a
b = Range l1 h1 a -> Range l0 h0 a -> OverlapType
forall a (l0 :: Bool) (h0 :: Bool) (l1 :: Bool) (h1 :: Bool).
Ord a =>
Range l0 h0 a -> Range l1 h1 a -> OverlapType
rangesOverlapType Range l1 h1 a
b Range l0 h0 a
a
rangesAdjoin :: (Ord a) => Range l0 h0 a -> Range l1 h1 a -> Bool
rangesAdjoin :: forall a (l0 :: Bool) (h0 :: Bool) (l1 :: Bool) (h1 :: Bool).
Ord a =>
Range l0 h0 a -> Range l1 h1 a -> Bool
rangesAdjoin Range l0 h0 a
a Range l1 h1 a
b = OverlapType
Adjoin OverlapType -> OverlapType -> Bool
forall a. Eq a => a -> a -> Bool
== Range l0 h0 a -> Range l1 h1 a -> OverlapType
forall a (l0 :: Bool) (h0 :: Bool) (l1 :: Bool) (h1 :: Bool).
Ord a =>
Range l0 h0 a -> Range l1 h1 a -> OverlapType
rangesOverlapType Range l0 h0 a
a Range l1 h1 a
b
inRange :: (Ord a) => Range l h a -> a -> Bool
inRange :: forall a (l :: Bool) (h :: Bool). Ord a => Range l h a -> a -> Bool
inRange (SingletonRange a
a) a
value = a
value a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
a
inRange (SpanRange Bound a
x Bound a
y) a
value = OverlapType
Overlap OverlapType -> OverlapType -> Bool
forall a. Eq a => a -> a -> Bool
== Bound a -> (Bound a, Bound a) -> OverlapType
forall a. Ord a => Bound a -> (Bound a, Bound a) -> OverlapType
boundIsBetween (a -> Bound a
forall a. a -> Bound a
InclusiveBound a
value) (Bound a
x, Bound a
y)
inRange (LowerBoundRange Bound a
lower) a
value = OverlapType
Overlap OverlapType -> OverlapType -> Bool
forall a. Eq a => a -> a -> Bool
== Bound a -> Bound a -> OverlapType
forall a. Ord a => Bound a -> Bound a -> OverlapType
againstLowerBound (a -> Bound a
forall a. a -> Bound a
InclusiveBound a
value) Bound a
lower
inRange (UpperBoundRange Bound a
upper) a
value = OverlapType
Overlap OverlapType -> OverlapType -> Bool
forall a. Eq a => a -> a -> Bool
== Bound a -> Bound a -> OverlapType
forall a. Ord a => Bound a -> Bound a -> OverlapType
againstUpperBound (a -> Bound a
forall a. a -> Bound a
InclusiveBound a
value) Bound a
upper
inRange Range l h a
InfiniteRange a
_ = Bool
True
inRange Range l h a
EmptyRange a
_ = Bool
False
inRanges :: (Ord a) => [AnyRange a] -> a -> Bool
inRanges :: forall a. Ord a => [AnyRange a] -> a -> Bool
inRanges [AnyRange a]
rs a
a = (AnyRange a -> Bool) -> [AnyRange a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((forall (l :: Bool) (h :: Bool).
AnyRangeConstraint (Range l h) =>
Range l h a -> Bool)
-> AnyRange a -> Bool
forall (c :: (* -> *) -> Constraint) a b.
(forall (l :: Bool) (h :: Bool). c (Range l h) => Range l h a -> b)
-> AnyRangeFor c a -> b
withRange (Range l h a -> a -> Bool
forall a (l :: Bool) (h :: Bool). Ord a => Range l h a -> a -> Bool
`inRange` a
a)) [AnyRange a]
rs
aboveRange :: (Ord a) => Range l h a -> a -> Bool
aboveRange :: forall a (l :: Bool) (h :: Bool). Ord a => Range l h a -> a -> Bool
aboveRange (SingletonRange a
a) a
value = a
value a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
a
aboveRange (SpanRange Bound a
_ Bound a
y) a
value = OverlapType
Overlap OverlapType -> OverlapType -> Bool
forall a. Eq a => a -> a -> Bool
== Bound a -> Bound a -> OverlapType
forall a. Ord a => Bound a -> Bound a -> OverlapType
againstLowerBound (a -> Bound a
forall a. a -> Bound a
InclusiveBound a
value) (Bound a -> Bound a
forall a. Bound a -> Bound a
invertBound Bound a
y)
aboveRange (LowerBoundRange Bound a
_) a
_ = Bool
False
aboveRange (UpperBoundRange Bound a
upper) a
value = OverlapType
Overlap OverlapType -> OverlapType -> Bool
forall a. Eq a => a -> a -> Bool
== Bound a -> Bound a -> OverlapType
forall a. Ord a => Bound a -> Bound a -> OverlapType
againstLowerBound (a -> Bound a
forall a. a -> Bound a
InclusiveBound a
value) (Bound a -> Bound a
forall a. Bound a -> Bound a
invertBound Bound a
upper)
aboveRange Range l h a
InfiniteRange a
_ = Bool
False
aboveRange Range l h a
EmptyRange a
_ = Bool
True
aboveRanges :: (Ord a) => [AnyRange a] -> a -> Bool
aboveRanges :: forall a. Ord a => [AnyRange a] -> a -> Bool
aboveRanges [AnyRange a]
rs a
a = (AnyRange a -> Bool) -> [AnyRange a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((forall (l :: Bool) (h :: Bool).
AnyRangeConstraint (Range l h) =>
Range l h a -> Bool)
-> AnyRange a -> Bool
forall (c :: (* -> *) -> Constraint) a b.
(forall (l :: Bool) (h :: Bool). c (Range l h) => Range l h a -> b)
-> AnyRangeFor c a -> b
withRange (Range l h a -> a -> Bool
forall a (l :: Bool) (h :: Bool). Ord a => Range l h a -> a -> Bool
`aboveRange` a
a)) [AnyRange a]
rs
belowRange :: (Ord a) => Range l h a -> a -> Bool
belowRange :: forall a (l :: Bool) (h :: Bool). Ord a => Range l h a -> a -> Bool
belowRange (SingletonRange a
a) a
value = a
value a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
a
belowRange (SpanRange Bound a
x Bound a
_) a
value = OverlapType
Overlap OverlapType -> OverlapType -> Bool
forall a. Eq a => a -> a -> Bool
== Bound a -> Bound a -> OverlapType
forall a. Ord a => Bound a -> Bound a -> OverlapType
againstUpperBound (a -> Bound a
forall a. a -> Bound a
InclusiveBound a
value) (Bound a -> Bound a
forall a. Bound a -> Bound a
invertBound Bound a
x)
belowRange (LowerBoundRange Bound a
lower) a
value = OverlapType
Overlap OverlapType -> OverlapType -> Bool
forall a. Eq a => a -> a -> Bool
== Bound a -> Bound a -> OverlapType
forall a. Ord a => Bound a -> Bound a -> OverlapType
againstUpperBound (a -> Bound a
forall a. a -> Bound a
InclusiveBound a
value) (Bound a -> Bound a
forall a. Bound a -> Bound a
invertBound Bound a
lower)
belowRange (UpperBoundRange Bound a
_) a
_ = Bool
False
belowRange Range l h a
InfiniteRange a
_ = Bool
False
belowRange Range l h a
EmptyRange a
_ = Bool
True
belowRanges :: (Ord a) => [AnyRange a] -> a -> Bool
belowRanges :: forall a. Ord a => [AnyRange a] -> a -> Bool
belowRanges [AnyRange a]
rs a
a = (AnyRange a -> Bool) -> [AnyRange a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((forall (l :: Bool) (h :: Bool).
AnyRangeConstraint (Range l h) =>
Range l h a -> Bool)
-> AnyRange a -> Bool
forall (c :: (* -> *) -> Constraint) a b.
(forall (l :: Bool) (h :: Bool). c (Range l h) => Range l h a -> b)
-> AnyRangeFor c a -> b
withRange (Range l h a -> a -> Bool
forall a (l :: Bool) (h :: Bool). Ord a => Range l h a -> a -> Bool
`belowRange` a
a)) [AnyRange a]
rs
mergeRanges :: (Ord a) => [AnyRange a] -> [AnyRange a]
mergeRanges :: forall a. Ord a => [AnyRange a] -> [AnyRange a]
mergeRanges = Algebra RangeExpr [AnyRange a]
forall a. RangeAlgebra a => Algebra RangeExpr a
Alg.eval Algebra RangeExpr [AnyRange a]
-> ([AnyRange a] -> RangeExpr [AnyRange a])
-> [AnyRange a]
-> [AnyRange a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RangeExpr [AnyRange a]
-> RangeExpr [AnyRange a] -> RangeExpr [AnyRange a]
forall a. RangeExpr a -> RangeExpr a -> RangeExpr a
Alg.union ([AnyRange a] -> RangeExpr [AnyRange a]
forall a. a -> RangeExpr a
Alg.const []) (RangeExpr [AnyRange a] -> RangeExpr [AnyRange a])
-> ([AnyRange a] -> RangeExpr [AnyRange a])
-> [AnyRange a]
-> RangeExpr [AnyRange a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [AnyRange a] -> RangeExpr [AnyRange a]
forall a. a -> RangeExpr a
Alg.const
{-# INLINE mergeRanges #-}
fromRanges :: forall a. (Ord a, Enum a) => [AnyRange a] -> [a]
fromRanges :: forall a. (Ord a, Enum a) => [AnyRange a] -> [a]
fromRanges = [[a]] -> [a]
forall a. [[a]] -> [a]
takeEvenly ([[a]] -> [a]) -> ([AnyRange a] -> [[a]]) -> [AnyRange a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AnyRange a -> [a]) -> [AnyRange a] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((forall (l :: Bool) (h :: Bool).
AnyRangeConstraint (Range l h) =>
Range l h a -> [a])
-> AnyRange a -> [a]
forall (c :: (* -> *) -> Constraint) a b.
(forall (l :: Bool) (h :: Bool). c (Range l h) => Range l h a -> b)
-> AnyRangeFor c a -> b
withRange Range l h a -> [a]
forall (l :: Bool) (h :: Bool).
AnyRangeConstraint (Range l h) =>
Range l h a -> [a]
forall (l :: Bool) (h :: Bool). Range l h a -> [a]
fromRange) ([AnyRange a] -> [[a]])
-> ([AnyRange a] -> [AnyRange a]) -> [AnyRange a] -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [AnyRange a] -> [AnyRange a]
forall a. Ord a => [AnyRange a] -> [AnyRange a]
mergeRanges
where
fromRange :: Range l h a -> [a]
fromRange :: forall (l :: Bool) (h :: Bool). Range l h a -> [a]
fromRange =
\case
Range l h a
EmptyRange -> []
SingletonRange a
x -> [a
x]
SpanRange Bound a
a Bound a
b -> [(a -> a) -> Bound a -> a
forall a. (a -> a) -> Bound a -> a
boundValueNormalized a -> a
forall a. Enum a => a -> a
succ Bound a
a .. (a -> a) -> Bound a -> a
forall a. (a -> a) -> Bound a -> a
boundValueNormalized a -> a
forall a. Enum a => a -> a
pred Bound a
b]
LowerBoundRange Bound a
x -> (a -> a) -> a -> [a]
forall a. (a -> a) -> a -> [a]
iterate a -> a
forall a. Enum a => a -> a
succ (a -> [a]) -> a -> [a]
forall a b. (a -> b) -> a -> b
$ (a -> a) -> Bound a -> a
forall a. (a -> a) -> Bound a -> a
boundValueNormalized a -> a
forall a. Enum a => a -> a
succ Bound a
x
UpperBoundRange Bound a
x -> (a -> a) -> a -> [a]
forall a. (a -> a) -> a -> [a]
iterate a -> a
forall a. Enum a => a -> a
pred (a -> [a]) -> a -> [a]
forall a b. (a -> b) -> a -> b
$ (a -> a) -> Bound a -> a
forall a. (a -> a) -> Bound a -> a
boundValueNormalized a -> a
forall a. Enum a => a -> a
pred Bound a
x
Range l h a
InfiniteRange -> a
zero a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [[a]] -> [a]
forall a. [[a]] -> [a]
takeEvenly [[a] -> [a]
forall a. HasCallStack => [a] -> [a]
tail ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ (a -> a) -> a -> [a]
forall a. (a -> a) -> a -> [a]
iterate a -> a
forall a. Enum a => a -> a
succ a
zero, [a] -> [a]
forall a. HasCallStack => [a] -> [a]
tail ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ (a -> a) -> a -> [a]
forall a. (a -> a) -> a -> [a]
iterate a -> a
forall a. Enum a => a -> a
pred a
zero]
where
zero :: a
zero = Int -> a
forall a. Enum a => Int -> a
toEnum Int
0
joinRanges :: (Ord a, Enum a) => [AnyRange a] -> [AnyRange a]
joinRanges :: forall a. (Ord a, Enum a) => [AnyRange a] -> [AnyRange a]
joinRanges = RangeMerge a -> [AnyRange a]
forall a. Eq a => RangeMerge a -> [AnyRange a]
exportRangeMerge (RangeMerge a -> [AnyRange a])
-> ([AnyRange a] -> RangeMerge a) -> [AnyRange a] -> [AnyRange a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RangeMerge a -> RangeMerge a
forall a. (Eq a, Enum a) => RangeMerge a -> RangeMerge a
joinRM (RangeMerge a -> RangeMerge a)
-> ([AnyRange a] -> RangeMerge a) -> [AnyRange a] -> RangeMerge a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [AnyRange a] -> RangeMerge a
forall a (c :: (* -> *) -> Constraint).
Ord a =>
[AnyRangeFor c a] -> RangeMerge a
loadRanges