{-# OPTIONS_GHC -Wall #-}
{-# LANGUAGE CPP, BangPatterns, TupleSections #-}
{-# LANGUAGE Safe #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Data.IntervalMap.Base
-- Copyright   :  (c) Masahiro Sakai 2016
-- License     :  BSD-style
--
-- Maintainer  :  masahiro.sakai@gmail.com
-- Stability   :  provisional
-- Portability :  non-portable (BangPatterns, TupleSections)
--
-- Mapping from intervals to values.
--
-- API of this module is strict in both the keys and the values.
-- If you need value-lazy maps, use "Data.IntervalMap.Lazy" instead.
-- The 'IntervalMap' type itself is shared between the lazy and strict modules,
-- meaning that the same 'IntervalMap' value can be passed to functions in
-- both modules (although that is rarely needed).
--
-- These modules are intended to be imported qualified, to avoid name
-- clashes with Prelude functions, e.g.
--
-- >  import Data.IntervalMap.Strict (IntervalMap)
-- >  import qualified Data.IntervalMap.Strict as IntervalMap
--
-----------------------------------------------------------------------------
module Data.IntervalMap.Strict
  (
  -- * Strictness properties
  -- $strictness

  -- * 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)
import Data.ExtendedReal
import Data.Interval (Interval)
import qualified Data.Interval as Interval
import Data.IntervalMap.Base hiding
  ( whole
  , singleton
  , insert
  , insertWith
  , adjust
  , update
  , alter
  , unionWith
  , unionsWith
  , intersectionWith
  , map
  , fromList
  , fromListWith
  )
import qualified Data.IntervalMap.Base as B
import qualified Data.IntervalSet as IntervalSet
import Data.List (foldl')
import qualified Data.Map.Strict as Map
#if __GLASGOW_HASKELL__ < 710
import Control.Applicative ((<$>))
#endif

-- $strictness
--
-- This module satisfies the following strictness properties:
--
-- 1. Key arguments are evaluated to WHNF;
--
-- 2. Keys and values are evaluated to WHNF before they are stored in
--    the map.
--
-- Here's an example illustrating the first property:
--
-- > delete undefined m  ==  undefined
--
-- Here are some examples that illustrate the second property:
--
-- > map (\ v -> undefined) m  ==  undefined      -- m is not empty
-- > mapKeysMonotonic (\ k -> undefined) m  ==  undefined  -- m is not 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 = a -> IntervalMap k a
forall k a. Ord k => a -> IntervalMap k a
B.whole a
a

-- | 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 -> a -> IntervalMap k a
forall k a. Ord k => Interval k -> a -> IntervalMap k a
B.singleton Interval k
i a
a

-- | 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
a IntervalMap k a
m = Interval k -> a -> IntervalMap k a -> IntervalMap k a
forall k a.
Ord k =>
Interval k -> a -> IntervalMap k a -> IntervalMap k a
B.insert Interval k
i a
a IntervalMap k a
m

-- | 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'

-- | 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 -> a -> (Interval k, a) -> (Interval k, a)
seq 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 -> a -> (Interval k, a) -> (Interval k, a)
seq 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
B.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 -> IntervalMap k a
seq Map (LB k) (Interval k, a)
m2' (IntervalMap k a -> IntervalMap k a)
-> IntervalMap k a -> IntervalMap k a
forall a b. (a -> b) -> a -> b
$ 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

-- | 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, 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

-- | 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)]
forall k.
Ord k =>
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,) (c -> (Interval k, c)) -> c -> (Interval k, c)
forall a b. (a -> b) -> a -> b
$! 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

-- | 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,) (b -> (Interval k, b)) -> b -> (Interval k, b)
forall a b. (a -> b) -> a -> b
$! a -> b
f a
a) Map (LB k) (Interval k, a)
m

-- ------------------------------------------------------------------------
-- Conversion

-- | 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