{-# LANGUAGE CPP #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE PatternGuards #-}
#if __GLASGOW_HASKELL__
{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-}
#endif
#if defined(__GLASGOW_HASKELL__)
{-# LANGUAGE Trustworthy #-}
#endif
#if __GLASGOW_HASKELL__ >= 708
{-# LANGUAGE RoleAnnotations #-}
{-# LANGUAGE TypeFamilies #-}
#define USE_MAGIC_PROXY 1
#endif

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

    -- ** 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
#if __GLASGOW_HASKELL__ && MIN_VERSION_base(4,8,0)
    , 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

#if MIN_VERSION_base(4,8,0)
import Data.Functor.Identity (Identity (..))
import Control.Applicative (liftA3)
#else
import Control.Applicative (Applicative(..), (<$>), liftA3)
import Data.Monoid (Monoid(..))
import Data.Traversable (Traversable(traverse))
#endif
#if MIN_VERSION_base(4,9,0)
import Data.Functor.Classes
import Data.Semigroup (stimesIdempotentMonoid)
#endif
#if MIN_VERSION_base(4,9,0)
import Data.Semigroup (Semigroup(stimes))
#endif
#if !(MIN_VERSION_base(4,11,0)) && MIN_VERSION_base(4,9,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,8,0)
import Data.Foldable (Foldable())
#endif
#if MIN_VERSION_base(4,10,0)
import Data.Bifoldable
#endif
import Data.Typeable
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)
#if !MIN_VERSION_base(4,8,0)
import Data.Functor ((<$))
#endif
#ifdef USE_MAGIC_PROXY
import GHC.Exts (Proxy#, proxy# )
#endif
#if __GLASGOW_HASKELL__ >= 708
import qualified GHC.Exts as GHCExts
#endif
import Text.Read hiding (lift)
import Data.Data
import qualified Control.Category as Category
#endif
#if __GLASGOW_HASKELL__ >= 708
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 = 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 = 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 = 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

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

instance (Ord k) => Monoid (Map k v) where
    mempty :: Map k v
mempty  = forall k a. Map k a
empty
    mconcat :: [Map k v] -> Map k v
mconcat = forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
unions
#if !(MIN_VERSION_base(4,9,0))
    mappend = union
#else
    mappend :: Map k v -> Map k v -> Map k v
mappend = forall a. Semigroup a => a -> a -> a
(<>)

instance (Ord k) => Semigroup (Map k v) where
    <> :: 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  = forall b a. (Integral b, Monoid a) => b -> a -> a
stimesIdempotentMonoid
#endif

#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   = forall g. g -> c g
z forall k a. Ord k => [(k, a)] -> Map k a
fromList forall d b. Data d => c (d -> b) -> d -> c b
`f` 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 -> Int
constrIndex Constr
c of
    Int
1 -> forall b r. Data b => c (b -> r) -> c r
k (forall r. r -> c r
z forall k a. Ord k => [(k, a)] -> Map k a
fromList)
    Int
_ -> 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    = 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 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 -> Int
size Map k a
Tip              = Int
0
size (Bin Int
sz k
_ a
_ Map k a
_ Map k a
_) = Int
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 = 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 = forall a. Maybe a
Nothing
    go t
k (Bin Int
_ t
kx a
x Map t a
l Map t a
r) = case 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 -> 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 = 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 Int
_ t
kx a
_ Map t a
l Map t a
r) = case 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 forall a b. (a -> b) -> a -> b
$ 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 = forall k a. Ord k => k -> Map k a -> a
go
  where
    go :: t -> Map t a -> a
go !t
_ Map t a
Tip = forall a. HasCallStack => [Char] -> a
error [Char]
"Map.!: given key is not an element in the map"
    go t
k (Bin Int
_ t
kx a
x Map t a
l Map t a
r) = case 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 = 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 Int
_ t
kx t
x Map t t
l Map t t
r) = case 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 = 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 = forall a. Maybe a
Nothing
    goNothing t
k (Bin Int
_ t
kx t
x Map t t
l Map t t
r) | t
k 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 = 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 = forall a. a -> Maybe a
Just (t
kx', t
x')
    goJust t
k t
kx' t
x' (Bin Int
_ t
kx t
x Map t t
l Map t t
r) | t
k 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 = 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 = forall a. Maybe a
Nothing
    goNothing t
k (Bin Int
_ t
kx t
x Map t t
l Map t t
r) | t
k forall a. Ord a => a -> a -> Bool
< t
kx = 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 = forall a. a -> Maybe a
Just (t
kx', t
x')
    goJust t
k t
kx' t
x' (Bin Int
_ t
kx t
x Map t t
l Map t t
r) | t
k 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 = 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 = forall a. Maybe a
Nothing
    goNothing a
k (Bin Int
_ a
kx b
x Map a b
l Map a b
r) = case 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 -> forall a. a -> Maybe a
Just (a
kx, b
x)
                                                        Ordering
GT -> 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 = forall a. a -> Maybe a
Just (t
kx', t
x')
    goJust t
k t
kx' t
x' (Bin Int
_ t
kx t
x Map t t
l Map t t
r) = case 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 -> 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 = 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 = forall a. Maybe a
Nothing
    goNothing t
k (Bin Int
_ t
kx b
x Map t b
l Map t b
r) = case forall a. Ord a => a -> a -> Ordering
compare t
k t
kx of Ordering
LT -> 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 -> 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 = forall a. a -> Maybe a
Just (a
kx', b
x')
    goJust a
k a
kx' b
x' (Bin Int
_ a
kx b
x Map a b
l Map a b
r) = case 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 -> 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 = 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 = forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin Int
1 k
k a
x forall k a. Map k a
Tip 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 = 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 = forall k a. k -> a -> Map k a
singleton (forall a. a -> a
lazy k
orig) a
x
    go k
orig !k
kx a
x t :: Map k a
t@(Bin Int
sz k
ky a
y Map k a
l Map k a
r) =
        case forall a. Ord a => a -> a -> Ordering
compare k
kx k
ky of
            Ordering
LT | Map k a
l' forall a. a -> a -> Bool
`ptrEq` Map k a
l -> Map k a
t
               | Bool
otherwise -> 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' = 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' forall a. a -> a -> Bool
`ptrEq` Map k a
r -> Map k a
t
               | Bool
otherwise -> 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' = 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 forall a. a -> a -> Bool
`ptrEq` a
y Bool -> Bool -> Bool
&& (forall a. a -> a
lazy k
orig seq :: forall a b. a -> b -> b
`seq` (k
orig forall a. a -> a -> Bool
`ptrEq` k
ky)) -> Map k a
t
               | Bool
otherwise -> forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin Int
sz (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 = 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 = forall k a. k -> a -> Map k a
singleton (forall a. a -> a
lazy k
orig) a
x
    go k
orig !k
kx a
x t :: Map k a
t@(Bin Int
_ k
ky a
y Map k a
l Map k a
r) =
        case forall a. Ord a => a -> a -> Ordering
compare k
kx k
ky of
            Ordering
LT | Map k a
l' forall a. a -> a -> Bool
`ptrEq` Map k a
l -> Map k a
t
               | Bool
otherwise -> 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' = 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' forall a. a -> a -> Bool
`ptrEq` Map k a
r -> Map k a
t
               | Bool
otherwise -> 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' = 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 = 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 = forall k a. k -> a -> Map k a
singleton k
kx a
x
    go a -> a -> a
f !k
kx a
x (Bin Int
sy k
ky a
y Map k a
l Map k a
r) =
        case forall a. Ord a => a -> a -> Ordering
compare k
kx k
ky of
            Ordering
LT -> forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceL k
ky a
y (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 -> forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceR k
ky a
y Map k a
l (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 -> forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin Int
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 = 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 = forall k a. k -> a -> Map k a
singleton k
kx a
x
    go a -> a -> a
f !k
kx a
x (Bin Int
sy k
ky a
y Map k a
l Map k a
r) =
        case forall a. Ord a => a -> a -> Ordering
compare k
kx k
ky of
            Ordering
LT -> forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceL k
ky a
y (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 -> forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceR k
ky a
y Map k a
l (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 -> forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin Int
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 = 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 = forall k a. k -> a -> Map k a
singleton k
kx a
x
    go k -> a -> a -> a
f k
kx a
x (Bin Int
sy k
ky a
y Map k a
l Map k a
r) =
        case forall a. Ord a => a -> a -> Ordering
compare k
kx k
ky of
            Ordering
LT -> forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceL k
ky a
y (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 -> forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceR k
ky a
y Map k a
l (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 -> forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin Int
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 = 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 = forall k a. k -> a -> Map k a
singleton k
kx a
x
    go k -> a -> a -> a
f k
kx a
x (Bin Int
sy k
ky a
y Map k a
l Map k a
r) =
        case forall a. Ord a => a -> a -> Ordering
compare k
kx k
ky of
            Ordering
LT -> forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceL k
ky a
y (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 -> forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceR k
ky a
y Map k a
l (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 -> forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin Int
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 = forall a b. StrictPair a b -> (a, b)
toPair forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = (forall a. Maybe a
Nothing forall a b. a -> b -> StrictPair a b
:*: forall k a. k -> a -> Map k a
singleton k
kx a
x)
    go k -> a -> a -> a
f k
kx a
x (Bin Int
sy k
ky a
y Map k a
l Map k a
r) =
        case forall a. Ord a => a -> a -> Ordering
compare k
kx k
ky of
            Ordering
LT -> let !(Maybe a
found :*: Map k a
l') = 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' = 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 forall a b. a -> b -> StrictPair a b
:*: Map k a
t')
            Ordering
GT -> let !(Maybe a
found :*: Map k a
r') = 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' = 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 forall a b. a -> b -> StrictPair a b
:*: Map k a
t')
            Ordering
EQ -> (forall a. a -> Maybe a
Just a
y forall a b. a -> b -> StrictPair a b
:*: forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin Int
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 = 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 = forall k a. Map k a
Tip
    go k
k t :: Map k a
t@(Bin Int
_ k
kx a
x Map k a
l Map k a
r) =
        case forall a. Ord a => a -> a -> Ordering
compare k
k k
kx of
            Ordering
LT | Map k a
l' forall a. a -> a -> Bool
`ptrEq` Map k a
l -> Map k a
t
               | Bool
otherwise -> 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' = 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' forall a. a -> a -> Bool
`ptrEq` Map k a
r -> Map k a
t
               | Bool
otherwise -> 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' = forall k a. Ord k => k -> Map k a -> Map k a
go k
k Map k a
r
            Ordering
EQ -> 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 = 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 = 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 = forall k a. Map k a
Tip
    go k -> a -> a
f k
k (Bin Int
sx k
kx a
x Map k a
l Map k a
r) =
        case forall a. Ord a => a -> a -> Ordering
compare k
k k
kx of
           Ordering
LT -> forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin Int
sx k
kx a
x (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 -> forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin Int
sx k
kx a
x Map k a
l (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 -> forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin Int
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 = 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 = 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 = forall k a. Map k a
Tip
    go k -> a -> Maybe a
f k
k(Bin Int
sx k
kx a
x Map k a
l Map k a
r) =
        case forall a. Ord a => a -> a -> Ordering
compare k
k k
kx of
           Ordering
LT -> forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceR k
kx a
x (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 -> forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceL k
kx a
x Map k a
l (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' -> forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin Int
sx k
kx a
x' Map k a
l Map k a
r
                   Maybe a
Nothing -> 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 = forall a b. StrictPair a b -> (a, b)
toPair forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = (forall a. Maybe a
Nothing forall a b. a -> b -> StrictPair a b
:*: forall k a. Map k a
Tip)
   go k -> a -> Maybe a
f k
k (Bin Int
sx k
kx a
x Map k a
l Map k a
r) =
          case forall a. Ord a => a -> a -> Ordering
compare k
k k
kx of
               Ordering
LT -> let !(Maybe a
found :*: Map k a
l') = 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' = 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 forall a b. a -> b -> StrictPair a b
:*: Map k a
t')
               Ordering
GT -> let !(Maybe a
found :*: Map k a
r') = 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' = 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 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' -> (forall a. a -> Maybe a
Just a
x' forall a b. a -> b -> StrictPair a b
:*: forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin Int
sx k
kx a
x' Map k a
l Map k a
r)
                       Maybe a
Nothing -> let !glued :: Map k a
glued = forall k a. Map k a -> Map k a -> Map k a
glue Map k a
l Map k a
r
                                  in (forall a. a -> Maybe a
Just a
x 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 = 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 forall a. Maybe a
Nothing of
               Maybe a
Nothing -> forall k a. Map k a
Tip
               Just a
x  -> forall k a. k -> a -> Map k a
singleton k
k a
x

    go Maybe a -> Maybe a
f k
k (Bin Int
sx k
kx a
x Map k a
l Map k a
r) = case forall a. Ord a => a -> a -> Ordering
compare k
k k
kx of
               Ordering
LT -> forall k a. k -> a -> Map k a -> Map k a -> Map k a
balance k
kx a
x (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 -> forall k a. k -> a -> Map k a -> Map k a -> Map k a
balance k
kx a
x Map k a
l (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 (forall a. a -> Maybe a
Just a
x) of
                       Just a
x' -> forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin Int
sx k
kx a
x' Map k a
l Map k a
r
                       Maybe a
Nothing -> 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 = 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
 #-}

#if MIN_VERSION_base(4,8,0)
-- 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
#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 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 -> (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe a -> f (Maybe a)
f Maybe a
mv) 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 -> 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 seq :: forall a b. a -> b -> b
`seq` case Maybe a
mv of
                      Maybe a
Nothing -> 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
_ -> 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 -> 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
_ -> 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 = 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 = forall a. Maybe a -> BitQueue -> TraceResult a
TraceResult forall a. Maybe a
Nothing (BitQueueB -> BitQueue
buildQ BitQueueB
q)
    go BitQueueB
q k
k (Bin Int
_ k
kx a
x Map k a
l Map k a
r) = case forall a. Ord a => a -> a -> Ordering
compare k
k k
kx of
      Ordering
LT -> (forall k a. Ord k => BitQueueB -> k -> Map k a -> TraceResult a
go forall a b. (a -> b) -> a -> b
$! BitQueueB
q BitQueueB -> Bool -> BitQueueB
`snocQB` Bool
False) k
k Map k a
l
      Ordering
GT -> (forall k a. Ord k => BitQueueB -> k -> Map k a -> TraceResult a
go forall a b. (a -> b) -> a -> b
$! BitQueueB
q BitQueueB -> Bool -> BitQueueB
`snocQB` Bool
True) k
k Map k a
r
      Ordering
EQ -> forall a. Maybe a -> BitQueue -> TraceResult a
TraceResult (forall a. a -> Maybe a
Just a
x) (BitQueueB -> BitQueue
buildQ BitQueueB
q)

-- GHC 7.8 doesn't manage to unbox the queue properly
-- unless we explicitly inline this function. This stuff
-- is a bit touchy, unfortunately.
#if __GLASGOW_HASKELL__ >= 710
{-# 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 = forall k a. k -> a -> Map k a
singleton k
kx a
x
insertAlong BitQueue
q k
kx a
x (Bin Int
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) -> forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceL k
ky a
y (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) -> forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceR k
ky a
y Map k a
l (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 -> forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin Int
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 = forall k a. Proxy# () -> BitQueue -> Map k a -> Map k a
go (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 = forall k a. Map k a
Tip
  go Proxy# ()
foom BitQueue
q (Bin Int
_ 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) -> forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceR k
ky a
y (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) -> forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceL k
ky a
y Map k a
l (forall k a. Proxy# () -> BitQueue -> Map k a -> Map k a
go Proxy# ()
foom BitQueue
tl Map k a
r)
        Maybe (Bool, BitQueue)
Nothing -> 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
_ = 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 = forall k a. Map k a
Tip -- Should not happen
replaceAlong BitQueue
q  a
x (Bin Int
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) -> forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin Int
sz k
ky a
y (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) -> forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin Int
sz k
ky a
y Map k a
l (forall a k. BitQueue -> a -> Map k a -> Map k a
replaceAlong BitQueue
tl a
x Map k a
r)
        Maybe (Bool, BitQueue)
Nothing -> forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin Int
sz k
ky a
x Map k a
l Map k a
r

#if __GLASGOW_HASKELL__ && MIN_VERSION_base(4,8,0)
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 = forall a. a -> Identity a
Identity forall a b. (a -> b) -> a -> b
$ forall k a.
Ord k =>
AreWeStrict -> k -> (Maybe a -> Maybe a) -> Map k a -> Map k a
atKeyPlain AreWeStrict
Lazy k
k (coerce :: 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 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 forall a. Maybe a
Nothing of
                   Maybe a
Nothing -> forall k a. Altered k a
AltSame
                   Just a
x  -> case AreWeStrict
strict of
                     AreWeStrict
Lazy -> forall k a. Map k a -> Altered k a
AltBigger forall a b. (a -> b) -> a -> b
$ forall k a. k -> a -> Map k a
singleton k
k a
x
                     AreWeStrict
Strict -> a
x seq :: forall a b. a -> b -> b
`seq` (forall k a. Map k a -> Altered k a
AltBigger forall a b. (a -> b) -> a -> b
$ forall k a. k -> a -> Map k a
singleton k
k a
x)

    go k
k Maybe a -> Maybe a
f (Bin Int
sx k
kx a
x Map k a
l Map k a
r) = case forall a. Ord a => a -> a -> Ordering
compare k
k k
kx of
                   Ordering
LT -> case 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' -> forall k a. Map k a -> Altered k a
AltSmaller forall a b. (a -> b) -> a -> b
$ 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' -> forall k a. Map k a -> Altered k a
AltBigger forall a b. (a -> b) -> a -> b
$ 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' -> forall k a. Map k a -> Altered k a
AltAdj forall a b. (a -> b) -> a -> b
$ forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin Int
sx k
kx a
x Map k a
l' Map k a
r
                           Altered k a
AltSame -> forall k a. Altered k a
AltSame
                   Ordering
GT -> case 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' -> forall k a. Map k a -> Altered k a
AltSmaller forall a b. (a -> b) -> a -> b
$ 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' -> forall k a. Map k a -> Altered k a
AltBigger forall a b. (a -> b) -> a -> b
$ 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' -> forall k a. Map k a -> Altered k a
AltAdj forall a b. (a -> b) -> a -> b
$ forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin Int
sx k
kx a
x Map k a
l Map k a
r'
                           Altered k a
AltSame -> forall k a. Altered k a
AltSame
                   Ordering
EQ -> case Maybe a -> Maybe a
f (forall a. a -> Maybe a
Just a
x) of
                           Just a
x' -> case AreWeStrict
strict of
                             AreWeStrict
Lazy -> forall k a. Map k a -> Altered k a
AltAdj forall a b. (a -> b) -> a -> b
$ forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin Int
sx k
kx a
x' Map k a
l Map k a
r
                             AreWeStrict
Strict -> a
x' seq :: forall a b. a -> b -> b
`seq` (forall k a. Map k a -> Altered k a
AltAdj forall a b. (a -> b) -> a -> b
$ forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin Int
sx k
kx a
x' Map k a
l Map k a
r)
                           Maybe a
Nothing -> forall k a. Map k a -> Altered k a
AltSmaller forall a b. (a -> b) -> a -> b
$ 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 -> Int
findIndex = forall k a. Ord k => Int -> k -> Map k a -> Int
go Int
0
  where
    go :: Ord k => Int -> k -> Map k a -> Int
    go :: forall k a. Ord k => Int -> k -> Map k a -> Int
go !Int
_   !k
_ Map k a
Tip  = forall a. HasCallStack => [Char] -> a
error [Char]
"Map.findIndex: element is not in the map"
    go Int
idx k
k (Bin Int
_ k
kx a
_ Map k a
l Map k a
r) = case forall a. Ord a => a -> a -> Ordering
compare k
k k
kx of
      Ordering
LT -> forall k a. Ord k => Int -> k -> Map k a -> Int
go Int
idx k
k Map k a
l
      Ordering
GT -> forall k a. Ord k => Int -> k -> Map k a -> Int
go (Int
idx forall a. Num a => a -> a -> a
+ forall k a. Map k a -> Int
size Map k a
l forall a. Num a => a -> a -> a
+ Int
1) k
k Map k a
r
      Ordering
EQ -> Int
idx forall a. Num a => a -> a -> a
+ forall k a. Map k a -> Int
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 Int
lookupIndex = forall k a. Ord k => Int -> k -> Map k a -> Maybe Int
go Int
0
  where
    go :: Ord k => Int -> k -> Map k a -> Maybe Int
    go :: forall k a. Ord k => Int -> k -> Map k a -> Maybe Int
go !Int
_  !k
_ Map k a
Tip  = forall a. Maybe a
Nothing
    go Int
idx k
k (Bin Int
_ k
kx a
_ Map k a
l Map k a
r) = case forall a. Ord a => a -> a -> Ordering
compare k
k k
kx of
      Ordering
LT -> forall k a. Ord k => Int -> k -> Map k a -> Maybe Int
go Int
idx k
k Map k a
l
      Ordering
GT -> forall k a. Ord k => Int -> k -> Map k a -> Maybe Int
go (Int
idx forall a. Num a => a -> a -> a
+ forall k a. Map k a -> Int
size Map k a
l forall a. Num a => a -> a -> a
+ Int
1) k
k Map k a
r
      Ordering
EQ -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! Int
idx forall a. Num a => a -> a -> a
+ forall k a. Map k a -> Int
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. Int -> Map k a -> (k, a)
elemAt !Int
_ Map k a
Tip = forall a. HasCallStack => [Char] -> a
error [Char]
"Map.elemAt: index out of range"
elemAt Int
i (Bin Int
_ k
kx a
x Map k a
l Map k a
r)
  = case forall a. Ord a => a -> a -> Ordering
compare Int
i Int
sizeL of
      Ordering
LT -> forall k a. Int -> Map k a -> (k, a)
elemAt Int
i Map k a
l
      Ordering
GT -> forall k a. Int -> Map k a -> (k, a)
elemAt (Int
iforall a. Num a => a -> a -> a
-Int
sizeLforall a. Num a => a -> a -> a
-Int
1) Map k a
r
      Ordering
EQ -> (k
kx,a
x)
  where
    sizeL :: Int
sizeL = forall k a. Map k a -> Int
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. Int -> Map k a -> Map k a
take Int
i Map k a
m | Int
i forall a. Ord a => a -> a -> Bool
>= forall k a. Map k a -> Int
size Map k a
m = Map k a
m
take Int
i0 Map k a
m0 = forall k a. Int -> Map k a -> Map k a
go Int
i0 Map k a
m0
  where
    go :: Int -> Map k a -> Map k a
go Int
i !Map k a
_ | Int
i forall a. Ord a => a -> a -> Bool
<= Int
0 = forall k a. Map k a
Tip
    go !Int
_ Map k a
Tip = forall k a. Map k a
Tip
    go Int
i (Bin Int
_ k
kx a
x Map k a
l Map k a
r) =
      case forall a. Ord a => a -> a -> Ordering
compare Int
i Int
sizeL of
        Ordering
LT -> Int -> Map k a -> Map k a
go Int
i Map k a
l
        Ordering
GT -> forall k a. k -> a -> Map k a -> Map k a -> Map k a
link k
kx a
x Map k a
l (Int -> Map k a -> Map k a
go (Int
i forall a. Num a => a -> a -> a
- Int
sizeL forall a. Num a => a -> a -> a
- Int
1) Map k a
r)
        Ordering
EQ -> Map k a
l
      where sizeL :: Int
sizeL = forall k a. Map k a -> Int
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. Int -> Map k a -> Map k a
drop Int
i Map k a
m | Int
i forall a. Ord a => a -> a -> Bool
>= forall k a. Map k a -> Int
size Map k a
m = forall k a. Map k a
Tip
drop Int
i0 Map k a
m0 = forall k a. Int -> Map k a -> Map k a
go Int
i0 Map k a
m0
  where
    go :: Int -> Map k a -> Map k a
go Int
i Map k a
m | Int
i forall a. Ord a => a -> a -> Bool
<= Int
0 = Map k a
m
    go !Int
_ Map k a
Tip = forall k a. Map k a
Tip
    go Int
i (Bin Int
_ k
kx a
x Map k a
l Map k a
r) =
      case forall a. Ord a => a -> a -> Ordering
compare Int
i Int
sizeL of
        Ordering
LT -> forall k a. k -> a -> Map k a -> Map k a -> Map k a
link k
kx a
x (Int -> Map k a -> Map k a
go Int
i Map k a
l) Map k a
r
        Ordering
GT -> Int -> Map k a -> Map k a
go (Int
i forall a. Num a => a -> a -> a
- Int
sizeL forall a. Num a => a -> a -> a
- Int
1) Map k a
r
        Ordering
EQ -> forall k a. k -> a -> Map k a -> Map k a
insertMin k
kx a
x Map k a
r
      where sizeL :: Int
sizeL = forall k a. Map k a -> Int
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. Int -> Map k a -> (Map k a, Map k a)
splitAt Int
i0 Map k a
m0
  | Int
i0 forall a. Ord a => a -> a -> Bool
>= forall k a. Map k a -> Int
size Map k a
m0 = (Map k a
m0, forall k a. Map k a
Tip)
  | Bool
otherwise = forall a b. StrictPair a b -> (a, b)
toPair forall a b. (a -> b) -> a -> b
$ forall {k} {a}. Int -> Map k a -> StrictPair (Map k a) (Map k a)
go Int
i0 Map k a
m0
  where
    go :: Int -> Map k a -> StrictPair (Map k a) (Map k a)
go Int
i Map k a
m | Int
i forall a. Ord a => a -> a -> Bool
<= Int
0 = forall k a. Map k a
Tip forall a b. a -> b -> StrictPair a b
:*: Map k a
m
    go !Int
_ Map k a
Tip = forall k a. Map k a
Tip forall a b. a -> b -> StrictPair a b
:*: forall k a. Map k a
Tip
    go Int
i (Bin Int
_ k
kx a
x Map k a
l Map k a
r)
      = case forall a. Ord a => a -> a -> Ordering
compare Int
i Int
sizeL of
          Ordering
LT -> case Int -> Map k a -> StrictPair (Map k a) (Map k a)
go Int
i Map k a
l of
                  Map k a
ll :*: Map k a
lr -> Map k a
ll forall a b. a -> b -> StrictPair a b
:*: 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 Int -> Map k a -> StrictPair (Map k a) (Map k a)
go (Int
i forall a. Num a => a -> a -> a
- Int
sizeL forall a. Num a => a -> a -> a
- Int
1) Map k a
r of
                  Map k a
rl :*: Map k a
rr -> 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 forall a b. a -> b -> StrictPair a b
:*: Map k a
rr
          Ordering
EQ -> Map k a
l forall a b. a -> b -> StrictPair a b
:*: forall k a. k -> a -> Map k a -> Map k a
insertMin k
kx a
x Map k a
r
      where sizeL :: Int
sizeL = forall k a. Map k a -> Int
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) -> Int -> Map k a -> Map k a
updateAt k -> a -> Maybe a
f !Int
i Map k a
t =
  case Map k a
t of
    Map k a
Tip -> forall a. HasCallStack => [Char] -> a
error [Char]
"Map.updateAt: index out of range"
    Bin Int
sx k
kx a
x Map k a
l Map k a
r -> case forall a. Ord a => a -> a -> Ordering
compare Int
i Int
sizeL of
      Ordering
LT -> forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceR k
kx a
x (forall k a. (k -> a -> Maybe a) -> Int -> Map k a -> Map k a
updateAt k -> a -> Maybe a
f Int
i Map k a
l) Map k a
r
      Ordering
GT -> forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceL k
kx a
x Map k a
l (forall k a. (k -> a -> Maybe a) -> Int -> Map k a -> Map k a
updateAt k -> a -> Maybe a
f (Int
iforall a. Num a => a -> a -> a
-Int
sizeLforall a. Num a => a -> a -> a
-Int
1) Map k a
r)
      Ordering
EQ -> case k -> a -> Maybe a
f k
kx a
x of
              Just a
x' -> forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin Int
sx k
kx a
x' Map k a
l Map k a
r
              Maybe a
Nothing -> forall k a. Map k a -> Map k a -> Map k a
glue Map k a
l Map k a
r
      where
        sizeL :: Int
sizeL = forall k a. Map k a -> Int
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. Int -> Map k a -> Map k a
deleteAt !Int
i Map k a
t =
  case Map k a
t of
    Map k a
Tip -> forall a. HasCallStack => [Char] -> a
error [Char]
"Map.deleteAt: index out of range"
    Bin Int
_ k
kx a
x Map k a
l Map k a
r -> case forall a. Ord a => a -> a -> Ordering
compare Int
i Int
sizeL of
      Ordering
LT -> forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceR k
kx a
x (forall k a. Int -> Map k a -> Map k a
deleteAt Int
i Map k a
l) Map k a
r
      Ordering
GT -> forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceL k
kx a
x Map k a
l (forall k a. Int -> Map k a -> Map k a
deleteAt (Int
iforall a. Num a => a -> a -> a
-Int
sizeLforall a. Num a => a -> a -> a
-Int
1) Map k a
r)
      Ordering
EQ -> forall k a. Map k a -> Map k a -> Map k a
glue Map k a
l Map k a
r
      where
        sizeL :: Int
sizeL = forall k a. Map k a -> Int
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 Int
_ k
k a
a Map k a
l Map 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 = forall a. Maybe a
Nothing
lookupMin (Bin Int
_ k
k a
x Map k a
l Map k a
_) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! 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 <- forall k a. Map k a -> Maybe (k, a)
lookupMin Map k a
t = (k, a)
r
  | Bool
otherwise = 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 Int
_ k
k a
a Map k a
_ Map k a
r) = 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 = forall a. Maybe a
Nothing
lookupMax (Bin Int
_ k
k a
x Map k a
_ Map k a
r) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! 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 <- forall k a. Map k a -> Maybe (k, a)
lookupMax Map k a
t = (k, a)
r
  | Bool
otherwise = 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 Int
_ k
_  a
_ Map k a
Tip Map k a
r)  = Map k a
r
deleteMin (Bin Int
_ k
kx a
x Map k a
l Map k a
r)    = forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceR k
kx a
x (forall k a. Map k a -> Map k a
deleteMin Map k a
l) Map k a
r
deleteMin Map k a
Tip                 = 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 Int
_ k
_  a
_ Map k a
l Map k a
Tip)  = Map k a
l
deleteMax (Bin Int
_ k
kx a
x Map k a
l Map k a
r)    = forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceL k
kx a
x Map k a
l (forall k a. Map k a -> Map k a
deleteMax Map k a
r)
deleteMax Map k a
Tip                 = 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
  = 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
  = 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                 = forall k a. Map k a
Tip
updateMinWithKey k -> a -> Maybe a
f (Bin Int
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' -> forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin Int
sx k
kx a
x' forall k a. Map k a
Tip Map k a
r
updateMinWithKey k -> a -> Maybe a
f (Bin Int
_ k
kx a
x Map k a
l Map k a
r)    = forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceR k
kx a
x (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                 = forall k a. Map k a
Tip
updateMaxWithKey k -> a -> Maybe a
f (Bin Int
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' -> forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin Int
sx k
kx a
x' Map k a
l forall k a. Map k a
Tip
updateMaxWithKey k -> a -> Maybe a
f (Bin Int
_ k
kx a
x Map k a
l Map k a
r)    = forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceL k
kx a
x Map k a
l (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 = forall a. Maybe a
Nothing
minViewWithKey (Bin Int
_ k
k a
x Map k a
l Map k a
r) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$
  case 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 = forall a. Maybe a
Nothing
maxViewWithKey (Bin Int
_ k
k a
x Map k a
l Map k a
r) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$
  case 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 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 -> forall a. Maybe a
Nothing
              Just ~((k
_, a
x), Map k a
t') -> 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 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 -> forall a. Maybe a
Nothing
              Just ~((k
_, a
x), Map k a
t') -> 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
  = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Foldable.foldl' forall k v. Ord k => Map k v -> Map k v -> Map k v
union 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
  = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Foldable.foldl' (forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
unionWith a -> a -> a
f) forall k a. Map k a
empty f (Map k a)
ts
#if __GLASGOW_HASKELL__
{-# INLINABLE unionsWith #-}
#endif

-- | /O(m*log(n\/m + 1)), m <= 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 Int
_ k
k a
x Map k a
Tip Map k a
Tip) = forall k a. Ord k => k -> a -> Map k a -> Map k a
insertR k
k a
x Map k a
t1
union (Bin Int
_ k
k a
x Map k a
Tip Map k a
Tip) Map k a
t2 = 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 Int
_ k
k1 a
x1 Map k a
l1 Map k a
r1) Map k a
t2 = case 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 forall a. a -> a -> Bool
`ptrEq` Map k a
l1 Bool -> Bool -> Bool
&& Map k a
r1r2 forall a. a -> a -> Bool
`ptrEq` Map k a
r1 -> Map k a
t1
           | Bool
otherwise -> 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 = 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 = 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(m*log(n\/m + 1)), m <= 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 Int
_ k
k a
x Map k a
Tip Map k a
Tip) = 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 Int
_ k
k a
x Map k a
Tip Map k a
Tip) Map k a
t2 = 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 Int
_ k
k1 a
x1 Map k a
l1 Map k a
r1) Map k a
t2 = case 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 -> 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 -> 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 = 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 = 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(m*log(n\/m + 1)), m <= 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 Int
_ k
k a
x Map k a
Tip Map k a
Tip) = 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 Int
_ k
k a
x Map k a
Tip Map k a
Tip) Map k a
t2 = 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 Int
_ k
k1 a
x1 Map k a
l1 Map k a
r1) Map k a
t2 = case 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 -> 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 -> 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 = 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 = 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(m*log(n\/m + 1)), m <= 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
_   = 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 Int
_ k
k b
_ Map k b
l2 Map k b
r2) = case 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)
    | forall k a. Map k a -> Int
size Map k a
l1l2 forall a. Num a => a -> a -> a
+ forall k a. Map k a -> Int
size Map k a
r1r2 forall a. Eq a => a -> a -> Bool
== forall k a. Map k a -> Int
size Map k a
t1 -> Map k a
t1
    | Bool
otherwise -> 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 = 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 = 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(m*log(n\/m + 1)), m <= 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
_ = 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 Int
_ k
k Set k
ls Set k
rs) = case 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' forall a. a -> a -> Bool
`ptrEq` Map k a
lm Bool -> Bool -> Bool
&& Map k a
rm' forall a. a -> a -> Bool
`ptrEq` Map k a
rm -> Map k a
m
     | Bool
otherwise -> 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' = 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' = 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 = 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 forall (f :: * -> *) k x. Applicative f => WhenMissing f k x x
preserveMissing forall (f :: * -> *) k x y. Applicative f => WhenMissing f k x y
dropMissing forall a b. (a -> b) -> a -> b
$
       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 =
  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 forall (f :: * -> *) k x. Applicative f => WhenMissing f k x x
preserveMissing forall (f :: * -> *) k x y. Applicative f => WhenMissing f k x y
dropMissing (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(m*log(n\/m + 1)), m <= 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
_ = forall k a. Map k a
Tip
intersection Map k a
_ Map k b
Tip = forall k a. Map k a
Tip
intersection t1 :: Map k a
t1@(Bin Int
_ k
k a
x Map k a
l1 Map k a
r1) Map k b
t2
  | Bool
mb = if Map k a
l1l2 forall a. a -> a -> Bool
`ptrEq` Map k a
l1 Bool -> Bool -> Bool
&& Map k a
r1r2 forall a. a -> a -> Bool
`ptrEq` Map k a
r1
         then Map k a
t1
         else 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 = 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) = 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 = 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 = 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(m*log(n\/m + 1)), m <= 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
_ = forall k a. Map k a
Tip
restrictKeys Map k a
_ Set k
Set.Tip = forall k a. Map k a
Tip
restrictKeys m :: Map k a
m@(Bin Int
_ k
k a
x Map k a
l1 Map k a
r1) Set k
s
  | Bool
b = if Map k a
l1l2 forall a. a -> a -> Bool
`ptrEq` Map k a
l1 Bool -> Bool -> Bool
&& Map k a
r1r2 forall a. a -> a -> Bool
`ptrEq` Map k a
r1
        then Map k a
m
        else 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 = 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) = forall a. Ord a => a -> Set a -> (Set a, Bool, Set a)
Set.splitMember k
k Set k
s
    !l1l2 :: Map k a
l1l2 = 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 = 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(m*log(n\/m + 1)), m <= 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
_ = forall k a. Map k a
Tip
intersectionWith a -> b -> c
_f Map k a
_ Map k b
Tip = forall k a. Map k a
Tip
intersectionWith a -> b -> c
f (Bin Int
_ k
k a
x1 Map k a
l1 Map k a
r1) Map k b
t2 = case Maybe b
mb of
    Just b
x2 -> 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 -> 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) = 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 = 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 = 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(m*log(n\/m + 1)), m <= 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
_ = forall k a. Map k a
Tip
intersectionWithKey k -> a -> b -> c
_f Map k a
_ Map k b
Tip = forall k a. Map k a
Tip
intersectionWithKey k -> a -> b -> c
f (Bin Int
_ k
k a
x1 Map k a
l1 Map k a
r1) Map k b
t2 = case Maybe b
mb of
    Just b
x2 -> 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 -> 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) = 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 = 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 = 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(m*log(n\/m + 1)), m <= 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 Int
1 k
k a
_ Map k a
_ Map k a
_) Map k b
t = k
k forall k a. Ord k => k -> Map k a -> Bool
`notMember` Map k b
t
disjoint (Bin Int
_ k
k a
_ Map k a
l Map k a
r) Map k b
t
  = Bool -> Bool
not Bool
found Bool -> Bool -> 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
&& 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) = 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
  | forall k a. Map k a -> Bool
null Map b c
bc = forall k a. Map k a
empty
  | Bool
otherwise = forall a b k. (a -> Maybe b) -> Map k a -> Map k b
mapMaybe (Map b c
bc forall k a. Ord k => Map k a -> k -> Maybe a
!?) Map a b
ab

#if !MIN_VERSION_base (4,8,0)
-- | The identity type.
newtype Identity a = Identity { runIdentity :: a }
#if __GLASGOW_HASKELL__ == 708
instance Functor Identity where
  fmap = coerce
instance Applicative Identity where
  (<*>) = coerce
  pure = Identity
#else
instance Functor Identity where
  fmap f (Identity a) = Identity (f a)
instance Applicative Identity where
  Identity f <*> Identity x = Identity (f x)
  pure = Identity
#endif
#endif

-- | 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 = 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 = 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 = forall (f :: * -> *) k x y.
Applicative f =>
(k -> x -> f (Maybe y)) -> WhenMissing f k x y
traverseMaybeMissing forall a b. (a -> b) -> a -> b
$
    \ k
k a
x -> 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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Maybe b
y ->
         case Maybe b
y of
           Maybe b
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
           Just b
q -> forall (f :: * -> *) k x y.
WhenMissing f k x y -> k -> x -> f (Maybe y)
missingKey WhenMissing f k b c
f k
k b
q
  {-# INLINE id #-}
  {-# INLINE (.) #-}

-- | Equivalent to @ ReaderT k (ReaderT x (MaybeT f)) @.
--
-- @since 0.5.9
instance (Applicative f, Monad f) => Applicative (WhenMissing f k x) where
  pure :: forall a. a -> WhenMissing f k x a
pure a
x = forall (f :: * -> *) k x y.
Applicative f =>
(k -> x -> y) -> WhenMissing f k x y
mapMissing (\ k
_ x
_ -> a
x)
  WhenMissing f k x (a -> b)
f <*> :: forall a b.
WhenMissing f k x (a -> b)
-> WhenMissing f k x a -> WhenMissing f k x b
<*> WhenMissing f k x a
g = forall (f :: * -> *) k x y.
Applicative f =>
(k -> x -> f (Maybe y)) -> WhenMissing f k x y
traverseMaybeMissing forall a b. (a -> b) -> a -> b
$ \k
k x
x -> do
         Maybe (a -> b)
res1 <- forall (f :: * -> *) k x y.
WhenMissing f k x y -> k -> x -> f (Maybe y)
missingKey WhenMissing f k x (a -> b)
f k
k x
x
         case Maybe (a -> b)
res1 of
           Maybe (a -> b)
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
           Just a -> b
r -> (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$!) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
r forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (f :: * -> *) k x y.
WhenMissing f k x y -> k -> x -> f (Maybe y)
missingKey WhenMissing f k x a
g k
k x
x
  {-# INLINE pure #-}
  {-# INLINE (<*>) #-}

-- | Equivalent to @ ReaderT k (ReaderT x (MaybeT f)) @.
--
-- @since 0.5.9
instance (Applicative f, Monad f) => Monad (WhenMissing f k x) where
#if !MIN_VERSION_base(4,8,0)
  return = pure
#endif
  WhenMissing f k x a
m >>= :: forall a b.
WhenMissing f k x a
-> (a -> WhenMissing f k x b) -> WhenMissing f k x b
>>= a -> WhenMissing f k x b
f = forall (f :: * -> *) k x y.
Applicative f =>
(k -> x -> f (Maybe y)) -> WhenMissing f k x y
traverseMaybeMissing forall a b. (a -> b) -> a -> b
$ \k
k x
x -> do
         Maybe a
res1 <- forall (f :: * -> *) k x y.
WhenMissing f k x y -> k -> x -> f (Maybe y)
missingKey WhenMissing f k x a
m k
k x
x
         case Maybe a
res1 of
           Maybe a
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
           Just a
r -> forall (f :: * -> *) k x y.
WhenMissing f k x y -> k -> x -> f (Maybe y)
missingKey (a -> WhenMissing f k x b
f a
r) k
k x
x
  {-# INLINE (>>=) #-}

-- | Map covariantly over a @'WhenMissing' f k x@.
--
-- @since 0.5.9
mapWhenMissing :: (Applicative f, Monad f)
               => (a -> b)
               -> WhenMissing f k x a -> WhenMissing