{-# LANGUAGE LambdaCase #-}

module Data.Range.Typed.RangeInternal where

import Control.Monad (guard)
import Data.Functor (($>))
import Data.Maybe (catMaybes, mapMaybe)
import Data.Range.Typed.Data
import Data.Range.Typed.Spans
import Data.Range.Typed.Util

{-
 - 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
  | ERM
  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) => AnyRangeFor c a -> RangeMerge a
storeRange :: forall a (c :: (* -> *) -> Constraint).
Ord a =>
AnyRangeFor c a -> RangeMerge a
storeRange (AnyRangeFor Range hasLowerBound hasUpperBound a
range) =
  case Range hasLowerBound hasUpperBound a
range of
    Range hasLowerBound hasUpperBound a
InfiniteRange -> RangeMerge a
forall a. RangeMerge a
IRM
    Range hasLowerBound hasUpperBound a
EmptyRange -> RangeMerge a
forall a. RangeMerge a
ERM
    LowerBoundRange Bound a
lower -> RangeMerge a
forall a. RangeMerge a
emptyRangeMerge {largestLowerBound = Just lower}
    UpperBoundRange Bound a
upper -> RangeMerge a
forall a. RangeMerge a
emptyRangeMerge {largestUpperBound = Just upper}
    SpanRange Bound a
x Bound a
y
      | Bound a -> a
forall a. Bound a -> a
boundValue Bound a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== Bound a -> a
forall a. Bound a -> a
boundValue Bound a
y Bool -> Bool -> Bool
&& Bound a -> Bound a -> OverlapType
forall a b. Bound a -> Bound b -> OverlapType
pointJoinType Bound a
x Bound a
y OverlapType -> OverlapType -> Bool
forall a. Eq a => a -> a -> Bool
== OverlapType
Separate -> RangeMerge a
forall a. RangeMerge a
emptyRangeMerge
      | Bool
otherwise -> RangeMerge a
forall a. RangeMerge a
emptyRangeMerge {spanRanges = [(minBounds x y, maxBounds x y)]}
    SingletonRange a
x -> RangeMerge a
forall a. RangeMerge a
emptyRangeMerge {spanRanges = [(InclusiveBound x, InclusiveBound x)]}

storeRanges :: (Ord a) => RangeMerge a -> [AnyRangeFor c a] -> RangeMerge a
storeRanges :: forall a (c :: (* -> *) -> Constraint).
Ord a =>
RangeMerge a -> [AnyRangeFor c a] -> RangeMerge a
storeRanges = (AnyRangeFor c a -> RangeMerge a -> RangeMerge a)
-> RangeMerge a -> [AnyRangeFor c 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 -> RangeMerge a -> RangeMerge a)
-> (AnyRangeFor c a -> RangeMerge a)
-> AnyRangeFor c a
-> RangeMerge a
-> RangeMerge a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnyRangeFor c a -> RangeMerge a
forall a (c :: (* -> *) -> Constraint).
Ord a =>
AnyRangeFor c a -> RangeMerge a
storeRange)

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

exportRangeMerge :: (Eq a) => RangeMerge a -> [AnyRange a]
exportRangeMerge :: forall a. Eq a => RangeMerge a -> [AnyRange a]
exportRangeMerge =
  \case
    RangeMerge a
IRM -> [Range 'False 'False a -> AnyRange a
forall (c :: (* -> *) -> Constraint) a (hasLowerBound :: Bool)
       (hasUpperBound :: Bool).
c (Range hasLowerBound hasUpperBound) =>
Range hasLowerBound hasUpperBound a -> AnyRangeFor c a
AnyRangeFor Range 'False 'False a
forall a. Range 'False 'False a
InfiniteRange]
    RangeMerge a
ERM -> [Range 'False 'False a -> AnyRange a
forall (c :: (* -> *) -> Constraint) a (hasLowerBound :: Bool)
       (hasUpperBound :: Bool).
c (Range hasLowerBound hasUpperBound) =>
Range hasLowerBound hasUpperBound a -> AnyRangeFor c a
AnyRangeFor Range 'False 'False a
forall a. Range 'False 'False a
EmptyRange]
    RM Maybe (Bound a)
lb Maybe (Bound a)
up [(Bound a, Bound a)]
spans ->
      let putLowerBound :: Maybe (Bound a) -> [AnyRange a]
          putLowerBound :: forall a. Maybe (Bound a) -> [AnyRange a]
putLowerBound = [AnyRange a]
-> (Bound a -> [AnyRange a]) -> Maybe (Bound a) -> [AnyRange a]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (AnyRange a -> [AnyRange a]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyRange a -> [AnyRange a])
-> (Bound a -> AnyRange a) -> Bound a -> [AnyRange a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Range 'True 'False a -> AnyRange a
forall (c :: (* -> *) -> Constraint) a (hasLowerBound :: Bool)
       (hasUpperBound :: Bool).
c (Range hasLowerBound hasUpperBound) =>
Range hasLowerBound hasUpperBound a -> AnyRangeFor c a
AnyRangeFor (Range 'True 'False a -> AnyRange a)
-> (Bound a -> Range 'True 'False a) -> Bound a -> AnyRange a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bound a -> Range 'True 'False a
forall a. Bound a -> Range 'True 'False a
LowerBoundRange)
          putUpperBound :: Maybe (Bound a) -> [AnyRange a]
          putUpperBound :: forall a. Maybe (Bound a) -> [AnyRange a]
putUpperBound = [AnyRange a]
-> (Bound a -> [AnyRange a]) -> Maybe (Bound a) -> [AnyRange a]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (AnyRange a -> [AnyRange a]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyRange a -> [AnyRange a])
-> (Bound a -> AnyRange a) -> Bound a -> [AnyRange a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Range 'False 'True a -> AnyRange a
forall (c :: (* -> *) -> Constraint) a (hasLowerBound :: Bool)
       (hasUpperBound :: Bool).
c (Range hasLowerBound hasUpperBound) =>
Range hasLowerBound hasUpperBound a -> AnyRangeFor c a
AnyRangeFor (Range 'False 'True a -> AnyRange a)
-> (Bound a -> Range 'False 'True a) -> Bound a -> AnyRange a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bound a -> Range 'False 'True a
forall a. Bound a -> Range 'False 'True a
UpperBoundRange)
          putSpans :: [(Bound a, Bound a)] -> [AnyRange a]
putSpans = ((Bound a, Bound a) -> AnyRange a)
-> [(Bound a, Bound a)] -> [AnyRange a]
forall a b. (a -> b) -> [a] -> [b]
map (Bound a, Bound a) -> AnyRange a
forall {c :: (* -> *) -> Constraint} {a}.
(c (Range 'True 'True), Eq a) =>
(Bound a, Bound a) -> AnyRangeFor c a
simplifySpan
          simplifySpan :: (Bound a, Bound a) -> AnyRangeFor c a
simplifySpan (Bound a
x, Bound a
y) =
            if Bound a
x Bound a -> Bound a -> Bool
forall a. Eq a => a -> a -> Bool
== Bound a
y Bool -> Bool -> Bool
&& Bound a -> Bound a -> OverlapType
forall a b. Bound a -> Bound b -> OverlapType
pointJoinType Bound a
x Bound a
y OverlapType -> OverlapType -> Bool
forall a. Eq a => a -> a -> Bool
/= OverlapType
Separate
              then Range 'True 'True a -> AnyRangeFor c a
forall (c :: (* -> *) -> Constraint) a (hasLowerBound :: Bool)
       (hasUpperBound :: Bool).
c (Range hasLowerBound hasUpperBound) =>
Range hasLowerBound hasUpperBound a -> AnyRangeFor c a
AnyRangeFor (Range 'True 'True a -> AnyRangeFor c a)
-> Range 'True 'True a -> AnyRangeFor c a
forall a b. (a -> b) -> a -> b
$ a -> Range 'True 'True a
forall a. a -> Range 'True 'True a
SingletonRange (a -> Range 'True 'True a) -> a -> Range 'True 'True a
forall a b. (a -> b) -> a -> b
$ Bound a -> a
forall a. Bound a -> a
boundValue Bound a
x
              else Range 'True 'True a -> AnyRangeFor c a
forall (c :: (* -> *) -> Constraint) a (hasLowerBound :: Bool)
       (hasUpperBound :: Bool).
c (Range hasLowerBound hasUpperBound) =>
Range hasLowerBound hasUpperBound a -> AnyRangeFor c a
AnyRangeFor (Range 'True 'True a -> AnyRangeFor c a)
-> Range 'True 'True a -> AnyRangeFor c a
forall a b. (a -> b) -> a -> b
$ Bound a -> Bound a -> Range 'True 'True a
forall a. Bound a -> Bound a -> Range 'True 'True a
SpanRange Bound a
x Bound a
y
       in Maybe (Bound a) -> [AnyRange a]
forall a. Maybe (Bound a) -> [AnyRange a]
putUpperBound Maybe (Bound a)
up [AnyRange a] -> [AnyRange a] -> [AnyRange a]
forall a. Semigroup a => a -> a -> a
<> [(Bound a, Bound a)] -> [AnyRange a]
putSpans [(Bound a, Bound a)]
spans [AnyRange a] -> [AnyRange a] -> [AnyRange a]
forall a. Semigroup a => a -> a -> a
<> Maybe (Bound a) -> [AnyRange a]
forall a. Maybe (Bound a) -> [AnyRange a]
putLowerBound Maybe (Bound a)
lb

{-# RULES "load/export" [1] forall x. loadRanges (exportRangeMerge x) = x #-}

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 = ((Bound a, Bound a) -> Maybe (Bound a, Bound a))
-> [(Bound a, Bound a)] -> [(Bound a, Bound a)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (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 Bound a
lower (Bound a
x, Bound a
y) = do
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bound a -> a
forall a. Bound a -> a
boundValue Bound a
lower a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= Bound a -> a
forall a. Bound a -> a
boundValue Bound a
y)
  (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 Bound a
upper (Bound a
x, Bound a
y) = do
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bound a -> a
forall a. Bound a -> a
boundValue Bound a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= Bound a -> a
forall a. Bound a -> a
boundValue Bound a
upper)
  (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
ERM RangeMerge a
_ = RangeMerge a
forall a. RangeMerge a
ERM
intersectionRangeMerges RangeMerge a
_ RangeMerge a
ERM = RangeMerge a
forall a. RangeMerge a
ERM
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
ERM RangeMerge a
one = RangeMerge a
one
unionRangeMerges RangeMerge a
one RangeMerge a
ERM = RangeMerge a
one
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 = ((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
filterOne {spanRanges = []}) (RangeMerge a -> [(Bound a, Bound a)]
forall a. RangeMerge a -> [(Bound a, Bound a)]
spanRanges RangeMerge a
filterOne)

    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
ERM = RangeMerge a
forall a. RangeMerge a
ERM
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
ERM = RangeMerge a
forall a. RangeMerge a
ERM
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
ERM = RangeMerge a
forall a. RangeMerge a
IRM
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 RangeMerge a
rm =
  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. Semigroup a => a -> a -> a
<> [(Bound a, Bound a)]
betweenSpans [(Bound a, Bound a)]
-> [(Bound a, Bound a)] -> [(Bound a, Bound a)]
forall a. Semigroup a => a -> a -> a
<> [(Bound a, Bound a)]
lowerSpan
    }
  where
    newLowerValue :: Bound a
newLowerValue = Bound a -> Bound a
forall a. Bound a -> Bound a
invertBound (Bound a -> Bound a) -> Bound a -> Bound a
forall a b. (a -> b) -> a -> b
$ (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
forall a b. (a -> b) -> a -> b
$ [(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)] -> (Bound a, Bound a)
forall a b. (a -> b) -> a -> b
$ RangeMerge a -> [(Bound a, Bound a)]
forall a. RangeMerge a -> [(Bound a, Bound a)]
spanRanges RangeMerge a
rm
    newUpperValue :: Bound a
newUpperValue = Bound a -> Bound a
forall a. Bound a -> Bound a
invertBound (Bound a -> Bound a) -> Bound a -> Bound a
forall a b. (a -> b) -> a -> b
$ (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)] -> (Bound a, Bound a)
forall a. HasCallStack => [a] -> a
head ([(Bound a, Bound a)] -> (Bound a, Bound a))
-> [(Bound a, Bound a)] -> (Bound a, Bound a)
forall a b. (a -> b) -> a -> b
$ RangeMerge a -> [(Bound a, Bound a)]
forall a. RangeMerge a -> [(Bound a, Bound a)]
spanRanges RangeMerge a
rm

    newUpperBound :: Maybe (Bound a)
newUpperBound = case RangeMerge a -> Maybe (Bound a)
forall a. RangeMerge a -> Maybe (Bound a)
largestUpperBound RangeMerge a
rm 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 RangeMerge a -> Maybe (Bound a)
forall a. RangeMerge a -> Maybe (Bound a)
largestLowerBound RangeMerge a
rm 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 RangeMerge a -> Maybe (Bound a)
forall a. RangeMerge a -> Maybe (Bound a)
largestUpperBound RangeMerge a
rm 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 RangeMerge a -> Maybe (Bound a)
forall a. RangeMerge a -> Maybe (Bound a)
largestLowerBound RangeMerge a
rm 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)] -> [(Bound a, Bound a)])
-> [(Bound a, Bound a)] -> [(Bound a, Bound a)]
forall a b. (a -> b) -> a -> b
$ RangeMerge a -> [(Bound a, Bound a)]
forall a. RangeMerge a -> [(Bound a, Bound a)]
spanRanges RangeMerge a
rm

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)])
-> [(Bound a, Bound a)] -> [(Bound a, Bound a)]
forall a b. (a -> b) -> a -> b
$ RangeMerge a -> [(Bound a, Bound a)]
forall a. RangeMerge a -> [(Bound a, Bound a)]
spanRanges 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 (Bound a -> a
forall a. Enum a => Bound a -> a
highestValueInUpperBound 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 (Bound a -> a
forall a. Enum a => Bound a -> a
lowestValueInLowerBound 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 -> a -> Bound a
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
($>)

unmergeRM :: RangeMerge a -> [RangeMerge a]
unmergeRM :: forall a. RangeMerge a -> [RangeMerge a]
unmergeRM RangeMerge a
ERM = [RangeMerge a
forall a. RangeMerge a
ERM]
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. Semigroup 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. Semigroup 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