{-# LANGUAGE CPP #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE PatternGuards #-}
#if defined(__GLASGOW_HASKELL__)
{-# LANGUAGE DeriveLift #-}
{-# LANGUAGE RoleAnnotations #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE TypeFamilies #-}
#endif
#define USE_MAGIC_PROXY 1

#ifdef USE_MAGIC_PROXY
{-# LANGUAGE MagicHash #-}
#endif

{-# OPTIONS_HADDOCK not-home #-}

#include "containers.h"

#if !(WORD_SIZE_IN_BITS >= 61)
#define DEFINE_ALTERF_FALLBACK 1
#endif

-----------------------------------------------------------------------------
-- |
-- Module      :  Data.Map.Internal
-- Copyright   :  (c) Daan Leijen 2002
--                (c) Andriy Palamarchuk 2008
-- License     :  BSD-style
-- Maintainer  :  libraries@haskell.org
-- Portability :  portable
--
-- = WARNING
--
-- This module is considered __internal__.
--
-- The Package Versioning Policy __does not apply__.
--
-- The contents of this module may change __in any way whatsoever__
-- and __without any warning__ between minor versions of this package.
--
-- Authors importing this module are expected to track development
-- closely.
--
-- = Description
--
-- An efficient implementation of maps from keys to values (dictionaries).
--
-- Since many function names (but not the type name) clash with
-- "Prelude" names, this module is usually imported @qualified@, e.g.
--
-- >  import Data.Map (Map)
-- >  import qualified Data.Map as Map
--
-- The implementation of 'Map' is based on /size balanced/ binary trees (or
-- trees of /bounded balance/) as described by:
--
--    * Stephen Adams, \"/Efficient sets: a balancing act/\",
--     Journal of Functional Programming 3(4):553-562, October 1993,
--     <http://www.swiss.ai.mit.edu/~adams/BB/>.
--    * J. Nievergelt and E.M. Reingold,
--      \"/Binary search trees of bounded balance/\",
--      SIAM journal of computing 2(1), March 1973.
--
--  Bounds for 'union', 'intersection', and 'difference' are as given
--  by
--
--    * Guy Blelloch, Daniel Ferizovic, and Yihan Sun,
--      \"/Just Join for Parallel Ordered Sets/\",
--      <https://arxiv.org/abs/1602.02120v3>.
--
-- Note that the implementation is /left-biased/ -- the elements of a
-- first argument are always preferred to the second, for example in
-- 'union' or 'insert'.
--
-- Operation comments contain the operation time complexity in
-- the Big-O notation <http://en.wikipedia.org/wiki/Big_O_notation>.
--
-- @since 0.5.9
-----------------------------------------------------------------------------

-- [Note: Using INLINABLE]
-- ~~~~~~~~~~~~~~~~~~~~~~~
-- It is crucial to the performance that the functions specialize on the Ord
-- type when possible. GHC 7.0 and higher does this by itself when it sees th
-- unfolding of a function -- that is why all public functions are marked
-- INLINABLE (that exposes the unfolding).


-- [Note: Using INLINE]
-- ~~~~~~~~~~~~~~~~~~~~
-- For other compilers and GHC pre 7.0, we mark some of the functions INLINE.
-- We mark the functions that just navigate down the tree (lookup, insert,
-- delete and similar). That navigation code gets inlined and thus specialized
-- when possible. There is a price to pay -- code growth. The code INLINED is
-- therefore only the tree navigation, all the real work (rebalancing) is not
-- INLINED by using a NOINLINE.
--
-- All methods marked INLINE have to be nonrecursive -- a 'go' function doing
-- the real work is provided.


-- [Note: Type of local 'go' function]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-- If the local 'go' function uses an Ord class, it sometimes heap-allocates
-- the Ord dictionary when the 'go' function does not have explicit type.
-- In that case we give 'go' explicit type. But this slightly decrease
-- performance, as the resulting 'go' function can float out to top level.


-- [Note: Local 'go' functions and capturing]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-- As opposed to Map, when 'go' function captures an argument, increased
-- heap-allocation can occur: sometimes in a polymorphic function, the 'go'
-- floats out of its enclosing function and then it heap-allocates the
-- dictionary and the argument. Maybe it floats out too late and strictness
-- analyzer cannot see that these could be passed on stack.
--

-- [Note: Order of constructors]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-- The order of constructors of Map matters when considering performance.
-- Currently in GHC 7.0, when type has 2 constructors, a forward conditional
-- jump is made when successfully matching second constructor. Successful match
-- of first constructor results in the forward jump not taken.
-- On GHC 7.0, reordering constructors from Tip | Bin to Bin | Tip
-- improves the benchmark by up to 10% on x86.

module Data.Map.Internal (
    -- * Map type
      Map(..)          -- instance Eq,Show,Read
    , Size

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

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

    -- * Construction
    , empty
    , singleton

    -- ** Insertion
    , insert
    , insertWith
    , insertWithKey
    , insertLookupWithKey

    -- ** Delete\/Update
    , delete
    , adjust
    , adjustWithKey
    , update
    , updateWithKey
    , updateLookupWithKey
    , alter
    , alterF

    -- * Combine

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

    -- ** Difference
    , difference
    , differenceWith
    , differenceWithKey

    -- ** Intersection
    , intersection
    , intersectionWith
    , intersectionWithKey

    -- ** Disjoint
    , disjoint

    -- ** Compose
    , compose

    -- ** General combining function
    , SimpleWhenMissing
    , SimpleWhenMatched
    , runWhenMatched
    , runWhenMissing
    , merge
    -- *** @WhenMatched@ tactics
    , zipWithMaybeMatched
    , zipWithMatched
    -- *** @WhenMissing@ tactics
    , mapMaybeMissing
    , dropMissing
    , preserveMissing
    , preserveMissing'
    , mapMissing
    , filterMissing

    -- ** Applicative general combining function
    , WhenMissing (..)
    , WhenMatched (..)
    , mergeA

    -- *** @WhenMatched@ tactics
    -- | The tactics described for 'merge' work for
    -- 'mergeA' as well. Furthermore, the following
    -- are available.
    , zipWithMaybeAMatched
    , zipWithAMatched

    -- *** @WhenMissing@ tactics
    -- | The tactics described for 'merge' work for
    -- 'mergeA' as well. Furthermore, the following
    -- are available.
    , traverseMaybeMissing
    , traverseMissing
    , filterAMissing

    -- ** Deprecated general combining function

    , mergeWithKey

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

    -- * Folds
    , foldr
    , foldl
    , foldrWithKey
    , foldlWithKey
    , foldMapWithKey

    -- ** Strict folds
    , foldr'
    , foldl'
    , foldrWithKey'
    , foldlWithKey'

    -- * Conversion
    , elems
    , keys
    , assocs
    , keysSet
    , argSet
    , fromSet
    , fromArgSet

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

    -- ** Ordered lists
    , toAscList
    , toDescList
    , fromAscList
    , fromAscListWith
    , fromAscListWithKey
    , fromDistinctAscList
    , fromDescList
    , fromDescListWith
    , fromDescListWithKey
    , fromDistinctDescList

    -- * Filter
    , filter
    , filterWithKey

    , takeWhileAntitone
    , dropWhileAntitone
    , spanAntitone

    , restrictKeys
    , withoutKeys
    , partition
    , partitionWithKey

    , mapMaybe
    , mapMaybeWithKey
    , mapEither
    , mapEitherWithKey

    , split
    , splitLookup
    , splitRoot

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

    -- * Indexed
    , lookupIndex
    , findIndex
    , elemAt
    , updateAt
    , deleteAt
    , take
    , drop
    , splitAt

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

    -- Used by the strict version
    , AreWeStrict (..)
    , atKeyImpl
#ifdef __GLASGOW_HASKELL__
    , atKeyPlain
#endif
    , bin
    , balance
    , balanceL
    , balanceR
    , delta
    , insertMax
    , link
    , link2
    , glue
    , MaybeS(..)
    , Identity(..)

    -- Used by Map.Merge.Lazy
    , mapWhenMissing
    , mapWhenMatched
    , lmapWhenMissing
    , contramapFirstWhenMatched
    , contramapSecondWhenMatched
    , mapGentlyWhenMissing
    , mapGentlyWhenMatched
    ) where

import Data.Functor.Identity (Identity (..))
import Control.Applicative (liftA3)
import Data.Functor.Classes
import Data.Semigroup (stimesIdempotentMonoid)
import Data.Semigroup (Arg(..), Semigroup(stimes))
#if !(MIN_VERSION_base(4,11,0))
import Data.Semigroup (Semigroup((<>)))
#endif
import Control.Applicative (Const (..))
import Control.DeepSeq (NFData(rnf))
import Data.Bits (shiftL, shiftR)
import qualified Data.Foldable as Foldable
#if MIN_VERSION_base(4,10,0)
import Data.Bifoldable
#endif
import Prelude hiding (lookup, map, filter, foldr, foldl, null, splitAt, take, drop)

import qualified Data.Set.Internal as Set
import Data.Set.Internal (Set)
import Utils.Containers.Internal.PtrEquality (ptrEq)
import Utils.Containers.Internal.StrictPair
import Utils.Containers.Internal.StrictMaybe
import Utils.Containers.Internal.BitQueue
#ifdef DEFINE_ALTERF_FALLBACK
import Utils.Containers.Internal.BitUtil (wordSize)
#endif

#if __GLASGOW_HASKELL__
import GHC.Exts (build, lazy)
import Language.Haskell.TH.Syntax (Lift)
#  ifdef USE_MAGIC_PROXY
import GHC.Exts (Proxy#, proxy# )
#  endif
import qualified GHC.Exts as GHCExts
import Text.Read hiding (lift)
import Data.Data
import qualified Control.Category as Category
import Data.Coerce
#endif


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

-- | \(O(\log n)\). Find the value at a key.
-- Calls 'error' when the element can not be found.
--
-- > fromList [(5,'a'), (3,'b')] ! 1    Error: element not in the map
-- > fromList [(5,'a'), (3,'b')] ! 5 == 'a'

(!) :: Ord k => Map k a -> k -> a
! :: forall k a. Ord k => Map k a -> k -> a
(!) Map k a
m k
k = k -> Map k a -> a
forall k a. Ord k => k -> Map k a -> a
find k
k Map k a
m
#if __GLASGOW_HASKELL__
{-# INLINE (!) #-}
#endif

-- | \(O(\log n)\). Find the value at a key.
-- Returns 'Nothing' when the element can not be found.
--
-- prop> fromList [(5, 'a'), (3, 'b')] !? 1 == Nothing
-- prop> fromList [(5, 'a'), (3, 'b')] !? 5 == Just 'a'
--
-- @since 0.5.9

(!?) :: Ord k => Map k a -> k -> Maybe a
!? :: forall k a. Ord k => Map k a -> k -> Maybe a
(!?) Map k a
m k
k = k -> Map k a -> Maybe a
forall k a. Ord k => k -> Map k a -> Maybe a
lookup k
k Map k a
m
#if __GLASGOW_HASKELL__
{-# INLINE (!?) #-}
#endif

-- | Same as 'difference'.
(\\) :: Ord k => Map k a -> Map k b -> Map k a
Map k a
m1 \\ :: forall k a b. Ord k => Map k a -> Map k b -> Map k a
\\ Map k b
m2 = Map k a -> Map k b -> Map k a
forall k a b. Ord k => Map k a -> Map k b -> Map k a
difference Map k a
m1 Map k b
m2
#if __GLASGOW_HASKELL__
{-# INLINE (\\) #-}
#endif

{--------------------------------------------------------------------
  Size balanced trees.
--------------------------------------------------------------------}
-- | A Map from keys @k@ to values @a@.
--
-- The 'Semigroup' operation for 'Map' is 'union', which prefers
-- values from the left operand. If @m1@ maps a key @k@ to a value
-- @a1@, and @m2@ maps the same key to a different value @a2@, then
-- their union @m1 <> m2@ maps @k@ to @a1@.

-- See Note: Order of constructors
data Map k a  = Bin {-# UNPACK #-} !Size !k a !(Map k a) !(Map k a)
              | Tip

type Size     = Int

#ifdef __GLASGOW_HASKELL__
type role Map nominal representational
#endif

#ifdef __GLASGOW_HASKELL__
-- | @since FIXME
deriving instance (Lift k, Lift a) => Lift (Map k a)
#endif

instance (Ord k) => Monoid (Map k v) where
    mempty :: Map k v
mempty  = Map k v
forall k a. Map k a
empty
    mconcat :: [Map k v] -> Map k v
mconcat = [Map k v] -> Map k v
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
unions
    mappend :: Map k v -> Map k v -> Map k v
mappend = Map k v -> Map k v -> Map k v
forall a. Semigroup a => a -> a -> a
(<>)

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

#if __GLASGOW_HASKELL__

{--------------------------------------------------------------------
  A Data instance
--------------------------------------------------------------------}

-- 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 (Map k a) where
  gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Map k a -> c (Map k a)
gfoldl forall d b. Data d => c (d -> b) -> d -> c b
f forall g. g -> c g
z Map k a
m   = ([(k, a)] -> Map k a) -> c ([(k, a)] -> Map k a)
forall g. g -> c g
z [(k, a)] -> Map k a
forall k a. Ord k => [(k, a)] -> Map k a
fromList c ([(k, a)] -> Map k a) -> [(k, a)] -> c (Map k a)
forall d b. Data d => c (d -> b) -> d -> c b
`f` Map k a -> [(k, a)]
forall k a. Map k a -> [(k, a)]
toList Map k a
m
  toConstr :: Map k a -> Constr
toConstr Map k a
_     = Constr
fromListConstr
  gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Map k a)
gunfold forall b r. Data b => c (b -> r) -> c r
k forall r. r -> c r
z Constr
c  = case Constr -> Size
constrIndex Constr
c of
    Size
1 -> c ([(k, a)] -> Map k a) -> c (Map k a)
forall b r. Data b => c (b -> r) -> c r
k (([(k, a)] -> Map k a) -> c ([(k, a)] -> Map k a)
forall r. r -> c r
z [(k, a)] -> Map k a
forall k a. Ord k => [(k, a)] -> Map k a
fromList)
    Size
_ -> [Char] -> c (Map k a)
forall a. HasCallStack => [Char] -> a
error [Char]
"gunfold"
  dataTypeOf :: Map k a -> DataType
dataTypeOf Map k a
_   = DataType
mapDataType
  dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Map k a))
dataCast2 forall d e. (Data d, Data e) => c (t d e)
f    = c (t k a) -> Maybe (c (Map k a))
forall {k1} {k2} {k3} (c :: k1 -> *) (t :: k2 -> k3 -> k1)
       (t' :: k2 -> k3 -> k1) (a :: k2) (b :: k3).
(Typeable t, Typeable t') =>
c (t a b) -> Maybe (c (t' a b))
gcast2 c (t k a)
forall d e. (Data d, Data e) => c (t d e)
f

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

mapDataType :: DataType
mapDataType :: DataType
mapDataType = [Char] -> [Constr] -> DataType
mkDataType [Char]
"Data.Map.Internal.Map" [Constr
fromListConstr]

#endif

{--------------------------------------------------------------------
  Query
--------------------------------------------------------------------}
-- | \(O(1)\). Is the map empty?
--
-- > Data.Map.null (empty)           == True
-- > Data.Map.null (singleton 1 'a') == False

null :: Map k a -> Bool
null :: forall k a. Map k a -> Bool
null Map k a
Tip      = Bool
True
null (Bin {}) = Bool
False
{-# INLINE null #-}

-- | \(O(1)\). The number of elements in the map.
--
-- > size empty                                   == 0
-- > size (singleton 1 'a')                       == 1
-- > size (fromList([(1,'a'), (2,'c'), (3,'b')])) == 3

size :: Map k a -> Int
size :: forall k a. Map k a -> Size
size Map k a
Tip              = Size
0
size (Bin Size
sz k
_ a
_ Map k a
_ Map k a
_) = Size
sz
{-# INLINE size #-}


-- | \(O(\log n)\). 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.
--
-- An example of using @lookup@:
--
-- > import Prelude hiding (lookup)
-- > import Data.Map
-- >
-- > employeeDept = fromList([("John","Sales"), ("Bob","IT")])
-- > deptCountry = fromList([("IT","USA"), ("Sales","France")])
-- > countryCurrency = fromList([("USA", "Dollar"), ("France", "Euro")])
-- >
-- > employeeCurrency :: String -> Maybe String
-- > employeeCurrency name = do
-- >     dept <- lookup name employeeDept
-- >     country <- lookup dept deptCountry
-- >     lookup country countryCurrency
-- >
-- > main = do
-- >     putStrLn $ "John's currency: " ++ (show (employeeCurrency "John"))
-- >     putStrLn $ "Pete's currency: " ++ (show (employeeCurrency "Pete"))
--
-- The output of this program:
--
-- >   John's currency: Just "Euro"
-- >   Pete's currency: Nothing
lookup :: Ord k => k -> Map k a -> Maybe a
lookup :: forall k a. Ord k => k -> Map k a -> Maybe a
lookup = k -> Map k a -> Maybe a
forall k a. Ord k => k -> Map k a -> Maybe a
go
  where
    go :: t -> Map t a -> Maybe a
go !t
_ Map t a
Tip = Maybe a
forall a. Maybe a
Nothing
    go t
k (Bin Size
_ t
kx a
x Map t a
l Map t a
r) = case t -> t -> Ordering
forall a. Ord a => a -> a -> Ordering
compare t
k t
kx of
      Ordering
LT -> t -> Map t a -> Maybe a
go t
k Map t a
l
      Ordering
GT -> t -> Map t a -> Maybe a
go t
k Map t a
r
      Ordering
EQ -> a -> Maybe a
forall a. a -> Maybe a
Just a
x
#if __GLASGOW_HASKELL__
{-# INLINABLE lookup #-}
#else
{-# INLINE lookup #-}
#endif

-- | \(O(\log n)\). Is the key a member of the map? See also 'notMember'.
--
-- > member 5 (fromList [(5,'a'), (3,'b')]) == True
-- > member 1 (fromList [(5,'a'), (3,'b')]) == False
member :: Ord k => k -> Map k a -> Bool
member :: forall k a. Ord k => k -> Map k a -> Bool
member = k -> Map k a -> Bool
forall k a. Ord k => k -> Map k a -> Bool
go
  where
    go :: t -> Map t a -> Bool
go !t
_ Map t a
Tip = Bool
False
    go t
k (Bin Size
_ t
kx a
_ Map t a
l Map t a
r) = case t -> t -> Ordering
forall a. Ord a => a -> a -> Ordering
compare t
k t
kx of
      Ordering
LT -> t -> Map t a -> Bool
go t
k Map t a
l
      Ordering
GT -> t -> Map t a -> Bool
go t
k Map t a
r
      Ordering
EQ -> Bool
True
#if __GLASGOW_HASKELL__
{-# INLINABLE member #-}
#else
{-# INLINE member #-}
#endif

-- | \(O(\log n)\). Is the key not a member of the map? See also 'member'.
--
-- > notMember 5 (fromList [(5,'a'), (3,'b')]) == False
-- > notMember 1 (fromList [(5,'a'), (3,'b')]) == True

notMember :: Ord k => k -> Map k a -> Bool
notMember :: forall k a. Ord k => k -> Map k a -> Bool
notMember k
k Map k a
m = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ k -> Map k a -> Bool
forall k a. Ord k => k -> Map k a -> Bool
member k
k Map k a
m
#if __GLASGOW_HASKELL__
{-# INLINABLE notMember #-}
#else
{-# INLINE notMember #-}
#endif

-- | \(O(\log n)\). Find the value at a key.
-- Calls 'error' when the element can not be found.
find :: Ord k => k -> Map k a -> a
find :: forall k a. Ord k => k -> Map k a -> a
find = k -> Map k a -> a
forall k a. Ord k => k -> Map k a -> a
go
  where
    go :: t -> Map t a -> a
go !t
_ Map t a
Tip = [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"Map.!: given key is not an element in the map"
    go t
k (Bin Size
_ t
kx a
x Map t a
l Map t a
r) = case t -> t -> Ordering
forall a. Ord a => a -> a -> Ordering
compare t
k t
kx of
      Ordering
LT -> t -> Map t a -> a
go t
k Map t a
l
      Ordering
GT -> t -> Map t a -> a
go t
k Map t a
r
      Ordering
EQ -> a
x
#if __GLASGOW_HASKELL__
{-# INLINABLE find #-}
#else
{-# INLINE find #-}
#endif

-- | \(O(\log n)\). The expression @('findWithDefault' def k map)@ returns
-- the value at key @k@ or returns default value @def@
-- when the key is not in the map.
--
-- > findWithDefault 'x' 1 (fromList [(5,'a'), (3,'b')]) == 'x'
-- > findWithDefault 'x' 5 (fromList [(5,'a'), (3,'b')]) == 'a'
findWithDefault :: Ord k => a -> k -> Map k a -> a
findWithDefault :: forall k a. Ord k => a -> k -> Map k a -> a
findWithDefault = a -> k -> Map k a -> a
forall k a. Ord k => a -> k -> Map k a -> a
go
  where
    go :: t -> t -> Map t t -> t
go t
def !t
_ Map t t
Tip = t
def
    go t
def t
k (Bin Size
_ t
kx t
x Map t t
l Map t t
r) = case t -> t -> Ordering
forall a. Ord a => a -> a -> Ordering
compare t
k t
kx of
      Ordering
LT -> t -> t -> Map t t -> t
go t
def t
k Map t t
l
      Ordering
GT -> t -> t -> Map t t -> t
go t
def t
k Map t t
r
      Ordering
EQ -> t
x
#if __GLASGOW_HASKELL__
{-# INLINABLE findWithDefault #-}
#else
{-# INLINE findWithDefault #-}
#endif

-- | \(O(\log n)\). Find largest key smaller than the given one and return the
-- corresponding (key, value) pair.
--
-- > lookupLT 3 (fromList [(3,'a'), (5,'b')]) == Nothing
-- > lookupLT 4 (fromList [(3,'a'), (5,'b')]) == Just (3, 'a')
lookupLT :: Ord k => k -> Map k v -> Maybe (k, v)
lookupLT :: forall k v. Ord k => k -> Map k v -> Maybe (k, v)
lookupLT = k -> Map k v -> Maybe (k, v)
forall k v. Ord k => k -> Map k v -> Maybe (k, v)
goNothing
  where
    goNothing :: t -> Map t t -> Maybe (t, t)
goNothing !t
_ Map t t
Tip = Maybe (t, t)
forall a. Maybe a
Nothing
    goNothing t
k (Bin Size
_ t
kx t
x Map t t
l Map t t
r) | t
k t -> t -> Bool
forall a. Ord a => a -> a -> Bool
<= t
kx = t -> Map t t -> Maybe (t, t)
goNothing t
k Map t t
l
                                 | Bool
otherwise = t -> t -> t -> Map t t -> Maybe (t, t)
forall {t} {t}. Ord t => t -> t -> t -> Map t t -> Maybe (t, t)
goJust t
k t
kx t
x Map t t
r

    goJust :: t -> t -> t -> Map t t -> Maybe (t, t)
goJust !t
_ t
kx' t
x' Map t t
Tip = (t, t) -> Maybe (t, t)
forall a. a -> Maybe a
Just (t
kx', t
x')
    goJust t
k t
kx' t
x' (Bin Size
_ t
kx t
x Map t t
l Map t t
r) | t
k t -> t -> Bool
forall a. Ord a => a -> a -> Bool
<= t
kx = t -> t -> t -> Map t t -> Maybe (t, t)
goJust t
k t
kx' t
x' Map t t
l
                                     | Bool
otherwise = t -> t -> t -> Map t t -> Maybe (t, t)
goJust t
k t
kx t
x Map t t
r
#if __GLASGOW_HASKELL__
{-# INLINABLE lookupLT #-}
#else
{-# INLINE lookupLT #-}
#endif

-- | \(O(\log n)\). Find smallest key greater than the given one and return the
-- corresponding (key, value) pair.
--
-- > lookupGT 4 (fromList [(3,'a'), (5,'b')]) == Just (5, 'b')
-- > lookupGT 5 (fromList [(3,'a'), (5,'b')]) == Nothing
lookupGT :: Ord k => k -> Map k v -> Maybe (k, v)
lookupGT :: forall k v. Ord k => k -> Map k v -> Maybe (k, v)
lookupGT = k -> Map k v -> Maybe (k, v)
forall k v. Ord k => k -> Map k v -> Maybe (k, v)
goNothing
  where
    goNothing :: t -> Map t t -> Maybe (t, t)
goNothing !t
_ Map t t
Tip = Maybe (t, t)
forall a. Maybe a
Nothing
    goNothing t
k (Bin Size
_ t
kx t
x Map t t
l Map t t
r) | t
k t -> t -> Bool
forall a. Ord a => a -> a -> Bool
< t
kx = t -> t -> t -> Map t t -> Maybe (t, t)
forall {t} {t}. Ord t => t -> t -> t -> Map t t -> Maybe (t, t)
goJust t
k t
kx t
x Map t t
l
                                 | Bool
otherwise = t -> Map t t -> Maybe (t, t)
goNothing t
k Map t t
r

    goJust :: t -> t -> t -> Map t t -> Maybe (t, t)
goJust !t
_ t
kx' t
x' Map t t
Tip = (t, t) -> Maybe (t, t)
forall a. a -> Maybe a
Just (t
kx', t
x')
    goJust t
k t
kx' t
x' (Bin Size
_ t
kx t
x Map t t
l Map t t
r) | t
k t -> t -> Bool
forall a. Ord a => a -> a -> Bool
< t
kx = t -> t -> t -> Map t t -> Maybe (t, t)
goJust t
k t
kx t
x Map t t
l
                                     | Bool
otherwise = t -> t -> t -> Map t t -> Maybe (t, t)
goJust t
k t
kx' t
x' Map t t
r
#if __GLASGOW_HASKELL__
{-# INLINABLE lookupGT #-}
#else
{-# INLINE lookupGT #-}
#endif

-- | \(O(\log n)\). Find largest key smaller or equal to the given one and return
-- the corresponding (key, value) pair.
--
-- > lookupLE 2 (fromList [(3,'a'), (5,'b')]) == Nothing
-- > lookupLE 4 (fromList [(3,'a'), (5,'b')]) == Just (3, 'a')
-- > lookupLE 5 (fromList [(3,'a'), (5,'b')]) == Just (5, 'b')
lookupLE :: Ord k => k -> Map k v -> Maybe (k, v)
lookupLE :: forall k v. Ord k => k -> Map k v -> Maybe (k, v)
lookupLE = k -> Map k v -> Maybe (k, v)
forall k v. Ord k => k -> Map k v -> Maybe (k, v)
goNothing
  where
    goNothing :: a -> Map a b -> Maybe (a, b)
goNothing !a
_ Map a b
Tip = Maybe (a, b)
forall a. Maybe a
Nothing
    goNothing a
k (Bin Size
_ a
kx b
x Map a b
l Map a b
r) = case a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
k a
kx of Ordering
LT -> a -> Map a b -> Maybe (a, b)
goNothing a
k Map a b
l
                                                        Ordering
EQ -> (a, b) -> Maybe (a, b)
forall a. a -> Maybe a
Just (a
kx, b
x)
                                                        Ordering
GT -> a -> a -> b -> Map a b -> Maybe (a, b)
forall {t} {t}. Ord t => t -> t -> t -> Map t t -> Maybe (t, t)
goJust a
k a
kx b
x Map a b
r

    goJust :: t -> t -> t -> Map t t -> Maybe (t, t)
goJust !t
_ t
kx' t
x' Map t t
Tip = (t, t) -> Maybe (t, t)
forall a. a -> Maybe a
Just (t
kx', t
x')
    goJust t
k t
kx' t
x' (Bin Size
_ t
kx t
x Map t t
l Map t t
r) = case t -> t -> Ordering
forall a. Ord a => a -> a -> Ordering
compare t
k t
kx of Ordering
LT -> t -> t -> t -> Map t t -> Maybe (t, t)
goJust t
k t
kx' t
x' Map t t
l
                                                            Ordering
EQ -> (t, t) -> Maybe (t, t)
forall a. a -> Maybe a
Just (t
kx, t
x)
                                                            Ordering
GT -> t -> t -> t -> Map t t -> Maybe (t, t)
goJust t
k t
kx t
x Map t t
r
#if __GLASGOW_HASKELL__
{-# INLINABLE lookupLE #-}
#else
{-# INLINE lookupLE #-}
#endif

-- | \(O(\log n)\). Find smallest key greater or equal to the given one and return
-- the corresponding (key, value) pair.
--
-- > lookupGE 3 (fromList [(3,'a'), (5,'b')]) == Just (3, 'a')
-- > lookupGE 4 (fromList [(3,'a'), (5,'b')]) == Just (5, 'b')
-- > lookupGE 6 (fromList [(3,'a'), (5,'b')]) == Nothing
lookupGE :: Ord k => k -> Map k v -> Maybe (k, v)
lookupGE :: forall k v. Ord k => k -> Map k v -> Maybe (k, v)
lookupGE = k -> Map k v -> Maybe (k, v)
forall k v. Ord k => k -> Map k v -> Maybe (k, v)
goNothing
  where
    goNothing :: t -> Map t b -> Maybe (t, b)
goNothing !t
_ Map t b
Tip = Maybe (t, b)
forall a. Maybe a
Nothing
    goNothing t
k (Bin Size
_ t
kx b
x Map t b
l Map t b
r) = case t -> t -> Ordering
forall a. Ord a => a -> a -> Ordering
compare t
k t
kx of Ordering
LT -> t -> t -> b -> Map t b -> Maybe (t, b)
forall {t} {t}. Ord t => t -> t -> t -> Map t t -> Maybe (t, t)
goJust t
k t
kx b
x Map t b
l
                                                        Ordering
EQ -> (t, b) -> Maybe (t, b)
forall a. a -> Maybe a
Just (t
kx, b
x)
                                                        Ordering
GT -> t -> Map t b -> Maybe (t, b)
goNothing t
k Map t b
r

    goJust :: a -> a -> b -> Map a b -> Maybe (a, b)
goJust !a
_ a
kx' b
x' Map a b
Tip = (a, b) -> Maybe (a, b)
forall a. a -> Maybe a
Just (a
kx', b
x')
    goJust a
k a
kx' b
x' (Bin Size
_ a
kx b
x Map a b
l Map a b
r) = case a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
k a
kx of Ordering
LT -> a -> a -> b -> Map a b -> Maybe (a, b)
goJust a
k a
kx b
x Map a b
l
                                                            Ordering
EQ -> (a, b) -> Maybe (a, b)
forall a. a -> Maybe a
Just (a
kx, b
x)
                                                            Ordering
GT -> a -> a -> b -> Map a b -> Maybe (a, b)
goJust a
k a
kx' b
x' Map a b
r
#if __GLASGOW_HASKELL__
{-# INLINABLE lookupGE #-}
#else
{-# INLINE lookupGE #-}
#endif

{--------------------------------------------------------------------
  Construction
--------------------------------------------------------------------}
-- | \(O(1)\). The empty map.
--
-- > empty      == fromList []
-- > size empty == 0

empty :: Map k a
empty :: forall k a. Map k a
empty = Map k a
forall k a. Map k a
Tip
{-# INLINE empty #-}

-- | \(O(1)\). A map with a single element.
--
-- > singleton 1 'a'        == fromList [(1, 'a')]
-- > size (singleton 1 'a') == 1

singleton :: k -> a -> Map k a
singleton :: forall k a. k -> a -> Map k a
singleton k
k a
x = Size -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Size -> k -> a -> Map k a -> Map k a -> Map k a
Bin Size
1 k
k a
x Map k a
forall k a. Map k a
Tip Map k a
forall k a. Map k a
Tip
{-# INLINE singleton #-}

{--------------------------------------------------------------------
  Insertion
--------------------------------------------------------------------}
-- | \(O(\log n)\). 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' is equivalent to
-- @'insertWith' 'const'@.
--
-- > insert 5 'x' (fromList [(5,'a'), (3,'b')]) == fromList [(3, 'b'), (5, 'x')]
-- > insert 7 'x' (fromList [(5,'a'), (3,'b')]) == fromList [(3, 'b'), (5, 'a'), (7, 'x')]
-- > insert 5 'x' empty                         == singleton 5 'x'

-- See Note: Type of local 'go' function
-- See Note: Avoiding worker/wrapper
insert :: Ord k => k -> a -> Map k a -> Map k a
insert :: forall k a. Ord k => k -> a -> Map k a -> Map k a
insert k
kx0 = k -> k -> a -> Map k a -> Map k a
forall k a. Ord k => k -> k -> a -> Map k a -> Map k a
go k
kx0 k
kx0
  where
    -- Unlike insertR, we only get sharing here
    -- when the inserted value is at the same address
    -- as the present value. We try anyway; this condition
    -- seems particularly likely to occur in 'union'.
    go :: Ord k => k -> k -> a -> Map k a -> Map k a
    go :: forall k a. Ord k => k -> k -> a -> Map k a -> Map k a
go k
orig !k
_  a
x Map k a
Tip = k -> a -> Map k a
forall k a. k -> a -> Map k a
singleton (k -> k
forall a. a -> a
lazy k
orig) a
x
    go k
orig !k
kx a
x t :: Map k a
t@(Bin Size
sz k
ky a
y Map k a
l Map k a
r) =
        case k -> k -> Ordering
forall a. Ord a => a -> a -> Ordering
compare k
kx k
ky of
            Ordering
LT | Map k a
l' Map k a -> Map k a -> Bool
forall a. a -> a -> Bool
`ptrEq` Map k a
l -> Map k a
t
               | Bool
otherwise -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceL k
ky a
y Map k a
l' Map k a
r
               where !l' :: Map k a
l' = k -> k -> a -> Map k a -> Map k a
forall k a. Ord k => k -> k -> a -> Map k a -> Map k a
go k
orig k
kx a
x Map k a
l
            Ordering
GT | Map k a
r' Map k a -> Map k a -> Bool
forall a. a -> a -> Bool
`ptrEq` Map k a
r -> Map k a
t
               | Bool
otherwise -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceR k
ky a
y Map k a
l Map k a
r'
               where !r' :: Map k a
r' = k -> k -> a -> Map k a -> Map k a
forall k a. Ord k => k -> k -> a -> Map k a -> Map k a
go k
orig k
kx a
x Map k a
r
            Ordering
EQ | a
x a -> a -> Bool
forall a. a -> a -> Bool
`ptrEq` a
y Bool -> Bool -> Bool
&& (k -> k
forall a. a -> a
lazy k
orig k -> Bool -> Bool
forall a b. a -> b -> b
`seq` (k
orig k -> k -> Bool
forall a. a -> a -> Bool
`ptrEq` k
ky)) -> Map k a
t
               | Bool
otherwise -> Size -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Size -> k -> a -> Map k a -> Map k a -> Map k a
Bin Size
sz (k -> k
forall a. a -> a
lazy k
orig) a
x Map k a
l Map k a
r
#if __GLASGOW_HASKELL__
{-# INLINABLE insert #-}
#else
{-# INLINE insert #-}
#endif

#ifndef __GLASGOW_HASKELL__
lazy :: a -> a
lazy a = a
#endif

-- [Note: Avoiding worker/wrapper]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-- 'insert' has to go to great lengths to get pointer equality right and
-- to prevent unnecessary allocation. The trouble is that GHC *really* wants
-- to unbox the key and throw away the boxed one. This is bad for us, because
-- we want to compare the pointer of the box we are given to the one already
-- present if they compare EQ. It's also bad for us because it leads to the
-- key being *reboxed* if it's actually stored in the map. Ugh! So we pass the
-- 'go' function *two copies* of the key we're given. One of them we use for
-- comparisons; the other we keep in our pocket. To prevent worker/wrapper from
-- messing with the copy in our pocket, we sprinkle about calls to the magical
-- function 'lazy'. This is all horrible, but it seems to work okay.


-- Insert a new key and value in the map if it is not already present.
-- Used by `union`.

-- See Note: Type of local 'go' function
-- See Note: Avoiding worker/wrapper
insertR :: Ord k => k -> a -> Map k a -> Map k a
insertR :: forall k a. Ord k => k -> a -> Map k a -> Map k a
insertR k
kx0 = k -> k -> a -> Map k a -> Map k a
forall k a. Ord k => k -> k -> a -> Map k a -> Map k a
go k
kx0 k
kx0
  where
    go :: Ord k => k -> k -> a -> Map k a -> Map k a
    go :: forall k a. Ord k => k -> k -> a -> Map k a -> Map k a
go k
orig !k
_  a
x Map k a
Tip = k -> a -> Map k a
forall k a. k -> a -> Map k a
singleton (k -> k
forall a. a -> a
lazy k
orig) a
x
    go k
orig !k
kx a
x t :: Map k a
t@(Bin Size
_ k
ky a
y Map k a
l Map k a
r) =
        case k -> k -> Ordering
forall a. Ord a => a -> a -> Ordering
compare k
kx k
ky of
            Ordering
LT | Map k a
l' Map k a -> Map k a -> Bool
forall a. a -> a -> Bool
`ptrEq` Map k a
l -> Map k a
t
               | Bool
otherwise -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceL k
ky a
y Map k a
l' Map k a
r
               where !l' :: Map k a
l' = k -> k -> a -> Map k a -> Map k a
forall k a. Ord k => k -> k -> a -> Map k a -> Map k a
go k
orig k
kx a
x Map k a
l
            Ordering
GT | Map k a
r' Map k a -> Map k a -> Bool
forall a. a -> a -> Bool
`ptrEq` Map k a
r -> Map k a
t
               | Bool
otherwise -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceR k
ky a
y Map k a
l Map k a
r'
               where !r' :: Map k a
r' = k -> k -> a -> Map k a -> Map k a
forall k a. Ord k => k -> k -> a -> Map k a -> Map k a
go k
orig k
kx a
x Map k a
r
            Ordering
EQ -> Map k a
t
#if __GLASGOW_HASKELL__
{-# INLINABLE insertR #-}
#else
{-# INLINE insertR #-}
#endif

-- | \(O(\log n)\). Insert with a function, combining new value and old value.
-- @'insertWith' f key value mp@
-- will insert the pair (key, value) into @mp@ if key does
-- not exist in the map. If the key does exist, the function will
-- insert the pair @(key, f new_value old_value)@.
--
-- > insertWith (++) 5 "xxx" (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "xxxa")]
-- > insertWith (++) 7 "xxx" (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "a"), (7, "xxx")]
-- > insertWith (++) 5 "xxx" empty                         == singleton 5 "xxx"

insertWith :: Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
insertWith :: forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
insertWith = (a -> a -> a) -> k -> a -> Map k a -> Map k a
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
go
  where
    -- We have no hope of making pointer equality tricks work
    -- here, because lazy insertWith *always* changes the tree,
    -- either adding a new entry or replacing an element with a
    -- thunk.
    go :: Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
    go :: forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
go a -> a -> a
_ !k
kx a
x Map k a
Tip = k -> a -> Map k a
forall k a. k -> a -> Map k a
singleton k
kx a
x
    go a -> a -> a
f !k
kx a
x (Bin Size
sy k
ky a
y Map k a
l Map k a
r) =
        case k -> k -> Ordering
forall a. Ord a => a -> a -> Ordering
compare k
kx k
ky of
            Ordering
LT -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceL k
ky a
y ((a -> a -> a) -> k -> a -> Map k a -> Map k a
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
go a -> a -> a
f k
kx a
x Map k a
l) Map k a
r
            Ordering
GT -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceR k
ky a
y Map k a
l ((a -> a -> a) -> k -> a -> Map k a -> Map k a
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
go a -> a -> a
f k
kx a
x Map k a
r)
            Ordering
EQ -> Size -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Size -> k -> a -> Map k a -> Map k a -> Map k a
Bin Size
sy k
kx (a -> a -> a
f a
x a
y) Map k a
l Map k a
r

#if __GLASGOW_HASKELL__
{-# INLINABLE insertWith #-}
#else
{-# INLINE insertWith #-}
#endif

-- | A helper function for 'unionWith'. When the key is already in
-- the map, the key is left alone, not replaced. The combining
-- function is flipped--it is applied to the old value and then the
-- new value.

insertWithR :: Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
insertWithR :: forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
insertWithR = (a -> a -> a) -> k -> a -> Map k a -> Map k a
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
go
  where
    go :: Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
    go :: forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
go a -> a -> a
_ !k
kx a
x Map k a
Tip = k -> a -> Map k a
forall k a. k -> a -> Map k a
singleton k
kx a
x
    go a -> a -> a
f !k
kx a
x (Bin Size
sy k
ky a
y Map k a
l Map k a
r) =
        case k -> k -> Ordering
forall a. Ord a => a -> a -> Ordering
compare k
kx k
ky of
            Ordering
LT -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceL k
ky a
y ((a -> a -> a) -> k -> a -> Map k a -> Map k a
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
go a -> a -> a
f k
kx a
x Map k a
l) Map k a
r
            Ordering
GT -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceR k
ky a
y Map k a
l ((a -> a -> a) -> k -> a -> Map k a -> Map k a
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
go a -> a -> a
f k
kx a
x Map k a
r)
            Ordering
EQ -> Size -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Size -> k -> a -> Map k a -> Map k a -> Map k a
Bin Size
sy k
ky (a -> a -> a
f a
y a
x) Map k a
l Map k a
r
#if __GLASGOW_HASKELL__
{-# INLINABLE insertWithR #-}
#else
{-# INLINE insertWithR #-}
#endif

-- | \(O(\log n)\). Insert with a function, combining key, new value and old value.
-- @'insertWithKey' f key value mp@
-- will insert the pair (key, value) into @mp@ if key does
-- not exist in the map. If the key does exist, the function will
-- insert the pair @(key,f key new_value old_value)@.
-- Note that the key passed to f is the same key passed to 'insertWithKey'.
--
-- > let f key new_value old_value = (show key) ++ ":" ++ new_value ++ "|" ++ old_value
-- > insertWithKey f 5 "xxx" (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "5:xxx|a")]
-- > insertWithKey f 7 "xxx" (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "a"), (7, "xxx")]
-- > insertWithKey f 5 "xxx" empty                         == singleton 5 "xxx"

-- See Note: Type of local 'go' function
insertWithKey :: Ord k => (k -> a -> a -> a) -> k -> a -> Map k a -> Map k a
insertWithKey :: forall k a.
Ord k =>
(k -> a -> a -> a) -> k -> a -> Map k a -> Map k a
insertWithKey = (k -> a -> a -> a) -> k -> a -> Map k a -> Map k a
forall k a.
Ord k =>
(k -> a -> a -> a) -> k -> a -> Map k a -> Map k a
go
  where
    go :: Ord k => (k -> a -> a -> a) -> k -> a -> Map k a -> Map k a
    go :: forall k a.
Ord k =>
(k -> a -> a -> a) -> k -> a -> Map k a -> Map k a
go k -> a -> a -> a
_ !k
kx a
x Map k a
Tip = k -> a -> Map k a
forall k a. k -> a -> Map k a
singleton k
kx a
x
    go k -> a -> a -> a
f k
kx a
x (Bin Size
sy k
ky a
y Map k a
l Map k a
r) =
        case k -> k -> Ordering
forall a. Ord a => a -> a -> Ordering
compare k
kx k
ky of
            Ordering
LT -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceL k
ky a
y ((k -> a -> a -> a) -> k -> a -> Map k a -> Map k a
forall k a.
Ord k =>
(k -> a -> a -> a) -> k -> a -> Map k a -> Map k a
go k -> a -> a -> a
f k
kx a
x Map k a
l) Map k a
r
            Ordering
GT -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceR k
ky a
y Map k a
l ((k -> a -> a -> a) -> k -> a -> Map k a -> Map k a
forall k a.
Ord k =>
(k -> a -> a -> a) -> k -> a -> Map k a -> Map k a
go k -> a -> a -> a
f k
kx a
x Map k a
r)
            Ordering
EQ -> Size -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Size -> k -> a -> Map k a -> Map k a -> Map k a
Bin Size
sy k
kx (k -> a -> a -> a
f k
kx a
x a
y) Map k a
l Map k a
r
#if __GLASGOW_HASKELL__
{-# INLINABLE insertWithKey #-}
#else
{-# INLINE insertWithKey #-}
#endif

-- | A helper function for 'unionWithKey'. When the key is already in
-- the map, the key is left alone, not replaced. The combining
-- function is flipped--it is applied to the old value and then the
-- new value.
insertWithKeyR :: Ord k => (k -> a -> a -> a) -> k -> a -> Map k a -> Map k a
insertWithKeyR :: forall k a.
Ord k =>
(k -> a -> a -> a) -> k -> a -> Map k a -> Map k a
insertWithKeyR = (k -> a -> a -> a) -> k -> a -> Map k a -> Map k a
forall k a.
Ord k =>
(k -> a -> a -> a) -> k -> a -> Map k a -> Map k a
go
  where
    go :: Ord k => (k -> a -> a -> a) -> k -> a -> Map k a -> Map k a
    go :: forall k a.
Ord k =>
(k -> a -> a -> a) -> k -> a -> Map k a -> Map k a
go k -> a -> a -> a
_ !k
kx a
x Map k a
Tip = k -> a -> Map k a
forall k a. k -> a -> Map k a
singleton k
kx a
x
    go k -> a -> a -> a
f k
kx a
x (Bin Size
sy k
ky a
y Map k a
l Map k a
r) =
        case k -> k -> Ordering
forall a. Ord a => a -> a -> Ordering
compare k
kx k
ky of
            Ordering
LT -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceL k
ky a
y ((k -> a -> a -> a) -> k -> a -> Map k a -> Map k a
forall k a.
Ord k =>
(k -> a -> a -> a) -> k -> a -> Map k a -> Map k a
go k -> a -> a -> a
f k
kx a
x Map k a
l) Map k a
r
            Ordering
GT -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceR k
ky a
y Map k a
l ((k -> a -> a -> a) -> k -> a -> Map k a -> Map k a
forall k a.
Ord k =>
(k -> a -> a -> a) -> k -> a -> Map k a -> Map k a
go k -> a -> a -> a
f k
kx a
x Map k a
r)
            Ordering
EQ -> Size -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Size -> k -> a -> Map k a -> Map k a -> Map k a
Bin Size
sy k
ky (k -> a -> a -> a
f k
ky a
y a
x) Map k a
l Map k a
r
#if __GLASGOW_HASKELL__
{-# INLINABLE insertWithKeyR #-}
#else
{-# INLINE insertWithKeyR #-}
#endif

-- | \(O(\log n)\). Combines insert operation with old value retrieval.
-- The expression (@'insertLookupWithKey' f k x map@)
-- is a pair where the first element is equal to (@'lookup' k map@)
-- and the second element equal to (@'insertWithKey' f k x map@).
--
-- > let f key new_value old_value = (show key) ++ ":" ++ new_value ++ "|" ++ old_value
-- > insertLookupWithKey f 5 "xxx" (fromList [(5,"a"), (3,"b")]) == (Just "a", fromList [(3, "b"), (5, "5:xxx|a")])
-- > insertLookupWithKey f 7 "xxx" (fromList [(5,"a"), (3,"b")]) == (Nothing,  fromList [(3, "b"), (5, "a"), (7, "xxx")])
-- > insertLookupWithKey f 5 "xxx" empty                         == (Nothing,  singleton 5 "xxx")
--
-- This is how to define @insertLookup@ using @insertLookupWithKey@:
--
-- > let insertLookup kx x t = insertLookupWithKey (\_ a _ -> a) kx x t
-- > insertLookup 5 "x" (fromList [(5,"a"), (3,"b")]) == (Just "a", fromList [(3, "b"), (5, "x")])
-- > insertLookup 7 "x" (fromList [(5,"a"), (3,"b")]) == (Nothing,  fromList [(3, "b"), (5, "a"), (7, "x")])

-- See Note: Type of local 'go' function
insertLookupWithKey :: Ord k => (k -> a -> a -> a) -> k -> a -> Map k a
                    -> (Maybe a, Map k a)
insertLookupWithKey :: forall k a.
Ord k =>
(k -> a -> a -> a) -> k -> a -> Map k a -> (Maybe a, Map k a)
insertLookupWithKey k -> a -> a -> a
f0 k
k0 a
x0 = StrictPair (Maybe a) (Map k a) -> (Maybe a, Map k a)
forall a b. StrictPair a b -> (a, b)
toPair (StrictPair (Maybe a) (Map k a) -> (Maybe a, Map k a))
-> (Map k a -> StrictPair (Maybe a) (Map k a))
-> Map k a
-> (Maybe a, Map k a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (k -> a -> a -> a)
-> k -> a -> Map k a -> StrictPair (Maybe a) (Map k a)
forall k a.
Ord k =>
(k -> a -> a -> a)
-> k -> a -> Map k a -> StrictPair (Maybe a) (Map k a)
go k -> a -> a -> a
f0 k
k0 a
x0
  where
    go :: Ord k => (k -> a -> a -> a) -> k -> a -> Map k a -> StrictPair (Maybe a) (Map k a)
    go :: forall k a.
Ord k =>
(k -> a -> a -> a)
-> k -> a -> Map k a -> StrictPair (Maybe a) (Map k a)
go k -> a -> a -> a
_ !k
kx a
x Map k a
Tip = (Maybe a
forall a. Maybe a
Nothing Maybe a -> Map k a -> StrictPair (Maybe a) (Map k a)
forall a b. a -> b -> StrictPair a b
:*: k -> a -> Map k a
forall k a. k -> a -> Map k a
singleton k
kx a
x)
    go k -> a -> a -> a
f k
kx a
x (Bin Size
sy k
ky a
y Map k a
l Map k a
r) =
        case k -> k -> Ordering
forall a. Ord a => a -> a -> Ordering
compare k
kx k
ky of
            Ordering
LT -> let !(Maybe a
found :*: Map k a
l') = (k -> a -> a -> a)
-> k -> a -> Map k a -> StrictPair (Maybe a) (Map k a)
forall k a.
Ord k =>
(k -> a -> a -> a)
-> k -> a -> Map k a -> StrictPair (Maybe a) (Map k a)
go k -> a -> a -> a
f k
kx a
x Map k a
l
                      !t' :: Map k a
t' = k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceL k
ky a
y Map k a
l' Map k a
r
                  in (Maybe a
found Maybe a -> Map k a -> StrictPair (Maybe a) (Map k a)
forall a b. a -> b -> StrictPair a b
:*: Map k a
t')
            Ordering
GT -> let !(Maybe a
found :*: Map k a
r') = (k -> a -> a -> a)
-> k -> a -> Map k a -> StrictPair (Maybe a) (Map k a)
forall k a.
Ord k =>
(k -> a -> a -> a)
-> k -> a -> Map k a -> StrictPair (Maybe a) (Map k a)
go k -> a -> a -> a
f k
kx a
x Map k a
r
                      !t' :: Map k a
t' = k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceR k
ky a
y Map k a
l Map k a
r'
                  in (Maybe a
found Maybe a -> Map k a -> StrictPair (Maybe a) (Map k a)
forall a b. a -> b -> StrictPair a b
:*: Map k a
t')
            Ordering
EQ -> (a -> Maybe a
forall a. a -> Maybe a
Just a
y Maybe a -> Map k a -> StrictPair (Maybe a) (Map k a)
forall a b. a -> b -> StrictPair a b
:*: Size -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Size -> k -> a -> Map k a -> Map k a -> Map k a
Bin Size
sy k
kx (k -> a -> a -> a
f k
kx a
x a
y) Map k a
l Map k a
r)
#if __GLASGOW_HASKELL__
{-# INLINABLE insertLookupWithKey #-}
#else
{-# INLINE insertLookupWithKey #-}
#endif

{--------------------------------------------------------------------
  Deletion
--------------------------------------------------------------------}
-- | \(O(\log n)\). Delete a key and its value from the map. When the key is not
-- a member of the map, the original map is returned.
--
-- > delete 5 (fromList [(5,"a"), (3,"b")]) == singleton 3 "b"
-- > delete 7 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "a")]
-- > delete 5 empty                         == empty

-- See Note: Type of local 'go' function
delete :: Ord k => k -> Map k a -> Map k a
delete :: forall k a. Ord k => k -> Map k a -> Map k a
delete = k -> Map k a -> Map k a
forall k a. Ord k => k -> Map k a -> Map k a
go
  where
    go :: Ord k => k -> Map k a -> Map k a
    go :: forall k a. Ord k => k -> Map k a -> Map k a
go !k
_ Map k a
Tip = Map k a
forall k a. Map k a
Tip
    go k
k t :: Map k a
t@(Bin Size
_ k
kx a
x Map k a
l Map k a
r) =
        case k -> k -> Ordering
forall a. Ord a => a -> a -> Ordering
compare k
k k
kx of
            Ordering
LT | Map k a
l' Map k a -> Map k a -> Bool
forall a. a -> a -> Bool
`ptrEq` Map k a
l -> Map k a
t
               | Bool
otherwise -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceR k
kx a
x Map k a
l' Map k a
r
               where !l' :: Map k a
l' = k -> Map k a -> Map k a
forall k a. Ord k => k -> Map k a -> Map k a
go k
k Map k a
l
            Ordering
GT | Map k a
r' Map k a -> Map k a -> Bool
forall a. a -> a -> Bool
`ptrEq` Map k a
r -> Map k a
t
               | Bool
otherwise -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceL k
kx a
x Map k a
l Map k a
r'
               where !r' :: Map k a
r' = k -> Map k a -> Map k a
forall k a. Ord k => k -> Map k a -> Map k a
go k
k Map k a
r
            Ordering
EQ -> Map k a -> Map k a -> Map k a
forall k a. Map k a -> Map k a -> Map k a
glue Map k a
l Map k a
r
#if __GLASGOW_HASKELL__
{-# INLINABLE delete #-}
#else
{-# INLINE delete #-}
#endif

-- | \(O(\log n)\). Update a value at a specific key with the result of the provided function.
-- When the key is not
-- a member of the map, the original map is returned.
--
-- > adjust ("new " ++) 5 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "new a")]
-- > adjust ("new " ++) 7 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "a")]
-- > adjust ("new " ++) 7 empty                         == empty

adjust :: Ord k => (a -> a) -> k -> Map k a -> Map k a
adjust :: forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
adjust a -> a
f = (k -> a -> a) -> k -> Map k a -> Map k a
forall k a. Ord k => (k -> a -> a) -> k -> Map k a -> Map k a
adjustWithKey (\k
_ a
x -> a -> a
f a
x)
#if __GLASGOW_HASKELL__
{-# INLINABLE adjust #-}
#else
{-# INLINE adjust #-}
#endif

-- | \(O(\log n)\). Adjust a value at a specific key. When the key is not
-- a member of the map, the original map is returned.
--
-- > let f key x = (show key) ++ ":new " ++ x
-- > adjustWithKey f 5 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "5:new a")]
-- > adjustWithKey f 7 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "a")]
-- > adjustWithKey f 7 empty                         == empty

adjustWithKey :: Ord k => (k -> a -> a) -> k -> Map k a -> Map k a
adjustWithKey :: forall k a. Ord k => (k -> a -> a) -> k -> Map k a -> Map k a
adjustWithKey = (k -> a -> a) -> k -> Map k a -> Map k a
forall k a. Ord k => (k -> a -> a) -> k -> Map k a -> Map k a
go
  where
    go :: Ord k => (k -> a -> a) -> k -> Map k a -> Map k a
    go :: forall k a. Ord k => (k -> a -> a) -> k -> Map k a -> Map k a
go k -> a -> a
_ !k
_ Map k a
Tip = Map k a
forall k a. Map k a
Tip
    go k -> a -> a
f k
k (Bin Size
sx k
kx a
x Map k a
l Map k a
r) =
        case k -> k -> Ordering
forall a. Ord a => a -> a -> Ordering
compare k
k k
kx of
           Ordering
LT -> Size -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Size -> k -> a -> Map k a -> Map k a -> Map k a
Bin Size
sx k
kx a
x ((k -> a -> a) -> k -> Map k a -> Map k a
forall k a. Ord k => (k -> a -> a) -> k -> Map k a -> Map k a
go k -> a -> a
f k
k Map k a
l) Map k a
r
           Ordering
GT -> Size -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Size -> k -> a -> Map k a -> Map k a -> Map k a
Bin Size
sx k
kx a
x Map k a
l ((k -> a -> a) -> k -> Map k a -> Map k a
forall k a. Ord k => (k -> a -> a) -> k -> Map k a -> Map k a
go k -> a -> a
f k
k Map k a
r)
           Ordering
EQ -> Size -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Size -> k -> a -> Map k a -> Map k a -> Map k a
Bin Size
sx k
kx (k -> a -> a
f k
kx a
x) Map k a
l Map k a
r
#if __GLASGOW_HASKELL__
{-# INLINABLE adjustWithKey #-}
#else
{-# INLINE adjustWithKey #-}
#endif

-- | \(O(\log n)\). The expression (@'update' f k map@) updates the value @x@
-- at @k@ (if it is in the map). If (@f x@) is 'Nothing', the element is
-- deleted. If it is (@'Just' y@), the key @k@ is bound to the new value @y@.
--
-- > let f x = if x == "a" then Just "new a" else Nothing
-- > update f 5 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "new a")]
-- > update f 7 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "a")]
-- > update f 3 (fromList [(5,"a"), (3,"b")]) == singleton 5 "a"

update :: Ord k => (a -> Maybe a) -> k -> Map k a -> Map k a
update :: forall k a. Ord k => (a -> Maybe a) -> k -> Map k a -> Map k a
update a -> Maybe a
f = (k -> a -> Maybe a) -> k -> Map k a -> Map k a
forall k a. Ord k => (k -> a -> Maybe a) -> k -> Map k a -> Map k a
updateWithKey (\k
_ a
x -> a -> Maybe a
f a
x)
#if __GLASGOW_HASKELL__
{-# INLINABLE update #-}
#else
{-# INLINE update #-}
#endif

-- | \(O(\log n)\). The expression (@'updateWithKey' f k map@) updates the
-- value @x@ at @k@ (if it is in the map). If (@f k x@) is 'Nothing',
-- the element is deleted. If it is (@'Just' y@), the key @k@ is bound
-- to the new value @y@.
--
-- > let f k x = if x == "a" then Just ((show k) ++ ":new a") else Nothing
-- > updateWithKey f 5 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "5:new a")]
-- > updateWithKey f 7 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "a")]
-- > updateWithKey f 3 (fromList [(5,"a"), (3,"b")]) == singleton 5 "a"

-- See Note: Type of local 'go' function
updateWithKey :: Ord k => (k -> a -> Maybe a) -> k -> Map k a -> Map k a
updateWithKey :: forall k a. Ord k => (k -> a -> Maybe a) -> k -> Map k a -> Map k a
updateWithKey = (k -> a -> Maybe a) -> k -> Map k a -> Map k a
forall k a. Ord k => (k -> a -> Maybe a) -> k -> Map k a -> Map k a
go
  where
    go :: Ord k => (k -> a -> Maybe a) -> k -> Map k a -> Map k a
    go :: forall k a. Ord k => (k -> a -> Maybe a) -> k -> Map k a -> Map k a
go k -> a -> Maybe a
_ !k
_ Map k a
Tip = Map k a
forall k a. Map k a
Tip
    go k -> a -> Maybe a
f k
k(Bin Size
sx k
kx a
x Map k a
l Map k a
r) =
        case k -> k -> Ordering
forall a. Ord a => a -> a -> Ordering
compare k
k k
kx of
           Ordering
LT -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceR k
kx a
x ((k -> a -> Maybe a) -> k -> Map k a -> Map k a
forall k a. Ord k => (k -> a -> Maybe a) -> k -> Map k a -> Map k a
go k -> a -> Maybe a
f k
k Map k a
l) Map k a
r
           Ordering
GT -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceL k
kx a
x Map k a
l ((k -> a -> Maybe a) -> k -> Map k a -> Map k a
forall k a. Ord k => (k -> a -> Maybe a) -> k -> Map k a -> Map k a
go k -> a -> Maybe a
f k
k Map k a
r)
           Ordering
EQ -> case k -> a -> Maybe a
f k
kx a
x of
                   Just a
x' -> Size -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Size -> k -> a -> Map k a -> Map k a -> Map k a
Bin Size
sx k
kx a
x' Map k a
l Map k a
r
                   Maybe a
Nothing -> Map k a -> Map k a -> Map k a
forall k a. Map k a -> Map k a -> Map k a
glue Map k a
l Map k a
r
#if __GLASGOW_HASKELL__
{-# INLINABLE updateWithKey #-}
#else
{-# INLINE updateWithKey #-}
#endif

-- | \(O(\log n)\). Lookup and update. See also 'updateWithKey'.
-- The function returns changed value, if it is updated.
-- Returns the original key value if the map entry is deleted.
--
-- > let f k x = if x == "a" then Just ((show k) ++ ":new a") else Nothing
-- > updateLookupWithKey f 5 (fromList [(5,"a"), (3,"b")]) == (Just "5:new a", fromList [(3, "b"), (5, "5:new a")])
-- > updateLookupWithKey f 7 (fromList [(5,"a"), (3,"b")]) == (Nothing,  fromList [(3, "b"), (5, "a")])
-- > updateLookupWithKey f 3 (fromList [(5,"a"), (3,"b")]) == (Just "b", singleton 5 "a")

-- See Note: Type of local 'go' function
updateLookupWithKey :: Ord k => (k -> a -> Maybe a) -> k -> Map k a -> (Maybe a,Map k a)
updateLookupWithKey :: forall k a.
Ord k =>
(k -> a -> Maybe a) -> k -> Map k a -> (Maybe a, Map k a)
updateLookupWithKey k -> a -> Maybe a
f0 k
k0 = StrictPair (Maybe a) (Map k a) -> (Maybe a, Map k a)
forall a b. StrictPair a b -> (a, b)
toPair (StrictPair (Maybe a) (Map k a) -> (Maybe a, Map k a))
-> (Map k a -> StrictPair (Maybe a) (Map k a))
-> Map k a
-> (Maybe a, Map k a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (k -> a -> Maybe a)
-> k -> Map k a -> StrictPair (Maybe a) (Map k a)
forall k a.
Ord k =>
(k -> a -> Maybe a)
-> k -> Map k a -> StrictPair (Maybe a) (Map k a)
go k -> a -> Maybe a
f0 k
k0
 where
   go :: Ord k => (k -> a -> Maybe a) -> k -> Map k a -> StrictPair (Maybe a) (Map k a)
   go :: forall k a.
Ord k =>
(k -> a -> Maybe a)
-> k -> Map k a -> StrictPair (Maybe a) (Map k a)
go k -> a -> Maybe a
_ !k
_ Map k a
Tip = (Maybe a
forall a. Maybe a
Nothing Maybe a -> Map k a -> StrictPair (Maybe a) (Map k a)
forall a b. a -> b -> StrictPair a b
:*: Map k a
forall k a. Map k a
Tip)
   go k -> a -> Maybe a
f k
k (Bin Size
sx k
kx a
x Map k a
l Map k a
r) =
          case k -> k -> Ordering
forall a. Ord a => a -> a -> Ordering
compare k
k k
kx of
               Ordering
LT -> let !(Maybe a
found :*: Map k a
l') = (k -> a -> Maybe a)
-> k -> Map k a -> StrictPair (Maybe a) (Map k a)
forall k a.
Ord k =>
(k -> a -> Maybe a)
-> k -> Map k a -> StrictPair (Maybe a) (Map k a)
go k -> a -> Maybe a
f k
k Map k a
l
                         !t' :: Map k a
t' = k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceR k
kx a
x Map k a
l' Map k a
r
                     in (Maybe a
found Maybe a -> Map k a -> StrictPair (Maybe a) (Map k a)
forall a b. a -> b -> StrictPair a b
:*: Map k a
t')
               Ordering
GT -> let !(Maybe a
found :*: Map k a
r') = (k -> a -> Maybe a)
-> k -> Map k a -> StrictPair (Maybe a) (Map k a)
forall k a.
Ord k =>
(k -> a -> Maybe a)
-> k -> Map k a -> StrictPair (Maybe a) (Map k a)
go k -> a -> Maybe a
f k
k Map k a
r
                         !t' :: Map k a
t' = k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceL k
kx a
x Map k a
l Map k a
r'
                     in (Maybe a
found Maybe a -> Map k a -> StrictPair (Maybe a) (Map k a)
forall a b. a -> b -> StrictPair a b
:*: Map k a
t')
               Ordering
EQ -> case k -> a -> Maybe a
f k
kx a
x of
                       Just a
x' -> (a -> Maybe a
forall a. a -> Maybe a
Just a
x' Maybe a -> Map k a -> StrictPair (Maybe a) (Map k a)
forall a b. a -> b -> StrictPair a b
:*: Size -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Size -> k -> a -> Map k a -> Map k a -> Map k a
Bin Size
sx k
kx a
x' Map k a
l Map k a
r)
                       Maybe a
Nothing -> let !glued :: Map k a
glued = Map k a -> Map k a -> Map k a
forall k a. Map k a -> Map k a -> Map k a
glue Map k a
l Map k a
r
                                  in (a -> Maybe a
forall a. a -> Maybe a
Just a
x Maybe a -> Map k a -> StrictPair (Maybe a) (Map k a)
forall a b. a -> b -> StrictPair a b
:*: Map k a
glued)
#if __GLASGOW_HASKELL__
{-# INLINABLE updateLookupWithKey #-}
#else
{-# INLINE updateLookupWithKey #-}
#endif

-- | \(O(\log n)\). The expression (@'alter' f k map@) alters the value @x@ at @k@, or absence thereof.
-- 'alter' can be used to insert, delete, or update a value in a 'Map'.
-- In short : @'lookup' k ('alter' f k m) = f ('lookup' k m)@.
--
-- > let f _ = Nothing
-- > alter f 7 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "a")]
-- > alter f 5 (fromList [(5,"a"), (3,"b")]) == singleton 3 "b"
-- >
-- > let f _ = Just "c"
-- > alter f 7 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "a"), (7, "c")]
-- > alter f 5 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "c")]
--
-- Note that @'adjust' = alter . fmap@.

-- See Note: Type of local 'go' function
alter :: Ord k => (Maybe a -> Maybe a) -> k -> Map k a -> Map k a
alter :: forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
alter = (Maybe a -> Maybe a) -> k -> Map k a -> Map k a
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
go
  where
    go :: Ord k => (Maybe a -> Maybe a) -> k -> Map k a -> Map k a
    go :: forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
go Maybe a -> Maybe a
f !k
k Map k a
Tip = case Maybe a -> Maybe a
f Maybe a
forall a. Maybe a
Nothing of
               Maybe a
Nothing -> Map k a
forall k a. Map k a
Tip
               Just a
x  -> k -> a -> Map k a
forall k a. k -> a -> Map k a
singleton k
k a
x

    go Maybe a -> Maybe a
f k
k (Bin Size
sx k
kx a
x Map k a
l Map k a
r) = case k -> k -> Ordering
forall a. Ord a => a -> a -> Ordering
compare k
k k
kx of
               Ordering
LT -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
balance k
kx a
x ((Maybe a -> Maybe a) -> k -> Map k a -> Map k a
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
go Maybe a -> Maybe a
f k
k Map k a
l) Map k a
r
               Ordering
GT -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
balance k
kx a
x Map k a
l ((Maybe a -> Maybe a) -> k -> Map k a -> Map k a
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
go Maybe a -> Maybe a
f k
k Map k a
r)
               Ordering
EQ -> case Maybe a -> Maybe a
f (a -> Maybe a
forall a. a -> Maybe a
Just a
x) of
                       Just a
x' -> Size -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Size -> k -> a -> Map k a -> Map k a -> Map k a
Bin Size
sx k
kx a
x' Map k a
l Map k a
r
                       Maybe a
Nothing -> Map k a -> Map k a -> Map k a
forall k a. Map k a -> Map k a -> Map k a
glue Map k a
l Map k a
r
#if __GLASGOW_HASKELL__
{-# INLINABLE alter #-}
#else
{-# INLINE alter #-}
#endif

-- Used to choose the appropriate alterF implementation.
data AreWeStrict = Strict | Lazy

-- | \(O(\log n)\). The expression (@'alterF' f k map@) alters the value @x@ at
-- @k@, or absence thereof.  'alterF' can be used to inspect, insert, delete,
-- or update a value in a 'Map'.  In short: @'lookup' k \<$\> 'alterF' f k m = f
-- ('lookup' k m)@.
--
-- Example:
--
-- @
-- interactiveAlter :: Int -> Map Int String -> IO (Map Int String)
-- interactiveAlter k m = alterF f k m where
--   f Nothing = do
--      putStrLn $ show k ++
--          " was not found in the map. Would you like to add it?"
--      getUserResponse1 :: IO (Maybe String)
--   f (Just old) = do
--      putStrLn $ "The key is currently bound to " ++ show old ++
--          ". Would you like to change or delete it?"
--      getUserResponse2 :: IO (Maybe String)
-- @
--
-- 'alterF' is the most general operation for working with an individual
-- key that may or may not be in a given map. When used with trivial
-- functors like 'Identity' and 'Const', it is often slightly slower than
-- more specialized combinators like 'lookup' and 'insert'. However, when
-- the functor is non-trivial and key comparison is not particularly cheap,
-- it is the fastest way.
--
-- Note on rewrite rules:
--
-- This module includes GHC rewrite rules to optimize 'alterF' for
-- the 'Const' and 'Identity' functors. In general, these rules
-- improve performance. The sole exception is that when using
-- 'Identity', deleting a key that is already absent takes longer
-- than it would without the rules. If you expect this to occur
-- a very large fraction of the time, you might consider using a
-- private copy of the 'Identity' type.
--
-- Note: 'alterF' is a flipped version of the @at@ combinator from
-- @Control.Lens.At@.
--
-- @since 0.5.8
alterF :: (Functor f, Ord k)
       => (Maybe a -> f (Maybe a)) -> k -> Map k a -> f (Map k a)
alterF :: forall (f :: * -> *) k a.
(Functor f, Ord k) =>
(Maybe a -> f (Maybe a)) -> k -> Map k a -> f (Map k a)
alterF Maybe a -> f (Maybe a)
f k
k Map k a
m = AreWeStrict
-> k -> (Maybe a -> f (Maybe a)) -> Map k a -> f (Map k a)
forall (f :: * -> *) k a.
(Functor f, Ord k) =>
AreWeStrict
-> k -> (Maybe a -> f (Maybe a)) -> Map k a -> f (Map k a)
atKeyImpl AreWeStrict
Lazy k
k Maybe a -> f (Maybe a)
f Map k a
m

#ifndef __GLASGOW_HASKELL__
{-# INLINE alterF #-}
#else
{-# INLINABLE [2] alterF #-}

-- We can save a little time by recognizing the special case of
-- `Control.Applicative.Const` and just doing a lookup.
{-# RULES
"alterF/Const" forall k (f :: Maybe a -> Const b (Maybe a)) . alterF f k = \m -> Const . getConst . f $ lookup k m
 #-}

-- base 4.8 and above include Data.Functor.Identity, so we can
-- save a pretty decent amount of time by handling it specially.
{-# RULES
"alterF/Identity" forall k f . alterF f k = atKeyIdentity k f
 #-}
#endif

atKeyImpl :: (Functor f, Ord k) =>
      AreWeStrict -> k -> (Maybe a -> f (Maybe a)) -> Map k a -> f (Map k a)
#ifdef DEFINE_ALTERF_FALLBACK
atKeyImpl strict !k f m
-- It doesn't seem sensible to worry about overflowing the queue
-- if the word size is 61 or more. If I calculate it correctly,
-- that would take a map with nearly a quadrillion entries.
  | wordSize < 61 && size m >= alterFCutoff = alterFFallback strict k f m
#endif
atKeyImpl :: forall (f :: * -> *) k a.
(Functor f, Ord k) =>
AreWeStrict
-> k -> (Maybe a -> f (Maybe a)) -> Map k a -> f (Map k a)
atKeyImpl AreWeStrict
strict !k
k Maybe a -> f (Maybe a)
f Map k a
m = case k -> Map k a -> TraceResult a
forall k a. Ord k => k -> Map k a -> TraceResult a
lookupTrace k
k Map k a
m of
  TraceResult Maybe a
mv BitQueue
q -> ((Maybe a -> Map k a) -> f (Maybe a) -> f (Map k a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe a -> f (Maybe a)
f Maybe a
mv) ((Maybe a -> Map k a) -> f (Map k a))
-> (Maybe a -> Map k a) -> f (Map k a)
forall a b. (a -> b) -> a -> b
$ \ Maybe a
fres ->
    case Maybe a
fres of
      Maybe a
Nothing -> case Maybe a
mv of
                   Maybe a
Nothing -> Map k a
m
                   Just a
old -> a -> BitQueue -> Map k a -> Map k a
forall any k a. any -> BitQueue -> Map k a -> Map k a
deleteAlong a
old BitQueue
q Map k a
m
      Just a
new -> case AreWeStrict
strict of
         AreWeStrict
Strict -> a
new a -> Map k a -> Map k a
forall a b. a -> b -> b
`seq` case Maybe a
mv of
                      Maybe a
Nothing -> BitQueue -> k -> a -> Map k a -> Map k a
forall k a. BitQueue -> k -> a -> Map k a -> Map k a
insertAlong BitQueue
q k
k a
new Map k a
m
                      Just a
_ -> BitQueue -> a -> Map k a -> Map k a
forall a k. BitQueue -> a -> Map k a -> Map k a
replaceAlong BitQueue
q a
new Map k a
m
         AreWeStrict
Lazy -> case Maybe a
mv of
                      Maybe a
Nothing -> BitQueue -> k -> a -> Map k a -> Map k a
forall k a. BitQueue -> k -> a -> Map k a -> Map k a
insertAlong BitQueue
q k
k a
new Map k a
m
                      Just a
_ -> BitQueue -> a -> Map k a -> Map k a
forall a k. BitQueue -> a -> Map k a -> Map k a
replaceAlong BitQueue
q a
new Map k a
m

{-# INLINE atKeyImpl #-}

#ifdef DEFINE_ALTERF_FALLBACK
alterFCutoff :: Int
#if WORD_SIZE_IN_BITS == 32
alterFCutoff = 55744454
#else
alterFCutoff = case wordSize of
      30 -> 17637893
      31 -> 31356255
      32 -> 55744454
      x -> (4^(x*2-2)) `quot` (3^(x*2-2))  -- Unlikely
#endif
#endif

data TraceResult a = TraceResult (Maybe a) {-# UNPACK #-} !BitQueue

-- Look up a key and return a result indicating whether it was found
-- and what path was taken.
lookupTrace :: Ord k => k -> Map k a -> TraceResult a
lookupTrace :: forall k a. Ord k => k -> Map k a -> TraceResult a
lookupTrace = BitQueueB -> k -> Map k a -> TraceResult a
forall k a. Ord k => BitQueueB -> k -> Map k a -> TraceResult a
go BitQueueB
emptyQB
  where
    go :: Ord k => BitQueueB -> k -> Map k a -> TraceResult a
    go :: forall k a. Ord k => BitQueueB -> k -> Map k a -> TraceResult a
go !BitQueueB
q !k
_ Map k a
Tip = Maybe a -> BitQueue -> TraceResult a
forall a. Maybe a -> BitQueue -> TraceResult a
TraceResult Maybe a
forall a. Maybe a
Nothing (BitQueueB -> BitQueue
buildQ BitQueueB
q)
    go BitQueueB
q k
k (Bin Size
_ k
kx a
x Map k a
l Map k a
r) = case k -> k -> Ordering
forall a. Ord a => a -> a -> Ordering
compare k
k k
kx of
      Ordering
LT -> (BitQueueB -> k -> Map k a -> TraceResult a
forall k a. Ord k => BitQueueB -> k -> Map k a -> TraceResult a
go (BitQueueB -> k -> Map k a -> TraceResult a)
-> BitQueueB -> k -> Map k a -> TraceResult a
forall a b. (a -> b) -> a -> b
$! BitQueueB
q BitQueueB -> Bool -> BitQueueB
`snocQB` Bool
False) k
k Map k a
l
      Ordering
GT -> (BitQueueB -> k -> Map k a -> TraceResult a
forall k a. Ord k => BitQueueB -> k -> Map k a -> TraceResult a
go (BitQueueB -> k -> Map k a -> TraceResult a)
-> BitQueueB -> k -> Map k a -> TraceResult a
forall a b. (a -> b) -> a -> b
$! BitQueueB
q BitQueueB -> Bool -> BitQueueB
`snocQB` Bool
True) k
k Map k a
r
      Ordering
EQ -> Maybe a -> BitQueue -> TraceResult a
forall a. Maybe a -> BitQueue -> TraceResult a
TraceResult (a -> Maybe a
forall a. a -> Maybe a
Just a
x) (BitQueueB -> BitQueue
buildQ BitQueueB
q)

#ifdef __GLASGOW_HASKELL__
{-# INLINABLE lookupTrace #-}
#else
{-# INLINE lookupTrace #-}
#endif

-- Insert at a location (which will always be a leaf)
-- described by the path passed in.
insertAlong :: BitQueue -> k -> a -> Map k a -> Map k a
insertAlong :: forall k a. BitQueue -> k -> a -> Map k a -> Map k a
insertAlong !BitQueue
_ k
kx a
x Map k a
Tip = k -> a -> Map k a
forall k a. k -> a -> Map k a
singleton k
kx a
x
insertAlong BitQueue
q k
kx a
x (Bin Size
sz k
ky a
y Map k a
l Map k a
r) =
  case BitQueue -> Maybe (Bool, BitQueue)
unconsQ BitQueue
q of
        Just (Bool
False, BitQueue
tl) -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceL k
ky a
y (BitQueue -> k -> a -> Map k a -> Map k a
forall k a. BitQueue -> k -> a -> Map k a -> Map k a
insertAlong BitQueue
tl k
kx a
x Map k a
l) Map k a
r
        Just (Bool
True,BitQueue
tl) -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceR k
ky a
y Map k a
l (BitQueue -> k -> a -> Map k a -> Map k a
forall k a. BitQueue -> k -> a -> Map k a -> Map k a
insertAlong BitQueue
tl k
kx a
x Map k a
r)
        Maybe (Bool, BitQueue)
Nothing -> Size -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Size -> k -> a -> Map k a -> Map k a -> Map k a
Bin Size
sz k
kx a
x Map k a
l Map k a
r  -- Shouldn't happen

-- Delete from a location (which will always be a node)
-- described by the path passed in.
--
-- This is fairly horrifying! We don't actually have any
-- use for the old value we're deleting. But if GHC sees
-- that, then it will allocate a thunk representing the
-- Map with the key deleted before we have any reason to
-- believe we'll actually want that. This transformation
-- enhances sharing, but we don't care enough about that.
-- So deleteAlong needs to take the old value, and we need
-- to convince GHC somehow that it actually uses it. We
-- can't NOINLINE deleteAlong, because that would prevent
-- the BitQueue from being unboxed. So instead we pass the
-- old value to a NOINLINE constant function and then
-- convince GHC that we use the result throughout the
-- computation. Doing the obvious thing and just passing
-- the value itself through the recursion costs 3-4% time,
-- so instead we convert the value to a magical zero-width
-- proxy that's ultimately erased.
deleteAlong :: any -> BitQueue -> Map k a -> Map k a
deleteAlong :: forall any k a. any -> BitQueue -> Map k a -> Map k a
deleteAlong any
old !BitQueue
q0 !Map k a
m = Proxy# () -> BitQueue -> Map k a -> Map k a
forall k a. Proxy# () -> BitQueue -> Map k a -> Map k a
go (any -> Proxy# ()
forall a. a -> Proxy# ()
bogus any
old) BitQueue
q0 Map k a
m where
#ifdef USE_MAGIC_PROXY
  go :: Proxy# () -> BitQueue -> Map k a -> Map k a
#else
  go :: any -> BitQueue -> Map k a -> Map k a
#endif
  go :: forall k a. Proxy# () -> BitQueue -> Map k a -> Map k a
go !Proxy# ()
_ !BitQueue
_ Map k a
Tip = Map k a
forall k a. Map k a
Tip
  go Proxy# ()
foom BitQueue
q (Bin Size
_ k
ky a
y Map k a
l Map k a
r) =
      case BitQueue -> Maybe (Bool, BitQueue)
unconsQ BitQueue
q of
        Just (Bool
False, BitQueue
tl) -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceR k
ky a
y (Proxy# () -> BitQueue -> Map k a -> Map k a
forall k a. Proxy# () -> BitQueue -> Map k a -> Map k a
go Proxy# ()
foom BitQueue
tl Map k a
l) Map k a
r
        Just (Bool
True, BitQueue
tl) -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceL k
ky a
y Map k a
l (Proxy# () -> BitQueue -> Map k a -> Map k a
forall k a. Proxy# () -> BitQueue -> Map k a -> Map k a
go Proxy# ()
foom BitQueue
tl Map k a
r)
        Maybe (Bool, BitQueue)
Nothing -> Map k a -> Map k a -> Map k a
forall k a. Map k a -> Map k a -> Map k a
glue Map k a
l Map k a
r

#ifdef USE_MAGIC_PROXY
{-# NOINLINE bogus #-}
bogus :: a -> Proxy# ()
bogus :: forall a. a -> Proxy# ()
bogus a
_ = Proxy# ()
forall {k} (a :: k). Proxy# a
proxy#
#else
-- No point hiding in this case.
{-# INLINE bogus #-}
bogus :: a -> a
bogus a = a
#endif

-- Replace the value found in the node described
-- by the given path with a new one.
replaceAlong :: BitQueue -> a -> Map k a -> Map k a
replaceAlong :: forall a k. BitQueue -> a -> Map k a -> Map k a
replaceAlong !BitQueue
_ a
_ Map k a
Tip = Map k a
forall k a. Map k a
Tip -- Should not happen
replaceAlong BitQueue
q  a
x (Bin Size
sz k
ky a
y Map k a
l Map k a
r) =
      case BitQueue -> Maybe (Bool, BitQueue)
unconsQ BitQueue
q of
        Just (Bool
False, BitQueue
tl) -> Size -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Size -> k -> a -> Map k a -> Map k a -> Map k a
Bin Size
sz k
ky a
y (BitQueue -> a -> Map k a -> Map k a
forall a k. BitQueue -> a -> Map k a -> Map k a
replaceAlong BitQueue
tl a
x Map k a
l) Map k a
r
        Just (Bool
True,BitQueue
tl) -> Size -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Size -> k -> a -> Map k a -> Map k a -> Map k a
Bin Size
sz k
ky a
y Map k a
l (BitQueue -> a -> Map k a -> Map k a
forall a k. BitQueue -> a -> Map k a -> Map k a
replaceAlong BitQueue
tl a
x Map k a
r)
        Maybe (Bool, BitQueue)
Nothing -> Size -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Size -> k -> a -> Map k a -> Map k a -> Map k a
Bin Size
sz k
ky a
x Map k a
l Map k a
r

#ifdef __GLASGOW_HASKELL__
atKeyIdentity :: Ord k => k -> (Maybe a -> Identity (Maybe a)) -> Map k a -> Identity (Map k a)
atKeyIdentity :: forall k a.
Ord k =>
k
-> (Maybe a -> Identity (Maybe a)) -> Map k a -> Identity (Map k a)
atKeyIdentity k
k Maybe a -> Identity (Maybe a)
f Map k a
t = Map k a -> Identity (Map k a)
forall a. a -> Identity a
Identity (Map k a -> Identity (Map k a)) -> Map k a -> Identity (Map k a)
forall a b. (a -> b) -> a -> b
$ AreWeStrict -> k -> (Maybe a -> Maybe a) -> Map k a -> Map k a
forall k a.
Ord k =>
AreWeStrict -> k -> (Maybe a -> Maybe a) -> Map k a -> Map k a
atKeyPlain AreWeStrict
Lazy k
k ((Maybe a -> Identity (Maybe a)) -> Maybe a -> Maybe a
forall a b. Coercible a b => a -> b
coerce Maybe a -> Identity (Maybe a)
f) Map k a
t
{-# INLINABLE atKeyIdentity #-}

atKeyPlain :: Ord k => AreWeStrict -> k -> (Maybe a -> Maybe a) -> Map k a -> Map k a
atKeyPlain :: forall k a.
Ord k =>
AreWeStrict -> k -> (Maybe a -> Maybe a) -> Map k a -> Map k a
atKeyPlain AreWeStrict
strict k
k0 Maybe a -> Maybe a
f0 Map k a
t = case k -> (Maybe a -> Maybe a) -> Map k a -> Altered k a
forall k a.
Ord k =>
k -> (Maybe a -> Maybe a) -> Map k a -> Altered k a
go k
k0 Maybe a -> Maybe a
f0 Map k a
t of
    AltSmaller Map k a
t' -> Map k a
t'
    AltBigger Map k a
t' -> Map k a
t'
    AltAdj Map k a
t' -> Map k a
t'
    Altered k a
AltSame -> Map k a
t
  where
    go :: Ord k => k -> (Maybe a -> Maybe a) -> Map k a -> Altered k a
    go :: forall k a.
Ord k =>
k -> (Maybe a -> Maybe a) -> Map k a -> Altered k a
go !k
k Maybe a -> Maybe a
f Map k a
Tip = case Maybe a -> Maybe a
f Maybe a
forall a. Maybe a
Nothing of
                   Maybe a
Nothing -> Altered k a
forall k a. Altered k a
AltSame
                   Just a
x  -> case AreWeStrict
strict of
                     AreWeStrict
Lazy -> Map k a -> Altered k a
forall k a. Map k a -> Altered k a
AltBigger (Map k a -> Altered k a) -> Map k a -> Altered k a
forall a b. (a -> b) -> a -> b
$ k -> a -> Map k a
forall k a. k -> a -> Map k a
singleton k
k a
x
                     AreWeStrict
Strict -> a
x a -> Altered k a -> Altered k a
forall a b. a -> b -> b
`seq` (Map k a -> Altered k a
forall k a. Map k a -> Altered k a
AltBigger (Map k a -> Altered k a) -> Map k a -> Altered k a
forall a b. (a -> b) -> a -> b
$ k -> a -> Map k a
forall k a. k -> a -> Map k a
singleton k
k a
x)

    go k
k Maybe a -> Maybe a
f (Bin Size
sx k
kx a
x Map k a
l Map k a
r) = case k -> k -> Ordering
forall a. Ord a => a -> a -> Ordering
compare k
k k
kx of
                   Ordering
LT -> case k -> (Maybe a -> Maybe a) -> Map k a -> Altered k a
forall k a.
Ord k =>
k -> (Maybe a -> Maybe a) -> Map k a -> Altered k a
go k
k Maybe a -> Maybe a
f Map k a
l of
                           AltSmaller Map k a
l' -> Map k a -> Altered k a
forall k a. Map k a -> Altered k a
AltSmaller (Map k a -> Altered k a) -> Map k a -> Altered k a
forall a b. (a -> b) -> a -> b
$ k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceR k
kx a
x Map k a
l' Map k a
r
                           AltBigger Map k a
l' -> Map k a -> Altered k a
forall k a. Map k a -> Altered k a
AltBigger (Map k a -> Altered k a) -> Map k a -> Altered k a
forall a b. (a -> b) -> a -> b
$ k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceL k
kx a
x Map k a
l' Map k a
r
                           AltAdj Map k a
l' -> Map k a -> Altered k a
forall k a. Map k a -> Altered k a
AltAdj (Map k a -> Altered k a) -> Map k a -> Altered k a
forall a b. (a -> b) -> a -> b
$ Size -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Size -> k -> a -> Map k a -> Map k a -> Map k a
Bin Size
sx k
kx a
x Map k a
l' Map k a
r
                           Altered k a
AltSame -> Altered k a
forall k a. Altered k a
AltSame
                   Ordering
GT -> case k -> (Maybe a -> Maybe a) -> Map k a -> Altered k a
forall k a.
Ord k =>
k -> (Maybe a -> Maybe a) -> Map k a -> Altered k a
go k
k Maybe a -> Maybe a
f Map k a
r of
                           AltSmaller Map k a
r' -> Map k a -> Altered k a
forall k a. Map k a -> Altered k a
AltSmaller (Map k a -> Altered k a) -> Map k a -> Altered k a
forall a b. (a -> b) -> a -> b
$ k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceL k
kx a
x Map k a
l Map k a
r'
                           AltBigger Map k a
r' -> Map k a -> Altered k a
forall k a. Map k a -> Altered k a
AltBigger (Map k a -> Altered k a) -> Map k a -> Altered k a
forall a b. (a -> b) -> a -> b
$ k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceR k
kx a
x Map k a
l Map k a
r'
                           AltAdj Map k a
r' -> Map k a -> Altered k a
forall k a. Map k a -> Altered k a
AltAdj (Map k a -> Altered k a) -> Map k a -> Altered k a
forall a b. (a -> b) -> a -> b
$ Size -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Size -> k -> a -> Map k a -> Map k a -> Map k a
Bin Size
sx k
kx a
x Map k a
l Map k a
r'
                           Altered k a
AltSame -> Altered k a
forall k a. Altered k a
AltSame
                   Ordering
EQ -> case Maybe a -> Maybe a
f (a -> Maybe a
forall a. a -> Maybe a
Just a
x) of
                           Just a
x' -> case AreWeStrict
strict of
                             AreWeStrict
Lazy -> Map k a -> Altered k a
forall k a. Map k a -> Altered k a
AltAdj (Map k a -> Altered k a) -> Map k a -> Altered k a
forall a b. (a -> b) -> a -> b
$ Size -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Size -> k -> a -> Map k a -> Map k a -> Map k a
Bin Size
sx k
kx a
x' Map k a
l Map k a
r
                             AreWeStrict
Strict -> a
x' a -> Altered k a -> Altered k a
forall a b. a -> b -> b
`seq` (Map k a -> Altered k a
forall k a. Map k a -> Altered k a
AltAdj (Map k a -> Altered k a) -> Map k a -> Altered k a
forall a b. (a -> b) -> a -> b
$ Size -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Size -> k -> a -> Map k a -> Map k a -> Map k a
Bin Size
sx k
kx a
x' Map k a
l Map k a
r)
                           Maybe a
Nothing -> Map k a -> Altered k a
forall k a. Map k a -> Altered k a
AltSmaller (Map k a -> Altered k a) -> Map k a -> Altered k a
forall a b. (a -> b) -> a -> b
$ Map k a -> Map k a -> Map k a
forall k a. Map k a -> Map k a -> Map k a
glue Map k a
l Map k a
r
{-# INLINE atKeyPlain #-}

data Altered k a = AltSmaller !(Map k a) | AltBigger !(Map k a) | AltAdj !(Map k a) | AltSame
#endif

#ifdef DEFINE_ALTERF_FALLBACK
-- When the map is too large to use a bit queue, we fall back to
-- this much slower version which uses a more "natural" implementation
-- improved with Yoneda to avoid repeated fmaps. This works okayish for
-- some operations, but it's pretty lousy for lookups.
alterFFallback :: (Functor f, Ord k)
   => AreWeStrict -> k -> (Maybe a -> f (Maybe a)) -> Map k a -> f (Map k a)
alterFFallback Lazy k f t = alterFYoneda k (\m q -> q <$> f m) t id
alterFFallback Strict k f t = alterFYoneda k (\m q -> q . forceMaybe <$> f m) t id
  where
    forceMaybe Nothing = Nothing
    forceMaybe may@(Just !_) = may
{-# NOINLINE alterFFallback #-}

alterFYoneda :: Ord k =>
      k -> (Maybe a -> (Maybe a -> b) -> f b) -> Map k a -> (Map k a -> b) -> f b
alterFYoneda = go
  where
    go :: Ord k =>
      k -> (Maybe a -> (Maybe a -> b) -> f b) -> Map k a -> (Map k a -> b) -> f b
    go !k f Tip g = f Nothing $ \ mx -> case mx of
      Nothing -> g Tip
      Just x -> g (singleton k x)
    go k f (Bin sx kx x l r) g = case compare k kx of
               LT -> go k f l (\m -> g (balance kx x m r))
               GT -> go k f r (\m -> g (balance kx x l m))
               EQ -> f (Just x) $ \ mx' -> case mx' of
                       Just x' -> g (Bin sx kx x' l r)
                       Nothing -> g (glue l r)
{-# INLINE alterFYoneda #-}
#endif

{--------------------------------------------------------------------
  Indexing
--------------------------------------------------------------------}
-- | \(O(\log n)\). Return the /index/ of a key, which is its zero-based index in
-- the sequence sorted by keys. The index is a number from /0/ up to, but not
-- including, the 'size' of the map. Calls 'error' when the key is not
-- a 'member' of the map.
--
-- > findIndex 2 (fromList [(5,"a"), (3,"b")])    Error: element is not in the map
-- > findIndex 3 (fromList [(5,"a"), (3,"b")]) == 0
-- > findIndex 5 (fromList [(5,"a"), (3,"b")]) == 1
-- > findIndex 6 (fromList [(5,"a"), (3,"b")])    Error: element is not in the map

-- See Note: Type of local 'go' function
findIndex :: Ord k => k -> Map k a -> Int
findIndex :: forall k a. Ord k => k -> Map k a -> Size
findIndex = Size -> k -> Map k a -> Size
forall k a. Ord k => Size -> k -> Map k a -> Size
go Size
0
  where
    go :: Ord k => Int -> k -> Map k a -> Int
    go :: forall k a. Ord k => Size -> k -> Map k a -> Size
go !Size
_   !k
_ Map k a
Tip  = [Char] -> Size
forall a. HasCallStack => [Char] -> a
error [Char]
"Map.findIndex: element is not in the map"
    go Size
idx k
k (Bin Size
_ k
kx a
_ Map k a
l Map k a
r) = case k -> k -> Ordering
forall a. Ord a => a -> a -> Ordering
compare k
k k
kx of
      Ordering
LT -> Size -> k -> Map k a -> Size
forall k a. Ord k => Size -> k -> Map k a -> Size
go Size
idx k
k Map k a
l
      Ordering
GT -> Size -> k -> Map k a -> Size
forall k a. Ord k => Size -> k -> Map k a -> Size
go (Size
idx Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Map k a -> Size
forall k a. Map k a -> Size
size Map k a
l Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Size
1) k
k Map k a
r
      Ordering
EQ -> Size
idx Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Map k a -> Size
forall k a. Map k a -> Size
size Map k a
l
#if __GLASGOW_HASKELL__
{-# INLINABLE findIndex #-}
#endif

-- | \(O(\log n)\). Lookup the /index/ of a key, which is its zero-based index in
-- the sequence sorted by keys. The index is a number from /0/ up to, but not
-- including, the 'size' of the map.
--
-- > isJust (lookupIndex 2 (fromList [(5,"a"), (3,"b")]))   == False
-- > fromJust (lookupIndex 3 (fromList [(5,"a"), (3,"b")])) == 0
-- > fromJust (lookupIndex 5 (fromList [(5,"a"), (3,"b")])) == 1
-- > isJust (lookupIndex 6 (fromList [(5,"a"), (3,"b")]))   == False

-- See Note: Type of local 'go' function
lookupIndex :: Ord k => k -> Map k a -> Maybe Int
lookupIndex :: forall k a. Ord k => k -> Map k a -> Maybe Size
lookupIndex = Size -> k -> Map k a -> Maybe Size
forall k a. Ord k => Size -> k -> Map k a -> Maybe Size
go Size
0
  where
    go :: Ord k => Int -> k -> Map k a -> Maybe Int
    go :: forall k a. Ord k => Size -> k -> Map k a -> Maybe Size
go !Size
_  !k
_ Map k a
Tip  = Maybe Size
forall a. Maybe a
Nothing
    go Size
idx k
k (Bin Size
_ k
kx a
_ Map k a
l Map k a
r) = case k -> k -> Ordering
forall a. Ord a => a -> a -> Ordering
compare k
k k
kx of
      Ordering
LT -> Size -> k -> Map k a -> Maybe Size
forall k a. Ord k => Size -> k -> Map k a -> Maybe Size
go Size
idx k
k Map k a
l
      Ordering
GT -> Size -> k -> Map k a -> Maybe Size
forall k a. Ord k => Size -> k -> Map k a -> Maybe Size
go (Size
idx Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Map k a -> Size
forall k a. Map k a -> Size
size Map k a
l Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Size
1) k
k Map k a
r
      Ordering
EQ -> Size -> Maybe Size
forall a. a -> Maybe a
Just (Size -> Maybe Size) -> Size -> Maybe Size
forall a b. (a -> b) -> a -> b
$! Size
idx Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Map k a -> Size
forall k a. Map k a -> Size
size Map k a
l
#if __GLASGOW_HASKELL__
{-# INLINABLE lookupIndex #-}
#endif

-- | \(O(\log n)\). Retrieve an element by its /index/, i.e. by its zero-based
-- index in the sequence sorted by keys. If the /index/ is out of range (less
-- than zero, greater or equal to 'size' of the map), 'error' is called.
--
-- > elemAt 0 (fromList [(5,"a"), (3,"b")]) == (3,"b")
-- > elemAt 1 (fromList [(5,"a"), (3,"b")]) == (5, "a")
-- > elemAt 2 (fromList [(5,"a"), (3,"b")])    Error: index out of range

elemAt :: Int -> Map k a -> (k,a)
elemAt :: forall k a. Size -> Map k a -> (k, a)
elemAt !Size
_ Map k a
Tip = [Char] -> (k, a)
forall a. HasCallStack => [Char] -> a
error [Char]
"Map.elemAt: index out of range"
elemAt Size
i (Bin Size
_ k
kx a
x Map k a
l Map k a
r)
  = case Size -> Size -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Size
i Size
sizeL of
      Ordering
LT -> Size -> Map k a -> (k, a)
forall k a. Size -> Map k a -> (k, a)
elemAt Size
i Map k a
l
      Ordering
GT -> Size -> Map k a -> (k, a)
forall k a. Size -> Map k a -> (k, a)
elemAt (Size
iSize -> Size -> Size
forall a. Num a => a -> a -> a
-Size
sizeLSize -> Size -> Size
forall a. Num a => a -> a -> a
-Size
1) Map k a
r
      Ordering
EQ -> (k
kx,a
x)
  where
    sizeL :: Size
sizeL = Map k a -> Size
forall k a. Map k a -> Size
size Map k a
l

-- | Take a given number of entries in key order, beginning
-- with the smallest keys.
--
-- @
-- take n = 'fromDistinctAscList' . 'Prelude.take' n . 'toAscList'
-- @
--
-- @since 0.5.8

take :: Int -> Map k a -> Map k a
take :: forall k a. Size -> Map k a -> Map k a
take Size
i Map k a
m | Size
i Size -> Size -> Bool
forall a. Ord a => a -> a -> Bool
>= Map k a -> Size
forall k a. Map k a -> Size
size Map k a
m = Map k a
m
take Size
i0 Map k a
m0 = Size -> Map k a -> Map k a
forall k a. Size -> Map k a -> Map k a
go Size
i0 Map k a
m0
  where
    go :: Size -> Map k a -> Map k a
go Size
i !Map k a
_ | Size
i Size -> Size -> Bool
forall a. Ord a => a -> a -> Bool
<= Size
0 = Map k a
forall k a. Map k a
Tip
    go !Size
_ Map k a
Tip = Map k a
forall k a. Map k a
Tip
    go Size
i (Bin Size
_ k
kx a
x Map k a
l Map k a
r) =
      case Size -> Size -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Size
i Size
sizeL of
        Ordering
LT -> Size -> Map k a -> Map k a
go Size
i Map k a
l
        Ordering
GT -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
link k
kx a
x Map k a
l (Size -> Map k a -> Map k a
go (Size
i Size -> Size -> Size
forall a. Num a => a -> a -> a
- Size
sizeL Size -> Size -> Size
forall a. Num a => a -> a -> a
- Size
1) Map k a
r)
        Ordering
EQ -> Map k a
l
      where sizeL :: Size
sizeL = Map k a -> Size
forall k a. Map k a -> Size
size Map k a
l

-- | Drop a given number of entries in key order, beginning
-- with the smallest keys.
--
-- @
-- drop n = 'fromDistinctAscList' . 'Prelude.drop' n . 'toAscList'
-- @
--
-- @since 0.5.8
drop :: Int -> Map k a -> Map k a
drop :: forall k a. Size -> Map k a -> Map k a
drop Size
i Map k a
m | Size
i Size -> Size -> Bool
forall a. Ord a => a -> a -> Bool
>= Map k a -> Size
forall k a. Map k a -> Size
size Map k a
m = Map k a
forall k a. Map k a
Tip
drop Size
i0 Map k a
m0 = Size -> Map k a -> Map k a
forall k a. Size -> Map k a -> Map k a
go Size
i0 Map k a
m0
  where
    go :: Size -> Map k a -> Map k a
go Size
i Map k a
m | Size
i Size -> Size -> Bool
forall a. Ord a => a -> a -> Bool
<= Size
0 = Map k a
m
    go !Size
_ Map k a
Tip = Map k a
forall k a. Map k a
Tip
    go Size
i (Bin Size
_ k
kx a
x Map k a
l Map k a
r) =
      case Size -> Size -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Size
i Size
sizeL of
        Ordering
LT -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
link k
kx a
x (Size -> Map k a -> Map k a
go Size
i Map k a
l) Map k a
r
        Ordering
GT -> Size -> Map k a -> Map k a
go (Size
i Size -> Size -> Size
forall a. Num a => a -> a -> a
- Size
sizeL Size -> Size -> Size
forall a. Num a => a -> a -> a
- Size
1) Map k a
r
        Ordering
EQ -> k -> a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a
insertMin k
kx a
x Map k a
r
      where sizeL :: Size
sizeL = Map k a -> Size
forall k a. Map k a -> Size
size Map k a
l

-- | \(O(\log n)\). Split a map at a particular index.
--
-- @
-- splitAt !n !xs = ('take' n xs, 'drop' n xs)
-- @
--
-- @since 0.5.8
splitAt :: Int -> Map k a -> (Map k a, Map k a)
splitAt :: forall k a. Size -> Map k a -> (Map k a, Map k a)
splitAt Size
i0 Map k a
m0
  | Size
i0 Size -> Size -> Bool
forall a. Ord a => a -> a -> Bool
>= Map k a -> Size
forall k a. Map k a -> Size
size Map k a
m0 = (Map k a
m0, Map k a
forall k a. Map k a
Tip)
  | Bool
otherwise = StrictPair (Map k a) (Map k a) -> (Map k a, Map k a)
forall a b. StrictPair a b -> (a, b)
toPair (StrictPair (Map k a) (Map k a) -> (Map k a, Map k a))
-> StrictPair (Map k a) (Map k a) -> (Map k a, Map k a)
forall a b. (a -> b) -> a -> b
$ Size -> Map k a -> StrictPair (Map k a) (Map k a)
forall {k} {a}. Size -> Map k a -> StrictPair (Map k a) (Map k a)
go Size
i0 Map k a
m0
  where
    go :: Size -> Map k a -> StrictPair (Map k a) (Map k a)
go Size
i Map k a
m | Size
i Size -> Size -> Bool
forall a. Ord a => a -> a -> Bool
<= Size
0 = Map k a
forall k a. Map k a
Tip Map k a -> Map k a -> StrictPair (Map k a) (Map k a)
forall a b. a -> b -> StrictPair a b
:*: Map k a
m
    go !Size
_ Map k a
Tip = Map k a
forall k a. Map k a
Tip Map k a -> Map k a -> StrictPair (Map k a) (Map k a)
forall a b. a -> b -> StrictPair a b
:*: Map k a
forall k a. Map k a
Tip
    go Size
i (Bin Size
_ k
kx a
x Map k a
l Map k a
r)
      = case Size -> Size -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Size
i Size
sizeL of
          Ordering
LT -> case Size -> Map k a -> StrictPair (Map k a) (Map k a)
go Size
i Map k a
l of
                  Map k a
ll :*: Map k a
lr -> Map k a
ll Map k a -> Map k a -> StrictPair (Map k a) (Map k a)
forall a b. a -> b -> StrictPair a b
:*: k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
link k
kx a
x Map k a
lr Map k a
r
          Ordering
GT -> case Size -> Map k a -> StrictPair (Map k a) (Map k a)
go (Size
i Size -> Size -> Size
forall a. Num a => a -> a -> a
- Size
sizeL Size -> Size -> Size
forall a. Num a => a -> a -> a
- Size
1) Map k a
r of
                  Map k a
rl :*: Map k a
rr -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
link k
kx a
x Map k a
l Map k a
rl Map k a -> Map k a -> StrictPair (Map k a) (Map k a)
forall a b. a -> b -> StrictPair a b
:*: Map k a
rr
          Ordering
EQ -> Map k a
l Map k a -> Map k a -> StrictPair (Map k a) (Map k a)
forall a b. a -> b -> StrictPair a b
:*: k -> a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a
insertMin k
kx a
x Map k a
r
      where sizeL :: Size
sizeL = Map k a -> Size
forall k a. Map k a -> Size
size Map k a
l

-- | \(O(\log n)\). Update the element at /index/, i.e. by its zero-based index in
-- the sequence sorted by keys. If the /index/ is out of range (less than zero,
-- greater or equal to 'size' of the map), 'error' is called.
--
-- > updateAt (\ _ _ -> Just "x") 0    (fromList [(5,"a"), (3,"b")]) == fromList [(3, "x"), (5, "a")]
-- > updateAt (\ _ _ -> Just "x") 1    (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "x")]
-- > updateAt (\ _ _ -> Just "x") 2    (fromList [(5,"a"), (3,"b")])    Error: index out of range
-- > updateAt (\ _ _ -> Just "x") (-1) (fromList [(5,"a"), (3,"b")])    Error: index out of range
-- > updateAt (\_ _  -> Nothing)  0    (fromList [(5,"a"), (3,"b")]) == singleton 5 "a"
-- > updateAt (\_ _  -> Nothing)  1    (fromList [(5,"a"), (3,"b")]) == singleton 3 "b"
-- > updateAt (\_ _  -> Nothing)  2    (fromList [(5,"a"), (3,"b")])    Error: index out of range
-- > updateAt (\_ _  -> Nothing)  (-1) (fromList [(5,"a"), (3,"b")])    Error: index out of range

updateAt :: (k -> a -> Maybe a) -> Int -> Map k a -> Map k a
updateAt :: forall k a. (k -> a -> Maybe a) -> Size -> Map k a -> Map k a
updateAt k -> a -> Maybe a
f !Size
i Map k a
t =
  case Map k a
t of
    Map k a
Tip -> [Char] -> Map k a
forall a. HasCallStack => [Char] -> a
error [Char]
"Map.updateAt: index out of range"
    Bin Size
sx k
kx a
x Map k a
l Map k a
r -> case Size -> Size -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Size
i Size
sizeL of
      Ordering
LT -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceR k
kx a
x ((k -> a -> Maybe a) -> Size -> Map k a -> Map k a
forall k a. (k -> a -> Maybe a) -> Size -> Map k a -> Map k a
updateAt k -> a -> Maybe a
f Size
i Map k a
l) Map k a
r
      Ordering
GT -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceL k
kx a
x Map k a
l ((k -> a -> Maybe a) -> Size -> Map k a -> Map k a
forall k a. (k -> a -> Maybe a) -> Size -> Map k a -> Map k a
updateAt k -> a -> Maybe a
f (Size
iSize -> Size -> Size
forall a. Num a => a -> a -> a
-Size
sizeLSize -> Size -> Size
forall a. Num a => a -> a -> a
-Size
1) Map k a
r)
      Ordering
EQ -> case k -> a -> Maybe a
f k
kx a
x of
              Just a
x' -> Size -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Size -> k -> a -> Map k a -> Map k a -> Map k a
Bin Size
sx k
kx a
x' Map k a
l Map k a
r
              Maybe a
Nothing -> Map k a -> Map k a -> Map k a
forall k a. Map k a -> Map k a -> Map k a
glue Map k a
l Map k a
r
      where
        sizeL :: Size
sizeL = Map k a -> Size
forall k a. Map k a -> Size
size Map k a
l

-- | \(O(\log n)\). Delete the element at /index/, i.e. by its zero-based index in
-- the sequence sorted by keys. If the /index/ is out of range (less than zero,
-- greater or equal to 'size' of the map), 'error' is called.
--
-- > deleteAt 0  (fromList [(5,"a"), (3,"b")]) == singleton 5 "a"
-- > deleteAt 1  (fromList [(5,"a"), (3,"b")]) == singleton 3 "b"
-- > deleteAt 2 (fromList [(5,"a"), (3,"b")])     Error: index out of range
-- > deleteAt (-1) (fromList [(5,"a"), (3,"b")])  Error: index out of range

deleteAt :: Int -> Map k a -> Map k a
deleteAt :: forall k a. Size -> Map k a -> Map k a
deleteAt !Size
i Map k a
t =
  case Map k a
t of
    Map k a
Tip -> [Char] -> Map k a
forall a. HasCallStack => [Char] -> a
error [Char]
"Map.deleteAt: index out of range"
    Bin Size
_ k
kx a
x Map k a
l Map k a
r -> case Size -> Size -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Size
i Size
sizeL of
      Ordering
LT -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceR k
kx a
x (Size -> Map k a -> Map k a
forall k a. Size -> Map k a -> Map k a
deleteAt Size
i Map k a
l) Map k a
r
      Ordering
GT -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceL k
kx a
x Map k a
l (Size -> Map k a -> Map k a
forall k a. Size -> Map k a -> Map k a
deleteAt (Size
iSize -> Size -> Size
forall a. Num a => a -> a -> a
-Size
sizeLSize -> Size -> Size
forall a. Num a => a -> a -> a
-Size
1) Map k a
r)
      Ordering
EQ -> Map k a -> Map k a -> Map k a
forall k a. Map k a -> Map k a -> Map k a
glue Map k a
l Map k a
r
      where
        sizeL :: Size
sizeL = Map k a -> Size
forall k a. Map k a -> Size
size Map k a
l


{--------------------------------------------------------------------
  Minimal, Maximal
--------------------------------------------------------------------}

lookupMinSure :: k -> a -> Map k a -> (k, a)
lookupMinSure :: forall k a. k -> a -> Map k a -> (k, a)
lookupMinSure k
k a
a Map k a
Tip = (k
k, a
a)
lookupMinSure k
_ a
_ (Bin Size
_ k
k a
a Map k a
l Map k a
_) = k -> a -> Map k a -> (k, a)
forall k a. k -> a -> Map k a -> (k, a)
lookupMinSure k
k a
a Map k a
l

-- | \(O(\log n)\). The minimal key of the map. Returns 'Nothing' if the map is empty.
--
-- > lookupMin (fromList [(5,"a"), (3,"b")]) == Just (3,"b")
-- > lookupMin empty = Nothing
--
-- @since 0.5.9

lookupMin :: Map k a -> Maybe (k,a)
lookupMin :: forall k a. Map k a -> Maybe (k, a)
lookupMin Map k a
Tip = Maybe (k, a)
forall a. Maybe a
Nothing
lookupMin (Bin Size
_ k
k a
x Map k a
l Map k a
_) = (k, a) -> Maybe (k, a)
forall a. a -> Maybe a
Just ((k, a) -> Maybe (k, a)) -> (k, a) -> Maybe (k, a)
forall a b. (a -> b) -> a -> b
$! k -> a -> Map k a -> (k, a)
forall k a. k -> a -> Map k a -> (k, a)
lookupMinSure k
k a
x Map k a
l

-- | \(O(\log n)\). The minimal key of the map. Calls 'error' if the map is empty.
--
-- > findMin (fromList [(5,"a"), (3,"b")]) == (3,"b")
-- > findMin empty                            Error: empty map has no minimal element

findMin :: Map k a -> (k,a)
findMin :: forall k a. Map k a -> (k, a)
findMin Map k a
t
  | Just (k, a)
r <- Map k a -> Maybe (k, a)
forall k a. Map k a -> Maybe (k, a)
lookupMin Map k a
t = (k, a)
r
  | Bool
otherwise = [Char] -> (k, a)
forall a. HasCallStack => [Char] -> a
error [Char]
"Map.findMin: empty map has no minimal element"

-- | \(O(\log n)\). The maximal key of the map. Calls 'error' if the map is empty.
--
-- > findMax (fromList [(5,"a"), (3,"b")]) == (5,"a")
-- > findMax empty                            Error: empty map has no maximal element

lookupMaxSure :: k -> a -> Map k a -> (k, a)
lookupMaxSure :: forall k a. k -> a -> Map k a -> (k, a)
lookupMaxSure k
k a
a Map k a
Tip = (k
k, a
a)
lookupMaxSure k
_ a
_ (Bin Size
_ k
k a
a Map k a
_ Map k a
r) = k -> a -> Map k a -> (k, a)
forall k a. k -> a -> Map k a -> (k, a)
lookupMaxSure k
k a
a Map k a
r

-- | \(O(\log n)\). The maximal key of the map. Returns 'Nothing' if the map is empty.
--
-- > lookupMax (fromList [(5,"a"), (3,"b")]) == Just (5,"a")
-- > lookupMax empty = Nothing
--
-- @since 0.5.9

lookupMax :: Map k a -> Maybe (k, a)
lookupMax :: forall k a. Map k a -> Maybe (k, a)
lookupMax Map k a
Tip = Maybe (k, a)
forall a. Maybe a
Nothing
lookupMax (Bin Size
_ k
k a
x Map k a
_ Map k a
r) = (k, a) -> Maybe (k, a)
forall a. a -> Maybe a
Just ((k, a) -> Maybe (k, a)) -> (k, a) -> Maybe (k, a)
forall a b. (a -> b) -> a -> b
$! k -> a -> Map k a -> (k, a)
forall k a. k -> a -> Map k a -> (k, a)
lookupMaxSure k
k a
x Map k a
r

findMax :: Map k a -> (k,a)
findMax :: forall k a. Map k a -> (k, a)
findMax Map k a
t
  | Just (k, a)
r <- Map k a -> Maybe (k, a)
forall k a. Map k a -> Maybe (k, a)
lookupMax Map k a
t = (k, a)
r
  | Bool
otherwise = [Char] -> (k, a)
forall a. HasCallStack => [Char] -> a
error [Char]
"Map.findMax: empty map has no maximal element"

-- | \(O(\log n)\). Delete the minimal key. Returns an empty map if the map is empty.
--
-- > deleteMin (fromList [(5,"a"), (3,"b"), (7,"c")]) == fromList [(5,"a"), (7,"c")]
-- > deleteMin empty == empty

deleteMin :: Map k a -> Map k a
deleteMin :: forall k a. Map k a -> Map k a
deleteMin (Bin Size
_ k
_  a
_ Map k a
Tip Map k a
r)  = Map k a
r
deleteMin (Bin Size
_ k
kx a
x Map k a
l Map k a
r)    = k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceR k
kx a
x (Map k a -> Map k a
forall k a. Map k a -> Map k a
deleteMin Map k a
l) Map k a
r
deleteMin Map k a
Tip                 = Map k a
forall k a. Map k a
Tip

-- | \(O(\log n)\). Delete the maximal key. Returns an empty map if the map is empty.
--
-- > deleteMax (fromList [(5,"a"), (3,"b"), (7,"c")]) == fromList [(3,"b"), (5,"a")]
-- > deleteMax empty == empty

deleteMax :: Map k a -> Map k a
deleteMax :: forall k a. Map k a -> Map k a
deleteMax (Bin Size
_ k
_  a
_ Map k a
l Map k a
Tip)  = Map k a
l
deleteMax (Bin Size
_ k
kx a
x Map k a
l Map k a
r)    = k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceL k
kx a
x Map k a
l (Map k a -> Map k a
forall k a. Map k a -> Map k a
deleteMax Map k a
r)
deleteMax Map k a
Tip                 = Map k a
forall k a. Map k a
Tip

-- | \(O(\log n)\). Update the value at the minimal key.
--
-- > updateMin (\ a -> Just ("X" ++ a)) (fromList [(5,"a"), (3,"b")]) == fromList [(3, "Xb"), (5, "a")]
-- > updateMin (\ _ -> Nothing)         (fromList [(5,"a"), (3,"b")]) == singleton 5 "a"

updateMin :: (a -> Maybe a) -> Map k a -> Map k a
updateMin :: forall a k. (a -> Maybe a) -> Map k a -> Map k a
updateMin a -> Maybe a
f Map k a
m
  = (k -> a -> Maybe a) -> Map k a -> Map k a
forall k a. (k -> a -> Maybe a) -> Map k a -> Map k a
updateMinWithKey (\k
_ a
x -> a -> Maybe a
f a
x) Map k a
m

-- | \(O(\log n)\). Update the value at the maximal key.
--
-- > updateMax (\ a -> Just ("X" ++ a)) (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "Xa")]
-- > updateMax (\ _ -> Nothing)         (fromList [(5,"a"), (3,"b")]) == singleton 3 "b"

updateMax :: (a -> Maybe a) -> Map k a -> Map k a
updateMax :: forall a k. (a -> Maybe a) -> Map k a -> Map k a
updateMax a -> Maybe a
f Map k a
m
  = (k -> a -> Maybe a) -> Map k a -> Map k a
forall k a. (k -> a -> Maybe a) -> Map k a -> Map k a
updateMaxWithKey (\k
_ a
x -> a -> Maybe a
f a
x) Map k a
m


-- | \(O(\log n)\). Update the value at the minimal key.
--
-- > updateMinWithKey (\ k a -> Just ((show k) ++ ":" ++ a)) (fromList [(5,"a"), (3,"b")]) == fromList [(3,"3:b"), (5,"a")]
-- > updateMinWithKey (\ _ _ -> Nothing)                     (fromList [(5,"a"), (3,"b")]) == singleton 5 "a"

updateMinWithKey :: (k -> a -> Maybe a) -> Map k a -> Map k a
updateMinWithKey :: forall k a. (k -> a -> Maybe a) -> Map k a -> Map k a
updateMinWithKey k -> a -> Maybe a
_ Map k a
Tip                 = Map k a
forall k a. Map k a
Tip
updateMinWithKey k -> a -> Maybe a
f (Bin Size
sx k
kx a
x Map k a
Tip Map k a
r) = case k -> a -> Maybe a
f k
kx a
x of
                                           Maybe a
Nothing -> Map k a
r
                                           Just a
x' -> Size -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Size -> k -> a -> Map k a -> Map k a -> Map k a
Bin Size
sx k
kx a
x' Map k a
forall k a. Map k a
Tip Map k a
r
updateMinWithKey k -> a -> Maybe a
f (Bin Size
_ k
kx a
x Map k a
l Map k a
r)    = k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceR k
kx a
x ((k -> a -> Maybe a) -> Map k a -> Map k a
forall k a. (k -> a -> Maybe a) -> Map k a -> Map k a
updateMinWithKey k -> a -> Maybe a
f Map k a
l) Map k a
r

-- | \(O(\log n)\). Update the value at the maximal key.
--
-- > updateMaxWithKey (\ k a -> Just ((show k) ++ ":" ++ a)) (fromList [(5,"a"), (3,"b")]) == fromList [(3,"b"), (5,"5:a")]
-- > updateMaxWithKey (\ _ _ -> Nothing)                     (fromList [(5,"a"), (3,"b")]) == singleton 3 "b"

updateMaxWithKey :: (k -> a -> Maybe a) -> Map k a -> Map k a
updateMaxWithKey :: forall k a. (k -> a -> Maybe a) -> Map k a -> Map k a
updateMaxWithKey k -> a -> Maybe a
_ Map k a
Tip                 = Map k a
forall k a. Map k a
Tip
updateMaxWithKey k -> a -> Maybe a
f (Bin Size
sx k
kx a
x Map k a
l Map k a
Tip) = case k -> a -> Maybe a
f k
kx a
x of
                                           Maybe a
Nothing -> Map k a
l
                                           Just a
x' -> Size -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Size -> k -> a -> Map k a -> Map k a -> Map k a
Bin Size
sx k
kx a
x' Map k a
l Map k a
forall k a. Map k a
Tip
updateMaxWithKey k -> a -> Maybe a
f (Bin Size
_ k
kx a
x Map k a
l Map k a
r)    = k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceL k
kx a
x Map k a
l ((k -> a -> Maybe a) -> Map k a -> Map k a
forall k a. (k -> a -> Maybe a) -> Map k a -> Map k a
updateMaxWithKey k -> a -> Maybe a
f Map k a
r)

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

minViewWithKey :: Map k a -> Maybe ((k,a), Map k a)
minViewWithKey :: forall k a. Map k a -> Maybe ((k, a), Map k a)
minViewWithKey Map k a
Tip = Maybe ((k, a), Map k a)
forall a. Maybe a
Nothing
minViewWithKey (Bin Size
_ k
k a
x Map k a
l Map k a
r) = ((k, a), Map k a) -> Maybe ((k, a), Map k a)
forall a. a -> Maybe a
Just (((k, a), Map k a) -> Maybe ((k, a), Map k a))
-> ((k, a), Map k a) -> Maybe ((k, a), Map k a)
forall a b. (a -> b) -> a -> b
$
  case k -> a -> Map k a -> Map k a -> MinView k a
forall k a. k -> a -> Map k a -> Map k a -> MinView k a
minViewSure k
k a
x Map k a
l Map k a
r of
    MinView k
km a
xm Map k a
t -> ((k
km, a
xm), Map k a
t)
-- We inline this to give GHC the best possible chance of getting
-- rid of the Maybe and pair constructors, as well as the thunk under
-- the Just.
{-# INLINE minViewWithKey #-}

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

maxViewWithKey :: Map k a -> Maybe ((k,a), Map k a)
maxViewWithKey :: forall k a. Map k a -> Maybe ((k, a), Map k a)
maxViewWithKey Map k a
Tip = Maybe ((k, a), Map k a)
forall a. Maybe a
Nothing
maxViewWithKey (Bin Size
_ k
k a
x Map k a
l Map k a
r) = ((k, a), Map k a) -> Maybe ((k, a), Map k a)
forall a. a -> Maybe a
Just (((k, a), Map k a) -> Maybe ((k, a), Map k a))
-> ((k, a), Map k a) -> Maybe ((k, a), Map k a)
forall a b. (a -> b) -> a -> b
$
  case k -> a -> Map k a -> Map k a -> MaxView k a
forall k a. k -> a -> Map k a -> Map k a -> MaxView k a
maxViewSure k
k a
x Map k a
l Map k a
r of
    MaxView k
km a
xm Map k a
t -> ((k
km, a
xm), Map k a
t)
-- See note on inlining at minViewWithKey
{-# INLINE maxViewWithKey #-}

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

minView :: Map k a -> Maybe (a, Map k a)
minView :: forall k a. Map k a -> Maybe (a, Map k a)
minView Map k a
t = case Map k a -> Maybe ((k, a), Map k a)
forall k a. Map k a -> Maybe ((k, a), Map k a)
minViewWithKey Map k a
t of
              Maybe ((k, a), Map k a)
Nothing -> Maybe (a, Map k a)
forall a. Maybe a
Nothing
              Just ~((k
_, a
x), Map k a
t') -> (a, Map k a) -> Maybe (a, Map k a)
forall a. a -> Maybe a
Just (a
x, Map k a
t')

-- | \(O(\log n)\). Retrieves the value associated with maximal key of the
-- map, and the map stripped of that element, or 'Nothing' if passed an
-- empty map.
--
-- > maxView (fromList [(5,"a"), (3,"b")]) == Just ("a", singleton 3 "b")
-- > maxView empty == Nothing

maxView :: Map k a -> Maybe (a, Map k a)
maxView :: forall k a. Map k a -> Maybe (a, Map k a)
maxView Map k a
t = case Map k a -> Maybe ((k, a), Map k a)
forall k a. Map k a -> Maybe ((k, a), Map k a)
maxViewWithKey Map k a
t of
              Maybe ((k, a), Map k a)
Nothing -> Maybe (a, Map k a)
forall a. Maybe a
Nothing
              Just ~((k
_, a
x), Map k a
t') -> (a, Map k a) -> Maybe (a, Map k a)
forall a. a -> Maybe a
Just (a
x, Map k a
t')

{--------------------------------------------------------------------
  Union.
--------------------------------------------------------------------}
-- | The union of a list of maps:
--   (@'unions' == 'Prelude.foldl' 'union' 'empty'@).
--
-- > unions [(fromList [(5, "a"), (3, "b")]), (fromList [(5, "A"), (7, "C")]), (fromList [(5, "A3"), (3, "B3")])]
-- >     == fromList [(3, "b"), (5, "a"), (7, "C")]
-- > unions [(fromList [(5, "A3"), (3, "B3")]), (fromList [(5, "A"), (7, "C")]), (fromList [(5, "a"), (3, "b")])]
-- >     == fromList [(3, "B3"), (5, "A3"), (7, "C")]

unions :: (Foldable f, Ord k) => f (Map k a) -> Map k a
unions :: forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
unions f (Map k a)
ts
  = (Map k a -> Map k a -> Map k a)
-> Map k a -> f (Map k a) -> Map k a
forall b a. (b -> a -> b) -> b -> f a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Foldable.foldl' Map k a -> Map k a -> Map k a
forall k v. Ord k => Map k v -> Map k v -> Map k v
union Map k a
forall k a. Map k a
empty f (Map k a)
ts
#if __GLASGOW_HASKELL__
{-# INLINABLE unions #-}
#endif

-- | The union of a list of maps, with a combining operation:
--   (@'unionsWith' f == 'Prelude.foldl' ('unionWith' f) 'empty'@).
--
-- > unionsWith (++) [(fromList [(5, "a"), (3, "b")]), (fromList [(5, "A"), (7, "C")]), (fromList [(5, "A3"), (3, "B3")])]
-- >     == fromList [(3, "bB3"), (5, "aAA3"), (7, "C")]

unionsWith :: (Foldable f, Ord k) => (a->a->a) -> f (Map k a) -> Map k a
unionsWith :: forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
unionsWith a -> a -> a
f f (Map k a)
ts
  = (Map k a -> Map k a -> Map k a)
-> Map k a -> f (Map k a) -> Map k a
forall b a. (b -> a -> b) -> b -> f a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Foldable.foldl' ((a -> a -> a) -> Map k a -> Map k a -> Map k a
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
unionWith a -> a -> a
f) Map k a
forall k a. Map k a
empty f (Map k a)
ts
#if __GLASGOW_HASKELL__
{-# INLINABLE unionsWith #-}
#endif

-- | \(O\bigl(m \log\bigl(\frac{n+1}{m+1}\bigr)\bigr), \; m \leq n\).
-- The expression (@'union' t1 t2@) takes the left-biased union of @t1@ and @t2@.
-- It prefers @t1@ when duplicate keys are encountered,
-- i.e. (@'union' == 'unionWith' 'const'@).
--
-- > union (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == fromList [(3, "b"), (5, "a"), (7, "C")]

union :: Ord k => Map k a -> Map k a -> Map k a
union :: forall k v. Ord k => Map k v -> Map k v -> Map k v
union Map k a
t1 Map k a
Tip  = Map k a
t1
union Map k a
t1 (Bin Size
_ k
k a
x Map k a
Tip Map k a
Tip) = k -> a -> Map k a -> Map k a
forall k a. Ord k => k -> a -> Map k a -> Map k a
insertR k
k a
x Map k a
t1
union (Bin Size
_ k
k a
x Map k a
Tip Map k a
Tip) Map k a
t2 = k -> a -> Map k a -> Map k a
forall k a. Ord k => k -> a -> Map k a -> Map k a
insert k
k a
x Map k a
t2
union Map k a
Tip Map k a
t2 = Map k a
t2
union t1 :: Map k a
t1@(Bin Size
_ k
k1 a
x1 Map k a
l1 Map k a
r1) Map k a
t2 = case k -> Map k a -> (Map k a, Map k a)
forall k a. Ord k => k -> Map k a -> (Map k a, Map k a)
split k
k1 Map k a
t2 of
  (Map k a
l2, Map k a
r2) | Map k a
l1l2 Map k a -> Map k a -> Bool
forall a. a -> a -> Bool
`ptrEq` Map k a
l1 Bool -> Bool -> Bool
&& Map k a
r1r2 Map k a -> Map k a -> Bool
forall a. a -> a -> Bool
`ptrEq` Map k a
r1 -> Map k a
t1
           | Bool
otherwise -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
link k
k1 a
x1 Map k a
l1l2 Map k a
r1r2
           where !l1l2 :: Map k a
l1l2 = Map k a -> Map k a -> Map k a
forall k v. Ord k => Map k v -> Map k v -> Map k v
union Map k a
l1 Map k a
l2
                 !r1r2 :: Map k a
r1r2 = Map k a -> Map k a -> Map k a
forall k v. Ord k => Map k v -> Map k v -> Map k v
union Map k a
r1 Map k a
r2
#if __GLASGOW_HASKELL__
{-# INLINABLE union #-}
#endif

{--------------------------------------------------------------------
  Union with a combining function
--------------------------------------------------------------------}
-- | \(O\bigl(m \log\bigl(\frac{n+1}{m+1}\bigr)\bigr), \; m \leq n\). Union with a combining function.
--
-- > unionWith (++) (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == fromList [(3, "b"), (5, "aA"), (7, "C")]

unionWith :: Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
-- QuickCheck says pointer equality never happens here.
unionWith :: forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
unionWith a -> a -> a
_f Map k a
t1 Map k a
Tip = Map k a
t1
unionWith a -> a -> a
f Map k a
t1 (Bin Size
_ k
k a
x Map k a
Tip Map k a
Tip) = (a -> a -> a) -> k -> a -> Map k a -> Map k a
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
insertWithR a -> a -> a
f k
k a
x Map k a
t1
unionWith a -> a -> a
f (Bin Size
_ k
k a
x Map k a
Tip Map k a
Tip) Map k a
t2 = (a -> a -> a) -> k -> a -> Map k a -> Map k a
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
insertWith a -> a -> a
f k
k a
x Map k a
t2
unionWith a -> a -> a
_f Map k a
Tip Map k a
t2 = Map k a
t2
unionWith a -> a -> a
f (Bin Size
_ k
k1 a
x1 Map k a
l1 Map k a
r1) Map k a
t2 = case k -> Map k a -> (Map k a, Maybe a, Map k a)
forall k a. Ord k => k -> Map k a -> (Map k a, Maybe a, Map k a)
splitLookup k
k1 Map k a
t2 of
  (Map k a
l2, Maybe a
mb, Map k a
r2) -> case Maybe a
mb of
      Maybe a
Nothing -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
link k
k1 a
x1 Map k a
l1l2 Map k a
r1r2
      Just a
x2 -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
link k
k1 (a -> a -> a
f a
x1 a
x2) Map k a
l1l2 Map k a
r1r2
    where !l1l2 :: Map k a
l1l2 = (a -> a -> a) -> Map k a -> Map k a -> Map k a
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
unionWith a -> a -> a
f Map k a
l1 Map k a
l2
          !r1r2 :: Map k a
r1r2 = (a -> a -> a) -> Map k a -> Map k a -> Map k a
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
unionWith a -> a -> a
f Map k a
r1 Map k a
r2
#if __GLASGOW_HASKELL__
{-# INLINABLE unionWith #-}
#endif

-- | \(O\bigl(m \log\bigl(\frac{n+1}{m+1}\bigr)\bigr), \; m \leq n\).
-- Union with a combining function.
--
-- > let f key left_value right_value = (show key) ++ ":" ++ left_value ++ "|" ++ right_value
-- > unionWithKey f (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == fromList [(3, "b"), (5, "5:a|A"), (7, "C")]

unionWithKey :: Ord k => (k -> a -> a -> a) -> Map k a -> Map k a -> Map k a
unionWithKey :: forall k a.
Ord k =>
(k -> a -> a -> a) -> Map k a -> Map k a -> Map k a
unionWithKey k -> a -> a -> a
_f Map k a
t1 Map k a
Tip = Map k a
t1
unionWithKey k -> a -> a -> a
f Map k a
t1 (Bin Size
_ k
k a
x Map k a
Tip Map k a
Tip) = (k -> a -> a -> a) -> k -> a -> Map k a -> Map k a
forall k a.
Ord k =>
(k -> a -> a -> a) -> k -> a -> Map k a -> Map k a
insertWithKeyR k -> a -> a -> a
f k
k a
x Map k a
t1
unionWithKey k -> a -> a -> a
f (Bin Size
_ k
k a
x Map k a
Tip Map k a
Tip) Map k a
t2 = (k -> a -> a -> a) -> k -> a -> Map k a -> Map k a
forall k a.
Ord k =>
(k -> a -> a -> a) -> k -> a -> Map k a -> Map k a
insertWithKey k -> a -> a -> a
f k
k a
x Map k a
t2
unionWithKey k -> a -> a -> a
_f Map k a
Tip Map k a
t2 = Map k a
t2
unionWithKey k -> a -> a -> a
f (Bin Size
_ k
k1 a
x1 Map k a
l1 Map k a
r1) Map k a
t2 = case k -> Map k a -> (Map k a, Maybe a, Map k a)
forall k a. Ord k => k -> Map k a -> (Map k a, Maybe a, Map k a)
splitLookup k
k1 Map k a
t2 of
  (Map k a
l2, Maybe a
mb, Map k a
r2) -> case Maybe a
mb of
      Maybe a
Nothing -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
link k
k1 a
x1 Map k a
l1l2 Map k a
r1r2
      Just a
x2 -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
link k
k1 (k -> a -> a -> a
f k
k1 a
x1 a
x2) Map k a
l1l2 Map k a
r1r2
    where !l1l2 :: Map k a
l1l2 = (k -> a -> a -> a) -> Map k a -> Map k a -> Map k a
forall k a.
Ord k =>
(k -> a -> a -> a) -> Map k a -> Map k a -> Map k a
unionWithKey k -> a -> a -> a
f Map k a
l1 Map k a
l2
          !r1r2 :: Map k a
r1r2 = (k -> a -> a -> a) -> Map k a -> Map k a -> Map k a
forall k a.
Ord k =>
(k -> a -> a -> a) -> Map k a -> Map k a -> Map k a
unionWithKey k -> a -> a -> a
f Map k a
r1 Map k a
r2
#if __GLASGOW_HASKELL__
{-# INLINABLE unionWithKey #-}
#endif

{--------------------------------------------------------------------
  Difference
--------------------------------------------------------------------}

-- We don't currently attempt to use any pointer equality tricks for
-- 'difference'. To do so, we'd have to match on the first argument
-- and split the second. Unfortunately, the proof of the time bound
-- relies on doing it the way we do, and it's not clear whether that
-- bound holds the other way.

-- | \(O\bigl(m \log\bigl(\frac{n+1}{m+1}\bigr)\bigr), \; m \leq n\). Difference of two maps.
-- Return elements of the first map not existing in the second map.
--
-- > difference (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == singleton 3 "b"

difference :: Ord k => Map k a -> Map k b -> Map k a
difference :: forall k a b. Ord k => Map k a -> Map k b -> Map k a
difference Map k a
Tip Map k b
_   = Map k a
forall k a. Map k a
Tip
difference Map k a
t1 Map k b
Tip  = Map k a
t1
difference Map k a
t1 (Bin Size
_ k
k b
_ Map k b
l2 Map k b
r2) = case k -> Map k a -> (Map k a, Map k a)
forall k a. Ord k => k -> Map k a -> (Map k a, Map k a)
split k
k Map k a
t1 of
  (Map k a
l1, Map k a
r1)
    | Map k a -> Size
forall k a. Map k a -> Size
size Map k a
l1l2 Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Map k a -> Size
forall k a. Map k a -> Size
size Map k a
r1r2 Size -> Size -> Bool
forall a. Eq a => a -> a -> Bool
== Map k a -> Size
forall k a. Map k a -> Size
size Map k a
t1 -> Map k a
t1
    | Bool
otherwise -> Map k a -> Map k a -> Map k a
forall k a. Map k a -> Map k a -> Map k a
link2 Map k a
l1l2 Map k a
r1r2
    where
      !l1l2 :: Map k a
l1l2 = Map k a -> Map k b -> Map k a
forall k a b. Ord k => Map k a -> Map k b -> Map k a
difference Map k a
l1 Map k b
l2
      !r1r2 :: Map k a
r1r2 = Map k a -> Map k b -> Map k a
forall k a b. Ord k => Map k a -> Map k b -> Map k a
difference Map k a
r1 Map k b
r2
#if __GLASGOW_HASKELL__
{-# INLINABLE difference #-}
#endif

-- | \(O\bigl(m \log\bigl(\frac{n+1}{m+1}\bigr)\bigr), \; m \leq n\). Remove all keys in a 'Set' from a 'Map'.
--
-- @
-- m \`withoutKeys\` s = 'filterWithKey' (\k _ -> k ``Set.notMember`` s) m
-- m \`withoutKeys\` s = m ``difference`` 'fromSet' (const ()) s
-- @
--
-- @since 0.5.8

withoutKeys :: Ord k => Map k a -> Set k -> Map k a
withoutKeys :: forall k a. Ord k => Map k a -> Set k -> Map k a
withoutKeys Map k a
Tip Set k
_ = Map k a
forall k a. Map k a
Tip
withoutKeys Map k a
m Set k
Set.Tip = Map k a
m
withoutKeys Map k a
m (Set.Bin Size
_ k
k Set k
ls Set k
rs) = case k -> Map k a -> (Map k a, Bool, Map k a)
forall k a. Ord k => k -> Map k a -> (Map k a, Bool, Map k a)
splitMember k
k Map k a
m of
  (Map k a
lm, Bool
b, Map k a
rm)
     | Bool -> Bool
not Bool
b Bool -> Bool -> Bool
&& Map k a
lm' Map k a -> Map k a -> Bool
forall a. a -> a -> Bool
`ptrEq` Map k a
lm Bool -> Bool -> Bool
&& Map k a
rm' Map k a -> Map k a -> Bool
forall a. a -> a -> Bool
`ptrEq` Map k a
rm -> Map k a
m
     | Bool
otherwise -> Map k a -> Map k a -> Map k a
forall k a. Map k a -> Map k a -> Map k a
link2 Map k a
lm' Map k a
rm'
     where
       !lm' :: Map k a
lm' = Map k a -> Set k -> Map k a
forall k a. Ord k => Map k a -> Set k -> Map k a
withoutKeys Map k a
lm Set k
ls
       !rm' :: Map k a
rm' = Map k a -> Set k -> Map k a
forall k a. Ord k => Map k a -> Set k -> Map k a
withoutKeys Map k a
rm Set k
rs
#if __GLASGOW_HASKELL__
{-# INLINABLE withoutKeys #-}
#endif

-- | \(O(n+m)\). Difference with a combining function.
-- When two equal keys are
-- encountered, the combining function is applied to the values of these keys.
-- If it returns 'Nothing', the element is discarded (proper set difference). If
-- it returns (@'Just' y@), the element is updated with a new value @y@.
--
-- > let f al ar = if al == "b" then Just (al ++ ":" ++ ar) else Nothing
-- > differenceWith f (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (3, "B"), (7, "C")])
-- >     == singleton 3 "b:B"
differenceWith :: Ord k => (a -> b -> Maybe a) -> Map k a -> Map k b -> Map k a
differenceWith :: forall k a b.
Ord k =>
(a -> b -> Maybe a) -> Map k a -> Map k b -> Map k a
differenceWith a -> b -> Maybe a
f = SimpleWhenMissing k a a
-> SimpleWhenMissing k b a
-> SimpleWhenMatched k a b a
-> Map k a
-> Map k b
-> Map k a
forall k a c b.
Ord k =>
SimpleWhenMissing k a c
-> SimpleWhenMissing k b c
-> SimpleWhenMatched k a b c
-> Map k a
-> Map k b
-> Map k c
merge SimpleWhenMissing k a a
forall (f :: * -> *) k x. Applicative f => WhenMissing f k x x
preserveMissing SimpleWhenMissing k b a
forall (f :: * -> *) k x y. Applicative f => WhenMissing f k x y
dropMissing (SimpleWhenMatched k a b a -> Map k a -> Map k b -> Map k a)
-> SimpleWhenMatched k a b a -> Map k a -> Map k b -> Map k a
forall a b. (a -> b) -> a -> b
$
       (k -> a -> b -> Maybe a) -> SimpleWhenMatched k a b a
forall (f :: * -> *) k x y z.
Applicative f =>
(k -> x -> y -> Maybe z) -> WhenMatched f k x y z
zipWithMaybeMatched (\k
_ a
x b
y -> a -> b -> Maybe a
f a
x b
y)
#if __GLASGOW_HASKELL__
{-# INLINABLE differenceWith #-}
#endif

-- | \(O(n+m)\). Difference with a combining function. When two equal keys are
-- encountered, the combining function is applied to the key and both values.
-- If it returns 'Nothing', the element is discarded (proper set difference). If
-- it returns (@'Just' y@), the element is updated with a new value @y@.
--
-- > let f k al ar = if al == "b" then Just ((show k) ++ ":" ++ al ++ "|" ++ ar) else Nothing
-- > differenceWithKey f (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (3, "B"), (10, "C")])
-- >     == singleton 3 "3:b|B"

differenceWithKey :: Ord k => (k -> a -> b -> Maybe a) -> Map k a -> Map k b -> Map k a
differenceWithKey :: forall k a b.
Ord k =>
(k -> a -> b -> Maybe a) -> Map k a -> Map k b -> Map k a
differenceWithKey k -> a -> b -> Maybe a
f =
  SimpleWhenMissing k a a
-> SimpleWhenMissing k b a
-> SimpleWhenMatched k a b a
-> Map k a
-> Map k b
-> Map k a
forall k a c b.
Ord k =>
SimpleWhenMissing k a c
-> SimpleWhenMissing k b c
-> SimpleWhenMatched k a b c
-> Map k a
-> Map k b
-> Map k c
merge SimpleWhenMissing k a a
forall (f :: * -> *) k x. Applicative f => WhenMissing f k x x
preserveMissing SimpleWhenMissing k b a
forall (f :: * -> *) k x y. Applicative f => WhenMissing f k x y
dropMissing ((k -> a -> b -> Maybe a) -> SimpleWhenMatched k a b a
forall (f :: * -> *) k x y z.
Applicative f =>
(k -> x -> y -> Maybe z) -> WhenMatched f k x y z
zipWithMaybeMatched k -> a -> b -> Maybe a
f)
#if __GLASGOW_HASKELL__
{-# INLINABLE differenceWithKey #-}
#endif


{--------------------------------------------------------------------
  Intersection
--------------------------------------------------------------------}
-- | \(O\bigl(m \log\bigl(\frac{n+1}{m+1}\bigr)\bigr), \; m \leq n\). Intersection of two maps.
-- Return data in the first map for the keys existing in both maps.
-- (@'intersection' m1 m2 == 'intersectionWith' 'const' m1 m2@).
--
-- > intersection (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == singleton 5 "a"

intersection :: Ord k => Map k a -> Map k b -> Map k a
intersection :: forall k a b. Ord k => Map k a -> Map k b -> Map k a
intersection Map k a
Tip Map k b
_ = Map k a
forall k a. Map k a
Tip
intersection Map k a
_ Map k b
Tip = Map k a
forall k a. Map k a
Tip
intersection t1 :: Map k a
t1@(Bin Size
_ k
k a
x Map k a
l1 Map k a
r1) Map k b
t2
  | Bool
mb = if Map k a
l1l2 Map k a -> Map k a -> Bool
forall a. a -> a -> Bool
`ptrEq` Map k a
l1 Bool -> Bool -> Bool
&& Map k a
r1r2 Map k a -> Map k a -> Bool
forall a. a -> a -> Bool
`ptrEq` Map k a
r1
         then Map k a
t1
         else k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
link k
k a
x Map k a
l1l2 Map k a
r1r2
  | Bool
otherwise = Map k a -> Map k a -> Map k a
forall k a. Map k a -> Map k a -> Map k a
link2 Map k a
l1l2 Map k a
r1r2
  where
    !(Map k b
l2, Bool
mb, Map k b
r2) = k -> Map k b -> (Map k b, Bool, Map k b)
forall k a. Ord k => k -> Map k a -> (Map k a, Bool, Map k a)
splitMember k
k Map k b
t2
    !l1l2 :: Map k a
l1l2 = Map k a -> Map k b -> Map k a
forall k a b. Ord k => Map k a -> Map k b -> Map k a
intersection Map k a
l1 Map k b
l2
    !r1r2 :: Map k a
r1r2 = Map k a -> Map k b -> Map k a
forall k a b. Ord k => Map k a -> Map k b -> Map k a
intersection Map k a
r1 Map k b
r2
#if __GLASGOW_HASKELL__
{-# INLINABLE intersection #-}
#endif

-- | \(O\bigl(m \log\bigl(\frac{n+1}{m+1}\bigr)\bigr), \; m \leq n\). Restrict a 'Map' to only those keys
-- found in a 'Set'.
--
-- @
-- m \`restrictKeys\` s = 'filterWithKey' (\k _ -> k ``Set.member`` s) m
-- m \`restrictKeys\` s = m ``intersection`` 'fromSet' (const ()) s
-- @
--
-- @since 0.5.8
restrictKeys :: Ord k => Map k a -> Set k -> Map k a
restrictKeys :: forall k a. Ord k => Map k a -> Set k -> Map k a
restrictKeys Map k a
Tip Set k
_ = Map k a
forall k a. Map k a
Tip
restrictKeys Map k a
_ Set k
Set.Tip = Map k a
forall k a. Map k a
Tip
restrictKeys m :: Map k a
m@(Bin Size
_ k
k a
x Map k a
l1 Map k a
r1) Set k
s
  | Bool
b = if Map k a
l1l2 Map k a -> Map k a -> Bool
forall a. a -> a -> Bool
`ptrEq` Map k a
l1 Bool -> Bool -> Bool
&& Map k a
r1r2 Map k a -> Map k a -> Bool
forall a. a -> a -> Bool
`ptrEq` Map k a
r1
        then Map k a
m
        else k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
link k
k a
x Map k a
l1l2 Map k a
r1r2
  | Bool
otherwise = Map k a -> Map k a -> Map k a
forall k a. Map k a -> Map k a -> Map k a
link2 Map k a
l1l2 Map k a
r1r2
  where
    !(Set k
l2, Bool
b, Set k
r2) = k -> Set k -> (Set k, Bool, Set k)
forall a. Ord a => a -> Set a -> (Set a, Bool, Set a)
Set.splitMember k
k Set k
s
    !l1l2 :: Map k a
l1l2 = Map k a -> Set k -> Map k a
forall k a. Ord k => Map k a -> Set k -> Map k a
restrictKeys Map k a
l1 Set k
l2
    !r1r2 :: Map k a
r1r2 = Map k a -> Set k -> Map k a
forall k a. Ord k => Map k a -> Set k -> Map k a
restrictKeys Map k a
r1 Set k
r2
#if __GLASGOW_HASKELL__
{-# INLINABLE restrictKeys #-}
#endif

-- | \(O\bigl(m \log\bigl(\frac{n+1}{m+1}\bigr)\bigr), \; m \leq n\). Intersection with a combining function.
--
-- > intersectionWith (++) (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == singleton 5 "aA"

intersectionWith :: Ord k => (a -> b -> c) -> Map k a -> Map k b -> Map k c
-- We have no hope of pointer equality tricks here because every single
-- element in the result will be a thunk.
intersectionWith :: forall k a b c.
Ord k =>
(a -> b -> c) -> Map k a -> Map k b -> Map k c
intersectionWith a -> b -> c
_f Map k a
Tip Map k b
_ = Map k c
forall k a. Map k a
Tip
intersectionWith a -> b -> c
_f Map k a
_ Map k b
Tip = Map k c
forall k a. Map k a
Tip
intersectionWith a -> b -> c
f (Bin Size
_ k
k a
x1 Map k a
l1 Map k a
r1) Map k b
t2 = case Maybe b
mb of
    Just b
x2 -> k -> c -> Map k c -> Map k c -> Map k c
forall k a. k -> a -> Map k a -> Map k a -> Map k a
link k
k (a -> b -> c
f a
x1 b
x2) Map k c
l1l2 Map k c
r1r2
    Maybe b
Nothing -> Map k c -> Map k c -> Map k c
forall k a. Map k a -> Map k a -> Map k a
link2 Map k c
l1l2 Map k c
r1r2
  where
    !(Map k b
l2, Maybe b
mb, Map k b
r2) = k -> Map k b -> (Map k b, Maybe b, Map k b)
forall k a. Ord k => k -> Map k a -> (Map k a, Maybe a, Map k a)
splitLookup k
k Map k b
t2
    !l1l2 :: Map k c
l1l2 = (a -> b -> c) -> Map k a -> Map k b -> Map k c
forall k a b c.
Ord k =>
(a -> b -> c) -> Map k a -> Map k b -> Map k c
intersectionWith a -> b -> c
f Map k a
l1 Map k b
l2
    !r1r2 :: Map k c
r1r2 = (a -> b -> c) -> Map k a -> Map k b -> Map k c
forall k a b c.
Ord k =>
(a -> b -> c) -> Map k a -> Map k b -> Map k c
intersectionWith a -> b -> c
f Map k a
r1 Map k b
r2
#if __GLASGOW_HASKELL__
{-# INLINABLE intersectionWith #-}
#endif

-- | \(O\bigl(m \log\bigl(\frac{n+1}{m+1}\bigr)\bigr), \; m \leq n\). Intersection with a combining function.
--
-- > let f k al ar = (show k) ++ ":" ++ al ++ "|" ++ ar
-- > intersectionWithKey f (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == singleton 5 "5:a|A"

intersectionWithKey :: Ord k => (k -> a -> b -> c) -> Map k a -> Map k b -> Map k c
intersectionWithKey :: forall k a b c.
Ord k =>
(k -> a -> b -> c) -> Map k a -> Map k b -> Map k c
intersectionWithKey k -> a -> b -> c
_f Map k a
Tip Map k b
_ = Map k c
forall k a. Map k a
Tip
intersectionWithKey k -> a -> b -> c
_f Map k a
_ Map k b
Tip = Map k c
forall k a. Map k a
Tip
intersectionWithKey k -> a -> b -> c
f (Bin Size
_ k
k a
x1 Map k a
l1 Map k a
r1) Map k b
t2 = case Maybe b
mb of
    Just b
x2 -> k -> c -> Map k c -> Map k c -> Map k c
forall k a. k -> a -> Map k a -> Map k a -> Map k a
link k
k (k -> a -> b -> c
f k
k a
x1 b
x2) Map k c
l1l2 Map k c
r1r2
    Maybe b
Nothing -> Map k c -> Map k c -> Map k c
forall k a. Map k a -> Map k a -> Map k a
link2 Map k c
l1l2 Map k c
r1r2
  where
    !(Map k b
l2, Maybe b
mb, Map k b
r2) = k -> Map k b -> (Map k b, Maybe b, Map k b)
forall k a. Ord k => k -> Map k a -> (Map k a, Maybe a, Map k a)
splitLookup k
k Map k b
t2
    !l1l2 :: Map k c
l1l2 = (k -> a -> b -> c) -> Map k a -> Map k b -> Map k c
forall k a b c.
Ord k =>
(k -> a -> b -> c) -> Map k a -> Map k b -> Map k c
intersectionWithKey k -> a -> b -> c
f Map k a
l1 Map k b
l2
    !r1r2 :: Map k c
r1r2 = (k -> a -> b -> c) -> Map k a -> Map k b -> Map k c
forall k a b c.
Ord k =>
(k -> a -> b -> c) -> Map k a -> Map k b -> Map k c
intersectionWithKey k -> a -> b -> c
f Map k a
r1 Map k b
r2
#if __GLASGOW_HASKELL__
{-# INLINABLE intersectionWithKey #-}
#endif

{--------------------------------------------------------------------
  Disjoint
--------------------------------------------------------------------}
-- | \(O\bigl(m \log\bigl(\frac{n+1}{m+1}\bigr)\bigr), \; m \leq n\). Check whether the key sets of two
-- maps are disjoint (i.e., their 'intersection' is empty).
--
-- > disjoint (fromList [(2,'a')]) (fromList [(1,()), (3,())])   == True
-- > disjoint (fromList [(2,'a')]) (fromList [(1,'a'), (2,'b')]) == False
-- > disjoint (fromList [])        (fromList [])                 == True
--
-- @
-- xs ``disjoint`` ys = null (xs ``intersection`` ys)
-- @
--
-- @since 0.6.2.1

-- See 'Data.Set.Internal.isSubsetOfX' for some background
-- on the implementation design.
disjoint :: Ord k => Map k a -> Map k b -> Bool
disjoint :: forall k a b. Ord k => Map k a -> Map k b -> Bool
disjoint Map k a
Tip Map k b
_ = Bool
True
disjoint Map k a
_ Map k b
Tip = Bool
True
disjoint (Bin Size
1 k
k a
_ Map k a
_ Map k a
_) Map k b
t = k
k k -> Map k b -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`notMember` Map k b
t
disjoint (Bin Size
_ k
k a
_ Map k a
l Map k a
r) Map k b
t
  = Bool -> Bool
not Bool
found Bool -> Bool -> Bool
&& Map k a -> Map k b -> Bool
forall k a b. Ord k => Map k a -> Map k b -> Bool
disjoint Map k a
l Map k b
lt Bool -> Bool -> Bool
&& Map k a -> Map k b -> Bool
forall k a b. Ord k => Map k a -> Map k b -> Bool
disjoint Map k a
r Map k b
gt
  where
    (Map k b
lt,Bool
found,Map k b
gt) = k -> Map k b -> (Map k b, Bool, Map k b)
forall k a. Ord k => k -> Map k a -> (Map k a, Bool, Map k a)
splitMember k
k Map k b
t

{--------------------------------------------------------------------
  Compose
--------------------------------------------------------------------}
-- | Relate the keys of one map to the values of
-- the other, by using the values of the former as keys for lookups
-- in the latter.
--
-- Complexity: \( O (n * \log(m)) \), where \(m\) is the size of the first argument
--
-- > compose (fromList [('a', "A"), ('b', "B")]) (fromList [(1,'a'),(2,'b'),(3,'z')]) = fromList [(1,"A"),(2,"B")]
--
-- @
-- ('compose' bc ab '!?') = (bc '!?') <=< (ab '!?')
-- @
--
-- __Note:__ Prior to v0.6.4, "Data.Map.Strict" exposed a version of
-- 'compose' that forced the values of the output 'Map'. This version does not
-- force these values.
--
-- @since 0.6.3.1
compose :: Ord b => Map b c -> Map a b -> Map a c
compose :: forall b c a. Ord b => Map b c -> Map a b -> Map a c
compose Map b c
bc !Map a b
ab
  | Map b c -> Bool
forall k a. Map k a -> Bool
null Map b c
bc = Map a c
forall k a. Map k a
empty
  | Bool
otherwise = (b -> Maybe c) -> Map a b -> Map a c
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
mapMaybe (Map b c
bc Map b c -> b -> Maybe c
forall k a. Ord k => Map k a -> k -> Maybe a
!?) Map a b
ab

-- | A tactic for dealing with keys present in one map but not the other in
-- 'merge' or 'mergeA'.
--
-- A tactic of type @ WhenMissing f k x z @ is an abstract representation
-- of a function of type @ k -> x -> f (Maybe z) @.
--
-- @since 0.5.9

data WhenMissing f k x y = WhenMissing
  { forall (f :: * -> *) k x y.
WhenMissing f k x y -> Map k x -> f (Map k y)
missingSubtree :: Map k x -> f (Map k y)
  , forall (f :: * -> *) k x y.
WhenMissing f k x y -> k -> x -> f (Maybe y)
missingKey :: k -> x -> f (Maybe y)}

-- | @since 0.5.9
instance (Applicative f, Monad f) => Functor (WhenMissing f k x) where
  fmap :: forall a b. (a -> b) -> WhenMissing f k x a -> WhenMissing f k x b
fmap = (a -> b) -> WhenMissing f k x a -> WhenMissing f k x b
forall (f :: * -> *) a b k x.
(Applicative f, Monad f) =>
(a -> b) -> WhenMissing f k x a -> WhenMissing f k x b
mapWhenMissing
  {-# INLINE fmap #-}

-- | @since 0.5.9
instance (Applicative f, Monad f)
         => Category.Category (WhenMissing f k) where
  id :: forall a. WhenMissing f k a a
id = WhenMissing f k a a
forall (f :: * -> *) k x. Applicative f => WhenMissing f k x x
preserveMissing
  WhenMissing f k b c
f . :: forall b c a.
WhenMissing f k b c -> WhenMissing f k a b -> WhenMissing f k a c
. WhenMissing f k a b
g = (k -> a -> f (Maybe c)) -> WhenMissing f k a c
forall (f :: * -> *) k x y.
Applicative f =>
(k -> x -> f (Maybe y)) -> WhenMissing f k x y
traverseMaybeMissing ((k -> a -> f (Maybe c)) -> WhenMissing f k a c)
-> (k -> a -> f (Maybe c)) -> WhenMissing f k a c
forall a b. (a -> b) -> a -> b
$
    \ k
k a
x -> WhenMissing f k a b -> k -> a -> f (Maybe b)
forall (f :: * -> *) k x y.
WhenMissing f k x y -> k -> x -> f (Maybe y)
missingKey WhenMissing f k a b
g k
k a
x f (Maybe b) -> (Maybe b -> f (Maybe c)) -> f (Maybe c)
forall a b. f a -> (a -> f b) -> f b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Maybe b
y