{-# OPTIONS_GHC -Wall #-}
{-# LANGUAGE CPP, LambdaCase, ScopedTypeVariables, TypeFamilies, DeriveDataTypeable, MultiWayIf, GeneralizedNewtypeDeriving #-}
{-# LANGUAGE Trustworthy #-}
#if __GLASGOW_HASKELL__ >= 708
{-# LANGUAGE RoleAnnotations #-}
#endif
-----------------------------------------------------------------------------
-- |
-- 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__ < 710
import Control.Applicative ((<$>))
import Data.Traversable (Traversable(..))
#endif
#if __GLASGOW_HASKELL__ < 804
import Data.Monoid (Monoid(..))
#endif
#if __GLASGOW_HASKELL__ >= 708
import qualified GHC.Exts as GHCExts
#endif

-- ------------------------------------------------------------------------
-- 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
(IntervalMap r a -> IntervalMap r a -> Bool)
-> (IntervalMap r a -> IntervalMap r a -> Bool)
-> Eq (IntervalMap r a)
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, Typeable)

#if __GLASGOW_HASKELL__ >= 708
type role IntervalMap nominal representational
#endif

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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
appPrec) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
    String -> ShowS
showString String
"fromList " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    Int -> [(Interval k, a)] -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec (Int
appPrecInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Map (LB k) (Interval k, a) -> [(Interval k, a)]
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 =
    (Bool -> ReadS (IntervalMap k a) -> ReadS (IntervalMap k a)
forall a. Bool -> ReadS a -> ReadS a
readParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
appPrec) (ReadS (IntervalMap k a) -> ReadS (IntervalMap k a))
-> ReadS (IntervalMap k a) -> ReadS (IntervalMap k a)
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) <- Int -> ReadS [(Interval k, a)]
forall a. Read a => Int -> ReadS a
readsPrec (Int
appPrecInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) String
s1
      (IntervalMap k a, String) -> [(IntervalMap k a, String)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Interval k, a)] -> IntervalMap k a
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 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   = ([(Interval k, a)] -> IntervalMap k a)
-> c ([(Interval k, a)] -> IntervalMap k a)
forall g. g -> c g
z [(Interval k, a)] -> IntervalMap k a
forall k a. Ord k => [(Interval k, a)] -> IntervalMap k a
fromList c ([(Interval k, a)] -> IntervalMap k a)
-> [(Interval k, a)] -> c (IntervalMap k a)
forall d b. Data d => c (d -> b) -> d -> c b
`k` IntervalMap k a -> [(Interval k, a)]
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 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 -> c ([(Interval k, a)] -> IntervalMap k a) -> c (IntervalMap k a)
forall b r. Data b => c (b -> r) -> c r
k (([(Interval k, a)] -> IntervalMap k a)
-> c ([(Interval k, a)] -> IntervalMap k a)
forall r. r -> c r
z [(Interval k, a)] -> IntervalMap k a
forall k a. Ord k => [(Interval k, a)] -> IntervalMap k a
fromList)
    Int
_ -> String -> c (IntervalMap k a)
forall a. HasCallStack => String -> a
error String
"gunfold"
  dataTypeOf :: IntervalMap k a -> DataType
dataTypeOf IntervalMap k a
_   = DataType
mapDataType
  dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c (IntervalMap k a))
dataCast1 forall d. Data d => c (t d)
f    = c (t a) -> Maybe (c (IntervalMap k a))
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 c (t a)
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) = Map (LB k) (Interval k, a) -> ()
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 = Int -> [(Interval k, a)] -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s (IntervalMap k a -> [(Interval k, a)]
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 = IntervalMap k a
forall k a. Ord k => IntervalMap k a
empty
  mappend :: IntervalMap k a -> IntervalMap k a -> IntervalMap k a
mappend = IntervalMap k a -> IntervalMap k a -> IntervalMap k a
forall k a.
Ord k =>
IntervalMap k a -> IntervalMap k a -> IntervalMap k a
union
  mconcat :: [IntervalMap k a] -> IntervalMap k a
mconcat = [IntervalMap k a] -> IntervalMap k a
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
(<>)   = IntervalMap k a -> IntervalMap k a -> IntervalMap k a
forall k a.
Ord k =>
IntervalMap k a -> IntervalMap k a -> IntervalMap k a
union
#if !defined(VERSION_semigroups)
  stimes :: b -> IntervalMap k a -> IntervalMap k a
stimes = b -> IntervalMap k a -> IntervalMap k a
forall b a. (Integral b, Monoid a) => b -> a -> a
Semigroup.stimesIdempotentMonoid
#else
#if MIN_VERSION_semigroups(0,17,0)
  stimes = Semigroup.stimesIdempotentMonoid
#else
  times1p _ a = a
#endif
#endif

#if __GLASGOW_HASKELL__ >= 708
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 = [Item (IntervalMap k a)] -> IntervalMap k a
forall k a. Ord k => [(Interval k, a)] -> IntervalMap k a
fromList
  toList :: IntervalMap k a -> [Item (IntervalMap k a)]
toList = IntervalMap k a -> [Item (IntervalMap k a)]
forall k a. IntervalMap k a -> [(Interval k, a)]
toList
#endif

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

newtype LB r = LB (Extended r, Interval.Boundary)
  deriving (LB r -> LB r -> Bool
(LB r -> LB r -> Bool) -> (LB r -> LB r -> Bool) -> Eq (LB r)
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 -> ()
(LB r -> ()) -> NFData (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 Extended r -> Extended r -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Extended r
lb2) Ordering -> Ordering -> Ordering
forall a. Monoid a => a -> a -> a
`mappend` (Boundary
lb2in Boundary -> Boundary -> Ordering
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 ! :: IntervalMap k a -> k -> a
! k
k =
  case LB k -> Map (LB k) (Interval k, a) -> Maybe (LB k, (Interval k, a))
forall k v. Ord k => k -> Map k v -> Maybe (k, v)
Map.lookupLE ((Extended k, Boundary) -> LB k
forall r. (Extended r, Boundary) -> LB r
LB (k -> Extended k
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 k -> Interval k -> Bool
forall r. Ord r => r -> Interval r -> Bool
`Interval.member` Interval k
i -> a
a
    Maybe (LB k, (Interval k, a))
_ -> String -> 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 \\ :: IntervalMap k a -> IntervalMap k b -> IntervalMap k a
\\ IntervalMap k b
m2 = IntervalMap k a -> IntervalMap k b -> IntervalMap k a
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 :: IntervalMap k a -> Bool
null (IntervalMap Map (LB k) (Interval k, a)
m) = Map (LB k) (Interval k, a) -> Bool
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 :: k -> IntervalMap k a -> Bool
member k
k (IntervalMap Map (LB k) (Interval k, a)
m) =
  case LB k -> Map (LB k) (Interval k, a) -> Maybe (LB k, (Interval k, a))
forall k v. Ord k => k -> Map k v -> Maybe (k, v)
Map.lookupLE ((Extended k, Boundary) -> LB k
forall r. (Extended r, Boundary) -> LB r
LB (k -> Extended k
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 k -> Interval k -> Bool
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 :: k -> IntervalMap k a -> Bool
notMember k
k IntervalMap k a
m = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ k -> IntervalMap k a -> Bool
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 :: k -> IntervalMap k a -> Maybe a
lookup k
k (IntervalMap Map (LB k) (Interval k, a)
m) =
  case LB k -> Map (LB k) (Interval k, a) -> Maybe (LB k, (Interval k, a))
forall k v. Ord k => k -> Map k v -> Maybe (k, v)
Map.lookupLE ((Extended k, Boundary) -> LB k
forall r. (Extended r, Boundary) -> LB r
LB (k -> Extended k
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 k -> Interval k -> Bool
forall r. Ord r => r -> Interval r -> Bool
`Interval.member` Interval k
i -> a -> Maybe a
forall a. a -> Maybe a
Just a
a
    Maybe (LB k, (Interval k, a))
_ -> Maybe 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 :: a -> k -> IntervalMap k a -> a
findWithDefault a
def k
k (IntervalMap Map (LB k) (Interval k, a)
m) =
  case LB k -> Map (LB k) (Interval k, a) -> Maybe (LB k, (Interval k, a))
forall k v. Ord k => k -> Map k v -> Maybe (k, v)
Map.lookupLE ((Extended k, Boundary) -> LB k
forall r. (Extended r, Boundary) -> LB r
LB (k -> Extended k
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 k -> Interval k -> Bool
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 :: Interval k -> IntervalMap k a -> Maybe a
lookupInterval Interval k
i (IntervalMap Map (LB k) (Interval k, a)
m) =
  case LB k -> Map (LB k) (Interval k, a) -> Maybe (LB k, (Interval k, a))
forall k v. Ord k => k -> Map k v -> Maybe (k, v)
Map.lookupLE ((Extended k, Boundary) -> LB k
forall r. (Extended r, Boundary) -> LB r
LB (Interval k -> (Extended k, Boundary)
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 Interval k -> Interval k -> Bool
forall r. Ord r => Interval r -> Interval r -> Bool
`Interval.isSubsetOf` Interval k
j -> a -> Maybe a
forall a. a -> Maybe a
Just a
a
    Maybe (LB k, (Interval k, a))
_ -> Maybe a
forall a. Maybe a
Nothing

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

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

-- | The empty map.
empty :: Ord k => IntervalMap k a
empty :: IntervalMap k a
empty = Map (LB k) (Interval k, a) -> IntervalMap k a
forall r a. Map (LB r) (Interval r, a) -> IntervalMap r a
IntervalMap Map (LB k) (Interval k, a)
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 :: a -> IntervalMap k a
whole a
a = Map (LB k) (Interval k, a) -> IntervalMap k a
forall r a. Map (LB r) (Interval r, a) -> IntervalMap r a
IntervalMap (Map (LB k) (Interval k, a) -> IntervalMap k a)
-> Map (LB k) (Interval k, a) -> IntervalMap k a
forall a b. (a -> b) -> a -> b
$ LB k -> (Interval k, a) -> Map (LB k) (Interval k, a)
forall k a. k -> a -> Map k a
Map.singleton ((Extended k, Boundary) -> LB k
forall r. (Extended r, Boundary) -> LB r
LB (Interval k -> (Extended k, Boundary)
forall r. Interval r -> (Extended r, Boundary)
Interval.lowerBound' Interval k
i)) (Interval k
i, a
a)
  where
    i :: Interval k
i = Interval k
forall r. Ord r => Interval r
Interval.whole

-- | A map with a single interval.
singleton :: Ord k => Interval k -> a -> IntervalMap k a
singleton :: Interval k -> a -> IntervalMap k a
singleton Interval k
i a
a
  | Interval k -> Bool
forall r. Ord r => Interval r -> Bool
Interval.null Interval k
i = IntervalMap k a
forall k a. Ord k => IntervalMap k a
empty
  | Bool
otherwise = Map (LB k) (Interval k, a) -> IntervalMap k a
forall r a. Map (LB r) (Interval r, a) -> IntervalMap r a
IntervalMap (Map (LB k) (Interval k, a) -> IntervalMap k a)
-> Map (LB k) (Interval k, a) -> IntervalMap k a
forall a b. (a -> b) -> a -> b
$ LB k -> (Interval k, a) -> Map (LB k) (Interval k, a)
forall k a. k -> a -> Map k a
Map.singleton ((Extended k, Boundary) -> LB k
forall r. (Extended r, Boundary) -> LB r
LB (Interval k -> (Extended k, Boundary)
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 :: Interval k -> a -> IntervalMap k a -> IntervalMap k a
insert Interval k
i a
_ IntervalMap k a
m | Interval k -> Bool
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 Interval k
-> IntervalMap k a
-> (IntervalMap k a, IntervalMap k a, IntervalMap k a)
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) ->
      Map (LB k) (Interval k, a) -> IntervalMap k a
forall r a. Map (LB r) (Interval r, a) -> IntervalMap r a
IntervalMap (Map (LB k) (Interval k, a) -> IntervalMap k a)
-> Map (LB k) (Interval k, a) -> IntervalMap k a
forall a b. (a -> b) -> a -> b
$ Map (LB k) (Interval k, a)
-> Map (LB k) (Interval k, a) -> Map (LB k) (Interval k, a)
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map (LB k) (Interval k, a)
m1 (LB k
-> (Interval k, a)
-> Map (LB k) (Interval k, a)
-> Map (LB k) (Interval k, a)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert ((Extended k, Boundary) -> LB k
forall r. (Extended r, Boundary) -> LB r
LB (Interval k -> (Extended k, Boundary)
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 :: (a -> a -> a)
-> Interval k -> a -> IntervalMap k a -> IntervalMap k a
insertWith a -> a -> a
_ Interval k
i a
_ IntervalMap k a
m | Interval k -> Bool
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 = (Maybe a -> Maybe a)
-> Interval k -> IntervalMap k a -> IntervalMap k a
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 = a -> Maybe a
forall a. a -> Maybe a
Just a
a
    g (Just a
a') = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
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 :: Interval k -> IntervalMap k a -> IntervalMap k a
delete Interval k
i IntervalMap k a
m | Interval k -> Bool
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 Interval k
-> IntervalMap k a
-> (IntervalMap k a, IntervalMap k a, IntervalMap k a)
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) ->
      Map (LB k) (Interval k, a) -> IntervalMap k a
forall r a. Map (LB r) (Interval r, a) -> IntervalMap r a
IntervalMap (Map (LB k) (Interval k, a) -> IntervalMap k a)
-> Map (LB k) (Interval k, a) -> IntervalMap k a
forall a b. (a -> b) -> a -> b
$ Map (LB k) (Interval k, a)
-> Map (LB k) (Interval k, a) -> Map (LB k) (Interval k, a)
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 :: (a -> a) -> Interval k -> IntervalMap k a -> IntervalMap k a
adjust a -> a
f = (a -> Maybe a) -> Interval k -> IntervalMap k a -> IntervalMap k a
forall k a.
Ord k =>
(a -> Maybe a) -> Interval k -> IntervalMap k a -> IntervalMap k a
update (a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> (a -> a) -> a -> Maybe a
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 :: (a -> Maybe a) -> Interval k -> IntervalMap k a -> IntervalMap k a
update a -> Maybe a
_ Interval k
i IntervalMap k a
m | Interval k -> Bool
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 Interval k
-> IntervalMap k a
-> (IntervalMap k a, IntervalMap k a, IntervalMap k a)
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) ->
      Map (LB k) (Interval k, a) -> IntervalMap k a
forall r a. Map (LB r) (Interval r, a) -> IntervalMap r a
IntervalMap (Map (LB k) (Interval k, a) -> IntervalMap k a)
-> Map (LB k) (Interval k, a) -> IntervalMap k a
forall a b. (a -> b) -> a -> b
$ [Map (LB k) (Interval k, a)] -> Map (LB k) (Interval k, a)
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
Map.unions [Map (LB k) (Interval k, a)
m1, ((Interval k, a) -> Maybe (Interval k, a))
-> Map (LB k) (Interval k, a) -> Map (LB k) (Interval k, a)
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)) (a -> (Interval k, a)) -> Maybe a -> Maybe (Interval k, a)
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 :: (Maybe a -> Maybe a)
-> Interval k -> IntervalMap k a -> IntervalMap k a
alter Maybe a -> Maybe a
_ Interval k
i IntervalMap k a
m | Interval k -> Bool
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 Interval k
-> IntervalMap k a
-> (IntervalMap k a, IntervalMap k a, IntervalMap k a)
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' = ((Interval k, a) -> Maybe (Interval k, a))
-> Map (LB k) (Interval k, a) -> Map (LB k) (Interval k, a)
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)) (a -> (Interval k, a)) -> Maybe a -> Maybe (Interval k, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe a -> Maybe a
f (a -> Maybe a
forall a. a -> Maybe a
Just a
a)) Map (LB k) (Interval k, a)
m2
          js :: IntervalSet k
js = Interval k -> IntervalSet k
forall r. Ord r => Interval r -> IntervalSet r
IntervalSet.singleton Interval k
i IntervalSet k -> IntervalSet k -> IntervalSet k
forall r. Ord r => IntervalSet r -> IntervalSet r -> IntervalSet r
`IntervalSet.difference` IntervalMap k a -> IntervalSet k
forall k a. Ord k => IntervalMap k a -> IntervalSet k
keysSet (Map (LB k) (Interval k, a) -> IntervalMap k a
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 Maybe a
forall a. Maybe a
Nothing of
              Maybe a
Nothing -> IntervalMap k a
forall k a. Ord k => IntervalMap k a
empty
              Just a
a -> [(Interval k, a)] -> IntervalMap k a
forall k a. Ord k => [(Interval k, a)] -> IntervalMap k a
fromList [(Interval k
j,a
a) | Interval k
j <- IntervalSet k -> [Interval k]
forall r. Ord r => IntervalSet r -> [Interval r]
IntervalSet.toList IntervalSet k
js]
      in Map (LB k) (Interval k, a) -> IntervalMap k a
forall r a. Map (LB r) (Interval r, a) -> IntervalMap r a
IntervalMap (Map (LB k) (Interval k, a) -> IntervalMap k a)
-> Map (LB k) (Interval k, a) -> IntervalMap k a
forall a b. (a -> b) -> a -> b
$ [Map (LB k) (Interval k, a)] -> Map (LB k) (Interval k, a)
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 :: IntervalMap k a -> IntervalMap k a -> IntervalMap k a
union IntervalMap k a
m1 IntervalMap k a
m2 =
  (IntervalMap k a -> (Interval k, a) -> IntervalMap k a)
-> IntervalMap k a -> [(Interval k, a)] -> IntervalMap k a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\IntervalMap k a
m (Interval k
i,a
a) -> Interval k -> a -> IntervalMap k a -> IntervalMap k 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 (IntervalMap k a -> [(Interval k, a)]
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 :: (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 =
  (IntervalMap k a -> (Interval k, a) -> IntervalMap k a)
-> IntervalMap k a -> [(Interval k, a)] -> IntervalMap k a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\IntervalMap k a
m (Interval k
i,a
a) -> (a -> a -> a)
-> Interval k -> a -> IntervalMap k a -> IntervalMap k 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 (IntervalMap k a -> [(Interval k, a)]
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 :: [IntervalMap k a] -> IntervalMap k a
unions = (IntervalMap k a -> IntervalMap k a -> IntervalMap k a)
-> IntervalMap k a -> [IntervalMap k a] -> IntervalMap k a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' IntervalMap k a -> IntervalMap k a -> IntervalMap k a
forall k a.
Ord k =>
IntervalMap k a -> IntervalMap k a -> IntervalMap k a
union IntervalMap k a
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 :: (a -> a -> a) -> [IntervalMap k a] -> IntervalMap k a
unionsWith a -> a -> a
f = (IntervalMap k a -> IntervalMap k a -> IntervalMap k a)
-> IntervalMap k a -> [IntervalMap k a] -> IntervalMap k a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((a -> a -> a)
-> IntervalMap k a -> IntervalMap k a -> IntervalMap k a
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
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 :: IntervalMap k a -> IntervalMap k b -> IntervalMap k a
difference IntervalMap k a
m1 IntervalMap k b
m2 = (IntervalMap k a -> Interval k -> IntervalMap k a)
-> IntervalMap k a -> [Interval k] -> IntervalMap k a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\IntervalMap k a
m Interval k
i -> Interval k -> IntervalMap k a -> IntervalMap k a
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 (IntervalSet k -> [Interval k]
forall r. Ord r => IntervalSet r -> [Interval r]
IntervalSet.toList (IntervalMap k b -> IntervalSet k
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 :: IntervalMap k a -> IntervalMap k a -> IntervalMap k a
intersection = (a -> a -> a)
-> IntervalMap k a -> IntervalMap k a -> IntervalMap k a
forall k a b c.
Ord k =>
(a -> b -> c)
-> IntervalMap k a -> IntervalMap k b -> IntervalMap k c
intersectionWith a -> a -> a
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 :: (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)
  | Map (LB k) (Interval k, a) -> Int
forall k a. Map k a -> Int
Map.size Map (LB k) (Interval k, a)
m1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Map (LB k) (Interval k, b) -> Int
forall k a. Map k a -> Int
Map.size Map (LB k) (Interval k, b)
m2 = (a -> b -> c)
-> IntervalMap k a -> IntervalMap k b -> IntervalMap k c
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 = (b -> a -> c)
-> IntervalMap k b -> IntervalMap k a -> IntervalMap k c
forall k a b c.
Ord k =>
(a -> b -> c)
-> IntervalMap k a -> IntervalMap k b -> IntervalMap k c
g ((a -> b -> c) -> b -> a -> c
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 :: (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) = Map (LB k) (Interval k, c) -> IntervalMap k c
forall r a. Map (LB r) (Interval r, a) -> IntervalMap r a
IntervalMap (Map (LB k) (Interval k, c) -> IntervalMap k c)
-> Map (LB k) (Interval k, c) -> IntervalMap k c
forall a b. (a -> b) -> a -> b
$ [Map (LB k) (Interval k, c)] -> Map (LB k) (Interval k, c)
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
Map.unions ([Map (LB k) (Interval k, c)] -> Map (LB k) (Interval k, c))
-> [Map (LB k) (Interval k, c)] -> Map (LB k) (Interval k, c)
forall a b. (a -> b) -> a -> b
$ IntervalMap k a
-> [(Interval k, b)] -> [Map (LB k) (Interval k, c)]
go IntervalMap k a
jm1 (Map (LB k) (Interval k, b) -> [(Interval k, b)]
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 Interval k
-> IntervalMap k a
-> (IntervalMap k a, IntervalMap k a, IntervalMap k a)
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) ->
              ((Interval k, a) -> (Interval k, c))
-> Map (LB k) (Interval k, a) -> Map (LB k) (Interval k, c)
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 Map (LB k) (Interval k, c)
-> [Map (LB k) (Interval k, c)] -> [Map (LB k) (Interval k, c)]
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 :: (a -> b) -> IntervalMap k a -> IntervalMap k b
fmap = (a -> b) -> IntervalMap k a -> IntervalMap k b
forall a b k. (a -> b) -> IntervalMap k a -> IntervalMap k b
map

instance Ord k => Foldable (IntervalMap k) where
  foldMap :: (a -> m) -> IntervalMap k a -> m
foldMap a -> m
f (IntervalMap Map (LB k) (Interval k, a)
m) = ((Interval k, a) -> m) -> 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 :: (a -> f b) -> IntervalMap k a -> f (IntervalMap k b)
traverse a -> f b
f (IntervalMap Map (LB k) (Interval k, a)
m) = Map (LB k) (Interval k, b) -> IntervalMap k b
forall r a. Map (LB r) (Interval r, a) -> IntervalMap r a
IntervalMap (Map (LB k) (Interval k, b) -> IntervalMap k b)
-> f (Map (LB k) (Interval k, b)) -> f (IntervalMap k b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Interval k, a) -> f (Interval k, b))
-> Map (LB k) (Interval k, a) -> f (Map (LB k) (Interval k, 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)) (b -> (Interval k, b)) -> f b -> f (Interval k, 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 :: (a -> b) -> IntervalMap k a -> IntervalMap k b
map a -> b
f (IntervalMap Map (LB k) (Interval k, a)
m) = Map (LB k) (Interval k, b) -> IntervalMap k b
forall r a. Map (LB r) (Interval r, a) -> IntervalMap r a
IntervalMap (Map (LB k) (Interval k, b) -> IntervalMap k b)
-> Map (LB k) (Interval k, b) -> IntervalMap k b
forall a b. (a -> b) -> a -> b
$ ((Interval k, a) -> (Interval k, b))
-> Map (LB k) (Interval k, a) -> Map (LB k) (Interval k, 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 :: (k1 -> k2) -> IntervalMap k1 a -> IntervalMap k2 a
mapKeysMonotonic k1 -> k2
f = [(Interval k2, a)] -> IntervalMap k2 a
forall k a. Ord k => [(Interval k, a)] -> IntervalMap k a
fromList ([(Interval k2, a)] -> IntervalMap k2 a)
-> (IntervalMap k1 a -> [(Interval k2, a)])
-> IntervalMap k1 a
-> IntervalMap k2 a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Interval k1, a) -> (Interval k2, a))
-> [(Interval k1, a)] -> [(Interval k2, a)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Interval k1, a) -> (Interval k2, a)
g ([(Interval k1, a)] -> [(Interval k2, a)])
-> (IntervalMap k1 a -> [(Interval k1, a)])
-> IntervalMap k1 a
-> [(Interval k2, a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntervalMap k1 a -> [(Interval k1, a)]
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) = ((k1 -> k2) -> Interval k1 -> Interval k2
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 :: IntervalMap k a -> [a]
elems (IntervalMap Map (LB k) (Interval k, a)
m) = [a
a | (Interval k
_,a
a) <- Map (LB k) (Interval k, a) -> [(Interval k, 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 :: IntervalMap k a -> [Interval k]
keys (IntervalMap Map (LB k) (Interval k, a)
m) = [Interval k
i | (Interval k
i,a
_) <- Map (LB k) (Interval k, a) -> [(Interval k, 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 :: IntervalMap k a -> [(Interval k, a)]
assocs = IntervalMap k a -> [(Interval k, a)]
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 :: IntervalMap k a -> IntervalSet k
keysSet (IntervalMap Map (LB k) (Interval k, a)
m) = [Interval k] -> IntervalSet k
forall r. Ord r => [Interval r] -> IntervalSet r
IntervalSet.fromAscList [Interval k
i | (Interval k
i,a
_) <- Map (LB k) (Interval k, a) -> [(Interval k, 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 :: IntervalMap k a -> [(Interval k, a)]
toList = IntervalMap k a -> [(Interval k, a)]
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 :: IntervalMap k a -> [(Interval k, a)]
toAscList (IntervalMap Map (LB k) (Interval k, a)
m) = Map (LB k) (Interval k, a) -> [(Interval k, 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 where the keys are in descending order.
toDescList :: IntervalMap k a -> [(Interval k, a)]
toDescList :: IntervalMap k a -> [(Interval k, a)]
toDescList (IntervalMap Map (LB k) (Interval k, a)
m) = ((LB k, (Interval k, a)) -> (Interval k, a))
-> [(LB k, (Interval k, a))] -> [(Interval k, a)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (LB k, (Interval k, a)) -> (Interval k, a)
forall a b. (a, b) -> b
snd ([(LB k, (Interval k, a))] -> [(Interval k, a)])
-> [(LB k, (Interval k, a))] -> [(Interval k, a)]
forall a b. (a -> b) -> a -> b
$ Map (LB k) (Interval k, a) -> [(LB k, (Interval k, a))]
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 :: [(Interval k, a)] -> IntervalMap k a
fromList = (IntervalMap k a -> (Interval k, a) -> IntervalMap k a)
-> IntervalMap k a -> [(Interval k, a)] -> IntervalMap k a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\IntervalMap k a
m (Interval k
i,a
a) -> Interval k -> a -> IntervalMap k a -> IntervalMap k 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
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 :: (a -> a -> a) -> [(Interval k, a)] -> IntervalMap k a
fromListWith a -> a -> a
f = (IntervalMap k a -> (Interval k, a) -> IntervalMap k a)
-> IntervalMap k a -> [(Interval k, a)] -> IntervalMap k a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\IntervalMap k a
m (Interval k
i,a
a) -> (a -> a -> a)
-> Interval k -> a -> IntervalMap k a -> IntervalMap k 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
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 :: (a -> Bool) -> IntervalMap k a -> IntervalMap k a
filter a -> Bool
p (IntervalMap Map (LB k) (Interval k, a)
m) = Map (LB k) (Interval k, a) -> IntervalMap k a
forall r a. Map (LB r) (Interval r, a) -> IntervalMap r a
IntervalMap (Map (LB k) (Interval k, a) -> IntervalMap k a)
-> Map (LB k) (Interval k, a) -> IntervalMap k a
forall a b. (a -> b) -> a -> b
$ ((Interval k, a) -> Bool)
-> Map (LB k) (Interval k, a) -> Map (LB k) (Interval k, a)
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 :: 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 LB k
-> Map (LB k) (Interval k, a)
-> (Map (LB k) (Interval k, a), Maybe (Interval k, a),
    Map (LB k) (Interval k, a))
forall k v. Ord k => k -> Map k v -> (Map k v, Maybe v, Map k v)
splitLookupLE ((Extended k, Boundary) -> LB k
forall r. (Extended r, Boundary) -> LB r
LB (Interval k -> (Extended k, Boundary)
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 LB k
-> Map (LB k) (Interval k, a)
-> (Map (LB k) (Interval k, a), Maybe (Interval k, a),
    Map (LB k) (Interval k, a))
forall k v. Ord k => k -> Map k v -> (Map k v, Maybe v, Map k v)
splitLookupLE ((Extended k, Boundary) -> LB k
forall r. (Extended r, Boundary) -> LB r
LB (Interval k -> Extended k
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) ->
          ( Map (LB k) (Interval k, a) -> IntervalMap k a
forall r a. Map (LB r) (Interval r, a) -> IntervalMap r a
IntervalMap (Map (LB k) (Interval k, a) -> IntervalMap k a)
-> Map (LB k) (Interval k, a) -> IntervalMap k a
forall a b. (a -> b) -> a -> b
$
              case Maybe (Interval k, a)
m1 of
                Maybe (Interval k, a)
Nothing -> Map (LB k) (Interval k, a)
forall k a. Map k a
Map.empty
                Just (Interval k
j,a
b) ->
                  let k :: Interval k
k = Interval k -> Interval k -> Interval k
forall r. Ord r => Interval r -> Interval r -> Interval r
Interval.intersection (Interval k -> Interval k
forall r. Ord r => Interval r -> Interval r
upTo Interval k
i) Interval k
j
                  in if Interval k -> Bool
forall r. Ord r => Interval r -> Bool
Interval.null Interval k
k
                     then Map (LB k) (Interval k, a)
smaller
                     else LB k
-> (Interval k, a)
-> Map (LB k) (Interval k, a)
-> Map (LB k) (Interval k, a)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert ((Extended k, Boundary) -> LB k
forall r. (Extended r, Boundary) -> LB r
LB (Interval k -> (Extended k, Boundary)
forall r. Interval r -> (Extended r, Boundary)
Interval.lowerBound' Interval k
k)) (Interval k
k,a
b) Map (LB k) (Interval k, a)
smaller
          , Map (LB k) (Interval k, a) -> IntervalMap k a
forall r a. Map (LB r) (Interval r, a) -> IntervalMap r a
IntervalMap (Map (LB k) (Interval k, a) -> IntervalMap k a)
-> Map (LB k) (Interval k, a) -> IntervalMap k a
forall a b. (a -> b) -> a -> b
$ [Map (LB k) (Interval k, a)] -> Map (LB k) (Interval k, a)
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
Map.unions ([Map (LB k) (Interval k, a)] -> Map (LB k) (Interval k, a))
-> [Map (LB k) (Interval k, a)] -> Map (LB k) (Interval k, a)
forall a b. (a -> b) -> a -> b
$ Map (LB k) (Interval k, a)
middle Map (LB k) (Interval k, a)
-> [Map (LB k) (Interval k, a)] -> [Map (LB k) (Interval k, a)]
forall a. a -> [a] -> [a]
:
              [ LB k -> (Interval k, a) -> Map (LB k) (Interval k, a)
forall k a. k -> a -> Map k a
Map.singleton ((Extended k, Boundary) -> LB k
forall r. (Extended r, Boundary) -> LB r
LB (Interval k -> (Extended k, Boundary)
forall r. Interval r -> (Extended r, Boundary)
Interval.lowerBound' Interval k
k)) (Interval k
k, a
b)
              | (Interval k
j, a
b) <- Maybe (Interval k, a) -> [(Interval k, a)]
forall a. Maybe a -> [a]
maybeToList Maybe (Interval k, a)
m1 [(Interval k, a)] -> [(Interval k, a)] -> [(Interval k, a)]
forall a. [a] -> [a] -> [a]
++ Maybe (Interval k, a) -> [(Interval k, a)]
forall a. Maybe a -> [a]
maybeToList Maybe (Interval k, a)
m2
              , let k :: Interval k
k = Interval k -> Interval k -> Interval k
forall r. Ord r => Interval r -> Interval r -> Interval r
Interval.intersection Interval k
i Interval k
j
              , Bool -> Bool
not (Interval k -> Bool
forall r. Ord r => Interval r -> Bool
Interval.null Interval k
k)
              ]
          , Map (LB k) (Interval k, a) -> IntervalMap k a
forall r a. Map (LB r) (Interval r, a) -> IntervalMap r a
IntervalMap (Map (LB k) (Interval k, a) -> IntervalMap k a)
-> Map (LB k) (Interval k, a) -> IntervalMap k a
forall a b. (a -> b) -> a -> b
$ [Map (LB k) (Interval k, a)] -> Map (LB k) (Interval k, a)
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
Map.unions ([Map (LB k) (Interval k, a)] -> Map (LB k) (Interval k, a))
-> [Map (LB k) (Interval k, a)] -> Map (LB k) (Interval k, a)
forall a b. (a -> b) -> a -> b
$ Map (LB k) (Interval k, a)
larger Map (LB k) (Interval k, a)
-> [Map (LB k) (Interval k, a)] -> [Map (LB k) (Interval k, a)]
forall a. a -> [a] -> [a]
:
              [ LB k -> (Interval k, a) -> Map (LB k) (Interval k, a)
forall k a. k -> a -> Map k a
Map.singleton ((Extended k, Boundary) -> LB k
forall r. (Extended r, Boundary) -> LB r
LB (Interval k -> (Extended k, Boundary)
forall r. Interval r -> (Extended r, Boundary)
Interval.lowerBound' Interval k
k)) (Interval k
k, a
b)
              | (Interval k
j, a
b) <- Maybe (Interval k, a) -> [(Interval k, a)]
forall a. Maybe a -> [a]
maybeToList Maybe (Interval k, a)
m1 [(Interval k, a)] -> [(Interval k, a)] -> [(Interval k, a)]
forall a. [a] -> [a] -> [a]
++ Maybe (Interval k, a) -> [(Interval k, a)]
forall a. Maybe a -> [a]
maybeToList Maybe (Interval k, a)
m2
              , let k :: Interval k
k = Interval k -> Interval k -> Interval k
forall r. Ord r => Interval r -> Interval r -> Interval r
Interval.intersection (Interval k -> Interval k
forall r. Ord r => Interval r -> Interval r
downTo Interval k
i) Interval k
j
              , Bool -> Bool
not (Interval k -> Bool
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 :: IntervalMap k a -> IntervalMap k a -> Bool
isSubmapOf = (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
(==)

-- |  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 :: (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
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$
  [ case Interval k -> IntervalMap k b -> Maybe b
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) <- IntervalMap k a -> [(Interval k, 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 :: IntervalMap k a -> IntervalMap k a -> Bool
isProperSubmapOf = (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
(==)

-- | 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 :: (a -> b -> Bool) -> IntervalMap k a -> IntervalMap k b -> Bool
isProperSubmapOfBy a -> b -> Bool
f IntervalMap k a
m1 IntervalMap k b
m2 =
  (a -> b -> Bool) -> IntervalMap k a -> IntervalMap k b -> Bool
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
&&
  IntervalMap k a -> IntervalSet k
forall k a. Ord k => IntervalMap k a -> IntervalSet k
keysSet IntervalMap k a
m1 IntervalSet k -> IntervalSet k -> Bool
forall r. Ord r => IntervalSet r -> IntervalSet r -> Bool
`IntervalSet.isProperSubsetOf` IntervalMap k b -> IntervalSet k
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 :: k -> Map k v -> (Map k v, Maybe v, Map k v)
splitLookupLE k
k Map k v
m =
  case k -> Map k v -> (Map k v, Maybe v, Map k v)
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, v -> Maybe v
forall a. a -> Maybe a
Just v
v, Map k v
larger)
    (Map k v
smaller, Maybe v
Nothing, Map k v
larger) ->
      case Map k v -> Maybe (v, Map k v)
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', v -> Maybe v
forall a. a -> Maybe a
Just v
v, Map k v
larger)
        Maybe (v, Map k v)
Nothing -> (Map k v
smaller, Maybe v
forall a. Maybe a
Nothing, Map k v
larger)

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

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