{-# LANGUAGE Safe #-}

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

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

-- 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 BoundType
_) y :: (Bound a, Bound a)
y@(Bound a
yLowValue BoundType
_, 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 a
xHighValue a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= 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, xup :: Bound a
xup@(Bound a
xUpValue BoundType
_)) : [(Bound a, Bound a)]
xs) (y :: (Bound a, Bound a)
y@(Bound a
ylow, yup :: Bound a
yup@(Bound a
yUpValue BoundType
_)) : [(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 (Bool -> Bool)
-> ((Bound a, Bound a) -> Bool) -> (Bound a, Bound a) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bound a, Bound a) -> Bool
forall a. Eq a => (Bound a, Bound a) -> Bool
isEmptySpan ((Bound a, Bound a) -> Bool) -> (Bound a, Bound a) -> Bool
forall a b. (a -> b) -> a -> b
$ (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 a
xUpValue a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
yUpValue 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)]
_ = []