module Unison.PatternMatchCoverage.IntervalSet
( IntervalSet,
empty,
singleton,
fromList,
insert,
delete,
difference,
intersection,
complement,
null,
member,
extractSingleton,
intersectIntervals,
map,
foldr,
lookupMin,
lookupMax,
)
where
import Data.Coerce (coerce)
import Data.Function (on)
import Data.IntMap (IntMap)
import Data.IntMap.Strict qualified as IntMap
import Data.List (sortOn)
import Data.Maybe (catMaybes, fromMaybe, maybeToList)
import Prelude hiding (foldr, map, null)
import Prelude qualified
newtype IntervalSet = IntervalSet {IntervalSet -> IntMap Int
unIntervalSet :: IntMap Int}
deriving stock (Int -> IntervalSet -> ShowS
[IntervalSet] -> ShowS
IntervalSet -> String
(Int -> IntervalSet -> ShowS)
-> (IntervalSet -> String)
-> ([IntervalSet] -> ShowS)
-> Show IntervalSet
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IntervalSet -> ShowS
showsPrec :: Int -> IntervalSet -> ShowS
$cshow :: IntervalSet -> String
show :: IntervalSet -> String
$cshowList :: [IntervalSet] -> ShowS
showList :: [IntervalSet] -> ShowS
Show, IntervalSet -> IntervalSet -> Bool
(IntervalSet -> IntervalSet -> Bool)
-> (IntervalSet -> IntervalSet -> Bool) -> Eq IntervalSet
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IntervalSet -> IntervalSet -> Bool
== :: IntervalSet -> IntervalSet -> Bool
$c/= :: IntervalSet -> IntervalSet -> Bool
/= :: IntervalSet -> IntervalSet -> Bool
Eq, Eq IntervalSet
Eq IntervalSet =>
(IntervalSet -> IntervalSet -> Ordering)
-> (IntervalSet -> IntervalSet -> Bool)
-> (IntervalSet -> IntervalSet -> Bool)
-> (IntervalSet -> IntervalSet -> Bool)
-> (IntervalSet -> IntervalSet -> Bool)
-> (IntervalSet -> IntervalSet -> IntervalSet)
-> (IntervalSet -> IntervalSet -> IntervalSet)
-> Ord IntervalSet
IntervalSet -> IntervalSet -> Bool
IntervalSet -> IntervalSet -> Ordering
IntervalSet -> IntervalSet -> IntervalSet
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: IntervalSet -> IntervalSet -> Ordering
compare :: IntervalSet -> IntervalSet -> Ordering
$c< :: IntervalSet -> IntervalSet -> Bool
< :: IntervalSet -> IntervalSet -> Bool
$c<= :: IntervalSet -> IntervalSet -> Bool
<= :: IntervalSet -> IntervalSet -> Bool
$c> :: IntervalSet -> IntervalSet -> Bool
> :: IntervalSet -> IntervalSet -> Bool
$c>= :: IntervalSet -> IntervalSet -> Bool
>= :: IntervalSet -> IntervalSet -> Bool
$cmax :: IntervalSet -> IntervalSet -> IntervalSet
max :: IntervalSet -> IntervalSet -> IntervalSet
$cmin :: IntervalSet -> IntervalSet -> IntervalSet
min :: IntervalSet -> IntervalSet -> IntervalSet
Ord)
empty :: IntervalSet
empty :: IntervalSet
empty = IntMap Int -> IntervalSet
IntervalSet IntMap Int
forall a. IntMap a
IntMap.empty
singleton :: (Int, Int) -> IntervalSet
singleton :: (Int, Int) -> IntervalSet
singleton (Int, Int)
x = (Int, Int) -> IntervalSet -> IntervalSet
insert (Int, Int)
x IntervalSet
empty
lookupMin :: IntervalSet -> Maybe Int
lookupMin :: IntervalSet -> Maybe Int
lookupMin = ((Int, Int) -> Int) -> Maybe (Int, Int) -> Maybe Int
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int, Int) -> Int
forall a b. (a, b) -> a
fst (Maybe (Int, Int) -> Maybe Int)
-> (IntervalSet -> Maybe (Int, Int)) -> IntervalSet -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntMap Int -> Maybe (Int, Int)
forall a. IntMap a -> Maybe (Int, a)
IntMap.lookupMin (IntMap Int -> Maybe (Int, Int))
-> (IntervalSet -> IntMap Int) -> IntervalSet -> Maybe (Int, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntervalSet -> IntMap Int
unIntervalSet
lookupMax :: IntervalSet -> Maybe Int
lookupMax :: IntervalSet -> Maybe Int
lookupMax = ((Int, Int) -> Int) -> Maybe (Int, Int) -> Maybe Int
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int, Int) -> Int
forall a b. (a, b) -> b
snd (Maybe (Int, Int) -> Maybe Int)
-> (IntervalSet -> Maybe (Int, Int)) -> IntervalSet -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntMap Int -> Maybe (Int, Int)
forall a. IntMap a -> Maybe (Int, a)
IntMap.lookupMax (IntMap Int -> Maybe (Int, Int))
-> (IntervalSet -> IntMap Int) -> IntervalSet -> Maybe (Int, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntervalSet -> IntMap Int
unIntervalSet
member :: Int -> IntervalSet -> Bool
member :: Int -> IntervalSet -> Bool
member Int
i IntervalSet
is =
case Int -> IntervalSet -> (IntervalSet, Maybe (Int, Int), IntervalSet)
splitLookupLE Int
i IntervalSet
is of
(IntervalSet
_, Maybe (Int, Int)
m, IntervalSet
_) -> case Maybe (Int, Int)
m of
Maybe (Int, Int)
Nothing -> Bool
False
Just (Int
_, Int
ub) -> Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
ub
foldr :: (Int -> Int -> b -> b) -> b -> IntervalSet -> b
foldr :: forall b. (Int -> Int -> b -> b) -> b -> IntervalSet -> b
foldr Int -> Int -> b -> b
f b
z = (Int -> Int -> b -> b) -> b -> IntMap Int -> b
forall a b. (Int -> a -> b -> b) -> b -> IntMap a -> b
IntMap.foldrWithKey Int -> Int -> b -> b
f b
z (IntMap Int -> b)
-> (IntervalSet -> IntMap Int) -> IntervalSet -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntervalSet -> IntMap Int
unIntervalSet
map :: ((Int, Int) -> (Int, Int)) -> IntervalSet -> IntervalSet
map :: ((Int, Int) -> (Int, Int)) -> IntervalSet -> IntervalSet
map (Int, Int) -> (Int, Int)
f = IntMap Int -> IntervalSet
IntervalSet (IntMap Int -> IntervalSet)
-> (IntervalSet -> IntMap Int) -> IntervalSet -> IntervalSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> IntMap Int -> IntMap Int)
-> IntMap Int -> IntervalSet -> IntMap Int
forall b. (Int -> Int -> b -> b) -> b -> IntervalSet -> b
foldr Int -> Int -> IntMap Int -> IntMap Int
phi IntMap Int
forall a. IntMap a
IntMap.empty
where
phi :: Int -> Int -> IntMap Int -> IntMap Int
phi Int
k Int
v IntMap Int
b = let (Int
k', Int
v') = (Int, Int) -> (Int, Int)
f (Int
k, Int
v) in Int -> Int -> IntMap Int -> IntMap Int
forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert Int
k' Int
v' IntMap Int
b
insert :: (Int, Int) -> IntervalSet -> IntervalSet
insert :: (Int, Int) -> IntervalSet -> IntervalSet
insert i :: (Int, Int)
i@(Int
lb, Int
ub) IntervalSet
is
| (Int, Int) -> Bool
nullInterval (Int, Int)
i = IntervalSet
is
| Bool
otherwise =
case Int -> IntervalSet -> (IntervalSet, Maybe (Int, Int), IntervalSet)
splitLookupLE Int
lb IntervalSet
is of
(IntervalSet
smaller, Maybe (Int, Int)
m1, IntervalSet
xs) ->
case Int -> IntervalSet -> (IntervalSet, Maybe (Int, Int), IntervalSet)
splitLookupLE Int
ub IntervalSet
xs of
(IntervalSet
_, Maybe (Int, Int)
m2, IntervalSet
larger) ->
IntMap Int -> IntervalSet
IntervalSet (IntMap Int -> IntervalSet) -> IntMap Int -> IntervalSet
forall a b. (a -> b) -> a -> b
$
[IntMap Int] -> IntMap Int
forall (f :: * -> *) a. Foldable f => f (IntMap a) -> IntMap a
IntMap.unions
[ IntervalSet -> IntMap Int
unIntervalSet IntervalSet
smaller,
IntervalSet -> IntMap Int
unIntervalSet (IntervalSet -> IntMap Int) -> IntervalSet -> IntMap Int
forall a b. (a -> b) -> a -> b
$ [(Int, Int)] -> IntervalSet
fromList (Maybe (Int, Int) -> [(Int, Int)]
forall a. Maybe a -> [a]
maybeToList Maybe (Int, Int)
m1 [(Int, Int)] -> [(Int, Int)] -> [(Int, Int)]
forall a. [a] -> [a] -> [a]
++ [(Int, Int)
i] [(Int, Int)] -> [(Int, Int)] -> [(Int, Int)]
forall a. [a] -> [a] -> [a]
++ Maybe (Int, Int) -> [(Int, Int)]
forall a. Maybe a -> [a]
maybeToList Maybe (Int, Int)
m2),
IntervalSet -> IntMap Int
unIntervalSet IntervalSet
larger
]
delete :: (Int, Int) -> IntervalSet -> IntervalSet
delete :: (Int, Int) -> IntervalSet -> IntervalSet
delete i :: (Int, Int)
i@(Int
lb, Int
ub) IntervalSet
is
| (Int, Int) -> Bool
nullInterval (Int, Int)
i = IntervalSet
is
| Bool
otherwise =
case Int -> IntervalSet -> (IntervalSet, Maybe (Int, Int), IntervalSet)
splitLookupLE Int
lb IntervalSet
is of
(IntervalSet
smaller, Maybe (Int, Int)
m1, IntervalSet
xs) ->
case Int -> IntervalSet -> (IntervalSet, Maybe (Int, Int), IntervalSet)
splitLookupLE Int
ub IntervalSet
xs of
(IntervalSet
_, Maybe (Int, Int)
m2, IntervalSet
larger) ->
IntMap Int -> IntervalSet
IntervalSet (IntMap Int -> IntervalSet) -> IntMap Int -> IntervalSet
forall a b. (a -> b) -> a -> b
$
[IntMap Int] -> IntMap Int
forall (f :: * -> *) a. Foldable f => f (IntMap a) -> IntMap a
IntMap.unions
[ IntervalSet -> IntMap Int
unIntervalSet IntervalSet
smaller,
case Maybe (Int, Int)
m1 of
Maybe (Int, Int)
Nothing -> IntMap Int
forall a. IntMap a
IntMap.empty
Just (Int, Int)
j -> [(Int, Int)] -> IntMap Int
forall a. [(Int, a)] -> IntMap a
IntMap.fromList ([Maybe (Int, Int)] -> [(Int, Int)]
forall a. [Maybe a] -> [a]
catMaybes ((Maybe (Int, Int) -> Maybe (Int, Int))
-> [Maybe (Int, Int)] -> [Maybe (Int, Int)]
forall a b. (a -> b) -> [a] -> [b]
Prelude.map ((Int, Int) -> (Int, Int) -> Maybe (Int, Int)
intersectIntervals (Int, Int)
j ((Int, Int) -> Maybe (Int, Int))
-> Maybe (Int, Int) -> Maybe (Int, Int)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) [Int -> Maybe (Int, Int)
upTo Int
lb, Int -> Maybe (Int, Int)
downTo Int
ub])),
IntMap Int -> Maybe (IntMap Int) -> IntMap Int
forall a. a -> Maybe a -> a
fromMaybe IntMap Int
forall a. IntMap a
IntMap.empty do
(Int, Int)
j <- Maybe (Int, Int)
m2
(Int, Int)
aboveDelete <- Int -> Maybe (Int, Int)
downTo Int
ub
(Int -> Int -> IntMap Int) -> (Int, Int) -> IntMap Int
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> Int -> IntMap Int
forall a. Int -> a -> IntMap a
IntMap.singleton ((Int, Int) -> IntMap Int)
-> Maybe (Int, Int) -> Maybe (IntMap Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int, Int) -> (Int, Int) -> Maybe (Int, Int)
intersectIntervals (Int, Int)
aboveDelete (Int, Int)
j,
IntervalSet -> IntMap Int
unIntervalSet IntervalSet
larger
]
complement :: IntervalSet -> IntervalSet
complement :: IntervalSet -> IntervalSet
complement (IntervalSet IntMap Int
m) = [(Int, Int)] -> IntervalSet
fromAscList ([(Int, Int)] -> IntervalSet)
-> (IntMap Int -> [(Int, Int)]) -> IntMap Int -> IntervalSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\[(Int, Int)]
xs -> ((Int, Int)
-> (Maybe Int -> [(Int, Int)]) -> Maybe Int -> [(Int, Int)])
-> (Maybe Int -> [(Int, Int)])
-> [(Int, Int)]
-> Maybe Int
-> [(Int, Int)]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
Prelude.foldr (Int, Int)
-> (Maybe Int -> [(Int, Int)]) -> Maybe Int -> [(Int, Int)]
forall {a}.
(Int, a) -> (Maybe a -> [(Int, Int)]) -> Maybe Int -> [(Int, Int)]
phi Maybe Int -> [(Int, Int)]
z [(Int, Int)]
xs Maybe Int
forall a. Maybe a
Nothing) ([(Int, Int)] -> [(Int, Int)])
-> (IntMap Int -> [(Int, Int)]) -> IntMap Int -> [(Int, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntMap Int -> [(Int, Int)]
forall a. IntMap a -> [(Int, a)]
IntMap.toAscList (IntMap Int -> IntervalSet) -> IntMap Int -> IntervalSet
forall a b. (a -> b) -> a -> b
$ IntMap Int
m
where
phi :: (Int, a) -> (Maybe a -> [(Int, Int)]) -> Maybe Int -> [(Int, Int)]
phi (Int
lb, a
ub) Maybe a -> [(Int, Int)]
b Maybe Int
mprevUb =
case Maybe Int
mprevUb of
Maybe Int
Nothing -> case Int -> Maybe (Int, Int)
upTo Int
lb of
Maybe (Int, Int)
Nothing -> Maybe a -> [(Int, Int)]
b (a -> Maybe a
forall a. a -> Maybe a
Just a
ub)
Just (Int, Int)
x -> (Int, Int)
x (Int, Int) -> [(Int, Int)] -> [(Int, Int)]
forall a. a -> [a] -> [a]
: Maybe a -> [(Int, Int)]
b (a -> Maybe a
forall a. a -> Maybe a
Just a
ub)
Just Int
lastUb ->
let !lbPred :: Int
lbPred = Int -> Int -> Int
safeAdd Int
lb (-Int
1)
!lastUbSucc :: Int
lastUbSucc = Int -> Int -> Int
safeAdd Int
lastUb Int
1
proposedInterval :: (Int, Int)
proposedInterval = (Int
lastUbSucc, Int
lbPred)
in case (Int, Int) -> Bool
nullInterval (Int, Int)
proposedInterval of
Bool
True -> Maybe a -> [(Int, Int)]
b (a -> Maybe a
forall a. a -> Maybe a
Just a
ub)
Bool
False -> (Int, Int)
proposedInterval (Int, Int) -> [(Int, Int)] -> [(Int, Int)]
forall a. a -> [a] -> [a]
: Maybe a -> [(Int, Int)]
b (a -> Maybe a
forall a. a -> Maybe a
Just a
ub)
z :: Maybe Int -> [(Int, Int)]
z = \case
Maybe Int
Nothing -> [(Int
0, Int
forall a. Bounded a => a
maxBound)]
Just Int
prev -> case Int -> Maybe (Int, Int)
downTo Int
prev of
Maybe (Int, Int)
Nothing -> []
Just (Int, Int)
x -> [(Int, Int)
x]
intersection :: IntervalSet -> IntervalSet -> IntervalSet
intersection :: IntervalSet -> IntervalSet -> IntervalSet
intersection IntervalSet
a IntervalSet
b = IntervalSet -> IntervalSet -> IntervalSet
difference IntervalSet
a (IntervalSet -> IntervalSet
complement IntervalSet
b)
null :: IntervalSet -> Bool
null :: IntervalSet -> Bool
null = IntMap Int -> Bool
forall a. IntMap a -> Bool
IntMap.null (IntMap Int -> Bool)
-> (IntervalSet -> IntMap Int) -> IntervalSet -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntervalSet -> IntMap Int
unIntervalSet
extractSingleton :: IntervalSet -> Maybe Int
(IntervalSet IntMap Int
m) = case IntMap Int -> [(Int, Int)]
forall a. IntMap a -> [(Int, a)]
IntMap.toList IntMap Int
m of
[(Int
lb, Int
ub)]
| Int
lb Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
ub -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
lb
[(Int, Int)]
_ -> Maybe Int
forall a. Maybe a
Nothing
safeAdd :: Int -> Int -> Int
safeAdd :: Int -> Int -> Int
safeAdd Int
a Int
b =
let c :: Int
c = Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
b
in case Int
a Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Int
b Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 of
Bool
True -> case Int
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 of
Bool
True -> Int
forall a. Bounded a => a
maxBound
Bool
False -> Int
c
Bool
False -> case Int
a Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
&& Int
b Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 of
Bool
True -> case Int
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 of
Bool
True -> Int
forall a. Bounded a => a
minBound
Bool
False -> Int
c
Bool
False -> Int
c
difference :: IntervalSet -> IntervalSet -> IntervalSet
difference :: IntervalSet -> IntervalSet -> IntervalSet
difference IntervalSet
x (IntervalSet IntMap Int
y) = (IntervalSet -> Int -> Int -> IntervalSet)
-> IntervalSet -> IntMap Int -> IntervalSet
forall a b. (a -> Int -> b -> a) -> a -> IntMap b -> a
IntMap.foldlWithKey' (\IntervalSet
b Int
k Int
v -> (Int, Int) -> IntervalSet -> IntervalSet
delete (Int
k, Int
v) IntervalSet
b) IntervalSet
x IntMap Int
y
upTo :: Int -> Maybe (Int, Int)
upTo :: Int -> Maybe (Int, Int)
upTo Int
lb = case Int
lb Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 of
Bool
True -> Maybe (Int, Int)
forall a. Maybe a
Nothing
Bool
False -> (Int, Int) -> Maybe (Int, Int)
forall a. a -> Maybe a
Just (Int
0, Int -> Int -> Int
safeAdd Int
lb (-Int
1))
downTo :: Int -> Maybe (Int, Int)
downTo :: Int -> Maybe (Int, Int)
downTo Int
ub = case Int
ub Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
forall a. Bounded a => a
maxBound of
Bool
True -> Maybe (Int, Int)
forall a. Maybe a
Nothing
Bool
False -> (Int, Int) -> Maybe (Int, Int)
forall a. a -> Maybe a
Just (Int -> Int -> Int
safeAdd Int
ub Int
1, Int
forall a. Bounded a => a
maxBound)
nullInterval :: (Int, Int) -> Bool
nullInterval :: (Int, Int) -> Bool
nullInterval (Int
lb, Int
ub) = Int
ub Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
lb
fromAscList :: [(Int, Int)] -> IntervalSet
fromAscList :: [(Int, Int)] -> IntervalSet
fromAscList = IntMap Int -> IntervalSet
IntervalSet (IntMap Int -> IntervalSet)
-> ([(Int, Int)] -> IntMap Int) -> [(Int, Int)] -> IntervalSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Int, Int)] -> IntMap Int
forall a. [(Int, a)] -> IntMap a
IntMap.fromAscList ([(Int, Int)] -> IntMap Int)
-> ([(Int, Int)] -> [(Int, Int)]) -> [(Int, Int)] -> IntMap Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Int, Int)] -> [(Int, Int)]
mergeOverlappingAscList
fromList :: [(Int, Int)] -> IntervalSet
fromList :: [(Int, Int)] -> IntervalSet
fromList = [(Int, Int)] -> IntervalSet
fromAscList ([(Int, Int)] -> IntervalSet)
-> ([(Int, Int)] -> [(Int, Int)]) -> [(Int, Int)] -> IntervalSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Int) -> Int) -> [(Int, Int)] -> [(Int, Int)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Int, Int) -> Int
forall a b. (a, b) -> a
fst ([(Int, Int)] -> [(Int, Int)])
-> ([(Int, Int)] -> [(Int, Int)]) -> [(Int, Int)] -> [(Int, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Int) -> Bool) -> [(Int, Int)] -> [(Int, Int)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> ((Int, Int) -> Bool) -> (Int, Int) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Int) -> Bool
nullInterval)
intersectIntervals :: (Int, Int) -> (Int, Int) -> Maybe (Int, Int)
intersectIntervals :: (Int, Int) -> (Int, Int) -> Maybe (Int, Int)
intersectIntervals (Int, Int)
a (Int, Int)
b
| (Int, Int) -> (Int, Int) -> Bool
doOverlap (Int, Int)
a (Int, Int)
b =
let !lb :: Int
lb = (Int -> Int -> Int)
-> ((Int, Int) -> Int) -> (Int, Int) -> (Int, Int) -> Int
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (Int, Int) -> Int
forall a b. (a, b) -> a
fst (Int, Int)
a (Int, Int)
b
!ub :: Int
ub = (Int -> Int -> Int)
-> ((Int, Int) -> Int) -> (Int, Int) -> (Int, Int) -> Int
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Int, Int) -> Int
forall a b. (a, b) -> b
snd (Int, Int)
a (Int, Int)
b
in (Int, Int) -> Maybe (Int, Int)
forall a. a -> Maybe a
Just (Int
lb, Int
ub)
| Bool
otherwise = Maybe (Int, Int)
forall a. Maybe a
Nothing
mergeOverlappingAscList :: [(Int, Int)] -> [(Int, Int)]
mergeOverlappingAscList :: [(Int, Int)] -> [(Int, Int)]
mergeOverlappingAscList = \case
(Int, Int)
x0 : (Int, Int)
x1 : [(Int, Int)]
xs -> case (Int, Int) -> (Int, Int) -> Bool
doOverlap (Int, Int)
x0 (Int, Int)
x1 of
Bool
True -> (Int, Int) -> (Int, Int) -> (Int, Int)
spanIntervals (Int, Int)
x0 (Int, Int)
x1 (Int, Int) -> [(Int, Int)] -> [(Int, Int)]
forall a. a -> [a] -> [a]
: [(Int, Int)] -> [(Int, Int)]
mergeOverlappingAscList [(Int, Int)]
xs
Bool
False -> (Int, Int)
x0 (Int, Int) -> [(Int, Int)] -> [(Int, Int)]
forall a. a -> [a] -> [a]
: (Int, Int)
x1 (Int, Int) -> [(Int, Int)] -> [(Int, Int)]
forall a. a -> [a] -> [a]
: [(Int, Int)] -> [(Int, Int)]
mergeOverlappingAscList [(Int, Int)]
xs
[(Int, Int)
x] -> [(Int, Int)
x]
[] -> []
doOverlap :: (Int, Int) -> (Int, Int) -> Bool
doOverlap :: (Int, Int) -> (Int, Int) -> Bool
doOverlap (Int
lb0, Int
ub0) (Int
lb1, Int
ub1)
| Int
ub0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
lb1 Bool -> Bool -> Bool
&& Int
lb0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
ub1 = Bool
True
| Bool
otherwise = Bool
False
spanIntervals :: (Int, Int) -> (Int, Int) -> (Int, Int)
spanIntervals :: (Int, Int) -> (Int, Int) -> (Int, Int)
spanIntervals (Int
lb0, Int
ub0) (Int
lb1, Int
ub1) =
let !lb :: Int
lb = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
lb0 Int
lb1
!ub :: Int
ub = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
ub0 Int
ub1
in (Int
lb, Int
ub)
splitLookupLE :: Int -> IntervalSet -> (IntervalSet, Maybe (Int, Int), IntervalSet)
splitLookupLE :: Int -> IntervalSet -> (IntervalSet, Maybe (Int, Int), IntervalSet)
splitLookupLE Int
k (IntervalSet IntMap Int
m) =
(IntMap Int, Maybe (Int, Int), IntMap Int)
-> (IntervalSet, Maybe (Int, Int), IntervalSet)
forall a b. Coercible a b => a -> b
coerce case Int -> IntMap Int -> (IntMap Int, Maybe Int, IntMap Int)
forall a. Int -> IntMap a -> (IntMap a, Maybe a, IntMap a)
IntMap.splitLookup Int
k IntMap Int
m of
(IntMap Int
smaller, Just Int
v, IntMap Int
larger) -> (IntMap Int
smaller, (Int, Int) -> Maybe (Int, Int)
forall a. a -> Maybe a
Just (Int
k, Int
v), IntMap Int
larger)
(IntMap Int
smaller, Maybe Int
Nothing, IntMap Int
larger) -> case IntMap Int -> Maybe ((Int, Int), IntMap Int)
forall a. IntMap a -> Maybe ((Int, a), IntMap a)
IntMap.maxViewWithKey IntMap Int
smaller of
Just ((Int
k, Int
v), IntMap Int
smaller) -> (IntMap Int
smaller, (Int, Int) -> Maybe (Int, Int)
forall a. a -> Maybe a
Just (Int
k, Int
v), IntMap Int
larger)
Maybe ((Int, Int), IntMap Int)
Nothing -> (IntMap Int
smaller, Maybe (Int, Int)
forall a. Maybe a
Nothing, IntMap Int
larger)