{-# LANGUAGE LambdaCase #-}

module Data.Range.Typed.Util where

import Data.Maybe (mapMaybe)
import Data.Range.Typed.Data
import Optics.Lens (Lens', lens)

-- This module is supposed to contain all of the functions that are required by the rest
-- of the code but could be easily pulled into separate and completely non-related
-- codebases or libraries.

compareLower :: (Ord a) => Bound a -> Bound a -> Ordering
compareLower :: forall a. Ord a => Bound a -> Bound a -> Ordering
compareLower Bound a
a Bound a
b
  | Bound a
a Bound a -> Bound a -> Bool
forall a. Eq a => a -> a -> Bool
== Bound a
b = Ordering
EQ
  | Bound a -> a
forall a. Bound a -> a
boundValue Bound a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== Bound a -> a
forall a. Bound a -> a
boundValue Bound a
b = if Bound a -> Bool
forall a. Bound a -> Bool
boundIsInclusive Bound a
a then Ordering
LT else Ordering
GT
  | Bound a -> a
forall a. Bound a -> a
boundValue Bound a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< Bound a -> a
forall a. Bound a -> a
boundValue Bound a
b = Ordering
LT
  | Bool
otherwise = Ordering
GT

compareHigher :: (Ord a) => Bound a -> Bound a -> Ordering
compareHigher :: forall a. Ord a => Bound a -> Bound a -> Ordering
compareHigher Bound a
a Bound a
b
  | Bound a
a Bound a -> Bound a -> Bool
forall a. Eq a => a -> a -> Bool
== Bound a
b = Ordering
EQ
  | Bound a -> a
forall a. Bound a -> a
boundValue Bound a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== Bound a -> a
forall a. Bound a -> a
boundValue Bound a
b = if Bound a -> Bool
forall a. Bound a -> Bool
boundIsInclusive Bound a
a then Ordering
GT else Ordering
LT
  | Bound a -> a
forall a. Bound a -> a
boundValue Bound a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< Bound a -> a
forall a. Bound a -> a
boundValue Bound a
b = Ordering
LT
  | Bool
otherwise = Ordering
GT

compareLowerIntersection :: (Ord a) => Bound a -> Bound a -> Ordering
compareLowerIntersection :: forall a. Ord a => Bound a -> Bound a -> Ordering
compareLowerIntersection Bound a
a Bound a
b
  | Bound a
a Bound a -> Bound a -> Bool
forall a. Eq a => a -> a -> Bool
== Bound a
b = Ordering
EQ
  | Bound a -> a
forall a. Bound a -> a
boundValue Bound a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== Bound a -> a
forall a. Bound a -> a
boundValue Bound a
b = if Bound a -> Bool
forall a. Bound a -> Bool
boundIsInclusive Bound a
a then Ordering
GT else Ordering
LT
  | Bound a -> a
forall a. Bound a -> a
boundValue Bound a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< Bound a -> a
forall a. Bound a -> a
boundValue Bound a
b = Ordering
LT
  | Bool
otherwise = Ordering
GT

compareHigherIntersection :: (Ord a) => Bound a -> Bound a -> Ordering
compareHigherIntersection :: forall a. Ord a => Bound a -> Bound a -> Ordering
compareHigherIntersection Bound a
a Bound a
b
  | Bound a
a Bound a -> Bound a -> Bool
forall a. Eq a => a -> a -> Bool
== Bound a
b = Ordering
EQ
  | Bound a -> a
forall a. Bound a -> a
boundValue Bound a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== Bound a -> a
forall a. Bound a -> a
boundValue Bound a
b = if Bound a -> Bool
forall a. Bound a -> Bool
boundIsInclusive Bound a
a then Ordering
LT else Ordering
GT
  | Bound a -> a
forall a. Bound a -> a
boundValue Bound a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< Bound a -> a
forall a. Bound a -> a
boundValue Bound a
b = Ordering
LT
  | Bool
otherwise = Ordering
GT

compareUpperToLower :: (Ord a) => Bound a -> Bound a -> Ordering
compareUpperToLower :: forall a. Ord a => Bound a -> Bound a -> Ordering
compareUpperToLower Bound a
upper Bound a
lower
  | Bound a -> a
forall a. Bound a -> a
boundValue Bound a
upper a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== Bound a -> a
forall a. Bound a -> a
boundValue Bound a
lower = if Bound a -> Bool
forall a. Bound a -> Bool
boundIsInclusive Bound a
upper Bool -> Bool -> Bool
|| Bound a -> Bool
forall a. Bound a -> Bool
boundIsInclusive Bound a
lower then Ordering
EQ else Ordering
LT
  | Bound a -> a
forall a. Bound a -> a
boundValue Bound a
upper a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< Bound a -> a
forall a. Bound a -> a
boundValue Bound a
lower = Ordering
LT
  | Bool
otherwise = Ordering
GT

minBounds :: (Ord a) => Bound a -> Bound a -> Bound a
minBounds :: forall a. Ord a => Bound a -> Bound a -> Bound a
minBounds Bound a
ao Bound a
bo = if Bound a -> Bound a -> Ordering
forall a. Ord a => Bound a -> Bound a -> Ordering
compareLower Bound a
ao Bound a
bo Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
LT then Bound a
ao else Bound a
bo

maxBounds :: (Ord a) => Bound a -> Bound a -> Bound a
maxBounds :: forall a. Ord a => Bound a -> Bound a -> Bound a
maxBounds Bound a
ao Bound a
bo = if Bound a -> Bound a -> Ordering
forall a. Ord a => Bound a -> Bound a -> Ordering
compareHigher Bound a
ao Bound a
bo Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT then Bound a
ao else Bound a
bo

minBoundsIntersection :: (Ord a) => Bound a -> Bound a -> Bound a
minBoundsIntersection :: forall a. Ord a => Bound a -> Bound a -> Bound a
minBoundsIntersection Bound a
ao Bound a
bo = if Bound a -> Bound a -> Ordering
forall a. Ord a => Bound a -> Bound a -> Ordering
compareLowerIntersection Bound a
ao Bound a
bo Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
LT then Bound a
ao else Bound a
bo

maxBoundsIntersection :: (Ord a) => Bound a -> Bound a -> Bound a
maxBoundsIntersection :: forall a. Ord a => Bound a -> Bound a -> Bound a
maxBoundsIntersection Bound a
ao Bound a
bo = if Bound a -> Bound a -> Ordering
forall a. Ord a => Bound a -> Bound a -> Ordering
compareHigherIntersection Bound a
ao Bound a
bo Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT then Bound a
ao else Bound a
bo

insertionSort :: (a -> a -> Ordering) -> [a] -> [a] -> [a]
insertionSort :: forall a. (a -> a -> Ordering) -> [a] -> [a] -> [a]
insertionSort a -> a -> Ordering
comp = [a] -> [a] -> [a]
go
  where
    go :: [a] -> [a] -> [a]
go (a
f : [a]
fs) (a
s : [a]
ss) = case a -> a -> Ordering
comp a
f a
s of
      Ordering
LT -> a
f a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
go [a]
fs (a
s a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
ss)
      Ordering
EQ -> a
f a -> [a] -> [a]
forall a. a -> [a] -> [a]
: a
s a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
go [a]
fs [a]
ss
      Ordering
GT -> a
s a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
go (a
f a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
fs) [a]
ss
    go [] [a]
z = [a]
z
    go [a]
z [] = [a]
z

invertBound :: Bound a -> Bound a
invertBound :: forall a. Bound a -> Bound a
invertBound (InclusiveBound a
x) = a -> Bound a
forall a. a -> Bound a
ExclusiveBound a
x
invertBound (ExclusiveBound a
x) = a -> Bound a
forall a. a -> Bound a
InclusiveBound a
x

isEmptySpan :: (Eq a) => (Bound a, Bound a) -> Bool
isEmptySpan :: forall a. Eq a => (Bound a, Bound a) -> Bool
isEmptySpan (Bound a
a, Bound a
b) = Bound a -> a
forall a. Bound a -> a
boundValue Bound a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== Bound a -> a
forall a. Bound a -> a
boundValue Bound a
b Bool -> Bool -> Bool
&& (Bool -> Bool
not (Bound a -> Bool
forall a. Bound a -> Bool
boundIsInclusive Bound a
a) Bool -> Bool -> Bool
|| Bool -> Bool
not (Bound a -> Bool
forall a. Bound a -> Bool
boundIsInclusive Bound a
b))

removeEmptySpans :: (Eq a) => [(Bound a, Bound a)] -> [(Bound a, Bound a)]
removeEmptySpans :: forall a. Eq a => [(Bound a, Bound a)] -> [(Bound a, Bound a)]
removeEmptySpans = ((Bound a, Bound a) -> Bool)
-> [(Bound a, Bound a)] -> [(Bound a, Bound a)]
forall a. (a -> Bool) -> [a] -> [a]
filter (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)

boundsOverlapType :: (Ord a) => (Bound a, Bound a) -> (Bound a, Bound a) -> OverlapType
boundsOverlapType :: forall a.
Ord a =>
(Bound a, Bound a) -> (Bound a, Bound a) -> OverlapType
boundsOverlapType l :: (Bound a, Bound a)
l@(Bound a
a, Bound a
b) r :: (Bound a, Bound a)
r@(Bound a
x, Bound a
y)
  | (Bound a, Bound a) -> Bool
forall a. Eq a => (Bound a, Bound a) -> Bool
isEmptySpan (Bound a, Bound a)
l Bool -> Bool -> Bool
|| (Bound a, Bound a) -> Bool
forall a. Eq a => (Bound a, Bound a) -> Bool
isEmptySpan (Bound a, Bound a)
r = OverlapType
Separate
  | Bound a -> a
forall a. Bound a -> a
boundValue Bound a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== Bound a -> a
forall a. Bound a -> a
boundValue Bound a
x = OverlapType
Overlap
  | Bound a -> a
forall a. Bound a -> a
boundValue Bound a
b a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== Bound a -> a
forall a. Bound a -> a
boundValue Bound a
y = OverlapType
Overlap
  | Bool
otherwise = (Bound a
a Bound a -> (Bound a, Bound a) -> OverlapType
forall a. Ord a => Bound a -> (Bound a, Bound a) -> OverlapType
`boundIsBetween` (Bound a
x, Bound a
y)) OverlapType -> OverlapType -> OverlapType
`orOverlapType` (Bound a
x Bound a -> (Bound a, Bound a) -> OverlapType
forall a. Ord a => Bound a -> (Bound a, Bound a) -> OverlapType
`boundIsBetween` (Bound a
a, Bound a
b))

orOverlapType :: OverlapType -> OverlapType -> OverlapType
orOverlapType :: OverlapType -> OverlapType -> OverlapType
orOverlapType OverlapType
Overlap OverlapType
_ = OverlapType
Overlap
orOverlapType OverlapType
_ OverlapType
Overlap = OverlapType
Overlap
orOverlapType OverlapType
Adjoin OverlapType
_ = OverlapType
Adjoin
orOverlapType OverlapType
_ OverlapType
Adjoin = OverlapType
Adjoin
orOverlapType OverlapType
_ OverlapType
_ = OverlapType
Separate

pointJoinType :: Bound a -> Bound b -> OverlapType
pointJoinType :: forall a b. Bound a -> Bound b -> OverlapType
pointJoinType (InclusiveBound a
_) (InclusiveBound b
_) = OverlapType
Overlap
pointJoinType (ExclusiveBound a
_) (ExclusiveBound b
_) = OverlapType
Separate
pointJoinType Bound a
_ Bound b
_ = OverlapType
Adjoin

-- This function assumes that the bound on the left is a lower bound and that the range is in (lower, upper)
-- bound order
boundCmp :: (Ord a) => Bound a -> (Bound a, Bound a) -> Ordering
boundCmp :: forall a. Ord a => Bound a -> (Bound a, Bound a) -> Ordering
boundCmp Bound a
a (Bound a
x, Bound a
y)
  | Bound a -> (Bound a, Bound a) -> OverlapType
forall a. Ord a => Bound a -> (Bound a, Bound a) -> OverlapType
boundIsBetween Bound a
a (Bound a
x, Bound a
y) OverlapType -> OverlapType -> Bool
forall a. Eq a => a -> a -> Bool
/= OverlapType
Separate = Ordering
EQ
  | Bound a -> a
forall a. Bound a -> a
boundValue Bound a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= Bound a -> a
forall a. Bound a -> a
boundValue Bound a
x = Ordering
LT
  | Bool
otherwise = Ordering
GT

-- TODO replace everywhere with boundsOverlapType
boundIsBetween :: (Ord a) => Bound a -> (Bound a, Bound a) -> OverlapType
boundIsBetween :: forall a. Ord a => Bound a -> (Bound a, Bound a) -> OverlapType
boundIsBetween Bound a
a (Bound a
x, Bound a
y)
  | 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
a = OverlapType
Separate
  | 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
a = Bound a -> Bound a -> OverlapType
forall a b. Bound a -> Bound b -> OverlapType
pointJoinType Bound a
a Bound a
x
  | Bound a -> a
forall a. Bound a -> a
boundValue Bound a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< Bound a -> a
forall a. Bound a -> a
boundValue Bound a
y = OverlapType
Overlap
  | Bound a -> a
forall a. Bound a -> a
boundValue Bound a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== Bound a -> a
forall a. Bound a -> a
boundValue Bound a
y = Bound a -> Bound a -> OverlapType
forall a b. Bound a -> Bound b -> OverlapType
pointJoinType Bound a
a Bound a
y
  | Bool
otherwise = OverlapType
Separate

singletonInSpan :: (Ord a) => a -> (Bound a, Bound a) -> OverlapType
singletonInSpan :: forall a. Ord a => a -> (Bound a, Bound a) -> OverlapType
singletonInSpan a
a = Bound a -> (Bound a, Bound a) -> OverlapType
forall a. Ord a => Bound a -> (Bound a, Bound a) -> OverlapType
boundIsBetween (Bound a -> (Bound a, Bound a) -> OverlapType)
-> Bound a -> (Bound a, Bound a) -> OverlapType
forall a b. (a -> b) -> a -> b
$ a -> Bound a
forall a. a -> Bound a
InclusiveBound a
a

againstLowerBound :: (Ord a) => Bound a -> Bound a -> OverlapType
againstLowerBound :: forall a. Ord a => Bound a -> Bound a -> OverlapType
againstLowerBound Bound a
a Bound a
lower
  | Bound a -> a
forall a. Bound a -> a
boundValue Bound a
lower a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== Bound a -> a
forall a. Bound a -> a
boundValue Bound a
a = Bound a -> Bound a -> OverlapType
forall a b. Bound a -> Bound b -> OverlapType
pointJoinType Bound a
a Bound a
lower
  | 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
a = OverlapType
Overlap
  | Bool
otherwise = OverlapType
Separate

againstUpperBound :: (Ord a) => Bound a -> Bound a -> OverlapType
againstUpperBound :: forall a. Ord a => Bound a -> Bound a -> OverlapType
againstUpperBound Bound a
a Bound a
upper
  | Bound a -> a
forall a. Bound a -> a
boundValue Bound a
upper a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== Bound a -> a
forall a. Bound a -> a
boundValue Bound a
a = Bound a -> Bound a -> OverlapType
forall a b. Bound a -> Bound b -> OverlapType
pointJoinType Bound a
a Bound a
upper
  | Bound a -> a
forall a. Bound a -> a
boundValue Bound a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< Bound a -> a
forall a. Bound a -> a
boundValue Bound a
upper = OverlapType
Overlap
  | Bool
otherwise = OverlapType
Separate

takeEvenly :: [[a]] -> [a]
takeEvenly :: forall a. [[a]] -> [a]
takeEvenly [] = []
takeEvenly [[a]]
xss = ([a] -> Maybe a) -> [[a]] -> [a]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe [a] -> Maybe a
forall a. [a] -> Maybe a
safeHead [[a]]
xss [a] -> [a] -> [a]
forall a. Semigroup a => a -> a -> a
<> [[a]] -> [a]
forall a. [[a]] -> [a]
takeEvenly (([a] -> Bool) -> [[a]] -> [[a]]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> ([a] -> Bool) -> [a] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) ([[a]] -> [[a]]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> a -> b
$ ([a] -> [a]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map [a] -> [a]
forall a. HasCallStack => [a] -> [a]
tail [[a]]
xss)

safeHead :: [a] -> Maybe a
safeHead :: forall a. [a] -> Maybe a
safeHead [] = Maybe a
forall a. Maybe a
Nothing
safeHead (a
x : [a]
_) = a -> Maybe a
forall a. a -> Maybe a
Just a
x

pairs :: [a] -> [(a, a)]
pairs :: forall a. [a] -> [(a, a)]
pairs [] = []
pairs [a]
xs = [a] -> [a] -> [(a, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
xs ([a] -> [a]
forall a. HasCallStack => [a] -> [a]
tail [a]
xs)

lowestValueInLowerBound :: (Enum a) => Bound a -> a
lowestValueInLowerBound :: forall a. Enum a => Bound a -> a
lowestValueInLowerBound = (a -> a) -> Bound a -> a
forall a. (a -> a) -> Bound a -> a
boundValueNormalized a -> a
forall a. Enum a => a -> a
succ

highestValueInUpperBound :: (Enum a) => Bound a -> a
highestValueInUpperBound :: forall a. Enum a => Bound a -> a
highestValueInUpperBound = (a -> a) -> Bound a -> a
forall a. (a -> a) -> Bound a -> a
boundValueNormalized a -> a
forall a. Enum a => a -> a
pred

boundValue :: Bound a -> a
boundValue :: forall a. Bound a -> a
boundValue =
  \case
    InclusiveBound a
a -> a
a
    ExclusiveBound a
a -> a
a

boundValueNormalized :: (a -> a) -> Bound a -> a
boundValueNormalized :: forall a. (a -> a) -> Bound a -> a
boundValueNormalized a -> a
normalize =
  \case
    InclusiveBound a
a -> a
a
    ExclusiveBound a
a -> a -> a
normalize a
a

boundIsInclusive :: Bound a -> Bool
boundIsInclusive :: forall a. Bound a -> Bool
boundIsInclusive =
  \case
    InclusiveBound a
_ -> Bool
True
    ExclusiveBound a
_ -> Bool
False

-- | Changing `Range`'s lower bound (possibly changing the constructor)
lowerBoundUnstable :: Lens' (AnyRange a) (Maybe (Bound a))
lowerBoundUnstable :: forall a. Lens' (AnyRange a) (Maybe (Bound a))
lowerBoundUnstable = (AnyRange a -> Maybe (Bound a))
-> (AnyRange a -> Maybe (Bound a) -> AnyRange a)
-> Lens
     (AnyRange a) (AnyRange a) (Maybe (Bound a)) (Maybe (Bound a))
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (\(AnyRangeFor Range hasLowerBound hasUpperBound a
range) -> Range hasLowerBound hasUpperBound a -> Maybe (Bound a)
forall (hasLowerBound :: Bool) (hasUpperBound :: Bool) a.
Range hasLowerBound hasUpperBound a -> Maybe (Bound a)
g Range hasLowerBound hasUpperBound a
range) (\(AnyRangeFor Range hasLowerBound hasUpperBound a
range) -> Range hasLowerBound hasUpperBound a
-> Maybe (Bound a) -> AnyRange a
forall (hasLowerBound :: Bool) (hasUpperBound :: Bool) a.
Range hasLowerBound hasUpperBound a
-> Maybe (Bound a) -> AnyRange a
s Range hasLowerBound hasUpperBound a
range)
  where
    g :: Range hasLowerBound hasUpperBound a -> Maybe (Bound a)
    g :: forall (hasLowerBound :: Bool) (hasUpperBound :: Bool) a.
Range hasLowerBound hasUpperBound a -> Maybe (Bound a)
g =
      \case
        SingletonRange a
a -> 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
$ a -> Bound a
forall a. a -> Bound a
InclusiveBound a
a
        SpanRange Bound a
x Bound a
_ -> Bound a -> Maybe (Bound a)
forall a. a -> Maybe a
Just Bound a
x
        LowerBoundRange Bound a
x -> Bound a -> Maybe (Bound a)
forall a. a -> Maybe a
Just Bound a
x
        UpperBoundRange Bound a
_ -> Maybe (Bound a)
forall a. Maybe a
Nothing
        Range hasLowerBound hasUpperBound a
InfiniteRange -> Maybe (Bound a)
forall a. Maybe a
Nothing
        Range hasLowerBound hasUpperBound a
EmptyRange -> Maybe (Bound a)
forall a. Maybe a
Nothing
    s :: Range hasLowerBound hasUpperBound a -> Maybe (Bound a) -> AnyRange a
    s :: forall (hasLowerBound :: Bool) (hasUpperBound :: Bool) a.
Range hasLowerBound hasUpperBound a
-> Maybe (Bound a) -> AnyRange a
s =
      \case
        SingletonRange a
_ ->
          \case
            Just (InclusiveBound a
y) -> Range 'True '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 'True 'True a -> AnyRange a)
-> Range 'True 'True a -> AnyRange a
forall a b. (a -> b) -> a -> b
$ a -> Range 'True 'True a
forall a. a -> Range 'True 'True a
SingletonRange a
y
            Just (ExclusiveBound a
y) -> Range 'True '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 'True 'True a -> AnyRange a)
-> Range 'True 'True a -> AnyRange a
forall a b. (a -> b) -> a -> b
$ a -> Range 'True 'True a
forall a. a -> Range 'True 'True a
SingletonRange a
y
            Maybe (Bound a)
Nothing -> 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
        SpanRange Bound a
_ Bound a
x -> AnyRange a
-> (Bound a -> AnyRange a) -> Maybe (Bound a) -> AnyRange a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (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)
-> Range 'False 'True a -> AnyRange a
forall a b. (a -> b) -> a -> b
$ Bound a -> Range 'False 'True a
forall a. Bound a -> Range 'False 'True a
UpperBoundRange Bound a
x) (Range 'True '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 'True 'True a -> AnyRange a)
-> (Bound a -> Range 'True 'True a) -> Bound a -> AnyRange a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bound a -> Bound a -> Range 'True 'True a
forall a. Bound a -> Bound a -> Range 'True 'True a
`SpanRange` Bound a
x))
        LowerBoundRange Bound a
_ -> AnyRange a
-> (Bound a -> AnyRange a) -> Maybe (Bound a) -> AnyRange a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (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) (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)
        UpperBoundRange Bound a
x -> AnyRange a
-> (Bound a -> AnyRange a) -> Maybe (Bound a) -> AnyRange a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (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)
-> Range 'False 'True a -> AnyRange a
forall a b. (a -> b) -> a -> b
$ Bound a -> Range 'False 'True a
forall a. Bound a -> Range 'False 'True a
UpperBoundRange Bound a
x) (Range 'True '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 'True 'True a -> AnyRange a)
-> (Bound a -> Range 'True 'True a) -> Bound a -> AnyRange a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bound a -> Bound a -> Range 'True 'True a
forall a. Bound a -> Bound a -> Range 'True 'True a
`SpanRange` Bound a
x))
        Range hasLowerBound hasUpperBound a
InfiniteRange -> AnyRange a
-> (Bound a -> AnyRange a) -> Maybe (Bound a) -> AnyRange a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (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) (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)
        Range hasLowerBound hasUpperBound a
EmptyRange -> AnyRange a -> Maybe (Bound a) -> AnyRange a
forall a b. a -> b -> a
const (AnyRange a -> Maybe (Bound a) -> AnyRange a)
-> AnyRange a -> Maybe (Bound a) -> AnyRange a
forall a b. (a -> b) -> a -> b
$ 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

-- | Changing `Range`'s upper bound (possibly changing the constructor)
upperBoundUnstable :: Lens' (AnyRange a) (Maybe (Bound a))
upperBoundUnstable :: forall a. Lens' (AnyRange a) (Maybe (Bound a))
upperBoundUnstable = (AnyRange a -> Maybe (Bound a))
-> (AnyRange a -> Maybe (Bound a) -> AnyRange a)
-> Lens
     (AnyRange a) (AnyRange a) (Maybe (Bound a)) (Maybe (Bound a))
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (\(AnyRangeFor Range hasLowerBound hasUpperBound a
range) -> Range hasLowerBound hasUpperBound a -> Maybe (Bound a)
forall (hasLowerBound :: Bool) (hasUpperBound :: Bool) a.
Range hasLowerBound hasUpperBound a -> Maybe (Bound a)
g Range hasLowerBound hasUpperBound a
range) (\(AnyRangeFor Range hasLowerBound hasUpperBound a
range) -> Range hasLowerBound hasUpperBound a
-> Maybe (Bound a) -> AnyRange a
forall (hasLowerBound :: Bool) (hasUpperBound :: Bool) a.
Range hasLowerBound hasUpperBound a
-> Maybe (Bound a) -> AnyRange a
s Range hasLowerBound hasUpperBound a
range)
  where
    g :: Range hasLowerBound hasUpperBound a -> Maybe (Bound a)
    g :: forall (hasLowerBound :: Bool) (hasUpperBound :: Bool) a.
Range hasLowerBound hasUpperBound a -> Maybe (Bound a)
g =
      \case
        SingletonRange a
a -> 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
$ a -> Bound a
forall a. a -> Bound a
InclusiveBound a
a
        SpanRange Bound a
_ Bound a
x -> Bound a -> Maybe (Bound a)
forall a. a -> Maybe a
Just Bound a
x
        UpperBoundRange Bound a
x -> Bound a -> Maybe (Bound a)
forall a. a -> Maybe a
Just Bound a
x
        LowerBoundRange Bound a
_ -> Maybe (Bound a)
forall a. Maybe a
Nothing
        Range hasLowerBound hasUpperBound a
InfiniteRange -> Maybe (Bound a)
forall a. Maybe a
Nothing
        Range hasLowerBound hasUpperBound a
EmptyRange -> Maybe (Bound a)
forall a. Maybe a
Nothing
    s :: Range hasLowerBound hasUpperBound a -> Maybe (Bound a) -> AnyRange a
    s :: forall (hasLowerBound :: Bool) (hasUpperBound :: Bool) a.
Range hasLowerBound hasUpperBound a
-> Maybe (Bound a) -> AnyRange a
s =
      \case
        SingletonRange a
_ ->
          \case
            Just (InclusiveBound a
y) -> Range 'True '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 'True 'True a -> AnyRange a)
-> Range 'True 'True a -> AnyRange a
forall a b. (a -> b) -> a -> b
$ a -> Range 'True 'True a
forall a. a -> Range 'True 'True a
SingletonRange a
y
            Just (ExclusiveBound a
y) -> Range 'True '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 'True 'True a -> AnyRange a)
-> Range 'True 'True a -> AnyRange a
forall a b. (a -> b) -> a -> b
$ a -> Range 'True 'True a
forall a. a -> Range 'True 'True a
SingletonRange a
y
            Maybe (Bound a)
Nothing -> 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
        SpanRange Bound a
x Bound a
_ -> AnyRange a
-> (Bound a -> AnyRange a) -> Maybe (Bound a) -> AnyRange a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (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)
-> Range 'False 'True a -> AnyRange a
forall a b. (a -> b) -> a -> b
$ Bound a -> Range 'False 'True a
forall a. Bound a -> Range 'False 'True a
UpperBoundRange Bound a
x) (Range 'True '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 'True 'True a -> AnyRange a)
-> (Bound a -> Range 'True 'True a) -> Bound a -> AnyRange a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bound a -> Bound a -> Range 'True 'True a
forall a. Bound a -> Bound a -> Range 'True 'True a
SpanRange Bound a
x)
        UpperBoundRange Bound a
_ -> AnyRange a
-> (Bound a -> AnyRange a) -> Maybe (Bound a) -> AnyRange a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (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) (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)
        LowerBoundRange Bound a
x -> AnyRange a
-> (Bound a -> AnyRange a) -> Maybe (Bound a) -> AnyRange a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (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)
-> Range 'True 'False a -> AnyRange a
forall a b. (a -> b) -> a -> b
$ Bound a -> Range 'True 'False a
forall a. Bound a -> Range 'True 'False a
LowerBoundRange Bound a
x) (Range 'True '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 'True 'True a -> AnyRange a)
-> (Bound a -> Range 'True 'True a) -> Bound a -> AnyRange a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bound a -> Bound a -> Range 'True 'True a
forall a. Bound a -> Bound a -> Range 'True 'True a
SpanRange Bound a
x)
        Range hasLowerBound hasUpperBound a
InfiniteRange -> AnyRange a
-> (Bound a -> AnyRange a) -> Maybe (Bound a) -> AnyRange a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (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) (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)
        Range hasLowerBound hasUpperBound a
EmptyRange -> AnyRange a -> Maybe (Bound a) -> AnyRange a
forall a b. a -> b -> a
const (AnyRange a -> Maybe (Bound a) -> AnyRange a)
-> AnyRange a -> Maybe (Bound a) -> AnyRange a
forall a b. (a -> b) -> a -> b
$ 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