{-# LANGUAGE Safe #-}
{-# LANGUAGE BangPatterns #-}

module Data.Range.RangeInternal where

import Data.Maybe (catMaybes)
import qualified Data.Map.Strict as Map

import Data.Range.Data
import Data.Range.Spans
import Data.Range.Util

import Control.Monad (guard)

{-
 - The following assumptions must be maintained at the beginning of these internal
 - functions so that we can reason about what we are given.
 -
 - RangeMerge assumptions:
 - * The span ranges will never overlap the bounds.
 - * The span ranges are always sorted in ascending order by the first element.
 - * The lower and upper bounds never overlap in such a way to make it an infinite range.
 -}
data RangeMerge a = RM
   { forall a. RangeMerge a -> Maybe (Bound a)
largestLowerBound :: Maybe (Bound a)
   , forall a. RangeMerge a -> Maybe (Bound a)
largestUpperBound :: Maybe (Bound a)
   , forall a. RangeMerge a -> [(Bound a, Bound a)]
spanRanges :: [(Bound a, Bound a)]
   }
   | IRM
   deriving (Int -> RangeMerge a -> ShowS
[RangeMerge a] -> ShowS
RangeMerge a -> String
(Int -> RangeMerge a -> ShowS)
-> (RangeMerge a -> String)
-> ([RangeMerge a] -> ShowS)
-> Show (RangeMerge a)
forall a. Show a => Int -> RangeMerge a -> ShowS
forall a. Show a => [RangeMerge a] -> ShowS
forall a. Show a => RangeMerge a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> RangeMerge a -> ShowS
showsPrec :: Int -> RangeMerge a -> ShowS
$cshow :: forall a. Show a => RangeMerge a -> String
show :: RangeMerge a -> String
$cshowList :: forall a. Show a => [RangeMerge a] -> ShowS
showList :: [RangeMerge a] -> ShowS
Show, RangeMerge a -> RangeMerge a -> Bool
(RangeMerge a -> RangeMerge a -> Bool)
-> (RangeMerge a -> RangeMerge a -> Bool) -> Eq (RangeMerge a)
forall a. Eq a => RangeMerge a -> RangeMerge a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => RangeMerge a -> RangeMerge a -> Bool
== :: RangeMerge a -> RangeMerge a -> Bool
$c/= :: forall a. Eq a => RangeMerge a -> RangeMerge a -> Bool
/= :: RangeMerge a -> RangeMerge a -> Bool
Eq)

emptyRangeMerge :: RangeMerge a
emptyRangeMerge :: forall a. RangeMerge a
emptyRangeMerge = Maybe (Bound a)
-> Maybe (Bound a) -> [(Bound a, Bound a)] -> RangeMerge a
forall a.
Maybe (Bound a)
-> Maybe (Bound a) -> [(Bound a, Bound a)] -> RangeMerge a
RM Maybe (Bound a)
forall a. Maybe a
Nothing Maybe (Bound a)
forall a. Maybe a
Nothing []

storeRange :: (Ord a) => Range a -> RangeMerge a
storeRange :: forall a. Ord a => Range a -> RangeMerge a
storeRange Range a
InfiniteRange = RangeMerge a
forall a. RangeMerge a
IRM
storeRange (LowerBoundRange Bound a
lower) =
   RM { largestLowerBound :: Maybe (Bound a)
largestLowerBound = Bound a -> Maybe (Bound a)
forall a. a -> Maybe a
Just Bound a
lower, largestUpperBound :: Maybe (Bound a)
largestUpperBound = Maybe (Bound a)
forall a. Maybe a
Nothing, spanRanges :: [(Bound a, Bound a)]
spanRanges = [] }
storeRange (UpperBoundRange Bound a
upper) =
   RM { largestLowerBound :: Maybe (Bound a)
largestLowerBound = Maybe (Bound a)
forall a. Maybe a
Nothing, largestUpperBound :: Maybe (Bound a)
largestUpperBound = Bound a -> Maybe (Bound a)
forall a. a -> Maybe a
Just Bound a
upper, spanRanges :: [(Bound a, Bound a)]
spanRanges = [] }
storeRange (SpanRange x :: Bound a
x@(Bound a
xValue BoundType
xType) y :: Bound a
y@(Bound a
yValue BoundType
yType))
   | a
xValue a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
yValue Bool -> Bool -> Bool
&& BoundType -> BoundType -> OverlapType
pointJoinType BoundType
xType BoundType
yType OverlapType -> OverlapType -> Bool
forall a. Eq a => a -> a -> Bool
== OverlapType
Separate = RangeMerge a
forall a. RangeMerge a
emptyRangeMerge
   | Bool
otherwise =
      RM { largestLowerBound :: Maybe (Bound a)
largestLowerBound = Maybe (Bound a)
forall a. Maybe a
Nothing, largestUpperBound :: Maybe (Bound a)
largestUpperBound = Maybe (Bound a)
forall a. Maybe a
Nothing
         , spanRanges :: [(Bound a, Bound a)]
spanRanges = [(Bound a -> Bound a -> Bound a
forall a. Ord a => Bound a -> Bound a -> Bound a
minBounds Bound a
x Bound a
y, Bound a -> Bound a -> Bound a
forall a. Ord a => Bound a -> Bound a -> Bound a
maxBounds Bound a
x Bound a
y)] }
storeRange (SingletonRange a
x) =
   RM { largestLowerBound :: Maybe (Bound a)
largestLowerBound = Maybe (Bound a)
forall a. Maybe a
Nothing, largestUpperBound :: Maybe (Bound a)
largestUpperBound = Maybe (Bound a)
forall a. Maybe a
Nothing
      , spanRanges :: [(Bound a, Bound a)]
spanRanges = [(a -> BoundType -> Bound a
forall a. a -> BoundType -> Bound a
Bound a
x BoundType
Inclusive, a -> BoundType -> Bound a
forall a. a -> BoundType -> Bound a
Bound a
x BoundType
Inclusive)] }

storeRanges :: (Ord a) => RangeMerge a -> [Range a] -> RangeMerge a
storeRanges :: forall a. Ord a => RangeMerge a -> [Range a] -> RangeMerge a
storeRanges RangeMerge a
start [Range a]
ranges = (RangeMerge a -> RangeMerge a -> RangeMerge a)
-> RangeMerge a -> [RangeMerge a] -> RangeMerge a
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr RangeMerge a -> RangeMerge a -> RangeMerge a
forall a. Ord a => RangeMerge a -> RangeMerge a -> RangeMerge a
unionRangeMerges RangeMerge a
start ((Range a -> RangeMerge a) -> [Range a] -> [RangeMerge a]
forall a b. (a -> b) -> [a] -> [b]
map Range a -> RangeMerge a
forall a. Ord a => Range a -> RangeMerge a
storeRange [Range a]
ranges)

loadRanges :: (Ord a) => [Range a] -> RangeMerge a
loadRanges :: forall a. Ord a => [Range a] -> RangeMerge a
loadRanges = RangeMerge a -> [Range a] -> RangeMerge a
forall a. Ord a => RangeMerge a -> [Range a] -> RangeMerge a
storeRanges RangeMerge a
forall a. RangeMerge a
emptyRangeMerge
{-# INLINE[0] loadRanges #-}

exportRangeMerge :: (Eq a) => RangeMerge a -> [Range a]
exportRangeMerge :: forall a. Eq a => RangeMerge a -> [Range a]
exportRangeMerge RangeMerge a
IRM = [Range a
forall a. Range a
InfiniteRange]
exportRangeMerge (RM Maybe (Bound a)
lb Maybe (Bound a)
up [(Bound a, Bound a)]
spans) = Maybe (Bound a) -> [Range a]
forall a. Maybe (Bound a) -> [Range a]
putUpperBound Maybe (Bound a)
up [Range a] -> [Range a] -> [Range a]
forall a. [a] -> [a] -> [a]
++ [(Bound a, Bound a)] -> [Range a]
putSpans [(Bound a, Bound a)]
spans [Range a] -> [Range a] -> [Range a]
forall a. [a] -> [a] -> [a]
++ Maybe (Bound a) -> [Range a]
forall a. Maybe (Bound a) -> [Range a]
putLowerBound Maybe (Bound a)
lb
   where
      putLowerBound :: Maybe (Bound a) -> [Range a]
      putLowerBound :: forall a. Maybe (Bound a) -> [Range a]
putLowerBound = [Range a] -> (Bound a -> [Range a]) -> Maybe (Bound a) -> [Range a]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (Range a -> [Range a]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (Range a -> [Range a])
-> (Bound a -> Range a) -> Bound a -> [Range a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bound a -> Range a
forall a. Bound a -> Range a
LowerBoundRange)
      putUpperBound :: Maybe (Bound a) -> [Range a]
      putUpperBound :: forall a. Maybe (Bound a) -> [Range a]
putUpperBound = [Range a] -> (Bound a -> [Range a]) -> Maybe (Bound a) -> [Range a]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (Range a -> [Range a]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (Range a -> [Range a])
-> (Bound a -> Range a) -> Bound a -> [Range a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bound a -> Range a
forall a. Bound a -> Range a
UpperBoundRange)
      putSpans :: [(Bound a, Bound a)] -> [Range a]
putSpans = ((Bound a, Bound a) -> Range a)
-> [(Bound a, Bound a)] -> [Range a]
forall a b. (a -> b) -> [a] -> [b]
map (Bound a, Bound a) -> Range a
forall {a}. Eq a => (Bound a, Bound a) -> Range a
simplifySpan

      simplifySpan :: (Bound a, Bound a) -> Range a
simplifySpan (x :: Bound a
x@(Bound a
xv BoundType
xType), y :: Bound a
y@(Bound a
_ BoundType
yType)) = if (Bound a
x Bound a -> Bound a -> Bool
forall a. Eq a => a -> a -> Bool
== Bound a
y) Bool -> Bool -> Bool
&& (BoundType -> BoundType -> OverlapType
pointJoinType BoundType
xType BoundType
yType OverlapType -> OverlapType -> Bool
forall a. Eq a => a -> a -> Bool
/= OverlapType
Separate)
         then a -> Range a
forall a. a -> Range a
SingletonRange a
xv
         else Bound a -> Bound a -> Range a
forall a. Bound a -> Bound a -> Range a
SpanRange Bound a
x Bound a
y


intersectSpansRM :: (Ord a) => RangeMerge a -> RangeMerge a -> RangeMerge a
intersectSpansRM :: forall a. Ord a => RangeMerge a -> RangeMerge a -> RangeMerge a
intersectSpansRM RangeMerge a
one RangeMerge a
two = Maybe (Bound a)
-> Maybe (Bound a) -> [(Bound a, Bound a)] -> RangeMerge a
forall a.
Maybe (Bound a)
-> Maybe (Bound a) -> [(Bound a, Bound a)] -> RangeMerge a
RM Maybe (Bound a)
forall a. Maybe a
Nothing Maybe (Bound a)
forall a. Maybe a
Nothing [(Bound a, Bound a)]
newSpans
   where
      newSpans :: [(Bound a, Bound a)]
newSpans = [(Bound a, Bound a)]
-> [(Bound a, Bound a)] -> [(Bound a, Bound a)]
forall a.
Ord a =>
[(Bound a, Bound a)]
-> [(Bound a, Bound a)] -> [(Bound a, Bound a)]
intersectSpans (RangeMerge a -> [(Bound a, Bound a)]
forall a. RangeMerge a -> [(Bound a, Bound a)]
spanRanges RangeMerge a
one) (RangeMerge a -> [(Bound a, Bound a)]
forall a. RangeMerge a -> [(Bound a, Bound a)]
spanRanges RangeMerge a
two)

intersectWith :: (Ord a) => (Bound a -> (Bound a, Bound a) -> Maybe (Bound a, Bound a)) -> Maybe (Bound a) -> [(Bound a, Bound a)] -> [(Bound a, Bound a)]
intersectWith :: forall a.
Ord a =>
(Bound a -> (Bound a, Bound a) -> Maybe (Bound a, Bound a))
-> Maybe (Bound a) -> [(Bound a, Bound a)] -> [(Bound a, Bound a)]
intersectWith Bound a -> (Bound a, Bound a) -> Maybe (Bound a, Bound a)
_ Maybe (Bound a)
Nothing [(Bound a, Bound a)]
_ = []
intersectWith Bound a -> (Bound a, Bound a) -> Maybe (Bound a, Bound a)
fix (Just Bound a
lower) [(Bound a, Bound a)]
xs = [Maybe (Bound a, Bound a)] -> [(Bound a, Bound a)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (Bound a, Bound a)] -> [(Bound a, Bound a)])
-> [Maybe (Bound a, Bound a)] -> [(Bound a, Bound a)]
forall a b. (a -> b) -> a -> b
$ ((Bound a, Bound a) -> Maybe (Bound a, Bound a))
-> [(Bound a, Bound a)] -> [Maybe (Bound a, Bound a)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bound a -> (Bound a, Bound a) -> Maybe (Bound a, Bound a)
fix Bound a
lower) [(Bound a, Bound a)]
xs

fixLower :: (Ord a) => Bound a -> (Bound a, Bound a) -> Maybe (Bound a, Bound a)
fixLower :: forall a.
Ord a =>
Bound a -> (Bound a, Bound a) -> Maybe (Bound a, Bound a)
fixLower lower :: Bound a
lower@(Bound a
lowerValue BoundType
_) (Bound a
x, y :: Bound a
y@(Bound a
yValue BoundType
_)) = do
   Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (a
lowerValue a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
yValue)
   (Bound a, Bound a) -> Maybe (Bound a, Bound a)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bound a -> Bound a -> Bound a
forall a. Ord a => Bound a -> Bound a -> Bound a
maxBoundsIntersection Bound a
lower Bound a
x, Bound a
y)

fixUpper :: (Ord a) => Bound a -> (Bound a, Bound a) -> Maybe (Bound a, Bound a)
fixUpper :: forall a.
Ord a =>
Bound a -> (Bound a, Bound a) -> Maybe (Bound a, Bound a)
fixUpper upper :: Bound a
upper@(Bound a
upperValue BoundType
_) (x :: Bound a
x@(Bound a
xValue BoundType
_), Bound a
y) = do
   Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (a
xValue a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
upperValue)
   (Bound a, Bound a) -> Maybe (Bound a, Bound a)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bound a
x, Bound a -> Bound a -> Bound a
forall a. Ord a => Bound a -> Bound a -> Bound a
minBoundsIntersection Bound a
y Bound a
upper)

intersectionRangeMerges :: (Ord a) => RangeMerge a -> RangeMerge a -> RangeMerge a
intersectionRangeMerges :: forall a. Ord a => RangeMerge a -> RangeMerge a -> RangeMerge a
intersectionRangeMerges RangeMerge a
IRM RangeMerge a
two = RangeMerge a
two
intersectionRangeMerges RangeMerge a
one RangeMerge a
IRM = RangeMerge a
one
intersectionRangeMerges RangeMerge a
one RangeMerge a
two = RM
   { largestLowerBound :: Maybe (Bound a)
largestLowerBound = Maybe (Bound a)
newLowerBound
   , largestUpperBound :: Maybe (Bound a)
largestUpperBound = Maybe (Bound a)
newUpperBound
   , spanRanges :: [(Bound a, Bound a)]
spanRanges = [(Bound a, Bound a)] -> [(Bound a, Bound a)]
forall a. Ord a => [(Bound a, Bound a)] -> [(Bound a, Bound a)]
unionSpans [(Bound a, Bound a)]
sortedResults
   }
   where
      lowerOneSpans :: [(Bound a, Bound a)]
lowerOneSpans = (Bound a -> (Bound a, Bound a) -> Maybe (Bound a, Bound a))
-> Maybe (Bound a) -> [(Bound a, Bound a)] -> [(Bound a, Bound a)]
forall a.
Ord a =>
(Bound a -> (Bound a, Bound a) -> Maybe (Bound a, Bound a))
-> Maybe (Bound a) -> [(Bound a, Bound a)] -> [(Bound a, Bound a)]
intersectWith Bound a -> (Bound a, Bound a) -> Maybe (Bound a, Bound a)
forall a.
Ord a =>
Bound a -> (Bound a, Bound a) -> Maybe (Bound a, Bound a)
fixLower (RangeMerge a -> Maybe (Bound a)
forall a. RangeMerge a -> Maybe (Bound a)
largestLowerBound RangeMerge a
one) (RangeMerge a -> [(Bound a, Bound a)]
forall a. RangeMerge a -> [(Bound a, Bound a)]
spanRanges RangeMerge a
two)
      lowerTwoSpans :: [(Bound a, Bound a)]
lowerTwoSpans = (Bound a -> (Bound a, Bound a) -> Maybe (Bound a, Bound a))
-> Maybe (Bound a) -> [(Bound a, Bound a)] -> [(Bound a, Bound a)]
forall a.
Ord a =>
(Bound a -> (Bound a, Bound a) -> Maybe (Bound a, Bound a))
-> Maybe (Bound a) -> [(Bound a, Bound a)] -> [(Bound a, Bound a)]
intersectWith Bound a -> (Bound a, Bound a) -> Maybe (Bound a, Bound a)
forall a.
Ord a =>
Bound a -> (Bound a, Bound a) -> Maybe (Bound a, Bound a)
fixLower (RangeMerge a -> Maybe (Bound a)
forall a. RangeMerge a -> Maybe (Bound a)
largestLowerBound RangeMerge a
two) (RangeMerge a -> [(Bound a, Bound a)]
forall a. RangeMerge a -> [(Bound a, Bound a)]
spanRanges RangeMerge a
one)
      upperOneSpans :: [(Bound a, Bound a)]
upperOneSpans = (Bound a -> (Bound a, Bound a) -> Maybe (Bound a, Bound a))
-> Maybe (Bound a) -> [(Bound a, Bound a)] -> [(Bound a, Bound a)]
forall a.
Ord a =>
(Bound a -> (Bound a, Bound a) -> Maybe (Bound a, Bound a))
-> Maybe (Bound a) -> [(Bound a, Bound a)] -> [(Bound a, Bound a)]
intersectWith Bound a -> (Bound a, Bound a) -> Maybe (Bound a, Bound a)
forall a.
Ord a =>
Bound a -> (Bound a, Bound a) -> Maybe (Bound a, Bound a)
fixUpper (RangeMerge a -> Maybe (Bound a)
forall a. RangeMerge a -> Maybe (Bound a)
largestUpperBound RangeMerge a
one) (RangeMerge a -> [(Bound a, Bound a)]
forall a. RangeMerge a -> [(Bound a, Bound a)]
spanRanges RangeMerge a
two)
      upperTwoSpans :: [(Bound a, Bound a)]
upperTwoSpans = (Bound a -> (Bound a, Bound a) -> Maybe (Bound a, Bound a))
-> Maybe (Bound a) -> [(Bound a, Bound a)] -> [(Bound a, Bound a)]
forall a.
Ord a =>
(Bound a -> (Bound a, Bound a) -> Maybe (Bound a, Bound a))
-> Maybe (Bound a) -> [(Bound a, Bound a)] -> [(Bound a, Bound a)]
intersectWith Bound a -> (Bound a, Bound a) -> Maybe (Bound a, Bound a)
forall a.
Ord a =>
Bound a -> (Bound a, Bound a) -> Maybe (Bound a, Bound a)
fixUpper (RangeMerge a -> Maybe (Bound a)
forall a. RangeMerge a -> Maybe (Bound a)
largestUpperBound RangeMerge a
two) (RangeMerge a -> [(Bound a, Bound a)]
forall a. RangeMerge a -> [(Bound a, Bound a)]
spanRanges RangeMerge a
one)
      intersectedSpans :: [(Bound a, Bound a)]
intersectedSpans = [(Bound a, Bound a)]
-> [(Bound a, Bound a)] -> [(Bound a, Bound a)]
forall a.
Ord a =>
[(Bound a, Bound a)]
-> [(Bound a, Bound a)] -> [(Bound a, Bound a)]
intersectSpans (RangeMerge a -> [(Bound a, Bound a)]
forall a. RangeMerge a -> [(Bound a, Bound a)]
spanRanges RangeMerge a
one) (RangeMerge a -> [(Bound a, Bound a)]
forall a. RangeMerge a -> [(Bound a, Bound a)]
spanRanges RangeMerge a
two)

      sortedResults :: [(Bound a, Bound a)]
sortedResults = [(Bound a, Bound a)] -> [(Bound a, Bound a)]
forall a. Eq a => [(Bound a, Bound a)] -> [(Bound a, Bound a)]
removeEmptySpans ([(Bound a, Bound a)] -> [(Bound a, Bound a)])
-> [(Bound a, Bound a)] -> [(Bound a, Bound a)]
forall a b. (a -> b) -> a -> b
$ ([(Bound a, Bound a)]
 -> [(Bound a, Bound a)] -> [(Bound a, Bound a)])
-> [[(Bound a, Bound a)]] -> [(Bound a, Bound a)]
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 [(Bound a, Bound a)]
-> [(Bound a, Bound a)] -> [(Bound a, Bound a)]
forall a.
Ord a =>
[(Bound a, Bound a)]
-> [(Bound a, Bound a)] -> [(Bound a, Bound a)]
insertionSortSpans
         [ [(Bound a, Bound a)]
lowerOneSpans
         , [(Bound a, Bound a)]
lowerTwoSpans
         , [(Bound a, Bound a)]
upperOneSpans
         , [(Bound a, Bound a)]
upperTwoSpans
         , [(Bound a, Bound a)]
intersectedSpans
         , RangeMerge a -> RangeMerge a -> [(Bound a, Bound a)]
forall a.
Ord a =>
RangeMerge a -> RangeMerge a -> [(Bound a, Bound a)]
calculateBoundOverlap RangeMerge a
one RangeMerge a
two
         ]

      newLowerBound :: Maybe (Bound a)
newLowerBound = (RangeMerge a -> Maybe (Bound a))
-> (Bound a -> Bound a -> Bound a)
-> RangeMerge a
-> RangeMerge a
-> Maybe (Bound a)
forall a.
Ord a =>
(RangeMerge a -> Maybe (Bound a))
-> (Bound a -> Bound a -> Bound a)
-> RangeMerge a
-> RangeMerge a
-> Maybe (Bound a)
calculateNewBound RangeMerge a -> Maybe (Bound a)
forall a. RangeMerge a -> Maybe (Bound a)
largestLowerBound Bound a -> Bound a -> Bound a
forall a. Ord a => Bound a -> Bound a -> Bound a
maxBoundsIntersection RangeMerge a
one RangeMerge a
two
      newUpperBound :: Maybe (Bound a)
newUpperBound = (RangeMerge a -> Maybe (Bound a))
-> (Bound a -> Bound a -> Bound a)
-> RangeMerge a
-> RangeMerge a
-> Maybe (Bound a)
forall a.
Ord a =>
(RangeMerge a -> Maybe (Bound a))
-> (Bound a -> Bound a -> Bound a)
-> RangeMerge a
-> RangeMerge a
-> Maybe (Bound a)
calculateNewBound RangeMerge a -> Maybe (Bound a)
forall a. RangeMerge a -> Maybe (Bound a)
largestUpperBound Bound a -> Bound a -> Bound a
forall a. Ord a => Bound a -> Bound a -> Bound a
minBoundsIntersection RangeMerge a
one RangeMerge a
two

      calculateNewBound
         :: (Ord a)
         => (RangeMerge a -> Maybe (Bound a))
         -> (Bound a -> Bound a -> Bound a)
         -> RangeMerge a -> RangeMerge a -> Maybe (Bound a)
      calculateNewBound :: forall a.
Ord a =>
(RangeMerge a -> Maybe (Bound a))
-> (Bound a -> Bound a -> Bound a)
-> RangeMerge a
-> RangeMerge a
-> Maybe (Bound a)
calculateNewBound RangeMerge a -> Maybe (Bound a)
ext Bound a -> Bound a -> Bound a
comp RangeMerge a
one' RangeMerge a
two' = case (RangeMerge a -> Maybe (Bound a)
ext RangeMerge a
one', RangeMerge a -> Maybe (Bound a)
ext RangeMerge a
two') of
         (Just Bound a
x, Just Bound a
y) -> Bound a -> Maybe (Bound a)
forall a. a -> Maybe a
Just (Bound a -> Maybe (Bound a)) -> Bound a -> Maybe (Bound a)
forall a b. (a -> b) -> a -> b
$ Bound a -> Bound a -> Bound a
comp Bound a
x Bound a
y
         (Maybe (Bound a)
_, Maybe (Bound a)
Nothing) -> Maybe (Bound a)
forall a. Maybe a
Nothing
         (Maybe (Bound a)
Nothing, Maybe (Bound a)
_) -> Maybe (Bound a)
forall a. Maybe a
Nothing

calculateBoundOverlap :: (Ord a) => RangeMerge a -> RangeMerge a -> [(Bound a, Bound a)]
calculateBoundOverlap :: forall a.
Ord a =>
RangeMerge a -> RangeMerge a -> [(Bound a, Bound a)]
calculateBoundOverlap RangeMerge a
one RangeMerge a
two = [Maybe (Bound a, Bound a)] -> [(Bound a, Bound a)]
forall a. [Maybe a] -> [a]
catMaybes [Maybe (Bound a, Bound a)
oneWay, Maybe (Bound a, Bound a)
secondWay]
   where
      oneWay :: Maybe (Bound a, Bound a)
oneWay = do
         Bound a
x <- RangeMerge a -> Maybe (Bound a)
forall a. RangeMerge a -> Maybe (Bound a)
largestLowerBound RangeMerge a
one
         Bound a
y <- RangeMerge a -> Maybe (Bound a)
forall a. RangeMerge a -> Maybe (Bound a)
largestUpperBound RangeMerge a
two
         Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bound a -> Bound a -> Ordering
forall a. Ord a => Bound a -> Bound a -> Ordering
compareLower Bound a
y Bound a
x Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
LT)
         (Bound a, Bound a) -> Maybe (Bound a, Bound a)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bound a
x, Bound a
y)

      secondWay :: Maybe (Bound a, Bound a)
secondWay = do
         Bound a
x <- RangeMerge a -> Maybe (Bound a)
forall a. RangeMerge a -> Maybe (Bound a)
largestLowerBound RangeMerge a
two
         Bound a
y <- RangeMerge a -> Maybe (Bound a)
forall a. RangeMerge a -> Maybe (Bound a)
largestUpperBound RangeMerge a
one
         Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bound a -> Bound a -> Ordering
forall a. Ord a => Bound a -> Bound a -> Ordering
compareLower Bound a
y Bound a
x Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
LT)
         (Bound a, Bound a) -> Maybe (Bound a, Bound a)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bound a
x, Bound a
y)

unionRangeMerges :: (Ord a) => RangeMerge a -> RangeMerge a -> RangeMerge a
unionRangeMerges :: forall a. Ord a => RangeMerge a -> RangeMerge a -> RangeMerge a
unionRangeMerges RangeMerge a
IRM RangeMerge a
_ = RangeMerge a
forall a. RangeMerge a
IRM
unionRangeMerges RangeMerge a
_ RangeMerge a
IRM = RangeMerge a
forall a. RangeMerge a
IRM
unionRangeMerges RangeMerge a
one RangeMerge a
two = RangeMerge a -> RangeMerge a
forall a. Ord a => RangeMerge a -> RangeMerge a
infiniteCheck RangeMerge a
filterTwo
   where
      filterOne :: RangeMerge a
filterOne = ((Bound a, Bound a) -> RangeMerge a -> RangeMerge a)
-> RangeMerge a -> [(Bound a, Bound a)] -> RangeMerge a
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Bound a, Bound a) -> RangeMerge a -> RangeMerge a
forall a.
Ord a =>
(Bound a, Bound a) -> RangeMerge a -> RangeMerge a
filterLowerBound RangeMerge a
boundedRM ([(Bound a, Bound a)] -> [(Bound a, Bound a)]
forall a. Ord a => [(Bound a, Bound a)] -> [(Bound a, Bound a)]
unionSpans [(Bound a, Bound a)]
sortedSpans)
      filterTwo :: RangeMerge a
filterTwo = case RangeMerge a
filterOne of
         RangeMerge a
IRM -> RangeMerge a
forall a. RangeMerge a
IRM
         RangeMerge a
rm  -> ((Bound a, Bound a) -> RangeMerge a -> RangeMerge a)
-> RangeMerge a -> [(Bound a, Bound a)] -> RangeMerge a
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Bound a, Bound a) -> RangeMerge a -> RangeMerge a
forall a.
Ord a =>
(Bound a, Bound a) -> RangeMerge a -> RangeMerge a
filterUpperBound (RangeMerge a
rm { spanRanges = [] }) (RangeMerge a -> [(Bound a, Bound a)]
forall a. RangeMerge a -> [(Bound a, Bound a)]
spanRanges RangeMerge a
rm)

      infiniteCheck :: (Ord a) => RangeMerge a -> RangeMerge a
      infiniteCheck :: forall a. Ord a => RangeMerge a -> RangeMerge a
infiniteCheck RangeMerge a
IRM = RangeMerge a
forall a. RangeMerge a
IRM
      infiniteCheck rm :: RangeMerge a
rm@(RM (Just Bound a
lower) (Just Bound a
upper) [(Bound a, Bound a)]
_) = if Bound a -> Bound a -> Ordering
forall a. Ord a => Bound a -> Bound a -> Ordering
compareUpperToLower Bound a
upper Bound a
lower Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
LT
         then RangeMerge a
forall a. RangeMerge a
IRM
         else RangeMerge a
rm
      infiniteCheck RangeMerge a
rm = RangeMerge a
rm

      newLowerBound :: Maybe (Bound a)
newLowerBound = (RangeMerge a -> Maybe (Bound a))
-> (Bound a -> Bound a -> Bound a)
-> RangeMerge a
-> RangeMerge a
-> Maybe (Bound a)
forall a.
Ord a =>
(RangeMerge a -> Maybe (Bound a))
-> (Bound a -> Bound a -> Bound a)
-> RangeMerge a
-> RangeMerge a
-> Maybe (Bound a)
calculateNewBound RangeMerge a -> Maybe (Bound a)
forall a. RangeMerge a -> Maybe (Bound a)
largestLowerBound Bound a -> Bound a -> Bound a
forall a. Ord a => Bound a -> Bound a -> Bound a
minBounds RangeMerge a
one RangeMerge a
two
      newUpperBound :: Maybe (Bound a)
newUpperBound = (RangeMerge a -> Maybe (Bound a))
-> (Bound a -> Bound a -> Bound a)
-> RangeMerge a
-> RangeMerge a
-> Maybe (Bound a)
forall a.
Ord a =>
(RangeMerge a -> Maybe (Bound a))
-> (Bound a -> Bound a -> Bound a)
-> RangeMerge a
-> RangeMerge a
-> Maybe (Bound a)
calculateNewBound RangeMerge a -> Maybe (Bound a)
forall a. RangeMerge a -> Maybe (Bound a)
largestUpperBound Bound a -> Bound a -> Bound a
forall a. Ord a => Bound a -> Bound a -> Bound a
maxBounds RangeMerge a
one RangeMerge a
two

      sortedSpans :: [(Bound a, Bound a)]
sortedSpans = [(Bound a, Bound a)]
-> [(Bound a, Bound a)] -> [(Bound a, Bound a)]
forall a.
Ord a =>
[(Bound a, Bound a)]
-> [(Bound a, Bound a)] -> [(Bound a, Bound a)]
insertionSortSpans (RangeMerge a -> [(Bound a, Bound a)]
forall a. RangeMerge a -> [(Bound a, Bound a)]
spanRanges RangeMerge a
one) (RangeMerge a -> [(Bound a, Bound a)]
forall a. RangeMerge a -> [(Bound a, Bound a)]
spanRanges RangeMerge a
two)

      boundedRM :: RangeMerge a
boundedRM = RM
         { largestLowerBound :: Maybe (Bound a)
largestLowerBound = Maybe (Bound a)
newLowerBound
         , largestUpperBound :: Maybe (Bound a)
largestUpperBound = Maybe (Bound a)
newUpperBound
         , spanRanges :: [(Bound a, Bound a)]
spanRanges = []
         }

      calculateNewBound
         :: (Ord a)
         => (RangeMerge a -> Maybe (Bound a))
         -> (Bound a -> Bound a -> Bound a)
         -> RangeMerge a -> RangeMerge a -> Maybe (Bound a)
      calculateNewBound :: forall a.
Ord a =>
(RangeMerge a -> Maybe (Bound a))
-> (Bound a -> Bound a -> Bound a)
-> RangeMerge a
-> RangeMerge a
-> Maybe (Bound a)
calculateNewBound RangeMerge a -> Maybe (Bound a)
ext Bound a -> Bound a -> Bound a
comp RangeMerge a
one' RangeMerge a
two' = case (RangeMerge a -> Maybe (Bound a)
ext RangeMerge a
one', RangeMerge a -> Maybe (Bound a)
ext RangeMerge a
two') of
         (Just Bound a
x, Just Bound a
y) -> Bound a -> Maybe (Bound a)
forall a. a -> Maybe a
Just (Bound a -> Maybe (Bound a)) -> Bound a -> Maybe (Bound a)
forall a b. (a -> b) -> a -> b
$ Bound a -> Bound a -> Bound a
comp Bound a
x Bound a
y
         (Maybe (Bound a)
z, Maybe (Bound a)
Nothing) -> Maybe (Bound a)
z
         (Maybe (Bound a)
Nothing, Maybe (Bound a)
z) -> Maybe (Bound a)
z

filterLowerBound :: (Ord a) => (Bound a, Bound a) -> RangeMerge a -> RangeMerge a
filterLowerBound :: forall a.
Ord a =>
(Bound a, Bound a) -> RangeMerge a -> RangeMerge a
filterLowerBound (Bound a, Bound a)
_ RangeMerge a
IRM = RangeMerge a
forall a. RangeMerge a
IRM
filterLowerBound (Bound a, Bound a)
a rm :: RangeMerge a
rm@(RM Maybe (Bound a)
Nothing Maybe (Bound a)
_ [(Bound a, Bound a)]
_) = RangeMerge a
rm { spanRanges = a : spanRanges rm }
filterLowerBound s :: (Bound a, Bound a)
s@(Bound a
lower, Bound a
_) rm :: RangeMerge a
rm@(RM (Just Bound a
lowestBound) Maybe (Bound a)
_ [(Bound a, Bound a)]
_) =
   case Bound a -> (Bound a, Bound a) -> Ordering
forall a. Ord a => Bound a -> (Bound a, Bound a) -> Ordering
boundCmp Bound a
lowestBound (Bound a, Bound a)
s of
      Ordering
GT -> RangeMerge a
rm { spanRanges = s : spanRanges rm }
      Ordering
LT -> RangeMerge a
rm
      Ordering
EQ -> RangeMerge a
rm { largestLowerBound = Just $ minBounds lowestBound lower }

filterUpperBound :: (Ord a) => (Bound a, Bound a) -> RangeMerge a -> RangeMerge a
filterUpperBound :: forall a.
Ord a =>
(Bound a, Bound a) -> RangeMerge a -> RangeMerge a
filterUpperBound (Bound a, Bound a)
_ RangeMerge a
IRM = RangeMerge a
forall a. RangeMerge a
IRM
filterUpperBound (Bound a, Bound a)
a rm :: RangeMerge a
rm@(RM Maybe (Bound a)
_ Maybe (Bound a)
Nothing [(Bound a, Bound a)]
_) = RangeMerge a
rm { spanRanges = a : spanRanges rm }
filterUpperBound s :: (Bound a, Bound a)
s@(Bound a
_, Bound a
upper) rm :: RangeMerge a
rm@(RM Maybe (Bound a)
_ (Just Bound a
upperBound) [(Bound a, Bound a)]
_) =
   case Bound a -> (Bound a, Bound a) -> Ordering
forall a. Ord a => Bound a -> (Bound a, Bound a) -> Ordering
boundCmp Bound a
upperBound (Bound a, Bound a)
s of
      Ordering
LT -> RangeMerge a
rm { spanRanges = s : spanRanges rm }
      Ordering
GT -> RangeMerge a
rm
      Ordering
EQ -> RangeMerge a
rm { largestUpperBound = Just $ maxBounds upperBound upper }

invertRM :: (Ord a) => RangeMerge a -> RangeMerge a
invertRM :: forall a. Ord a => RangeMerge a -> RangeMerge a
invertRM RangeMerge a
IRM = RangeMerge a
forall a. RangeMerge a
emptyRangeMerge
invertRM (RM Maybe (Bound a)
Nothing Maybe (Bound a)
Nothing []) = RangeMerge a
forall a. RangeMerge a
IRM
invertRM (RM (Just Bound a
lower) Maybe (Bound a)
Nothing []) = Maybe (Bound a)
-> Maybe (Bound a) -> [(Bound a, Bound a)] -> RangeMerge a
forall a.
Maybe (Bound a)
-> Maybe (Bound a) -> [(Bound a, Bound a)] -> RangeMerge a
RM Maybe (Bound a)
forall a. Maybe a
Nothing (Bound a -> Maybe (Bound a)
forall a. a -> Maybe a
Just (Bound a -> Maybe (Bound a))
-> (Bound a -> Bound a) -> Bound a -> Maybe (Bound a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bound a -> Bound a
forall a. Bound a -> Bound a
invertBound (Bound a -> Maybe (Bound a)) -> Bound a -> Maybe (Bound a)
forall a b. (a -> b) -> a -> b
$ Bound a
lower) []
invertRM (RM Maybe (Bound a)
Nothing (Just Bound a
upper) []) = Maybe (Bound a)
-> Maybe (Bound a) -> [(Bound a, Bound a)] -> RangeMerge a
forall a.
Maybe (Bound a)
-> Maybe (Bound a) -> [(Bound a, Bound a)] -> RangeMerge a
RM (Bound a -> Maybe (Bound a)
forall a. a -> Maybe a
Just (Bound a -> Maybe (Bound a))
-> (Bound a -> Bound a) -> Bound a -> Maybe (Bound a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bound a -> Bound a
forall a. Bound a -> Bound a
invertBound (Bound a -> Maybe (Bound a)) -> Bound a -> Maybe (Bound a)
forall a b. (a -> b) -> a -> b
$ Bound a
upper) Maybe (Bound a)
forall a. Maybe a
Nothing []
invertRM (RM (Just Bound a
lower) (Just Bound a
upper) []) = Maybe (Bound a)
-> Maybe (Bound a) -> [(Bound a, Bound a)] -> RangeMerge a
forall a.
Maybe (Bound a)
-> Maybe (Bound a) -> [(Bound a, Bound a)] -> RangeMerge a
RM Maybe (Bound a)
forall a. Maybe a
Nothing Maybe (Bound a)
forall a. Maybe a
Nothing [(Bound a -> Bound a
forall a. Bound a -> Bound a
invertBound Bound a
upper, Bound a -> Bound a
forall a. Bound a -> Bound a
invertBound Bound a
lower)]
invertRM (RM Maybe (Bound a)
lb Maybe (Bound a)
ub spans :: [(Bound a, Bound a)]
spans@((Bound a, Bound a)
firstSpan : [(Bound a, Bound a)]
_)) = RM
   { largestUpperBound :: Maybe (Bound a)
largestUpperBound = Maybe (Bound a)
newUpperBound
   , largestLowerBound :: Maybe (Bound a)
largestLowerBound = Maybe (Bound a)
newLowerBound
   , spanRanges :: [(Bound a, Bound a)]
spanRanges = [(Bound a, Bound a)]
upperSpan [(Bound a, Bound a)]
-> [(Bound a, Bound a)] -> [(Bound a, Bound a)]
forall a. [a] -> [a] -> [a]
++ [(Bound a, Bound a)]
betweenSpans [(Bound a, Bound a)]
-> [(Bound a, Bound a)] -> [(Bound a, Bound a)]
forall a. [a] -> [a] -> [a]
++ [(Bound a, Bound a)]
lowerSpan
   }
   where
      newUpperValue :: Bound a
newUpperValue = Bound a -> Bound a
forall a. Bound a -> Bound a
invertBound (Bound a -> Bound a)
-> ((Bound a, Bound a) -> Bound a) -> (Bound a, Bound a) -> Bound a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bound a, Bound a) -> Bound a
forall a b. (a, b) -> a
fst ((Bound a, Bound a) -> Bound a) -> (Bound a, Bound a) -> Bound a
forall a b. (a -> b) -> a -> b
$ (Bound a, Bound a)
firstSpan
      newLowerValue :: Bound a
newLowerValue = Bound a -> Bound a
forall a. Bound a -> Bound a
invertBound (Bound a -> Bound a)
-> ([(Bound a, Bound a)] -> Bound a)
-> [(Bound a, Bound a)]
-> Bound a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bound a, Bound a) -> Bound a
forall a b. (a, b) -> b
snd ((Bound a, Bound a) -> Bound a)
-> ([(Bound a, Bound a)] -> (Bound a, Bound a))
-> [(Bound a, Bound a)]
-> Bound a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Bound a, Bound a)] -> (Bound a, Bound a)
forall a. HasCallStack => [a] -> a
last ([(Bound a, Bound a)] -> Bound a)
-> [(Bound a, Bound a)] -> Bound a
forall a b. (a -> b) -> a -> b
$ [(Bound a, Bound a)]
spans

      newUpperBound :: Maybe (Bound a)
newUpperBound = case Maybe (Bound a)
ub of
         Just Bound a
_ -> Maybe (Bound a)
forall a. Maybe a
Nothing
         Maybe (Bound a)
Nothing -> Bound a -> Maybe (Bound a)
forall a. a -> Maybe a
Just Bound a
newUpperValue

      newLowerBound :: Maybe (Bound a)
newLowerBound = case Maybe (Bound a)
lb of
         Just Bound a
_ -> Maybe (Bound a)
forall a. Maybe a
Nothing
         Maybe (Bound a)
Nothing -> Bound a -> Maybe (Bound a)
forall a. a -> Maybe a
Just Bound a
newLowerValue

      upperSpan :: [(Bound a, Bound a)]
upperSpan = case Maybe (Bound a)
ub of
         Maybe (Bound a)
Nothing -> []
         Just Bound a
upper -> [(Bound a -> Bound a
forall a. Bound a -> Bound a
invertBound Bound a
upper, Bound a
newUpperValue)]
      lowerSpan :: [(Bound a, Bound a)]
lowerSpan = case Maybe (Bound a)
lb of
         Maybe (Bound a)
Nothing -> []
         Just Bound a
lower -> [(Bound a
newLowerValue, Bound a -> Bound a
forall a. Bound a -> Bound a
invertBound Bound a
lower)]

      betweenSpans :: [(Bound a, Bound a)]
betweenSpans = [(Bound a, Bound a)] -> [(Bound a, Bound a)]
forall a. [(Bound a, Bound a)] -> [(Bound a, Bound a)]
invertSpans [(Bound a, Bound a)]
spans

joinRM :: (Eq a, Enum a) => RangeMerge a -> RangeMerge a
joinRM :: forall a. (Eq a, Enum a) => RangeMerge a -> RangeMerge a
joinRM o :: RangeMerge a
o@(RM Maybe (Bound a)
_ Maybe (Bound a)
_ []) = RangeMerge a
o
joinRM RangeMerge a
rm = Maybe (Bound a)
-> Maybe (Bound a) -> [(Bound a, Bound a)] -> RangeMerge a
forall a.
Maybe (Bound a)
-> Maybe (Bound a) -> [(Bound a, Bound a)] -> RangeMerge a
RM Maybe (Bound a)
lower Maybe (Bound a)
higher [(Bound a, Bound a)]
spansAfterHigher
   where
      joinedSpans :: [(Bound a, Bound a)]
joinedSpans = [(Bound a, Bound a)] -> [(Bound a, Bound a)]
forall a.
(Eq a, Enum a) =>
[(Bound a, Bound a)] -> [(Bound a, Bound a)]
joinSpans ([(Bound a, Bound a)] -> [(Bound a, Bound a)])
-> (RangeMerge a -> [(Bound a, Bound a)])
-> RangeMerge a
-> [(Bound a, Bound a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RangeMerge a -> [(Bound a, Bound a)]
forall a. RangeMerge a -> [(Bound a, Bound a)]
spanRanges (RangeMerge a -> [(Bound a, Bound a)])
-> RangeMerge a -> [(Bound a, Bound a)]
forall a b. (a -> b) -> a -> b
$ RangeMerge a
rm

      (Maybe (Bound a)
lower, [(Bound a, Bound a)]
spansAfterLower) =
         case (RangeMerge a -> Maybe (Bound a)
forall a. RangeMerge a -> Maybe (Bound a)
largestLowerBound RangeMerge a
rm, [(Bound a, Bound a)] -> [(Bound a, Bound a)]
forall a. [a] -> [a]
reverse [(Bound a, Bound a)]
joinedSpans) of
            o :: (Maybe (Bound a), [(Bound a, Bound a)])
o@(Just Bound a
l, ((Bound a
xl, Bound a
xh) : [(Bound a, Bound a)]
xs)) ->
               if (a -> a
forall a. Enum a => a -> a
succ (a -> a) -> (Bound a -> a) -> Bound a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bound a -> a
forall a. Enum a => Bound a -> a
highestValueInUpperBound (Bound a -> a) -> Bound a -> a
forall a b. (a -> b) -> a -> b
$ Bound a
xh) a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== Bound a -> a
forall a. Enum a => Bound a -> a
lowestValueInLowerBound Bound a
l
                  then (Bound a -> Maybe (Bound a)
forall a. a -> Maybe a
Just Bound a
xl, [(Bound a, Bound a)] -> [(Bound a, Bound a)]
forall a. [a] -> [a]
reverse [(Bound a, Bound a)]
xs)
                  else (Maybe (Bound a), [(Bound a, Bound a)])
o
            (Maybe (Bound a), [(Bound a, Bound a)])
x -> (Maybe (Bound a), [(Bound a, Bound a)])
x

      (Maybe (Bound a)
higher, [(Bound a, Bound a)]
spansAfterHigher) =
         case (RangeMerge a -> Maybe (Bound a)
forall a. RangeMerge a -> Maybe (Bound a)
largestUpperBound RangeMerge a
rm, [(Bound a, Bound a)]
spansAfterLower) of
            o :: (Maybe (Bound a), [(Bound a, Bound a)])
o@(Just Bound a
h, ((Bound a
xl, Bound a
xh) : [(Bound a, Bound a)]
xs)) ->
               if Bound a -> a
forall a. Enum a => Bound a -> a
highestValueInUpperBound Bound a
h a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== (a -> a
forall a. Enum a => a -> a
pred (a -> a) -> (Bound a -> a) -> Bound a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bound a -> a
forall a. Enum a => Bound a -> a
lowestValueInLowerBound (Bound a -> a) -> Bound a -> a
forall a b. (a -> b) -> a -> b
$ Bound a
xl)
                  then (Bound a -> Maybe (Bound a)
forall a. a -> Maybe a
Just Bound a
xh, [(Bound a, Bound a)]
xs)
                  else (Maybe (Bound a), [(Bound a, Bound a)])
o
            (Maybe (Bound a), [(Bound a, Bound a)])
x -> (Maybe (Bound a), [(Bound a, Bound a)])
x

updateBound :: Bound a -> a -> Bound a
updateBound :: forall a. Bound a -> a -> Bound a
updateBound (Bound a
_ BoundType
aType) a
b = a -> BoundType -> Bound a
forall a. a -> BoundType -> Bound a
Bound a
b BoundType
aType

unmergeRM :: RangeMerge a -> [RangeMerge a]
unmergeRM :: forall a. RangeMerge a -> [RangeMerge a]
unmergeRM RangeMerge a
IRM = [RangeMerge a
forall a. RangeMerge a
IRM]
unmergeRM (RM Maybe (Bound a)
lower Maybe (Bound a)
upper [(Bound a, Bound a)]
spans) =
   ([RangeMerge a]
-> (Bound a -> [RangeMerge a]) -> Maybe (Bound a) -> [RangeMerge a]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Bound a
x -> [Maybe (Bound a)
-> Maybe (Bound a) -> [(Bound a, Bound a)] -> RangeMerge a
forall a.
Maybe (Bound a)
-> Maybe (Bound a) -> [(Bound a, Bound a)] -> RangeMerge a
RM Maybe (Bound a)
forall a. Maybe a
Nothing (Bound a -> Maybe (Bound a)
forall a. a -> Maybe a
Just Bound a
x) []]) Maybe (Bound a)
upper) [RangeMerge a] -> [RangeMerge a] -> [RangeMerge a]
forall a. [a] -> [a] -> [a]
++
   ((Bound a, Bound a) -> RangeMerge a)
-> [(Bound a, Bound a)] -> [RangeMerge a]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Bound a, Bound a)
x -> Maybe (Bound a)
-> Maybe (Bound a) -> [(Bound a, Bound a)] -> RangeMerge a
forall a.
Maybe (Bound a)
-> Maybe (Bound a) -> [(Bound a, Bound a)] -> RangeMerge a
RM Maybe (Bound a)
forall a. Maybe a
Nothing Maybe (Bound a)
forall a. Maybe a
Nothing [(Bound a, Bound a)
x]) [(Bound a, Bound a)]
spans [RangeMerge a] -> [RangeMerge a] -> [RangeMerge a]
forall a. [a] -> [a] -> [a]
++
   ([RangeMerge a]
-> (Bound a -> [RangeMerge a]) -> Maybe (Bound a) -> [RangeMerge a]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Bound a
x -> [Maybe (Bound a)
-> Maybe (Bound a) -> [(Bound a, Bound a)] -> RangeMerge a
forall a.
Maybe (Bound a)
-> Maybe (Bound a) -> [(Bound a, Bound a)] -> RangeMerge a
RM (Bound a -> Maybe (Bound a)
forall a. a -> Maybe a
Just Bound a
x) Maybe (Bound a)
forall a. Maybe a
Nothing []]) Maybe (Bound a)
lower)

-- | Pre-build a 'Data.Map'-backed lookup structure from a canonical span list,
-- returning an O(log n) membership predicate. Build the map once; apply the
-- returned function for every subsequent query.
-- Precondition: spans are sorted and non-overlapping (canonical form).
buildSpanQuery :: Ord a
               => Maybe (Bound a)       -- ^ largest lower bound (semi-infinite tail)
               -> Maybe (Bound a)       -- ^ largest upper bound (semi-infinite tail)
               -> [(Bound a, Bound a)]  -- ^ canonical finite spans
               -> (a -> Bool)
buildSpanQuery :: forall a.
Ord a =>
Maybe (Bound a)
-> Maybe (Bound a) -> [(Bound a, Bound a)] -> a -> Bool
buildSpanQuery Maybe (Bound a)
lb Maybe (Bound a)
ub [(Bound a, Bound a)]
spans =
  let !m :: Map (Bound a) (Bound a)
m = [(Bound a, Bound a)] -> Map (Bound a) (Bound a)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Bound a, Bound a)]
spans
  in \a
val ->
       let v :: Bound a
v = a -> BoundType -> Bound a
forall a. a -> BoundType -> Bound a
Bound a
val BoundType
Inclusive
       in Bool -> (Bound a -> Bool) -> Maybe (Bound a) -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (\Bound a
b -> 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 Bound a
v Bound a
b) Maybe (Bound a)
ub
          Bool -> Bool -> Bool
|| Bool -> (Bound a -> Bool) -> Maybe (Bound a) -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (\Bound a
b -> 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 Bound a
v Bound a
b) Maybe (Bound a)
lb
          Bool -> Bool -> Bool
|| case Bound a -> Map (Bound a) (Bound a) -> Maybe (Bound a, Bound a)
forall k v. Ord k => k -> Map k v -> Maybe (k, v)
Map.lookupLE Bound a
v Map (Bound a) (Bound a)
m of
               Maybe (Bound a, Bound a)
Nothing       -> Bool
False
               Just (Bound a
lo, Bound a
hi) -> 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 Bound a
v (Bound a
lo, Bound a
hi)