-- This module contains every function that purely performs operations on spans.
module Data.Range.Typed.Spans where

import Data.Range.Typed.Data
import Data.Range.Typed.Util

-- Assume that both inputs are sorted spans
insertionSortSpans :: (Ord a) => [(Bound a, Bound a)] -> [(Bound a, Bound a)] -> [(Bound a, Bound a)]
insertionSortSpans :: forall a.
Ord a =>
[(Bound a, Bound a)]
-> [(Bound a, Bound a)] -> [(Bound a, Bound a)]
insertionSortSpans = ((Bound a, Bound a) -> (Bound a, Bound a) -> Ordering)
-> [(Bound a, Bound a)]
-> [(Bound a, Bound a)]
-> [(Bound a, Bound a)]
forall a. (a -> a -> Ordering) -> [a] -> [a] -> [a]
insertionSort (\(Bound a, Bound a)
a (Bound a, Bound a)
b -> Bound a -> Bound a -> Ordering
forall a. Ord a => Bound a -> Bound a -> Ordering
compareLower ((Bound a, Bound a) -> Bound a
forall a b. (a, b) -> a
fst (Bound a, Bound a)
a) ((Bound a, Bound a) -> Bound a
forall a b. (a, b) -> a
fst (Bound a, Bound a)
b))

spanCmp :: (Ord a) => (Bound a, Bound a) -> (Bound a, Bound a) -> Ordering
spanCmp :: forall a.
Ord a =>
(Bound a, Bound a) -> (Bound a, Bound a) -> Ordering
spanCmp x :: (Bound a, Bound a)
x@(Bound a
_, Bound a
xHighValue) y :: (Bound a, Bound a)
y@(Bound a
yLowValue, Bound a
_) =
  if (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, Bound a)
x (Bound a, Bound a)
y OverlapType -> OverlapType -> Bool
forall a. Eq a => a -> a -> Bool
/= OverlapType
Separate
    then Ordering
EQ
    else if Bound a -> a
forall a. Bound a -> a
boundValue Bound a
xHighValue a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= Bound a -> a
forall a. Bound a -> a
boundValue Bound a
yLowValue then Ordering
LT else Ordering
GT

intersectSpans :: (Ord a) => [(Bound a, Bound a)] -> [(Bound a, Bound a)] -> [(Bound a, Bound a)]
intersectSpans :: forall a.
Ord a =>
[(Bound a, Bound a)]
-> [(Bound a, Bound a)] -> [(Bound a, Bound a)]
intersectSpans (x :: (Bound a, Bound a)
x@(Bound a
xlow, Bound a
xup) : [(Bound a, Bound a)]
xs) (y :: (Bound a, Bound a)
y@(Bound a
ylow, Bound a
yup) : [(Bound a, Bound a)]
ys) =
  case (Bound a, Bound a) -> (Bound a, Bound a) -> Ordering
forall a.
Ord a =>
(Bound a, Bound a) -> (Bound a, Bound a) -> Ordering
spanCmp (Bound a, Bound a)
x (Bound a, Bound a)
y of
    Ordering
EQ -> if Bool -> Bool
not ((Bound a, Bound a) -> Bool
forall a. Eq a => (Bound a, Bound a) -> Bool
isEmptySpan (Bound a, Bound a)
intersectedSpan) then (Bound a, Bound a)
intersectedSpan (Bound a, Bound a) -> [(Bound a, Bound a)] -> [(Bound a, Bound a)]
forall a. a -> [a] -> [a]
: [(Bound a, Bound a)]
equalNext else [(Bound a, Bound a)]
equalNext
    Ordering
LT -> [(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 [(Bound a, Bound a)]
xs ((Bound a, Bound a)
y (Bound a, Bound a) -> [(Bound a, Bound a)] -> [(Bound a, Bound a)]
forall a. a -> [a] -> [a]
: [(Bound a, Bound a)]
ys)
    Ordering
GT -> [(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 ((Bound a, Bound a)
x (Bound a, Bound a) -> [(Bound a, Bound a)] -> [(Bound a, Bound a)]
forall a. a -> [a] -> [a]
: [(Bound a, Bound a)]
xs) [(Bound a, Bound a)]
ys
  where
    intersectedSpan :: (Bound a, Bound a)
intersectedSpan = (Bound a -> Bound a -> Bound a
forall a. Ord a => Bound a -> Bound a -> Bound a
maxBoundsIntersection Bound a
xlow Bound a
ylow, Bound a -> Bound a -> Bound a
forall a. Ord a => Bound a -> Bound a -> Bound a
minBoundsIntersection Bound a
xup Bound a
yup)

    lessThanNext :: [(Bound a, Bound a)]
lessThanNext = [(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 [(Bound a, Bound a)]
xs ((Bound a, Bound a)
y (Bound a, Bound a) -> [(Bound a, Bound a)] -> [(Bound a, Bound a)]
forall a. a -> [a] -> [a]
: [(Bound a, Bound a)]
ys)
    greaterThanNext :: [(Bound a, Bound a)]
greaterThanNext = [(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 ((Bound a, Bound a)
x (Bound a, Bound a) -> [(Bound a, Bound a)] -> [(Bound a, Bound a)]
forall a. a -> [a] -> [a]
: [(Bound a, Bound a)]
xs) [(Bound a, Bound a)]
ys
    equalNext :: [(Bound a, Bound a)]
equalNext = if Bound a -> a
forall a. Bound a -> a
boundValue Bound a
xup a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< Bound a -> a
forall a. Bound a -> a
boundValue Bound a
yup then [(Bound a, Bound a)]
lessThanNext else [(Bound a, Bound a)]
greaterThanNext
intersectSpans [(Bound a, Bound a)]
_ [(Bound a, Bound a)]
_ = []

-- Assume that you are given a sorted list of spans
joinSpans :: (Eq a, Enum a) => [(Bound a, Bound a)] -> [(Bound a, Bound a)]
joinSpans :: forall a.
(Eq a, Enum a) =>
[(Bound a, Bound a)] -> [(Bound a, Bound a)]
joinSpans (f :: (Bound a, Bound a)
f@(Bound a
a, Bound a
b) : s :: (Bound a, Bound a)
s@(Bound a
x, Bound a
y) : [(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
b) a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== Bound a -> a
forall a. Enum a => Bound a -> a
lowestValueInLowerBound Bound a
x
    then [(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
$ (Bound a
a, Bound a
y) (Bound a, Bound a) -> [(Bound a, Bound a)] -> [(Bound a, Bound a)]
forall a. a -> [a] -> [a]
: [(Bound a, Bound a)]
xs
    else (Bound a, Bound a)
f (Bound a, Bound a) -> [(Bound a, Bound a)] -> [(Bound a, Bound a)]
forall a. a -> [a] -> [a]
: [(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)
s (Bound a, Bound a) -> [(Bound a, Bound a)] -> [(Bound a, Bound a)]
forall a. a -> [a] -> [a]
: [(Bound a, Bound a)]
xs)
joinSpans [(Bound a, Bound a)]
xs = [(Bound a, Bound a)]
xs

-- Assume that you are given a sorted list of spans
unionSpans :: (Ord a) => [(Bound a, Bound a)] -> [(Bound a, Bound a)]
unionSpans :: forall a. Ord a => [(Bound a, Bound a)] -> [(Bound a, Bound a)]
unionSpans (f :: (Bound a, Bound a)
f@(Bound a
a, Bound a
b) : s :: (Bound a, Bound a)
s@(Bound a
_, Bound a
y) : [(Bound a, Bound a)]
xs) =
  if (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, Bound a)
f (Bound a, Bound a)
s OverlapType -> OverlapType -> Bool
forall a. Eq a => a -> a -> Bool
/= OverlapType
Separate
    then [(Bound a, Bound a)] -> [(Bound a, Bound a)]
forall a. Ord a => [(Bound a, Bound a)] -> [(Bound a, Bound a)]
unionSpans ((Bound a
a, Bound a -> Bound a -> Bound a
forall a. Ord a => Bound a -> Bound a -> Bound a
maxBounds Bound a
b Bound a
y) (Bound a, Bound a) -> [(Bound a, Bound a)] -> [(Bound a, Bound a)]
forall a. a -> [a] -> [a]
: [(Bound a, Bound a)]
xs)
    else (Bound a, Bound a)
f (Bound a, Bound a) -> [(Bound a, Bound a)] -> [(Bound a, Bound a)]
forall a. a -> [a] -> [a]
: [(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)
s (Bound a, Bound a) -> [(Bound a, Bound a)] -> [(Bound a, Bound a)]
forall a. a -> [a] -> [a]
: [(Bound a, Bound a)]
xs)
unionSpans [(Bound a, Bound a)]
xs = [(Bound a, Bound a)]
xs

-- Assume that you are given a sorted and joined list of spans
invertSpans :: [(Bound a, Bound a)] -> [(Bound a, Bound a)]
invertSpans :: forall a. [(Bound a, Bound a)] -> [(Bound a, Bound a)]
invertSpans ((Bound a
_, Bound a
x) : s :: (Bound a, Bound a)
s@(Bound a
y, Bound a
_) : [(Bound a, Bound a)]
xs) = (Bound a -> Bound a
forall a. Bound a -> Bound a
invertBound Bound a
x, Bound a -> Bound a
forall a. Bound a -> Bound a
invertBound Bound a
y) (Bound a, Bound a) -> [(Bound a, Bound a)] -> [(Bound a, Bound a)]
forall a. a -> [a] -> [a]
: [(Bound a, Bound a)] -> [(Bound a, Bound a)]
forall a. [(Bound a, Bound a)] -> [(Bound a, Bound a)]
invertSpans ((Bound a, Bound a)
s (Bound a, Bound a) -> [(Bound a, Bound a)] -> [(Bound a, Bound a)]
forall a. a -> [a] -> [a]
: [(Bound a, Bound a)]
xs)
invertSpans [(Bound a, Bound a)]
_ = []