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 inclusive bounds interval into set
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
extractSingleton :: IntervalSet -> Maybe Int
extractSingleton (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

-- | add two integers, sticking to a bound if it would overflow
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

-- | the interval [0, lb)
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))

-- | the interval (ub, maxBound]
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

-- | merge a list sorted on the lower bound ascending
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)