{-# OPTIONS_GHC -Wall #-}
{-# LANGUAGE CPP, LambdaCase, ScopedTypeVariables, TypeFamilies, DeriveDataTypeable, MultiWayIf, GeneralizedNewtypeDeriving #-}
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE RoleAnnotations #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Data.IntervalMap.Base
-- Copyright   :  (c) Masahiro Sakai 2016
-- License     :  BSD-style
--
-- Maintainer  :  masahiro.sakai@gmail.com
-- Stability   :  provisional
-- Portability :  non-portable (CPP, ScopedTypeVariables, TypeFamilies, DeriveDataTypeable, MultiWayIf, GeneralizedNewtypeDeriving)
--
-- Interval datatype and interval arithmetic.
--
-----------------------------------------------------------------------------
module Data.IntervalMap.Base
  (
  -- * IntervalMap type
    IntervalMap (..)
  , module Data.ExtendedReal

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

  -- * Query
  , null
  , member
  , notMember
  , lookup
  , findWithDefault
  , span

  -- * Construction
  , whole
  , empty
  , singleton

  -- ** Insertion
  , insert
  , insertWith

  -- ** Delete\/Update
  , delete
  , adjust
  , update
  , alter

  -- * Combine
  , union
  , unionWith
  , unions
  , unionsWith
  , intersection
  , intersectionWith
  , difference

  -- * Traversal
  , map
  , mapKeysMonotonic

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

  -- ** List
  , fromList
  , fromListWith
  , toList

  -- ** Ordered List
  , toAscList
  , toDescList

  -- * Filter
  , filter
  , split

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

import Prelude hiding (null, lookup, map, filter, span, and)
import Control.DeepSeq
import Data.Data
import Data.ExtendedReal
import Data.Hashable
import Data.Foldable hiding (null, toList)
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Maybe
import qualified Data.Semigroup as Semigroup
import Data.Interval (Interval)
import qualified Data.Interval as Interval
import Data.IntervalSet (IntervalSet)
import qualified Data.IntervalSet as IntervalSet
#if __GLASGOW_HASKELL__ < 804
import Data.Monoid (Monoid(..))
#endif
import qualified GHC.Exts as GHCExts

-- ------------------------------------------------------------------------
-- The IntervalMap type

-- | A Map from non-empty, disjoint intervals over k to values a.
--
-- Unlike 'IntervalSet', 'IntervalMap' never merge adjacent mappings,
-- even if adjacent intervals are connected and mapped to the same value.
newtype IntervalMap r a = IntervalMap (Map (LB r) (Interval r, a))
  deriving
    ( IntervalMap r a -> IntervalMap r a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall r a.
(Eq r, Eq a) =>
IntervalMap r a -> IntervalMap r a -> Bool
/= :: IntervalMap r a -> IntervalMap r a -> Bool
$c/= :: forall r a.
(Eq r, Eq a) =>
IntervalMap r a -> IntervalMap r a -> Bool
== :: IntervalMap r a -> IntervalMap r a -> Bool
$c== :: forall r a.
(Eq r, Eq a) =>
IntervalMap r a -> IntervalMap r a -> Bool
Eq
    , IntervalMap r a -> IntervalMap r a -> Bool
IntervalMap r a -> IntervalMap r a -> Ordering
IntervalMap r a -> IntervalMap r a -> IntervalMap r a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {r} {a}. (Ord r, Ord a) => Eq (IntervalMap r a)
forall r a.
(Ord r, Ord a) =>
IntervalMap r a -> IntervalMap r a -> Bool
forall r a.
(Ord r, Ord a) =>
IntervalMap r a -> IntervalMap r a -> Ordering
forall r a.
(Ord r, Ord a) =>
IntervalMap r a -> IntervalMap r a -> IntervalMap r a
min :: IntervalMap r a -> IntervalMap r a -> IntervalMap r a
$cmin :: forall r a.
(Ord r, Ord a) =>
IntervalMap r a -> IntervalMap r a -> IntervalMap r a
max :: IntervalMap r a -> IntervalMap r a -> IntervalMap r a
$cmax :: forall r a.
(Ord r, Ord a) =>
IntervalMap r a -> IntervalMap r a -> IntervalMap r a
>= :: IntervalMap r a -> IntervalMap r a -> Bool
$c>= :: forall r a.
(Ord r, Ord a) =>
IntervalMap r a -> IntervalMap r a -> Bool
> :: IntervalMap r a -> IntervalMap r a -> Bool
$c> :: forall r a.
(Ord r, Ord a) =>
IntervalMap r a -> IntervalMap r a -> Bool
<= :: IntervalMap r a -> IntervalMap r a -> Bool
$c<= :: forall r a.
(Ord r, Ord a) =>
IntervalMap r a -> IntervalMap r a -> Bool
< :: IntervalMap r a -> IntervalMap r a -> Bool
$c< :: forall r a.
(Ord r, Ord a) =>
IntervalMap r a -> IntervalMap r a -> Bool
compare :: IntervalMap r a -> IntervalMap r a -> Ordering
$ccompare :: forall r a.
(Ord r, Ord a) =>
IntervalMap r a -> IntervalMap r a -> Ordering
Ord
      -- ^ Note that this Ord is derived and not semantically meaningful.
      -- The primary intended use case is to allow using 'IntervalSet'
      -- in maps and sets that require ordering.
    , Typeable
    )

type role IntervalMap nominal representational

instance (Ord k, Show k, Show a) => Show (IntervalMap k a) where
  showsPrec :: Int -> IntervalMap k a -> ShowS
showsPrec Int
p (IntervalMap Map (LB k) (Interval k, a)
m) = Bool -> ShowS -> ShowS
showParen (Int
p forall a. Ord a => a -> a -> Bool
> Int
appPrec) forall a b. (a -> b) -> a -> b
$
    String -> ShowS
showString String
"fromList " forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    forall a. Show a => Int -> a -> ShowS
showsPrec (Int
appPrecforall a. Num a => a -> a -> a
+Int
1) (forall k a. Map k a -> [a]
Map.elems Map (LB k) (Interval k, a)
m)

instance (Ord k, Read k, Read a) => Read (IntervalMap k a) where
  readsPrec :: Int -> ReadS (IntervalMap k a)
readsPrec Int
p =
    (forall a. Bool -> ReadS a -> ReadS a
readParen (Int
p forall a. Ord a => a -> a -> Bool
> Int
appPrec) forall a b. (a -> b) -> a -> b
$ \String
s0 -> do
      (String
"fromList",String
s1) <- ReadS String
lex String
s0
      ([(Interval k, a)]
xs,String
s2) <- forall a. Read a => Int -> ReadS a
readsPrec (Int
appPrecforall a. Num a => a -> a -> a
+Int
1) String
s1
      forall (m :: * -> *) a. Monad m => a -> m a
return (forall k a. Ord k => [(Interval k, a)] -> IntervalMap k a
fromList [(Interval k, a)]
xs, String
s2))

appPrec :: Int
appPrec :: Int
appPrec = Int
10

-- This instance preserves data abstraction at the cost of inefficiency.
-- We provide limited reflection services for the sake of data abstraction.

instance (Data k, Data a, Ord k) => Data (IntervalMap k a) where
  gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> IntervalMap k a -> c (IntervalMap k a)
gfoldl forall d b. Data d => c (d -> b) -> d -> c b
k forall g. g -> c g
z IntervalMap k a
x   = forall g. g -> c g
z forall k a. Ord k => [(Interval k, a)] -> IntervalMap k a
fromList forall d b. Data d => c (d -> b) -> d -> c b
`k` forall k a. IntervalMap k a -> [(Interval k, a)]
toList IntervalMap k a
x
  toConstr :: IntervalMap k a -> Constr
toConstr IntervalMap k a
_     = Constr
fromListConstr
  gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (IntervalMap k a)
gunfold forall b r. Data b => c (b -> r) -> c r
k forall r. r -> c r
z Constr
c  = case Constr -> Int
constrIndex Constr
c of
    Int
1 -> forall b r. Data b => c (b -> r) -> c r
k (forall r. r -> c r
z forall k a. Ord k => [(Interval k, a)] -> IntervalMap k a
fromList)
    Int
_ -> forall a. HasCallStack => String -> a
error String
"gunfold"
  dataTypeOf :: IntervalMap k a -> DataType
dataTypeOf IntervalMap k a
_   = DataType
mapDataType
  dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (IntervalMap k a))
dataCast1 forall d. Data d => c (t d)
f    = forall {k1} {k2} (c :: k1 -> *) (t :: k2 -> k1) (t' :: k2 -> k1)
       (a :: k2).
(Typeable t, Typeable t') =>
c (t a) -> Maybe (c (t' a))
gcast1 forall d. Data d => c (t d)
f

fromListConstr :: Constr
fromListConstr :: Constr
fromListConstr = DataType -> String -> [String] -> Fixity -> Constr
mkConstr DataType
mapDataType String
"fromList" [] Fixity
Prefix

mapDataType :: DataType
mapDataType :: DataType
mapDataType = String -> [Constr] -> DataType
mkDataType String
"Data.IntervalMap.Base.IntervalMap" [Constr
fromListConstr]

instance (NFData k, NFData a) => NFData (IntervalMap k a) where
  rnf :: IntervalMap k a -> ()
rnf (IntervalMap Map (LB k) (Interval k, a)
m) = forall a. NFData a => a -> ()
rnf Map (LB k) (Interval k, a)
m

instance (Hashable k, Hashable a) => Hashable (IntervalMap k a) where
  hashWithSalt :: Int -> IntervalMap k a -> Int
hashWithSalt Int
s IntervalMap k a
m = forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s (forall k a. IntervalMap k a -> [(Interval k, a)]
toList IntervalMap k a
m)

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

instance Ord k => Semigroup.Semigroup (IntervalMap k a) where
  <> :: IntervalMap k a -> IntervalMap k a -> IntervalMap k a
(<>)   = forall k a.
Ord k =>
IntervalMap k a -> IntervalMap k a -> IntervalMap k a
union
  stimes :: forall b. Integral b => b -> IntervalMap k a -> IntervalMap k a
stimes = forall b a. (Integral b, Monoid a) => b -> a -> a
Semigroup.stimesIdempotentMonoid

instance Ord k => GHCExts.IsList (IntervalMap k a) where
  type Item (IntervalMap k a) = (Interval k, a)
  fromList :: [Item (IntervalMap k a)] -> IntervalMap k a
fromList = forall k a. Ord k => [(Interval k, a)] -> IntervalMap k a
fromList
  toList :: IntervalMap k a -> [Item (IntervalMap k a)]
toList = forall k a. IntervalMap k a -> [(Interval k, a)]
toList

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

newtype LB r = LB (Extended r, Interval.Boundary)
  deriving (LB r -> LB r -> Bool
forall r. Eq r => LB r -> LB r -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LB r -> LB r -> Bool
$c/= :: forall r. Eq r => LB r -> LB r -> Bool
== :: LB r -> LB r -> Bool
$c== :: forall r. Eq r => LB r -> LB r -> Bool
Eq, LB r -> ()
forall r. NFData r => LB r -> ()
forall a. (a -> ()) -> NFData a
rnf :: LB r -> ()
$crnf :: forall r. NFData r => LB r -> ()
NFData, Typeable)

instance Ord r => Ord (LB r) where
  compare :: LB r -> LB r -> Ordering
compare (LB (Extended r
lb1, Boundary
lb1in)) (LB (Extended r
lb2, Boundary
lb2in)) =
    -- inclusive lower endpoint shuold be considered smaller
    (Extended r
lb1 forall a. Ord a => a -> a -> Ordering
`compare` Extended r
lb2) forall a. Monoid a => a -> a -> a
`mappend` (Boundary
lb2in forall a. Ord a => a -> a -> Ordering
`compare` Boundary
lb1in)

-- ------------------------------------------------------------------------
-- Operators

infixl 9 !,\\ --

-- | Find the value at a key. Calls 'error' when the element can not be found.
(!) :: Ord k => IntervalMap k a -> k -> a
IntervalMap Map (LB k) (Interval k, a)
m ! :: forall k a. Ord k => IntervalMap k a -> k -> a
! k
k =
  case forall k v. Ord k => k -> Map k v -> Maybe (k, v)
Map.lookupLE (forall r. (Extended r, Boundary) -> LB r
LB (forall r. r -> Extended r
Finite k
k, Boundary
Interval.Closed)) Map (LB k) (Interval k, a)
m of
    Just (LB k
_, (Interval k
i, a
a)) | k
k forall r. Ord r => r -> Interval r -> Bool
`Interval.member` Interval k
i -> a
a
    Maybe (LB k, (Interval k, a))
_ -> forall a. HasCallStack => String -> a
error String
"IntervalMap.!: given key is not an element in the map"

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

-- ------------------------------------------------------------------------
-- Query

-- | Is the map empty?
null :: Ord k => IntervalMap k a -> Bool
null :: forall k a. Ord k => IntervalMap k a -> Bool
null (IntervalMap Map (LB k) (Interval k, a)
m) = forall k a. Map k a -> Bool
Map.null Map (LB k) (Interval k, a)
m

-- | Is the key a member of the map? See also 'notMember'.
member :: Ord k => k -> IntervalMap k a -> Bool
member :: forall k a. Ord k => k -> IntervalMap k a -> Bool
member k
k (IntervalMap Map (LB k) (Interval k, a)
m) =
  case forall k v. Ord k => k -> Map k v -> Maybe (k, v)
Map.lookupLE (forall r. (Extended r, Boundary) -> LB r
LB (forall r. r -> Extended r
Finite k
k, Boundary
Interval.Closed)) Map (LB k) (Interval k, a)
m of
    Just (LB k
_, (Interval k
i, a
_)) -> k
k forall r. Ord r => r -> Interval r -> Bool
`Interval.member` Interval k
i
    Maybe (LB k, (Interval k, a))
Nothing -> Bool
False

-- | Is the key not a member of the map? See also 'member'.
notMember :: Ord k => k -> IntervalMap k a -> Bool
notMember :: forall k a. Ord k => k -> IntervalMap k a -> Bool
notMember k
k IntervalMap k a
m = Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> IntervalMap k a -> Bool
member k
k IntervalMap k a
m

-- | Lookup the value at a key in the map.
--
-- The function will return the corresponding value as @('Just' value)@,
-- or 'Nothing' if the key isn't in the map.
lookup :: Ord k => k -> IntervalMap k a -> Maybe a
lookup :: forall k a. Ord k => k -> IntervalMap k a -> Maybe a
lookup k
k (IntervalMap Map (LB k) (Interval k, a)
m) =
  case forall k v. Ord k => k -> Map k v -> Maybe (k, v)
Map.lookupLE (forall r. (Extended r, Boundary) -> LB r
LB (forall r. r -> Extended r
Finite k
k, Boundary
Interval.Closed)) Map (LB k) (Interval k, a)
m of
    Just (LB k
_, (Interval k
i, a
a)) | k
k forall r. Ord r => r -> Interval r -> Bool
`Interval.member` Interval k
i -> forall a. a -> Maybe a
Just a
a
    Maybe (LB k, (Interval k, a))
_ -> forall a. Maybe a
Nothing

-- | 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 Map (LB k) (Interval k, a)
m) =
  case forall k v. Ord k => k -> Map k v -> Maybe (k, v)
Map.lookupLE (forall r. (Extended r, Boundary) -> LB r
LB (forall r. r -> Extended r
Finite k
k, Boundary
Interval.Closed)) Map (LB k) (Interval k, a)
m of
    Just (LB k
_, (Interval k
i, a
a)) | k
k forall r. Ord r => r -> Interval r -> Bool
`Interval.member` Interval k
i -> a
a
    Maybe (LB k, (Interval k, a))
_ -> a
def

lookupInterval :: Ord k => Interval k -> IntervalMap k a -> Maybe a
lookupInterval :: forall k a. Ord k => Interval k -> IntervalMap k a -> Maybe a
lookupInterval Interval k
i (IntervalMap Map (LB k) (Interval k, a)
m) =
  case forall k v. Ord k => k -> Map k v -> Maybe (k, v)
Map.lookupLE (forall r. (Extended r, Boundary) -> LB r
LB (forall r. Interval r -> (Extended r, Boundary)
Interval.lowerBound' Interval k
i)) Map (LB k) (Interval k, a)
m of
    Just (LB k
_, (Interval k
j, a
a)) | Interval k
i forall r. Ord r => Interval r -> Interval r -> Bool
`Interval.isSubsetOf` Interval k
j -> forall a. a -> Maybe a
Just a
a
    Maybe (LB k, (Interval k, a))
_ -> forall a. Maybe a
Nothing

-- | convex hull of key intervals.
span :: Ord k => IntervalMap k a -> Interval k
span :: forall k a. Ord k => IntervalMap k a -> Interval k
span = forall r. Ord r => IntervalSet r -> Interval r
IntervalSet.span forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => IntervalMap k a -> IntervalSet k
keysSet

-- ------------------------------------------------------------------------
-- Construction

-- | The empty map.
empty :: Ord k => IntervalMap k a
empty :: forall k a. Ord k => IntervalMap k a
empty = forall r a. Map (LB r) (Interval r, a) -> IntervalMap r a
IntervalMap forall k a. Map k a
Map.empty

-- | The map that maps whole range of k to a.
whole :: Ord k => a -> IntervalMap k a
whole :: forall k a. Ord k => a -> IntervalMap k a
whole a
a = forall r a. Map (LB r) (Interval r, a) -> IntervalMap r a
IntervalMap forall a b. (a -> b) -> a -> b
$ forall k a. k -> a -> Map k a
Map.singleton (forall r. (Extended r, Boundary) -> LB r
LB (forall r. Interval r -> (Extended r, Boundary)
Interval.lowerBound' Interval k
i)) (Interval k
i, a
a)
  where
    i :: Interval k
i = forall r. Ord r => Interval r
Interval.whole

-- | A map with a single interval.
singleton :: Ord k => Interval k -> a -> IntervalMap k a
singleton :: forall k a. Ord k => Interval k -> a -> IntervalMap k a
singleton Interval k
i a
a
  | forall r. Ord r => Interval r -> Bool
Interval.null Interval k
i = forall k a. Ord k => IntervalMap k a
empty
  | Bool
otherwise = forall r a. Map (LB r) (Interval r, a) -> IntervalMap r a
IntervalMap forall a b. (a -> b) -> a -> b
$ forall k a. k -> a -> Map k a
Map.singleton (forall r. (Extended r, Boundary) -> LB r
LB (forall r. Interval r -> (Extended r, Boundary)
Interval.lowerBound' Interval k
i)) (Interval k
i, a
a)

-- ------------------------------------------------------------------------
-- Insertion

-- | insert a new key and value in the map.
-- If the key is already present in the map, the associated value is
-- replaced with the supplied value.
insert :: Ord k => Interval k -> a -> IntervalMap k a -> IntervalMap k a
insert :: forall k a.
Ord k =>
Interval k -> a -> IntervalMap k a -> IntervalMap k a
insert Interval k
i a
_ IntervalMap k a
m | forall r. Ord r => Interval r -> Bool
Interval.null Interval k
i = IntervalMap k a
m
insert Interval k
i a
a IntervalMap k a
m =
  case forall k a.
Ord k =>
Interval k
-> IntervalMap k a
-> (IntervalMap k a, IntervalMap k a, IntervalMap k a)
split Interval k
i IntervalMap k a
m of
    (IntervalMap Map (LB k) (Interval k, a)
m1, IntervalMap k a
_, IntervalMap Map (LB k) (Interval k, a)
m2) ->
      forall r a. Map (LB r) (Interval r, a) -> IntervalMap r a
IntervalMap forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map (LB k) (Interval k, a)
m1 (forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (forall r. (Extended r, Boundary) -> LB r
LB (forall r. Interval r -> (Extended r, Boundary)
Interval.lowerBound' Interval k
i)) (Interval k
i,a
a) Map (LB k) (Interval k, a)
m2)


-- | Insert with a function, combining new value and old value.
-- @'insertWith' f key value mp@ will insert the pair (interval, value) into @mp@.
-- If the interval overlaps with existing entries, the value for the entry is replace
-- with @(f new_value old_value)@.
insertWith :: Ord k => (a -> a -> a) -> Interval k -> a -> IntervalMap k a -> IntervalMap k a
insertWith :: forall k a.
Ord k =>
(a -> a -> a)
-> Interval k -> a -> IntervalMap k a -> IntervalMap k a
insertWith a -> a -> a
_ Interval k
i a
_ IntervalMap k a
m | forall r. Ord r => Interval r -> Bool
Interval.null Interval k
i = IntervalMap k a
m
insertWith a -> a -> a
f Interval k
i a
a IntervalMap k a
m = forall k a.
Ord k =>
(Maybe a -> Maybe a)
-> Interval k -> IntervalMap k a -> IntervalMap k a
alter Maybe a -> Maybe a
g Interval k
i IntervalMap k a
m
  where
    g :: Maybe a -> Maybe a
g Maybe a
Nothing = forall a. a -> Maybe a
Just a
a
    g (Just a
a') = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ a -> a -> a
f a
a a
a'

-- ------------------------------------------------------------------------
-- Delete/Update

-- | Delete an interval and its value from the map.
-- When the interval does not overlap with the map, the original map is returned.
delete :: Ord k => Interval k -> IntervalMap k a -> IntervalMap k a
delete :: forall k a.
Ord k =>
Interval k -> IntervalMap k a -> IntervalMap k a
delete Interval k
i IntervalMap k a
m | forall r. Ord r => Interval r -> Bool
Interval.null Interval k
i = IntervalMap k a
m
delete Interval k
i IntervalMap k a
m =
  case forall k a.
Ord k =>
Interval k
-> IntervalMap k a
-> (IntervalMap k a, IntervalMap k a, IntervalMap k a)
split Interval k
i IntervalMap k a
m of
    (IntervalMap Map (LB k) (Interval k, a)
m1, IntervalMap k a
_, IntervalMap Map (LB k) (Interval k, a)
m2) ->
      forall r a. Map (LB r) (Interval r, a) -> IntervalMap r a
IntervalMap forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map (LB k) (Interval k, a)
m1 Map (LB k) (Interval k, a)
m2

-- | Update a value at a specific interval with the result of the provided function.
-- When the interval does not overlatp with the map, the original map is returned.
adjust :: Ord k => (a -> a) -> Interval k -> IntervalMap k a -> IntervalMap k a
adjust :: forall k a.
Ord k =>
(a -> a) -> Interval k -> IntervalMap k a -> IntervalMap k a
adjust a -> a
f = forall k a.
Ord k =>
(a -> Maybe a) -> Interval k -> IntervalMap k a -> IntervalMap k a
update (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
f)

-- | The expression (@'update' f i map@) updates the value @x@
-- at @i@ (if it is in the map). If (@f x@) is 'Nothing', the element is
-- deleted. If it is (@'Just' y@), the key @i@ is bound to the new value @y@.
update :: Ord k => (a -> Maybe a) -> Interval k -> IntervalMap k a -> IntervalMap k a
update :: forall k a.
Ord k =>
(a -> Maybe a) -> Interval k -> IntervalMap k a -> IntervalMap k a
update a -> Maybe a
_ Interval k
i IntervalMap k a
m | forall r. Ord r => Interval r -> Bool
Interval.null Interval k
i = IntervalMap k a
m
update a -> Maybe a
f Interval k
i IntervalMap k a
m =
  case forall k a.
Ord k =>
Interval k
-> IntervalMap k a
-> (IntervalMap k a, IntervalMap k a, IntervalMap k a)
split Interval k
i IntervalMap k a
m of
    (IntervalMap Map (LB k) (Interval k, a)
m1, IntervalMap Map (LB k) (Interval k, a)
m2, IntervalMap Map (LB k) (Interval k, a)
m3) ->
      forall r a. Map (LB r) (Interval r, a) -> IntervalMap r a
IntervalMap forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
Map.unions [Map (LB k) (Interval k, a)
m1, forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe (\(Interval k
j,a
a) -> (\a
b -> (Interval k
j,a
b)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> Maybe a
f a
a) Map (LB k) (Interval k, a)
m2, Map (LB k) (Interval k, a)
m3]

-- | The expression (@'alter' f i map@) alters the value @x@ at @i@, or absence thereof.
-- 'alter' can be used to insert, delete, or update a value in a 'IntervalMap'.
alter :: Ord k => (Maybe a -> Maybe a) -> Interval k -> IntervalMap k a -> IntervalMap k a
alter :: forall k a.
Ord k =>
(Maybe a -> Maybe a)
-> Interval k -> IntervalMap k a -> IntervalMap k a
alter Maybe a -> Maybe a
_ Interval k
i IntervalMap k a
m | forall r. Ord r => Interval r -> Bool
Interval.null Interval k
i = IntervalMap k a
m
alter Maybe a -> Maybe a
f Interval k
i IntervalMap k a
m =
  case forall k a.
Ord k =>
Interval k
-> IntervalMap k a
-> (IntervalMap k a, IntervalMap k a, IntervalMap k a)
split Interval k
i IntervalMap k a
m of
    (IntervalMap Map (LB k) (Interval k, a)
m1, IntervalMap Map (LB k) (Interval k, a)
m2, IntervalMap Map (LB k) (Interval k, a)
m3) ->
      let m2' :: Map (LB k) (Interval k, a)
m2' = forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe (\(Interval k
j,a
a) -> (\a
b -> (Interval k
j,a
b)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe a -> Maybe a
f (forall a. a -> Maybe a
Just a
a)) Map (LB k) (Interval k, a)
m2
          js :: IntervalSet k
js = forall r. Ord r => Interval r -> IntervalSet r
IntervalSet.singleton Interval k
i forall r. Ord r => IntervalSet r -> IntervalSet r -> IntervalSet r
`IntervalSet.difference` forall k a. Ord k => IntervalMap k a -> IntervalSet k
keysSet (forall r a. Map (LB r) (Interval r, a) -> IntervalMap r a
IntervalMap Map (LB k) (Interval k, a)
m2)
          IntervalMap Map (LB k) (Interval k, a)
m2'' =
            case Maybe a -> Maybe a
f forall a. Maybe a
Nothing of
              Maybe a
Nothing -> forall k a. Ord k => IntervalMap k a
empty
              Just a
a -> forall k a. Ord k => [(Interval k, a)] -> IntervalMap k a
fromList [(Interval k
j,a
a) | Interval k
j <- forall r. Ord r => IntervalSet r -> [Interval r]
IntervalSet.toList IntervalSet k
js]
      in forall r a. Map (LB r) (Interval r, a) -> IntervalMap r a
IntervalMap forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
Map.unions [Map (LB k) (Interval k, a)
m1, Map (LB k) (Interval k, a)
m2', Map (LB k) (Interval k, a)
m2'', Map (LB k) (Interval k, a)
m3]

-- ------------------------------------------------------------------------
-- Combine

-- | The expression (@'union' t1 t2@) takes the left-biased union of @t1@ and @t2@.
-- It prefers @t1@ when overlapping keys are encountered,
union :: Ord k => IntervalMap k a -> IntervalMap k a -> IntervalMap k a
union :: forall k a.
Ord k =>
IntervalMap k a -> IntervalMap k a -> IntervalMap k a
union IntervalMap k a
m1 IntervalMap k a
m2 =
  forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\IntervalMap k a
m (Interval k
i,a
a) -> forall k a.
Ord k =>
Interval k -> a -> IntervalMap k a -> IntervalMap k a
insert Interval k
i a
a IntervalMap k a
m) IntervalMap k a
m2 (forall k a. IntervalMap k a -> [(Interval k, a)]
toList IntervalMap k a
m1)

-- | Union with a combining function.
unionWith :: Ord k => (a -> a -> a) -> IntervalMap k a -> IntervalMap k a -> IntervalMap k a
unionWith :: forall k a.
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 =
  forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\IntervalMap k a
m (Interval k
i,a
a) -> forall k a.
Ord k =>
(a -> a -> a)
-> Interval k -> a -> IntervalMap k a -> IntervalMap k a
insertWith a -> a -> a
f Interval k
i a
a IntervalMap k a
m) IntervalMap k a
m2 (forall k a. IntervalMap k a -> [(Interval k, a)]
toList IntervalMap k a
m1)

-- | The union of a list of maps:
--   (@'unions' == 'Prelude.foldl' 'union' 'empty'@).
unions :: Ord k => [IntervalMap k a] -> IntervalMap k a
unions :: forall k a. Ord k => [IntervalMap k a] -> IntervalMap k a
unions = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall k a.
Ord k =>
IntervalMap k a -> IntervalMap k a -> IntervalMap k a
union forall k a. Ord k => IntervalMap k a
empty

-- | The union of a list of maps, with a combining operation:
--   (@'unionsWith' f == 'Prelude.foldl' ('unionWith' f) 'empty'@).
unionsWith :: Ord k => (a -> a -> a) -> [IntervalMap k a] -> IntervalMap k a
unionsWith :: forall k a.
Ord k =>
(a -> a -> a) -> [IntervalMap k a] -> IntervalMap k a
unionsWith a -> a -> a
f = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (forall k a.
Ord k =>
(a -> a -> a)
-> IntervalMap k a -> IntervalMap k a -> IntervalMap k a
unionWith a -> a -> a
f) forall k a. Ord k => IntervalMap k a
empty

-- | Return elements of the first map not existing in the second map.
difference :: Ord k => IntervalMap k a -> IntervalMap k b -> IntervalMap k a
difference :: forall k a b.
Ord k =>
IntervalMap k a -> IntervalMap k b -> IntervalMap k a
difference IntervalMap k a
m1 IntervalMap k b
m2 = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\IntervalMap k a
m Interval k
i -> forall k a.
Ord k =>
Interval k -> IntervalMap k a -> IntervalMap k a
delete Interval k
i IntervalMap k a
m) IntervalMap k a
m1 (forall r. Ord r => IntervalSet r -> [Interval r]
IntervalSet.toList (forall k a. Ord k => IntervalMap k a -> IntervalSet k
keysSet IntervalMap k b
m2))

-- | Intersection of two maps.
-- Return data in the first map for the keys existing in both maps.
intersection :: Ord k => IntervalMap k a -> IntervalMap k a -> IntervalMap k a
intersection :: forall k a.
Ord k =>
IntervalMap k a -> IntervalMap k a -> IntervalMap k a
intersection = forall k a b c.
Ord k =>
(a -> b -> c)
-> IntervalMap k a -> IntervalMap k b -> IntervalMap k c
intersectionWith forall a b. a -> b -> a
const

-- | Intersection with a combining function.
intersectionWith :: Ord k => (a -> b -> c) -> IntervalMap k a -> IntervalMap k b -> IntervalMap k c
intersectionWith :: forall k a b c.
Ord k =>
(a -> b -> c)
-> IntervalMap k a -> IntervalMap k b -> IntervalMap k c
intersectionWith a -> b -> c
f im1 :: IntervalMap k a
im1@(IntervalMap Map (LB k) (Interval k, a)
m1) im2 :: IntervalMap k b
im2@(IntervalMap Map (LB k) (Interval k, b)
m2)
  | forall k a. Map k a -> Int
Map.size Map (LB k) (Interval k, a)
m1 forall a. Ord a => a -> a -> Bool
>= forall k a. Map k a -> Int
Map.size Map (LB k) (Interval k, b)
m2 = forall k a b c.
Ord k =>
(a -> b -> c)
-> IntervalMap k a -> IntervalMap k b -> IntervalMap k c
g a -> b -> c
f IntervalMap k a
im1 IntervalMap k b
im2
  | Bool
otherwise = forall k a b c.
Ord k =>
(a -> b -> c)
-> IntervalMap k a -> IntervalMap k b -> IntervalMap k c
g (forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> b -> c
f) IntervalMap k b
im2 IntervalMap k a
im1
  where
    g :: Ord k => (a -> b -> c) -> IntervalMap k a -> IntervalMap k b -> IntervalMap k c
    g :: forall k a b c.
Ord k =>
(a -> b -> c)
-> IntervalMap k a -> IntervalMap k b -> IntervalMap k c
g a -> b -> c
h IntervalMap k a
jm1 (IntervalMap Map (LB k) (Interval k, b)
m3) = forall r a. Map (LB r) (Interval r, a) -> IntervalMap r a
IntervalMap forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
Map.unions forall a b. (a -> b) -> a -> b
$ IntervalMap k a
-> [(Interval k, b)] -> [Map (LB k) (Interval k, c)]
go IntervalMap k a
jm1 (forall k a. Map k a -> [a]
Map.elems Map (LB k) (Interval k, b)
m3)
      where
        go :: IntervalMap k a
-> [(Interval k, b)] -> [Map (LB k) (Interval k, c)]
go IntervalMap k a
_ [] = []
        go IntervalMap k a
im ((Interval k
i,b
b) : [(Interval k, b)]
xs) =
          case forall k a.
Ord k =>
Interval k
-> IntervalMap k a
-> (IntervalMap k a, IntervalMap k a, IntervalMap k a)
split Interval k
i IntervalMap k a
im of
            (IntervalMap k a
_, IntervalMap Map (LB k) (Interval k, a)
m, IntervalMap k a
jm2) ->
              forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (\(Interval k
j, a
a) -> (Interval k
j, a -> b -> c
h a
a b
b)) Map (LB k) (Interval k, a)
m forall a. a -> [a] -> [a]
: IntervalMap k a
-> [(Interval k, b)] -> [Map (LB k) (Interval k, c)]
go IntervalMap k a
jm2 [(Interval k, b)]
xs

-- ------------------------------------------------------------------------
-- Traversal

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

instance Ord k => Foldable (IntervalMap k) where
  foldMap :: forall m a. Monoid m => (a -> m) -> IntervalMap k a -> m
foldMap a -> m
f (IntervalMap Map (LB k) (Interval k, a)
m) = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\(Interval k
_,a
a) -> a -> m
f a
a) Map (LB k) (Interval k, a)
m

instance Ord k => 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
f (IntervalMap Map (LB k) (Interval k, a)
m) = forall r a. Map (LB r) (Interval r, a) -> IntervalMap r a
IntervalMap forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\(Interval k
i,a
a) -> (\b
b -> (Interval k
i,b
b)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
a) Map (LB k) (Interval k, a)
m

-- | 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 (IntervalMap Map (LB k) (Interval k, a)
m) = forall r a. Map (LB r) (Interval r, a) -> IntervalMap r a
IntervalMap forall a b. (a -> b) -> a -> b
$ forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (\(Interval k
i, a
a) -> (Interval k
i, a -> b
f a
a)) Map (LB k) (Interval k, a)
m

-- | @'mapKeysMonotonic' f s@ is the map obtained by applying @f@ to each key of @s@.
-- @f@ must be strictly monotonic.
-- That is, for any values @x@ and @y@, if @x@ < @y@ then @f x@ < @f y@.
mapKeysMonotonic :: forall k1 k2 a. (Ord k1, Ord k2) => (k1 -> k2) -> IntervalMap k1 a -> IntervalMap k2 a
mapKeysMonotonic :: forall k1 k2 a.
(Ord k1, Ord k2) =>
(k1 -> k2) -> IntervalMap k1 a -> IntervalMap k2 a
mapKeysMonotonic k1 -> k2
f = forall k a. Ord k => [(Interval k, a)] -> IntervalMap k a
fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Interval k1, a) -> (Interval k2, a)
g forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. IntervalMap k a -> [(Interval k, a)]
toList
  where
    g :: (Interval k1, a) -> (Interval k2, a)
    g :: (Interval k1, a) -> (Interval k2, a)
g (Interval k1
i, a
a) = (forall a b. (Ord a, Ord b) => (a -> b) -> Interval a -> Interval b
Interval.mapMonotonic k1 -> k2
f Interval k1
i, a
a)

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

-- | Return all elements of the map in the ascending order of their keys.
elems :: IntervalMap k a -> [a]
elems :: forall k a. IntervalMap k a -> [a]
elems (IntervalMap Map (LB k) (Interval k, a)
m) = [a
a | (Interval k
_,a
a) <- forall k a. Map k a -> [a]
Map.elems Map (LB k) (Interval k, a)
m]

-- | Return all keys of the map in ascending order. Subject to list
keys :: IntervalMap k a -> [Interval k]
keys :: forall k a. IntervalMap k a -> [Interval k]
keys (IntervalMap Map (LB k) (Interval k, a)
m) = [Interval k
i | (Interval k
i,a
_) <- forall k a. Map k a -> [a]
Map.elems Map (LB k) (Interval k, a)
m]

-- | An alias for 'toAscList'. Return all key\/value pairs in the map
-- in ascending key order.
assocs :: IntervalMap k a -> [(Interval k, a)]
assocs :: forall k a. IntervalMap k a -> [(Interval k, a)]
assocs = forall k a. IntervalMap k a -> [(Interval k, a)]
toAscList

-- | The set of all keys of the map.
keysSet :: Ord k => IntervalMap k a -> IntervalSet k
keysSet :: forall k a. Ord k => IntervalMap k a -> IntervalSet k
keysSet (IntervalMap Map (LB k) (Interval k, a)
m) = forall r. Ord r => [Interval r] -> IntervalSet r
IntervalSet.fromAscList [Interval k
i | (Interval k
i,a
_) <- forall k a. Map k a -> [a]
Map.elems Map (LB k) (Interval k, a)
m]

-- | Convert the map to a list of key\/value pairs.
toList :: IntervalMap k a -> [(Interval k, a)]
toList :: forall k a. IntervalMap k a -> [(Interval k, a)]
toList = forall k a. IntervalMap k a -> [(Interval k, a)]
toAscList

-- | Convert the map to a list of key/value pairs where the keys are in ascending order.
toAscList :: IntervalMap k a -> [(Interval k, a)]
toAscList :: forall k a. IntervalMap k a -> [(Interval k, a)]
toAscList (IntervalMap Map (LB k) (Interval k, a)
m) = forall k a. Map k a -> [a]
Map.elems Map (LB k) (Interval k, a)
m

-- | Convert the map to a list of key/value pairs where the keys are in descending order.
toDescList :: IntervalMap k a -> [(Interval k, a)]
toDescList :: forall k a. IntervalMap k a -> [(Interval k, a)]
toDescList (IntervalMap Map (LB k) (Interval k, a)
m) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
Map.toDescList Map (LB k) (Interval k, a)
m

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

-- | Build a map from a list of key\/value pairs with a combining function.
fromListWith :: Ord k => (a -> a -> a) -> [(Interval k, a)] -> IntervalMap k a
fromListWith :: forall k a.
Ord k =>
(a -> a -> a) -> [(Interval k, a)] -> IntervalMap k a
fromListWith a -> a -> a
f = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\IntervalMap k a
m (Interval k
i,a
a) -> forall k a.
Ord k =>
(a -> a -> a)
-> Interval k -> a -> IntervalMap k a -> IntervalMap k a
insertWith a -> a -> a
f Interval k
i a
a IntervalMap k a
m) forall k a. Ord k => IntervalMap k a
empty

-- ------------------------------------------------------------------------
-- Filter

-- | Filter all values that satisfy some predicate.
filter :: Ord k => (a -> Bool) -> IntervalMap k a -> IntervalMap k a
filter :: forall k a.
Ord k =>
(a -> Bool) -> IntervalMap k a -> IntervalMap k a
filter a -> Bool
p (IntervalMap Map (LB k) (Interval k, a)
m) = forall r a. Map (LB r) (Interval r, a) -> IntervalMap r a
IntervalMap forall a b. (a -> b) -> a -> b
$ forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (\(Interval k
_,a
a) -> a -> Bool
p a
a) Map (LB k) (Interval k, a)
m

-- | The expression (@'split' i map@) is a triple @(map1,map2,map3)@ where
-- the keys in @map1@ are smaller than @i@, the keys in @map2@ are included in @i@, and the keys in @map3@ are larger than @i@.
split :: Ord k => Interval k -> IntervalMap k a -> (IntervalMap k a, IntervalMap k a, IntervalMap k a)
split :: forall k a.
Ord k =>
Interval k
-> IntervalMap k a
-> (IntervalMap k a, IntervalMap k a, IntervalMap k a)
split Interval k
i (IntervalMap Map (LB k) (Interval k, a)
m) =
  case forall k v. Ord k => k -> Map k v -> (Map k v, Maybe v, Map k v)
splitLookupLE (forall r. (Extended r, Boundary) -> LB r
LB (forall r. Interval r -> (Extended r, Boundary)
Interval.lowerBound' Interval k
i)) Map (LB k) (Interval k, a)
m of
    (Map (LB k) (Interval k, a)
smaller, Maybe (Interval k, a)
m1, Map (LB k) (Interval k, a)
xs) ->
      case forall k v. Ord k => k -> Map k v -> (Map k v, Maybe v, Map k v)
splitLookupLE (forall r. (Extended r, Boundary) -> LB r
LB (forall r. Interval r -> Extended r
Interval.upperBound Interval k
i, Boundary
Interval.Closed)) Map (LB k) (Interval k, a)
xs of
        (Map (LB k) (Interval k, a)
middle, Maybe (Interval k, a)
m2, Map (LB k) (Interval k, a)
larger) ->
          ( forall r a. Map (LB r) (Interval r, a) -> IntervalMap r a
IntervalMap forall a b. (a -> b) -> a -> b
$
              case Maybe (Interval k, a)
m1 of
                Maybe (Interval k, a)
Nothing -> forall k a. Map k a
Map.empty
                Just (Interval k
j,a
b) ->
                  let k :: Interval k
k = forall r. Ord r => Interval r -> Interval r -> Interval r
Interval.intersection (forall r. Ord r => Interval r -> Interval r
upTo Interval k
i) Interval k
j
                  in if forall r. Ord r => Interval r -> Bool
Interval.null Interval k
k
                     then Map (LB k) (Interval k, a)
smaller
                     else forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (forall r. (Extended r, Boundary) -> LB r
LB (forall r. Interval r -> (Extended r, Boundary)
Interval.lowerBound' Interval k
k)) (Interval k
k,a
b) Map (LB k) (Interval k, a)
smaller
          , forall r a. Map (LB r) (Interval r, a) -> IntervalMap r a
IntervalMap forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
Map.unions forall a b. (a -> b) -> a -> b
$ Map (LB k) (Interval k, a)
middle forall a. a -> [a] -> [a]
:
              [ forall k a. k -> a -> Map k a
Map.singleton (forall r. (Extended r, Boundary) -> LB r
LB (forall r. Interval r -> (Extended r, Boundary)
Interval.lowerBound' Interval k
k)) (Interval k
k, a
b)
              | (Interval k
j, a
b) <- forall a. Maybe a -> [a]
maybeToList Maybe (Interval k, a)
m1 forall a. [a] -> [a] -> [a]
++ forall a. Maybe a -> [a]
maybeToList Maybe (Interval k, a)
m2
              , let k :: Interval k
k = forall r. Ord r => Interval r -> Interval r -> Interval r
Interval.intersection Interval k
i Interval k
j
              , Bool -> Bool
not (forall r. Ord r => Interval r -> Bool
Interval.null Interval k
k)
              ]
          , forall r a. Map (LB r) (Interval r, a) -> IntervalMap r a
IntervalMap forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
Map.unions forall a b. (a -> b) -> a -> b
$ Map (LB k) (Interval k, a)
larger forall a. a -> [a] -> [a]
:
              [ forall k a. k -> a -> Map k a
Map.singleton (forall r. (Extended r, Boundary) -> LB r
LB (forall r. Interval r -> (Extended r, Boundary)
Interval.lowerBound' Interval k
k)) (Interval k
k, a
b)
              | (Interval k
j, a
b) <- forall a. Maybe a -> [a]
maybeToList Maybe (Interval k, a)
m1 forall a. [a] -> [a] -> [a]
++ forall a. Maybe a -> [a]
maybeToList Maybe (Interval k, a)
m2
              , let k :: Interval k
k = forall r. Ord r => Interval r -> Interval r -> Interval r
Interval.intersection (forall r. Ord r => Interval r -> Interval r
downTo Interval k
i) Interval k
j
              , Bool -> Bool
not (forall r. Ord r => Interval r -> Bool
Interval.null Interval k
k)
              ]
          )

-- ------------------------------------------------------------------------
-- Submap

-- | 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 = forall k a b.
Ord k =>
(a -> b -> Bool) -> IntervalMap k a -> IntervalMap k b -> Bool
isSubmapOfBy forall a. Eq a => a -> a -> Bool
(==)

-- |  The expression (@'isSubmapOfBy' f t1 t2@) returns 'True' if
-- all keys in @t1@ are in tree @t2@, and when @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 = forall (t :: * -> *). Foldable t => t Bool -> Bool
and forall a b. (a -> b) -> a -> b
$
  [ case forall k a. Ord k => Interval k -> IntervalMap k a -> Maybe a
lookupInterval Interval k
i IntervalMap k b
m2 of
      Maybe b
Nothing -> Bool
False
      Just b
b -> a -> b -> Bool
f a
a b
b
  | (Interval k
i,a
a) <- forall k a. IntervalMap k a -> [(Interval k, a)]
toList IntervalMap k a
m1 ]

-- |  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 = forall k a b.
Ord k =>
(a -> b -> Bool) -> IntervalMap k a -> IntervalMap k b -> Bool
isProperSubmapOfBy forall a. Eq a => a -> a -> Bool
(==)

-- | 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 =
  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 Bool -> Bool -> Bool
&&
  forall k a. Ord k => IntervalMap k a -> IntervalSet k
keysSet IntervalMap k a
m1 forall r. Ord r => IntervalSet r -> IntervalSet r -> Bool
`IntervalSet.isProperSubsetOf` forall k a. Ord k => IntervalMap k a -> IntervalSet k
keysSet IntervalMap k b
m2

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

splitLookupLE :: Ord k => k -> Map k v -> (Map k v, Maybe v, Map k v)
splitLookupLE :: forall k v. Ord k => k -> Map k v -> (Map k v, Maybe v, Map k v)
splitLookupLE k
k Map k v
m =
  case forall k v. Ord k => k -> Map k v -> (Map k v, Maybe v, Map k v)
Map.splitLookup k
k Map k v
m of
    (Map k v
smaller, Just v
v, Map k v
larger) -> (Map k v
smaller, forall a. a -> Maybe a
Just v
v, Map k v
larger)
    (Map k v
smaller, Maybe v
Nothing, Map k v
larger) ->
      case forall k a. Map k a -> Maybe (a, Map k a)
Map.maxView Map k v
smaller of
        Just (v
v, Map k v
smaller') -> (Map k v
smaller', forall a. a -> Maybe a
Just v
v, Map k v
larger)
        Maybe (v, Map k v)
Nothing -> (Map k v
smaller, forall a. Maybe a
Nothing, Map k v
larger)

upTo :: Ord r => Interval r -> Interval r
upTo :: forall r. Ord r => Interval r -> Interval r
upTo Interval r
i =
  case forall r. Interval r -> (Extended r, Boundary)
Interval.lowerBound' Interval r
i of
    (Extended r
NegInf, Boundary
_) -> forall r. Ord r => Interval r
Interval.empty
    (Extended r
PosInf, Boundary
_) -> forall r. Ord r => Interval r
Interval.whole
    (Finite r
lb, Boundary
incl) ->
      forall r.
Ord r =>
(Extended r, Boundary) -> (Extended r, Boundary) -> Interval r
Interval.interval (forall r. Extended r
NegInf, Boundary
Interval.Open) (forall r. r -> Extended r
Finite r
lb, Boundary -> Boundary
notB Boundary
incl)

downTo :: Ord r => Interval r -> Interval r
downTo :: forall r. Ord r => Interval r -> Interval r
downTo Interval r
i =
  case forall r. Interval r -> (Extended r, Boundary)
Interval.upperBound' Interval r
i of
    (Extended r
PosInf, Boundary
_) -> forall r. Ord r => Interval r
Interval.empty
    (Extended r
NegInf, Boundary
_) -> forall r. Ord r => Interval r
Interval.whole
    (Finite r
ub, Boundary
incl) ->
      forall r.
Ord r =>
(Extended r, Boundary) -> (Extended r, Boundary) -> Interval r
Interval.interval (forall r. r -> Extended r
Finite r
ub, Boundary -> Boundary
notB Boundary
incl) (forall r. Extended r
PosInf, Boundary
Interval.Open)

notB :: Interval.Boundary -> Interval.Boundary
notB :: Boundary -> Boundary
notB = \case
  Boundary
Interval.Open   -> Boundary
Interval.Closed
  Boundary
Interval.Closed -> Boundary
Interval.Open