-- |
-- Module      :  Data.IntervalMap.Generic.Base
-- Copyright   :  (c) Christoph Breitkopf 2014
-- License     :  BSD-style
-- Maintainer  :  chbreitkopf@gmail.com
-- Stability   :  experimental
-- Portability :  non-portable (MPTC with FD)
--
-- An implementation of maps from intervals to values. The key intervals may
-- overlap, and the implementation contains efficient search functions
-- for all keys containing a point or overlapping an interval.
-- Closed, open, and half-open intervals can be contained in the same map.
--
-- An IntervalMap cannot contain duplicate keys - if you need to map a key
-- to multiple values, use a collection as the value type, for
-- example: @IntervalMap /k/ [/v/]@.
--
-- It is an error to insert an empty interval into a map. This precondition is not
-- checked by the various construction functions.
--
-- Since many function names (but not the type name) clash with
-- /Prelude/ names, this module is usually imported @qualified@, e.g.
--
-- >  import Data.Generic.IntervalMap.Strict (IntervalMap)
-- >  import qualified Data.Generic.IntervalMap.Strict as IM
--
-- It offers most of the same functions as 'Data.Map', but the key type must be an
-- instance of 'Interval'.
-- Some functions differ in asymptotic performance (for example 'size') or have not
-- been tuned for efficiency as much as their equivalents in 'Data.Map' (in
-- particular the various set functions).
--
-- In addition, there are functions specific to maps of intervals, for example to search
-- for all keys containing a given point or contained in a given interval.
--
-- The implementation is a red-black tree augmented with the maximum upper bound
-- of all keys.
--
-- Parts of this implementation are based on code from the 'Data.Map' implementation,
-- (c) Daan Leijen 2002, (c) Andriy Palamarchuk 2008.
-- The red-black tree deletion is based on code from llrbtree by Kazu Yamamoto.
-- Of course, any errors are mine.
--
{-# LANGUAGE UndecidableInstances #-}
module Data.IntervalMap.Generic.Base (
            -- * re-export
            Interval(..)
            -- * Map type
            , IntervalMap(..)      -- instance Eq,Show,Read

            -- * Operators
            , (!), (\\)

            -- * Query
            , null
            , size
            , member
            , notMember
            , lookup
            , findWithDefault
            , lookupLT
            , lookupGT
            , lookupLE
            , lookupGE

            -- ** Interval query
            , containing
            , intersecting
            , within
            
            -- * Construction
            , empty
            , singleton

            -- ** Insertion
            , insert
            , insertWith
            , insertWithKey
            , insertLookupWithKey
            
            -- ** Delete\/Update
            , delete
            , adjust
            , adjustWithKey
            , update
            , updateWithKey
            , updateLookupWithKey
            , alter

            -- * Combine

            -- ** Union
            , union
            , unionWith
            , unionWithKey
            , unions
            , unionsWith

            -- ** Difference
            , difference
            , differenceWith
            , differenceWithKey
            
            -- ** Intersection
            , intersection
            , intersectionWith
            , intersectionWithKey

            -- * Traversal
            -- ** Map
            , map
            , mapWithKey
            , mapAccum
            , mapAccumWithKey
            , mapAccumRWithKey
            , mapKeys
            , mapKeysWith
            , mapKeysMonotonic

            -- ** Fold
            , foldr, foldl
            , foldrWithKey, foldlWithKey
            , foldl', foldr'
            , foldrWithKey', foldlWithKey'

            -- * Flatten
            , flattenWith, flattenWithMonotonic

            -- * Conversion
            , elems
            , keys
            , keysSet
            , assocs

            -- ** Lists
            , toList
            , fromList
            , fromListWith
            , fromListWithKey

            -- ** Ordered lists
            , toAscList
            , toDescList
            , fromAscList
            , fromAscListWith
            , fromAscListWithKey
            , fromDistinctAscList

            -- * Filter
            , filter
            , filterWithKey
            , partition
            , partitionWithKey

            , mapMaybe
            , mapMaybeWithKey
            , mapEither
            , mapEitherWithKey

            , split
            , splitLookup
            , splitAt
            , splitIntersecting

            -- * Submap
            , isSubmapOf, isSubmapOfBy
            , isProperSubmapOf, isProperSubmapOfBy

            -- * Min\/Max
            , findMin
            , findMax
            , lookupMin
            , lookupMax
            , findLast
            , lookupLast
            , deleteMin
            , deleteMax
            , deleteFindMin
            , deleteFindMax
            , updateMin
            , updateMax
            , updateMinWithKey
            , updateMaxWithKey
            , minView
            , maxView
            , minViewWithKey
            , maxViewWithKey

            -- * Internal, not re-exported by Data.IntervalMap.{Lazy,Strict}
            , Color(..)
            , balanceL, balanceR
            , turnBlack
            , setMinValue, setMaxValue

            -- * Debugging
            , valid

            -- * Testing
            , height, maxHeight, showStats

            ) where

import Prelude hiding (Foldable(..), lookup, map, filter, splitAt)
import Data.Maybe (fromMaybe, fromJust)
import Data.Bits (shiftR, (.&.))
import qualified Data.Semigroup as Sem
import Data.Monoid (Monoid(..))
import Control.Applicative (Applicative(..), (<$>), (<|>))
import Data.Traversable (Traversable(traverse))
import qualified Data.Foldable as Foldable
import qualified Data.List as L
import qualified Data.Set as Set
import Control.DeepSeq

import Data.IntervalMap.Generic.Interval

{--------------------------------------------------------------------
  Operators
--------------------------------------------------------------------}
infixl 9 !,\\ --

-- | /O(log n)/. Lookup value for given key. Calls 'error' if the key is not in the map.
--
-- Use 'lookup' or 'findWithDefault' instead of this function, unless you are absolutely
-- sure that the key is present in the map.
(!) :: (Ord k) => IntervalMap k v -> k -> v
IntervalMap k v
tree ! :: forall k v. Ord k => IntervalMap k v -> k -> v
! k
key = v -> Maybe v -> v
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> v
forall a. HasCallStack => [Char] -> a
error [Char]
"IntervalMap.!: key not found") (k -> IntervalMap k v -> Maybe v
forall k v. Ord k => k -> IntervalMap k v -> Maybe v
lookup k
key IntervalMap k v
tree)

-- | Same as 'difference'.
(\\) :: (Interval k e, Ord k) => IntervalMap k a -> IntervalMap k b -> IntervalMap k a
IntervalMap k a
m1 \\ :: forall k e a b.
(Interval k e, Ord k) =>
IntervalMap k a -> IntervalMap k b -> IntervalMap k a
\\ IntervalMap k b
m2 = IntervalMap k a -> IntervalMap k b -> IntervalMap k a
forall k e a b.
(Interval k e, Ord k) =>
IntervalMap k a -> IntervalMap k b -> IntervalMap k a
difference IntervalMap k a
m1 IntervalMap k b
m2


data Color = R | B deriving (Color -> Color -> Bool
(Color -> Color -> Bool) -> (Color -> Color -> Bool) -> Eq Color
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Color -> Color -> Bool
== :: Color -> Color -> Bool
$c/= :: Color -> Color -> Bool
/= :: Color -> Color -> Bool
Eq, ReadPrec [Color]
ReadPrec Color
Int -> ReadS Color
ReadS [Color]
(Int -> ReadS Color)
-> ReadS [Color]
-> ReadPrec Color
-> ReadPrec [Color]
-> Read Color
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Color
readsPrec :: Int -> ReadS Color
$creadList :: ReadS [Color]
readList :: ReadS [Color]
$creadPrec :: ReadPrec Color
readPrec :: ReadPrec Color
$creadListPrec :: ReadPrec [Color]
readListPrec :: ReadPrec [Color]
Read, Int -> Color -> ShowS
[Color] -> ShowS
Color -> [Char]
(Int -> Color -> ShowS)
-> (Color -> [Char]) -> ([Color] -> ShowS) -> Show Color
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Color -> ShowS
showsPrec :: Int -> Color -> ShowS
$cshow :: Color -> [Char]
show :: Color -> [Char]
$cshowList :: [Color] -> ShowS
showList :: [Color] -> ShowS
Show)

-- | A map from intervals of type @k@ to values of type @v@.
data IntervalMap k v = Nil
                      | Node !Color
                             !k -- key
                             !k -- interval with maximum upper in tree
                             v             -- value
                             !(IntervalMap k v) -- left subtree
                             !(IntervalMap k v) -- right subtree

instance (Eq k, Eq v) => Eq (IntervalMap k v) where
  IntervalMap k v
a == :: IntervalMap k v -> IntervalMap k v -> Bool
== IntervalMap k v
b = IntervalMap k v -> [(k, v)]
forall k v. IntervalMap k v -> [(k, v)]
toAscList IntervalMap k v
a [(k, v)] -> [(k, v)] -> Bool
forall a. Eq a => a -> a -> Bool
== IntervalMap k v -> [(k, v)]
forall k v. IntervalMap k v -> [(k, v)]
toAscList IntervalMap k v
b

instance (Ord k, Ord v) => Ord (IntervalMap k v) where
  compare :: IntervalMap k v -> IntervalMap k v -> Ordering
compare IntervalMap k v
a IntervalMap k v
b = [(k, v)] -> [(k, v)] -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (IntervalMap k v -> [(k, v)]
forall k v. IntervalMap k v -> [(k, v)]
toAscList IntervalMap k v
a) (IntervalMap k v -> [(k, v)]
forall k v. IntervalMap k v -> [(k, v)]
toAscList IntervalMap k v
b)

instance Functor (IntervalMap k) where
  fmap :: forall a b. (a -> b) -> IntervalMap k a -> IntervalMap k b
fmap a -> b
f IntervalMap k a
m  = (a -> b) -> IntervalMap k a -> IntervalMap k b
forall a b k. (a -> b) -> IntervalMap k a -> IntervalMap k b
map a -> b
f IntervalMap k a
m

instance (Interval i k, Ord i) => Sem.Semigroup (IntervalMap i v) where
  <> :: IntervalMap i v -> IntervalMap i v -> IntervalMap i v
(<>) = IntervalMap i v -> IntervalMap i v -> IntervalMap i v
forall i k v.
(Interval i k, Ord i) =>
IntervalMap i v -> IntervalMap i v -> IntervalMap i v
union
  sconcat :: NonEmpty (IntervalMap i v) -> IntervalMap i v
sconcat = [IntervalMap i v] -> IntervalMap i v
forall k e a.
(Interval k e, Ord k) =>
[IntervalMap k a] -> IntervalMap k a
unions ([IntervalMap i v] -> IntervalMap i v)
-> (NonEmpty (IntervalMap i v) -> [IntervalMap i v])
-> NonEmpty (IntervalMap i v)
-> IntervalMap i v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (IntervalMap i v) -> [IntervalMap i v]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList
  stimes :: forall b. Integral b => b -> IntervalMap i v -> IntervalMap i v
stimes = b -> IntervalMap i v -> IntervalMap i v
forall b a. (Integral b, Monoid a) => b -> a -> a
Sem.stimesIdempotentMonoid

instance (Interval i k, Ord i) => Monoid (IntervalMap i v) where
    mempty :: IntervalMap i v
mempty  = IntervalMap i v
forall k v. IntervalMap k v
empty
    mappend :: IntervalMap i v -> IntervalMap i v -> IntervalMap i v
mappend = IntervalMap i v -> IntervalMap i v -> IntervalMap i v
forall a. Semigroup a => a -> a -> a
(Sem.<>)
    mconcat :: [IntervalMap i v] -> IntervalMap i v
mconcat = [IntervalMap i v] -> IntervalMap i v
forall k e a.
(Interval k e, Ord k) =>
[IntervalMap k a] -> IntervalMap k a
unions

instance Traversable (IntervalMap k) where
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> IntervalMap k a -> f (IntervalMap k b)
traverse a -> f b
_ IntervalMap k a
Nil = IntervalMap k b -> f (IntervalMap k b)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure IntervalMap k b
forall k v. IntervalMap k v
Nil
  traverse a -> f b
f (Node Color
c k
k k
m a
v IntervalMap k a
l IntervalMap k a
r)
    = (b -> IntervalMap k b -> IntervalMap k b -> IntervalMap k b)
-> IntervalMap k b -> b -> IntervalMap k b -> IntervalMap k b
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Color
-> k
-> k
-> b
-> IntervalMap k b
-> IntervalMap k b
-> IntervalMap k b
forall k v.
Color
-> k
-> k
-> v
-> IntervalMap k v
-> IntervalMap k v
-> IntervalMap k v
Node Color
c k
k k
m) (IntervalMap k b -> b -> IntervalMap k b -> IntervalMap k b)
-> f (IntervalMap k b)
-> f (b -> IntervalMap k b -> IntervalMap k b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> IntervalMap k a -> f (IntervalMap k b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> IntervalMap k a -> f (IntervalMap k b)
traverse a -> f b
f IntervalMap k a
l f (b -> IntervalMap k b -> IntervalMap k b)
-> f b -> f (IntervalMap k b -> IntervalMap k b)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f b
f a
v f (IntervalMap k b -> IntervalMap k b)
-> f (IntervalMap k b) -> f (IntervalMap k b)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (a -> f b) -> IntervalMap k a -> f (IntervalMap k b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> IntervalMap k a -> f (IntervalMap k b)
traverse a -> f b
f IntervalMap k a
r

instance Foldable.Foldable (IntervalMap k) where
  fold :: forall m. Monoid m => IntervalMap k m -> m
fold IntervalMap k m
Nil = m
forall a. Monoid a => a
mempty
  fold (Node Color
_ k
_ k
_ m
v IntervalMap k m
l IntervalMap k m
r) = IntervalMap k m -> m
forall m. Monoid m => IntervalMap k m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
Foldable.fold IntervalMap k m
l m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` m
v m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` IntervalMap k m -> m
forall m. Monoid m => IntervalMap k m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
Foldable.fold IntervalMap k m
r
  foldr :: forall a b. (a -> b -> b) -> b -> IntervalMap k a -> b
foldr = (a -> b -> b) -> b -> IntervalMap k a -> b
forall a b k. (a -> b -> b) -> b -> IntervalMap k a -> b
foldr
  foldl :: forall b a. (b -> a -> b) -> b -> IntervalMap k a -> b
foldl = (b -> a -> b) -> b -> IntervalMap k a -> b
forall b a k. (b -> a -> b) -> b -> IntervalMap k a -> b
foldl
  foldMap :: forall m a. Monoid m => (a -> m) -> IntervalMap k a -> m
foldMap a -> m
_ IntervalMap k a
Nil = m
forall a. Monoid a => a
mempty
  foldMap a -> m
f (Node Color
_ k
_ k
_ a
v IntervalMap k a
l IntervalMap k a
r) = (a -> m) -> IntervalMap k a -> m
forall m a. Monoid m => (a -> m) -> IntervalMap k a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
Foldable.foldMap a -> m
f IntervalMap k a
l m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` a -> m
f a
v m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` (a -> m) -> IntervalMap k a -> m
forall m a. Monoid m => (a -> m) -> IntervalMap k a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
Foldable.foldMap a -> m
f IntervalMap k a
r

instance (NFData k, NFData a) => NFData (IntervalMap k a) where
    rnf :: IntervalMap k a -> ()
rnf IntervalMap k a
Nil = ()
    rnf (Node Color
_ k
kx k
_ a
x IntervalMap k a
l IntervalMap k a
r) = k
kx k -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq` a
x a -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq` IntervalMap k a
l IntervalMap k a -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq` IntervalMap k a
r IntervalMap k a -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq` ()

instance (Read e, Interval i k, Ord i, Read i) => Read (IntervalMap i e) where
  readsPrec :: Int -> ReadS (IntervalMap i e)
readsPrec Int
p = Bool -> ReadS (IntervalMap i e) -> ReadS (IntervalMap i e)
forall a. Bool -> ReadS a -> ReadS a
readParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ReadS (IntervalMap i e) -> ReadS (IntervalMap i e))
-> ReadS (IntervalMap i e) -> ReadS (IntervalMap i e)
forall a b. (a -> b) -> a -> b
$ \ [Char]
r -> do
    ([Char]
"fromList",[Char]
s) <- ReadS [Char]
lex [Char]
r
    ([(i, e)]
xs,[Char]
t) <- ReadS [(i, e)]
forall a. Read a => ReadS a
reads [Char]
s
    (IntervalMap i e, [Char]) -> [(IntervalMap i e, [Char])]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(i, e)] -> IntervalMap i e
forall k e v. (Interval k e, Ord k) => [(k, v)] -> IntervalMap k v
fromList [(i, e)]
xs,[Char]
t)

instance (Show k, Show a) => Show (IntervalMap k a) where
  showsPrec :: Int -> IntervalMap k a -> ShowS
showsPrec Int
d IntervalMap k a
m  = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
    [Char] -> ShowS
showString [Char]
"fromList " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(k, a)] -> ShowS
forall a. Show a => a -> ShowS
shows (IntervalMap k a -> [(k, a)]
forall k v. IntervalMap k v -> [(k, v)]
toList IntervalMap k a
m)


isRed :: IntervalMap k v -> Bool
isRed :: forall k a. IntervalMap k a -> Bool
isRed (Node Color
R k
_ k
_ v
_ IntervalMap k v
_ IntervalMap k v
_) = Bool
True
isRed IntervalMap k v
_ = Bool
False

turnBlack :: IntervalMap k v -> IntervalMap k v
turnBlack :: forall k v. IntervalMap k v -> IntervalMap k v
turnBlack (Node Color
R k
k k
m v
vs IntervalMap k v
l IntervalMap k v
r) = Color
-> k
-> k
-> v
-> IntervalMap k v
-> IntervalMap k v
-> IntervalMap k v
forall k v.
Color
-> k
-> k
-> v
-> IntervalMap k v
-> IntervalMap k v
-> IntervalMap k v
Node Color
B k
k k
m v
vs IntervalMap k v
l IntervalMap k v
r
turnBlack IntervalMap k v
t = IntervalMap k v
t

turnRed :: IntervalMap k v -> IntervalMap k v
turnRed :: forall k v. IntervalMap k v -> IntervalMap k v
turnRed IntervalMap k v
Nil = [Char] -> IntervalMap k v
forall a. HasCallStack => [Char] -> a
error [Char]
"turnRed: Leaf"
turnRed (Node Color
B k
k k
m v
v IntervalMap k v
l IntervalMap k v
r) = Color
-> k
-> k
-> v
-> IntervalMap k v
-> IntervalMap k v
-> IntervalMap k v
forall k v.
Color
-> k
-> k
-> v
-> IntervalMap k v
-> IntervalMap k v
-> IntervalMap k v
Node Color
R k
k k
m v
v IntervalMap k v
l IntervalMap k v
r
turnRed IntervalMap k v
t = IntervalMap k v
t

-- construct node, recomputing the upper key bound.
mNode :: (Interval k e) => Color -> k -> v -> IntervalMap k v -> IntervalMap k v -> IntervalMap k v
mNode :: forall k e v.
Interval k e =>
Color
-> k -> v -> IntervalMap k v -> IntervalMap k v -> IntervalMap k v
mNode Color
c k
k v
v IntervalMap k v
l IntervalMap k v
r = Color
-> k
-> k
-> v
-> IntervalMap k v
-> IntervalMap k v
-> IntervalMap k v
forall k v.
Color
-> k
-> k
-> v
-> IntervalMap k v
-> IntervalMap k v
-> IntervalMap k v
Node Color
c k
k (k -> IntervalMap k v -> IntervalMap k v -> k
forall i k v.
Interval i k =>
i -> IntervalMap i v -> IntervalMap i v -> i
maxUpper k
k IntervalMap k v
l IntervalMap k v
r) v
v IntervalMap k v
l IntervalMap k v
r

maxUpper :: (Interval i k) => i -> IntervalMap i v -> IntervalMap i v -> i
maxUpper :: forall i k v.
Interval i k =>
i -> IntervalMap i v -> IntervalMap i v -> i
maxUpper i
k IntervalMap i v
Nil                IntervalMap i v
Nil                = i
k
maxUpper i
k IntervalMap i v
Nil                (Node Color
_ i
_ i
m v
_ IntervalMap i v
_ IntervalMap i v
_) = i -> i -> i
forall i e. Interval i e => i -> i -> i
maxByUpper i
k i
m
maxUpper i
k (Node Color
_ i
_ i
m v
_ IntervalMap i v
_ IntervalMap i v
_) IntervalMap i v
Nil                = i -> i -> i
forall i e. Interval i e => i -> i -> i
maxByUpper i
k i
m
maxUpper i
k (Node Color
_ i
_ i
l v
_ IntervalMap i v
_ IntervalMap i v
_) (Node Color
_ i
_ i
r v
_ IntervalMap i v
_ IntervalMap i v
_) = i -> i -> i
forall i e. Interval i e => i -> i -> i
maxByUpper i
k (i -> i -> i
forall i e. Interval i e => i -> i -> i
maxByUpper i
l i
r)

-- interval with the greatest upper bound. The lower bound is ignored!
maxByUpper :: (Interval i e) => i -> i -> i
maxByUpper :: forall i e. Interval i e => i -> i -> i
maxByUpper i
a i
b = i
a i -> i -> i
forall a b. a -> b -> b
`seq` i
b i -> i -> i
forall a b. a -> b -> b
`seq`
                 case i -> i -> Ordering
forall i e. Interval i e => i -> i -> Ordering
compareUpperBounds i
a i
b of
                   Ordering
LT -> i
b
                   Ordering
_  -> i
a

-- ---------------------------------------------------------

-- | /O(1)/. The empty map.
empty :: IntervalMap k v
empty :: forall k v. IntervalMap k v
empty =  IntervalMap k v
forall k v. IntervalMap k v
Nil

-- | /O(1)/. A map with one entry.
singleton :: k -> v -> IntervalMap k v
singleton :: forall k v. k -> v -> IntervalMap k v
singleton k
k v
v = Color
-> k
-> k
-> v
-> IntervalMap k v
-> IntervalMap k v
-> IntervalMap k v
forall k v.
Color
-> k
-> k
-> v
-> IntervalMap k v
-> IntervalMap k v
-> IntervalMap k v
Node Color
B k
k k
k v
v IntervalMap k v
forall k v. IntervalMap k v
Nil IntervalMap k v
forall k v. IntervalMap k v
Nil


-- | /O(1)/. Is the map empty?
null :: IntervalMap k v -> Bool
null :: forall k a. IntervalMap k a -> Bool
null IntervalMap k v
Nil = Bool
True
null IntervalMap k v
_   = Bool
False

-- | /O(n)/. Number of keys in the map.
--
-- Caution: unlike 'Data.Map.size', which takes constant time, this is linear in the
-- number of keys!
size :: IntervalMap k v -> Int
size :: forall k a. IntervalMap k a -> Int
size IntervalMap k v
t = Int -> IntervalMap k v -> Int
forall {t} {k} {v}. Num t => t -> IntervalMap k v -> t
h Int
0 IntervalMap k v
t
  where
    h :: t -> IntervalMap k v -> t
h t
n IntervalMap k v
m = t
n t -> t -> t
forall a b. a -> b -> b
`seq` case IntervalMap k v
m of
                      IntervalMap k v
Nil -> t
n
                      Node Color
_ k
_ k
_ v
_ IntervalMap k v
l IntervalMap k v
r -> t -> IntervalMap k v -> t
h (t -> IntervalMap k v -> t
h t
n IntervalMap k v
l t -> t -> t
forall a. Num a => a -> a -> a
+ t
1) IntervalMap k v
r

-- | The height of the tree. For testing/debugging only.
height :: IntervalMap k v -> Int
height :: forall k a. IntervalMap k a -> Int
height IntervalMap k v
Nil = Int
0
height (Node Color
_ k
_ k
_ v
_ IntervalMap k v
l IntervalMap k v
r) = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (IntervalMap k v -> Int
forall k a. IntervalMap k a -> Int
height IntervalMap k v
l) (IntervalMap k v -> Int
forall k a. IntervalMap k a -> Int
height IntervalMap k v
r)

-- | The maximum height of a red-black tree with the given number of nodes.
-- For testing/debugging only.
maxHeight :: Int -> Int
maxHeight :: Int -> Int
maxHeight Int
nodes = Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int -> Int
log2 (Int
nodes Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

-- | Tree statistics (size, height, maxHeight size).
-- For testing/debugging only.
showStats :: IntervalMap k a -> (Int, Int, Int)
showStats :: forall k a. IntervalMap k a -> (Int, Int, Int)
showStats IntervalMap k a
m = (Int
n, IntervalMap k a -> Int
forall k a. IntervalMap k a -> Int
height IntervalMap k a
m, Int -> Int
maxHeight Int
n)
  where n :: Int
n = IntervalMap k a -> Int
forall k a. IntervalMap k a -> Int
size IntervalMap k a
m

-- | /O(log n)/. Does the map contain the given key? See also 'notMember'.
member :: (Ord k) => k -> IntervalMap k v -> Bool
member :: forall k v. Ord k => k -> IntervalMap k v -> Bool
member k
key IntervalMap k v
tree = case k -> IntervalMap k v -> Maybe v
forall k v. Ord k => k -> IntervalMap k v -> Maybe v
lookup k
key IntervalMap k v
tree of
                    Maybe v
Nothing -> Bool
False
                    Just v
_  -> Bool
True

-- | /O(log n)/. Does the map not contain the given key? See also 'member'.
notMember :: (Ord k) => k -> IntervalMap k v -> Bool
notMember :: forall k v. Ord k => k -> IntervalMap k v -> Bool
notMember k
key IntervalMap k v
tree = Bool -> Bool
not (k -> IntervalMap k v -> Bool
forall k v. Ord k => k -> IntervalMap k v -> Bool
member k
key IntervalMap k v
tree)


-- | /O(log n)/. Look up the given key in the map, returning the value @('Just' value)@,
-- or 'Nothing' if the key is not in the map.
lookup :: (Ord k) => k -> IntervalMap k v -> Maybe v
lookup :: forall k v. Ord k => k -> IntervalMap k v -> Maybe v
lookup k
k IntervalMap k v
Nil =  k
k k -> Maybe v -> Maybe v
forall a b. a -> b -> b
`seq` Maybe v
forall a. Maybe a
Nothing
lookup k
k (Node Color
_ k
key k
_ v
v IntervalMap k v
l IntervalMap k v
r) = case k -> k -> Ordering
forall a. Ord a => a -> a -> Ordering
compare k
k k
key of
                                  Ordering
LT -> k -> IntervalMap k v -> Maybe v
forall k v. Ord k => k -> IntervalMap k v -> Maybe v
lookup k
k IntervalMap k v
l
                                  Ordering
GT -> k -> IntervalMap k v -> Maybe v
forall k v. Ord k => k -> IntervalMap k v -> Maybe v
lookup k
k IntervalMap k v
r
                                  Ordering
EQ -> v -> Maybe v
forall a. a -> Maybe a
Just v
v


-- | /O(log n)/. The expression @('findWithDefault' def k map)@ returns
-- the value at key @k@ or returns default value @def@
-- when the key is not in the map.
findWithDefault :: Ord k => a -> k -> IntervalMap k a -> a
findWithDefault :: forall k a. Ord k => a -> k -> IntervalMap k a -> a
findWithDefault a
def k
k IntervalMap k a
m = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
def (k -> IntervalMap k a -> Maybe a
forall k v. Ord k => k -> IntervalMap k v -> Maybe v
lookup k
k IntervalMap k a
m)

-- | /O(log n)/. Find the largest key smaller than the given one
-- and return it along with its value.
lookupLT :: (Ord k) => k -> IntervalMap k v -> Maybe (k,v)
lookupLT :: forall k v. Ord k => k -> IntervalMap k v -> Maybe (k, v)
lookupLT k
k IntervalMap k v
m = IntervalMap k v -> Maybe (k, v)
forall {t}. IntervalMap k t -> Maybe (k, t)
go IntervalMap k v
m
  where
    go :: IntervalMap k t -> Maybe (k, t)
go IntervalMap k t
Nil = Maybe (k, t)
forall a. Maybe a
Nothing
    go (Node Color
_ k
key k
_ t
v IntervalMap k t
l IntervalMap k t
r) | k
k k -> k -> Bool
forall a. Ord a => a -> a -> Bool
<= k
key  = IntervalMap k t -> Maybe (k, t)
go IntervalMap k t
l
                            | Bool
otherwise = k -> t -> IntervalMap k t -> Maybe (k, t)
forall {t}. k -> t -> IntervalMap k t -> Maybe (k, t)
go1 k
key t
v IntervalMap k t
r
    go1 :: k -> t -> IntervalMap k t -> Maybe (k, t)
go1 k
rk t
rv IntervalMap k t
Nil = (k, t) -> Maybe (k, t)
forall a. a -> Maybe a
Just (k
rk,t
rv)
    go1 k
rk t
rv (Node Color
_ k
key k
_ t
v IntervalMap k t
l IntervalMap k t
r) | k
k k -> k -> Bool
forall a. Ord a => a -> a -> Bool
<= k
key  = k -> t -> IntervalMap k t -> Maybe (k, t)
go1 k
rk t
rv IntervalMap k t
l
                                   | Bool
otherwise = k -> t -> IntervalMap k t -> Maybe (k, t)
go1 k
key t
v IntervalMap k t
r

-- | /O(log n)/. Find the smallest key larger than the given one
-- and return it along with its value.
lookupGT :: (Ord k) => k -> IntervalMap k v -> Maybe (k,v)
lookupGT :: forall k v. Ord k => k -> IntervalMap k v -> Maybe (k, v)
lookupGT k
k IntervalMap k v
m = IntervalMap k v -> Maybe (k, v)
forall {t}. IntervalMap k t -> Maybe (k, t)
go IntervalMap k v
m
  where
    go :: IntervalMap k t -> Maybe (k, t)
go IntervalMap k t
Nil = Maybe (k, t)
forall a. Maybe a
Nothing
    go (Node Color
_ k
key k
_ t
v IntervalMap k t
l IntervalMap k t
r) | k
k k -> k -> Bool
forall a. Ord a => a -> a -> Bool
>= k
key  = IntervalMap k t -> Maybe (k, t)
go IntervalMap k t
r
                            | Bool
otherwise = k -> t -> IntervalMap k t -> Maybe (k, t)
forall {t}. k -> t -> IntervalMap k t -> Maybe (k, t)
go1 k
key t
v IntervalMap k t
l
    go1 :: k -> t -> IntervalMap k t -> Maybe (k, t)
go1 k
rk t
rv IntervalMap k t
Nil = (k, t) -> Maybe (k, t)
forall a. a -> Maybe a
Just (k
rk,t
rv)
    go1 k
rk t
rv (Node Color
_ k
key k
_ t
v IntervalMap k t
l IntervalMap k t
r) | k
k k -> k -> Bool
forall a. Ord a => a -> a -> Bool
>= k
key  = k -> t -> IntervalMap k t -> Maybe (k, t)
go1 k
rk t
rv IntervalMap k t
r
                                   | Bool
otherwise = k -> t -> IntervalMap k t -> Maybe (k, t)
go1 k
key t
v IntervalMap k t
l

-- | /O(log n)/. Find the largest key equal to or smaller than the given one
-- and return it along with its value.
lookupLE :: (Ord k) => k -> IntervalMap k v -> Maybe (k,v)
lookupLE :: forall k v. Ord k => k -> IntervalMap k v -> Maybe (k, v)
lookupLE k
k IntervalMap k v
m = IntervalMap k v -> Maybe (k, v)
forall {b}. IntervalMap k b -> Maybe (k, b)
go IntervalMap k v
m
  where
    go :: IntervalMap k b -> Maybe (k, b)
go IntervalMap k b
Nil = Maybe (k, b)
forall a. Maybe a
Nothing
    go (Node Color
_ k
key k
_ b
v IntervalMap k b
l IntervalMap k b
r) = case k -> k -> Ordering
forall a. Ord a => a -> a -> Ordering
compare k
k k
key of
                                Ordering
LT -> IntervalMap k b -> Maybe (k, b)
go IntervalMap k b
l
                                Ordering
EQ -> (k, b) -> Maybe (k, b)
forall a. a -> Maybe a
Just (k
key,b
v)
                                Ordering
GT -> k -> b -> IntervalMap k b -> Maybe (k, b)
forall {t}. k -> t -> IntervalMap k t -> Maybe (k, t)
go1 k
key b
v IntervalMap k b
r
    go1 :: k -> t -> IntervalMap k t -> Maybe (k, t)
go1 k
rk t
rv IntervalMap k t
Nil = (k, t) -> Maybe (k, t)
forall a. a -> Maybe a
Just (k
rk,t
rv)
    go1 k
rk t
rv (Node Color
_ k
key k
_ t
v IntervalMap k t
l IntervalMap k t
r) = case k -> k -> Ordering
forall a. Ord a => a -> a -> Ordering
compare k
k k
key of
                                       Ordering
LT -> k -> t -> IntervalMap k t -> Maybe (k, t)
go1 k
rk t
rv IntervalMap k t
l
                                       Ordering
EQ -> (k, t) -> Maybe (k, t)
forall a. a -> Maybe a
Just (k
key,t
v)
                                       Ordering
GT -> k -> t -> IntervalMap k t -> Maybe (k, t)
go1 k
key t
v IntervalMap k t
r

-- | /O(log n)/. Find the smallest key equal to or larger than the given one
-- and return it along with its value.
lookupGE :: (Ord k) => k -> IntervalMap k v -> Maybe (k,v)
lookupGE :: forall k v. Ord k => k -> IntervalMap k v -> Maybe (k, v)
lookupGE k
k IntervalMap k v
m = IntervalMap k v -> Maybe (k, v)
forall {b}. IntervalMap k b -> Maybe (k, b)
go IntervalMap k v
m
  where
    go :: IntervalMap k b -> Maybe (k, b)
go IntervalMap k b
Nil = Maybe (k, b)
forall a. Maybe a
Nothing
    go (Node Color
_ k
key k
_ b
v IntervalMap k b
l IntervalMap k b
r) = case k -> k -> Ordering
forall a. Ord a => a -> a -> Ordering
compare k
k k
key of
                                Ordering
LT -> k -> b -> IntervalMap k b -> Maybe (k, b)
forall {b}. k -> b -> IntervalMap k b -> Maybe (k, b)
go1 k
key b
v IntervalMap k b
l
                                Ordering
EQ -> (k, b) -> Maybe (k, b)
forall a. a -> Maybe a
Just (k
key,b
v)
                                Ordering
GT -> IntervalMap k b -> Maybe (k, b)
go IntervalMap k b
r
    go1 :: k -> b -> IntervalMap k b -> Maybe (k, b)
go1 k
rk b
rv IntervalMap k b
Nil = (k, b) -> Maybe (k, b)
forall a. a -> Maybe a
Just (k
rk,b
rv)
    go1 k
rk b
rv (Node Color
_ k
key k
_ b
v IntervalMap k b
l IntervalMap k b
r) = case k -> k -> Ordering
forall a. Ord a => a -> a -> Ordering
compare k
k k
key of
                                       Ordering
LT -> k -> b -> IntervalMap k b -> Maybe (k, b)
go1 k
key b
v IntervalMap k b
l
                                       Ordering
EQ -> (k, b) -> Maybe (k, b)
forall a. a -> Maybe a
Just (k
key,b
v)
                                       Ordering
GT -> k -> b -> IntervalMap k b -> Maybe (k, b)
go1 k
rk b
rv IntervalMap k b
r

-- | Return the submap of key intervals containing the given point.
-- This is the second element of the value of 'splitAt':
--
-- > m `containing` p == let (_,m',_) = m `splitAt` p in m'
--
-- /O(n)/, since potentially all keys could contain the point.
-- /O(log n)/ average case. This is also the worst case for maps containing no overlapping keys.
containing :: (Interval k e) => IntervalMap k v -> e -> IntervalMap k v
IntervalMap k v
t containing :: forall k e v.
Interval k e =>
IntervalMap k v -> e -> IntervalMap k v
`containing` e
pt = e
pt e -> IntervalMap k v -> IntervalMap k v
forall a b. a -> b -> b
`seq` [(k, v)] -> IntervalMap k v
forall k e v. Interval k e => [(k, v)] -> IntervalMap k v
fromDistinctAscList ([(k, v)] -> e -> IntervalMap k v -> [(k, v)]
forall {a} {e} {b}.
Interval a e =>
[(a, b)] -> e -> IntervalMap a b -> [(a, b)]
go [] e
pt IntervalMap k v
t)
  where
    go :: [(a, b)] -> e -> IntervalMap a b -> [(a, b)]
go [(a, b)]
xs e
_ IntervalMap a b
Nil = [(a, b)]
xs
    go [(a, b)]
xs e
p (Node Color
_ a
k a
m b
v IntervalMap a b
l IntervalMap a b
r)
       | e
p e -> a -> Bool
forall i e. Interval i e => e -> i -> Bool
`above` a
m  =  [(a, b)]
xs         -- above all intervals in the tree: no result
       | e
p e -> a -> Bool
forall i e. Interval i e => e -> i -> Bool
`below` a
k  =  [(a, b)] -> e -> IntervalMap a b -> [(a, b)]
go [(a, b)]
xs e
p IntervalMap a b
l  -- to the left of the lower bound: can't be in right subtree
       | e
p e -> a -> Bool
forall i e. Interval i e => e -> i -> Bool
`inside` a
k =  [(a, b)] -> e -> IntervalMap a b -> [(a, b)]
go ((a
k,b
v) (a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
: [(a, b)] -> e -> IntervalMap a b -> [(a, b)]
go [(a, b)]
xs e
p IntervalMap a b
r) e
p IntervalMap a b
l
       | Bool
otherwise    =  [(a, b)] -> e -> IntervalMap a b -> [(a, b)]
go ([(a, b)] -> e -> IntervalMap a b -> [(a, b)]
go [(a, b)]
xs e
p IntervalMap a b
r) e
p IntervalMap a b
l

-- | Return the submap of key intervals overlapping (intersecting) the given interval.
-- This is the second element of the value of 'splitIntersecting':
--
-- > m `intersecting` i == let (_,m',_) = m `splitIntersecting` i in m'
--
-- /O(n)/, since potentially all keys could intersect the interval.
-- /O(log n)/ average case, if few keys intersect the interval.
intersecting :: (Interval k e) => IntervalMap k v -> k -> IntervalMap k v
IntervalMap k v
t intersecting :: forall k e v.
Interval k e =>
IntervalMap k v -> k -> IntervalMap k v
`intersecting` k
iv = k
iv k -> IntervalMap k v -> IntervalMap k v
forall a b. a -> b -> b
`seq` [(k, v)] -> IntervalMap k v
forall k e v. Interval k e => [(k, v)] -> IntervalMap k v
fromDistinctAscList ([(k, v)] -> k -> IntervalMap k v -> [(k, v)]
forall {a} {e} {b}.
Interval a e =>
[(a, b)] -> a -> IntervalMap a b -> [(a, b)]
go [] k
iv IntervalMap k v
t)
  where
    go :: [(a, b)] -> a -> IntervalMap a b -> [(a, b)]
go [(a, b)]
xs a
_ IntervalMap a b
Nil = [(a, b)]
xs
    go [(a, b)]
xs a
i (Node Color
_ a
k a
m b
v IntervalMap a b
l IntervalMap a b
r)
       | a
i a -> a -> Bool
forall i e. Interval i e => i -> i -> Bool
`after` a
m     =  [(a, b)]
xs
       | a
i a -> a -> Bool
forall i e. Interval i e => i -> i -> Bool
`before` a
k    =  [(a, b)] -> a -> IntervalMap a b -> [(a, b)]
go [(a, b)]
xs a
i IntervalMap a b
l
       | a
i a -> a -> Bool
forall i e. Interval i e => i -> i -> Bool
`overlaps` a
k  =  [(a, b)] -> a -> IntervalMap a b -> [(a, b)]
go ((a
k,b
v) (a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
: [(a, b)] -> a -> IntervalMap a b -> [(a, b)]
go [(a, b)]
xs a
i IntervalMap a b
r) a
i IntervalMap a b
l
       | Bool
otherwise       =  [(a, b)] -> a -> IntervalMap a b -> [(a, b)]
go ([(a, b)] -> a -> IntervalMap a b -> [(a, b)]
go [(a, b)]
xs a
i IntervalMap a b
r) a
i IntervalMap a b
l

-- | Return the submap of key intervals completely inside the given interval.
--
-- /O(n)/, since potentially all keys could be inside the interval.
-- /O(log n)/ average case, if few keys are inside the interval.
within :: (Interval k e) => IntervalMap k v -> k -> IntervalMap k v
IntervalMap k v
t within :: forall k e v.
Interval k e =>
IntervalMap k v -> k -> IntervalMap k v
`within` k
iv = k
iv k -> IntervalMap k v -> IntervalMap k v
forall a b. a -> b -> b
`seq` [(k, v)] -> IntervalMap k v
forall k e v. Interval k e => [(k, v)] -> IntervalMap k v
fromDistinctAscList ([(k, v)] -> k -> IntervalMap k v -> [(k, v)]
forall {a} {e} {b}.
Interval a e =>
[(a, b)] -> a -> IntervalMap a b -> [(a, b)]
go [] k
iv IntervalMap k v
t)
  where
    go :: [(a, b)] -> a -> IntervalMap a b -> [(a, b)]
go [(a, b)]
xs a
_ IntervalMap a b
Nil = [(a, b)]
xs
    go [(a, b)]
xs a
i (Node Color
_ a
k a
m b
v IntervalMap a b
l IntervalMap a b
r)
       | a
i a -> a -> Bool
forall i e. Interval i e => i -> i -> Bool
`after` a
m     =  [(a, b)]
xs
       | a
i a -> a -> Bool
forall i e. Interval i e => i -> i -> Bool
`before` a
k    =  [(a, b)] -> a -> IntervalMap a b -> [(a, b)]
go [(a, b)]
xs a
i IntervalMap a b
l
       | a
i a -> a -> Bool
forall i e. Interval i e => i -> i -> Bool
`subsumes` a
k  =  [(a, b)] -> a -> IntervalMap a b -> [(a, b)]
go ((a
k,b
v) (a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
: [(a, b)] -> a -> IntervalMap a b -> [(a, b)]
go [(a, b)]
xs a
i IntervalMap a b
r) a
i IntervalMap a b
l
       | Bool
otherwise       =  [(a, b)] -> a -> IntervalMap a b -> [(a, b)]
go ([(a, b)] -> a -> IntervalMap a b -> [(a, b)]
go [(a, b)]
xs a
i IntervalMap a b
r) a
i IntervalMap a b
l


-- | /O(log n)/. Insert a new key/value pair. If the map already contains the key, its value is
-- changed to the new value.
insert :: (Interval k e, Ord k) => k -> v -> IntervalMap k v -> IntervalMap k v
insert :: forall k e v.
(Interval k e, Ord k) =>
k -> v -> IntervalMap k v -> IntervalMap k v
insert =  (k -> v -> v -> v) -> k -> v -> IntervalMap k v -> IntervalMap k v
forall k e v.
(Interval k e, Ord k) =>
(k -> v -> v -> v) -> k -> v -> IntervalMap k v -> IntervalMap k v
insertWithKey (\k
_ v
v v
_ -> v
v)

-- | /O(log n)/. Insert with a function, combining new value and old value.
-- @'insertWith' f key value mp@ 
-- will insert the pair (key, value) into @mp@ if key does
-- not exist in the map. If the key does exist, the function will
-- insert the pair @(key, f new_value old_value)@.
insertWith :: (Interval k e, Ord k) => (v -> v -> v) -> k -> v -> IntervalMap k v -> IntervalMap k v
insertWith :: forall k e v.
(Interval k e, Ord k) =>
(v -> v -> v) -> k -> v -> IntervalMap k v -> IntervalMap k v
insertWith v -> v -> v
f = (k -> v -> v -> v) -> k -> v -> IntervalMap k v -> IntervalMap k v
forall k e v.
(Interval k e, Ord k) =>
(k -> v -> v -> v) -> k -> v -> IntervalMap k v -> IntervalMap k v
insertWithKey (\k
_ v
new v
old -> v -> v -> v
f v
new v
old)

-- | /O(log n)/. Insert with a function, combining key, new value and old value.
-- @'insertWithKey' f key value mp@ 
-- will insert the pair (key, value) into @mp@ if key does
-- not exist in the map. If the key does exist, the function will
-- insert the pair @(key, f key new_value old_value)@.
-- Note that the key passed to f is the same key passed to 'insertWithKey'.
insertWithKey :: (Interval k e, Ord k) => (k -> v -> v -> v) -> k -> v -> IntervalMap k v -> IntervalMap k v
insertWithKey :: forall k e v.
(Interval k e, Ord k) =>
(k -> v -> v -> v) -> k -> v -> IntervalMap k v -> IntervalMap k v
insertWithKey k -> v -> v -> v
f k
key v
value IntervalMap k v
mp  =  k
key k -> IntervalMap k v -> IntervalMap k v
forall a b. a -> b -> b
`seq` IntervalMap k v -> IntervalMap k v
forall k v. IntervalMap k v -> IntervalMap k v
turnBlack (IntervalMap k v -> IntervalMap k v
ins IntervalMap k v
mp)
  where
    singletonR :: k -> v -> IntervalMap k v
singletonR k
k v
v = Color
-> k
-> k
-> v
-> IntervalMap k v
-> IntervalMap k v
-> IntervalMap k v
forall k v.
Color
-> k
-> k
-> v
-> IntervalMap k v
-> IntervalMap k v
-> IntervalMap k v
Node Color
R k
k k
k v
v IntervalMap k v
forall k v. IntervalMap k v
Nil IntervalMap k v
forall k v. IntervalMap k v
Nil
    ins :: IntervalMap k v -> IntervalMap k v
ins IntervalMap k v
Nil = k -> v -> IntervalMap k v
forall k v. k -> v -> IntervalMap k v
singletonR k
key v
value
    ins (Node Color
color k
k k
m v
v IntervalMap k v
l IntervalMap k v
r) =
      case k -> k -> Ordering
forall a. Ord a => a -> a -> Ordering
compare k
key k
k of
        Ordering
LT -> Color
-> k -> v -> IntervalMap k v -> IntervalMap k v -> IntervalMap k v
forall k e v.
Interval k e =>
Color
-> k -> v -> IntervalMap k v -> IntervalMap k v -> IntervalMap k v
balanceL Color
color k
k v
v (IntervalMap k v -> IntervalMap k v
ins IntervalMap k v
l) IntervalMap k v
r
        Ordering
GT -> Color
-> k -> v -> IntervalMap k v -> IntervalMap k v -> IntervalMap k v
forall k e v.
Interval k e =>
Color
-> k -> v -> IntervalMap k v -> IntervalMap k v -> IntervalMap k v
balanceR Color
color k
k v
v IntervalMap k v
l (IntervalMap k v -> IntervalMap k v
ins IntervalMap k v
r)
        Ordering
EQ -> Color
-> k
-> k
-> v
-> IntervalMap k v
-> IntervalMap k v
-> IntervalMap k v
forall k v.
Color
-> k
-> k
-> v
-> IntervalMap k v
-> IntervalMap k v
-> IntervalMap k v
Node Color
color k
k k
m (k -> v -> v -> v
f k
k v
value v
v) IntervalMap k v
l IntervalMap k v
r

-- | /O(log n)/. Combine insert with old values retrieval.
insertLookupWithKey :: (Interval k e, Ord k) => (k -> v -> v -> v) -> k -> v -> IntervalMap k v -> (Maybe v, IntervalMap k v)
insertLookupWithKey :: forall k e v.
(Interval k e, Ord k) =>
(k -> v -> v -> v)
-> k -> v -> IntervalMap k v -> (Maybe v, IntervalMap k v)
insertLookupWithKey k -> v -> v -> v
f k
key v
value IntervalMap k v
mp  =  k
key k -> (Maybe v, IntervalMap k v) -> (Maybe v, IntervalMap k v)
forall a b. a -> b -> b
`seq` (Maybe v
oldval, IntervalMap k v -> IntervalMap k v
forall k v. IntervalMap k v -> IntervalMap k v
turnBlack IntervalMap k v
mp')
  where
    (Maybe v
oldval, IntervalMap k v
mp') = IntervalMap k v -> (Maybe v, IntervalMap k v)
ins IntervalMap k v
mp
    singletonR :: k -> v -> IntervalMap k v
singletonR k
k v
v = Color
-> k
-> k
-> v
-> IntervalMap k v
-> IntervalMap k v
-> IntervalMap k v
forall k v.
Color
-> k
-> k
-> v
-> IntervalMap k v
-> IntervalMap k v
-> IntervalMap k v
Node Color
R k
k k
k v
v IntervalMap k v
forall k v. IntervalMap k v
Nil IntervalMap k v
forall k v. IntervalMap k v
Nil
    ins :: IntervalMap k v -> (Maybe v, IntervalMap k v)
ins IntervalMap k v
Nil = (Maybe v
forall a. Maybe a
Nothing, k -> v -> IntervalMap k v
forall k v. k -> v -> IntervalMap k v
singletonR k
key v
value)
    ins (Node Color
color k
k k
m v
v IntervalMap k v
l IntervalMap k v
r) =
      case k -> k -> Ordering
forall a. Ord a => a -> a -> Ordering
compare k
key k
k of
        Ordering
LT -> case IntervalMap k v -> (Maybe v, IntervalMap k v)
ins IntervalMap k v
l of
                 (x :: Maybe v
x@(Just v
_), IntervalMap k v
t') -> (Maybe v
x, Color
-> k
-> k
-> v
-> IntervalMap k v
-> IntervalMap k v
-> IntervalMap k v
forall k v.
Color
-> k
-> k
-> v
-> IntervalMap k v
-> IntervalMap k v
-> IntervalMap k v
Node Color
color k
k k
m v
v IntervalMap k v
t' IntervalMap k v
r)
                 (Maybe v
Nothing, IntervalMap k v
t') -> (Maybe v
forall a. Maybe a
Nothing, Color
-> k -> v -> IntervalMap k v -> IntervalMap k v -> IntervalMap k v
forall k e v.
Interval k e =>
Color
-> k -> v -> IntervalMap k v -> IntervalMap k v -> IntervalMap k v
balanceL Color
color k
k v
v IntervalMap k v
t' IntervalMap k v
r)
        Ordering
GT -> case IntervalMap k v -> (Maybe v, IntervalMap k v)
ins IntervalMap k v
r of
                 (x :: Maybe v
x@(Just v
_), IntervalMap k v
t') -> (Maybe v
x, Color
-> k
-> k
-> v
-> IntervalMap k v
-> IntervalMap k v
-> IntervalMap k v
forall k v.
Color
-> k
-> k
-> v
-> IntervalMap k v
-> IntervalMap k v
-> IntervalMap k v
Node Color
color k
k k
m v
v IntervalMap k v
l IntervalMap k v
t')
                 (Maybe v
Nothing, IntervalMap k v
t') -> (Maybe v
forall a. Maybe a
Nothing, Color
-> k -> v -> IntervalMap k v -> IntervalMap k v -> IntervalMap k v
forall k e v.
Interval k e =>
Color
-> k -> v -> IntervalMap k v -> IntervalMap k v -> IntervalMap k v
balanceR Color
color k
k v
v IntervalMap k v
l IntervalMap k v
t')
        Ordering
EQ -> (v -> Maybe v
forall a. a -> Maybe a
Just v
v, Color
-> k
-> k
-> v
-> IntervalMap k v
-> IntervalMap k v
-> IntervalMap k v
forall k v.
Color
-> k
-> k
-> v
-> IntervalMap k v
-> IntervalMap k v
-> IntervalMap k v
Node Color
color k
k k
m (k -> v -> v -> v
f k
k v
value v
v) IntervalMap k v
l IntervalMap k v
r)


balanceL :: (Interval k e) => Color -> k -> v -> IntervalMap k v -> IntervalMap k v -> IntervalMap k v
balanceL :: forall k e v.
Interval k e =>
Color
-> k -> v -> IntervalMap k v -> IntervalMap k v -> IntervalMap k v
balanceL Color
B k
zk v
zv (Node Color
R k
yk k
_ v
yv (Node Color
R k
xk k
_ v
xv IntervalMap k v
a IntervalMap k v
b) IntervalMap k v
c) IntervalMap k v
d =
    Color
-> k -> v -> IntervalMap k v -> IntervalMap k v -> IntervalMap k v
forall k e v.
Interval k e =>
Color
-> k -> v -> IntervalMap k v -> IntervalMap k v -> IntervalMap k v
mNode Color
R k
yk v
yv (Color
-> k -> v -> IntervalMap k v -> IntervalMap k v -> IntervalMap k v
forall k e v.
Interval k e =>
Color
-> k -> v -> IntervalMap k v -> IntervalMap k v -> IntervalMap k v
mNode Color
B k
xk v
xv IntervalMap k v
a IntervalMap k v
b) (Color
-> k -> v -> IntervalMap k v -> IntervalMap k v -> IntervalMap k v
forall k e v.
Interval k e =>
Color
-> k -> v -> IntervalMap k v -> IntervalMap k v -> IntervalMap k v
mNode Color
B k
zk v
zv IntervalMap k v
c IntervalMap k v
d)
balanceL Color
B k
zk v
zv (Node Color
R k
xk k
_ v
xv IntervalMap k v
a (Node Color
R k
yk k
_ v
yv IntervalMap k v
b IntervalMap k v
c)) IntervalMap k v
d =
    Color
-> k -> v -> IntervalMap k v -> IntervalMap k v -> IntervalMap k v
forall k e v.
Interval k e =>
Color
-> k -> v -> IntervalMap k v -> IntervalMap k v -> IntervalMap k v
mNode Color
R k
yk v
yv (Color
-> k -> v -> IntervalMap k v -> IntervalMap k v -> IntervalMap k v
forall k e v.
Interval k e =>
Color
-> k -> v -> IntervalMap k v -> IntervalMap k v -> IntervalMap k v
mNode Color
B k
xk v
xv IntervalMap k v
a IntervalMap k v
b) (Color
-> k -> v -> IntervalMap k v -> IntervalMap k v -> IntervalMap k v
forall k e v.
Interval k e =>
Color
-> k -> v -> IntervalMap k v -> IntervalMap k v -> IntervalMap k v
mNode Color
B k
zk v
zv IntervalMap k v
c IntervalMap k v
d)
balanceL Color
c k
xk v
xv IntervalMap k v
l IntervalMap k v
r = Color
-> k -> v -> IntervalMap k v -> IntervalMap k v -> IntervalMap k v
forall k e v.
Interval k e =>
Color
-> k -> v -> IntervalMap k v -> IntervalMap k v -> IntervalMap k v
mNode Color
c k
xk v
xv IntervalMap k v
l IntervalMap k v
r

balanceR :: (Interval k e) => Color -> k -> v -> IntervalMap k v -> IntervalMap k v -> IntervalMap k v
balanceR :: forall k e v.
Interval k e =>
Color
-> k -> v -> IntervalMap k v -> IntervalMap k v -> IntervalMap k v
balanceR Color
B k
xk v
xv IntervalMap k v
a (Node Color
R k
yk k
_ v
yv IntervalMap k v
b (Node Color
R k
zk k
_ v
zv IntervalMap k v
c IntervalMap k v
d)) =
    Color
-> k -> v -> IntervalMap k v -> IntervalMap k v -> IntervalMap k v
forall k e v.
Interval k e =>
Color
-> k -> v -> IntervalMap k v -> IntervalMap k v -> IntervalMap k v
mNode Color
R k
yk v
yv (Color
-> k -> v -> IntervalMap k v -> IntervalMap k v -> IntervalMap k v
forall k e v.
Interval k e =>
Color
-> k -> v -> IntervalMap k v -> IntervalMap k v -> IntervalMap k v
mNode Color
B k
xk v
xv IntervalMap k v
a IntervalMap k v
b) (Color
-> k -> v -> IntervalMap k v -> IntervalMap k v -> IntervalMap k v
forall k e v.
Interval k e =>
Color
-> k -> v -> IntervalMap k v -> IntervalMap k v -> IntervalMap k v
mNode Color
B k
zk v
zv IntervalMap k v
c IntervalMap k v
d)
balanceR Color
B k
xk v
xv IntervalMap k v
a (Node Color
R k
zk k
_ v
zv (Node Color
R k
yk k
_ v
yv IntervalMap k v
b IntervalMap k v
c) IntervalMap k v
d) =
    Color
-> k -> v -> IntervalMap k v -> IntervalMap k v -> IntervalMap k v
forall k e v.
Interval k e =>
Color
-> k -> v -> IntervalMap k v -> IntervalMap k v -> IntervalMap k v
mNode Color
R k
yk v
yv (Color
-> k -> v -> IntervalMap k v -> IntervalMap k v -> IntervalMap k v
forall k e v.
Interval k e =>
Color
-> k -> v -> IntervalMap k v -> IntervalMap k v -> IntervalMap k v
mNode Color
B k
xk v
xv IntervalMap k v
a IntervalMap k v
b) (Color
-> k -> v -> IntervalMap k v -> IntervalMap k v -> IntervalMap k v
forall k e v.
Interval k e =>
Color
-> k -> v -> IntervalMap k v -> IntervalMap k v -> IntervalMap k v
mNode Color
B k
zk v
zv IntervalMap k v
c IntervalMap k v
d)
balanceR Color
c k
xk v
xv IntervalMap k v
l IntervalMap k v
r = Color
-> k -> v -> IntervalMap k v -> IntervalMap k v -> IntervalMap k v
forall k e v.
Interval k e =>
Color
-> k -> v -> IntervalMap k v -> IntervalMap k v -> IntervalMap k v
mNode Color
c k
xk v
xv IntervalMap k v
l IntervalMap k v
r


-- min/max

-- | /O(log n)/. Returns the smallest key and its associated value.
-- Calls 'error' if the map is empty.
findMin :: IntervalMap k v -> (k, v)
findMin :: forall k v. IntervalMap k v -> (k, v)
findMin (Node Color
_ k
k k
_ v
v IntervalMap k v
Nil IntervalMap k v
_) = (k
k,v
v)
findMin (Node Color
_ k
_ k
_ v
_ IntervalMap k v
l IntervalMap k v
_) = IntervalMap k v -> (k, v)
forall k v. IntervalMap k v -> (k, v)
findMin IntervalMap k v
l
findMin IntervalMap k v
Nil = [Char] -> (k, v)
forall a. HasCallStack => [Char] -> a
error [Char]
"IntervalMap.findMin: empty map"

-- | /O(log n)/. Returns the largest key and its associated value.
-- Calls 'error' if the map is empty.
findMax :: IntervalMap k v -> (k, v)
findMax :: forall k v. IntervalMap k v -> (k, v)
findMax (Node Color
_ k
k k
_ v
v IntervalMap k v
_ IntervalMap k v
Nil) = (k
k,v
v)
findMax (Node Color
_ k
_ k
_ v
_ IntervalMap k v
_ IntervalMap k v
r) = IntervalMap k v -> (k, v)
forall k v. IntervalMap k v -> (k, v)
findMax IntervalMap k v
r
findMax IntervalMap k v
Nil = [Char] -> (k, v)
forall a. HasCallStack => [Char] -> a
error [Char]
"IntervalMap.findMin: empty map"

-- | /O(log n)/. Returns the smallest key and its associated value.
lookupMin :: IntervalMap k v -> Maybe (k, v)
lookupMin :: forall k v. IntervalMap k v -> Maybe (k, v)
lookupMin (Node Color
_ k
k k
_ v
v IntervalMap k v
Nil IntervalMap k v
_) = (k, v) -> Maybe (k, v)
forall a. a -> Maybe a
Just (k
k,v
v)
lookupMin (Node Color
_ k
_ k
_ v
_ IntervalMap k v
l IntervalMap k v
_) = IntervalMap k v -> Maybe (k, v)
forall k v. IntervalMap k v -> Maybe (k, v)
lookupMin IntervalMap k v
l
lookupMin IntervalMap k v
Nil = Maybe (k, v)
forall a. Maybe a
Nothing

-- | /O(log n)/. Returns the largest key and its associated value.
lookupMax :: IntervalMap k v -> Maybe (k, v)
lookupMax :: forall k v. IntervalMap k v -> Maybe (k, v)
lookupMax (Node Color
_ k
k k
_ v
v IntervalMap k v
_ IntervalMap k v
Nil) = (k, v) -> Maybe (k, v)
forall a. a -> Maybe a
Just (k
k,v
v)
lookupMax (Node Color
_ k
_ k
_ v
_ IntervalMap k v
_ IntervalMap k v
r) = IntervalMap k v -> Maybe (k, v)
forall k v. IntervalMap k v -> Maybe (k, v)
lookupMax IntervalMap k v
r
lookupMax IntervalMap k v
Nil = Maybe (k, v)
forall a. Maybe a
Nothing

-- | Returns the key with the largest endpoint and its associated value.
-- If there is more than one key with that endpoint, return the rightmost.
--
-- /O(n)/, since all keys could have the same endpoint.
-- /O(log n)/ average case.
findLast :: (Interval k e) => IntervalMap k v -> (k, v)
findLast :: forall k e v. Interval k e => IntervalMap k v -> (k, v)
findLast IntervalMap k v
Nil = [Char] -> (k, v)
forall a. HasCallStack => [Char] -> a
error [Char]
"IntervalMap.findLast: empty map"
findLast t :: IntervalMap k v
t@(Node Color
_ k
_ k
mx v
_ IntervalMap k v
_ IntervalMap k v
_) = Maybe (k, v) -> (k, v)
forall a. HasCallStack => Maybe a -> a
fromJust (IntervalMap k v -> Maybe (k, v)
forall {b}. IntervalMap k b -> Maybe (k, b)
go IntervalMap k v
t)
  where
    go :: IntervalMap k b -> Maybe (k, b)
go IntervalMap k b
Nil = Maybe (k, b)
forall a. Maybe a
Nothing
    go (Node Color
_ k
k k
m b
v IntervalMap k b
l IntervalMap k b
r) | k -> k -> Bool
forall i e. Interval i e => i -> i -> Bool
sameU k
m k
mx = if k -> k -> Bool
forall i e. Interval i e => i -> i -> Bool
sameU k
k k
m then IntervalMap k b -> Maybe (k, b)
go IntervalMap k b
r Maybe (k, b) -> Maybe (k, b) -> Maybe (k, b)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (k, b) -> Maybe (k, b)
forall a. a -> Maybe a
Just (k
k,b
v)
                                                      else IntervalMap k b -> Maybe (k, b)
go IntervalMap k b
r Maybe (k, b) -> Maybe (k, b) -> Maybe (k, b)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> IntervalMap k b -> Maybe (k, b)
go IntervalMap k b
l
                          | Bool
otherwise  = Maybe (k, b)
forall a. Maybe a
Nothing
    sameU :: i -> i -> Bool
sameU i
a i
b = i -> i -> Ordering
forall i e. Interval i e => i -> i -> Ordering
compareUpperBounds i
a i
b Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
EQ

-- | Returns the key with the largest endpoint and its associated value.
-- If there is more than one key with that endpoint, return the rightmost.
--
-- /O(n)/, since all keys could have the same endpoint.
-- /O(log n)/ average case.
lookupLast :: (Interval k e) => IntervalMap k v -> Maybe (k, v)
lookupLast :: forall k e v. Interval k e => IntervalMap k v -> Maybe (k, v)
lookupLast IntervalMap k v
Nil = Maybe (k, v)
forall a. Maybe a
Nothing
lookupLast t :: IntervalMap k v
t@(Node Color
_ k
_ k
mx v
_ IntervalMap k v
_ IntervalMap k v
_) = IntervalMap k v -> Maybe (k, v)
forall {b}. IntervalMap k b -> Maybe (k, b)
go IntervalMap k v
t
  where
    go :: IntervalMap k b -> Maybe (k, b)
go IntervalMap k b
Nil = Maybe (k, b)
forall a. Maybe a
Nothing
    go (Node Color
_ k
k k
m b
v IntervalMap k b
l IntervalMap k b
r) | k -> k -> Bool
forall i e. Interval i e => i -> i -> Bool
sameU k
m k
mx = if k -> k -> Bool
forall i e. Interval i e => i -> i -> Bool
sameU k
k k
m then IntervalMap k b -> Maybe (k, b)
go IntervalMap k b
r Maybe (k, b) -> Maybe (k, b) -> Maybe (k, b)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (k, b) -> Maybe (k, b)
forall a. a -> Maybe a
Just (k
k,b
v)
                                                      else IntervalMap k b -> Maybe (k, b)
go IntervalMap k b
r Maybe (k, b) -> Maybe (k, b) -> Maybe (k, b)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> IntervalMap k b -> Maybe (k, b)
go IntervalMap k b
l
                          | Bool
otherwise  = Maybe (k, b)
forall a. Maybe a
Nothing
    sameU :: i -> i -> Bool
sameU i
a i
b = i -> i -> Ordering
forall i e. Interval i e => i -> i -> Ordering
compareUpperBounds i
a i
b Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
EQ



-- Type to indicate whether the number of black nodes changed or stayed the same.
data DeleteResult k v = U !(IntervalMap k v)   -- Unchanged
                      | S !(IntervalMap k v)   -- Shrunk

unwrap :: DeleteResult k v -> IntervalMap k v
unwrap :: forall k v. DeleteResult k v -> IntervalMap k v
unwrap (U IntervalMap k v
m) = IntervalMap k v
m
unwrap (S IntervalMap k v
m) = IntervalMap k v
m

-- DeleteResult with value
data DeleteResult' k v a = U' !(IntervalMap k v) a
                         | S' !(IntervalMap k v) a

unwrap' :: DeleteResult' k v a -> IntervalMap k v
unwrap' :: forall k v a. DeleteResult' k v a -> IntervalMap k v
unwrap' (U' IntervalMap k v
m a
_) = IntervalMap k v
m
unwrap' (S' IntervalMap k v
m a
_) = IntervalMap k v
m

-- annotate DeleteResult with value
annotate :: DeleteResult k v -> a -> DeleteResult' k v a
annotate :: forall k v a. DeleteResult k v -> a -> DeleteResult' k v a
annotate (U IntervalMap k v
m) a
x = IntervalMap k v -> a -> DeleteResult' k v a
forall k v a. IntervalMap k v -> a -> DeleteResult' k v a
U' IntervalMap k v
m a
x
annotate (S IntervalMap k v
m) a
x = IntervalMap k v -> a -> DeleteResult' k v a
forall k v a. IntervalMap k v -> a -> DeleteResult' k v a
S' IntervalMap k v
m a
x


-- | /O(log n)/. Remove the smallest key from the map. Return the empty map if the map is empty.
deleteMin :: (Interval k e, Ord k) => IntervalMap k v -> IntervalMap k v
deleteMin :: forall k e v.
(Interval k e, Ord k) =>
IntervalMap k v -> IntervalMap k v
deleteMin IntervalMap k v
Nil = IntervalMap k v
forall k v. IntervalMap k v
Nil
deleteMin IntervalMap k v
m   = IntervalMap k v -> IntervalMap k v
forall k v. IntervalMap k v -> IntervalMap k v
turnBlack (DeleteResult' k v (k, v) -> IntervalMap k v
forall k v a. DeleteResult' k v a -> IntervalMap k v
unwrap' (IntervalMap k v -> DeleteResult' k v (k, v)
forall k e v.
(Interval k e, Ord k) =>
IntervalMap k v -> DeleteResult' k v (k, v)
deleteMin' IntervalMap k v
m))

deleteMin' :: (Interval k e, Ord k) => IntervalMap k v -> DeleteResult' k v (k, v)
deleteMin' :: forall k e v.
(Interval k e, Ord k) =>
IntervalMap k v -> DeleteResult' k v (k, v)
deleteMin' IntervalMap k v
Nil = [Char] -> DeleteResult' k v (k, v)
forall a. HasCallStack => [Char] -> a
error [Char]
"deleteMin': Nil"
deleteMin' (Node Color
B k
k k
_ v
v IntervalMap k v
Nil IntervalMap k v
Nil) = IntervalMap k v -> (k, v) -> DeleteResult' k v (k, v)
forall k v a. IntervalMap k v -> a -> DeleteResult' k v a
S' IntervalMap k v
forall k v. IntervalMap k v
Nil (k
k,v
v)
deleteMin' (Node Color
B k
k k
_ v
v IntervalMap k v
Nil r :: IntervalMap k v
r@(Node Color
R k
_ k
_ v
_ IntervalMap k v
_ IntervalMap k v
_)) = IntervalMap k v -> (k, v) -> DeleteResult' k v (k, v)
forall k v a. IntervalMap k v -> a -> DeleteResult' k v a
U' (IntervalMap k v -> IntervalMap k v
forall k v. IntervalMap k v -> IntervalMap k v
turnBlack IntervalMap k v
r) (k
k,v
v)
deleteMin' (Node Color
R k
k k
_ v
v IntervalMap k v
Nil IntervalMap k v
r) = IntervalMap k v -> (k, v) -> DeleteResult' k v (k, v)
forall k v a. IntervalMap k v -> a -> DeleteResult' k v a
U' IntervalMap k v
r (k
k,v
v)
deleteMin' (Node Color
c k
k k
_ v
v IntervalMap k v
l IntervalMap k v
r) =
  case IntervalMap k v -> DeleteResult' k v (k, v)
forall k e v.
(Interval k e, Ord k) =>
IntervalMap k v -> DeleteResult' k v (k, v)
deleteMin' IntervalMap k v
l of
    (U' IntervalMap k v
l' (k, v)
kv) -> IntervalMap k v -> (k, v) -> DeleteResult' k v (k, v)
forall k v a. IntervalMap k v -> a -> DeleteResult' k v a
U' (Color
-> k -> v -> IntervalMap k v -> IntervalMap k v -> IntervalMap k v
forall k e v.
Interval k e =>
Color
-> k -> v -> IntervalMap k v -> IntervalMap k v -> IntervalMap k v
mNode Color
c k
k v
v IntervalMap k v
l' IntervalMap k v
r) (k, v)
kv
    (S' IntervalMap k v
l' (k, v)
kv) -> DeleteResult k v -> (k, v) -> DeleteResult' k v (k, v)
forall k v a. DeleteResult k v -> a -> DeleteResult' k v a
annotate (Color
-> k -> v -> IntervalMap k v -> IntervalMap k v -> DeleteResult k v
forall k e v.
Interval k e =>
Color
-> k -> v -> IntervalMap k v -> IntervalMap k v -> DeleteResult k v
unbalancedR Color
c k
k v
v IntervalMap k v
l' IntervalMap k v
r) (k, v)
kv

deleteMax' :: (Interval k e, Ord k) => IntervalMap k v -> DeleteResult' k v (k, v)
deleteMax' :: forall k e v.
(Interval k e, Ord k) =>
IntervalMap k v -> DeleteResult' k v (k, v)
deleteMax' IntervalMap k v
Nil = [Char] -> DeleteResult' k v (k, v)
forall a. HasCallStack => [Char] -> a
error [Char]
"deleteMax': Nil"
deleteMax' (Node Color
B k
k k
_ v
v IntervalMap k v
Nil IntervalMap k v
Nil) = IntervalMap k v -> (k, v) -> DeleteResult' k v (k, v)
forall k v a. IntervalMap k v -> a -> DeleteResult' k v a
S' IntervalMap k v
forall k v. IntervalMap k v
Nil (k
k,v
v)
deleteMax' (Node Color
B k
k k
_ v
v l :: IntervalMap k v
l@(Node Color
R k
_ k
_ v
_ IntervalMap k v
_ IntervalMap k v
_) IntervalMap k v
Nil) = IntervalMap k v -> (k, v) -> DeleteResult' k v (k, v)
forall k v a. IntervalMap k v -> a -> DeleteResult' k v a
U' (IntervalMap k v -> IntervalMap k v
forall k v. IntervalMap k v -> IntervalMap k v
turnBlack IntervalMap k v
l) (k
k,v
v)
deleteMax' (Node Color
R k
k k
_ v
v IntervalMap k v
l IntervalMap k v
Nil) = IntervalMap k v -> (k, v) -> DeleteResult' k v (k, v)
forall k v a. IntervalMap k v -> a -> DeleteResult' k v a
U' IntervalMap k v
l (k
k,v
v)
deleteMax' (Node Color
c k
k k
_ v
v IntervalMap k v
l IntervalMap k v
r) =
  case IntervalMap k v -> DeleteResult' k v (k, v)
forall k e v.
(Interval k e, Ord k) =>
IntervalMap k v -> DeleteResult' k v (k, v)
deleteMax' IntervalMap k v
r of
    (U' IntervalMap k v
r' (k, v)
kv) -> IntervalMap k v -> (k, v) -> DeleteResult' k v (k, v)
forall k v a. IntervalMap k v -> a -> DeleteResult' k v a
U' (Color
-> k -> v -> IntervalMap k v -> IntervalMap k v -> IntervalMap k v
forall k e v.
Interval k e =>
Color
-> k -> v -> IntervalMap k v -> IntervalMap k v -> IntervalMap k v
mNode Color
c k
k v
v IntervalMap k v
l IntervalMap k v
r') (k, v)
kv
    (S' IntervalMap k v
r' (k, v)
kv) -> DeleteResult k v -> (k, v) -> DeleteResult' k v (k, v)
forall k v a. DeleteResult k v -> a -> DeleteResult' k v a
annotate (Color
-> k -> v -> IntervalMap k v -> IntervalMap k v -> DeleteResult k v
forall k e v.
Interval k e =>
Color
-> k -> v -> IntervalMap k v -> IntervalMap k v -> DeleteResult k v
unbalancedL Color
c k
k v
v IntervalMap k v
l IntervalMap k v
r') (k, v)
kv

-- The left tree lacks one Black node
unbalancedR :: (Interval k e) => Color -> k -> v -> IntervalMap k v -> IntervalMap k v -> DeleteResult k v
-- Decreasing one Black node in the right
unbalancedR :: forall k e v.
Interval k e =>
Color
-> k -> v -> IntervalMap k v -> IntervalMap k v -> DeleteResult k v
unbalancedR Color
B k
k v
v IntervalMap k v
l r :: IntervalMap k v
r@(Node Color
B k
_ k
_ v
_ IntervalMap k v
_ IntervalMap k v
_) = IntervalMap k v -> DeleteResult k v
forall k v. IntervalMap k v -> DeleteResult k v
S (Color
-> k -> v -> IntervalMap k v -> IntervalMap k v -> IntervalMap k v
forall k e v.
Interval k e =>
Color
-> k -> v -> IntervalMap k v -> IntervalMap k v -> IntervalMap k v
balanceR Color
B k
k v
v IntervalMap k v
l (IntervalMap k v -> IntervalMap k v
forall k v. IntervalMap k v -> IntervalMap k v
turnRed IntervalMap k v
r))
unbalancedR Color
R k
k v
v IntervalMap k v
l r :: IntervalMap k v
r@(Node Color
B k
_ k
_ v
_ IntervalMap k v
_ IntervalMap k v
_) = IntervalMap k v -> DeleteResult k v
forall k v. IntervalMap k v -> DeleteResult k v
U (Color
-> k -> v -> IntervalMap k v -> IntervalMap k v -> IntervalMap k v
forall k e v.
Interval k e =>
Color
-> k -> v -> IntervalMap k v -> IntervalMap k v -> IntervalMap k v
balanceR Color
B k
k v
v IntervalMap k v
l (IntervalMap k v -> IntervalMap k v
forall k v. IntervalMap k v -> IntervalMap k v
turnRed IntervalMap k v
r))
-- Taking one Red node from the right and adding it to the right as Black
unbalancedR Color
B k
k v
v IntervalMap k v
l (Node Color
R k
rk k
_ v
rv rl :: IntervalMap k v
rl@(Node Color
B k
_ k
_ v
_ IntervalMap k v
_ IntervalMap k v
_) IntervalMap k v
rr)
  = IntervalMap k v -> DeleteResult k v
forall k v. IntervalMap k v -> DeleteResult k v
U (Color
-> k -> v -> IntervalMap k v -> IntervalMap k v -> IntervalMap k v
forall k e v.
Interval k e =>
Color
-> k -> v -> IntervalMap k v -> IntervalMap k v -> IntervalMap k v
mNode Color
B k
rk v
rv (Color
-> k -> v -> IntervalMap k v -> IntervalMap k v -> IntervalMap k v
forall k e v.
Interval k e =>
Color
-> k -> v -> IntervalMap k v -> IntervalMap k v -> IntervalMap k v
balanceR Color
B k
k v
v IntervalMap k v
l (IntervalMap k v -> IntervalMap k v
forall k v. IntervalMap k v -> IntervalMap k v
turnRed IntervalMap k v
rl)) IntervalMap k v
rr)
unbalancedR Color
_ k
_ v
_ IntervalMap k v
_ IntervalMap k v
_ = [Char] -> DeleteResult k v
forall a. HasCallStack => [Char] -> a
error [Char]
"unbalancedR"

unbalancedL :: (Interval k e) => Color -> k -> v -> IntervalMap k v -> IntervalMap k v -> DeleteResult k v
unbalancedL :: forall k e v.
Interval k e =>
Color
-> k -> v -> IntervalMap k v -> IntervalMap k v -> DeleteResult k v
unbalancedL Color
R k
k v
v l :: IntervalMap k v
l@(Node Color
B k
_ k
_ v
_ IntervalMap k v
_ IntervalMap k v
_) IntervalMap k v
r = IntervalMap k v -> DeleteResult k v
forall k v. IntervalMap k v -> DeleteResult k v
U (Color
-> k -> v -> IntervalMap k v -> IntervalMap k v -> IntervalMap k v
forall k e v.
Interval k e =>
Color
-> k -> v -> IntervalMap k v -> IntervalMap k v -> IntervalMap k v
balanceL Color
B k
k v
v (IntervalMap k v -> IntervalMap k v
forall k v. IntervalMap k v -> IntervalMap k v
turnRed IntervalMap k v
l) IntervalMap k v
r)
unbalancedL Color
B k
k v
v l :: IntervalMap k v
l@(Node Color
B k
_ k
_ v
_ IntervalMap k v
_ IntervalMap k v
_) IntervalMap k v
r = IntervalMap k v -> DeleteResult k v
forall k v. IntervalMap k v -> DeleteResult k v
S (Color
-> k -> v -> IntervalMap k v -> IntervalMap k v -> IntervalMap k v
forall k e v.
Interval k e =>
Color
-> k -> v -> IntervalMap k v -> IntervalMap k v -> IntervalMap k v
balanceL Color
B k
k v
v (IntervalMap k v -> IntervalMap k v
forall k v. IntervalMap k v -> IntervalMap k v
turnRed IntervalMap k v
l) IntervalMap k v
r)
unbalancedL Color
B k
k v
v (Node Color
R k
lk k
_ v
lv IntervalMap k v
ll lr :: IntervalMap k v
lr@(Node Color
B k
_ k
_ v
_ IntervalMap k v
_ IntervalMap k v
_)) IntervalMap k v
r
  = IntervalMap k v -> DeleteResult k v
forall k v. IntervalMap k v -> DeleteResult k v
U (Color
-> k -> v -> IntervalMap k v -> IntervalMap k v -> IntervalMap k v
forall k e v.
Interval k e =>
Color
-> k -> v -> IntervalMap k v -> IntervalMap k v -> IntervalMap k v
mNode Color
B k
lk v
lv IntervalMap k v
ll (Color
-> k -> v -> IntervalMap k v -> IntervalMap k v -> IntervalMap k v
forall k e v.
Interval k e =>
Color
-> k -> v -> IntervalMap k v -> IntervalMap k v -> IntervalMap k v
balanceL Color
B k
k v
v (IntervalMap k v -> IntervalMap k v
forall k v. IntervalMap k v -> IntervalMap k v
turnRed IntervalMap k v
lr) IntervalMap k v
r))
unbalancedL Color
_ k
_ v
_ IntervalMap k v
_ IntervalMap k v
_ = [Char] -> DeleteResult k v
forall a. HasCallStack => [Char] -> a
error [Char]
"unbalancedL"



-- | /O(log n)/. Remove the largest key from the map. Return the empty map if the map is empty.
deleteMax :: (Interval k e, Ord k) => IntervalMap k v -> IntervalMap k v
deleteMax :: forall k e v.
(Interval k e, Ord k) =>
IntervalMap k v -> IntervalMap k v
deleteMax IntervalMap k v
Nil = IntervalMap k v
forall k v. IntervalMap k v
Nil
deleteMax IntervalMap k v
m   = IntervalMap k v -> IntervalMap k v
forall k v. IntervalMap k v -> IntervalMap k v
turnBlack (DeleteResult' k v (k, v) -> IntervalMap k v
forall k v a. DeleteResult' k v a -> IntervalMap k v
unwrap' (IntervalMap k v -> DeleteResult' k v (k, v)
forall k e v.
(Interval k e, Ord k) =>
IntervalMap k v -> DeleteResult' k v (k, v)
deleteMax' IntervalMap k v
m))

-- | /O(log n)/. Delete and return the smallest key.
deleteFindMin :: (Interval k e, Ord k) => IntervalMap k v -> ((k,v), IntervalMap k v)
deleteFindMin :: forall k e v.
(Interval k e, Ord k) =>
IntervalMap k v -> ((k, v), IntervalMap k v)
deleteFindMin IntervalMap k v
mp = case IntervalMap k v -> DeleteResult' k v (k, v)
forall k e v.
(Interval k e, Ord k) =>
IntervalMap k v -> DeleteResult' k v (k, v)
deleteMin' IntervalMap k v
mp of
                     (U' IntervalMap k v
r (k, v)
v) -> ((k, v)
v, IntervalMap k v -> IntervalMap k v
forall k v. IntervalMap k v -> IntervalMap k v
turnBlack IntervalMap k v
r)
                     (S' IntervalMap k v
r (k, v)
v) -> ((k, v)
v, IntervalMap k v -> IntervalMap k v
forall k v. IntervalMap k v -> IntervalMap k v
turnBlack IntervalMap k v
r)

-- | /O(log n)/. Delete and return the largest key.
deleteFindMax :: (Interval k e, Ord k) => IntervalMap k v -> ((k,v), IntervalMap k v)
deleteFindMax :: forall k e v.
(Interval k e, Ord k) =>
IntervalMap k v -> ((k, v), IntervalMap k v)
deleteFindMax IntervalMap k v
mp = case IntervalMap k v -> DeleteResult' k v (k, v)
forall k e v.
(Interval k e, Ord k) =>
IntervalMap k v -> DeleteResult' k v (k, v)
deleteMax' IntervalMap k v
mp of
                     (U' IntervalMap k v
r (k, v)
v) -> ((k, v)
v, IntervalMap k v -> IntervalMap k v
forall k v. IntervalMap k v -> IntervalMap k v
turnBlack IntervalMap k v
r)
                     (S' IntervalMap k v
r (k, v)
v) -> ((k, v)
v, IntervalMap k v -> IntervalMap k v
forall k v. IntervalMap k v -> IntervalMap k v
turnBlack IntervalMap k v
r)

-- | /O(log n)/. Update or delete value at minimum key.
updateMin :: (Interval k e, Ord k) => (v -> Maybe v) -> IntervalMap k v -> IntervalMap k v
updateMin :: forall k e v.
(Interval k e, Ord k) =>
(v -> Maybe v) -> IntervalMap k v -> IntervalMap k v
updateMin v -> Maybe v
f IntervalMap k v
m = (k -> v -> Maybe v) -> IntervalMap k v -> IntervalMap k v
forall k e v.
(Interval k e, Ord k) =>
(k -> v -> Maybe v) -> IntervalMap k v -> IntervalMap k v
updateMinWithKey (\k
_ v
v -> v -> Maybe v
f v
v) IntervalMap k v
m

-- | /O(log n)/. Update or delete value at maximum key.
updateMax :: (Interval k e, Ord k) => (v -> Maybe v) -> IntervalMap k v -> IntervalMap k v
updateMax :: forall k e v.
(Interval k e, Ord k) =>
(v -> Maybe v) -> IntervalMap k v -> IntervalMap k v
updateMax v -> Maybe v
f IntervalMap k v
m = (k -> v -> Maybe v) -> IntervalMap k v -> IntervalMap k v
forall k e v.
(Interval k e, Ord k) =>
(k -> v -> Maybe v) -> IntervalMap k v -> IntervalMap k v
updateMaxWithKey (\k
_ v
v -> v -> Maybe v
f v
v) IntervalMap k v
m

-- | /O(log n)/. Update or delete value at minimum key.
updateMinWithKey :: (Interval k e, Ord k) => (k -> v -> Maybe v) -> IntervalMap k v -> IntervalMap k v
updateMinWithKey :: forall k e v.
(Interval k e, Ord k) =>
(k -> v -> Maybe v) -> IntervalMap k v -> IntervalMap k v
updateMinWithKey k -> v -> Maybe v
_ IntervalMap k v
Nil = IntervalMap k v
forall k v. IntervalMap k v
Nil
updateMinWithKey k -> v -> Maybe v
f IntervalMap k v
m = let (k
k,v
v) = IntervalMap k v -> (k, v)
forall k v. IntervalMap k v -> (k, v)
findMin IntervalMap k v
m in
                       case k -> v -> Maybe v
f k
k v
v of
                         Just v
v' -> v -> IntervalMap k v -> IntervalMap k v
forall v k. v -> IntervalMap k v -> IntervalMap k v
setMinValue v
v' IntervalMap k v
m
                         Maybe v
Nothing -> IntervalMap k v -> IntervalMap k v
forall k e v.
(Interval k e, Ord k) =>
IntervalMap k v -> IntervalMap k v
deleteMin IntervalMap k v
m

-- | /O(log n)/. Update or delete value at maximum key.
updateMaxWithKey :: (Interval k e, Ord k) => (k -> v -> Maybe v) -> IntervalMap k v -> IntervalMap k v
updateMaxWithKey :: forall k e v.
(Interval k e, Ord k) =>
(k -> v -> Maybe v) -> IntervalMap k v -> IntervalMap k v
updateMaxWithKey k -> v -> Maybe v
_ IntervalMap k v
Nil = IntervalMap k v
forall k v. IntervalMap k v
Nil
updateMaxWithKey k -> v -> Maybe v
f IntervalMap k v
m = let (k
k,v
v) = IntervalMap k v -> (k, v)
forall k v. IntervalMap k v -> (k, v)
findMax IntervalMap k v
m in
                       case k -> v -> Maybe v
f k
k v
v of
                         Just v
v' -> v -> IntervalMap k v -> IntervalMap k v
forall v k. v -> IntervalMap k v -> IntervalMap k v
setMaxValue v
v' IntervalMap k v
m
                         Maybe v
Nothing -> IntervalMap k v -> IntervalMap k v
forall k e v.
(Interval k e, Ord k) =>
IntervalMap k v -> IntervalMap k v
deleteMax IntervalMap k v
m

-- | /O(log n)/. Retrieves the minimal (key,value) pair of the map, and
-- the map stripped of that element, or 'Nothing' if passed an empty map.
--
-- > minViewWithKey (fromList [([5,6],"a"), ([3,4],"b")]) == Just (([3,4],"b"), singleton [5,6] "a")
-- > minViewWithKey empty == Nothing

minViewWithKey :: (Interval k e, Ord k) => IntervalMap k a -> Maybe ((k, a), IntervalMap k a)
minViewWithKey :: forall k e a.
(Interval k e, Ord k) =>
IntervalMap k a -> Maybe ((k, a), IntervalMap k a)
minViewWithKey IntervalMap k a
Nil = Maybe ((k, a), IntervalMap k a)
forall a. Maybe a
Nothing
minViewWithKey IntervalMap k a
x   = ((k, a), IntervalMap k a) -> Maybe ((k, a), IntervalMap k a)
forall a. a -> Maybe a
Just (IntervalMap k a -> ((k, a), IntervalMap k a)
forall k e v.
(Interval k e, Ord k) =>
IntervalMap k v -> ((k, v), IntervalMap k v)
deleteFindMin IntervalMap k a
x)

-- | /O(log n)/. Retrieves the maximal (key,value) pair of the map, and
-- the map stripped of that element, or 'Nothing' if passed an empty map.
maxViewWithKey :: (Interval k e, Ord k) => IntervalMap k a -> Maybe ((k, a), IntervalMap k a)
maxViewWithKey :: forall k e a.
(Interval k e, Ord k) =>
IntervalMap k a -> Maybe ((k, a), IntervalMap k a)
maxViewWithKey IntervalMap k a
Nil = Maybe ((k, a), IntervalMap k a)
forall a. Maybe a
Nothing
maxViewWithKey IntervalMap k a
x   = ((k, a), IntervalMap k a) -> Maybe ((k, a), IntervalMap k a)
forall a. a -> Maybe a
Just (IntervalMap k a -> ((k, a), IntervalMap k a)
forall k e v.
(Interval k e, Ord k) =>
IntervalMap k v -> ((k, v), IntervalMap k v)
deleteFindMax IntervalMap k a
x)

-- | /O(log n)/. Retrieves the value associated with minimal key of the
-- map, and the map stripped of that element, or 'Nothing' if passed an
-- empty map.
minView :: (Interval k e, Ord k) => IntervalMap k a -> Maybe (a, IntervalMap k a)
minView :: forall k e a.
(Interval k e, Ord k) =>
IntervalMap k a -> Maybe (a, IntervalMap k a)
minView IntervalMap k a
Nil = Maybe (a, IntervalMap k a)
forall a. Maybe a
Nothing
minView IntervalMap k a
x   = case IntervalMap k a -> ((k, a), IntervalMap k a)
forall k e v.
(Interval k e, Ord k) =>
IntervalMap k v -> ((k, v), IntervalMap k v)
deleteFindMin IntervalMap k a
x of ((k
_,a
a), IntervalMap k a
x') -> (a, IntervalMap k a) -> Maybe (a, IntervalMap k a)
forall a. a -> Maybe a
Just (a
a, IntervalMap k a
x')

-- | /O(log n)/. Retrieves the value associated with maximal key of the
-- map, and the map stripped of that element, or 'Nothing' if passed an
-- empty map.
maxView :: (Interval k e, Ord k) => IntervalMap k a -> Maybe (a, IntervalMap k a)
maxView :: forall k e a.
(Interval k e, Ord k) =>
IntervalMap k a -> Maybe (a, IntervalMap k a)
maxView IntervalMap k a
Nil = Maybe (a, IntervalMap k a)
forall a. Maybe a
Nothing
maxView IntervalMap k a
x   = case IntervalMap k a -> ((k, a), IntervalMap k a)
forall k e v.
(Interval k e, Ord k) =>
IntervalMap k v -> ((k, v), IntervalMap k v)
deleteFindMax IntervalMap k a
x of ((k
_,a
a), IntervalMap k a
x') -> (a, IntervalMap k a) -> Maybe (a, IntervalMap k a)
forall a. a -> Maybe a
Just (a
a, IntervalMap k a
x')


setMinValue :: v -> IntervalMap k v -> IntervalMap k v
setMinValue :: forall v k. v -> IntervalMap k v -> IntervalMap k v
setMinValue v
_  IntervalMap k v
Nil = IntervalMap k v
forall k v. IntervalMap k v
Nil
setMinValue v
v' (Node Color
c k
k k
m v
_ IntervalMap k v
Nil IntervalMap k v
r) = Color
-> k
-> k
-> v
-> IntervalMap k v
-> IntervalMap k v
-> IntervalMap k v
forall k v.
Color
-> k
-> k
-> v
-> IntervalMap k v
-> IntervalMap k v
-> IntervalMap k v
Node Color
c k
k k
m v
v' IntervalMap k v
forall k v. IntervalMap k v
Nil IntervalMap k v
r
setMinValue v
v' (Node Color
c k
k k
m v
v IntervalMap k v
l   IntervalMap k v
r) = Color
-> k
-> k
-> v
-> IntervalMap k v
-> IntervalMap k v
-> IntervalMap k v
forall k v.
Color
-> k
-> k
-> v
-> IntervalMap k v
-> IntervalMap k v
-> IntervalMap k v
Node Color
c k
k k
m v
v (v -> IntervalMap k v -> IntervalMap k v
forall v k. v -> IntervalMap k v -> IntervalMap k v
setMinValue v
v' IntervalMap k v
l) IntervalMap k v
r

setMaxValue :: v -> IntervalMap k v -> IntervalMap k v
setMaxValue :: forall v k. v -> IntervalMap k v -> IntervalMap k v
setMaxValue v
_  IntervalMap k v
Nil = IntervalMap k v
forall k v. IntervalMap k v
Nil
setMaxValue v
v' (Node Color
c k
k k
m v
_ IntervalMap k v
l IntervalMap k v
Nil) = Color
-> k
-> k
-> v
-> IntervalMap k v
-> IntervalMap k v
-> IntervalMap k v
forall k v.
Color
-> k
-> k
-> v
-> IntervalMap k v
-> IntervalMap k v
-> IntervalMap k v
Node Color
c k
k k
m v
v' IntervalMap k v
l IntervalMap k v
forall k v. IntervalMap k v
Nil
setMaxValue v
v' (Node Color
c k
k k
m v
v IntervalMap k v
l IntervalMap k v
r)   = Color
-> k
-> k
-> v
-> IntervalMap k v
-> IntervalMap k v
-> IntervalMap k v
forall k v.
Color
-> k
-> k
-> v
-> IntervalMap k v
-> IntervalMap k v
-> IntervalMap k v
Node Color
c k
k k
m v
v IntervalMap k v
l (v -> IntervalMap k v -> IntervalMap k v
forall v k. v -> IntervalMap k v -> IntervalMap k v
setMaxValue v
v' IntervalMap k v
r)



-- folding

-- | /O(n)/. Fold the values in the map using the given right-associative
-- binary operator, such that @'foldr' f z == 'Prelude.foldr' f z . 'elems'@.
foldr :: (a -> b -> b) -> b -> IntervalMap k a -> b
foldr :: forall a b k. (a -> b -> b) -> b -> IntervalMap k a -> b
foldr a -> b -> b
_ b
z IntervalMap k a
Nil = b
z
foldr a -> b -> b
f b
z (Node Color
_ k
_ k
_ a
x IntervalMap k a
l IntervalMap k a
r) = (a -> b -> b) -> b -> IntervalMap k a -> b
forall a b k. (a -> b -> b) -> b -> IntervalMap k a -> b
foldr a -> b -> b
f (a -> b -> b
f a
x ((a -> b -> b) -> b -> IntervalMap k a -> b
forall a b k. (a -> b -> b) -> b -> IntervalMap k a -> b
foldr a -> b -> b
f b
z IntervalMap k a
r)) IntervalMap k a
l

-- | /O(n)/. A strict version of 'foldr'. Each application of the operator is
-- evaluated before using the result in the next application. This
-- function is strict in the starting value.
foldr' :: (a -> b -> b) -> b -> IntervalMap k a -> b
foldr' :: forall a b k. (a -> b -> b) -> b -> IntervalMap k a -> b
foldr' a -> b -> b
f b
z IntervalMap k a
m = b
z b -> b -> b
forall a b. a -> b -> b
`seq` case IntervalMap k a
m of
                         IntervalMap k a
Nil -> b
z
                         Node Color
_ k
_ k
_ a
x IntervalMap k a
l IntervalMap k a
r -> (a -> b -> b) -> b -> IntervalMap k a -> b
forall a b k. (a -> b -> b) -> b -> IntervalMap k a -> b
foldr' a -> b -> b
f (a -> b -> b
f a
x ((a -> b -> b) -> b -> IntervalMap k a -> b
forall a b k. (a -> b -> b) -> b -> IntervalMap k a -> b
foldr' a -> b -> b
f b
z IntervalMap k a
r)) IntervalMap k a
l

-- | /O(n)/. Fold the values in the map using the given left-associative
-- binary operator, such that @'foldl' f z == 'Prelude.foldl' f z . 'elems'@.
foldl :: (b -> a -> b) -> b -> IntervalMap k a -> b
foldl :: forall b a k. (b -> a -> b) -> b -> IntervalMap k a -> b
foldl b -> a -> b
_ b
z IntervalMap k a
Nil = b
z
foldl b -> a -> b
f b
z (Node Color
_ k
_ k
_ a
x IntervalMap k a
l IntervalMap k a
r) = (b -> a -> b) -> b -> IntervalMap k a -> b
forall b a k. (b -> a -> b) -> b -> IntervalMap k a -> b
foldl b -> a -> b
f (b -> a -> b
f ((b -> a -> b) -> b -> IntervalMap k a -> b
forall b a k. (b -> a -> b) -> b -> IntervalMap k a -> b
foldl b -> a -> b
f b
z IntervalMap k a
l) a
x) IntervalMap k a
r

-- | /O(n)/. A strict version of 'foldl'. Each application of the operator is
-- evaluated before using the result in the next application. This
-- function is strict in the starting value.
foldl' :: (b -> a -> b) -> b -> IntervalMap k a -> b
foldl' :: forall b a k. (b -> a -> b) -> b -> IntervalMap k a -> b
foldl' b -> a -> b
f b
z IntervalMap k a
m = b
z b -> b -> b
forall a b. a -> b -> b
`seq` case IntervalMap k a
m of
                         IntervalMap k a
Nil -> b
z
                         Node Color
_ k
_ k
_ a
x IntervalMap k a
l IntervalMap k a
r -> (b -> a -> b) -> b -> IntervalMap k a -> b
forall b a k. (b -> a -> b) -> b -> IntervalMap k a -> b
foldl' b -> a -> b
f (b -> a -> b
f ((b -> a -> b) -> b -> IntervalMap k a -> b
forall b a k. (b -> a -> b) -> b -> IntervalMap k a -> b
foldl' b -> a -> b
f b
z IntervalMap k a
l) a
x) IntervalMap k a
r

-- | /O(n)/. Fold the keys and values in the map using the given right-associative
-- binary operator, such that
-- @'foldrWithKey' f z == 'Prelude.foldr' ('uncurry' f) z . 'toAscList'@.
foldrWithKey :: (k -> v -> a -> a) -> a -> IntervalMap k v -> a
foldrWithKey :: forall k v a. (k -> v -> a -> a) -> a -> IntervalMap k v -> a
foldrWithKey k -> v -> a -> a
_ a
z IntervalMap k v
Nil = a
z
foldrWithKey k -> v -> a -> a
f a
z (Node Color
_ k
k k
_ v
x IntervalMap k v
l IntervalMap k v
r) = (k -> v -> a -> a) -> a -> IntervalMap k v -> a
forall k v a. (k -> v -> a -> a) -> a -> IntervalMap k v -> a
foldrWithKey k -> v -> a -> a
f (k -> v -> a -> a
f k
k v
x ((k -> v -> a -> a) -> a -> IntervalMap k v -> a
forall k v a. (k -> v -> a -> a) -> a -> IntervalMap k v -> a
foldrWithKey k -> v -> a -> a
f a
z IntervalMap k v
r)) IntervalMap k v
l

-- | /O(n)/. A strict version of 'foldrWithKey'. Each application of the operator is
-- evaluated before using the result in the next application. This
-- function is strict in the starting value.
foldrWithKey' :: (k -> v -> a -> a) -> a -> IntervalMap k v -> a
foldrWithKey' :: forall k v a. (k -> v -> a -> a) -> a -> IntervalMap k v -> a
foldrWithKey' k -> v -> a -> a
f a
z IntervalMap k v
m = a
z a -> a -> a
forall a b. a -> b -> b
`seq` case IntervalMap k v
m of
                                IntervalMap k v
Nil -> a
z
                                Node Color
_ k
k k
_ v
x IntervalMap k v
l IntervalMap k v
r -> (k -> v -> a -> a) -> a -> IntervalMap k v -> a
forall k v a. (k -> v -> a -> a) -> a -> IntervalMap k v -> a
foldrWithKey' k -> v -> a -> a
f (k -> v -> a -> a
f k
k v
x ((k -> v -> a -> a) -> a -> IntervalMap k v -> a
forall k v a. (k -> v -> a -> a) -> a -> IntervalMap k v -> a
foldrWithKey' k -> v -> a -> a
f a
z IntervalMap k v
r)) IntervalMap k v
l

-- | /O(n)/. Fold the keys and values in the map using the given left-associative
-- binary operator, such that
-- @'foldlWithKey' f z == 'Prelude.foldl' (\\z' (kx, x) -> f z' kx x) z . 'toAscList'@.
foldlWithKey :: (a -> k -> v -> a) -> a -> IntervalMap k v -> a
foldlWithKey :: forall a k v. (a -> k -> v -> a) -> a -> IntervalMap k v -> a
foldlWithKey a -> k -> v -> a
_ a
z IntervalMap k v
Nil = a
z
foldlWithKey a -> k -> v -> a
f a
z (Node Color
_ k
k k
_ v
x IntervalMap k v
l IntervalMap k v
r) = (a -> k -> v -> a) -> a -> IntervalMap k v -> a
forall a k v. (a -> k -> v -> a) -> a -> IntervalMap k v -> a
foldlWithKey a -> k -> v -> a
f (a -> k -> v -> a
f ((a -> k -> v -> a) -> a -> IntervalMap k v -> a
forall a k v. (a -> k -> v -> a) -> a -> IntervalMap k v -> a
foldlWithKey a -> k -> v -> a
f a
z IntervalMap k v
l) k
k v
x) IntervalMap k v
r

-- | /O(n)/. A strict version of 'foldlWithKey'. Each application of the operator is
-- evaluated before using the result in the next application. This
-- function is strict in the starting value.
foldlWithKey' :: (a -> k -> v -> a) -> a -> IntervalMap k v -> a
foldlWithKey' :: forall a k v. (a -> k -> v -> a) -> a -> IntervalMap k v -> a
foldlWithKey' a -> k -> v -> a
f a
z IntervalMap k v
m = a
z a -> a -> a
forall a b. a -> b -> b
`seq` case IntervalMap k v
m of
                                IntervalMap k v
Nil -> a
z
                                Node Color
_ k
k k
_ v
x IntervalMap k v
l IntervalMap k v
r -> (a -> k -> v -> a) -> a -> IntervalMap k v -> a
forall a k v. (a -> k -> v -> a) -> a -> IntervalMap k v -> a
foldlWithKey' a -> k -> v -> a
f (a -> k -> v -> a
f ((a -> k -> v -> a) -> a -> IntervalMap k v -> a
forall a k v. (a -> k -> v -> a) -> a -> IntervalMap k v -> a
foldlWithKey' a -> k -> v -> a
f a
z IntervalMap k v
l) k
k v
x) IntervalMap k v
r

-- | /O(n log n)/. Build a new map by combining successive key/value pairs.
flattenWith :: (Ord k, Interval k e) => ((k,v) -> (k,v) -> Maybe (k,v)) -> IntervalMap k v -> IntervalMap k v
flattenWith :: forall k e v.
(Ord k, Interval k e) =>
((k, v) -> (k, v) -> Maybe (k, v))
-> IntervalMap k v -> IntervalMap k v
flattenWith (k, v) -> (k, v) -> Maybe (k, v)
combine IntervalMap k v
m = [(k, v)] -> IntervalMap k v
forall k e v. (Interval k e, Ord k) => [(k, v)] -> IntervalMap k v
fromList (((k, v) -> (k, v) -> Maybe (k, v)) -> IntervalMap k v -> [(k, v)]
forall k v.
((k, v) -> (k, v) -> Maybe (k, v)) -> IntervalMap k v -> [(k, v)]
combineSuccessive (k, v) -> (k, v) -> Maybe (k, v)
combine IntervalMap k v
m)

-- | /O(n)/. Build a new map by combining successive key/value pairs.
-- Same as 'flattenWith', but works only when the combining functions returns
-- strictly monotonic key values.
flattenWithMonotonic :: (Interval k e) => ((k,v) -> (k,v) -> Maybe (k,v)) -> IntervalMap k v -> IntervalMap k v
flattenWithMonotonic :: forall k e v.
Interval k e =>
((k, v) -> (k, v) -> Maybe (k, v))
-> IntervalMap k v -> IntervalMap k v
flattenWithMonotonic (k, v) -> (k, v) -> Maybe (k, v)
combine IntervalMap k v
m = [(k, v)] -> IntervalMap k v
forall k e v. Interval k e => [(k, v)] -> IntervalMap k v
fromDistinctAscList (((k, v) -> (k, v) -> Maybe (k, v)) -> IntervalMap k v -> [(k, v)]
forall k v.
((k, v) -> (k, v) -> Maybe (k, v)) -> IntervalMap k v -> [(k, v)]
combineSuccessive (k, v) -> (k, v) -> Maybe (k, v)
combine IntervalMap k v
m)

combineSuccessive :: ((k,v) -> (k,v) -> Maybe (k,v)) -> IntervalMap k v -> [(k,v)]
combineSuccessive :: forall k v.
((k, v) -> (k, v) -> Maybe (k, v)) -> IntervalMap k v -> [(k, v)]
combineSuccessive (k, v) -> (k, v) -> Maybe (k, v)
combine IntervalMap k v
m = [(k, v)] -> [(k, v)]
go (IntervalMap k v -> [(k, v)]
forall k v. IntervalMap k v -> [(k, v)]
toAscList IntervalMap k v
m)
  where
    go :: [(k, v)] -> [(k, v)]
go ((k, v)
x : xs :: [(k, v)]
xs@((k, v)
y:[(k, v)]
ys)) = case (k, v) -> (k, v) -> Maybe (k, v)
combine (k, v)
x (k, v)
y of
                           Maybe (k, v)
Nothing -> (k, v)
x (k, v) -> [(k, v)] -> [(k, v)]
forall a. a -> [a] -> [a]
: [(k, v)] -> [(k, v)]
go [(k, v)]
xs
                           Just (k, v)
x' -> [(k, v)] -> [(k, v)]
go ((k, v)
x' (k, v) -> [(k, v)] -> [(k, v)]
forall a. a -> [a] -> [a]
: [(k, v)]
ys)
    go [(k, v)]
xs = [(k, v)]
xs


-- delete

-- | /O(log n)/. Delete a key from the map. If the map does not contain the key,
-- it is returned unchanged.
delete :: (Interval k e, Ord k) => k -> IntervalMap k v -> IntervalMap k v
delete :: forall k e v.
(Interval k e, Ord k) =>
k -> IntervalMap k v -> IntervalMap k v
delete k
key IntervalMap k v
mp = IntervalMap k v -> IntervalMap k v
forall k v. IntervalMap k v -> IntervalMap k v
turnBlack (DeleteResult k v -> IntervalMap k v
forall k v. DeleteResult k v -> IntervalMap k v
unwrap (k -> IntervalMap k v -> DeleteResult k v
forall k e v.
(Interval k e, Ord k) =>
k -> IntervalMap k v -> DeleteResult k v
delete' k
key IntervalMap k v
mp))

delete' :: (Interval k e, Ord k) => k -> IntervalMap k v -> DeleteResult k v
delete' :: forall k e v.
(Interval k e, Ord k) =>
k -> IntervalMap k v -> DeleteResult k v
delete' k
x IntervalMap k v
Nil = k
x k -> DeleteResult k v -> DeleteResult k v
forall a b. a -> b -> b
`seq` IntervalMap k v -> DeleteResult k v
forall k v. IntervalMap k v -> DeleteResult k v
U IntervalMap k v
forall k v. IntervalMap k v
Nil
delete' k
x (Node Color
c k
k k
_ v
v IntervalMap k v
l IntervalMap k v
r) =
  case k -> k -> Ordering
forall a. Ord a => a -> a -> Ordering
compare k
x k
k of
    Ordering
LT -> case k -> IntervalMap k v -> DeleteResult k v
forall k e v.
(Interval k e, Ord k) =>
k -> IntervalMap k v -> DeleteResult k v
delete' k
x IntervalMap k v
l of
            (U IntervalMap k v
l') -> IntervalMap k v -> DeleteResult k v
forall k v. IntervalMap k v -> DeleteResult k v
U (Color
-> k -> v -> IntervalMap k v -> IntervalMap k v -> IntervalMap k v
forall k e v.
Interval k e =>
Color
-> k -> v -> IntervalMap k v -> IntervalMap k v -> IntervalMap k v
mNode Color
c k
k v
v IntervalMap k v
l' IntervalMap k v
r)
            (S IntervalMap k v
l')    -> Color
-> k -> v -> IntervalMap k v -> IntervalMap k v -> DeleteResult k v
forall k e v.
Interval k e =>
Color
-> k -> v -> IntervalMap k v -> IntervalMap k v -> DeleteResult k v
unbalancedR Color
c k
k v
v IntervalMap k v
l' IntervalMap k v
r
    Ordering
GT -> case k -> IntervalMap k v -> DeleteResult k v
forall k e v.
(Interval k e, Ord k) =>
k -> IntervalMap k v -> DeleteResult k v
delete' k
x IntervalMap k v
r of
            (U IntervalMap k v
r') -> IntervalMap k v -> DeleteResult k v
forall k v. IntervalMap k v -> DeleteResult k v
U (Color
-> k -> v -> IntervalMap k v -> IntervalMap k v -> IntervalMap k v
forall k e v.
Interval k e =>
Color
-> k -> v -> IntervalMap k v -> IntervalMap k v -> IntervalMap k v
mNode Color
c k
k v
v IntervalMap k v
l IntervalMap k v
r')
            (S IntervalMap k v
r')    -> Color
-> k -> v -> IntervalMap k v -> IntervalMap k v -> DeleteResult k v
forall k e v.
Interval k e =>
Color
-> k -> v -> IntervalMap k v -> IntervalMap k v -> DeleteResult k v
unbalancedL Color
c k
k v
v IntervalMap k v
l IntervalMap k v
r'
    Ordering
EQ -> case IntervalMap k v
r of
            IntervalMap k v
Nil -> if Color
c Color -> Color -> Bool
forall a. Eq a => a -> a -> Bool
== Color
B then IntervalMap k v -> DeleteResult k v
forall k v. IntervalMap k v -> DeleteResult k v
blackify IntervalMap k v
l else IntervalMap k v -> DeleteResult k v
forall k v. IntervalMap k v -> DeleteResult k v
U IntervalMap k v
l
            IntervalMap k v
_ -> case IntervalMap k v -> DeleteResult' k v (k, v)
forall k e v.
(Interval k e, Ord k) =>
IntervalMap k v -> DeleteResult' k v (k, v)
deleteMin' IntervalMap k v
r of
                   (U' IntervalMap k v
r' (k
rk,v
rv)) -> IntervalMap k v -> DeleteResult k v
forall k v. IntervalMap k v -> DeleteResult k v
U (Color
-> k -> v -> IntervalMap k v -> IntervalMap k v -> IntervalMap k v
forall k e v.
Interval k e =>
Color
-> k -> v -> IntervalMap k v -> IntervalMap k v -> IntervalMap k v
mNode Color
c k
rk v
rv IntervalMap k v
l IntervalMap k v
r')
                   (S' IntervalMap k v
r' (k
rk,v
rv)) -> Color
-> k -> v -> IntervalMap k v -> IntervalMap k v -> DeleteResult k v
forall k e v.
Interval k e =>
Color
-> k -> v -> IntervalMap k v -> IntervalMap k v -> DeleteResult k v
unbalancedL Color
c k
rk v
rv IntervalMap k v
l IntervalMap k v
r'

blackify :: IntervalMap k v -> DeleteResult k v
blackify :: forall k v. IntervalMap k v -> DeleteResult k v
blackify (Node Color
R k
k k
m v
v IntervalMap k v
l IntervalMap k v
r) = IntervalMap k v -> DeleteResult k v
forall k v. IntervalMap k v -> DeleteResult k v
U (Color
-> k
-> k
-> v
-> IntervalMap k v
-> IntervalMap k v
-> IntervalMap k v
forall k v.
Color
-> k
-> k
-> v
-> IntervalMap k v
-> IntervalMap k v
-> IntervalMap k v
Node Color
B k
k k
m v
v IntervalMap k v
l IntervalMap k v
r)
blackify IntervalMap k v
s                  = IntervalMap k v -> DeleteResult k v
forall k v. IntervalMap k v -> DeleteResult k v
S IntervalMap k v
s

-- | /O(log n)/. Update a value at a specific key with the result of the provided function.
-- When the key is not
-- a member of the map, the original map is returned.
adjust :: Ord k => (a -> a) -> k -> IntervalMap k a -> IntervalMap k a
adjust :: forall k a.
Ord k =>
(a -> a) -> k -> IntervalMap k a -> IntervalMap k a
adjust a -> a
f k
k IntervalMap k a
m = (k -> a -> a) -> k -> IntervalMap k a -> IntervalMap k a
forall k a.
Ord k =>
(k -> a -> a) -> k -> IntervalMap k a -> IntervalMap k a
adjustWithKey (\k
_ a
v -> a -> a
f a
v) k
k IntervalMap k a
m

-- | /O(log n)/. Adjust a value at a specific key. When the key is not
-- a member of the map, the original map is returned.
adjustWithKey :: Ord k => (k -> a -> a) -> k -> IntervalMap k a -> IntervalMap k a
adjustWithKey :: forall k a.
Ord k =>
(k -> a -> a) -> k -> IntervalMap k a -> IntervalMap k a
adjustWithKey k -> a -> a
_ k
_ IntervalMap k a
Nil = IntervalMap k a
forall k v. IntervalMap k v
Nil
adjustWithKey k -> a -> a
f k
x (Node Color
c k
k k
m a
v IntervalMap k a
l IntervalMap k a
r) =
  case k -> k -> Ordering
forall a. Ord a => a -> a -> Ordering
compare k
x k
k of
    Ordering
LT -> Color
-> k
-> k
-> a
-> IntervalMap k a
-> IntervalMap k a
-> IntervalMap k a
forall k v.
Color
-> k
-> k
-> v
-> IntervalMap k v
-> IntervalMap k v
-> IntervalMap k v
Node Color
c k
k k
m a
v ((k -> a -> a) -> k -> IntervalMap k a -> IntervalMap k a
forall k a.
Ord k =>
(k -> a -> a) -> k -> IntervalMap k a -> IntervalMap k a
adjustWithKey k -> a -> a
f k
x IntervalMap k a
l) IntervalMap k a
r
    Ordering
GT -> Color
-> k
-> k
-> a
-> IntervalMap k a
-> IntervalMap k a
-> IntervalMap k a
forall k v.
Color
-> k
-> k
-> v
-> IntervalMap k v
-> IntervalMap k v
-> IntervalMap k v
Node Color
c k
k k
m a
v IntervalMap k a
l ((k -> a -> a) -> k -> IntervalMap k a -> IntervalMap k a
forall k a.
Ord k =>
(k -> a -> a) -> k -> IntervalMap k a -> IntervalMap k a
adjustWithKey k -> a -> a
f k
x IntervalMap k a
r)
    Ordering
EQ -> Color
-> k
-> k
-> a
-> IntervalMap k a
-> IntervalMap k a
-> IntervalMap k a
forall k v.
Color
-> k
-> k
-> v
-> IntervalMap k v
-> IntervalMap k v
-> IntervalMap k v
Node Color
c k
k k
m (k -> a -> a
f k
k a
v) IntervalMap k a
l IntervalMap k a
r

-- | /O(log n)/. The expression (@'update' f k map@) updates the value @x@
-- at @k@ (if it is in the map). If (@f x@) is 'Nothing', the element is
-- deleted. If it is (@'Just' y@), the key @k@ is bound to the new value @y@.
update :: (Interval k e, Ord k) => (a -> Maybe a) -> k -> IntervalMap k a -> IntervalMap k a
update :: forall k e a.
(Interval k e, Ord k) =>
(a -> Maybe a) -> k -> IntervalMap k a -> IntervalMap k a
update a -> Maybe a
f k
k IntervalMap k a
m = (k -> a -> Maybe a) -> k -> IntervalMap k a -> IntervalMap k a
forall k e a.
(Interval k e, Ord k) =>
(k -> a -> Maybe a) -> k -> IntervalMap k a -> IntervalMap k a
updateWithKey (\k
_ a
v -> a -> Maybe a
f a
v) k
k IntervalMap k a
m

-- | /O(log n)/. The expression (@'updateWithKey' f k map@) updates the
-- value @x@ at @k@ (if it is in the map). If (@f k x@) is 'Nothing',
-- the element is deleted. If it is (@'Just' y@), the key @k@ is bound
-- to the new value @y@.
updateWithKey :: (Interval k e, Ord k) => (k -> a -> Maybe a) -> k -> IntervalMap k a -> IntervalMap k a
updateWithKey :: forall k e a.
(Interval k e, Ord k) =>
(k -> a -> Maybe a) -> k -> IntervalMap k a -> IntervalMap k a
updateWithKey k -> a -> Maybe a
f k
k IntervalMap k a
m = (Maybe a, IntervalMap k a) -> IntervalMap k a
forall a b. (a, b) -> b
snd ((k -> a -> Maybe a)
-> k -> IntervalMap k a -> (Maybe a, IntervalMap k a)
forall k e a.
(Interval k e, Ord k) =>
(k -> a -> Maybe a)
-> k -> IntervalMap k a -> (Maybe a, IntervalMap k a)
updateLookupWithKey k -> a -> Maybe a
f k
k IntervalMap k a
m)

-- | /O(log n)/. Lookup and update. See also 'updateWithKey'.
-- The function returns changed value, if it is updated.
-- Returns the original key value if the map entry is deleted.
updateLookupWithKey :: (Interval k e, Ord k) => (k -> a -> Maybe a) -> k -> IntervalMap k a -> (Maybe a, IntervalMap k a)
updateLookupWithKey :: forall k e a.
(Interval k e, Ord k) =>
(k -> a -> Maybe a)
-> k -> IntervalMap k a -> (Maybe a, IntervalMap k a)
updateLookupWithKey k -> a -> Maybe a
f k
x IntervalMap k a
m = case k -> IntervalMap k a -> Maybe a
forall k v. Ord k => k -> IntervalMap k v -> Maybe v
lookup k
x IntervalMap k a
m of
                              Maybe a
Nothing -> (Maybe a
forall a. Maybe a
Nothing, IntervalMap k a
m)
                              r :: Maybe a
r@(Just a
v) -> case k -> a -> Maybe a
f k
x a
v of
                                              Maybe a
Nothing -> (Maybe a
r, k -> IntervalMap k a -> IntervalMap k a
forall k e v.
(Interval k e, Ord k) =>
k -> IntervalMap k v -> IntervalMap k v
delete k
x IntervalMap k a
m)
                                              r' :: Maybe a
r'@(Just a
v') -> (Maybe a
r', (a -> a) -> k -> IntervalMap k a -> IntervalMap k a
forall k a.
Ord k =>
(a -> a) -> k -> IntervalMap k a -> IntervalMap k a
adjust (a -> a -> a
forall a b. a -> b -> a
const a
v') k
x IntervalMap k a
m)

-- | /O(log n)/. The expression (@'alter' f k map@) alters the value @x@ at @k@, or absence thereof.
-- 'alter' can be used to insert, delete, or update a value in a 'Map'.
-- In short : @'lookup' k ('alter' f k m) = f ('lookup' k m)@.
alter :: (Interval k e, Ord k) => (Maybe a -> Maybe a) -> k -> IntervalMap k a -> IntervalMap k a
alter :: forall k e a.
(Interval k e, Ord k) =>
(Maybe a -> Maybe a) -> k -> IntervalMap k a -> IntervalMap k a
alter Maybe a -> Maybe a
f k
x IntervalMap k a
m = case k -> IntervalMap k a -> Maybe a
forall k v. Ord k => k -> IntervalMap k v -> Maybe v
lookup k
x IntervalMap k a
m of
                Maybe a
Nothing -> case Maybe a -> Maybe a
f Maybe a
forall a. Maybe a
Nothing of
                             Maybe a
Nothing -> IntervalMap k a
m
                             Just a
v -> k -> a -> IntervalMap k a -> IntervalMap k a
forall k e v.
(Interval k e, Ord k) =>
k -> v -> IntervalMap k v -> IntervalMap k v
insert k
x a
v IntervalMap k a
m
                Maybe a
y       -> case Maybe a -> Maybe a
f Maybe a
y of
                             Maybe a
Nothing -> k -> IntervalMap k a -> IntervalMap k a
forall k e v.
(Interval k e, Ord k) =>
k -> IntervalMap k v -> IntervalMap k v
delete k
x IntervalMap k a
m
                             Just a
v' -> (a -> a) -> k -> IntervalMap k a -> IntervalMap k a
forall k a.
Ord k =>
(a -> a) -> k -> IntervalMap k a -> IntervalMap k a
adjust (a -> a -> a
forall a b. a -> b -> a
const a
v') k
x IntervalMap k a
m


-- | /O(n+m)/. The expression (@'union' t1 t2@) takes the left-biased union of @t1@ and @t2@. 
-- It prefers @t1@ when duplicate keys are encountered,
-- i.e. (@'union' == 'unionWith' 'const'@).
union :: (Interval k e, Ord k) => IntervalMap k a -> IntervalMap k a -> IntervalMap k a
union :: forall i k v.
(Interval i k, Ord i) =>
IntervalMap i v -> IntervalMap i v -> IntervalMap i v
union IntervalMap k a
m1 IntervalMap k a
m2 = (k -> a -> a -> a)
-> IntervalMap k a -> IntervalMap k a -> IntervalMap k a
forall k e a.
(Interval k e, Ord k) =>
(k -> a -> a -> a)
-> IntervalMap k a -> IntervalMap k a -> IntervalMap k a
unionWithKey (\k
_ a
v a
_ -> a
v) IntervalMap k a
m1 IntervalMap k a
m2

-- | /O(n+m)/. Union with a combining function.
unionWith :: (Interval k e, Ord k) => (a -> a -> a) -> IntervalMap k a -> IntervalMap k a -> IntervalMap k a
unionWith :: forall k e a.
(Interval k e, Ord k) =>
(a -> a -> a)
-> IntervalMap k a -> IntervalMap k a -> IntervalMap k a
unionWith a -> a -> a
f IntervalMap k a
m1 IntervalMap k a
m2 = (k -> a -> a -> a)
-> IntervalMap k a -> IntervalMap k a -> IntervalMap k a
forall k e a.
(Interval k e, Ord k) =>
(k -> a -> a -> a)
-> IntervalMap k a -> IntervalMap k a -> IntervalMap k a
unionWithKey (\k
_ a
v1 a
v2 -> a -> a -> a
f a
v1 a
v2) IntervalMap k a
m1 IntervalMap k a
m2

-- | /O(n+m)/. Union with a combining function.
unionWithKey :: (Interval k e, Ord k) => (k -> a -> a -> a) -> IntervalMap k a -> IntervalMap k a -> IntervalMap k a
unionWithKey :: forall k e a.
(Interval k e, Ord k) =>
(k -> a -> a -> a)
-> IntervalMap k a -> IntervalMap k a -> IntervalMap k a
unionWithKey k -> a -> a -> a
f IntervalMap k a
m1 IntervalMap k a
m2 = [(k, a)] -> IntervalMap k a
forall k e v. Interval k e => [(k, v)] -> IntervalMap k v
fromDistinctAscList ((k -> a -> a -> a) -> [(k, a)] -> [(k, a)] -> [(k, a)]
forall k a.
Ord k =>
(k -> a -> a -> a) -> [(k, a)] -> [(k, a)] -> [(k, a)]
ascListUnion k -> a -> a -> a
f (IntervalMap k a -> [(k, a)]
forall k v. IntervalMap k v -> [(k, v)]
toAscList IntervalMap k a
m1) (IntervalMap k a -> [(k, a)]
forall k v. IntervalMap k v -> [(k, v)]
toAscList IntervalMap k a
m2))

-- | The union of a list of maps:
--   (@'unions' == 'Prelude.foldl' 'union' 'empty'@).
unions :: (Interval k e, Ord k) => [IntervalMap k a] -> IntervalMap k a
unions :: forall k e a.
(Interval k e, Ord k) =>
[IntervalMap k a] -> IntervalMap k a
unions [IntervalMap k a]
ms = (a -> a -> a) -> [IntervalMap k a] -> IntervalMap k a
forall k e a.
(Interval k e, Ord k) =>
(a -> a -> a) -> [IntervalMap k a] -> IntervalMap k a
unionsWith a -> a -> a
forall a b. a -> b -> a
const [IntervalMap k a]
ms

-- | The union of a list of maps, with a combining operation:
--   (@'unionsWith' f == 'Prelude.foldl' ('unionWith' f) 'empty'@).
unionsWith :: (Interval k e, Ord k) => (a -> a -> a) -> [IntervalMap k a] -> IntervalMap k a
unionsWith :: forall k e a.
(Interval k e, Ord k) =>
(a -> a -> a) -> [IntervalMap k a] -> IntervalMap k a
unionsWith a -> a -> a
_ []  = IntervalMap k a
forall k v. IntervalMap k v
empty
unionsWith a -> a -> a
_ [IntervalMap k a
m] = IntervalMap k a
m
unionsWith a -> a -> a
f [IntervalMap k a]
ms = [(k, a)] -> IntervalMap k a
forall k e v. Interval k e => [(k, v)] -> IntervalMap k v
fromDistinctAscList ([[(k, a)]] -> [(k, a)]
forall a. HasCallStack => [a] -> a
head ([[(k, a)]] -> [[(k, a)]]
forall {k}. Ord k => [[(k, a)]] -> [[(k, a)]]
go ((IntervalMap k a -> [(k, a)]) -> [IntervalMap k a] -> [[(k, a)]]
forall a b. (a -> b) -> [a] -> [b]
L.map IntervalMap k a -> [(k, a)]
forall k v. IntervalMap k v -> [(k, v)]
toAscList [IntervalMap k a]
ms)))
  where
    f' :: p -> a -> a -> a
f' p
_ a
l a
r = a -> a -> a
f a
l a
r
    merge :: [(k, a)] -> [(k, a)] -> [(k, a)]
merge [(k, a)]
m1 [(k, a)]
m2 = (k -> a -> a -> a) -> [(k, a)] -> [(k, a)] -> [(k, a)]
forall k a.
Ord k =>
(k -> a -> a -> a) -> [(k, a)] -> [(k, a)] -> [(k, a)]
ascListUnion k -> a -> a -> a
forall {p}. p -> a -> a -> a
f' [(k, a)]
m1 [(k, a)]
m2
    go :: [[(k, a)]] -> [[(k, a)]]
go [] = []
    go xs :: [[(k, a)]]
xs@[[(k, a)]
_] = [[(k, a)]]
xs
    go ([(k, a)]
x:[(k, a)]
y:[[(k, a)]]
xs) = [[(k, a)]] -> [[(k, a)]]
go ([(k, a)] -> [(k, a)] -> [(k, a)]
forall {k}. Ord k => [(k, a)] -> [(k, a)] -> [(k, a)]
merge [(k, a)]
x [(k, a)]
y [(k, a)] -> [[(k, a)]] -> [[(k, a)]]
forall a. a -> [a] -> [a]
: [[(k, a)]] -> [[(k, a)]]
go [[(k, a)]]
xs)

-- | /O(n+m)/. Difference of two maps. 
-- Return elements of the first map not existing in the second map.
difference :: (Interval k e, Ord k) => IntervalMap k a -> IntervalMap k b -> IntervalMap k a
difference :: forall k e a b.
(Interval k e, Ord k) =>
IntervalMap k a -> IntervalMap k b -> IntervalMap k a
difference IntervalMap k a
m1 IntervalMap k b
m2 = (k -> a -> b -> Maybe a)
-> IntervalMap k a -> IntervalMap k b -> IntervalMap k a
forall k e a b.
(Interval k e, Ord k) =>
(k -> a -> b -> Maybe a)
-> IntervalMap k a -> IntervalMap k b -> IntervalMap k a
differenceWithKey (\k
_ a
_ b
_ -> Maybe a
forall a. Maybe a
Nothing) IntervalMap k a
m1 IntervalMap k b
m2

-- | /O(n+m)/. Difference with a combining function. 
-- When two equal keys are
-- encountered, the combining function is applied to the values of these keys.
-- If it returns 'Nothing', the element is discarded (proper set difference). If
-- it returns (@'Just' y@), the element is updated with a new value @y@. 
differenceWith :: (Interval k e, Ord k) => (a -> b -> Maybe a) -> IntervalMap k a -> IntervalMap k b -> IntervalMap k a
differenceWith :: forall k e a b.
(Interval k e, Ord k) =>
(a -> b -> Maybe a)
-> IntervalMap k a -> IntervalMap k b -> IntervalMap k a
differenceWith a -> b -> Maybe a
f IntervalMap k a
m1 IntervalMap k b
m2 = (k -> a -> b -> Maybe a)
-> IntervalMap k a -> IntervalMap k b -> IntervalMap k a
forall k e a b.
(Interval k e, Ord k) =>
(k -> a -> b -> Maybe a)
-> IntervalMap k a -> IntervalMap k b -> IntervalMap k a
differenceWithKey (\k
_ a
v1 b
v2 -> a -> b -> Maybe a
f a
v1 b
v2) IntervalMap k a
m1 IntervalMap k b
m2

-- | /O(n+m)/. Difference with a combining function. When two equal keys are
-- encountered, the combining function is applied to the key and both values.
-- If it returns 'Nothing', the element is discarded (proper set difference). If
-- it returns (@'Just' y@), the element is updated with a new value @y@. 
differenceWithKey :: (Interval k e, Ord k) => (k -> a -> b -> Maybe a) -> IntervalMap k a -> IntervalMap k b -> IntervalMap k a
differenceWithKey :: forall k e a b.
(Interval k e, Ord k) =>
(k -> a -> b -> Maybe a)
-> IntervalMap k a -> IntervalMap k b -> IntervalMap k a
differenceWithKey k -> a -> b -> Maybe a
f IntervalMap k a
m1 IntervalMap k b
m2 = [(k, a)] -> IntervalMap k a
forall k e v. Interval k e => [(k, v)] -> IntervalMap k v
fromDistinctAscList ((k -> a -> b -> Maybe a) -> [(k, a)] -> [(k, b)] -> [(k, a)]
forall k a b.
Ord k =>
(k -> a -> b -> Maybe a) -> [(k, a)] -> [(k, b)] -> [(k, a)]
ascListDifference k -> a -> b -> Maybe a
f (IntervalMap k a -> [(k, a)]
forall k v. IntervalMap k v -> [(k, v)]
toAscList IntervalMap k a
m1) (IntervalMap k b -> [(k, b)]
forall k v. IntervalMap k v -> [(k, v)]
toAscList IntervalMap k b
m2))

-- | /O(n+m)/. Intersection of two maps.
-- Return data in the first map for the keys existing in both maps.
-- (@'intersection' m1 m2 == 'intersectionWith' 'const' m1 m2@).
intersection :: (Interval k e, Ord k) => IntervalMap k a -> IntervalMap k b -> IntervalMap k a
intersection :: forall k e a b.
(Interval k e, Ord k) =>
IntervalMap k a -> IntervalMap k b -> IntervalMap k a
intersection IntervalMap k a
m1 IntervalMap k b
m2 = (k -> a -> b -> a)
-> IntervalMap k a -> IntervalMap k b -> IntervalMap k a
forall k e a b c.
(Interval k e, Ord k) =>
(k -> a -> b -> c)
-> IntervalMap k a -> IntervalMap k b -> IntervalMap k c
intersectionWithKey (\k
_ a
v b
_ -> a
v) IntervalMap k a
m1 IntervalMap k b
m2

-- | /O(n+m)/. Intersection with a combining function.
intersectionWith :: (Interval k e, Ord k) => (a -> b -> c) -> IntervalMap k a -> IntervalMap k b -> IntervalMap k c
intersectionWith :: forall k e a b c.
(Interval k e, Ord k) =>
(a -> b -> c)
-> IntervalMap k a -> IntervalMap k b -> IntervalMap k c
intersectionWith a -> b -> c
f IntervalMap k a
m1 IntervalMap k b
m2 = (k -> a -> b -> c)
-> IntervalMap k a -> IntervalMap k b -> IntervalMap k c
forall k e a b c.
(Interval k e, Ord k) =>
(k -> a -> b -> c)
-> IntervalMap k a -> IntervalMap k b -> IntervalMap k c
intersectionWithKey (\k
_ a
v1 b
v2 -> a -> b -> c
f a
v1 b
v2) IntervalMap k a
m1 IntervalMap k b
m2

-- | /O(n+m)/. Intersection with a combining function.
intersectionWithKey :: (Interval k e, Ord k) => (k -> a -> b -> c) -> IntervalMap k a -> IntervalMap k b -> IntervalMap k c
intersectionWithKey :: forall k e a b c.
(Interval k e, Ord k) =>
(k -> a -> b -> c)
-> IntervalMap k a -> IntervalMap k b -> IntervalMap k c
intersectionWithKey k -> a -> b -> c
f IntervalMap k a
m1 IntervalMap k b
m2 = [(k, c)] -> IntervalMap k c
forall k e v. Interval k e => [(k, v)] -> IntervalMap k v
fromDistinctAscList ((k -> a -> b -> c) -> [(k, a)] -> [(k, b)] -> [(k, c)]
forall k a b c.
Ord k =>
(k -> a -> b -> c) -> [(k, a)] -> [(k, b)] -> [(k, c)]
ascListIntersection k -> a -> b -> c
f (IntervalMap k a -> [(k, a)]
forall k v. IntervalMap k v -> [(k, v)]
toAscList IntervalMap k a
m1) (IntervalMap k b -> [(k, b)]
forall k v. IntervalMap k v -> [(k, v)]
toAscList IntervalMap k b
m2))

ascListUnion :: Ord k => (k -> a -> a -> a) -> [(k,a)] -> [(k,a)] -> [(k,a)]
ascListUnion :: forall k a.
Ord k =>
(k -> a -> a -> a) -> [(k, a)] -> [(k, a)] -> [(k, a)]
ascListUnion k -> a -> a -> a
_ [] [] = []
ascListUnion k -> a -> a -> a
_ [] [(k, a)]
ys = [(k, a)]
ys
ascListUnion k -> a -> a -> a
_ [(k, a)]
xs [] = [(k, a)]
xs
ascListUnion k -> a -> a -> a
f xs :: [(k, a)]
xs@(x :: (k, a)
x@(k
xk,a
xv):[(k, a)]
xs') ys :: [(k, a)]
ys@(y :: (k, a)
y@(k
yk,a
yv):[(k, a)]
ys') =
  case k -> k -> Ordering
forall a. Ord a => a -> a -> Ordering
compare k
xk k
yk of
    Ordering
LT -> (k, a)
x (k, a) -> [(k, a)] -> [(k, a)]
forall a. a -> [a] -> [a]
: (k -> a -> a -> a) -> [(k, a)] -> [(k, a)] -> [(k, a)]
forall k a.
Ord k =>
(k -> a -> a -> a) -> [(k, a)] -> [(k, a)] -> [(k, a)]
ascListUnion k -> a -> a -> a
f [(k, a)]
xs' [(k, a)]
ys
    Ordering
GT -> (k, a)
y (k, a) -> [(k, a)] -> [(k, a)]
forall a. a -> [a] -> [a]
: (k -> a -> a -> a) -> [(k, a)] -> [(k, a)] -> [(k, a)]
forall k a.
Ord k =>
(k -> a -> a -> a) -> [(k, a)] -> [(k, a)] -> [(k, a)]
ascListUnion k -> a -> a -> a
f [(k, a)]
xs [(k, a)]
ys'
    Ordering
EQ -> (k
xk, k -> a -> a -> a
f k
xk a
xv a
yv) (k, a) -> [(k, a)] -> [(k, a)]
forall a. a -> [a] -> [a]
: (k -> a -> a -> a) -> [(k, a)] -> [(k, a)] -> [(k, a)]
forall k a.
Ord k =>
(k -> a -> a -> a) -> [(k, a)] -> [(k, a)] -> [(k, a)]
ascListUnion k -> a -> a -> a
f [(k, a)]
xs' [(k, a)]
ys'

ascListDifference :: Ord k => (k -> a -> b -> Maybe a) -> [(k,a)] -> [(k,b)] -> [(k,a)]
ascListDifference :: forall k a b.
Ord k =>
(k -> a -> b -> Maybe a) -> [(k, a)] -> [(k, b)] -> [(k, a)]
ascListDifference k -> a -> b -> Maybe a
_ [] [(k, b)]
_  = []
ascListDifference k -> a -> b -> Maybe a
_ [(k, a)]
xs [] = [(k, a)]
xs
ascListDifference k -> a -> b -> Maybe a
f xs :: [(k, a)]
xs@(x :: (k, a)
x@(k
xk,a
xv):[(k, a)]
xs') ys :: [(k, b)]
ys@((k
yk,b
yv):[(k, b)]
ys') =
  case k -> k -> Ordering
forall a. Ord a => a -> a -> Ordering
compare k
xk k
yk of
    Ordering
LT -> (k, a)
x (k, a) -> [(k, a)] -> [(k, a)]
forall a. a -> [a] -> [a]
: (k -> a -> b -> Maybe a) -> [(k, a)] -> [(k, b)] -> [(k, a)]
forall k a b.
Ord k =>
(k -> a -> b -> Maybe a) -> [(k, a)] -> [(k, b)] -> [(k, a)]
ascListDifference k -> a -> b -> Maybe a
f [(k, a)]
xs' [(k, b)]
ys
    Ordering
GT -> (k -> a -> b -> Maybe a) -> [(k, a)] -> [(k, b)] -> [(k, a)]
forall k a b.
Ord k =>
(k -> a -> b -> Maybe a) -> [(k, a)] -> [(k, b)] -> [(k, a)]
ascListDifference k -> a -> b -> Maybe a
f [(k, a)]
xs [(k, b)]
ys'
    Ordering
EQ -> case k -> a -> b -> Maybe a
f k
xk a
xv b
yv of
            Maybe a
Nothing -> (k -> a -> b -> Maybe a) -> [(k, a)] -> [(k, b)] -> [(k, a)]
forall k a b.
Ord k =>
(k -> a -> b -> Maybe a) -> [(k, a)] -> [(k, b)] -> [(k, a)]
ascListDifference k -> a -> b -> Maybe a
f [(k, a)]
xs' [(k, b)]
ys'
            Just a
v' -> (k
xk,a
v') (k, a) -> [(k, a)] -> [(k, a)]
forall a. a -> [a] -> [a]
: (k -> a -> b -> Maybe a) -> [(k, a)] -> [(k, b)] -> [(k, a)]
forall k a b.
Ord k =>
(k -> a -> b -> Maybe a) -> [(k, a)] -> [(k, b)] -> [(k, a)]
ascListDifference k -> a -> b -> Maybe a
f [(k, a)]
xs' [(k, b)]
ys'

ascListIntersection :: Ord k => (k -> a -> b -> c) -> [(k,a)] -> [(k,b)] -> [(k,c)]
ascListIntersection :: forall k a b c.
Ord k =>
(k -> a -> b -> c) -> [(k, a)] -> [(k, b)] -> [(k, c)]
ascListIntersection k -> a -> b -> c
_ [] [(k, b)]
_ = []
ascListIntersection k -> a -> b -> c
_ [(k, a)]
_ [] = []
ascListIntersection k -> a -> b -> c
f xs :: [(k, a)]
xs@((k
xk,a
xv):[(k, a)]
xs') ys :: [(k, b)]
ys@((k
yk,b
yv):[(k, b)]
ys') =
  case k -> k -> Ordering
forall a. Ord a => a -> a -> Ordering
compare k
xk k
yk of
    Ordering
LT -> (k -> a -> b -> c) -> [(k, a)] -> [(k, b)] -> [(k, c)]
forall k a b c.
Ord k =>
(k -> a -> b -> c) -> [(k, a)] -> [(k, b)] -> [(k, c)]
ascListIntersection k -> a -> b -> c
f [(k, a)]
xs' [(k, b)]
ys
    Ordering
GT -> (k -> a -> b -> c) -> [(k, a)] -> [(k, b)] -> [(k, c)]
forall k a b c.
Ord k =>
(k -> a -> b -> c) -> [(k, a)] -> [(k, b)] -> [(k, c)]
ascListIntersection k -> a -> b -> c
f [(k, a)]
xs [(k, b)]
ys'
    Ordering
EQ -> (k
xk, k -> a -> b -> c
f k
xk a
xv b
yv) (k, c) -> [(k, c)] -> [(k, c)]
forall a. a -> [a] -> [a]
: (k -> a -> b -> c) -> [(k, a)] -> [(k, b)] -> [(k, c)]
forall k a b c.
Ord k =>
(k -> a -> b -> c) -> [(k, a)] -> [(k, b)] -> [(k, c)]
ascListIntersection k -> a -> b -> c
f [(k, a)]
xs' [(k, b)]
ys'


-- --- Conversion ---

-- | /O(n)/. The list of all key\/value pairs contained in the map, in ascending order of keys.
toAscList :: IntervalMap k v -> [(k,v)]
toAscList :: forall k v. IntervalMap k v -> [(k, v)]
toAscList IntervalMap k v
m = (k -> v -> [(k, v)] -> [(k, v)])
-> [(k, v)] -> IntervalMap k v -> [(k, v)]
forall k v a. (k -> v -> a -> a) -> a -> IntervalMap k v -> a
foldrWithKey (\k
k v
v [(k, v)]
r -> (k
k,v
v) (k, v) -> [(k, v)] -> [(k, v)]
forall a. a -> [a] -> [a]
: [(k, v)]
r) [] IntervalMap k v
m

toAscList' :: IntervalMap k v -> [(k,v)] -> [(k,v)]
toAscList' :: forall k v. IntervalMap k v -> [(k, v)] -> [(k, v)]
toAscList' IntervalMap k v
m [(k, v)]
xs = (k -> v -> [(k, v)] -> [(k, v)])
-> [(k, v)] -> IntervalMap k v -> [(k, v)]
forall k v a. (k -> v -> a -> a) -> a -> IntervalMap k v -> a
foldrWithKey (\k
k v
v [(k, v)]
r -> (k
k,v
v) (k, v) -> [(k, v)] -> [(k, v)]
forall a. a -> [a] -> [a]
: [(k, v)]
r) [(k, v)]
xs IntervalMap k v
m

-- | /O(n)/. The list of all key\/value pairs contained in the map, in no particular order.
toList :: IntervalMap k v -> [(k,v)]
toList :: forall k v. IntervalMap k v -> [(k, v)]
toList IntervalMap k v
m = IntervalMap k v -> [(k, v)]
forall k v. IntervalMap k v -> [(k, v)]
toAscList IntervalMap k v
m

-- | /O(n)/. The list of all key\/value pairs contained in the map, in descending order of keys.
toDescList :: IntervalMap k v -> [(k, v)]
toDescList :: forall k v. IntervalMap k v -> [(k, v)]
toDescList IntervalMap k v
m = ([(k, v)] -> k -> v -> [(k, v)])
-> [(k, v)] -> IntervalMap k v -> [(k, v)]
forall a k v. (a -> k -> v -> a) -> a -> IntervalMap k v -> a
foldlWithKey (\[(k, v)]
r k
k v
v -> (k
k,v
v) (k, v) -> [(k, v)] -> [(k, v)]
forall a. a -> [a] -> [a]
: [(k, v)]
r) [] IntervalMap k v
m

-- | /O(n log n)/. Build a map from a list of key\/value pairs. See also 'fromAscList'.
-- If the list contains more than one value for the same key, the last value
-- for the key is retained.
fromList :: (Interval k e, Ord k) => [(k,v)] -> IntervalMap k v
fromList :: forall k e v. (Interval k e, Ord k) => [(k, v)] -> IntervalMap k v
fromList [(k, v)]
xs = (IntervalMap k v -> (k, v) -> IntervalMap k v)
-> IntervalMap k v -> [(k, v)] -> IntervalMap k v
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
L.foldl' (\IntervalMap k v
m (k
k,v
v) -> k -> v -> IntervalMap k v -> IntervalMap k v
forall k e v.
(Interval k e, Ord k) =>
k -> v -> IntervalMap k v -> IntervalMap k v
insert k
k v
v IntervalMap k v
m) IntervalMap k v
forall k v. IntervalMap k v
empty [(k, v)]
xs

-- | /O(n log n)/. Build a map from a list of key\/value pairs with a combining function. See also 'fromAscListWith'.
fromListWith :: (Interval k e, Ord k) => (a -> a -> a) -> [(k,a)] -> IntervalMap k a 
fromListWith :: forall k e a.
(Interval k e, Ord k) =>
(a -> a -> a) -> [(k, a)] -> IntervalMap k a
fromListWith a -> a -> a
f [(k, a)]
xs = (k -> a -> a -> a) -> [(k, a)] -> IntervalMap k a
forall k e a.
(Interval k e, Ord k) =>
(k -> a -> a -> a) -> [(k, a)] -> IntervalMap k a
fromListWithKey (\k
_ a
x a
y -> a -> a -> a
f a
x a
y) [(k, a)]
xs

-- | /O(n log n)/. Build a map from a list of key\/value pairs with a combining function. See also 'fromAscListWith'.
fromListWithKey :: (Interval k e, Ord k) => (k -> a -> a -> a) -> [(k,a)] -> IntervalMap k a 
fromListWithKey :: forall k e a.
(Interval k e, Ord k) =>
(k -> a -> a -> a) -> [(k, a)] -> IntervalMap k a
fromListWithKey k -> a -> a -> a
f [(k, a)]
xs = (IntervalMap k a -> (k, a) -> IntervalMap k a)
-> IntervalMap k a -> [(k, a)] -> IntervalMap k a
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
L.foldl' IntervalMap k a -> (k, a) -> IntervalMap k a
ins IntervalMap k a
forall k v. IntervalMap k v
empty [(k, a)]
xs
  where
    ins :: IntervalMap k a -> (k, a) -> IntervalMap k a
ins IntervalMap k a
t (k
k,a
x) = (k -> a -> a -> a) -> k -> a -> IntervalMap k a -> IntervalMap k a
forall k e v.
(Interval k e, Ord k) =>
(k -> v -> v -> v) -> k -> v -> IntervalMap k v -> IntervalMap k v
insertWithKey k -> a -> a -> a
f k
k a
x IntervalMap k a
t

-- | /O(n)/. Build a map from an ascending list in linear time.
-- /The precondition (input list is ascending) is not checked./
fromAscList :: (Interval k e, Eq k) => [(k,v)] -> IntervalMap k v
fromAscList :: forall k e v. (Interval k e, Eq k) => [(k, v)] -> IntervalMap k v
fromAscList [(k, v)]
xs = (v -> v -> v) -> [(k, v)] -> IntervalMap k v
forall k e a.
(Interval k e, Eq k) =>
(a -> a -> a) -> [(k, a)] -> IntervalMap k a
fromAscListWith (\v
_ v
b -> v
b) [(k, v)]
xs

-- | /O(n)/. Build a map from an ascending list in linear time with a combining function for equal keys.
-- /The precondition (input list is ascending) is not checked./
fromAscListWith :: (Interval k e, Eq k) => (a -> a -> a) -> [(k,a)] -> IntervalMap k a 
fromAscListWith :: forall k e a.
(Interval k e, Eq k) =>
(a -> a -> a) -> [(k, a)] -> IntervalMap k a
fromAscListWith a -> a -> a
f [(k, a)]
xs = (k -> a -> a -> a) -> [(k, a)] -> IntervalMap k a
forall k e a.
(Interval k e, Eq k) =>
(k -> a -> a -> a) -> [(k, a)] -> IntervalMap k a
fromAscListWithKey (\k
_ a
a a
b -> a -> a -> a
f a
a a
b) [(k, a)]
xs

-- | /O(n)/. Build a map from an ascending list in linear time with a combining function for equal keys.
-- /The precondition (input list is ascending) is not checked./
fromAscListWithKey :: (Interval k e, Eq k) => (k -> a -> a -> a) -> [(k,a)] -> IntervalMap k a 
fromAscListWithKey :: forall k e a.
(Interval k e, Eq k) =>
(k -> a -> a -> a) -> [(k, a)] -> IntervalMap k a
fromAscListWithKey k -> a -> a -> a
f [(k, a)]
xs = [(k, a)] -> IntervalMap k a
forall k e v. Interval k e => [(k, v)] -> IntervalMap k v
fromDistinctAscList ((k -> a -> a -> a) -> [(k, a)] -> [(k, a)]
forall k a. Eq k => (k -> a -> a -> a) -> [(k, a)] -> [(k, a)]
combineEq k -> a -> a -> a
f [(k, a)]
xs)

combineEq :: Eq k => (k -> a -> a -> a) -> [(k,a)] -> [(k,a)]
combineEq :: forall k a. Eq k => (k -> a -> a -> a) -> [(k, a)] -> [(k, a)]
combineEq k -> a -> a -> a
_ [] = []
combineEq k -> a -> a -> a
_ xs :: [(k, a)]
xs@[(k, a)
_] = [(k, a)]
xs
combineEq k -> a -> a -> a
f (x :: (k, a)
x@(k
xk,a
xv) : xs :: [(k, a)]
xs@((k
yk,a
yv) : [(k, a)]
xs'))
  | k
xk k -> k -> Bool
forall a. Eq a => a -> a -> Bool
== k
yk  = (k -> a -> a -> a) -> [(k, a)] -> [(k, a)]
forall k a. Eq k => (k -> a -> a -> a) -> [(k, a)] -> [(k, a)]
combineEq k -> a -> a -> a
f ((k
xk, k -> a -> a -> a
f k
xk a
xv a
yv) (k, a) -> [(k, a)] -> [(k, a)]
forall a. a -> [a] -> [a]
: [(k, a)]
xs')
  | Bool
otherwise = (k, a)
x (k, a) -> [(k, a)] -> [(k, a)]
forall a. a -> [a] -> [a]
: (k -> a -> a -> a) -> [(k, a)] -> [(k, a)]
forall k a. Eq k => (k -> a -> a -> a) -> [(k, a)] -> [(k, a)]
combineEq k -> a -> a -> a
f [(k, a)]
xs


-- Strict tuple
data T2 a b = T2 !a !b


-- | /O(n)/. Build a map from an ascending list of elements with distinct keys in linear time.
-- /The precondition is not checked./
fromDistinctAscList :: (Interval k e) => [(k,v)] -> IntervalMap k v
-- exactly 2^n-1 items have height n. They can be all black
-- from 2^n - 2^n-2 items have height n+1. The lowest "row" should be red.
fromDistinctAscList :: forall k e v. Interval k e => [(k, v)] -> IntervalMap k v
fromDistinctAscList [(k, v)]
lyst = case Int -> [(k, v)] -> T2 (IntervalMap k v) [(k, v)]
forall {k} {e} {v}.
Interval k e =>
Int -> [(k, v)] -> T2 (IntervalMap k v) [(k, v)]
h ([(k, v)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
L.length [(k, v)]
lyst) [(k, v)]
lyst of
                             (T2 IntervalMap k v
result []) -> IntervalMap k v
result
                             T2 (IntervalMap k v) [(k, v)]
_ -> [Char] -> IntervalMap k v
forall a. HasCallStack => [Char] -> a
error [Char]
"fromDistinctAscList: list not fully consumed"
  where
    h :: Int -> [(k, v)] -> T2 (IntervalMap k v) [(k, v)]
h Int
n [(k, v)]
xs | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0      = IntervalMap k v -> [(k, v)] -> T2 (IntervalMap k v) [(k, v)]
forall a b. a -> b -> T2 a b
T2 IntervalMap k v
forall k v. IntervalMap k v
Nil [(k, v)]
xs
           | Int -> Bool
isPerfect Int
n = Int -> [(k, v)] -> T2 (IntervalMap k v) [(k, v)]
forall {t} {k} {e} {v}.
(Integral t, Interval k e) =>
t -> [(k, v)] -> T2 (IntervalMap k v) [(k, v)]
buildB Int
n [(k, v)]
xs
           | Bool
otherwise   = Int -> Int -> [(k, v)] -> T2 (IntervalMap k v) [(k, v)]
forall {t} {t} {k} {e} {v}.
(Num t, Integral t, Interval k e, Eq t) =>
t -> t -> [(k, v)] -> T2 (IntervalMap k v) [(k, v)]
buildR Int
n (Int -> Int
log2 Int
n) [(k, v)]
xs

    buildB :: t -> [(k, v)] -> T2 (IntervalMap k v) [(k, v)]
buildB t
n [(k, v)]
xs | [(k, v)]
xs [(k, v)] -> Bool -> Bool
forall a b. a -> b -> b
`seq` t
n t -> t -> Bool
forall a. Ord a => a -> a -> Bool
<= t
0 = [Char] -> T2 (IntervalMap k v) [(k, v)]
forall a. HasCallStack => [Char] -> a
error [Char]
"fromDictinctAscList: buildB 0"
                | t
n t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
1     = case [(k, v)]
xs of ((k
k,v
v):[(k, v)]
xs') -> IntervalMap k v -> [(k, v)] -> T2 (IntervalMap k v) [(k, v)]
forall a b. a -> b -> T2 a b
T2 (Color
-> k
-> k
-> v
-> IntervalMap k v
-> IntervalMap k v
-> IntervalMap k v
forall k v.
Color
-> k
-> k
-> v
-> IntervalMap k v
-> IntervalMap k v
-> IntervalMap k v
Node Color
B k
k k
k v
v IntervalMap k v
forall k v. IntervalMap k v
Nil IntervalMap k v
forall k v. IntervalMap k v
Nil) [(k, v)]
xs'
                                          [(k, v)]
_ -> [Char] -> T2 (IntervalMap k v) [(k, v)]
forall a. HasCallStack => [Char] -> a
error [Char]
"fromDictinctAscList: buildB 1"
                | Bool
otherwise  =
                     case t
n t -> t -> t
forall a. Integral a => a -> a -> a
`quot` t
2 of { t
n' ->
                     case t -> [(k, v)] -> T2 (IntervalMap k v) [(k, v)]
buildB t
n' [(k, v)]
xs of { (T2 IntervalMap k v
_ []) -> [Char] -> T2 (IntervalMap k v) [(k, v)]
forall a. HasCallStack => [Char] -> a
error [Char]
"fromDictinctAscList: buildB n";
                                            (T2 IntervalMap k v
l ((k
k,v
v):[(k, v)]
xs')) ->
                     case t -> [(k, v)] -> T2 (IntervalMap k v) [(k, v)]
buildB t
n' [(k, v)]
xs' of { (T2 IntervalMap k v
r [(k, v)]
xs'') ->
                     IntervalMap k v -> [(k, v)] -> T2 (IntervalMap k v) [(k, v)]
forall a b. a -> b -> T2 a b
T2 (Color
-> k -> v -> IntervalMap k v -> IntervalMap k v -> IntervalMap k v
forall k e v.
Interval k e =>
Color
-> k -> v -> IntervalMap k v -> IntervalMap k v -> IntervalMap k v
mNode Color
B k
k v
v IntervalMap k v
l IntervalMap k v
r) [(k, v)]
xs'' }}}

    buildR :: t -> t -> [(k, v)] -> T2 (IntervalMap k v) [(k, v)]
buildR t
n t
d [(k, v)]
xs | t
d t -> Bool -> Bool
forall a b. a -> b -> b
`seq` [(k, v)]
xs [(k, v)] -> Bool -> Bool
forall a b. a -> b -> b
`seq` t
n t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
0 = IntervalMap k v -> [(k, v)] -> T2 (IntervalMap k v) [(k, v)]
forall a b. a -> b -> T2 a b
T2 IntervalMap k v
forall k v. IntervalMap k v
Nil [(k, v)]
xs
                  | t
n t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
1    = case [(k, v)]
xs of ((k
k,v
v):[(k, v)]
xs') -> IntervalMap k v -> [(k, v)] -> T2 (IntervalMap k v) [(k, v)]
forall a b. a -> b -> T2 a b
T2 (Color
-> k
-> k
-> v
-> IntervalMap k v
-> IntervalMap k v
-> IntervalMap k v
forall k v.
Color
-> k
-> k
-> v
-> IntervalMap k v
-> IntervalMap k v
-> IntervalMap k v
Node (if t
dt -> t -> Bool
forall a. Eq a => a -> a -> Bool
==t
0 then Color
R else Color
B) k
k k
k v
v IntervalMap k v
forall k v. IntervalMap k v
Nil IntervalMap k v
forall k v. IntervalMap k v
Nil) [(k, v)]
xs'
                                           [(k, v)]
_ -> [Char] -> T2 (IntervalMap k v) [(k, v)]
forall a. HasCallStack => [Char] -> a
error [Char]
"fromDistinctAscList: buildR 1"
                  | Bool
otherwise =
                      case t
n t -> t -> t
forall a. Integral a => a -> a -> a
`quot` t
2 of { t
n' ->
                      case t -> t -> [(k, v)] -> T2 (IntervalMap k v) [(k, v)]
buildR t
n' (t
dt -> t -> t
forall a. Num a => a -> a -> a
-t
1) [(k, v)]
xs of { (T2 IntervalMap k v
_ []) -> [Char] -> T2 (IntervalMap k v) [(k, v)]
forall a. HasCallStack => [Char] -> a
error [Char]
"fromDistinctAscList: buildR n";
                                                   (T2 IntervalMap k v
l ((k
k,v
v):[(k, v)]
xs')) ->
                      case t -> t -> [(k, v)] -> T2 (IntervalMap k v) [(k, v)]
buildR (t
n t -> t -> t
forall a. Num a => a -> a -> a
- (t
n' t -> t -> t
forall a. Num a => a -> a -> a
+ t
1)) (t
dt -> t -> t
forall a. Num a => a -> a -> a
-t
1) [(k, v)]
xs' of { (T2 IntervalMap k v
r [(k, v)]
xs'') ->
                      IntervalMap k v -> [(k, v)] -> T2 (IntervalMap k v) [(k, v)]
forall a b. a -> b -> T2 a b
T2 (Color
-> k -> v -> IntervalMap k v -> IntervalMap k v -> IntervalMap k v
forall k e v.
Interval k e =>
Color
-> k -> v -> IntervalMap k v -> IntervalMap k v -> IntervalMap k v
mNode Color
B k
k v
v IntervalMap k v
l IntervalMap k v
r) [(k, v)]
xs'' }}}


-- is n a perfect binary tree size (2^m-1)?
isPerfect :: Int -> Bool
isPerfect :: Int -> Bool
isPerfect Int
n = (Int
n Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0

log2 :: Int -> Int
log2 :: Int -> Int
log2 Int
m = Int -> Int -> Int
forall {t} {t}. (Ord t, Num t, Num t, Bits t) => t -> t -> t
h (-Int
1) Int
m
  where
    h :: t -> t -> t
h t
r t
n | t
r t -> Bool -> Bool
forall a b. a -> b -> b
`seq` t
n t -> t -> Bool
forall a. Ord a => a -> a -> Bool
<= t
0 = t
r
          | Bool
otherwise      = t -> t -> t
h (t
r t -> t -> t
forall a. Num a => a -> a -> a
+ t
1) (t
n t -> Int -> t
forall a. Bits a => a -> Int -> a
`shiftR` Int
1)


-- | /O(n)/. List of all values in the map, in ascending order of their keys.
elems :: IntervalMap k v -> [v]
elems :: forall k a. IntervalMap k a -> [a]
elems IntervalMap k v
m = [v
v | (k
_,v
v) <- IntervalMap k v -> [(k, v)]
forall k v. IntervalMap k v -> [(k, v)]
toAscList IntervalMap k v
m]

-- | /O(n)/. List of all keys in the map, in ascending order.
keys :: IntervalMap k v -> [k]
keys :: forall k v. IntervalMap k v -> [k]
keys IntervalMap k v
m = [k
k | (k
k,v
_) <- IntervalMap k v -> [(k, v)]
forall k v. IntervalMap k v -> [(k, v)]
toAscList IntervalMap k v
m]

-- | /O(n)/. Set of the keys.
keysSet :: IntervalMap k v -> Set.Set k
keysSet :: forall k v. IntervalMap k v -> Set k
keysSet IntervalMap k v
m =  [k] -> Set k
forall a. [a] -> Set a
Set.fromDistinctAscList (IntervalMap k v -> [k]
forall k v. IntervalMap k v -> [k]
keys IntervalMap k v
m)

-- | Same as 'toAscList'.
assocs :: IntervalMap k v -> [(k, v)]
assocs :: forall k v. IntervalMap k v -> [(k, v)]
assocs IntervalMap k v
m = IntervalMap k v -> [(k, v)]
forall k v. IntervalMap k v -> [(k, v)]
toAscList IntervalMap k v
m

-- --- Mapping ---

-- | /O(n)/. Map a function over all values in the map.
map :: (a -> b) -> IntervalMap k a -> IntervalMap k b
map :: forall a b k. (a -> b) -> IntervalMap k a -> IntervalMap k b
map a -> b
f = (k -> a -> b) -> IntervalMap k a -> IntervalMap k b
forall k a b. (k -> a -> b) -> IntervalMap k a -> IntervalMap k b
mapWithKey (\k
_ a
x -> a -> b
f a
x)

-- | /O(n)/. Map a function over all values in the map.
mapWithKey :: (k -> a -> b) -> IntervalMap k a -> IntervalMap k b
mapWithKey :: forall k a b. (k -> a -> b) -> IntervalMap k a -> IntervalMap k b
mapWithKey k -> a -> b
f = IntervalMap k a -> IntervalMap k b
go
  where
    go :: IntervalMap k a -> IntervalMap k b
go IntervalMap k a
Nil = IntervalMap k b
forall k v. IntervalMap k v
Nil
    go (Node Color
c k
k k
m a
v IntervalMap k a
l IntervalMap k a
r) = Color
-> k
-> k
-> b
-> IntervalMap k b
-> IntervalMap k b
-> IntervalMap k b
forall k v.
Color
-> k
-> k
-> v
-> IntervalMap k v
-> IntervalMap k v
-> IntervalMap k v
Node Color
c k
k k
m (k -> a -> b
f k
k a
v) (IntervalMap k a -> IntervalMap k b
go IntervalMap k a
l) (IntervalMap k a -> IntervalMap k b
go IntervalMap k a
r)

-- | /O(n)/. The function 'mapAccum' threads an accumulating
-- argument through the map in ascending order of keys.
mapAccum :: (a -> b -> (a,c)) -> a -> IntervalMap k b -> (a, IntervalMap k c)
mapAccum :: forall a b c k.
(a -> b -> (a, c)) -> a -> IntervalMap k b -> (a, IntervalMap k c)
mapAccum a -> b -> (a, c)
f a
a IntervalMap k b
m = (a -> k -> b -> (a, c))
-> a -> IntervalMap k b -> (a, IntervalMap k c)
forall a k b c.
(a -> k -> b -> (a, c))
-> a -> IntervalMap k b -> (a, IntervalMap k c)
mapAccumWithKey (\a
a' k
_ b
x' -> a -> b -> (a, c)
f a
a' b
x') a
a IntervalMap k b
m

-- | /O(n)/. The function 'mapAccumWithKey' threads an accumulating
-- argument through the map in ascending order of keys.
mapAccumWithKey :: (a -> k -> b -> (a,c)) -> a -> IntervalMap k b -> (a, IntervalMap k c)
mapAccumWithKey :: forall a k b c.
(a -> k -> b -> (a, c))
-> a -> IntervalMap k b -> (a, IntervalMap k c)
mapAccumWithKey a -> k -> b -> (a, c)
f = a -> IntervalMap k b -> (a, IntervalMap k c)
go
  where
    go :: a -> IntervalMap k b -> (a, IntervalMap k c)
go a
a IntervalMap k b
Nil               = (a
a,IntervalMap k c
forall k v. IntervalMap k v
Nil)
    go a
a (Node Color
c k
kx k
m b
x IntervalMap k b
l IntervalMap k b
r) =
                 let (a
a1,IntervalMap k c
l') = a -> IntervalMap k b -> (a, IntervalMap k c)
go a
a IntervalMap k b
l
                     (a
a2,c
x') = a -> k -> b -> (a, c)
f a
a1 k
kx b
x
                     (a
a3,IntervalMap k c
r') = a -> IntervalMap k b -> (a, IntervalMap k c)
go a
a2 IntervalMap k b
r
                 in (a
a3, Color
-> k
-> k
-> c
-> IntervalMap k c
-> IntervalMap k c
-> IntervalMap k c
forall k v.
Color
-> k
-> k
-> v
-> IntervalMap k v
-> IntervalMap k v
-> IntervalMap k v
Node Color
c k
kx k
m c
x' IntervalMap k c
l' IntervalMap k c
r')

-- | /O(n)/. The function 'mapAccumRWithKey' threads an accumulating
-- argument through the map in descending order of keys.
mapAccumRWithKey :: (a -> k -> b -> (a,c)) -> a -> IntervalMap k b -> (a, IntervalMap k c)
mapAccumRWithKey :: forall a k b c.
(a -> k -> b -> (a, c))
-> a -> IntervalMap k b -> (a, IntervalMap k c)
mapAccumRWithKey a -> k -> b -> (a, c)
f = a -> IntervalMap k b -> (a, IntervalMap k c)
go
  where
    go :: a -> IntervalMap k b -> (a, IntervalMap k c)
go a
a IntervalMap k b
Nil = (a
a, IntervalMap k c
forall k v. IntervalMap k v
Nil)
    go a
a (Node Color
c k
kx k
m b
x IntervalMap k b
l IntervalMap k b
r) =
                 let (a
a1,IntervalMap k c
r') = a -> IntervalMap k b -> (a, IntervalMap k c)
go a
a IntervalMap k b
r
                     (a
a2,c
x') = a -> k -> b -> (a, c)
f a
a1 k
kx b
x
                     (a
a3,IntervalMap k c
l') = a -> IntervalMap k b -> (a, IntervalMap k c)
go a
a2 IntervalMap k b
l
                 in (a
a3, Color
-> k
-> k
-> c
-> IntervalMap k c
-> IntervalMap k c
-> IntervalMap k c
forall k v.
Color
-> k
-> k
-> v
-> IntervalMap k v
-> IntervalMap k v
-> IntervalMap k v
Node Color
c k
kx k
m c
x' IntervalMap k c
l' IntervalMap k c
r')


-- | /O(n log n)/. @'mapKeys' f s@ is the map obtained by applying @f@ to each key of @s@.
-- 
-- The size of the result may be smaller if @f@ maps two or more distinct
-- keys to the same new key.  In this case the value at the smallest of
-- these keys is retained.
mapKeys :: (Interval k2 e, Ord k2) => (k1 -> k2) -> IntervalMap k1 a -> IntervalMap k2 a
mapKeys :: forall k2 e k1 a.
(Interval k2 e, Ord k2) =>
(k1 -> k2) -> IntervalMap k1 a -> IntervalMap k2 a
mapKeys k1 -> k2
f IntervalMap k1 a
m = [(k2, a)] -> IntervalMap k2 a
forall k e v. (Interval k e, Ord k) => [(k, v)] -> IntervalMap k v
fromList [ (k1 -> k2
f k1
k, a
v) | (k1
k, a
v) <- IntervalMap k1 a -> [(k1, a)]
forall k v. IntervalMap k v -> [(k, v)]
toDescList IntervalMap k1 a
m ]

-- | /O(n log n)/. @'mapKeysWith' c f s@ is the map obtained by applying @f@ to each key of @s@.
-- 
-- The size of the result may be smaller if @f@ maps two or more distinct
-- keys to the same new key.  In this case the associated values will be
-- combined using @c@.
mapKeysWith :: (Interval k2 e, Ord k2) => (a -> a -> a) -> (k1 -> k2) -> IntervalMap k1 a -> IntervalMap k2 a
mapKeysWith :: forall k2 e a k1.
(Interval k2 e, Ord k2) =>
(a -> a -> a) -> (k1 -> k2) -> IntervalMap k1 a -> IntervalMap k2 a
mapKeysWith a -> a -> a
c k1 -> k2
f IntervalMap k1 a
m = (a -> a -> a) -> [(k2, a)] -> IntervalMap k2 a
forall k e a.
(Interval k e, Ord k) =>
(a -> a -> a) -> [(k, a)] -> IntervalMap k a
fromListWith a -> a -> a
c [ (k1 -> k2
f k1
k, a
v) | (k1
k, a
v) <- IntervalMap k1 a -> [(k1, a)]
forall k v. IntervalMap k v -> [(k, v)]
toAscList IntervalMap k1 a
m ]

-- | /O(n)/. @'mapKeysMonotonic' f s == 'mapKeys' f s@, but works only when @f@
-- is strictly monotonic.
-- That is, for any values @x@ and @y@, if @x@ < @y@ then @f x@ < @f y@.
-- /The precondition is not checked./
mapKeysMonotonic :: (Interval k2 e, Ord k2) => (k1 -> k2) -> IntervalMap k1 a -> IntervalMap k2 a
mapKeysMonotonic :: forall k2 e k1 a.
(Interval k2 e, Ord k2) =>
(k1 -> k2) -> IntervalMap k1 a -> IntervalMap k2 a
mapKeysMonotonic k1 -> k2
_ IntervalMap k1 a
Nil = IntervalMap k2 a
forall k v. IntervalMap k v
Nil
mapKeysMonotonic k1 -> k2
f (Node Color
c k1
k k1
_ a
x IntervalMap k1 a
l IntervalMap k1 a
r) =
    Color
-> k2
-> a
-> IntervalMap k2 a
-> IntervalMap k2 a
-> IntervalMap k2 a
forall k e v.
Interval k e =>
Color
-> k -> v -> IntervalMap k v -> IntervalMap k v -> IntervalMap k v
mNode Color
c (k1 -> k2
f k1
k) a
x ((k1 -> k2) -> IntervalMap k1 a -> IntervalMap k2 a
forall k2 e k1 a.
(Interval k2 e, Ord k2) =>
(k1 -> k2) -> IntervalMap k1 a -> IntervalMap k2 a
mapKeysMonotonic k1 -> k2
f IntervalMap k1 a
l) ((k1 -> k2) -> IntervalMap k1 a -> IntervalMap k2 a
forall k2 e k1 a.
(Interval k2 e, Ord k2) =>
(k1 -> k2) -> IntervalMap k1 a -> IntervalMap k2 a
mapKeysMonotonic k1 -> k2
f IntervalMap k1 a
r)

-- | /O(n)/. Filter values satisfying a predicate.
filter :: (Interval k e) => (a -> Bool) -> IntervalMap k a -> IntervalMap k a
filter :: forall k e a.
Interval k e =>
(a -> Bool) -> IntervalMap k a -> IntervalMap k a
filter a -> Bool
p IntervalMap k a
m = (k -> a -> Bool) -> IntervalMap k a -> IntervalMap k a
forall k e a.
Interval k e =>
(k -> a -> Bool) -> IntervalMap k a -> IntervalMap k a
filterWithKey (\k
_ a
v -> a -> Bool
p a
v) IntervalMap k a
m

-- | /O(n)/. Filter keys\/values satisfying a predicate.
filterWithKey :: (Interval k e) => (k -> a -> Bool) -> IntervalMap k a -> IntervalMap k a
filterWithKey :: forall k e a.
Interval k e =>
(k -> a -> Bool) -> IntervalMap k a -> IntervalMap k a
filterWithKey k -> a -> Bool
p IntervalMap k a
m = (k -> a -> Maybe a) -> IntervalMap k a -> IntervalMap k a
forall k e a b.
Interval k e =>
(k -> a -> Maybe b) -> IntervalMap k a -> IntervalMap k b
mapMaybeWithKey (\k
k a
v -> if k -> a -> Bool
p k
k a
v then a -> Maybe a
forall a. a -> Maybe a
Just a
v else Maybe a
forall a. Maybe a
Nothing) IntervalMap k a
m

-- | /O(n)/. Partition the map according to a predicate. The first
-- map contains all elements that satisfy the predicate, the second all
-- elements that fail the predicate. See also 'split'.
partition :: (Interval k e) => (a -> Bool) -> IntervalMap k a -> (IntervalMap k a, IntervalMap k a)
partition :: forall k e a.
Interval k e =>
(a -> Bool)
-> IntervalMap k a -> (IntervalMap k a, IntervalMap k a)
partition a -> Bool
p IntervalMap k a
m = (k -> a -> Bool)
-> IntervalMap k a -> (IntervalMap k a, IntervalMap k a)
forall k e a.
Interval k e =>
(k -> a -> Bool)
-> IntervalMap k a -> (IntervalMap k a, IntervalMap k a)
partitionWithKey (\k
_ a
v -> a -> Bool
p a
v) IntervalMap k a
m

-- | /O(n)/. Partition the map according to a predicate. The first
-- map contains all elements that satisfy the predicate, the second all
-- elements that fail the predicate. See also 'split'.
partitionWithKey :: (Interval k e) => (k -> a -> Bool) -> IntervalMap k a -> (IntervalMap k a, IntervalMap k a)
partitionWithKey :: forall k e a.
Interval k e =>
(k -> a -> Bool)
-> IntervalMap k a -> (IntervalMap k a, IntervalMap k a)
partitionWithKey k -> a -> Bool
p IntervalMap k a
m = (k -> a -> Either a a)
-> IntervalMap k a -> (IntervalMap k a, IntervalMap k a)
forall i k a b c.
Interval i k =>
(i -> a -> Either b c)
-> IntervalMap i a -> (IntervalMap i b, IntervalMap i c)
mapEitherWithKey k -> a -> Either a a
p' IntervalMap k a
m
  where
    p' :: k -> a -> Either a a
p' k
k a
v | k -> a -> Bool
p k
k a
v     = a -> Either a a
forall a b. a -> Either a b
Left a
v
           | Bool
otherwise = a -> Either a a
forall a b. b -> Either a b
Right a
v

-- | /O(n)/. Map values and collect the 'Just' results.
mapMaybe :: (Interval k e) => (a -> Maybe b) -> IntervalMap k a -> IntervalMap k b
mapMaybe :: forall k e a b.
Interval k e =>
(a -> Maybe b) -> IntervalMap k a -> IntervalMap k b
mapMaybe a -> Maybe b
f IntervalMap k a
m = (k -> a -> Maybe b) -> IntervalMap k a -> IntervalMap k b
forall k e a b.
Interval k e =>
(k -> a -> Maybe b) -> IntervalMap k a -> IntervalMap k b
mapMaybeWithKey (\k
_ a
v -> a -> Maybe b
f a
v) IntervalMap k a
m

-- | /O(n)/. Map keys\/values and collect the 'Just' results.
mapMaybeWithKey :: (Interval k e) => (k -> a -> Maybe b) -> IntervalMap k a -> IntervalMap k b
mapMaybeWithKey :: forall k e a b.
Interval k e =>
(k -> a -> Maybe b) -> IntervalMap k a -> IntervalMap k b
mapMaybeWithKey k -> a -> Maybe b
f IntervalMap k a
m = [(k, b)] -> IntervalMap k b
forall k e v. Interval k e => [(k, v)] -> IntervalMap k v
fromDistinctAscList ([(k, b)] -> IntervalMap k a -> [(k, b)]
mapf [] IntervalMap k a
m)
  where
    mapf :: [(k, b)] -> IntervalMap k a -> [(k, b)]
mapf [(k, b)]
z IntervalMap k a
Nil = [(k, b)]
z
    mapf [(k, b)]
z (Node Color
_ k
k k
_ a
v IntervalMap k a
l IntervalMap k a
r) = [(k, b)] -> IntervalMap k a -> [(k, b)]
mapf (k -> a -> [(k, b)] -> IntervalMap k a -> [(k, b)]
f' k
k a
v [(k, b)]
z IntervalMap k a
r) IntervalMap k a
l
    f' :: k -> a -> [(k, b)] -> IntervalMap k a -> [(k, b)]
f' k
k a
v [(k, b)]
z IntervalMap k a
r = case k -> a -> Maybe b
f k
k a
v of
                   Maybe b
Nothing -> [(k, b)] -> IntervalMap k a -> [(k, b)]
mapf [(k, b)]
z IntervalMap k a
r
                   Just b
v' -> (k
k,b
v') (k, b) -> [(k, b)] -> [(k, b)]
forall a. a -> [a] -> [a]
: [(k, b)] -> IntervalMap k a -> [(k, b)]
mapf [(k, b)]
z IntervalMap k a
r

-- | /O(n)/. Map values and separate the 'Left' and 'Right' results.
mapEither :: (Interval k e) => (a -> Either b c) -> IntervalMap k a -> (IntervalMap k b, IntervalMap k c)
mapEither :: forall k e a b c.
Interval k e =>
(a -> Either b c)
-> IntervalMap k a -> (IntervalMap k b, IntervalMap k c)
mapEither a -> Either b c
f IntervalMap k a
m = (k -> a -> Either b c)
-> IntervalMap k a -> (IntervalMap k b, IntervalMap k c)
forall i k a b c.
Interval i k =>
(i -> a -> Either b c)
-> IntervalMap i a -> (IntervalMap i b, IntervalMap i c)
mapEitherWithKey (\k
_ a
v -> a -> Either b c
f a
v) IntervalMap k a
m

-- | /O(n)/. Map keys\/values and separate the 'Left' and 'Right' results.
mapEitherWithKey :: (Interval i k) => (i -> a -> Either b c) -> IntervalMap i a -> (IntervalMap i b, IntervalMap i c)
mapEitherWithKey :: forall i k a b c.
Interval i k =>
(i -> a -> Either b c)
-> IntervalMap i a -> (IntervalMap i b, IntervalMap i c)
mapEitherWithKey i -> a -> Either b c
f IntervalMap i a
m = ([(i, b)] -> IntervalMap i b
forall k e v. Interval k e => [(k, v)] -> IntervalMap k v
fromDistinctAscList [(i, b)]
l, [(i, c)] -> IntervalMap i c
forall k e v. Interval k e => [(k, v)] -> IntervalMap k v
fromDistinctAscList [(i, c)]
r)
  where
    ([(i, b)]
l, [(i, c)]
r) = [(i, b)] -> [(i, c)] -> [(i, a)] -> ([(i, b)], [(i, c)])
part [] [] (IntervalMap i a -> [(i, a)]
forall k v. IntervalMap k v -> [(k, v)]
toDescList IntervalMap i a
m)
    part :: [(i, b)] -> [(i, c)] -> [(i, a)] -> ([(i, b)], [(i, c)])
part [(i, b)]
ls [(i, c)]
rs [] = ([(i, b)]
ls, [(i, c)]
rs)
    part [(i, b)]
ls [(i, c)]
rs ((i
k,a
v):[(i, a)]
xs) = case i -> a -> Either b c
f i
k a
v of
                              Left b
v'  -> [(i, b)] -> [(i, c)] -> [(i, a)] -> ([(i, b)], [(i, c)])
part ((i
k,b
v')(i, b) -> [(i, b)] -> [(i, b)]
forall a. a -> [a] -> [a]
:[(i, b)]
ls) [(i, c)]
rs [(i, a)]
xs
                              Right c
v' -> [(i, b)] -> [(i, c)] -> [(i, a)] -> ([(i, b)], [(i, c)])
part [(i, b)]
ls ((i
k,c
v')(i, c) -> [(i, c)] -> [(i, c)]
forall a. a -> [a] -> [a]
:[(i, c)]
rs) [(i, a)]
xs

-- | /O(n)/. The expression (@'split' k map@) is a pair @(map1,map2)@ where
-- the keys in @map1@ are smaller than @k@ and the keys in @map2@ larger than @k@.
-- Any key equal to @k@ is found in neither @map1@ nor @map2@.
split :: (Interval i k, Ord i) => i -> IntervalMap i a -> (IntervalMap i a, IntervalMap i a)
split :: forall i k a.
(Interval i k, Ord i) =>
i -> IntervalMap i a -> (IntervalMap i a, IntervalMap i a)
split i
x IntervalMap i a
m = (IntervalMap i a
l, IntervalMap i a
r)
  where (IntervalMap i a
l, Maybe a
_, IntervalMap i a
r) = i -> IntervalMap i a -> (IntervalMap i a, Maybe a, IntervalMap i a)
forall i k a.
(Interval i k, Ord i) =>
i -> IntervalMap i a -> (IntervalMap i a, Maybe a, IntervalMap i a)
splitLookup i
x IntervalMap i a
m
     
-- | /O(n)/. The expression (@'splitLookup' k map@) splits a map just
-- like 'split' but also returns @'lookup' k map@.
splitLookup :: (Interval i k, Ord i) => i -> IntervalMap i a -> (IntervalMap i a, Maybe a, IntervalMap i a)
splitLookup :: forall i k a.
(Interval i k, Ord i) =>
i -> IntervalMap i a -> (IntervalMap i a, Maybe a, IntervalMap i a)
splitLookup i
x IntervalMap i a
m = case ((i, a) -> Bool) -> [(i, a)] -> ([(i, a)], [(i, a)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (\(i
k,a
_) -> i
k i -> i -> Bool
forall a. Ord a => a -> a -> Bool
< i
x) (IntervalMap i a -> [(i, a)]
forall k v. IntervalMap k v -> [(k, v)]
toAscList IntervalMap i a
m) of
                    ([], [])                        -> (IntervalMap i a
forall k v. IntervalMap k v
empty, Maybe a
forall a. Maybe a
Nothing, IntervalMap i a
forall k v. IntervalMap k v
empty)
                    ([], (i
k,a
v):[(i, a)]
_)       | i
k i -> i -> Bool
forall a. Eq a => a -> a -> Bool
== i
x    -> (IntervalMap i a
forall k v. IntervalMap k v
empty, a -> Maybe a
forall a. a -> Maybe a
Just a
v, IntervalMap i a -> IntervalMap i a
forall k e v.
(Interval k e, Ord k) =>
IntervalMap k v -> IntervalMap k v
deleteMin IntervalMap i a
m)
                                        | Bool
otherwise -> (IntervalMap i a
forall k v. IntervalMap k v
empty, Maybe a
forall a. Maybe a
Nothing, IntervalMap i a
m)
                    ([(i, a)]
_, [])                         -> (IntervalMap i a
m, Maybe a
forall a. Maybe a
Nothing, IntervalMap i a
forall k v. IntervalMap k v
empty)
                    ([(i, a)]
lt, ge :: [(i, a)]
ge@((i
k,a
v):[(i, a)]
gt)) | i
k i -> i -> Bool
forall a. Eq a => a -> a -> Bool
== i
x    -> ([(i, a)] -> IntervalMap i a
forall k e v. Interval k e => [(k, v)] -> IntervalMap k v
fromDistinctAscList [(i, a)]
lt, a -> Maybe a
forall a. a -> Maybe a
Just a
v, [(i, a)] -> IntervalMap i a
forall k e v. Interval k e => [(k, v)] -> IntervalMap k v
fromDistinctAscList [(i, a)]
gt)
                                        | Bool
otherwise -> ([(i, a)] -> IntervalMap i a
forall k e v. Interval k e => [(k, v)] -> IntervalMap k v
fromDistinctAscList [(i, a)]
lt, Maybe a
forall a. Maybe a
Nothing, [(i, a)] -> IntervalMap i a
forall k e v. Interval k e => [(k, v)] -> IntervalMap k v
fromDistinctAscList [(i, a)]
ge)


-- | /O(n)/. Split around a point.
-- Splits the map into three submaps: intervals below the point,
-- intervals containing the point, and intervals above the point.
splitAt :: (Interval i k) => IntervalMap i a -> k -> (IntervalMap i a, IntervalMap i a, IntervalMap i a)
splitAt :: forall i k a.
Interval i k =>
IntervalMap i a
-> k -> (IntervalMap i a, IntervalMap i a, IntervalMap i a)
splitAt IntervalMap i a
mp k
p = (Union i a -> IntervalMap i a
forall k e v. Interval k e => Union k v -> IntervalMap k v
fromUnion (IntervalMap i a -> Union i a
forall {i} {v}. Interval i k => IntervalMap i v -> Union i v
lower IntervalMap i a
mp), IntervalMap i a
mp IntervalMap i a -> k -> IntervalMap i a
forall k e v.
Interval k e =>
IntervalMap k v -> e -> IntervalMap k v
`containing` k
p, Union i a -> IntervalMap i a
forall k e v. Interval k e => Union k v -> IntervalMap k v
fromUnion (IntervalMap i a -> Union i a
forall {i} {v}. Interval i k => IntervalMap i v -> Union i v
higher IntervalMap i a
mp))
  where
    lower :: IntervalMap i v -> Union i v
lower IntervalMap i v
Nil = Union i v
forall k v. Union k v
UEmpty
    lower s :: IntervalMap i v
s@(Node Color
_ i
k i
m v
v IntervalMap i v
l IntervalMap i v
r)
      | k
p k -> i -> Bool
forall i e. Interval i e => e -> i -> Bool
`above`  i
m  =  IntervalMap i v -> Union i v -> Union i v
forall k v. IntervalMap k v -> Union k v -> Union k v
UAppend IntervalMap i v
s Union i v
forall k v. Union k v
UEmpty
      | k
p k -> i -> Bool
forall i e. Interval i e => e -> i -> Bool
`below`  i
k  =  IntervalMap i v -> Union i v
lower IntervalMap i v
l
      | k
p k -> i -> Bool
forall i e. Interval i e => e -> i -> Bool
`inside` i
k  =  Union i v -> Union i v -> Union i v
forall k v. Union k v -> Union k v -> Union k v
mkUnion (IntervalMap i v -> Union i v
lower IntervalMap i v
l) (IntervalMap i v -> Union i v
lower IntervalMap i v
r)
      | Bool
otherwise     =  Union i v -> Union i v -> Union i v
forall k v. Union k v -> Union k v -> Union k v
mkUnion (IntervalMap i v -> Union i v
lower IntervalMap i v
l) (i -> v -> Union i v -> Union i v
forall k v. k -> v -> Union k v -> Union k v
UCons i
k v
v (IntervalMap i v -> Union i v
lower IntervalMap i v
r))
    higher :: IntervalMap k v -> Union k v
higher IntervalMap k v
Nil = Union k v
forall k v. Union k v
UEmpty
    higher (Node Color
_ k
k k
m v
v IntervalMap k v
l IntervalMap k v
r)
      | k
p k -> k -> Bool
forall i e. Interval i e => e -> i -> Bool
`above`  k
m  =  Union k v
forall k v. Union k v
UEmpty
      | k
p k -> k -> Bool
forall i e. Interval i e => e -> i -> Bool
`below`  k
k  =  Union k v -> Union k v -> Union k v
forall k v. Union k v -> Union k v -> Union k v
mkUnion (IntervalMap k v -> Union k v
higher IntervalMap k v
l) (k -> v -> Union k v -> Union k v
forall k v. k -> v -> Union k v -> Union k v
UCons k
k v
v (IntervalMap k v -> Union k v -> Union k v
forall k v. IntervalMap k v -> Union k v -> Union k v
UAppend IntervalMap k v
r Union k v
forall k v. Union k v
UEmpty))
      | Bool
otherwise     =  IntervalMap k v -> Union k v
higher IntervalMap k v
r

-- | /O(n)/. Split around an interval.
-- Splits the set into three subsets: intervals below the given interval,
-- intervals intersecting the given interval, and intervals above the
-- given interval.
splitIntersecting :: (Interval i k, Ord i) => IntervalMap i a -> i -> (IntervalMap i a, IntervalMap i a, IntervalMap i a)
splitIntersecting :: forall i k a.
(Interval i k, Ord i) =>
IntervalMap i a
-> i -> (IntervalMap i a, IntervalMap i a, IntervalMap i a)
splitIntersecting IntervalMap i a
mp i
i = (Union i a -> IntervalMap i a
forall k e v. Interval k e => Union k v -> IntervalMap k v
fromUnion (IntervalMap i a -> Union i a
forall {v}. IntervalMap i v -> Union i v
lower IntervalMap i a
mp), IntervalMap i a
mp IntervalMap i a -> i -> IntervalMap i a
forall k e v.
Interval k e =>
IntervalMap k v -> k -> IntervalMap k v
`intersecting` i
i, Union i a -> IntervalMap i a
forall k e v. Interval k e => Union k v -> IntervalMap k v
fromUnion (IntervalMap i a -> Union i a
forall {v}. IntervalMap i v -> Union i v
higher IntervalMap i a
mp))
  where
    lower :: IntervalMap i v -> Union i v
lower IntervalMap i v
Nil = Union i v
forall k v. Union k v
UEmpty
    lower s :: IntervalMap i v
s@(Node Color
_ i
k i
m v
v IntervalMap i v
l IntervalMap i v
r)
      -- whole set lower: all
      | i
i i -> i -> Bool
forall i e. Interval i e => i -> i -> Bool
`after`  i
m   =  IntervalMap i v -> Union i v -> Union i v
forall k v. IntervalMap k v -> Union k v -> Union k v
UAppend IntervalMap i v
s Union i v
forall k v. Union k v
UEmpty
      -- interval before key: only from left subtree
      | i
i i -> i -> Bool
forall a. Ord a => a -> a -> Bool
<= i
k         =  IntervalMap i v -> Union i v
lower IntervalMap i v
l
      -- interval intersects key to the right: both subtrees could contain lower intervals
      | i
i i -> i -> Bool
forall i e. Interval i e => i -> i -> Bool
`overlaps` i
k =  Union i v -> Union i v -> Union i v
forall k v. Union k v -> Union k v -> Union k v
mkUnion (IntervalMap i v -> Union i v
lower IntervalMap i v
l) (IntervalMap i v -> Union i v
lower IntervalMap i v
r)
      -- interval to the right of the key: key and both subtrees
      | Bool
otherwise      =  Union i v -> Union i v -> Union i v
forall k v. Union k v -> Union k v -> Union k v
mkUnion (IntervalMap i v -> Union i v
lower IntervalMap i v
l) (i -> v -> Union i v -> Union i v
forall k v. k -> v -> Union k v -> Union k v
UCons i
k v
v (IntervalMap i v -> Union i v
lower IntervalMap i v
r))
    higher :: IntervalMap i v -> Union i v
higher IntervalMap i v
Nil = Union i v
forall k v. Union k v
UEmpty
    higher (Node Color
_ i
k i
m v
v IntervalMap i v
l IntervalMap i v
r)
      -- whole set lower: nothing
      | i
i i -> i -> Bool
forall i e. Interval i e => i -> i -> Bool
`after` i
m    =  Union i v
forall k v. Union k v
UEmpty
      -- interval before key: node and complete right subtree + maybe part of the left subtree
      | i
i i -> i -> Bool
forall i e. Interval i e => i -> i -> Bool
`before`  i
k  =  Union i v -> Union i v -> Union i v
forall k v. Union k v -> Union k v -> Union k v
mkUnion (IntervalMap i v -> Union i v
higher IntervalMap i v
l) (i -> v -> Union i v -> Union i v
forall k v. k -> v -> Union k v -> Union k v
UCons i
k v
v (IntervalMap i v -> Union i v -> Union i v
forall k v. IntervalMap k v -> Union k v -> Union k v
UAppend IntervalMap i v
r Union i v
forall k v. Union k v
UEmpty))
      -- interval overlaps or to the right of key: only from right subtree
      | Bool
otherwise      =  IntervalMap i v -> Union i v
higher IntervalMap i v
r


-- Helper for building sets from distinct ascending keys and submaps
data Union k v = UEmpty | Union !(Union k v) !(Union k v)
               | UCons !k v !(Union k v)
               | UAppend !(IntervalMap k v) !(Union k v)

mkUnion :: Union k v -> Union k v -> Union k v
mkUnion :: forall k v. Union k v -> Union k v -> Union k v
mkUnion Union k v
UEmpty Union k v
u = Union k v
u
mkUnion Union k v
u Union k v
UEmpty = Union k v
u
mkUnion Union k v
u1 Union k v
u2 = Union k v -> Union k v -> Union k v
forall k v. Union k v -> Union k v -> Union k v
Union Union k v
u1 Union k v
u2

fromUnion :: Interval k e => Union k v -> IntervalMap k v
fromUnion :: forall k e v. Interval k e => Union k v -> IntervalMap k v
fromUnion Union k v
UEmpty               = IntervalMap k v
forall k v. IntervalMap k v
empty
fromUnion (UCons k
key v
v Union k v
UEmpty) = k -> v -> IntervalMap k v
forall k v. k -> v -> IntervalMap k v
singleton k
key v
v
fromUnion (UAppend IntervalMap k v
mp Union k v
UEmpty)  = IntervalMap k v -> IntervalMap k v
forall k v. IntervalMap k v -> IntervalMap k v
turnBlack IntervalMap k v
mp
fromUnion Union k v
x                    = [(k, v)] -> IntervalMap k v
forall k e v. Interval k e => [(k, v)] -> IntervalMap k v
fromDistinctAscList (Union k v -> [(k, v)] -> [(k, v)]
forall {a} {b}. Union a b -> [(a, b)] -> [(a, b)]
unfold Union k v
x [])
  where
    unfold :: Union a b -> [(a, b)] -> [(a, b)]
unfold Union a b
UEmpty        [(a, b)]
r = [(a, b)]
r
    unfold (Union Union a b
a Union a b
b)   [(a, b)]
r = Union a b -> [(a, b)] -> [(a, b)]
unfold Union a b
a (Union a b -> [(a, b)] -> [(a, b)]
unfold Union a b
b [(a, b)]
r)
    unfold (UCons a
k b
v Union a b
u) [(a, b)]
r = (a
k,b
v) (a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
: Union a b -> [(a, b)] -> [(a, b)]
unfold Union a b
u [(a, b)]
r
    unfold (UAppend IntervalMap a b
s Union a b
u) [(a, b)]
r = IntervalMap a b -> [(a, b)] -> [(a, b)]
forall k v. IntervalMap k v -> [(k, v)] -> [(k, v)]
toAscList' IntervalMap a b
s (Union a b -> [(a, b)] -> [(a, b)]
unfold Union a b
u [(a, b)]
r)


-- submaps

-- | /O(n+m)/. This function is defined as (@'isSubmapOf' = 'isSubmapOfBy' (==)@).
isSubmapOf :: (Ord k, Eq a) => IntervalMap k a -> IntervalMap k a -> Bool
isSubmapOf :: forall k a.
(Ord k, Eq a) =>
IntervalMap k a -> IntervalMap k a -> Bool
isSubmapOf IntervalMap k a
m1 IntervalMap k a
m2 = (a -> a -> Bool) -> IntervalMap k a -> IntervalMap k a -> Bool
forall k a b.
Ord k =>
(a -> b -> Bool) -> IntervalMap k a -> IntervalMap k b -> Bool
isSubmapOfBy a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==) IntervalMap k a
m1 IntervalMap k a
m2

{- | /O(n+m)/.
 The expression (@'isSubmapOfBy' f t1 t2@) returns 'True' if
 all keys in @t1@ are in tree @t2@, and @f@ returns 'True' when
 applied to their respective values.
-}
isSubmapOfBy :: Ord k => (a -> b -> Bool) -> IntervalMap k a -> IntervalMap k b -> Bool
isSubmapOfBy :: forall k a b.
Ord k =>
(a -> b -> Bool) -> IntervalMap k a -> IntervalMap k b -> Bool
isSubmapOfBy a -> b -> Bool
f IntervalMap k a
m1 IntervalMap k b
m2 = (a -> b -> Bool) -> [(k, a)] -> [(k, b)] -> Bool
forall k a b.
Ord k =>
(a -> b -> Bool) -> [(k, a)] -> [(k, b)] -> Bool
ascListSubset a -> b -> Bool
f (IntervalMap k a -> [(k, a)]
forall k v. IntervalMap k v -> [(k, v)]
toAscList IntervalMap k a
m1) (IntervalMap k b -> [(k, b)]
forall k v. IntervalMap k v -> [(k, v)]
toAscList IntervalMap k b
m2)

ascListSubset :: Ord k => (a -> b -> Bool) -> [(k,a)] -> [(k,b)] -> Bool
ascListSubset :: forall k a b.
Ord k =>
(a -> b -> Bool) -> [(k, a)] -> [(k, b)] -> Bool
ascListSubset a -> b -> Bool
_ []    [(k, b)]
_  =  Bool
True
ascListSubset a -> b -> Bool
_ ((k, a)
_:[(k, a)]
_) [] =  Bool
False
ascListSubset a -> b -> Bool
f s1 :: [(k, a)]
s1@((k
k1,a
v1):[(k, a)]
r1) ((k
k2,b
v2):[(k, b)]
r2) =
  case k -> k -> Ordering
forall a. Ord a => a -> a -> Ordering
compare k
k1 k
k2 of
    Ordering
GT -> (a -> b -> Bool) -> [(k, a)] -> [(k, b)] -> Bool
forall k a b.
Ord k =>
(a -> b -> Bool) -> [(k, a)] -> [(k, b)] -> Bool
ascListSubset a -> b -> Bool
f [(k, a)]
s1 [(k, b)]
r2
    Ordering
EQ -> a -> b -> Bool
f a
v1 b
v2 Bool -> Bool -> Bool
&& (a -> b -> Bool) -> [(k, a)] -> [(k, b)] -> Bool
forall k a b.
Ord k =>
(a -> b -> Bool) -> [(k, a)] -> [(k, b)] -> Bool
ascListSubset a -> b -> Bool
f [(k, a)]
r1 [(k, b)]
r2
    Ordering
LT -> Bool
False

-- | /O(n+m)/. Is this a proper submap? (ie. a submap but not equal). 
-- Defined as (@'isProperSubmapOf' = 'isProperSubmapOfBy' (==)@).
isProperSubmapOf :: (Ord k, Eq a) => IntervalMap k a -> IntervalMap k a -> Bool
isProperSubmapOf :: forall k a.
(Ord k, Eq a) =>
IntervalMap k a -> IntervalMap k a -> Bool
isProperSubmapOf IntervalMap k a
m1 IntervalMap k a
m2 = (a -> a -> Bool) -> IntervalMap k a -> IntervalMap k a -> Bool
forall k a b.
Ord k =>
(a -> b -> Bool) -> IntervalMap k a -> IntervalMap k b -> Bool
isProperSubmapOfBy a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==) IntervalMap k a
m1 IntervalMap k a
m2

{- | /O(n+m)/. Is this a proper submap? (ie. a submap but not equal).
 The expression (@'isProperSubmapOfBy' f m1 m2@) returns 'True' when
 @m1@ and @m2@ are not equal,
 all keys in @m1@ are in @m2@, and when @f@ returns 'True' when
 applied to their respective values.
-}
isProperSubmapOfBy :: Ord k => (a -> b -> Bool) -> IntervalMap k a -> IntervalMap k b -> Bool
isProperSubmapOfBy :: forall k a b.
Ord k =>
(a -> b -> Bool) -> IntervalMap k a -> IntervalMap k b -> Bool
isProperSubmapOfBy a -> b -> Bool
f IntervalMap k a
m1 IntervalMap k b
m2 = [(k, a)] -> [(k, b)] -> Bool
forall {k}. Ord k => [(k, a)] -> [(k, b)] -> Bool
go (IntervalMap k a -> [(k, a)]
forall k v. IntervalMap k v -> [(k, v)]
toAscList IntervalMap k a
m1) (IntervalMap k b -> [(k, b)]
forall k v. IntervalMap k v -> [(k, v)]
toAscList IntervalMap k b
m2)
  where
    go :: [(k, a)] -> [(k, b)] -> Bool
go [] ((k, b)
_:[(k, b)]
_)  =  Bool
True
    go [(k, a)]
_  []     =  Bool
False
    go s1 :: [(k, a)]
s1@((k
k1,a
v1):[(k, a)]
r1) ((k
k2,b
v2):[(k, b)]
r2) =
       case k -> k -> Ordering
forall a. Ord a => a -> a -> Ordering
compare k
k1 k
k2 of
         Ordering
GT -> (a -> b -> Bool) -> [(k, a)] -> [(k, b)] -> Bool
forall k a b.
Ord k =>
(a -> b -> Bool) -> [(k, a)] -> [(k, b)] -> Bool
ascListSubset a -> b -> Bool
f [(k, a)]
s1 [(k, b)]
r2
         Ordering
EQ -> a -> b -> Bool
f a
v1 b
v2 Bool -> Bool -> Bool
&& [(k, a)] -> [(k, b)] -> Bool
go [(k, a)]
r1 [(k, b)]
r2
         Ordering
LT -> Bool
False


-- debugging

-- | Check red-black-tree and interval search augmentation invariants.
-- For testing/debugging only.
valid :: (Interval i k, Ord i) => IntervalMap i v -> Bool
valid :: forall i k v. (Interval i k, Ord i) => IntervalMap i v -> Bool
valid IntervalMap i v
mp = IntervalMap i v -> Bool
forall i k v. (Interval i k, Ord i) => IntervalMap i v -> Bool
test IntervalMap i v
mp Bool -> Bool -> Bool
&& IntervalMap i v -> Int
forall k a. IntervalMap k a -> Int
height IntervalMap i v
mp Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int -> Int
maxHeight (IntervalMap i v -> Int
forall k a. IntervalMap k a -> Int
size IntervalMap i v
mp) Bool -> Bool -> Bool
&& IntervalMap i v -> Bool
forall k a. IntervalMap k a -> Bool
validColor IntervalMap i v
mp
  where
    test :: IntervalMap a v -> Bool
test IntervalMap a v
Nil = Bool
True
    test n :: IntervalMap a v
n@(Node Color
_ a
_ a
_ v
_ IntervalMap a v
l IntervalMap a v
r) = IntervalMap a v -> Bool
forall {a} {v}. Ord a => IntervalMap a v -> Bool
validOrder IntervalMap a v
n Bool -> Bool -> Bool
&& IntervalMap a v -> Bool
forall {a} {k} {v}. (Interval a k, Eq a) => IntervalMap a v -> Bool
validMax IntervalMap a v
n Bool -> Bool -> Bool
&& IntervalMap a v -> Bool
test IntervalMap a v
l Bool -> Bool -> Bool
&& IntervalMap a v -> Bool
test IntervalMap a v
r
    validMax :: IntervalMap a v -> Bool
validMax (Node Color
_ a
k a
m v
_ IntervalMap a v
lo IntervalMap a v
hi) =  a
m a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a -> IntervalMap a v -> IntervalMap a v -> a
forall i k v.
Interval i k =>
i -> IntervalMap i v -> IntervalMap i v -> i
maxUpper a
k IntervalMap a v
lo IntervalMap a v
hi
    validMax IntervalMap a v
Nil = Bool
True

    validOrder :: IntervalMap a v -> Bool
validOrder (Node Color
_ a
_ a
_ v
_ IntervalMap a v
Nil IntervalMap a v
Nil) = Bool
True
    validOrder (Node Color
_ a
k1 a
_ v
_ IntervalMap a v
Nil (Node Color
_ a
k2 a
_ v
_ IntervalMap a v
_ IntervalMap a v
_)) = a
k1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
k2
    validOrder (Node Color
_ a
k2 a
_ v
_ (Node Color
_ a
k1 a
_ v
_ IntervalMap a v
_ IntervalMap a v
_) IntervalMap a v
Nil) = a
k1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
k2
    validOrder (Node Color
_ a
k2 a
_ v
_ (Node Color
_ a
k1 a
_ v
_ IntervalMap a v
_ IntervalMap a v
_) (Node Color
_ a
k3 a
_ v
_ IntervalMap a v
_ IntervalMap a v
_)) = a
k1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
k2 Bool -> Bool -> Bool
&& a
k2 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
k3
    validOrder IntervalMap a v
Nil = Bool
True

    -- validColor parentColor blackCount tree
    validColor :: IntervalMap k v -> Bool
validColor IntervalMap k v
n = IntervalMap k v -> Int
forall k a. IntervalMap k a -> Int
blackDepth IntervalMap k v
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0

    -- return -1 if subtrees have diffrent black depths or two consecutive red nodes are encountered
    blackDepth :: IntervalMap k v -> Int
    blackDepth :: forall k a. IntervalMap k a -> Int
blackDepth IntervalMap k v
Nil  = Int
0
    blackDepth (Node Color
c k
_ k
_ v
_ IntervalMap k v
l IntervalMap k v
r) = case IntervalMap k v -> Int
forall k a. IntervalMap k a -> Int
blackDepth IntervalMap k v
l of
                                      Int
ld -> if Int
ld Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 then Int
ld
                                            else
                                              case IntervalMap k v -> Int
forall k a. IntervalMap k a -> Int
blackDepth IntervalMap k v
r of
                                                Int
rd | Int
rd Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0    -> Int
rd
                                                   | Int
rd Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
ld Bool -> Bool -> Bool
|| (Color
c Color -> Color -> Bool
forall a. Eq a => a -> a -> Bool
== Color
R Bool -> Bool -> Bool
&& (IntervalMap k v -> Bool
forall k a. IntervalMap k a -> Bool
isRed IntervalMap k v
l Bool -> Bool -> Bool
|| IntervalMap k v -> Bool
forall k a. IntervalMap k a -> Bool
isRed IntervalMap k v
r)) -> -Int
1
                                                   | Color
c Color -> Color -> Bool
forall a. Eq a => a -> a -> Bool
== Color
B    -> Int
rd Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
                                                   | Bool
otherwise -> Int
rd