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

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

{-# OPTIONS_HADDOCK not-home #-}

#include "containers.h"

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

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

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


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


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


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

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

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

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

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

    -- * Construction
    , empty
    , singleton

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

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

    -- * Combine

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

    -- ** Difference
    , difference
    , differenceWith
    , differenceWithKey

    -- ** Intersection
    , intersection
    , intersectionWith
    , intersectionWithKey

    -- ** Disjoint
    , disjoint

    -- ** Compose
    , compose

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

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

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

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

    -- ** Deprecated general combining function

    , mergeWithKey

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

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

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

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

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

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

    -- * Filter
    , filter
    , filterWithKey

    , takeWhileAntitone
    , dropWhileAntitone
    , spanAntitone

    , restrictKeys
    , withoutKeys
    , partition
    , partitionWithKey

    , mapMaybe
    , mapMaybeWithKey
    , mapEither
    , mapEitherWithKey

    , split
    , splitLookup
    , splitRoot

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

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

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

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

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

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

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

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


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

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

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

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

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

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

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

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

type Size     = Int

#ifdef __GLASGOW_HASKELL__
type role Map nominal representational
#endif

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

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

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

#if __GLASGOW_HASKELL__

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

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

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

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

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

#endif

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

null :: Map k a -> Bool
null :: 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 :: 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 :: k -> Map k a -> Maybe a
lookup = k -> Map k a -> Maybe a
forall k a. Ord k => k -> Map k a -> Maybe a
go
  where
    go :: t -> Map t a -> Maybe a
go !t
_ Map t a
Tip = Maybe a
forall a. Maybe a
Nothing
    go t
k (Bin Int
_ t
kx a
x Map t a
l Map t a
r) = case t -> t -> Ordering
forall a. Ord a => a -> a -> Ordering
compare t
k t
kx of
      Ordering
LT -> t -> Map t a -> Maybe a
go t
k Map t a
l
      Ordering
GT -> t -> Map t a -> Maybe a
go t
k Map t a
r
      Ordering
EQ -> a -> Maybe a
forall a. a -> Maybe a
Just a
x
#if __GLASGOW_HASKELL__
{-# INLINABLE lookup #-}
#else
{-# INLINE lookup #-}
#endif

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

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

notMember :: Ord k => k -> Map k a -> Bool
notMember :: k -> Map k a -> Bool
notMember k
k Map k a
m = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ k -> Map k a -> Bool
forall t a. Ord t => t -> Map t 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 :: k -> Map k a -> a
find = k -> Map k a -> a
forall k a. Ord k => k -> Map k a -> a
go
  where
    go :: t -> Map t p -> p
go !t
_ Map t p
Tip = [Char] -> p
forall a. HasCallStack => [Char] -> a
error [Char]
"Map.!: given key is not an element in the map"
    go t
k (Bin Int
_ t
kx p
x Map t p
l Map t p
r) = case t -> t -> Ordering
forall a. Ord a => a -> a -> Ordering
compare t
k t
kx of
      Ordering
LT -> t -> Map t p -> p
go t
k Map t p
l
      Ordering
GT -> t -> Map t p -> p
go t
k Map t p
r
      Ordering
EQ -> p
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 :: a -> k -> Map k a -> a
findWithDefault = a -> k -> Map k a -> a
forall t t. Ord t => t -> t -> Map t t -> t
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 t -> t -> Ordering
forall a. Ord a => a -> a -> Ordering
compare t
k t
kx of
      Ordering
LT -> t -> t -> Map t t -> t
go t
def t
k Map t t
l
      Ordering
GT -> t -> t -> Map t t -> t
go t
def t
k Map t t
r
      Ordering
EQ -> t
x
#if __GLASGOW_HASKELL__
{-# INLINABLE findWithDefault #-}
#else
{-# INLINE findWithDefault #-}
#endif

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

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

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

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

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

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

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

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

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

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

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

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

{--------------------------------------------------------------------
  Insertion
--------------------------------------------------------------------}
-- | \(O(\log n)\). Insert a new key and value in the map.
-- If the key is already present in the map, the associated value is
-- replaced with the supplied value. 'insert' is equivalent to
-- @'insertWith' 'const'@.
--
-- > insert 5 'x' (fromList [(5,'a'), (3,'b')]) == fromList [(3, 'b'), (5, 'x')]
-- > insert 7 'x' (fromList [(5,'a'), (3,'b')]) == fromList [(3, 'b'), (5, 'a'), (7, 'x')]
-- > insert 5 'x' empty                         == singleton 5 'x'

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

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

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


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

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

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

insertWith :: Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
insertWith :: (a -> a -> a) -> k -> a -> Map k a -> Map k a
insertWith = (a -> a -> a) -> k -> a -> Map k a -> Map k a
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
go
  where
    -- We have no hope of making pointer equality tricks work
    -- here, because lazy insertWith *always* changes the tree,
    -- either adding a new entry or replacing an element with a
    -- thunk.
    go :: Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
    go :: (a -> a -> a) -> k -> a -> Map k a -> Map k a
go a -> a -> a
_ !k
kx a
x Map k a
Tip = k -> a -> Map k a
forall k a. k -> a -> Map k a
singleton k
kx a
x
    go a -> a -> a
f !k
kx a
x (Bin Int
sy k
ky a
y Map k a
l Map k a
r) =
        case k -> k -> Ordering
forall a. Ord a => a -> a -> Ordering
compare k
kx k
ky of
            Ordering
LT -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceL k
ky a
y ((a -> a -> a) -> k -> a -> Map k a -> Map k a
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
go a -> a -> a
f k
kx a
x Map k a
l) Map k a
r
            Ordering
GT -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceR k
ky a
y Map k a
l ((a -> a -> a) -> k -> a -> Map k a -> Map k a
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
go a -> a -> a
f k
kx a
x Map k a
r)
            Ordering
EQ -> Int -> k -> a -> Map k a -> Map k a -> Map k a
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 :: (a -> a -> a) -> k -> a -> Map k a -> Map k a
insertWithR = (a -> a -> a) -> k -> a -> Map k a -> Map k a
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
go
  where
    go :: Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
    go :: (a -> a -> a) -> k -> a -> Map k a -> Map k a
go a -> a -> a
_ !k
kx a
x Map k a
Tip = k -> a -> Map k a
forall k a. k -> a -> Map k a
singleton k
kx a
x
    go a -> a -> a
f !k
kx a
x (Bin Int
sy k
ky a
y Map k a
l Map k a
r) =
        case k -> k -> Ordering
forall a. Ord a => a -> a -> Ordering
compare k
kx k
ky of
            Ordering
LT -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceL k
ky a
y ((a -> a -> a) -> k -> a -> Map k a -> Map k a
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
go a -> a -> a
f k
kx a
x Map k a
l) Map k a
r
            Ordering
GT -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceR k
ky a
y Map k a
l ((a -> a -> a) -> k -> a -> Map k a -> Map k a
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
go a -> a -> a
f k
kx a
x Map k a
r)
            Ordering
EQ -> Int -> k -> a -> Map k a -> Map k a -> Map k a
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 :: (k -> a -> a -> a) -> k -> a -> Map k a -> Map k a
insertWithKey = (k -> a -> a -> a) -> k -> a -> Map k a -> Map k a
forall k a.
Ord k =>
(k -> a -> a -> a) -> k -> a -> Map k a -> Map k a
go
  where
    go :: Ord k => (k -> a -> a -> a) -> k -> a -> Map k a -> Map k a
    go :: (k -> a -> a -> a) -> k -> a -> Map k a -> Map k a
go k -> a -> a -> a
_ !k
kx a
x Map k a
Tip = k -> a -> Map k a
forall k a. k -> a -> Map k a
singleton k
kx a
x
    go k -> a -> a -> a
f k
kx a
x (Bin Int
sy k
ky a
y Map k a
l Map k a
r) =
        case k -> k -> Ordering
forall a. Ord a => a -> a -> Ordering
compare k
kx k
ky of
            Ordering
LT -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceL k
ky a
y ((k -> a -> a -> a) -> k -> a -> Map k a -> Map k a
forall k a.
Ord k =>
(k -> a -> a -> a) -> k -> a -> Map k a -> Map k a
go k -> a -> a -> a
f k
kx a
x Map k a
l) Map k a
r
            Ordering
GT -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceR k
ky a
y Map k a
l ((k -> a -> a -> a) -> k -> a -> Map k a -> Map k a
forall k a.
Ord k =>
(k -> a -> a -> a) -> k -> a -> Map k a -> Map k a
go k -> a -> a -> a
f k
kx a
x Map k a
r)
            Ordering
EQ -> Int -> k -> a -> Map k a -> Map k a -> Map k a
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 :: (k -> a -> a -> a) -> k -> a -> Map k a -> Map k a
insertWithKeyR = (k -> a -> a -> a) -> k -> a -> Map k a -> Map k a
forall k a.
Ord k =>
(k -> a -> a -> a) -> k -> a -> Map k a -> Map k a
go
  where
    go :: Ord k => (k -> a -> a -> a) -> k -> a -> Map k a -> Map k a
    go :: (k -> a -> a -> a) -> k -> a -> Map k a -> Map k a
go k -> a -> a -> a
_ !k
kx a
x Map k a
Tip = k -> a -> Map k a
forall k a. k -> a -> Map k a
singleton k
kx a
x
    go k -> a -> a -> a
f k
kx a
x (Bin Int
sy k
ky a
y Map k a
l Map k a
r) =
        case k -> k -> Ordering
forall a. Ord a => a -> a -> Ordering
compare k
kx k
ky of
            Ordering
LT -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceL k
ky a
y ((k -> a -> a -> a) -> k -> a -> Map k a -> Map k a
forall k a.
Ord k =>
(k -> a -> a -> a) -> k -> a -> Map k a -> Map k a
go k -> a -> a -> a
f k
kx a
x Map k a
l) Map k a
r
            Ordering
GT -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceR k
ky a
y Map k a
l ((k -> a -> a -> a) -> k -> a -> Map k a -> Map k a
forall k a.
Ord k =>
(k -> a -> a -> a) -> k -> a -> Map k a -> Map k a
go k -> a -> a -> a
f k
kx a
x Map k a
r)
            Ordering
EQ -> Int -> k -> a -> Map k a -> Map k a -> Map k a
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 :: (k -> a -> a -> a) -> k -> a -> Map k a -> (Maybe a, Map k a)
insertLookupWithKey k -> a -> a -> a
f0 k
k0 a
x0 = StrictPair (Maybe a) (Map k a) -> (Maybe a, Map k a)
forall a b. StrictPair a b -> (a, b)
toPair (StrictPair (Maybe a) (Map k a) -> (Maybe a, Map k a))
-> (Map k a -> StrictPair (Maybe a) (Map k a))
-> Map k a
-> (Maybe a, Map k a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (k -> a -> a -> a)
-> k -> a -> Map k a -> StrictPair (Maybe a) (Map k a)
forall k a.
Ord k =>
(k -> a -> a -> a)
-> k -> a -> Map k a -> StrictPair (Maybe a) (Map k a)
go k -> a -> a -> a
f0 k
k0 a
x0
  where
    go :: Ord k => (k -> a -> a -> a) -> k -> a -> Map k a -> StrictPair (Maybe a) (Map k a)
    go :: (k -> a -> a -> a)
-> k -> a -> Map k a -> StrictPair (Maybe a) (Map k a)
go k -> a -> a -> a
_ !k
kx a
x Map k a
Tip = (Maybe a
forall a. Maybe a
Nothing Maybe a -> Map k a -> StrictPair (Maybe a) (Map k a)
forall a b. a -> b -> StrictPair a b
:*: k -> a -> Map k a
forall k a. k -> a -> Map k a
singleton k
kx a
x)
    go k -> a -> a -> a
f k
kx a
x (Bin Int
sy k
ky a
y Map k a
l Map k a
r) =
        case k -> k -> Ordering
forall a. Ord a => a -> a -> Ordering
compare k
kx k
ky of
            Ordering
LT -> let !(Maybe a
found :*: Map k a
l') = (k -> a -> a -> a)
-> k -> a -> Map k a -> StrictPair (Maybe a) (Map k a)
forall k a.
Ord k =>
(k -> a -> a -> a)
-> k -> a -> Map k a -> StrictPair (Maybe a) (Map k a)
go k -> a -> a -> a
f k
kx a
x Map k a
l
                      !t' :: Map k a
t' = k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceL k
ky a
y Map k a
l' Map k a
r
                  in (Maybe a
found Maybe a -> Map k a -> StrictPair (Maybe a) (Map k a)
forall a b. a -> b -> StrictPair a b
:*: Map k a
t')
            Ordering
GT -> let !(Maybe a
found :*: Map k a
r') = (k -> a -> a -> a)
-> k -> a -> Map k a -> StrictPair (Maybe a) (Map k a)
forall k a.
Ord k =>
(k -> a -> a -> a)
-> k -> a -> Map k a -> StrictPair (Maybe a) (Map k a)
go k -> a -> a -> a
f k
kx a
x Map k a
r
                      !t' :: Map k a
t' = k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceR k
ky a
y Map k a
l Map k a
r'
                  in (Maybe a
found Maybe a -> Map k a -> StrictPair (Maybe a) (Map k a)
forall a b. a -> b -> StrictPair a b
:*: Map k a
t')
            Ordering
EQ -> (a -> Maybe a
forall a. a -> Maybe a
Just a
y Maybe a -> Map k a -> StrictPair (Maybe a) (Map k a)
forall a b. a -> b -> StrictPair a b
:*: Int -> k -> a -> Map k a -> Map k a -> Map k a
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 :: k -> Map k a -> Map k a
delete = k -> Map k a -> Map k a
forall k a. Ord k => k -> Map k a -> Map k a
go
  where
    go :: Ord k => k -> Map k a -> Map k a
    go :: k -> Map k a -> Map k a
go !k
_ Map k a
Tip = Map k a
forall k a. Map k a
Tip
    go k
k t :: Map k a
t@(Bin Int
_ k
kx a
x Map k a
l Map k a
r) =
        case k -> k -> Ordering
forall a. Ord a => a -> a -> Ordering
compare k
k k
kx of
            Ordering
LT | Map k a
l' Map k a -> Map k a -> Bool
forall a. a -> a -> Bool
`ptrEq` Map k a
l -> Map k a
t
               | Bool
otherwise -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceR k
kx a
x Map k a
l' Map k a
r
               where !l' :: Map k a
l' = k -> Map k a -> Map k a
forall k a. Ord k => k -> Map k a -> Map k a
go k
k Map k a
l
            Ordering
GT | Map k a
r' Map k a -> Map k a -> Bool
forall a. a -> a -> Bool
`ptrEq` Map k a
r -> Map k a
t
               | Bool
otherwise -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceL k
kx a
x Map k a
l Map k a
r'
               where !r' :: Map k a
r' = k -> Map k a -> Map k a
forall k a. Ord k => k -> Map k a -> Map k a
go k
k Map k a
r
            Ordering
EQ -> Map k a -> Map k a -> Map k a
forall k a. Map k a -> Map k a -> Map k a
glue Map k a
l Map k a
r
#if __GLASGOW_HASKELL__
{-# INLINABLE delete #-}
#else
{-# INLINE delete #-}
#endif

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

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

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

adjustWithKey :: Ord k => (k -> a -> a) -> k -> Map k a -> Map k a
adjustWithKey :: (k -> a -> a) -> k -> Map k a -> Map k a
adjustWithKey = (k -> a -> a) -> k -> Map k a -> Map k a
forall k a. Ord k => (k -> a -> a) -> k -> Map k a -> Map k a
go
  where
    go :: Ord k => (k -> a -> a) -> k -> Map k a -> Map k a
    go :: (k -> a -> a) -> k -> Map k a -> Map k a
go k -> a -> a
_ !k
_ Map k a
Tip = Map k a
forall k a. Map k a
Tip
    go k -> a -> a
f k
k (Bin Int
sx k
kx a
x Map k a
l Map k a
r) =
        case k -> k -> Ordering
forall a. Ord a => a -> a -> Ordering
compare k
k k
kx of
           Ordering
LT -> Int -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin Int
sx k
kx a
x ((k -> a -> a) -> k -> Map k a -> Map k a
forall k a. Ord k => (k -> a -> a) -> k -> Map k a -> Map k a
go k -> a -> a
f k
k Map k a
l) Map k a
r
           Ordering
GT -> Int -> k -> a -> Map k a -> Map k a -> Map k a
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 ((k -> a -> a) -> k -> Map k a -> Map k a
forall k a. Ord k => (k -> a -> a) -> k -> Map k a -> Map k a
go k -> a -> a
f k
k Map k a
r)
           Ordering
EQ -> Int -> k -> a -> Map k a -> Map k a -> Map k a
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 :: (a -> Maybe a) -> k -> Map k a -> Map k a
update a -> Maybe a
f = (k -> a -> Maybe a) -> k -> Map k a -> Map k a
forall k a. Ord k => (k -> a -> Maybe a) -> k -> Map k a -> Map k a
updateWithKey (\k
_ a
x -> a -> Maybe a
f a
x)
#if __GLASGOW_HASKELL__
{-# INLINABLE update #-}
#else
{-# INLINE update #-}
#endif

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

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

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

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

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

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

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

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

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

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

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

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

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

{-# INLINE atKeyImpl #-}

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

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

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

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

-- Insert at a location (which will always be a leaf)
-- described by the path passed in.
insertAlong :: BitQueue -> k -> a -> Map k a -> Map k a
insertAlong :: BitQueue -> k -> a -> Map k a -> Map k a
insertAlong !BitQueue
_ k
kx a
x Map k a
Tip = k -> a -> Map k a
forall k a. k -> a -> Map k a
singleton k
kx a
x
insertAlong BitQueue
q k
kx a
x (Bin 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) -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceL k
ky a
y (BitQueue -> k -> a -> Map k a -> Map k a
forall k a. BitQueue -> k -> a -> Map k a -> Map k a
insertAlong BitQueue
tl k
kx a
x Map k a
l) Map k a
r
        Just (Bool
True,BitQueue
tl) -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceR k
ky a
y Map k a
l (BitQueue -> k -> a -> Map k a -> Map k a
forall k a. BitQueue -> k -> a -> Map k a -> Map k a
insertAlong BitQueue
tl k
kx a
x Map k a
r)
        Maybe (Bool, BitQueue)
Nothing -> Int -> k -> a -> Map k a -> Map k a -> Map k a
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 :: any -> BitQueue -> Map k a -> Map k a
deleteAlong any
old !BitQueue
q0 !Map k a
m = Proxy# () -> BitQueue -> Map k a -> Map k a
forall k a. Proxy# () -> BitQueue -> Map k a -> Map k a
go (any -> Proxy# ()
forall a. a -> Proxy# ()
bogus any
old) BitQueue
q0 Map k a
m where
#ifdef USE_MAGIC_PROXY
  go :: Proxy# () -> BitQueue -> Map k a -> Map k a
#else
  go :: any -> BitQueue -> Map k a -> Map k a
#endif
  go :: Proxy# () -> BitQueue -> Map k a -> Map k a
go !Proxy# ()
_ !BitQueue
_ Map k a
Tip = Map k a
forall k a. Map k a
Tip
  go Proxy# ()
foom BitQueue
q (Bin 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) -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceR k
ky a
y (Proxy# () -> BitQueue -> Map k a -> Map k a
forall k a. Proxy# () -> BitQueue -> Map k a -> Map k a
go Proxy# ()
foom BitQueue
tl Map k a
l) Map k a
r
        Just (Bool
True, BitQueue
tl) -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceL k
ky a
y Map k a
l (Proxy# () -> BitQueue -> Map k a -> Map k a
forall k a. Proxy# () -> BitQueue -> Map k a -> Map k a
go Proxy# ()
foom BitQueue
tl Map k a
r)
        Maybe (Bool, BitQueue)
Nothing -> Map k a -> Map k a -> Map k a
forall k a. Map k a -> Map k a -> Map k a
glue Map k a
l Map k a
r

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

-- Replace the value found in the node described
-- by the given path with a new one.
replaceAlong :: BitQueue -> a -> Map k a -> Map k a
replaceAlong :: BitQueue -> a -> Map k a -> Map k a
replaceAlong !BitQueue
_ a
_ Map k a
Tip = Map k a
forall k a. Map k a
Tip -- Should not happen
replaceAlong BitQueue
q  a
x (Bin 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) -> Int -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin Int
sz k
ky a
y (BitQueue -> a -> Map k a -> Map k a
forall a k. BitQueue -> a -> Map k a -> Map k a
replaceAlong BitQueue
tl a
x Map k a
l) Map k a
r
        Just (Bool
True,BitQueue
tl) -> Int -> k -> a -> Map k a -> Map k a -> Map k a
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 (BitQueue -> a -> Map k a -> Map k a
forall a k. BitQueue -> a -> Map k a -> Map k a
replaceAlong BitQueue
tl a
x Map k a
r)
        Maybe (Bool, BitQueue)
Nothing -> Int -> k -> a -> Map k a -> Map k a -> Map k a
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

#ifdef __GLASGOW_HASKELL__
atKeyIdentity :: Ord k => k -> (Maybe a -> Identity (Maybe a)) -> Map k a -> Identity (Map k a)
atKeyIdentity :: k
-> (Maybe a -> Identity (Maybe a)) -> Map k a -> Identity (Map k a)
atKeyIdentity k
k Maybe a -> Identity (Maybe a)
f Map k a
t = Map k a -> Identity (Map k a)
forall a. a -> Identity a
Identity (Map k a -> Identity (Map k a)) -> Map k a -> Identity (Map k a)
forall a b. (a -> b) -> a -> b
$ AreWeStrict -> k -> (Maybe a -> Maybe a) -> Map k a -> Map k a
forall k a.
Ord k =>
AreWeStrict -> k -> (Maybe a -> Maybe a) -> Map k a -> Map k a
atKeyPlain AreWeStrict
Lazy k
k ((Maybe a -> Identity (Maybe a)) -> Maybe a -> Maybe a
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 :: AreWeStrict -> k -> (Maybe a -> Maybe a) -> Map k a -> Map k a
atKeyPlain AreWeStrict
strict k
k0 Maybe a -> Maybe a
f0 Map k a
t = case k -> (Maybe a -> Maybe a) -> Map k a -> Altered k a
forall k a.
Ord k =>
k -> (Maybe a -> Maybe a) -> Map k a -> Altered k a
go k
k0 Maybe a -> Maybe a
f0 Map k a
t of
    AltSmaller Map k a
t' -> Map k a
t'
    AltBigger Map k a
t' -> Map k a
t'
    AltAdj Map k a
t' -> Map k a
t'
    Altered k a
AltSame -> Map k a
t
  where
    go :: Ord k => k -> (Maybe a -> Maybe a) -> Map k a -> Altered k a
    go :: k -> (Maybe a -> Maybe a) -> Map k a -> Altered k a
go !k
k Maybe a -> Maybe a
f Map k a
Tip = case Maybe a -> Maybe a
f Maybe a
forall a. Maybe a
Nothing of
                   Maybe a
Nothing -> Altered k a
forall k a. Altered k a
AltSame
                   Just a
x  -> case AreWeStrict
strict of
                     AreWeStrict
Lazy -> Map k a -> Altered k a
forall k a. Map k a -> Altered k a
AltBigger (Map k a -> Altered k a) -> Map k a -> Altered k a
forall a b. (a -> b) -> a -> b
$ k -> a -> Map k a
forall k a. k -> a -> Map k a
singleton k
k a
x
                     AreWeStrict
Strict -> a
x a -> Altered k a -> Altered k a
`seq` (Map k a -> Altered k a
forall k a. Map k a -> Altered k a
AltBigger (Map k a -> Altered k a) -> Map k a -> Altered k a
forall a b. (a -> b) -> a -> b
$ k -> a -> Map k a
forall k a. k -> a -> Map k a
singleton k
k a
x)

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

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

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

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

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

-- See Note: Type of local 'go' function
findIndex :: Ord k => k -> Map k a -> Int
findIndex :: k -> Map k a -> Int
findIndex = Int -> k -> Map k a -> Int
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 :: Int -> k -> Map k a -> Int
go !Int
_   !k
_ Map k a
Tip  = [Char] -> Int
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 k -> k -> Ordering
forall a. Ord a => a -> a -> Ordering
compare k
k k
kx of
      Ordering
LT -> Int -> k -> Map k a -> Int
forall k a. Ord k => Int -> k -> Map k a -> Int
go Int
idx k
k Map k a
l
      Ordering
GT -> Int -> k -> Map k a -> Int
forall k a. Ord k => Int -> k -> Map k a -> Int
go (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Map k a -> Int
forall k a. Map k a -> Int
size Map k a
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) k
k Map k a
r
      Ordering
EQ -> Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Map k a -> Int
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 :: k -> Map k a -> Maybe Int
lookupIndex = Int -> k -> Map k a -> Maybe Int
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 :: Int -> k -> Map k a -> Maybe Int
go !Int
_  !k
_ Map k a
Tip  = Maybe Int
forall a. Maybe a
Nothing
    go Int
idx k
k (Bin Int
_ k
kx a
_ Map k a
l Map k a
r) = case k -> k -> Ordering
forall a. Ord a => a -> a -> Ordering
compare k
k k
kx of
      Ordering
LT -> Int -> k -> Map k a -> Maybe Int
forall k a. Ord k => Int -> k -> Map k a -> Maybe Int
go Int
idx k
k Map k a
l
      Ordering
GT -> Int -> k -> Map k a -> Maybe Int
forall k a. Ord k => Int -> k -> Map k a -> Maybe Int
go (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Map k a -> Int
forall k a. Map k a -> Int
size Map k a
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) k
k Map k a
r
      Ordering
EQ -> Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$! Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Map k a -> Int
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 :: Int -> Map k a -> (k, a)
elemAt !Int
_ Map k a
Tip = [Char] -> (k, a)
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 Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
i Int
sizeL of
      Ordering
LT -> Int -> Map k a -> (k, a)
forall k a. Int -> Map k a -> (k, a)
elemAt Int
i Map k a
l
      Ordering
GT -> Int -> Map k a -> (k, a)
forall k a. Int -> Map k a -> (k, a)
elemAt (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
sizeLInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Map k a
r
      Ordering
EQ -> (k
kx,a
x)
  where
    sizeL :: Int
sizeL = Map k a -> Int
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 :: Int -> Map k a -> Map k a
take Int
i Map k a
m | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Map k a -> Int
forall k a. Map k a -> Int
size Map k a
m = Map k a
m
take Int
i0 Map k a
m0 = Int -> Map k a -> Map k a
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = Map k a
forall k a. Map k a
Tip
    go !Int
_ Map k a
Tip = Map k a
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 Int -> Int -> Ordering
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 -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
link k
kx a
x Map k a
l (Int -> Map k a -> Map k a
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sizeL Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Map k a
r)
        Ordering
EQ -> Map k a
l
      where sizeL :: Int
sizeL = Map k a -> Int
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 :: Int -> Map k a -> Map k a
drop Int
i Map k a
m | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Map k a -> Int
forall k a. Map k a -> Int
size Map k a
m = Map k a
forall k a. Map k a
Tip
drop Int
i0 Map k a
m0 = Int -> Map k a -> Map k a
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = Map k a
m
    go !Int
_ Map k a
Tip = Map k a
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 Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
i Int
sizeL of
        Ordering
LT -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
link k
kx a
x (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 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sizeL Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Map k a
r
        Ordering
EQ -> k -> a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a
insertMin k
kx a
x Map k a
r
      where sizeL :: Int
sizeL = Map k a -> Int
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 :: Int -> Map k a -> (Map k a, Map k a)
splitAt Int
i0 Map k a
m0
  | Int
i0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Map k a -> Int
forall k a. Map k a -> Int
size Map k a
m0 = (Map k a
m0, Map k a
forall k a. Map k a
Tip)
  | Bool
otherwise = StrictPair (Map k a) (Map k a) -> (Map k a, Map k a)
forall a b. StrictPair a b -> (a, b)
toPair (StrictPair (Map k a) (Map k a) -> (Map k a, Map k a))
-> StrictPair (Map k a) (Map k a) -> (Map k a, Map k a)
forall a b. (a -> b) -> a -> b
$ Int -> Map k a -> StrictPair (Map k a) (Map k a)
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = Map k a
forall k a. Map k a
Tip Map k a -> Map k a -> StrictPair (Map k a) (Map k a)
forall a b. a -> b -> StrictPair a b
:*: Map k a
m
    go !Int
_ Map k a
Tip = Map k a
forall k a. Map k a
Tip Map k a -> Map k a -> StrictPair (Map k a) (Map k a)
forall a b. a -> b -> StrictPair a b
:*: Map k a
forall k a. Map k a
Tip
    go Int
i (Bin Int
_ k
kx a
x Map k a
l Map k a
r)
      = case Int -> Int -> Ordering
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 Map k a -> Map k a -> StrictPair (Map k a) (Map k a)
forall a b. a -> b -> StrictPair a b
:*: k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
link k
kx a
x Map k a
lr Map k a
r
          Ordering
GT -> case Int -> Map k a -> StrictPair (Map k a) (Map k a)
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sizeL Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Map k a
r of
                  Map k a
rl :*: Map k a
rr -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
link k
kx a
x Map k a
l Map k a
rl Map k a -> Map k a -> StrictPair (Map k a) (Map k a)
forall a b. a -> b -> StrictPair a b
:*: Map k a
rr
          Ordering
EQ -> Map k a
l Map k a -> Map k a -> StrictPair (Map k a) (Map k a)
forall a b. a -> b -> StrictPair a b
:*: k -> a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a
insertMin k
kx a
x Map k a
r
      where sizeL :: Int
sizeL = Map k a -> Int
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 :: (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 -> [Char] -> Map k a
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 Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
i Int
sizeL of
      Ordering
LT -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceR k
kx a
x ((k -> a -> Maybe a) -> Int -> Map k a -> Map k a
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 -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceL k
kx a
x Map k a
l ((k -> a -> Maybe a) -> Int -> Map k a -> Map k a
forall k a. (k -> a -> Maybe a) -> Int -> Map k a -> Map k a
updateAt k -> a -> Maybe a
f (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
sizeLInt -> Int -> Int
forall 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' -> Int -> k -> a -> Map k a -> Map k a -> Map k a
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 -> Map k a -> Map k a -> Map k a
forall k a. Map k a -> Map k a -> Map k a
glue Map k a
l Map k a
r
      where
        sizeL :: Int
sizeL = Map k a -> Int
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 :: Int -> Map k a -> Map k a
deleteAt !Int
i Map k a
t =
  case Map k a
t of
    Map k a
Tip -> [Char] -> Map k a
forall a. HasCallStack => [Char] -> a
error [Char]
"Map.deleteAt: index out of range"
    Bin Int
_ k
kx a
x Map k a
l Map k a
r -> case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
i Int
sizeL of
      Ordering
LT -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceR k
kx a
x (Int -> Map k a -> Map k a
forall k a. Int -> Map k a -> Map k a
deleteAt Int
i Map k a
l) Map k a
r
      Ordering
GT -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceL k
kx a
x Map k a
l (Int -> Map k a -> Map k a
forall k a. Int -> Map k a -> Map k a
deleteAt (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
sizeLInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Map k a
r)
      Ordering
EQ -> Map k a -> Map k a -> Map k a
forall k a. Map k a -> Map k a -> Map k a
glue Map k a
l Map k a
r
      where
        sizeL :: Int
sizeL = Map k a -> Int
forall k a. Map k a -> Int
size Map k a
l


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

lookupMinSure :: k -> a -> Map k a -> (k, a)
lookupMinSure :: 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
_) = k -> a -> Map k a -> (k, a)
forall k a. k -> a -> Map k a -> (k, a)
lookupMinSure k
k a
a Map k a
l

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

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

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

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

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

lookupMaxSure :: k -> a -> Map k a -> (k, a)
lookupMaxSure :: 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) = k -> a -> Map k a -> (k, a)
forall k a. k -> a -> Map k a -> (k, a)
lookupMaxSure k
k a
a Map k a
r

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

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

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

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

deleteMin :: Map k a -> Map k a
deleteMin :: 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)    = k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceR k
kx a
x (Map k a -> Map k a
forall k a. Map k a -> Map k a
deleteMin Map k a
l) Map k a
r
deleteMin Map k a
Tip                 = Map k a
forall k a. Map k a
Tip

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

deleteMax :: Map k a -> Map k a
deleteMax :: 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)    = k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceL k
kx a
x Map k a
l (Map k a -> Map k a
forall k a. Map k a -> Map k a
deleteMax Map k a
r)
deleteMax Map k a
Tip                 = Map k a
forall k a. Map k a
Tip

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

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

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

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


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

updateMinWithKey :: (k -> a -> Maybe a) -> Map k a -> Map k a
updateMinWithKey :: (k -> a -> Maybe a) -> Map k a -> Map k a
updateMinWithKey k -> a -> Maybe a
_ Map k a
Tip                 = Map k a
forall k a. Map k a
Tip
updateMinWithKey k -> a -> Maybe a
f (Bin 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' -> Int -> k -> a -> Map k a -> Map k a -> Map k a
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
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)    = k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceR k
kx a
x ((k -> a -> Maybe a) -> Map k a -> Map k a
forall k a. (k -> a -> Maybe a) -> Map k a -> Map k a
updateMinWithKey k -> a -> Maybe a
f Map k a
l) Map k a
r

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

updateMaxWithKey :: (k -> a -> Maybe a) -> Map k a -> Map k a
updateMaxWithKey :: (k -> a -> Maybe a) -> Map k a -> Map k a
updateMaxWithKey k -> a -> Maybe a
_ Map k a
Tip                 = Map k a
forall k a. Map k a
Tip
updateMaxWithKey k -> a -> Maybe a
f (Bin 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' -> Int -> k -> a -> Map k a -> Map k a -> Map k a
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
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)    = k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceL k
kx a
x Map k a
l ((k -> a -> Maybe a) -> Map k a -> Map k a
forall k a. (k -> a -> Maybe a) -> Map k a -> Map k a
updateMaxWithKey k -> a -> Maybe a
f Map k a
r)

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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


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

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

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

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

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

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

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

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

-- See 'Data.Set.Internal.isSubsetOfX' for some background
-- on the implementation design.
disjoint :: Ord k => Map k a -> Map k b -> Bool
disjoint :: 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 k -> Map k b -> Bool
forall t a. Ord t => t -> Map t 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
&& Map k a -> Map k b -> Bool
forall k a b. Ord k => Map k a -> Map k b -> Bool
disjoint Map k a
l Map k b
lt Bool -> Bool -> Bool
&& Map k a -> Map k b -> Bool
forall k a b. Ord k => Map k a -> Map k b -> Bool
disjoint Map k a
r Map k b
gt
  where
    (Map k b
lt,Bool
found,Map k b
gt) = k -> Map k b -> (Map k b, Bool, Map k b)
forall k a. Ord k => k -> Map k a -> (Map k a, Bool, Map k a)
splitMember k
k Map k b
t

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

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

data WhenMissing f k x y = WhenMissing
  { WhenMissing f k x y -> Map k x -> f (Map k y)
missingSubtree :: Map k x -> f (Map k 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 :: (a -> b) -> WhenMissing f k x a -> WhenMissing f k x b
fmap = (a -> b) -> WhenMissing f k x a -> WhenMissing f k x b
forall (f :: * -> *) a b k x.
(Applicative f, Monad f) =>
(a -> b) -> WhenMissing f k x a -> WhenMissing f k x b
mapWhenMissing
  {-# INLINE fmap #-}

-- | @since 0.5.9
instance (Applicative f, Monad f)
         => Category.Category (WhenMissing f k) where
  id :: WhenMissing f k a a
id = WhenMissing f k a a
forall (f :: * -> *) k x. Applicative f => WhenMissing f k x x
preserveMissing
  WhenMissing f k b c
f . :: WhenMissing f k b c -> WhenMissing f k a b -> WhenMissing f k a c
. WhenMissing f k a b
g = (k -> a -> f (Maybe c)) -> WhenMissing f k a c
forall (f :: * -> *) k x y.
Applicative f =>
(k -> x -> f (Maybe y)) -> WhenMissing f k x y
traverseMaybeMissing ((k -> a -> f (Maybe c)) -> WhenMissing f k a c)
-> (k -> a -> f (Maybe c)) -> WhenMissing f k a c
forall a b. (a -> b) -> a -> b
$
    \ k
k a
x -> WhenMissing f k a b -> k -> a -> f (Maybe b)
forall (f :: * -> *) k x y.
WhenMissing f k x y -> k -> x -> f (Maybe y)
missingKey WhenMissing f k a b
g k
k a
x f (Maybe b) -> (Maybe b -> f (Maybe c)) -> f (Maybe c)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Maybe b
y ->
         case Maybe b
y of
           Maybe b
Nothing -> Maybe c -> f (Maybe c)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe c
forall a. Maybe a
Nothing
           Just b
q -> WhenMissing f k b c -> k -> b -> f (Maybe c)
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 :: a -> WhenMissing f k x a
pure a
x = (k -> x -> a) -> WhenMissing f k x a
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 <*> :: WhenMissing f k x (a -> b)
-> WhenMissing f k x a -> WhenMissing f k x b
<*> WhenMissing f k x a
g = (k -> x -> f (Maybe b)) -> WhenMissing f k x b
forall (f :: * -> *) k x y.
Applicative f =>
(k -> x -> f (Maybe y)) -> WhenMissing f k x y
traverseMaybeMissing ((k -> x -> f (Maybe b)) -> WhenMissing f k x b)
-> (k -> x -> f (Maybe b)) -> WhenMissing f k x b
forall a b. (a -> b) -> a -> b
$ \k
k x
x -> do
         Maybe (a -> b)
res1 <- WhenMissing f k x (a -> b) -> k -> x -> f (Maybe (a -> b))
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 -> Maybe b -> f (Maybe b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe b
forall a. Maybe a
Nothing
           Just a -> b
r -> (Maybe b -> f (Maybe b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe b -> f (Maybe b)) -> Maybe b -> f (Maybe b)
forall a b. (a -> b) -> a -> b
$!) (Maybe b -> f (Maybe b))
-> (Maybe a -> Maybe b) -> Maybe a -> f (Maybe b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
r (Maybe a -> f (Maybe b)) -> f (Maybe a) -> f (Maybe b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< WhenMissing f k x a -> k -> x -> f (Maybe a)
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
  WhenMissing f k x a
m >>= :: WhenMissing f k x a
-> (a -> WhenMissing f k x b) -> WhenMissing f k x b
>>= a -> WhenMissing f k x b
f = (k -> x -> f (Maybe b)) -> WhenMissing f k x b
forall (f :: * -> *) k x y.
Applicative f =>
(k -> x -> f (Maybe y)) -> WhenMissing f k x y
traverseMaybeMissing ((k -> x -> f (Maybe b)) -> WhenMissing f k x b)
-> (k -> x -> f (Maybe b)) -> WhenMissing f k x b
forall a b. (a -> b) -> a -> b
$ \k
k x
x -> do
         Maybe a
res1 <- WhenMissing f k x a -> k -> x -> f (Maybe a)
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 -> Maybe b -> f (Maybe b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe b
forall a. Maybe a
Nothing
           Just a
r -> WhenMissing f k x b -> k -> x -> f (Maybe b)
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 f k x b
mapWhenMissing :: (a -> b) -> WhenMissing f k x a -> WhenMissing f k x b
mapWhenMissing a -> b
f WhenMissing f k x a
t = WhenMissing :: forall (f :: * -> *) k x y.
(Map k x -> f (Map k y))
-> (k -> x -> f (Maybe y)) -> WhenMissing f k x y
WhenMissing
    { missingSubtree :: Map k x -> f (Map k b)
missingSubtree = \Map k x
m -> WhenMissing f k x a -> Map k x -> f (Map k a)
forall (f :: * -> *) k x y.
WhenMissing f k x y -> Map k x -> f (Map k y)
missingSubtree WhenMissing f k x a
t Map k x
m f (Map k a) -> (Map k a -> f (Map k b)) -> f (Map k b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Map k a
m' -> Map k b -> f (Map k b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map k b -> f (Map k b)) -> Map k b -> f (Map k b)
forall a b. (a -> b) -> a -> b
$! (a -> b) -> Map k a -> Map k b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Map k a
m'
    , missingKey :: k -> x -> f (Maybe b)
missingKey = \k
k x
x -> WhenMissing f k x a -> k -> x -> f (Maybe a)
forall (f :: * -> *) k x y.
WhenMissing f k x y -> k -> x -> f (Maybe y)
missingKey WhenMissing f k x a
t k
k x
x f (Maybe a) -> (Maybe a -> f (Maybe b)) -> f (Maybe b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Maybe a
q -> (Maybe b -> f (Maybe b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe b -> f (Maybe b)) -> Maybe b -> f (Maybe b)
forall a b. (a -> b) -> a -> b
$! (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Maybe a
q) }
{-# INLINE mapWhenMissing #-}

-- | Map covariantly over a @'WhenMissing' f k x@, using only a 'Functor f'
-- constraint.
mapGentlyWhenMissing :: Functor f
               => (a -> b)
               -> WhenMissing f k x a -> WhenMissing f k x b
mapGentlyWhenMissing :: (a -> b) -> WhenMissing f k x a -> WhenMissing f k x b
mapGentlyWhenMissing a -> b
f WhenMissing f k x a
t = WhenMissing :: forall (f :: * -> *) k x y.
(Map k x -> f (Map k y))
-> (k -> x -> f (Maybe y)) -> WhenMissing f k x y
WhenMissing
    { missingSubtree :: Map k x -> f (Map k b)
missingSubtree = \Map k x
m -> (a -> b) -> Map k a -> Map k b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (Map k a -> Map k b) -> f (Map k a) -> f (Map k b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WhenMissing f k x a -> Map k x -> f (Map k a)
forall (f :: * -> *) k x y.
WhenMissing f k x y -> Map k x -> f (Map k y)
missingSubtree WhenMissing f k x a
t Map k x
m
    , missingKey :: k -> x -> f (Maybe b)
missingKey = \k
k x
x -> (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (Maybe a -> Maybe b) -> f (Maybe a) -> f (Maybe b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WhenMissing f k x a -> k -> x -> f (Maybe a)
forall (f :: * -> *) k x y.
WhenMissing f k x y -> k -> x -> f (Maybe y)
missingKey WhenMissing f k x a
t k
k x
x }
{-# INLINE mapGentlyWhenMissing #-}

-- | Map covariantly over a @'WhenMatched' f k x@, using only a 'Functor f'
-- constraint.
mapGentlyWhenMatched :: Functor f
               => (a -> b)
               -> WhenMatched f k x y a -> WhenMatched f k x y b
mapGentlyWhenMatched :: (a -> b) -> WhenMatched f k x y a -> WhenMatched f k x y b
mapGentlyWhenMatched a -> b
f WhenMatched f k x y a
t = (k -> x -> y -> f (Maybe b)) -> WhenMatched f k x y b
forall k x y (f :: * -> *) z.
(k -> x -> y -> f (Maybe z)) -> WhenMatched f k x y z
zipWithMaybeAMatched ((k -> x -> y -> f (Maybe b)) -> WhenMatched f k x y b)
-> (k -> x -> y -> f (Maybe b)) -> WhenMatched f k x y b
forall a b. (a -> b) -> a -> b
$
  \k
k x
x y
y -> (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (Maybe a -> Maybe b) -> f (Maybe a) -> f (Maybe b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WhenMatched f k x y a -> k -> x -> y -> f (Maybe a)
forall (f :: * -> *) k x y z.
WhenMatched f k x y z -> k -> x -> y -> f (Maybe z)
runWhenMatched WhenMatched f k x y a
t k
k x
x y
y
{-# INLINE mapGentlyWhenMatched #-}

-- | Map contravariantly over a @'WhenMissing' f k _ x@.
--
-- @since 0.5.9
lmapWhenMissing :: (b -> a) -> WhenMissing f k a x -> WhenMissing f k b x
lmapWhenMissing :: (b -> a) -> WhenMissing f k a x -> WhenMissing f k b x
lmapWhenMissing b -> a
f WhenMissing f k a x
t = WhenMissing :: forall (f :: * -> *) k x y.
(Map k x -> f (Map k y))
-> (k -> x -> f (Maybe y)) -> WhenMissing f k x y
WhenMissing
  { missingSubtree :: Map k b -> f (Map k x)
missingSubtree = \Map k b
m -> WhenMissing f k a x -> Map k a -> f (Map k x)
forall (f :: * -> *) k x y.
WhenMissing f k x y -> Map k x -> f (Map k y)
missingSubtree WhenMissing f k a x
t ((b -> a) -> Map k b -> Map k a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> a
f Map k b
m)
  , missingKey :: k -> b -> f (Maybe x)
missingKey = \k
k b
x -> WhenMissing f k a x -> k -> a -> f (Maybe x)
forall (f :: * -> *) k x y.
WhenMissing f k x y -> k -> x -> f (Maybe y)
missingKey WhenMissing f k a x
t k
k (b -> a
f b
x) }
{-# INLINE lmapWhenMissing #-}

-- | Map contravariantly over a @'WhenMatched' f k _ y z@.
--
-- @since 0.5.9
contramapFirstWhenMatched :: (b -> a)
                          -> WhenMatched f k a y z
                          -> WhenMatched f k b y z
contramapFirstWhenMatched :: (b -> a) -> WhenMatched f k a y z -> WhenMatched f k b y z
contramapFirstWhenMatched b -> a
f WhenMatched f k a y z
t = (k -> b -> y -> f (Maybe z)) -> WhenMatched f k b y z
forall (f :: * -> *) k x y z.
(k -> x -> y -> f (Maybe z)) -> WhenMatched f k x y z
WhenMatched ((k -> b -> y -> f (Maybe z)) -> WhenMatched f k b y z)
-> (k -> b -> y -> f (Maybe z)) -> WhenMatched f k b y z
forall a b. (a -> b) -> a -> b
$
  \k
k b
x y
y -> WhenMatched f k a y z -> k -> a -> y -> f (Maybe z)
forall (f :: * -> *) k x y z.
WhenMatched f k x y z -> k -> x -> y -> f (Maybe z)
runWhenMatched WhenMatched f k a y z
t k
k (b -> a
f b
x) y
y
{-# INLINE contramapFirstWhenMatched #-}

-- | Map contravariantly over a @'WhenMatched' f k x _ z@.
--
-- @since 0.5.9
contramapSecondWhenMatched :: (b -> a)
                           -> WhenMatched f k x a z
                           -> WhenMatched f k x b z
contramapSecondWhenMatched :: (b -> a) -> WhenMatched f k x a z -> WhenMatched f k x b z
contramapSecondWhenMatched b -> a
f WhenMatched f k x a z
t = (k -> x -> b -> f (Maybe z)) -> WhenMatched f k x b z
forall (f :: * -> *) k x y z.
(k -> x -> y -> f (Maybe z)) -> WhenMatched f k x y z
WhenMatched ((k -> x -> b -> f (Maybe z)) -> WhenMatched f k x b z)
-> (k -> x -> b -> f (Maybe z)) -> WhenMatched f k x b z
forall a b. (a -> b) -> a -> b
$
  \k
k x
x b
y -> WhenMatched f k x a z -> k -> x -> a -> f (Maybe z)
forall (f :: * -> *) k x y z.
WhenMatched f k x y z -> k -> x -> y -> f (Maybe z)
runWhenMatched WhenMatched f k x a z
t k
k x
x (b -> a
f b
y)
{-# INLINE contramapSecondWhenMatched #-}

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

-- | A tactic for dealing with keys present in both
-- maps in 'merge' or 'mergeA'.
--
-- A tactic of type @ WhenMatched f k x y z @ is an abstract representation
-- of a function of type @ k -> x -> y -> f (Maybe z) @.
--
-- @since 0.5.9
newtype WhenMatched f k x y z = WhenMatched
  { WhenMatched f k x y z -> k -> x -> y -> f (Maybe z)
matchedKey :: k -> x -> y -> f (Maybe z) }

-- | Along with zipWithMaybeAMatched, witnesses the isomorphism between
-- @WhenMatched f k x y z@ and @k -> x -> y -> f (Maybe z)@.
--
-- @since 0.5.9
runWhenMatched :: WhenMatched f k x y z -> k -> x -> y -> f (Maybe z)
runWhenMatched :: WhenMatched f k x y z -> k -> x -> y -> f (Maybe z)
runWhenMatched = WhenMatched f k x y z -> k -> x -> y -> f (Maybe z)
forall (f :: * -> *) k x y z.
WhenMatched f k x y z -> k -> x -> y -> f (Maybe z)
matchedKey
{-# INLINE runWhenMatched #-}

-- | Along with traverseMaybeMissing, witnesses the isomorphism between
-- @WhenMissing f k x y@ and @k -> x -> f (Maybe y)@.
--
-- @since 0.5.9
runWhenMissing :: WhenMissing f k x y -> k -> x -> f (Maybe y)
runWhenMissing :: WhenMissing f k x y -> k -> x -> f (Maybe y)
runWhenMissing = WhenMissing f k x y -> k -> x -> f (Maybe y)
forall (f :: * -> *) k x y.
WhenMissing f k x y -> k -> x -> f (Maybe y)
missingKey
{-# INLINE runWhenMissing #-}

-- | @since 0.5.9
instance Functor f => Functor (WhenMatched f k x y) where
  fmap :: (a -> b) -> WhenMatched f k x y a -> WhenMatched f k x y b
fmap = (a -> b) -> WhenMatched f k x y a -> WhenMatched f k x y b
forall (f :: * -> *) a b k x y.
Functor f =>
(a -> b) -> WhenMatched f k x y a -> WhenMatched f k x y b
mapWhenMatched
  {-# INLINE fmap #-}

-- | @since 0.5.9
instance (Monad f, Applicative f) => Category.Category (WhenMatched f k x) where
  id :: WhenMatched f k x a a
id = (k -> x -> a -> a) -> WhenMatched f k x a a
forall (f :: * -> *) k x y z.
Applicative f =>
(k -> x -> y -> z) -> WhenMatched f k x y z
zipWithMatched (\k
_ x
_ a
y -> a
y)
  WhenMatched f k x b c
f . :: WhenMatched f k x b c
-> WhenMatched f k x a b -> WhenMatched f k x a c
. WhenMatched f k x a b
g = (k -> x -> a -> f (Maybe c)) -> WhenMatched f k x a c
forall k x y (f :: * -> *) z.
(k -> x -> y -> f (Maybe z)) -> WhenMatched f k x y z
zipWithMaybeAMatched ((k -> x -> a -> f (Maybe c)) -> WhenMatched f k x a c)
-> (k -> x -> a -> f (Maybe c)) -> WhenMatched f k x a c
forall a b. (a -> b) -> a -> b
$
            \k
k x
x a
y -> do
              Maybe b
res <- WhenMatched f k x a b -> k -> x -> a -> f (Maybe b)
forall (f :: * -> *) k x y z.
WhenMatched f k x y z -> k -> x -> y -> f (Maybe z)
runWhenMatched WhenMatched f k x a b
g k
k x
x a
y
              case Maybe b
res of
                Maybe b
Nothing -> Maybe c -> f (Maybe c)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe c
forall a. Maybe a
Nothing
                Just b
r -> WhenMatched f k x b c -> k -> x -> b -> f (Maybe c)
forall (f :: * -> *) k x y z.
WhenMatched f k x y z -> k -> x -> y -> f (Maybe z)
runWhenMatched WhenMatched f k x b c
f k
k x
x b
r
  {-# INLINE id #-}
  {-# INLINE (.) #-}

-- | Equivalent to @ ReaderT k (ReaderT x (ReaderT y (MaybeT f))) @
--
-- @since 0.5.9
instance (Monad f, Applicative f) => Applicative (WhenMatched f k x y) where
  pure :: a -> WhenMatched f k x y a
pure a
x = (k -> x -> y -> a) -> WhenMatched f k x y a
forall (f :: * -> *) k x y z.
Applicative f =>
(k -> x -> y -> z) -> WhenMatched f k x y z
zipWithMatched (\k
_ x
_ y
_ -> a
x)
  WhenMatched f k x y (a -> b)
fs <*> :: WhenMatched f k x y (a -> b)
-> WhenMatched f k x y a -> WhenMatched f k x y b
<*> WhenMatched f k x y a
xs = (k -> x -> y -> f (Maybe b)) -> WhenMatched f k x y b
forall k x y (f :: * -> *) z.
(k -> x -> y -> f (Maybe z)) -> WhenMatched f k x y z
zipWithMaybeAMatched ((k -> x -> y -> f (Maybe b)) -> WhenMatched f k x y b)
-> (k -> x -> y -> f (Maybe b)) -> WhenMatched f k x y b
forall a b. (a -> b) -> a -> b
$ \k
k x
x y
y -> do
    Maybe (a -> b)
res <- WhenMatched f k x y (a -> b) -> k -> x -> y -> f (Maybe (a -> b))
forall (f :: * -> *) k x y z.
WhenMatched f k x y z -> k -> x -> y -> f (Maybe z)
runWhenMatched WhenMatched f k x y (a -> b)
fs k
k x
x y
y
    case Maybe (a -> b)
res of
      Maybe (a -> b)
Nothing -> Maybe b -> f (Maybe b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe b
forall a. Maybe a
Nothing
      Just a -> b
r -> (Maybe b -> f (Maybe b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe b -> f (Maybe b)) -> Maybe b -> f (Maybe b)
forall a b. (a -> b) -> a -> b
$!) (Maybe b -> f (Maybe b))
-> (Maybe a -> Maybe b) -> Maybe a -> f (Maybe b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
r (Maybe a -> f (Maybe b)) -> f (Maybe a) -> f (Maybe b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< WhenMatched f k x y a -> k -> x -> y -> f (Maybe a)
forall (f :: * -> *) k x y z.
WhenMatched f k x y z -> k -> x -> y -> f (Maybe z)
runWhenMatched WhenMatched f k x y a
xs k
k x
x y
y
  {-# INLINE pure #-}
  {-# INLINE (<*>) #-}

-- | Equivalent to @ ReaderT k (ReaderT x (ReaderT y (MaybeT f))) @
--
-- @since 0.5.9
instance (Monad f, Applicative f) => Monad (WhenMatched f k x y) where
  WhenMatched f k x y a
m >>= :: WhenMatched f k x y a
-> (a -> WhenMatched f k x y b) -> WhenMatched f k x y b
>>= a -> WhenMatched f k x y b
f = (k -> x -> y -> f (Maybe b)) -> WhenMatched f k x y b
forall k x y (f :: * -> *) z.
(k -> x -> y -> f (Maybe z)) -> WhenMatched f k x y z
zipWithMaybeAMatched ((k -> x -> y -> f (Maybe b)) -> WhenMatched f k x y b)
-> (k -> x -> y -> f (Maybe b)) -> WhenMatched f k x y b
forall a b. (a -> b) -> a -> b
$ \k
k x
x y
y -> do
    Maybe a
res <- WhenMatched f k x y a -> k -> x -> y -> f (Maybe a)
forall (f :: * -> *) k x y z.
WhenMatched f k x y z -> k -> x -> y -> f (Maybe z)
runWhenMatched WhenMatched f k x y a
m k
k x
x y
y
    case Maybe a
res of
      Maybe a
Nothing -> Maybe b -> f (Maybe b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe b
forall a. Maybe a
Nothing
      Just a
r -> WhenMatched f k x y b -> k -> x -> y -> f (Maybe b)
forall (f :: * -> *) k x y z.
WhenMatched f k x y z -> k -> x -> y -> f (Maybe z)
runWhenMatched (a -> WhenMatched f k x y b
f a
r) k
k x
x y
y
  {-# INLINE (>>=) #-}

-- | Map covariantly over a @'WhenMatched' f k x y@.
--
-- @since 0.5.9
mapWhenMatched :: Functor f
               => (a -> b)
               -> WhenMatched f k x y a
               -> WhenMatched f k x y b
mapWhenMatched :: (a -> b) -> WhenMatched f k x y a -> WhenMatched f k x y b
mapWhenMatched a -> b
f (WhenMatched k -> x -> y -> f (Maybe a)
g) = (k -> x -> y -> f (Maybe b)) -> WhenMatched f k x y b
forall (f :: * -> *) k x y z.
(k -> x -> y -> f (Maybe z)) -> WhenMatched f k x y z
WhenMatched ((k -> x -> y -> f (Maybe b)) -> WhenMatched f k x y b)
-> (k -> x -> y -> f (Maybe b)) -> WhenMatched f k x y b
forall a b. (a -> b) -> a -> b
$ \k
k x
x y
y -> (Maybe a -> Maybe b) -> f (Maybe a) -> f (Maybe b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) (k -> x -> y -> f (Maybe a)
g k
k x
x y
y)
{-# INLINE mapWhenMatched #-}

-- | A tactic for dealing with keys present in both maps in 'merge'.
--
-- A tactic of type @ SimpleWhenMatched k x y z @ is an abstract representation
-- of a function of type @ k -> x -> y -> Maybe z @.
--
-- @since 0.5.9
type SimpleWhenMatched = WhenMatched Identity

-- | When a key is found in both maps, apply a function to the
-- key and values and use the result in the merged map.
--
-- @
-- zipWithMatched :: (k -> x -> y -> z)
--                -> SimpleWhenMatched k x y z
-- @
--
-- @since 0.5.9
zipWithMatched :: Applicative f
               => (k -> x -> y -> z)
               -> WhenMatched f k x y z
zipWithMatched :: (k -> x -> y -> z) -> WhenMatched f k x y z
zipWithMatched k -> x -> y -> z
f = (k -> x -> y -> f (Maybe z)) -> WhenMatched f k x y z
forall (f :: * -> *) k x y z.
(k -> x -> y -> f (Maybe z)) -> WhenMatched f k x y z
WhenMatched ((k -> x -> y -> f (Maybe z)) -> WhenMatched f k x y z)
-> (k -> x -> y -> f (Maybe z)) -> WhenMatched f k x y z
forall a b. (a -> b) -> a -> b
$ \ k
k x
x y
y -> Maybe z -> f (Maybe z)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe z -> f (Maybe z)) -> (z -> Maybe z) -> z -> f (Maybe z)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. z -> Maybe z
forall a. a -> Maybe a
Just (z -> f (Maybe z)) -> z -> f (Maybe z)
forall a b. (a -> b) -> a -> b
$ k -> x -> y -> z
f k
k x
x y
y
{-# INLINE zipWithMatched #-}

-- | When a key is found in both maps, apply a function to the
-- key and values to produce an action and use its result in the merged map.
--
-- @since 0.5.9
zipWithAMatched :: Applicative f
                => (k -> x -> y -> f z)
                -> WhenMatched f k x y z
zipWithAMatched :: (k -> x -> y -> f z) -> WhenMatched f k x y z
zipWithAMatched k -> x -> y -> f z
f = (k -> x -> y -> f (Maybe z)) -> WhenMatched f k x y z
forall (f :: * -> *) k x y z.
(k -> x -> y -> f (Maybe z)) -> WhenMatched f k x y z
WhenMatched ((k -> x -> y -> f (Maybe z)) -> WhenMatched f k x y z)
-> (k -> x -> y -> f (Maybe z)) -> WhenMatched f k x y z
forall a b. (a -> b) -> a -> b
$ \ k
k x
x y
y -> z -> Maybe z
forall a. a -> Maybe a
Just (z -> Maybe z) -> f z -> f (Maybe z)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> k -> x -> y -> f z
f k
k x
x y
y
{-# INLINE zipWithAMatched #-}

-- | When a key is found in both maps, apply a function to the
-- key and values and maybe use the result in the merged map.
--
-- @
-- zipWithMaybeMatched :: (k -> x -> y -> Maybe z)
--                     -> SimpleWhenMatched k x y z
-- @
--
-- @since 0.5.9
zipWithMaybeMatched :: Applicative f
                    => (k -> x -> y -> Maybe z)
                    -> WhenMatched f k x y z
zipWithMaybeMatched :: (k -> x -> y -> Maybe z) -> WhenMatched f k x y z
zipWithMaybeMatched k -> x -> y -> Maybe z
f = (k -> x -> y -> f (Maybe z)) -> WhenMatched f k x y z
forall (f :: * -> *) k x y z.
(k -> x -> y -> f (Maybe z)) -> WhenMatched f k x y z
WhenMatched ((k -> x -> y -> f (Maybe z)) -> WhenMatched f k x y z)
-> (k -> x -> y -> f (Maybe z)) -> WhenMatched f k x y z
forall a b. (a -> b) -> a -> b
$ \ k
k x
x y
y -> Maybe z -> f (Maybe z)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe z -> f (Maybe z)) -> Maybe z -> f (Maybe z)
forall a b. (a -> b) -> a -> b
$ k -> x -> y -> Maybe z
f k
k x
x y
y
{-# INLINE zipWithMaybeMatched #-}

-- | When a key is found in both maps, apply a function to the
-- key and values, perform the resulting action, and maybe use
-- the result in the merged map.
--
-- This is the fundamental 'WhenMatched' tactic.
--
-- @since 0.5.9
zipWithMaybeAMatched :: (k -> x -> y -> f (Maybe z))
                     -> WhenMatched f k x y z
zipWithMaybeAMatched :: (k -> x -> y -> f (Maybe z)) -> WhenMatched f k x y z
zipWithMaybeAMatched k -> x -> y -> f (Maybe z)
f = (k -> x -> y -> f (Maybe z)) -> WhenMatched f k x y z
forall (f :: * -> *) k x y z.
(k -> x -> y -> f (Maybe z)) -> WhenMatched f k x y z
WhenMatched ((k -> x -> y -> f (Maybe z)) -> WhenMatched f k x y z)
-> (k -> x -> y -> f (Maybe z)) -> WhenMatched f k x y z
forall a b. (a -> b) -> a -> b
$ \ k
k x
x y
y -> k -> x -> y -> f (Maybe z)
f k
k x
x y
y
{-# INLINE zipWithMaybeAMatched #-}

-- | Drop all the entries whose keys are missing from the other
-- map.
--
-- @
-- dropMissing :: SimpleWhenMissing k x y
-- @
--
-- prop> dropMissing = mapMaybeMissing (\_ _ -> Nothing)
--
-- but @dropMissing@ is much faster.
--
-- @since 0.5.9
dropMissing :: Applicative f => WhenMissing f k x y
dropMissing :: WhenMissing f k x y
dropMissing = WhenMissing :: forall (f :: * -> *) k x y.
(Map k x -> f (Map k y))
-> (k -> x -> f (Maybe y)) -> WhenMissing f k x y
WhenMissing
  { missingSubtree :: Map k x -> f (Map k y)
missingSubtree = f (Map k y) -> Map k x -> f (Map k y)
forall a b. a -> b -> a
const (Map k y -> f (Map k y)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map k y
forall k a. Map k a
Tip)
  , missingKey :: k -> x -> f (Maybe y)
missingKey = \k
_ x
_ -> Maybe y -> f (Maybe y)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe y
forall a. Maybe a
Nothing }
{-# INLINE dropMissing #-}

-- | Preserve, unchanged, the entries whose keys are missing from
-- the other map.
--
-- @
-- preserveMissing :: SimpleWhenMissing k x x
-- @
--
-- prop> preserveMissing = Merge.Lazy.mapMaybeMissing (\_ x -> Just x)
--
-- but @preserveMissing@ is much faster.
--
-- @since 0.5.9
preserveMissing :: Applicative f => WhenMissing f k x x
preserveMissing :: WhenMissing f k x x
preserveMissing = WhenMissing :: forall (f :: * -> *) k x y.
(Map k x -> f (Map k y))
-> (k -> x -> f (Maybe y)) -> WhenMissing f k x y
WhenMissing
  { missingSubtree :: Map k x -> f (Map k x)
missingSubtree = Map k x -> f (Map k x)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  , missingKey :: k -> x -> f (Maybe x)
missingKey = \k
_ x
v -> Maybe x -> f (Maybe x)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (x -> Maybe x
forall a. a -> Maybe a
Just x
v) }
{-# INLINE preserveMissing #-}

-- | Force the entries whose keys are missing from
-- the other map and otherwise preserve them unchanged.
--
-- @
-- preserveMissing' :: SimpleWhenMissing k x x
-- @
--
-- prop> preserveMissing' = Merge.Lazy.mapMaybeMissing (\_ x -> Just $! x)
--
-- but @preserveMissing'@ is quite a bit faster.
--
-- @since 0.5.9
preserveMissing' :: Applicative f => WhenMissing f k x x
preserveMissing' :: WhenMissing f k x x
preserveMissing' = WhenMissing :: forall (f :: * -> *) k x y.
(Map k x -> f (Map k y))
-> (k -> x -> f (Maybe y)) -> WhenMissing f k x y
WhenMissing
  { missingSubtree :: Map k x -> f (Map k x)
missingSubtree = \Map k x
t -> Map k x -> f (Map k x)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map k x -> f (Map k x)) -> Map k x -> f (Map k x)
forall a b. (a -> b) -> a -> b
$! Map k x -> ()
forall k a. Map k a -> ()
forceTree Map k x
t () -> Map k x -> Map k x
`seq` Map k x
t
  , missingKey :: k -> x -> f (Maybe x)
missingKey = \k
_ x
v -> Maybe x -> f (Maybe x)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe x -> f (Maybe x)) -> Maybe x -> f (Maybe x)
forall a b. (a -> b) -> a -> b
$! x -> Maybe x
forall a. a -> Maybe a
Just (x -> Maybe x) -> x -> Maybe x
forall a b. (a -> b) -> a -> b
$! x
v }
{-# INLINE preserveMissing' #-}

-- Force all the values in a tree.
forceTree :: Map k a -> ()
forceTree :: Map k a -> ()
forceTree (Bin Int
_ k
_ a
v Map k a
l Map k a
r) = a
v a -> () -> ()
`seq` Map k a -> ()
forall k a. Map k a -> ()
forceTree Map k a
l () -> () -> ()
`seq` Map k a -> ()
forall k a. Map k a -> ()
forceTree Map k a
r () -> () -> ()
`seq` ()
forceTree Map k a
Tip = ()

-- | Map over the entries whose keys are missing from the other map.
--
-- @
-- mapMissing :: (k -> x -> y) -> SimpleWhenMissing k x y
-- @
--
-- prop> mapMissing f = mapMaybeMissing (\k x -> Just $ f k x)
--
-- but @mapMissing@ is somewhat faster.
--
-- @since 0.5.9
mapMissing :: Applicative f => (k -> x -> y) -> WhenMissing f k x y
mapMissing :: (k -> x -> y) -> WhenMissing f k x y
mapMissing k -> x -> y
f = WhenMissing :: forall (f :: * -> *) k x y.
(Map k x -> f (Map k y))
-> (k -> x -> f (Maybe y)) -> WhenMissing f k x y
WhenMissing
  { missingSubtree :: Map k x -> f (Map k y)
missingSubtree = \Map k x
m -> Map k y -> f (Map k y)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map k y -> f (Map k y)) -> Map k y -> f (Map k y)
forall a b. (a -> b) -> a -> b
$! (k -> x -> y) -> Map k x -> Map k y
forall k a b. (k -> a -> b) -> Map k a -> Map k b
mapWithKey k -> x -> y
f Map k x
m
  , missingKey :: k -> x -> f (Maybe y)
missingKey = \ k
k x
x -> Maybe y -> f (Maybe y)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe y -> f (Maybe y)) -> Maybe y -> f (Maybe y)
forall a b. (a -> b) -> a -> b
$ y -> Maybe y
forall a. a -> Maybe a
Just (k -> x -> y
f k
k x
x) }
{-# INLINE mapMissing #-}

-- | Map over the entries whose keys are missing from the other map,
-- optionally removing some. This is the most powerful 'SimpleWhenMissing'
-- tactic, but others are usually more efficient.
--
-- @
-- mapMaybeMissing :: (k -> x -> Maybe y) -> SimpleWhenMissing k x y
-- @
--
-- prop> mapMaybeMissing f = traverseMaybeMissing (\k x -> pure (f k x))
--
-- but @mapMaybeMissing@ uses fewer unnecessary 'Applicative' operations.
--
-- @since 0.5.9
mapMaybeMissing :: Applicative f => (k -> x -> Maybe y) -> WhenMissing f k x y
mapMaybeMissing :: (k -> x -> Maybe y) -> WhenMissing f k x y
mapMaybeMissing k -> x -> Maybe y
f = WhenMissing :: forall (f :: * -> *) k x y.
(Map k x -> f (Map k y))
-> (k -> x -> f (Maybe y)) -> WhenMissing f k x y
WhenMissing
  { missingSubtree :: Map k x -> f (Map k y)
missingSubtree = \Map k x
m -> Map k y -> f (Map k y)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map k y -> f (Map k y)) -> Map k y -> f (Map k y)
forall a b. (a -> b) -> a -> b
$! (k -> x -> Maybe y) -> Map k x -> Map k y
forall k a b. (k -> a -> Maybe b) -> Map k a -> Map k b
mapMaybeWithKey k -> x -> Maybe y
f Map k x
m
  , missingKey :: k -> x -> f (Maybe y)
missingKey = \k
k x
x -> Maybe y -> f (Maybe y)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe y -> f (Maybe y)) -> Maybe y -> f (Maybe y)
forall a b. (a -> b) -> a -> b
$! k -> x -> Maybe y
f k
k x
x }
{-# INLINE mapMaybeMissing #-}

-- | Filter the entries whose keys are missing from the other map.
--
-- @
-- filterMissing :: (k -> x -> Bool) -> SimpleWhenMissing k x x
-- @
--
-- prop> filterMissing f = Merge.Lazy.mapMaybeMissing $ \k x -> guard (f k x) *> Just x
--
-- but this should be a little faster.
--
-- @since 0.5.9
filterMissing :: Applicative f
              => (k -> x -> Bool) -> WhenMissing f k x x
filterMissing :: (k -> x -> Bool) -> WhenMissing f k x x
filterMissing k -> x -> Bool
f = WhenMissing :: forall (f :: * -> *) k x y.
(Map k x -> f (Map k y))
-> (k -> x -> f (Maybe y)) -> WhenMissing f k x y
WhenMissing
  { missingSubtree :: Map k x -> f (Map k x)
missingSubtree = \Map k x
m -> Map k x -> f (Map k x)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map k x -> f (Map k x)) -> Map k x -> f (Map k x)
forall a b. (a -> b) -> a -> b
$! (k -> x -> Bool) -> Map k x -> Map k x
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
filterWithKey k -> x -> Bool
f Map k x
m
  , missingKey :: k -> x -> f (Maybe x)
missingKey = \k
k x
x -> Maybe x -> f (Maybe x)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe x -> f (Maybe x)) -> Maybe x -> f (Maybe x)
forall a b. (a -> b) -> a -> b
$! if k -> x -> Bool
f k
k x
x then x -> Maybe x
forall a. a -> Maybe a
Just x
x else Maybe x
forall a. Maybe a
Nothing }
{-# INLINE filterMissing #-}

-- | Filter the entries whose keys are missing from the other map
-- using some 'Applicative' action.
--
-- @
-- filterAMissing f = Merge.Lazy.traverseMaybeMissing $
--   \k x -> (\b -> guard b *> Just x) <$> f k x
-- @
--
-- but this should be a little faster.
--
-- @since 0.5.9
filterAMissing :: Applicative f
              => (k -> x -> f Bool) -> WhenMissing f k x x
filterAMissing :: (k -> x -> f Bool) -> WhenMissing f k x x
filterAMissing k -> x -> f Bool
f = WhenMissing :: forall (f :: * -> *) k x y.
(Map k x -> f (Map k y))
-> (k -> x -> f (Maybe y)) -> WhenMissing f k x y
WhenMissing
  { missingSubtree :: Map k x -> f (Map k x)
missingSubtree = \Map k x
m -> (k -> x -> f Bool) -> Map k x -> f (Map k x)
forall (f :: * -> *) k a.
Applicative f =>
(k -> a -> f Bool) -> Map k a -> f (Map k a)
filterWithKeyA k -> x -> f Bool
f Map k x
m
  , missingKey :: k -> x -> f (Maybe x)
missingKey = \k
k x
x -> Maybe x -> Maybe x -> Bool -> Maybe x
forall a. a -> a -> Bool -> a
bool Maybe x
forall a. Maybe a
Nothing (x -> Maybe x
forall a. a -> Maybe a
Just x
x) (Bool -> Maybe x) -> f Bool -> f (Maybe x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> k -> x -> f Bool
f k
k x
x }
{-# INLINE filterAMissing #-}

-- | This wasn't in Data.Bool until 4.7.0, so we define it here
bool :: a -> a -> Bool -> a
bool :: a -> a -> Bool -> a
bool a
f a
_ Bool
False = a
f
bool a
_ a
t Bool
True  = a
t

-- | Traverse over the entries whose keys are missing from the other map.
--
-- @since 0.5.9
traverseMissing :: Applicative f
                    => (k -> x -> f y) -> WhenMissing f k x y
traverseMissing :: (k -> x -> f y) -> WhenMissing f k x y
traverseMissing k -> x -> f y
f = WhenMissing :: forall (f :: * -> *) k x y.
(Map k x -> f (Map k y))
-> (k -> x -> f (Maybe y)) -> WhenMissing f k x y
WhenMissing
  { missingSubtree :: Map k x -> f (Map k y)
missingSubtree = (k -> x -> f y) -> Map k x -> f (Map k y)
forall (t :: * -> *) k a b.
Applicative t =>
(k -> a -> t b) -> Map k a -> t (Map k b)
traverseWithKey k -> x -> f y
f
  , missingKey :: k -> x -> f (Maybe y)
missingKey = \k
k x
x -> y -> Maybe y
forall a. a -> Maybe a
Just (y -> Maybe y) -> f y -> f (Maybe y)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> k -> x -> f y
f k
k x
x }
{-# INLINE traverseMissing #-}

-- | Traverse over the entries whose keys are missing from the other map,
-- optionally producing values to put in the result.
-- This is the most powerful 'WhenMissing' tactic, but others are usually
-- more efficient.
--
-- @since 0.5.9
traverseMaybeMissing :: Applicative f
                      => (k -> x -> f (Maybe y)) -> WhenMissing f k x y
traverseMaybeMissing :: (k -> x -> f (Maybe y)) -> WhenMissing f k x y
traverseMaybeMissing k -> x -> f (Maybe y)
f = WhenMissing :: forall (f :: * -> *) k x y.
(Map k x -> f (Map k y))
-> (k -> x -> f (Maybe y)) -> WhenMissing f k x y
WhenMissing
  { missingSubtree :: Map k x -> f (Map k y)
missingSubtree = (k -> x -> f (Maybe y)) -> Map k x -> f (Map k y)
forall (f :: * -> *) k a b.
Applicative f =>
(k -> a -> f (Maybe b)) -> Map k a -> f (Map k b)
traverseMaybeWithKey k -> x -> f (Maybe y)
f
  , missingKey :: k -> x -> f (Maybe y)
missingKey = k -> x -> f (Maybe y)
f }
{-# INLINE traverseMaybeMissing #-}

-- | Merge two maps.
--
-- 'merge' takes two 'WhenMissing' tactics, a 'WhenMatched'
-- tactic and two maps. It uses the tactics to merge the maps.
-- Its behavior is best understood via its fundamental tactics,
-- 'mapMaybeMissing' and 'zipWithMaybeMatched'.
--
-- Consider
--
-- @
-- merge (mapMaybeMissing g1)
--              (mapMaybeMissing g2)
--              (zipWithMaybeMatched f)
--              m1 m2
-- @
--
-- Take, for example,
--
-- @
-- m1 = [(0, \'a\'), (1, \'b\'), (3, \'c\'), (4, \'d\')]
-- m2 = [(1, "one"), (2, "two"), (4, "three")]
-- @
--
-- 'merge' will first \"align\" these maps by key:
--
-- @
-- m1 = [(0, \'a\'), (1, \'b\'),               (3, \'c\'), (4, \'d\')]
-- m2 =           [(1, "one"), (2, "two"),           (4, "three")]
-- @
--
-- It will then pass the individual entries and pairs of entries
-- to @g1@, @g2@, or @f@ as appropriate:
--
-- @
-- maybes = [g1 0 \'a\', f 1 \'b\' "one", g2 2 "two", g1 3 \'c\', f 4 \'d\' "three"]
-- @
--
-- This produces a 'Maybe' for each key:
--
-- @
-- keys =     0        1          2           3        4
-- results = [Nothing, Just True, Just False, Nothing, Just True]
-- @
--
-- Finally, the @Just@ results are collected into a map:
--
-- @
-- return value = [(1, True), (2, False), (4, True)]
-- @
--
-- The other tactics below are optimizations or simplifications of
-- 'mapMaybeMissing' for special cases. Most importantly,
--
-- * 'dropMissing' drops all the keys.
-- * 'preserveMissing' leaves all the entries alone.
--
-- When 'merge' is given three arguments, it is inlined at the call
-- site. To prevent excessive inlining, you should typically use 'merge'
-- to define your custom combining functions.
--
--
-- Examples:
--
-- prop> unionWithKey f = merge preserveMissing preserveMissing (zipWithMatched f)
-- prop> intersectionWithKey f = merge dropMissing dropMissing (zipWithMatched f)
-- prop> differenceWith f = merge preserveMissing dropMissing (zipWithMatched f)
-- prop> symmetricDifference = merge preserveMissing preserveMissing (zipWithMaybeMatched $ \ _ _ _ -> Nothing)
-- prop> mapEachPiece f g h = merge (mapMissing f) (mapMissing g) (zipWithMatched h)
--
-- @since 0.5.9
merge :: Ord k
             => SimpleWhenMissing k a c -- ^ What to do with keys in @m1@ but not @m2@
             -> SimpleWhenMissing k b c -- ^ What to do with keys in @m2@ but not @m1@
             -> SimpleWhenMatched k a b c -- ^ What to do with keys in both @m1@ and @m2@
             -> Map k a -- ^ Map @m1@
             -> Map k b -- ^ Map @m2@
             -> Map k c
merge :: SimpleWhenMissing k a c
-> SimpleWhenMissing k b c
-> SimpleWhenMatched k a b c
-> Map k a
-> Map k b
-> Map k c
merge SimpleWhenMissing k a c
g1 SimpleWhenMissing k b c
g2 SimpleWhenMatched k a b c
f Map k a
m1 Map k b
m2 = Identity (Map k c) -> Map k c
forall a. Identity a -> a
runIdentity (Identity (Map k c) -> Map k c) -> Identity (Map k c) -> Map k c
forall a b. (a -> b) -> a -> b
$
  SimpleWhenMissing k a c
-> SimpleWhenMissing k b c
-> SimpleWhenMatched k a b c
-> Map k a
-> Map k b
-> Identity (Map k c)
forall (f :: * -> *) k a c b.
(Applicative f, Ord k) =>
WhenMissing f k a c
-> WhenMissing f k b c
-> WhenMatched f k a b c
-> Map k a
-> Map k b
-> f (Map k c)
mergeA SimpleWhenMissing k a c
g1 SimpleWhenMissing k b c
g2 SimpleWhenMatched k a b c
f Map k a
m1 Map k b
m2
{-# INLINE merge #-}

-- | An applicative version of 'merge'.
--
-- 'mergeA' takes two 'WhenMissing' tactics, a 'WhenMatched'
-- tactic and two maps. It uses the tactics to merge the maps.
-- Its behavior is best understood via its fundamental tactics,
-- 'traverseMaybeMissing' and 'zipWithMaybeAMatched'.
--
-- Consider
--
-- @
-- mergeA (traverseMaybeMissing g1)
--               (traverseMaybeMissing g2)
--               (zipWithMaybeAMatched f)
--               m1 m2
-- @
--
-- Take, for example,
--
-- @
-- m1 = [(0, \'a\'), (1, \'b\'), (3, \'c\'), (4, \'d\')]
-- m2 = [(1, "one"), (2, "two"), (4, "three")]
-- @
--
-- @mergeA@ will first \"align\" these maps by key:
--
-- @
-- m1 = [(0, \'a\'), (1, \'b\'),               (3, \'c\'), (4, \'d\')]
-- m2 =           [(1, "one"), (2, "two"),           (4, "three")]
-- @
--
-- It will then pass the individual entries and pairs of entries
-- to @g1@, @g2@, or @f@ as appropriate:
--
-- @
-- actions = [g1 0 \'a\', f 1 \'b\' "one", g2 2 "two", g1 3 \'c\', f 4 \'d\' "three"]
-- @
--
-- Next, it will perform the actions in the @actions@ list in order from
-- left to right.
--
-- @
-- keys =     0        1          2           3        4
-- results = [Nothing, Just True, Just False, Nothing, Just True]
-- @
--
-- Finally, the @Just@ results are collected into a map:
--
-- @
-- return value = [(1, True), (2, False), (4, True)]
-- @
--
-- The other tactics below are optimizations or simplifications of
-- 'traverseMaybeMissing' for special cases. Most importantly,
--
-- * 'dropMissing' drops all the keys.
-- * 'preserveMissing' leaves all the entries alone.
-- * 'mapMaybeMissing' does not use the 'Applicative' context.
--
-- When 'mergeA' is given three arguments, it is inlined at the call
-- site. To prevent excessive inlining, you should generally only use
-- 'mergeA' to define custom combining functions.
--
-- @since 0.5.9
mergeA
  :: (Applicative f, Ord k)
  => WhenMissing f k a c -- ^ What to do with keys in @m1@ but not @m2@
  -> WhenMissing f k b c -- ^ What to do with keys in @m2@ but not @m1@
  -> WhenMatched f k a b c -- ^ What to do with keys in both @m1@ and @m2@
  -> Map k a -- ^ Map @m1@
  -> Map k b -- ^ Map @m2@
  -> f (Map k c)
mergeA :: WhenMissing f k a c
-> WhenMissing f k b c
-> WhenMatched f k a b c
-> Map k a
-> Map k b
-> f (Map k c)
mergeA
    WhenMissing{missingSubtree :: forall (f :: * -> *) k x y.
WhenMissing f k x y -> Map k x -> f (Map k y)
missingSubtree = Map k a -> f (Map k c)
g1t, missingKey :: forall (f :: * -> *) k x y.
WhenMissing f k x y -> k -> x -> f (Maybe y)
missingKey = k -> a -> f (Maybe c)
g1k}
    WhenMissing{missingSubtree :: forall (f :: * -> *) k x y.
WhenMissing f k x y -> Map k x -> f (Map k y)
missingSubtree = Map k b -> f (Map k c)
g2t}
    (WhenMatched k -> a -> b -> f (Maybe c)
f) = Map k a -> Map k b -> f (Map k c)
go
  where
    go :: Map k a -> Map k b -> f (Map k c)
go Map k a
t1 Map k b
Tip = Map k a -> f (Map k c)
g1t Map k a
t1
    go Map k a
Tip Map k b
t2 = Map k b -> f (Map k c)
g2t Map k b
t2
    go (Bin Int
_ k
kx a
x1 Map k a
l1 Map k a
r1) Map k b
t2 = case k -> Map k b -> (Map k b, Maybe b, Map k b)
forall k a. Ord k => k -> Map k a -> (Map k a, Maybe a, Map k a)
splitLookup k
kx Map k b
t2 of
      (Map k b
l2, Maybe b
mx2, Map k b
r2) -> case Maybe b
mx2 of
          Maybe b
Nothing -> (Map k c -> Maybe c -> Map k c -> Map k c)
-> f (Map k c) -> f (Maybe c) -> f (Map k c) -> f (Map k c)
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 (\Map k c
l' Maybe c
mx' Map k c
r' -> (Map k c -> Map k c -> Map k c)
-> (c -> Map k c -> Map k c -> Map k c)
-> Maybe c
-> Map k c
-> Map k c
-> Map k c
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Map k c -> Map k c -> Map k c
forall k a. Map k a -> Map k a -> Map k a
link2 (k -> c -> Map k c -> Map k c -> Map k c
forall k a. k -> a -> Map k a -> Map k a -> Map k a
link k
kx) Maybe c
mx' Map k c
l' Map k c
r')
                        f (Map k c)
l1l2 (k -> a -> f (Maybe c)
g1k k
kx a
x1) f (Map k c)
r1r2
          Just b
x2 -> (Map k c -> Maybe c -> Map k c -> Map k c)
-> f (Map k c) -> f (Maybe c) -> f (Map k c) -> f (Map k c)
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 (\Map k c
l' Maybe c
mx' Map k c
r' -> (Map k c -> Map k c -> Map k c)
-> (c -> Map k c -> Map k c -> Map k c)
-> Maybe c
-> Map k c
-> Map k c
-> Map k c
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Map k c -> Map k c -> Map k c
forall k a. Map k a -> Map k a -> Map k a
link2 (k -> c -> Map k c -> Map k c -> Map k c
forall k a. k -> a -> Map k a -> Map k a -> Map k a
link k
kx) Maybe c
mx' Map k c
l' Map k c
r')
                        f (Map k c)
l1l2 (k -> a -> b -> f (Maybe c)
f k
kx a
x1 b
x2) f (Map k c)
r1r2
        where
          !l1l2 :: f (Map k c)
l1l2 = Map k a -> Map k b -> f (Map k c)
go Map k a
l1 Map k b
l2
          !r1r2 :: f (Map k c)
r1r2 = Map k a -> Map k b -> f (Map k c)
go Map k a
r1 Map k b
r2
{-# INLINE mergeA #-}


{--------------------------------------------------------------------
  MergeWithKey
--------------------------------------------------------------------}

-- | \(O(n+m)\). An unsafe general combining function.
--
-- WARNING: This function can produce corrupt maps and its results
-- may depend on the internal structures of its inputs. Users should
-- prefer 'merge' or 'mergeA'.
--
-- When 'mergeWithKey' is given three arguments, it is inlined to the call
-- site. You should therefore use 'mergeWithKey' only to define custom
-- combining functions. For example, you could define 'unionWithKey',
-- 'differenceWithKey' and 'intersectionWithKey' as
--
-- > myUnionWithKey f m1 m2 = mergeWithKey (\k x1 x2 -> Just (f k x1 x2)) id id m1 m2
-- > myDifferenceWithKey f m1 m2 = mergeWithKey f id (const empty) m1 m2
-- > myIntersectionWithKey f m1 m2 = mergeWithKey (\k x1 x2 -> Just (f k x1 x2)) (const empty) (const empty) m1 m2
--
-- When calling @'mergeWithKey' combine only1 only2@, a function combining two
-- 'Map's is created, such that
--
-- * if a key is present in both maps, it is passed with both corresponding
--   values to the @combine@ function. Depending on the result, the key is either
--   present in the result with specified value, or is left out;
--
-- * a nonempty subtree present only in the first map is passed to @only1@ and
--   the output is added to the result;
--
-- * a nonempty subtree present only in the second map is passed to @only2@ and
--   the output is added to the result.
--
-- The @only1@ and @only2@ methods /must return a map with a subset (possibly empty) of the keys of the given map/.
-- The values can be modified arbitrarily. Most common variants of @only1@ and
-- @only2@ are 'id' and @'const' 'empty'@, but for example @'map' f@,
-- @'filterWithKey' f@, or @'mapMaybeWithKey' f@ could be used for any @f@.

mergeWithKey :: Ord k
             => (k -> a -> b -> Maybe c)
             -> (Map k a -> Map k c)
             -> (Map k b -> Map k c)
             -> Map k a -> Map k b -> Map k c
mergeWithKey :: (k -> a -> b -> Maybe c)
-> (Map k a -> Map k c)
-> (Map k b -> Map k c)
-> Map k a
-> Map k b
-> Map k c
mergeWithKey k -> a -> b -> Maybe c
f Map k a -> Map k c
g1 Map k b -> Map k c
g2 = Map k a -> Map k b -> Map k c
go
  where
    go :: Map k a -> Map k b -> Map k c
go Map k a
Tip Map k b
t2 = Map k b -> Map k c
g2 Map k b
t2
    go Map k a
t1 Map k b
Tip = Map k a -> Map k c
g1 Map k a
t1
    go (Bin Int
_ k
kx a
x Map k a
l1 Map k a
r1) Map k b
t2 =
      case Maybe b
found of
        Maybe b
Nothing -> case Map k a -> Map k c
g1 (k -> a -> Map k a
forall k a. k -> a -> Map k a
singleton k
kx a
x) of
                     Map k c
Tip -> Map k c -> Map k c -> Map k c
forall k a. Map k a -> Map k a -> Map k a
link2 Map k c
l' Map k c
r'
                     (Bin Int
_ k
_ c
x' Map k c
Tip Map k c
Tip) -> k -> c -> Map k c -> Map k c -> Map k c
forall k a. k -> a -> Map k a -> Map k a -> Map k a
link k
kx c
x' Map k c
l' Map k c
r'
                     Map k c
_ -> [Char] -> Map k c
forall a. HasCallStack => [Char] -> a
error [Char]
"mergeWithKey: Given function only1 does not fulfill required conditions (see documentation)"
        Just b
x2 -> case k -> a -> b -> Maybe c
f k
kx a
x b
x2 of
                     Maybe c
Nothing -> Map k c -> Map k c -> Map k c
forall k a. Map k a -> Map k a -> Map k a
link2 Map k c
l' Map k c
r'
                     Just c
x' -> k -> c -> Map k c -> Map k c -> Map k c
forall k a. k -> a -> Map k a -> Map k a -> Map k a
link k
kx c
x' Map k c
l' Map k c
r'
      where
        (Map k b
l2, Maybe b
found, Map k b
r2) = k -> Map k b -> (Map k b, Maybe b, Map k b)
forall k a. Ord k => k -> Map k a -> (Map k a, Maybe a, Map k a)
splitLookup k
kx Map k b
t2
        l' :: Map k c
l' = Map k a -> Map k b -> Map k c
go Map k a
l1 Map k b
l2
        r' :: Map k c
r' = Map k a -> Map k b -> Map k c
go Map k a
r1 Map k b
r2
{-# INLINE mergeWithKey #-}

{--------------------------------------------------------------------
  Submap
--------------------------------------------------------------------}
-- | \(O\bigl(m \log\bigl(\frac{n+1}{m+1}\bigr)\bigr), \; m \leq n\).
-- This function is defined as (@'isSubmapOf' = 'isSubmapOfBy' (==)@).
--
isSubmapOf :: (Ord k,Eq a) => Map k a -> Map k a -> Bool
isSubmapOf :: Map k a -> Map k a -> Bool
isSubmapOf Map k a
m1 Map k a
m2 = (a -> a -> Bool) -> Map k a -> Map k a -> Bool
forall k a b.
Ord k =>
(a -> b -> Bool) -> Map k a -> Map k b -> Bool
isSubmapOfBy a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==) Map k a
m1 Map k a
m2
#if __GLASGOW_HASKELL__
{-# INLINABLE isSubmapOf #-}
#endif

{- | \(O\bigl(m \log\bigl(\frac{n+1}{m+1}\bigr)\bigr), \; m \leq n\).
 The expression (@'isSubmapOfBy' f t1 t2@) returns 'True' if
 all keys in @t1@ are in tree @t2@, and when @f@ returns 'True' when
 applied to their respective values. For example, the following
 expressions are all 'True':

 > isSubmapOfBy (==) (fromList [('a',1)]) (fromList [('a',1),('b',2)])
 > isSubmapOfBy (<=) (fromList [('a',1)]) (fromList [('a',1),('b',2)])
 > isSubmapOfBy (==) (fromList [('a',1),('b',2)]) (fromList [('a',1),('b',2)])

 But the following are all 'False':

 > isSubmapOfBy (==) (fromList [('a',2)]) (fromList [('a',1),('b',2)])
 > isSubmapOfBy (<)  (fromList [('a',1)]) (fromList [('a',1),('b',2)])
 > isSubmapOfBy (==) (fromList [('a',1),('b',2)]) (fromList [('a',1)])

 Note that @isSubmapOfBy (\_ _ -> True) m1 m2@ tests whether all the keys
 in @m1@ are also keys in @m2@.

-}
isSubmapOfBy :: Ord k => (a->b->Bool) -> Map k a -> Map k b -> Bool
isSubmapOfBy :: (a -> b -> Bool) -> Map k a -> Map k b -> Bool
isSubmapOfBy a -> b -> Bool
f Map k a
t1 Map k b
t2
  = Map k a -> Int
forall k a. Map k a -> Int
size Map k a
t1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Map k b -> Int
forall k a. Map k a -> Int
size Map k b
t2 Bool -> Bool -> Bool
&& (a -> b -> Bool) -> Map k a -> Map k b -> Bool
forall k a b.
Ord k =>
(a -> b -> Bool) -> Map k a -> Map k b -> Bool
submap' a -> b -> Bool
f Map k a
t1 Map k b
t2
#if __GLASGOW_HASKELL__
{-# INLINABLE isSubmapOfBy #-}
#endif

-- Test whether a map is a submap of another without the *initial*
-- size test. See Data.Set.Internal.isSubsetOfX for notes on
-- implementation and analysis.
submap' :: Ord a => (b -> c -> Bool) -> Map a b -> Map a c -> Bool
submap' :: (b -> c -> Bool) -> Map a b -> Map a c -> Bool
submap' b -> c -> Bool
_ Map a b
Tip Map a c
_ = Bool
True
submap' b -> c -> Bool
_ Map a b
_ Map a c
Tip = Bool
False
submap' b -> c -> Bool
f (Bin Int
1 a
kx b
x Map a b
_ Map a b
_) Map a c
t
  = case a -> Map a c -> Maybe c
forall k a. Ord k => k -> Map k a -> Maybe a
lookup a
kx Map a c
t of
      Just c
y -> b -> c -> Bool
f b
x c
y
      Maybe c
Nothing -> Bool
False
submap' b -> c -> Bool
f (Bin Int
_ a
kx b
x Map a b
l Map a b
r) Map a c
t
  = case Maybe c
found of
      Maybe c
Nothing -> Bool
False
      Just c
y  -> b -> c -> Bool
f b
x c
y
                 Bool -> Bool -> Bool
&& Map a b -> Int
forall k a. Map k a -> Int
size Map a b
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Map a c -> Int
forall k a. Map k a -> Int
size Map a c
lt Bool -> Bool -> Bool
&& Map a b -> Int
forall k a. Map k a -> Int
size Map a b
r Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Map a c -> Int
forall k a. Map k a -> Int
size Map a c
gt
                 Bool -> Bool -> Bool
&& (b -> c -> Bool) -> Map a b -> Map a c -> Bool
forall k a b.
Ord k =>
(a -> b -> Bool) -> Map k a -> Map k b -> Bool
submap' b -> c -> Bool
f Map a b
l Map a c
lt Bool -> Bool -> Bool
&& (b -> c -> Bool) -> Map a b -> Map a c -> Bool
forall k a b.
Ord k =>
(a -> b -> Bool) -> Map k a -> Map k b -> Bool
submap' b -> c -> Bool
f Map a b
r Map a c
gt
  where
    (Map a c
lt,Maybe c
found,Map a c
gt) = a -> Map a c -> (Map a c, Maybe c, Map a c)
forall k a. Ord k => k -> Map k a -> (Map k a, Maybe a, Map k a)
splitLookup a
kx Map a c
t
#if __GLASGOW_HASKELL__
{-# INLINABLE submap' #-}
#endif

-- | \(O\bigl(m \log\bigl(\frac{n+1}{m+1}\bigr)\bigr), \; m \leq n\). Is this a proper submap? (ie. a submap but not equal).
-- Defined as (@'isProperSubmapOf' = 'isProperSubmapOfBy' (==)@).
isProperSubmapOf :: (Ord k,Eq a) => Map k a -> Map k a -> Bool
isProperSubmapOf :: Map k a -> Map k a -> Bool
isProperSubmapOf Map k a
m1 Map k a
m2
  = (a -> a -> Bool) -> Map k a -> Map k a -> Bool
forall k a b.
Ord k =>
(a -> b -> Bool) -> Map k a -> Map k b -> Bool
isProperSubmapOfBy a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==) Map k a
m1 Map k a
m2
#if __GLASGOW_HASKELL__
{-# INLINABLE isProperSubmapOf #-}
#endif

{- | \(O\bigl(m \log\bigl(\frac{n+1}{m+1}\bigr)\bigr), \; m \leq n\). Is this a proper submap? (ie. a submap but not equal).
 The expression (@'isProperSubmapOfBy' f m1 m2@) returns 'True' when
 @keys m1@ and @keys m2@ are not equal,
 all keys in @m1@ are in @m2@, and when @f@ returns 'True' when
 applied to their respective values. For example, the following
 expressions are all 'True':

  > isProperSubmapOfBy (==) (fromList [(1,1)]) (fromList [(1,1),(2,2)])
  > isProperSubmapOfBy (<=) (fromList [(1,1)]) (fromList [(1,1),(2,2)])

 But the following are all 'False':

  > isProperSubmapOfBy (==) (fromList [(1,1),(2,2)]) (fromList [(1,1),(2,2)])
  > isProperSubmapOfBy (==) (fromList [(1,1),(2,2)]) (fromList [(1,1)])
  > isProperSubmapOfBy (<)  (fromList [(1,1)])       (fromList [(1,1),(2,2)])


-}
isProperSubmapOfBy :: Ord k => (a -> b -> Bool) -> Map k a -> Map k b -> Bool
isProperSubmapOfBy :: (a -> b -> Bool) -> Map k a -> Map k b -> Bool
isProperSubmapOfBy a -> b -> Bool
f Map k a
t1 Map k b
t2
  = Map k a -> Int
forall k a. Map k a -> Int
size Map k a
t1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Map k b -> Int
forall k a. Map k a -> Int
size Map k b
t2 Bool -> Bool -> Bool
&& (a -> b -> Bool) -> Map k a -> Map k b -> Bool
forall k a b.
Ord k =>
(a -> b -> Bool) -> Map k a -> Map k b -> Bool
submap' a -> b -> Bool
f Map k a
t1 Map k b
t2
#if __GLASGOW_HASKELL__
{-# INLINABLE isProperSubmapOfBy #-}
#endif

{--------------------------------------------------------------------
  Filter and partition
--------------------------------------------------------------------}
-- | \(O(n)\). Filter all values that satisfy the predicate.
--
-- > filter (> "a") (fromList [(5,"a"), (3,"b")]) == singleton 3 "b"
-- > filter (> "x") (fromList [(5,"a"), (3,"b")]) == empty
-- > filter (< "a") (fromList [(5,"a"), (3,"b")]) == empty

filter :: (a -> Bool) -> Map k a -> Map k a
filter :: (a -> Bool) -> Map k a -> Map k a
filter a -> Bool
p Map k a
m
  = (k -> a -> Bool) -> Map k a -> Map k a
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
filterWithKey (\k
_ a
x -> a -> Bool
p a
x) Map k a
m

-- | \(O(n)\). Filter all keys\/values that satisfy the predicate.
--
-- > filterWithKey (\k _ -> k > 4) (fromList [(5,"a"), (3,"b")]) == singleton 5 "a"

filterWithKey :: (k -> a -> Bool) -> Map k a -> Map k a
filterWithKey :: (k -> a -> Bool) -> Map k a -> Map k a
filterWithKey k -> a -> Bool
_ Map k a
Tip = Map k a
forall k a. Map k a
Tip
filterWithKey k -> a -> Bool
p t :: Map k a
t@(Bin Int
_ k
kx a
x Map k a
l Map k a
r)
  | k -> a -> Bool
p k
kx a
x    = if Map k a
pl Map k a -> Map k a -> Bool
forall a. a -> a -> Bool
`ptrEq` Map k a
l Bool -> Bool -> Bool
&& Map k a
pr Map k a -> Map k a -> Bool
forall a. a -> a -> Bool
`ptrEq` Map k a
r
                then Map k a
t
                else k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
link k
kx a
x Map k a
pl Map k a
pr
  | Bool
otherwise = Map k a -> Map k a -> Map k a
forall k a. Map k a -> Map k a -> Map k a
link2 Map k a
pl Map k a
pr
  where !pl :: Map k a
pl = (k -> a -> Bool) -> Map k a -> Map k a
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
filterWithKey k -> a -> Bool
p Map k a
l
        !pr :: Map k a
pr = (k -> a -> Bool) -> Map k a -> Map k a
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
filterWithKey k -> a -> Bool
p Map k a
r

-- | \(O(n)\). Filter keys and values using an 'Applicative'
-- predicate.
filterWithKeyA :: Applicative f => (k -> a -> f Bool) -> Map k a -> f (Map k a)
filterWithKeyA :: (k -> a -> f Bool) -> Map k a -> f (Map k a)
filterWithKeyA k -> a -> f Bool
_ Map k a
Tip = Map k a -> f (Map k a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map k a
forall k a. Map k a
Tip
filterWithKeyA k -> a -> f Bool
p t :: Map k a
t@(Bin Int
_ k
kx a
x Map k a
l Map k a
r) =
  (Bool -> Map k a -> Map k a -> Map k a)
-> f Bool -> f (Map k a) -> f (Map k a) -> f (Map k a)
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 Bool -> Map k a -> Map k a -> Map k a
combine (k -> a -> f Bool
p k
kx a
x) ((k -> a -> f Bool) -> Map k a -> f (Map k a)
forall (f :: * -> *) k a.
Applicative f =>
(k -> a -> f Bool) -> Map k a -> f (Map k a)
filterWithKeyA k -> a -> f Bool
p Map k a
l) ((k -> a -> f Bool) -> Map k a -> f (Map k a)
forall (f :: * -> *) k a.
Applicative f =>
(k -> a -> f Bool) -> Map k a -> f (Map k a)
filterWithKeyA k -> a -> f Bool
p Map k a
r)
  where
    combine :: Bool -> Map k a -> Map k a -> Map k a
combine Bool
True Map k a
pl Map k a
pr
      | Map k a
pl Map k a -> Map k a -> Bool
forall a. a -> a -> Bool
`ptrEq` Map k a
l Bool -> Bool -> Bool
&& Map k a
pr Map k a -> Map k a -> Bool
forall a. a -> a -> Bool
`ptrEq` Map k a
r = Map k a
t
      | Bool
otherwise = k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
link k
kx a
x Map k a
pl Map k a
pr
    combine Bool
False Map k a
pl Map k a
pr = Map k a -> Map k a -> Map k a
forall k a. Map k a -> Map k a -> Map k a
link2 Map k a
pl Map k a
pr

-- | \(O(\log n)\). Take while a predicate on the keys holds.
-- The user is responsible for ensuring that for all keys @j@ and @k@ in the map,
-- @j \< k ==\> p j \>= p k@. See note at 'spanAntitone'.
--
-- @
-- takeWhileAntitone p = 'fromDistinctAscList' . 'Data.List.takeWhile' (p . fst) . 'toList'
-- takeWhileAntitone p = 'filterWithKey' (\k _ -> p k)
-- @
--
-- @since 0.5.8

takeWhileAntitone :: (k -> Bool) -> Map k a -> Map k a
takeWhileAntitone :: (k -> Bool) -> Map k a -> Map k a
takeWhileAntitone k -> Bool
_ Map k a
Tip = Map k a
forall k a. Map k a
Tip
takeWhileAntitone k -> Bool
p (Bin Int
_ k
kx a
x Map k a
l Map k a
r)
  | k -> Bool
p k
kx = k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
link k
kx a
x Map k a
l ((k -> Bool) -> Map k a -> Map k a
forall k a. (k -> Bool) -> Map k a -> Map k a
takeWhileAntitone k -> Bool
p Map k a
r)
  | Bool
otherwise = (k -> Bool) -> Map k a -> Map k a
forall k a. (k -> Bool) -> Map k a -> Map k a
takeWhileAntitone k -> Bool
p Map k a
l

-- | \(O(\log n)\). Drop while a predicate on the keys holds.
-- The user is responsible for ensuring that for all keys @j@ and @k@ in the map,
-- @j \< k ==\> p j \>= p k@. See note at 'spanAntitone'.
--
-- @
-- dropWhileAntitone p = 'fromDistinctAscList' . 'Data.List.dropWhile' (p . fst) . 'toList'
-- dropWhileAntitone p = 'filterWithKey' (\k -> not (p k))
-- @
--
-- @since 0.5.8

dropWhileAntitone :: (k -> Bool) -> Map k a -> Map k a
dropWhileAntitone :: (k -> Bool) -> Map k a -> Map k a
dropWhileAntitone k -> Bool
_ Map k a
Tip = Map k a
forall k a. Map k a
Tip
dropWhileAntitone k -> Bool
p (Bin Int
_ k
kx a
x Map k a
l Map k a
r)
  | k -> Bool
p k
kx = (k -> Bool) -> Map k a -> Map k a
forall k a. (k -> Bool) -> Map k a -> Map k a
dropWhileAntitone k -> Bool
p Map k a
r
  | Bool
otherwise = k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
link k
kx a
x ((k -> Bool) -> Map k a -> Map k a
forall k a. (k -> Bool) -> Map k a -> Map k a
dropWhileAntitone k -> Bool
p Map k a
l) Map k a
r

-- | \(O(\log n)\). Divide a map at the point where a predicate on the keys stops holding.
-- The user is responsible for ensuring that for all keys @j@ and @k@ in the map,
-- @j \< k ==\> p j \>= p k@.
--
-- @
-- spanAntitone p xs = ('takeWhileAntitone' p xs, 'dropWhileAntitone' p xs)
-- spanAntitone p xs = partitionWithKey (\k _ -> p k) xs
-- @
--
-- Note: if @p@ is not actually antitone, then @spanAntitone@ will split the map
-- at some /unspecified/ point where the predicate switches from holding to not
-- holding (where the predicate is seen to hold before the first key and to fail
-- after the last key).
--
-- @since 0.5.8

spanAntitone :: (k -> Bool) -> Map k a -> (Map k a, Map k a)
spanAntitone :: (k -> Bool) -> Map k a -> (Map k a, Map k a)
spanAntitone k -> Bool
p0 Map k a
m = StrictPair (Map k a) (Map k a) -> (Map k a, Map k a)
forall a b. StrictPair a b -> (a, b)
toPair ((k -> Bool) -> Map k a -> StrictPair (Map k a) (Map k a)
forall k a.
(k -> Bool) -> Map k a -> StrictPair (Map k a) (Map k a)
go k -> Bool
p0 Map k a
m)
  where
    go :: (k -> Bool) -> Map k a -> StrictPair (Map k a) (Map k a)
go k -> Bool
_ Map k a
Tip = Map k a
forall k a. Map k a
Tip Map k a -> Map k a -> StrictPair (Map k a) (Map k a)
forall a b. a -> b -> StrictPair a b
:*: Map k a
forall k a. Map k a
Tip
    go k -> Bool
p (Bin Int
_ k
kx a
x Map k a
l Map k a
r)
      | k -> Bool
p k
kx = let Map k a
u :*: Map k a
v = (k -> Bool) -> Map k a -> StrictPair (Map k a) (Map k a)
go k -> Bool
p Map k a
r in k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
link k
kx a
x Map k a
l Map k a
u Map k a -> Map k a -> StrictPair (Map k a) (Map k a)
forall a b. a -> b -> StrictPair a b
:*: Map k a
v
      | Bool
otherwise = let Map k a
u :*: Map k a
v = (k -> Bool) -> Map k a -> StrictPair (Map k a) (Map k a)
go k -> Bool
p Map k a
l in Map k a
u Map k a -> Map k a -> StrictPair (Map k a) (Map k a)
forall a b. a -> b -> StrictPair a b
:*: k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
link k
kx a
x Map k a
v Map k a
r

-- | \(O(n)\). Partition the map according to a predicate. The first
-- map contains all elements that satisfy the predicate, the second all
-- elements that fail the predicate. See also 'split'.
--
-- > partition (> "a") (fromList [(5,"a"), (3,"b")]) == (singleton 3 "b", singleton 5 "a")
-- > partition (< "x") (fromList [(5,"a"), (3,"b")]) == (fromList [(3, "b"), (5, "a")], empty)
-- > partition (> "x") (fromList [(5,"a"), (3,"b")]) == (empty, fromList [(3, "b"), (5, "a")])

partition :: (a -> Bool) -> Map k a -> (Map k a,Map k a)
partition :: (a -> Bool) -> Map k a -> (Map k a, Map k a)
partition a -> Bool
p Map k a
m
  = (k -> a -> Bool) -> Map k a -> (Map k a, Map k a)
forall k a. (k -> a -> Bool) -> Map k a -> (Map k a, Map k a)
partitionWithKey (\k
_ a
x -> a -> Bool
p a
x) Map k a
m

-- | \(O(n)\). Partition the map according to a predicate. The first
-- map contains all elements that satisfy the predicate, the second all
-- elements that fail the predicate. See also 'split'.
--
-- > partitionWithKey (\ k _ -> k > 3) (fromList [(5,"a"), (3,"b")]) == (singleton 5 "a", singleton 3 "b")
-- > partitionWithKey (\ k _ -> k < 7) (fromList [(5,"a"), (3,"b")]) == (fromList [(3, "b"), (5, "a")], empty)
-- > partitionWithKey (\ k _ -> k > 7) (fromList [(5,"a"), (3,"b")]) == (empty, fromList [(3, "b"), (5, "a")])

partitionWithKey :: (k -> a -> Bool) -> Map k a -> (Map k a,Map k a)
partitionWithKey :: (k -> a -> Bool) -> Map k a -> (Map k a, Map k a)
partitionWithKey k -> a -> Bool
p0 Map k a
t0 = StrictPair (Map k a) (Map k a) -> (Map k a, Map k a)
forall a b. StrictPair a b -> (a, b)
toPair (StrictPair (Map k a) (Map k a) -> (Map k a, Map k a))
-> StrictPair (Map k a) (Map k a) -> (Map k a, Map k a)
forall a b. (a -> b) -> a -> b
$ (k -> a -> Bool) -> Map k a -> StrictPair (Map k a) (Map k a)
forall k a.
(k -> a -> Bool) -> Map k a -> StrictPair (Map k a) (Map k a)
go k -> a -> Bool
p0 Map k a
t0
  where
    go :: (k -> a -> Bool) -> Map k a -> StrictPair (Map k a) (Map k a)
go k -> a -> Bool
_ Map k a
Tip = (Map k a
forall k a. Map k a
Tip Map k a -> Map k a -> StrictPair (Map k a) (Map k a)
forall a b. a -> b -> StrictPair a b
:*: Map k a
forall k a. Map k a
Tip)
    go k -> a -> Bool
p t :: Map k a
t@(Bin Int
_ k
kx a
x Map k a
l Map k a
r)
      | k -> a -> Bool
p k
kx a
x    = (if Map k a
l1 Map k a -> Map k a -> Bool
forall a. a -> a -> Bool
`ptrEq` Map k a
l Bool -> Bool -> Bool
&& Map k a
r1 Map k a -> Map k a -> Bool
forall a. a -> a -> Bool
`ptrEq` Map k a
r
                     then Map k a
t
                     else k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
link k
kx a
x Map k a
l1 Map k a
r1) Map k a -> Map k a -> StrictPair (Map k a) (Map k a)
forall a b. a -> b -> StrictPair a b
:*: Map k a -> Map k a -> Map k a
forall k a. Map k a -> Map k a -> Map k a
link2 Map k a
l2 Map k a
r2
      | Bool
otherwise = Map k a -> Map k a -> Map k a
forall k a. Map k a -> Map k a -> Map k a
link2 Map k a
l1 Map k a
r1 Map k a -> Map k a -> StrictPair (Map k a) (Map k a)
forall a b. a -> b -> StrictPair a b
:*:
                    (if Map k a
l2 Map k a -> Map k a -> Bool
forall a. a -> a -> Bool
`ptrEq` Map k a
l Bool -> Bool -> Bool
&& Map k a
r2 Map k a -> Map k a -> Bool
forall a. a -> a -> Bool
`ptrEq` Map k a
r
                     then Map k a
t
                     else k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
link k
kx a
x Map k a
l2 Map k a
r2)
      where
        (Map k a
l1 :*: Map k a
l2) = (k -> a -> Bool) -> Map k a -> StrictPair (Map k a) (Map k a)
go k -> a -> Bool
p Map k a
l
        (Map k a
r1 :*: Map k a
r2) = (k -> a -> Bool) -> Map k a -> StrictPair (Map k a) (Map k a)
go k -> a -> Bool
p Map k a
r

-- | \(O(n)\). Map values and collect the 'Just' results.
--
-- > let f x = if x == "a" then Just "new a" else Nothing
-- > mapMaybe f (fromList [(5,"a"), (3,"b")]) == singleton 5 "new a"

mapMaybe :: (a -> Maybe b) -> Map k a -> Map k b
mapMaybe :: (a -> Maybe b) -> Map k a -> Map k b
mapMaybe a -> Maybe b
f = (k -> a -> Maybe b) -> Map k a -> Map k b
forall k a b. (k -> a -> Maybe b) -> Map k a -> Map k b
mapMaybeWithKey (\k
_ a
x -> a -> Maybe b
f a
x)

-- | \(O(n)\). Map keys\/values and collect the 'Just' results.
--
-- > let f k _ = if k < 5 then Just ("key : " ++ (show k)) else Nothing
-- > mapMaybeWithKey f (fromList [(5,"a"), (3,"b")]) == singleton 3 "key : 3"

mapMaybeWithKey :: (k -> a -> Maybe b) -> Map k a -> Map k b
mapMaybeWithKey :: (k -> a -> Maybe b) -> Map k a -> Map k b
mapMaybeWithKey k -> a -> Maybe b
_ Map k a
Tip = Map k b
forall k a. Map k a
Tip
mapMaybeWithKey k -> a -> Maybe b
f (Bin Int
_ k
kx a
x Map k a
l Map k a
r) = case k -> a -> Maybe b
f k
kx a
x of
  Just b
y  -> k -> b -> Map k b -> Map k b -> Map k b
forall k a. k -> a -> Map k a -> Map k a -> Map k a
link k
kx b
y ((k -> a -> Maybe b) -> Map k a -> Map k b
forall k a b. (k -> a -> Maybe b) -> Map k a -> Map k b
mapMaybeWithKey k -> a -> Maybe b
f Map k a
l) ((k -> a -> Maybe b) -> Map k a -> Map k b
forall k a b. (k -> a -> Maybe b) -> Map k a -> Map k b
mapMaybeWithKey k -> a -> Maybe b
f Map k a
r)
  Maybe b
Nothing -> Map k b -> Map k b -> Map k b
forall k a. Map k a -> Map k a -> Map k a
link2 ((k -> a -> Maybe b) -> Map k a -> Map k b
forall k a b. (k -> a -> Maybe b) -> Map k a -> Map k b
mapMaybeWithKey k -> a -> Maybe b
f Map k a
l) ((k -> a -> Maybe b) -> Map k a -> Map k b
forall k a b. (k -> a -> Maybe b) -> Map k a -> Map k b
mapMaybeWithKey k -> a -> Maybe b
f Map k a
r)

-- | \(O(n)\). Traverse keys\/values and collect the 'Just' results.
--
-- @since 0.5.8
traverseMaybeWithKey :: Applicative f
                     => (k -> a -> f (Maybe b)) -> Map k a -> f (Map k b)
traverseMaybeWithKey :: (k -> a -> f (Maybe b)) -> Map k a -> f (Map k b)
traverseMaybeWithKey = (k -> a -> f (Maybe b)) -> Map k a -> f (Map k b)
forall (f :: * -> *) k a b.
Applicative f =>
(k -> a -> f (Maybe b)) -> Map k a -> f (Map k b)
go
  where
    go :: (k -> t -> f (Maybe a)) -> Map k t -> f (Map k a)
go k -> t -> f (Maybe a)
_ Map k t
Tip = Map k a -> f (Map k a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map k a
forall k a. Map k a
Tip
    go k -> t -> f (Maybe a)
f (Bin Int
_ k
kx t
x Map k t
Tip Map k t
Tip) = Map k a -> (a -> Map k a) -> Maybe a -> Map k a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Map k a
forall k a. Map k a
Tip (\a
x' -> Int -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin Int
1 k
kx a
x' Map k a
forall k a. Map k a
Tip Map k a
forall k a. Map k a
Tip) (Maybe a -> Map k a) -> f (Maybe a) -> f (Map k a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> k -> t -> f (Maybe a)
f k
kx t
x
    go k -> t -> f (Maybe a)
f (Bin Int
_ k
kx t
x Map k t
l Map k t
r) = (Map k a -> Maybe a -> Map k a -> Map k a)
-> f (Map k a) -> f (Maybe a) -> f (Map k a) -> f (Map k a)
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 Map k a -> Maybe a -> Map k a -> Map k a
combine ((k -> t -> f (Maybe a)) -> Map k t -> f (Map k a)
go k -> t -> f (Maybe a)
f Map k t
l) (k -> t -> f (Maybe a)
f k
kx t
x) ((k -> t -> f (Maybe a)) -> Map k t -> f (Map k a)
go k -> t -> f (Maybe a)
f Map k t
r)
      where
        combine :: Map k a -> Maybe a -> Map k a -> Map k a
combine !Map k a
l' Maybe a
mx !Map k a
r' = case Maybe a
mx of
          Maybe a
Nothing -> Map k a -> Map k a -> Map k a
forall k a. Map k a -> Map k a -> Map k a
link2 Map k a
l' Map k a
r'
          Just a
x' -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
link k
kx a
x' Map k a
l' Map k a
r'

-- | \(O(n)\). Map values and separate the 'Left' and 'Right' results.
--
-- > let f a = if a < "c" then Left a else Right a
-- > mapEither f (fromList [(5,"a"), (3,"b"), (1,"x"), (7,"z")])
-- >     == (fromList [(3,"b"), (5,"a")], fromList [(1,"x"), (7,"z")])
-- >
-- > mapEither (\ a -> Right a) (fromList [(5,"a"), (3,"b"), (1,"x"), (7,"z")])
-- >     == (empty, fromList [(5,"a"), (3,"b"), (1,"x"), (7,"z")])

mapEither :: (a -> Either b c) -> Map k a -> (Map k b, Map k c)
mapEither :: (a -> Either b c) -> Map k a -> (Map k b, Map k c)
mapEither a -> Either b c
f Map k a
m
  = (k -> a -> Either b c) -> Map k a -> (Map k b, Map k c)
forall k a b c.
(k -> a -> Either b c) -> Map k a -> (Map k b, Map k c)
mapEitherWithKey (\k
_ a
x -> a -> Either b c
f a
x) Map k a
m

-- | \(O(n)\). Map keys\/values and separate the 'Left' and 'Right' results.
--
-- > let f k a = if k < 5 then Left (k * 2) else Right (a ++ a)
-- > mapEitherWithKey f (fromList [(5,"a"), (3,"b"), (1,"x"), (7,"z")])
-- >     == (fromList [(1,2), (3,6)], fromList [(5,"aa"), (7,"zz")])
-- >
-- > mapEitherWithKey (\_ a -> Right a) (fromList [(5,"a"), (3,"b"), (1,"x"), (7,"z")])
-- >     == (empty, fromList [(1,"x"), (3,"b"), (5,"a"), (7,"z")])

mapEitherWithKey :: (k -> a -> Either b c) -> Map k a -> (Map k b, Map k c)
mapEitherWithKey :: (k -> a -> Either b c) -> Map k a -> (Map k b, Map k c)
mapEitherWithKey k -> a -> Either b c
f0 Map k a
t0 = StrictPair (Map k b) (Map k c) -> (Map k b, Map k c)
forall a b. StrictPair a b -> (a, b)
toPair (StrictPair (Map k b) (Map k c) -> (Map k b, Map k c))
-> StrictPair (Map k b) (Map k c) -> (Map k b, Map k c)
forall a b. (a -> b) -> a -> b
$ (k -> a -> Either b c) -> Map k a -> StrictPair (Map k b) (Map k c)
forall k t a a.
(k -> t -> Either a a) -> Map k t -> StrictPair (Map k a) (Map k a)
go k -> a -> Either b c
f0 Map k a
t0
  where
    go :: (k -> t -> Either a a) -> Map k t -> StrictPair (Map k a) (Map k a)
go k -> t -> Either a a
_ Map k t
Tip = (Map k a
forall k a. Map k a
Tip Map k a -> Map k a -> StrictPair (Map k a) (Map k a)
forall a b. a -> b -> StrictPair a b
:*: Map k a
forall k a. Map k a
Tip)
    go k -> t -> Either a a
f (Bin Int
_ k
kx t
x Map k t
l Map k t
r) = case k -> t -> Either a a
f k
kx t
x of
      Left a
y  -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
link k
kx a
y Map k a
l1 Map k a
r1 Map k a -> Map k a -> StrictPair (Map k a) (Map k a)
forall a b. a -> b -> StrictPair a b
:*: Map k a -> Map k a -> Map k a
forall k a. Map k a -> Map k a -> Map k a
link2 Map k a
l2 Map k a
r2
      Right a
z -> Map k a -> Map k a -> Map k a
forall k a. Map k a -> Map k a -> Map k a
link2 Map k a
l1 Map k a
r1 Map k a -> Map k a -> StrictPair (Map k a) (Map k a)
forall a b. a -> b -> StrictPair a b
:*: k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
link k
kx a
z Map k a
l2 Map k a
r2
     where
        (Map k a
l1 :*: Map k a
l2) = (k -> t -> Either a a) -> Map k t -> StrictPair (Map k a) (Map k a)
go k -> t -> Either a a
f Map k t
l
        (Map k a
r1 :*: Map k a
r2) = (k -> t -> Either a a) -> Map k t -> StrictPair (Map k a) (Map k a)
go k -> t -> Either a a
f Map k t
r

{--------------------------------------------------------------------
  Mapping
--------------------------------------------------------------------}
-- | \(O(n)\). Map a function over all values in the map.
--
-- > map (++ "x") (fromList [(5,"a"), (3,"b")]) == fromList [(3, "bx"), (5, "ax")]

map :: (a -> b) -> Map k a -> Map k b
map :: (a -> b) -> Map k a -> Map k b
map a -> b
f = Map k a -> Map k b
go where
  go :: Map k a -> Map k b
go Map k a
Tip = Map k b
forall k a. Map k a
Tip
  go (Bin Int
sx k
kx a
x Map k a
l Map k a
r) = Int -> k -> b -> Map k b -> Map k b -> Map k b
forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin Int
sx k
kx (a -> b
f a
x) (Map k a -> Map k b
go Map k a
l) (Map k a -> Map k b
go Map k a
r)
-- We use a `go` function to allow `map` to inline. This makes
-- a big difference if someone uses `map (const x) m` instead
-- of `x <$ m`; it doesn't seem to do any harm.

#ifdef __GLASGOW_HASKELL__
{-# NOINLINE [1] map #-}
{-# RULES
"map/map" forall f g xs . map f (map g xs) = map (f . g) xs
"map/coerce" map coerce = coerce
 #-}
#endif

-- | \(O(n)\). Map a function over all values in the map.
--
-- > let f key x = (show key) ++ ":" ++ x
-- > mapWithKey f (fromList [(5,"a"), (3,"b")]) == fromList [(3, "3:b"), (5, "5:a")]

mapWithKey :: (k -> a -> b) -> Map k a -> Map k b
mapWithKey :: (k -> a -> b) -> Map k a -> Map k b
mapWithKey k -> a -> b
_ Map k a
Tip = Map k b
forall k a. Map k a
Tip
mapWithKey k -> a -> b
f (Bin Int
sx k
kx a
x Map k a
l Map k a
r) = Int -> k -> b -> Map k b -> Map k b -> Map k b
forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin Int
sx k
kx (k -> a -> b
f k
kx a
x) ((k -> a -> b) -> Map k a -> Map k b
forall k a b. (k -> a -> b) -> Map k a -> Map k b
mapWithKey k -> a -> b
f Map k a
l) ((k -> a -> b) -> Map k a -> Map k b
forall k a b. (k -> a -> b) -> Map k a -> Map k b
mapWithKey k -> a -> b
f Map k a
r)

#ifdef __GLASGOW_HASKELL__
{-# NOINLINE [1] mapWithKey #-}
{-# RULES
"mapWithKey/mapWithKey" forall f g xs . mapWithKey f (mapWithKey g xs) =
  mapWithKey (\k a -> f k (g k a)) xs
"mapWithKey/map" forall f g xs . mapWithKey f (map g xs) =
  mapWithKey (\k a -> f k (g a)) xs
"map/mapWithKey" forall f g xs . map f (mapWithKey g xs) =
  mapWithKey (\k a -> f (g k a)) xs
 #-}
#endif

-- | \(O(n)\).
-- @'traverseWithKey' f m == 'fromList' <$> 'traverse' (\(k, v) -> (,) k <$> f k v) ('toList' m)@
-- That is, behaves exactly like a regular 'traverse' except that the traversing
-- function also has access to the key associated with a value.
--
-- > traverseWithKey (\k v -> if odd k then Just (succ v) else Nothing) (fromList [(1, 'a'), (5, 'e')]) == Just (fromList [(1, 'b'), (5, 'f')])
-- > traverseWithKey (\k v -> if odd k then Just (succ v) else Nothing) (fromList [(2, 'c')])           == Nothing
traverseWithKey :: Applicative t => (k -> a -> t b) -> Map k a -> t (Map k b)
traverseWithKey :: (k -> a -> t b) -> Map k a -> t (Map k b)
traverseWithKey k -> a -> t b
f = Map k a -> t (Map k b)
go
  where
    go :: Map k a -> t (Map k b)
go Map k a
Tip = Map k b -> t (Map k b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map k b
forall k a. Map k a
Tip
    go (Bin Int
1 k
k a
v Map k a
_ Map k a
_) = (\b
v' -> Int -> k -> b -> Map k b -> Map k b -> Map k b
forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin Int
1 k
k b
v' Map k b
forall k a. Map k a
Tip Map k b
forall k a. Map k a
Tip) (b -> Map k b) -> t b -> t (Map k b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> k -> a -> t b
f k
k a
v
    go (Bin Int
s k
k a
v Map k a
l Map k a
r) = (Map k b -> b -> Map k b -> Map k b)
-> t (Map k b) -> t b -> t (Map k b) -> t (Map k b)
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 ((b -> Map k b -> Map k b -> Map k b)
-> Map k b -> b -> Map k b -> Map k b
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Int -> k -> b -> Map k b -> Map k b -> Map k b
forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin Int
s k
k)) (Map k a -> t (Map k b)
go Map k a
l) (k -> a -> t b
f k
k a
v) (Map k a -> t (Map k b)
go Map k a
r)
{-# INLINE traverseWithKey #-}

-- | \(O(n)\). The function 'mapAccum' threads an accumulating
-- argument through the map in ascending order of keys.
--
-- > let f a b = (a ++ b, b ++ "X")
-- > mapAccum f "Everything: " (fromList [(5,"a"), (3,"b")]) == ("Everything: ba", fromList [(3, "bX"), (5, "aX")])

mapAccum :: (a -> b -> (a,c)) -> a -> Map k b -> (a,Map k c)
mapAccum :: (a -> b -> (a, c)) -> a -> Map k b -> (a, Map k c)
mapAccum a -> b -> (a, c)
f a
a Map k b
m
  = (a -> k -> b -> (a, c)) -> a -> Map k b -> (a, Map k c)
forall a k b c.
(a -> k -> b -> (a, c)) -> a -> Map k b -> (a, Map k c)
mapAccumWithKey (\a
a' k
_ b
x' -> a -> b -> (a, c)
f a
a' b
x') a
a Map k b
m

-- | \(O(n)\). The function 'mapAccumWithKey' threads an accumulating
-- argument through the map in ascending order of keys.
--
-- > let f a k b = (a ++ " " ++ (show k) ++ "-" ++ b, b ++ "X")
-- > mapAccumWithKey f "Everything:" (fromList [(5,"a"), (3,"b")]) == ("Everything: 3-b 5-a", fromList [(3, "bX"), (5, "aX")])

mapAccumWithKey :: (a -> k -> b -> (a,c)) -> a -> Map k b -> (a,Map k c)
mapAccumWithKey :: (a -> k -> b -> (a, c)) -> a -> Map k b -> (a, Map k c)
mapAccumWithKey a -> k -> b -> (a, c)
f a
a Map k b
t
  = (a -> k -> b -> (a, c)) -> a -> Map k b -> (a, Map k c)
forall a k b c.
(a -> k -> b -> (a, c)) -> a -> Map k b -> (a, Map k c)
mapAccumL a -> k -> b -> (a, c)
f a
a Map k b
t

-- | \(O(n)\). The function 'mapAccumL' threads an accumulating
-- argument through the map in ascending order of keys.
mapAccumL :: (a -> k -> b -> (a,c)) -> a -> Map k b -> (a,Map k c)
mapAccumL :: (a -> k -> b -> (a, c)) -> a -> Map k b -> (a, Map k c)
mapAccumL a -> k -> b -> (a, c)
_ a
a Map k b
Tip               = (a
a,Map k c
forall k a. Map k a
Tip)
mapAccumL a -> k -> b -> (a, c)
f a
a (Bin Int
sx k
kx b
x Map k b
l Map k b
r) =
  let (a
a1,Map k c
l') = (a -> k -> b -> (a, c)) -> a -> Map k b -> (a, Map k c)
forall a k b c.
(a -> k -> b -> (a, c)) -> a -> Map k b -> (a, Map k c)
mapAccumL a -> k -> b -> (a, c)
f a
a Map k b
l
      (a
a2,c
x') = a -> k -> b -> (a, c)
f a
a1 k
kx b
x
      (a
a3,Map k c
r') = (a -> k -> b -> (a, c)) -> a -> Map k b -> (a, Map k c)
forall a k b c.
(a -> k -> b -> (a, c)) -> a -> Map k b -> (a, Map k c)
mapAccumL a -> k -> b -> (a, c)
f a
a2 Map k b
r
  in (a
a3,Int -> k -> c -> Map k c -> Map k c -> Map k c
forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin Int
sx k
kx c
x' Map k c
l' Map k c
r')

-- | \(O(n)\). The function 'mapAccumRWithKey' threads an accumulating
-- argument through the map in descending order of keys.
mapAccumRWithKey :: (a -> k -> b -> (a,c)) -> a -> Map k b -> (a,Map k c)
mapAccumRWithKey :: (a -> k -> b -> (a, c)) -> a -> Map k b -> (a, Map k c)
mapAccumRWithKey a -> k -> b -> (a, c)
_ a
a Map k b
Tip = (a
a,Map k c
forall k a. Map k a
Tip)
mapAccumRWithKey a -> k -> b -> (a, c)
f a
a (Bin Int
sx k
kx b
x Map k b
l Map k b
r) =
  let (a
a1,Map k c
r') = (a -> k -> b -> (a, c)) -> a -> Map k b -> (a, Map k c)
forall a k b c.
(a -> k -> b -> (a, c)) -> a -> Map k b -> (a, Map k c)
mapAccumRWithKey a -> k -> b -> (a, c)
f a
a Map k b
r
      (a
a2,c
x') = a -> k -> b -> (a, c)
f a
a1 k
kx b
x
      (a
a3,Map k c
l') = (a -> k -> b -> (a, c)) -> a -> Map k b -> (a, Map k c)
forall a k b c.
(a -> k -> b -> (a, c)) -> a -> Map k b -> (a, Map k c)
mapAccumRWithKey a -> k -> b -> (a, c)
f a
a2 Map k b
l
  in (a
a3,Int -> k -> c -> Map k c -> Map k c -> Map k c
forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin Int
sx k
kx c
x' Map k c
l' Map k c
r')

-- | \(O(n \log n)\).
-- @'mapKeys' f s@ is the map obtained by applying @f@ to each key of @s@.
--
-- The size of the result may be smaller if @f@ maps two or more distinct
-- keys to the same new key.  In this case the value at the greatest of the
-- original keys is retained.
--
-- > mapKeys (+ 1) (fromList [(5,"a"), (3,"b")])                        == fromList [(4, "b"), (6, "a")]
-- > mapKeys (\ _ -> 1) (fromList [(1,"b"), (2,"a"), (3,"d"), (4,"c")]) == singleton 1 "c"
-- > mapKeys (\ _ -> 3) (fromList [(1,"b"), (2,"a"), (3,"d"), (4,"c")]) == singleton 3 "c"

mapKeys :: Ord k2 => (k1->k2) -> Map k1 a -> Map k2 a
mapKeys :: (k1 -> k2) -> Map k1 a -> Map k2 a
mapKeys k1 -> k2
f = [(k2, a)] -> Map k2 a
forall k a. Ord k => [(k, a)] -> Map k a
fromList ([(k2, a)] -> Map k2 a)
-> (Map k1 a -> [(k2, a)]) -> Map k1 a -> Map k2 a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (k1 -> a -> [(k2, a)] -> [(k2, a)])
-> [(k2, a)] -> Map k1 a -> [(k2, a)]
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
foldrWithKey (\k1
k a
x [(k2, a)]
xs -> (k1 -> k2
f k1
k, a
x) (k2, a) -> [(k2, a)] -> [(k2, a)]
forall a. a -> [a] -> [a]
: [(k2, a)]
xs) []
#if __GLASGOW_HASKELL__
{-# INLINABLE mapKeys #-}
#endif

-- | \(O(n \log n)\).
-- @'mapKeysWith' c f s@ is the map obtained by applying @f@ to each key of @s@.
--
-- The size of the result may be smaller if @f@ maps two or more distinct
-- keys to the same new key.  In this case the associated values will be
-- combined using @c@. The value at the greater of the two original keys
-- is used as the first argument to @c@.
--
-- > mapKeysWith (++) (\ _ -> 1) (fromList [(1,"b"), (2,"a"), (3,"d"), (4,"c")]) == singleton 1 "cdab"
-- > mapKeysWith (++) (\ _ -> 3) (fromList [(1,"b"), (2,"a"), (3,"d"), (4,"c")]) == singleton 3 "cdab"

mapKeysWith :: Ord k2 => (a -> a -> a) -> (k1->k2) -> Map k1 a -> Map k2 a
mapKeysWith :: (a -> a -> a) -> (k1 -> k2) -> Map k1 a -> Map k2 a
mapKeysWith a -> a -> a
c k1 -> k2
f = (a -> a -> a) -> [(k2, a)] -> Map k2 a
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
fromListWith a -> a -> a
c ([(k2, a)] -> Map k2 a)
-> (Map k1 a -> [(k2, a)]) -> Map k1 a -> Map k2 a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (k1 -> a -> [(k2, a)] -> [(k2, a)])
-> [(k2, a)] -> Map k1 a -> [(k2, a)]
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
foldrWithKey (\k1
k a
x [(k2, a)]
xs -> (k1 -> k2
f k1
k, a
x) (k2, a) -> [(k2, a)] -> [(k2, a)]
forall a. a -> [a] -> [a]
: [(k2, a)]
xs) []
#if __GLASGOW_HASKELL__
{-# INLINABLE mapKeysWith #-}
#endif


-- | \(O(n)\).
-- @'mapKeysMonotonic' f s == 'mapKeys' f s@, but works only when @f@
-- is strictly monotonic.
-- That is, for any values @x@ and @y@, if @x@ < @y@ then @f x@ < @f y@.
-- /The precondition is not checked./
-- Semi-formally, we have:
--
-- > and [x < y ==> f x < f y | x <- ls, y <- ls]
-- >                     ==> mapKeysMonotonic f s == mapKeys f s
-- >     where ls = keys s
--
-- This means that @f@ maps distinct original keys to distinct resulting keys.
-- This function has better performance than 'mapKeys'.
--
-- > mapKeysMonotonic (\ k -> k * 2) (fromList [(5,"a"), (3,"b")]) == fromList [(6, "b"), (10, "a")]
-- > valid (mapKeysMonotonic (\ k -> k * 2) (fromList [(5,"a"), (3,"b")])) == True
-- > valid (mapKeysMonotonic (\ _ -> 1)     (fromList [(5,"a"), (3,"b")])) == False

mapKeysMonotonic :: (k1->k2) -> Map k1 a -> Map k2 a
mapKeysMonotonic :: (k1 -> k2) -> Map k1 a -> Map k2 a
mapKeysMonotonic k1 -> k2
_ Map k1 a
Tip = Map k2 a
forall k a. Map k a
Tip
mapKeysMonotonic k1 -> k2
f (Bin Int
sz k1
k a
x Map k1 a
l Map k1 a
r) =
    Int -> k2 -> a -> Map k2 a -> Map k2 a -> Map k2 a
forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin Int
sz (k1 -> k2
f k1
k) a
x ((k1 -> k2) -> Map k1 a -> Map k2 a
forall k1 k2 a. (k1 -> k2) -> Map k1 a -> Map k2 a
mapKeysMonotonic k1 -> k2
f Map k1 a
l) ((k1 -> k2) -> Map k1 a -> Map k2 a
forall k1 k2 a. (k1 -> k2) -> Map k1 a -> Map k2 a
mapKeysMonotonic k1 -> k2
f Map k1 a
r)

{--------------------------------------------------------------------
  Folds
--------------------------------------------------------------------}

-- | \(O(n)\). Fold the values in the map using the given right-associative
-- binary operator, such that @'foldr' f z == 'Prelude.foldr' f z . 'elems'@.
--
-- For example,
--
-- > elems map = foldr (:) [] map
--
-- > let f a len = len + (length a)
-- > foldr f 0 (fromList [(5,"a"), (3,"bbb")]) == 4
foldr :: (a -> b -> b) -> b -> Map k a -> b
foldr :: (a -> b -> b) -> b -> Map k a -> b
foldr a -> b -> b
f b
z = b -> Map k a -> b
go b
z
  where
    go :: b -> Map k a -> b
go b
z' Map k a
Tip             = b
z'
    go b
z' (Bin Int
_ k
_ a
x Map k a
l Map k a
r) = b -> Map k a -> b
go (a -> b -> b
f a
x (b -> Map k a -> b
go b
z' Map k a
r)) Map k a
l
{-# INLINE foldr #-}

-- | \(O(n)\). A strict version of 'foldr'. Each application of the operator is
-- evaluated before using the result in the next application. This
-- function is strict in the starting value.
foldr' :: (a -> b -> b) -> b -> Map k a -> b
foldr' :: (a -> b -> b) -> b -> Map k a -> b
foldr' a -> b -> b
f b
z = b -> Map k a -> b
go b
z
  where
    go :: b -> Map k a -> b
go !b
z' Map k a
Tip            = b
z'
    go b
z' (Bin Int
_ k
_ a
x Map k a
l Map k a
r) = b -> Map k a -> b
go (a -> b -> b
f a
x (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$! b -> Map k a -> b
go b
z' Map k a
r) Map k a
l
{-# INLINE foldr' #-}

-- | \(O(n)\). Fold the values in the map using the given left-associative
-- binary operator, such that @'foldl' f z == 'Prelude.foldl' f z . 'elems'@.
--
-- For example,
--
-- > elems = reverse . foldl (flip (:)) []
--
-- > let f len a = len + (length a)
-- > foldl f 0 (fromList [(5,"a"), (3,"bbb")]) == 4
foldl :: (a -> b -> a) -> a -> Map k b -> a
foldl :: (a -> b -> a) -> a -> Map k b -> a
foldl a -> b -> a
f a
z = a -> Map k b -> a
go a
z
  where
    go :: a -> Map k b -> a
go a
z' Map k b
Tip             = a
z'
    go a
z' (Bin Int
_ k
_ b
x Map k b
l Map k b
r) = a -> Map k b -> a
go (a -> b -> a
f (a -> Map k b -> a
go a
z' Map k b
l) b
x) Map k b
r
{-# INLINE foldl #-}

-- | \(O(n)\). A strict version of 'foldl'. Each application of the operator is
-- evaluated before using the result in the next application. This
-- function is strict in the starting value.
foldl' :: (a -> b -> a) -> a -> Map k b -> a
foldl' :: (a -> b -> a) -> a -> Map k b -> a
foldl' a -> b -> a
f a
z = a -> Map k b -> a
go a
z
  where
    go :: a -> Map k b -> a
go !a
z' Map k b
Tip            = a
z'
    go a
z' (Bin Int
_ k
_ b
x Map k b
l Map k b
r) =
      let !z'' :: a
z'' = a -> Map k b -> a
go a
z' Map k b
l
      in a -> Map k b -> a
go (a -> b -> a
f a
z'' b
x) Map k b
r
{-# INLINE foldl' #-}

-- | \(O(n)\). Fold the keys and values in the map using the given right-associative
-- binary operator, such that
-- @'foldrWithKey' f z == 'Prelude.foldr' ('uncurry' f) z . 'toAscList'@.
--
-- For example,
--
-- > keys map = foldrWithKey (\k x ks -> k:ks) [] map
--
-- > let f k a result = result ++ "(" ++ (show k) ++ ":" ++ a ++ ")"
-- > foldrWithKey f "Map: " (fromList [(5,"a"), (3,"b")]) == "Map: (5:a)(3:b)"
foldrWithKey :: (k -> a -> b -> b) -> b -> Map k a -> b
foldrWithKey :: (k -> a -> b -> b) -> b -> Map k a -> b
foldrWithKey k -> a -> b -> b
f b
z = b -> Map k a -> b
go b
z
  where
    go :: b -> Map k a -> b
go b
z' Map k a
Tip             = b
z'
    go b
z' (Bin Int
_ k
kx a
x Map k a
l Map k a
r) = b -> Map k a -> b
go (k -> a -> b -> b
f k
kx a
x (b -> Map k a -> b
go b
z' Map k a
r)) Map k a
l
{-# INLINE foldrWithKey #-}

-- | \(O(n)\). A strict version of 'foldrWithKey'. Each application of the operator is
-- evaluated before using the result in the next application. This
-- function is strict in the starting value.
foldrWithKey' :: (k -> a -> b -> b) -> b -> Map k a -> b
foldrWithKey' :: (k -> a -> b -> b) -> b -> Map k a -> b
foldrWithKey' k -> a -> b -> b
f b
z = b -> Map k a -> b
go b
z
  where
    go :: b -> Map k a -> b
go !b
z' Map k a
Tip              = b
z'
    go b
z' (Bin Int
_ k
kx a
x Map k a
l Map k a
r) = b -> Map k a -> b
go (k -> a -> b -> b
f k
kx a
x (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$! b -> Map k a -> b
go b
z' Map k a
r) Map k a
l
{-# INLINE foldrWithKey' #-}

-- | \(O(n)\). Fold the keys and values in the map using the given left-associative
-- binary operator, such that
-- @'foldlWithKey' f z == 'Prelude.foldl' (\\z' (kx, x) -> f z' kx x) z . 'toAscList'@.
--
-- For example,
--
-- > keys = reverse . foldlWithKey (\ks k x -> k:ks) []
--
-- > let f result k a = result ++ "(" ++ (show k) ++ ":" ++ a ++ ")"
-- > foldlWithKey f "Map: " (fromList [(5,"a"), (3,"b")]) == "Map: (3:b)(5:a)"
foldlWithKey :: (a -> k -> b -> a) -> a -> Map k b -> a
foldlWithKey :: (a -> k -> b -> a) -> a -> Map k b -> a
foldlWithKey a -> k -> b -> a
f a
z = a -> Map k b -> a
go a
z
  where
    go :: a -> Map k b -> a
go a
z' Map k b
Tip              = a
z'
    go a
z' (Bin Int
_ k
kx b
x Map k b
l Map k b
r) = a -> Map k b -> a
go (a -> k -> b -> a
f (a -> Map k b -> a
go a
z' Map k b
l) k
kx b
x) Map k b
r
{-# INLINE foldlWithKey #-}

-- | \(O(n)\). A strict version of 'foldlWithKey'. Each application of the operator is
-- evaluated before using the result in the next application. This
-- function is strict in the starting value.
foldlWithKey' :: (a -> k -> b -> a) -> a -> Map k b -> a
foldlWithKey' :: (a -> k -> b -> a) -> a -> Map k b -> a
foldlWithKey' a -> k -> b -> a
f a
z = a -> Map k b -> a
go a
z
  where
    go :: a -> Map k b -> a
go !a
z' Map k b
Tip             = a
z'
    go a
z' (Bin Int
_ k
kx b
x Map k b
l Map k b
r) =
      let !z'' :: a
z'' = a -> Map k b -> a
go a
z' Map k b
l
      in a -> Map k b -> a
go (a -> k -> b -> a
f a
z'' k
kx b
x) Map k b
r
{-# INLINE foldlWithKey' #-}

-- | \(O(n)\). Fold the keys and values in the map using the given monoid, such that
--
-- @'foldMapWithKey' f = 'Prelude.fold' . 'mapWithKey' f@
--
-- This can be an asymptotically faster than 'foldrWithKey' or 'foldlWithKey' for some monoids.
--
-- @since 0.5.4
foldMapWithKey :: Monoid m => (k -> a -> m) -> Map k a -> m
foldMapWithKey :: (k -> a -> m) -> Map k a -> m
foldMapWithKey k -> a -> m
f = Map k a -> m
go
  where
    go :: Map k a -> m
go Map k a
Tip             = m
forall a. Monoid a => a
mempty
    go (Bin Int
1 k
k a
v Map k a
_ Map k a
_) = k -> a -> m
f k
k a
v
    go (Bin Int
_ k
k a
v Map k a
l Map k a
r) = Map k a -> m
go Map k a
l m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` (k -> a -> m
f k
k a
v m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` Map k a -> m
go Map k a
r)
{-# INLINE foldMapWithKey #-}

{--------------------------------------------------------------------
  List variations
--------------------------------------------------------------------}
-- | \(O(n)\).
-- Return all elements of the map in the ascending order of their keys.
-- Subject to list fusion.
--
-- > elems (fromList [(5,"a"), (3,"b")]) == ["b","a"]
-- > elems empty == []

elems :: Map k a -> [a]
elems :: Map k a -> [a]
elems = (a -> [a] -> [a]) -> [a] -> Map k a -> [a]
forall a b k. (a -> b -> b) -> b -> Map k a -> b
foldr (:) []

-- | \(O(n)\). Return all keys of the map in ascending order. Subject to list
-- fusion.
--
-- > keys (fromList [(5,"a"), (3,"b")]) == [3,5]
-- > keys empty == []

keys  :: Map k a -> [k]
keys :: Map k a -> [k]
keys = (k -> a -> [k] -> [k]) -> [k] -> Map k a -> [k]
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
foldrWithKey (\k
k a
_ [k]
ks -> k
k k -> [k] -> [k]
forall a. a -> [a] -> [a]
: [k]
ks) []

-- | \(O(n)\). An alias for 'toAscList'. Return all key\/value pairs in the map
-- in ascending key order. Subject to list fusion.
--
-- > assocs (fromList [(5,"a"), (3,"b")]) == [(3,"b"), (5,"a")]
-- > assocs empty == []

assocs :: Map k a -> [(k,a)]
assocs :: Map k a -> [(k, a)]
assocs Map k a
m
  = Map k a -> [(k, a)]
forall k a. Map k a -> [(k, a)]
toAscList Map k a
m

-- | \(O(n)\). The set of all keys of the map.
--
-- > keysSet (fromList [(5,"a"), (3,"b")]) == Data.Set.fromList [3,5]
-- > keysSet empty == Data.Set.empty

keysSet :: Map k a -> Set.Set k
keysSet :: Map k a -> Set k
keysSet Map k a
Tip = Set k
forall a. Set a
Set.Tip
keysSet (Bin Int
sz k
kx a
_ Map k a
l Map k a
r) = Int -> k -> Set k -> Set k -> Set k
forall a. Int -> a -> Set a -> Set a -> Set a
Set.Bin Int
sz k
kx (Map k a -> Set k
forall k a. Map k a -> Set k
keysSet Map k a
l) (Map k a -> Set k
forall k a. Map k a -> Set k
keysSet Map k a
r)

-- | \(O(n)\). The set of all elements of the map contained in 'Arg's.
--
-- > argSet (fromList [(5,"a"), (3,"b")]) == Data.Set.fromList [Arg 3 "b",Arg 5 "a"]
-- > argSet empty == Data.Set.empty

argSet :: Map k a -> Set.Set (Arg k a)
argSet :: Map k a -> Set (Arg k a)
argSet Map k a
Tip = Set (Arg k a)
forall a. Set a
Set.Tip
argSet (Bin Int
sz k
kx a
x Map k a
l Map k a
r) = Int -> Arg k a -> Set (Arg k a) -> Set (Arg k a) -> Set (Arg k a)
forall a. Int -> a -> Set a -> Set a -> Set a
Set.Bin Int
sz (k -> a -> Arg k a
forall a b. a -> b -> Arg a b
Arg k
kx a
x) (Map k a -> Set (Arg k a)
forall k a. Map k a -> Set (Arg k a)
argSet Map k a
l) (Map k a -> Set (Arg k a)
forall k a. Map k a -> Set (Arg k a)
argSet Map k a
r)

-- | \(O(n)\). Build a map from a set of keys and a function which for each key
-- computes its value.
--
-- > fromSet (\k -> replicate k 'a') (Data.Set.fromList [3, 5]) == fromList [(5,"aaaaa"), (3,"aaa")]
-- > fromSet undefined Data.Set.empty == empty

fromSet :: (k -> a) -> Set.Set k -> Map k a
fromSet :: (k -> a) -> Set k -> Map k a
fromSet k -> a
_ Set k
Set.Tip = Map k a
forall k a. Map k a
Tip
fromSet k -> a
f (Set.Bin Int
sz k
x Set k
l Set k
r) = Int -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin Int
sz k
x (k -> a
f k
x) ((k -> a) -> Set k -> Map k a
forall k a. (k -> a) -> Set k -> Map k a
fromSet k -> a
f Set k
l) ((k -> a) -> Set k -> Map k a
forall k a. (k -> a) -> Set k -> Map k a
fromSet k -> a
f Set k
r)

-- | /O(n)/. Build a map from a set of elements contained inside 'Arg's.
--
-- > fromArgSet (Data.Set.fromList [Arg 3 "aaa", Arg 5 "aaaaa"]) == fromList [(5,"aaaaa"), (3,"aaa")]
-- > fromArgSet Data.Set.empty == empty

fromArgSet :: Set.Set (Arg k a) -> Map k a
fromArgSet :: Set (Arg k a) -> Map k a
fromArgSet Set (Arg k a)
Set.Tip = Map k a
forall k a. Map k a
Tip
fromArgSet (Set.Bin Int
sz (Arg k
x a
v) Set (Arg k a)
l Set (Arg k a)
r) = Int -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin Int
sz k
x a
v (Set (Arg k a) -> Map k a
forall k a. Set (Arg k a) -> Map k a
fromArgSet Set (Arg k a)
l) (Set (Arg k a) -> Map k a
forall k a. Set (Arg k a) -> Map k a
fromArgSet Set (Arg k a)
r)

{--------------------------------------------------------------------
  Lists
--------------------------------------------------------------------}

#ifdef __GLASGOW_HASKELL__
-- | @since 0.5.6.2
instance (Ord k) => GHCExts.IsList (Map k v) where
  type Item (Map k v) = (k,v)
  fromList :: [Item (Map k v)] -> Map k v
fromList = [Item (Map k v)] -> Map k v
forall k a. Ord k => [(k, a)] -> Map k a
fromList
  toList :: Map k v -> [Item (Map k v)]
toList   = Map k v -> [Item (Map k v)]
forall k a. Map k a -> [(k, a)]
toList
#endif

-- | \(O(n \log n)\). Build a map from a list of key\/value pairs. See also 'fromAscList'.
-- If the list contains more than one value for the same key, the last value
-- for the key is retained.
--
-- If the keys of the list are ordered, linear-time implementation is used,
-- with the performance equal to 'fromDistinctAscList'.
--
-- > fromList [] == empty
-- > fromList [(5,"a"), (3,"b"), (5, "c")] == fromList [(5,"c"), (3,"b")]
-- > fromList [(5,"c"), (3,"b"), (5, "a")] == fromList [(5,"a"), (3,"b")]

-- For some reason, when 'singleton' is used in fromList or in
-- create, it is not inlined, so we inline it manually.
fromList :: Ord k => [(k,a)] -> Map k a
fromList :: [(k, a)] -> Map k a
fromList [] = Map k a
forall k a. Map k a
Tip
fromList [(k
kx, a
x)] = Int -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin Int
1 k
kx a
x Map k a
forall k a. Map k a
Tip Map k a
forall k a. Map k a
Tip
fromList ((k
kx0, a
x0) : [(k, a)]
xs0) | k -> [(k, a)] -> Bool
forall a b. Ord a => a -> [(a, b)] -> Bool
not_ordered k
kx0 [(k, a)]
xs0 = Map k a -> [(k, a)] -> Map k a
forall (t :: * -> *) k a.
(Foldable t, Ord k) =>
Map k a -> t (k, a) -> Map k a
fromList' (Int -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin Int
1 k
kx0 a
x0 Map k a
forall k a. Map k a
Tip Map k a
forall k a. Map k a
Tip) [(k, a)]
xs0
                           | Bool
otherwise = Int -> Map k a -> [(k, a)] -> Map k a
forall k t a.
(Ord k, Num t, Bits t) =>
t -> Map k a -> [(k, a)] -> Map k a
go (Int
1::Int) (Int -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin Int
1 k
kx0 a
x0 Map k a
forall k a. Map k a
Tip Map k a
forall k a. Map k a
Tip) [(k, a)]
xs0
  where
    not_ordered :: a -> [(a, b)] -> Bool
not_ordered a
_ [] = Bool
False
    not_ordered a
kx ((a
ky,b
_) : [(a, b)]
_) = a
kx a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
ky
    {-# INLINE not_ordered #-}

    fromList' :: Map k a -> t (k, a) -> Map k a
fromList' Map k a
t0 t (k, a)
xs = (Map k a -> (k, a) -> Map k a) -> Map k a -> t (k, a) -> Map k a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Foldable.foldl' Map k a -> (k, a) -> Map k a
forall k a. Ord k => Map k a -> (k, a) -> Map k a
ins Map k a
t0 t (k, a)
xs
      where ins :: Map k a -> (k, a) -> Map k a
ins Map k a
t (k
k,a
x) = k -> a -> Map k a -> Map k a
forall k a. Ord k => k -> a -> Map k a -> Map k a
insert k
k a
x Map k a
t

    go :: t -> Map k a -> [(k, a)] -> Map k a
go !t
_ Map k a
t [] = Map k a
t
    go t
_ Map k a
t [(k
kx, a
x)] = k -> a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a
insertMax k
kx a
x Map k a
t
    go t
s Map k a
l xs :: [(k, a)]
xs@((k
kx, a
x) : [(k, a)]
xss) | k -> [(k, a)] -> Bool
forall a b. Ord a => a -> [(a, b)] -> Bool
not_ordered k
kx [(k, a)]
xss = Map k a -> [(k, a)] -> Map k a
forall (t :: * -> *) k a.
(Foldable t, Ord k) =>
Map k a -> t (k, a) -> Map k a
fromList' Map k a
l [(k, a)]
xs
                              | Bool
otherwise = case t -> [(k, a)] -> (Map k a, [(k, a)], [(k, a)])
forall a k a.
(Num a, Ord k, Bits a) =>
a -> [(k, a)] -> (Map k a, [(k, a)], [(k, a)])
create t
s [(k, a)]
xss of
                                  (Map k a
r, [(k, a)]
ys, []) -> t -> Map k a -> [(k, a)] -> Map k a
go (t
s t -> Int -> t
forall a. Bits a => a -> Int -> a
`shiftL` Int
1) (k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
link k
kx a
x Map k a
l Map k a
r) [(k, a)]
ys
                                  (Map k a
r, [(k, a)]
_,  [(k, a)]
ys) -> Map k a -> [(k, a)] -> Map k a
forall (t :: * -> *) k a.
(Foldable t, Ord k) =>
Map k a -> t (k, a) -> Map k a
fromList' (k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
link k
kx a
x Map k a
l Map k a
r) [(k, a)]
ys

    -- The create is returning a triple (tree, xs, ys). Both xs and ys
    -- represent not yet processed elements and only one of them can be nonempty.
    -- If ys is nonempty, the keys in ys are not ordered with respect to tree
    -- and must be inserted using fromList'. Otherwise the keys have been
    -- ordered so far.
    create :: a -> [(k, a)] -> (Map k a, [(k, a)], [(k, a)])
create !a
_ [] = (Map k a
forall k a. Map k a
Tip, [], [])
    create a
s xs :: [(k, a)]
xs@((k, a)
xp : [(k, a)]
xss)
      | a
s a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
1 = case (k, a)
xp of (k
kx, a
x) | k -> [(k, a)] -> Bool
forall a b. Ord a => a -> [(a, b)] -> Bool
not_ordered k
kx [(k, a)]
xss -> (Int -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin Int
1 k
kx a
x Map k a
forall k a. Map k a
Tip Map k a
forall k a. Map k a
Tip, [], [(k, a)]
xss)
                                    | Bool
otherwise -> (Int -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin Int
1 k
kx a
x Map k a
forall k a. Map k a
Tip Map k a
forall k a. Map k a
Tip, [(k, a)]
xss, [])
      | Bool
otherwise = case a -> [(k, a)] -> (Map k a, [(k, a)], [(k, a)])
create (a
s a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftR` Int
1) [(k, a)]
xs of
                      res :: (Map k a, [(k, a)], [(k, a)])
res@(Map k a
_, [], [(k, a)]
_) -> (Map k a, [(k, a)], [(k, a)])
res
                      (Map k a
l, [(k
ky, a
y)], [(k, a)]
zs) -> (k -> a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a
insertMax k
ky a
y Map k a
l, [], [(k, a)]
zs)
                      (Map k a
l, ys :: [(k, a)]
ys@((k
ky, a
y):[(k, a)]
yss), [(k, a)]
_) | k -> [(k, a)] -> Bool
forall a b. Ord a => a -> [(a, b)] -> Bool
not_ordered k
ky [(k, a)]
yss -> (Map k a
l, [], [(k, a)]
ys)
                                               | Bool
otherwise -> case a -> [(k, a)] -> (Map k a, [(k, a)], [(k, a)])
create (a
s a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftR` Int
1) [(k, a)]
yss of
                                                   (Map k a
r, [(k, a)]
zs, [(k, a)]
ws) -> (k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
link k
ky a
y Map k a
l Map k a
r, [(k, a)]
zs, [(k, a)]
ws)
#if __GLASGOW_HASKELL__
{-# INLINABLE fromList #-}
#endif

-- | \(O(n \log n)\). Build a map from a list of key\/value pairs with a combining function. See also 'fromAscListWith'.
--
-- > fromListWith (++) [(5,"a"), (5,"b"), (3,"b"), (3,"a"), (5,"a")] == fromList [(3, "ab"), (5, "aba")]
-- > fromListWith (++) [] == empty

fromListWith :: Ord k => (a -> a -> a) -> [(k,a)] -> Map k a
fromListWith :: (a -> a -> a) -> [(k, a)] -> Map k a
fromListWith a -> a -> a
f [(k, a)]
xs
  = (k -> a -> a -> a) -> [(k, a)] -> Map k a
forall k a. Ord k => (k -> a -> a -> a) -> [(k, a)] -> Map k a
fromListWithKey (\k
_ a
x a
y -> a -> a -> a
f a
x a
y) [(k, a)]
xs
#if __GLASGOW_HASKELL__
{-# INLINABLE fromListWith #-}
#endif

-- | \(O(n \log n)\). Build a map from a list of key\/value pairs with a combining function. See also 'fromAscListWithKey'.
--
-- > let f k a1 a2 = (show k) ++ a1 ++ a2
-- > fromListWithKey f [(5,"a"), (5,"b"), (3,"b"), (3,"a"), (5,"a")] == fromList [(3, "3ab"), (5, "5a5ba")]
-- > fromListWithKey f [] == empty

fromListWithKey :: Ord k => (k -> a -> a -> a) -> [(k,a)] -> Map k a
fromListWithKey :: (k -> a -> a -> a) -> [(k, a)] -> Map k a
fromListWithKey k -> a -> a -> a
f [(k, a)]
xs
  = (Map k a -> (k, a) -> Map k a) -> Map k a -> [(k, a)] -> Map k a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Foldable.foldl' Map k a -> (k, a) -> Map k a
ins Map k a
forall k a. Map k a
empty [(k, a)]
xs
  where
    ins :: Map k a -> (k, a) -> Map k a
ins Map k a
t (k
k,a
x) = (k -> a -> a -> a) -> k -> a -> Map k a -> Map k a
forall k a.
Ord k =>
(k -> a -> a -> a) -> k -> a -> Map k a -> Map k a
insertWithKey k -> a -> a -> a
f k
k a
x Map k a
t
#if __GLASGOW_HASKELL__
{-# INLINABLE fromListWithKey #-}
#endif

-- | \(O(n)\). Convert the map to a list of key\/value pairs. Subject to list fusion.
--
-- > toList (fromList [(5,"a"), (3,"b")]) == [(3,"b"), (5,"a")]
-- > toList empty == []

toList :: Map k a -> [(k,a)]
toList :: Map k a -> [(k, a)]
toList = Map k a -> [(k, a)]
forall k a. Map k a -> [(k, a)]
toAscList

-- | \(O(n)\). Convert the map to a list of key\/value pairs where the keys are
-- in ascending order. Subject to list fusion.
--
-- > toAscList (fromList [(5,"a"), (3,"b")]) == [(3,"b"), (5,"a")]

toAscList :: Map k a -> [(k,a)]
toAscList :: Map k a -> [(k, a)]
toAscList = (k -> a -> [(k, a)] -> [(k, a)]) -> [(k, a)] -> Map k a -> [(k, a)]
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
foldrWithKey (\k
k a
x [(k, a)]
xs -> (k
k,a
x)(k, a) -> [(k, a)] -> [(k, a)]
forall a. a -> [a] -> [a]
:[(k, a)]
xs) []

-- | \(O(n)\). Convert the map to a list of key\/value pairs where the keys
-- are in descending order. Subject to list fusion.
--
-- > toDescList (fromList [(5,"a"), (3,"b")]) == [(5,"a"), (3,"b")]

toDescList :: Map k a -> [(k,a)]
toDescList :: Map k a -> [(k, a)]
toDescList = ([(k, a)] -> k -> a -> [(k, a)]) -> [(k, a)] -> Map k a -> [(k, a)]
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
foldlWithKey (\[(k, a)]
xs k
k a
x -> (k
k,a
x)(k, a) -> [(k, a)] -> [(k, a)]
forall a. a -> [a] -> [a]
:[(k, a)]
xs) []

-- List fusion for the list generating functions.
#if __GLASGOW_HASKELL__
-- The foldrFB and foldlFB are fold{r,l}WithKey equivalents, used for list fusion.
-- They are important to convert unfused methods back, see mapFB in prelude.
foldrFB :: (k -> a -> b -> b) -> b -> Map k a -> b
foldrFB :: (k -> a -> b -> b) -> b -> Map k a -> b
foldrFB = (k -> a -> b -> b) -> b -> Map k a -> b
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
foldrWithKey
{-# INLINE[0] foldrFB #-}
foldlFB :: (a -> k -> b -> a) -> a -> Map k b -> a
foldlFB :: (a -> k -> b -> a) -> a -> Map k b -> a
foldlFB = (a -> k -> b -> a) -> a -> Map k b -> a
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
foldlWithKey
{-# INLINE[0] foldlFB #-}

-- Inline assocs and toList, so that we need to fuse only toAscList.
{-# INLINE assocs #-}
{-# INLINE toList #-}

-- The fusion is enabled up to phase 2 included. If it does not succeed,
-- convert in phase 1 the expanded elems,keys,to{Asc,Desc}List calls back to
-- elems,keys,to{Asc,Desc}List.  In phase 0, we inline fold{lr}FB (which were
-- used in a list fusion, otherwise it would go away in phase 1), and let compiler
-- do whatever it wants with elems,keys,to{Asc,Desc}List -- it was forbidden to
-- inline it before phase 0, otherwise the fusion rules would not fire at all.
{-# NOINLINE[0] elems #-}
{-# NOINLINE[0] keys #-}
{-# NOINLINE[0] toAscList #-}
{-# NOINLINE[0] toDescList #-}
{-# RULES "Map.elems" [~1] forall m . elems m = build (\c n -> foldrFB (\_ x xs -> c x xs) n m) #-}
{-# RULES "Map.elemsBack" [1] foldrFB (\_ x xs -> x : xs) [] = elems #-}
{-# RULES "Map.keys" [~1] forall m . keys m = build (\c n -> foldrFB (\k _ xs -> c k xs) n m) #-}
{-# RULES "Map.keysBack" [1] foldrFB (\k _ xs -> k : xs) [] = keys #-}
{-# RULES "Map.toAscList" [~1] forall m . toAscList m = build (\c n -> foldrFB (\k x xs -> c (k,x) xs) n m) #-}
{-# RULES "Map.toAscListBack" [1] foldrFB (\k x xs -> (k, x) : xs) [] = toAscList #-}
{-# RULES "Map.toDescList" [~1] forall m . toDescList m = build (\c n -> foldlFB (\xs k x -> c (k,x) xs) n m) #-}
{-# RULES "Map.toDescListBack" [1] foldlFB (\xs k x -> (k, x) : xs) [] = toDescList #-}
#endif

{--------------------------------------------------------------------
  Building trees from ascending/descending lists can be done in linear time.

  Note that if [xs] is ascending that:
    fromAscList xs       == fromList xs
    fromAscListWith f xs == fromListWith f xs
--------------------------------------------------------------------}
-- | \(O(n)\). Build a map from an ascending list in linear time.
-- /The precondition (input list is ascending) is not checked./
--
-- > fromAscList [(3,"b"), (5,"a")]          == fromList [(3, "b"), (5, "a")]
-- > fromAscList [(3,"b"), (5,"a"), (5,"b")] == fromList [(3, "b"), (5, "b")]
-- > valid (fromAscList [(3,"b"), (5,"a"), (5,"b")]) == True
-- > valid (fromAscList [(5,"a"), (3,"b"), (5,"b")]) == False

fromAscList :: Eq k => [(k,a)] -> Map k a
fromAscList :: [(k, a)] -> Map k a
fromAscList [(k, a)]
xs
  = [(k, a)] -> Map k a
forall k a. [(k, a)] -> Map k a
fromDistinctAscList ([(k, a)] -> [(k, a)]
forall a b. Eq a => [(a, b)] -> [(a, b)]
combineEq [(k, a)]
xs)
  where
  -- [combineEq f xs] combines equal elements with function [f] in an ordered list [xs]
  combineEq :: [(a, b)] -> [(a, b)]
combineEq [(a, b)]
xs'
    = case [(a, b)]
xs' of
        []     -> []
        [(a, b)
x]    -> [(a, b)
x]
        ((a, b)
x:[(a, b)]
xx) -> (a, b) -> [(a, b)] -> [(a, b)]
forall a b. Eq a => (a, b) -> [(a, b)] -> [(a, b)]
combineEq' (a, b)
x [(a, b)]
xx

  combineEq' :: (a, b) -> [(a, b)] -> [(a, b)]
combineEq' (a, b)
z [] = [(a, b)
z]
  combineEq' z :: (a, b)
z@(a
kz,b
_) (x :: (a, b)
x@(a
kx,b
xx):[(a, b)]
xs')
    | a
kxa -> a -> Bool
forall a. Eq a => a -> a -> Bool
==a
kz    = (a, b) -> [(a, b)] -> [(a, b)]
combineEq' (a
kx,b
xx) [(a, b)]
xs'
    | Bool
otherwise = (a, b)
z(a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
:(a, b) -> [(a, b)] -> [(a, b)]
combineEq' (a, b)
x [(a, b)]
xs'
#if __GLASGOW_HASKELL__
{-# INLINABLE fromAscList #-}
#endif

-- | \(O(n)\). Build a map from a descending list in linear time.
-- /The precondition (input list is descending) is not checked./
--
-- > fromDescList [(5,"a"), (3,"b")]          == fromList [(3, "b"), (5, "a")]
-- > fromDescList [(5,"a"), (5,"b"), (3,"b")] == fromList [(3, "b"), (5, "b")]
-- > valid (fromDescList [(5,"a"), (5,"b"), (3,"b")]) == True
-- > valid (fromDescList [(5,"a"), (3,"b"), (5,"b")]) == False
--
-- @since 0.5.8

fromDescList :: Eq k => [(k,a)] -> Map k a
fromDescList :: [(k, a)] -> Map k a
fromDescList [(k, a)]
xs = [(k, a)] -> Map k a
forall k a. [(k, a)] -> Map k a
fromDistinctDescList ([(k, a)] -> [(k, a)]
forall a b. Eq a => [(a, b)] -> [(a, b)]
combineEq [(k, a)]
xs)
  where
  -- [combineEq f xs] combines equal elements with function [f] in an ordered list [xs]
  combineEq :: [(a, b)] -> [(a, b)]
combineEq [(a, b)]
xs'
    = case [(a, b)]
xs' of
        []     -> []
        [(a, b)
x]    -> [(a, b)
x]
        ((a, b)
x:[(a, b)]
xx) -> (a, b) -> [(a, b)] -> [(a, b)]
forall a b. Eq a => (a, b) -> [(a, b)] -> [(a, b)]
combineEq' (a, b)
x [(a, b)]
xx

  combineEq' :: (a, b) -> [(a, b)] -> [(a, b)]
combineEq' (a, b)
z [] = [(a, b)
z]
  combineEq' z :: (a, b)
z@(a
kz,b
_) (x :: (a, b)
x@(a
kx,b
xx):[(a, b)]
xs')
    | a
kxa -> a -> Bool
forall a. Eq a => a -> a -> Bool
==a
kz    = (a, b) -> [(a, b)] -> [(a, b)]
combineEq' (a
kx,b
xx) [(a, b)]
xs'
    | Bool
otherwise = (a, b)
z(a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
:(a, b) -> [(a, b)] -> [(a, b)]
combineEq' (a, b)
x [(a, b)]
xs'
#if __GLASGOW_HASKELL__
{-# INLINABLE fromDescList #-}
#endif

-- | \(O(n)\). Build a map from an ascending list in linear time with a combining function for equal keys.
-- /The precondition (input list is ascending) is not checked./
--
-- > fromAscListWith (++) [(3,"b"), (5,"a"), (5,"b")] == fromList [(3, "b"), (5, "ba")]
-- > valid (fromAscListWith (++) [(3,"b"), (5,"a"), (5,"b")]) == True
-- > valid (fromAscListWith (++) [(5,"a"), (3,"b"), (5,"b")]) == False

fromAscListWith :: Eq k => (a -> a -> a) -> [(k,a)] -> Map k a
fromAscListWith :: (a -> a -> a) -> [(k, a)] -> Map k a
fromAscListWith a -> a -> a
f [(k, a)]
xs
  = (k -> a -> a -> a) -> [(k, a)] -> Map k a
forall k a. Eq k => (k -> a -> a -> a) -> [(k, a)] -> Map k a
fromAscListWithKey (\k
_ a
x a
y -> a -> a -> a
f a
x a
y) [(k, a)]
xs
#if __GLASGOW_HASKELL__
{-# INLINABLE fromAscListWith #-}
#endif

-- | \(O(n)\). Build a map from a descending list in linear time with a combining function for equal keys.
-- /The precondition (input list is descending) is not checked./
--
-- > fromDescListWith (++) [(5,"a"), (5,"b"), (3,"b")] == fromList [(3, "b"), (5, "ba")]
-- > valid (fromDescListWith (++) [(5,"a"), (5,"b"), (3,"b")]) == True
-- > valid (fromDescListWith (++) [(5,"a"), (3,"b"), (5,"b")]) == False
--
-- @since 0.5.8

fromDescListWith :: Eq k => (a -> a -> a) -> [(k,a)] -> Map k a
fromDescListWith :: (a -> a -> a) -> [(k, a)] -> Map k a
fromDescListWith a -> a -> a
f [(k, a)]
xs
  = (k -> a -> a -> a) -> [(k, a)] -> Map k a
forall k a. Eq k => (k -> a -> a -> a) -> [(k, a)] -> Map k a
fromDescListWithKey (\k
_ a
x a
y -> a -> a -> a
f a
x a
y) [(k, a)]
xs
#if __GLASGOW_HASKELL__
{-# INLINABLE fromDescListWith #-}
#endif

-- | \(O(n)\). Build a map from an ascending list in linear time with a
-- combining function for equal keys.
-- /The precondition (input list is ascending) is not checked./
--
-- > let f k a1 a2 = (show k) ++ ":" ++ a1 ++ a2
-- > fromAscListWithKey f [(3,"b"), (5,"a"), (5,"b"), (5,"b")] == fromList [(3, "b"), (5, "5:b5:ba")]
-- > valid (fromAscListWithKey f [(3,"b"), (5,"a"), (5,"b"), (5,"b")]) == True
-- > valid (fromAscListWithKey f [(5,"a"), (3,"b"), (5,"b"), (5,"b")]) == False

fromAscListWithKey :: Eq k => (k -> a -> a -> a) -> [(k,a)] -> Map k a
fromAscListWithKey :: (k -> a -> a -> a) -> [(k, a)] -> Map k a
fromAscListWithKey k -> a -> a -> a
f [(k, a)]
xs
  = [(k, a)] -> Map k a
forall k a. [(k, a)] -> Map k a
fromDistinctAscList ((k -> a -> a -> a) -> [(k, a)] -> [(k, a)]
combineEq k -> a -> a -> a
f [(k, a)]
xs)
  where
  -- [combineEq f xs] combines equal elements with function [f] in an ordered list [xs]
  combineEq :: (k -> a -> a -> a) -> [(k, a)] -> [(k, a)]
combineEq k -> a -> a -> a
_ [(k, a)]
xs'
    = case [(k, a)]
xs' of
        []     -> []
        [(k, a)
x]    -> [(k, a)
x]
        ((k, a)
x:[(k, a)]
xx) -> (k, a) -> [(k, a)] -> [(k, a)]
combineEq' (k, a)
x [(k, a)]
xx

  combineEq' :: (k, a) -> [(k, a)] -> [(k, a)]
combineEq' (k, a)
z [] = [(k, a)
z]
  combineEq' z :: (k, a)
z@(k
kz,a
zz) (x :: (k, a)
x@(k
kx,a
xx):[(k, a)]
xs')
    | k
kxk -> k -> Bool
forall a. Eq a => a -> a -> Bool
==k
kz    = let yy :: a
yy = k -> a -> a -> a
f k
kx a
xx a
zz in (k, a) -> [(k, a)] -> [(k, a)]
combineEq' (k
kx,a
yy) [(k, a)]
xs'
    | Bool
otherwise = (k, a)
z(k, a) -> [(k, a)] -> [(k, a)]
forall a. a -> [a] -> [a]
:(k, a) -> [(k, a)] -> [(k, a)]
combineEq' (k, a)
x [(k, a)]
xs'
#if __GLASGOW_HASKELL__
{-# INLINABLE fromAscListWithKey #-}
#endif

-- | \(O(n)\). Build a map from a descending list in linear time with a
-- combining function for equal keys.
-- /The precondition (input list is descending) is not checked./
--
-- > let f k a1 a2 = (show k) ++ ":" ++ a1 ++ a2
-- > fromDescListWithKey f [(5,"a"), (5,"b"), (5,"b"), (3,"b")] == fromList [(3, "b"), (5, "5:b5:ba")]
-- > valid (fromDescListWithKey f [(5,"a"), (5,"b"), (5,"b"), (3,"b")]) == True
-- > valid (fromDescListWithKey f [(5,"a"), (3,"b"), (5,"b"), (5,"b")]) == False
fromDescListWithKey :: Eq k => (k -> a -> a -> a) -> [(k,a)] -> Map k a
fromDescListWithKey :: (k -> a -> a -> a) -> [(k, a)] -> Map k a
fromDescListWithKey k -> a -> a -> a
f [(k, a)]
xs
  = [(k, a)] -> Map k a
forall k a. [(k, a)] -> Map k a
fromDistinctDescList ((k -> a -> a -> a) -> [(k, a)] -> [(k, a)]
combineEq k -> a -> a -> a
f [(k, a)]
xs)
  where
  -- [combineEq f xs] combines equal elements with function [f] in an ordered list [xs]
  combineEq :: (k -> a -> a -> a) -> [(k, a)] -> [(k, a)]
combineEq k -> a -> a -> a
_ [(k, a)]
xs'
    = case [(k, a)]
xs' of
        []     -> []
        [(k, a)
x]    -> [(k, a)
x]
        ((k, a)
x:[(k, a)]
xx) -> (k, a) -> [(k, a)] -> [(k, a)]
combineEq' (k, a)
x [(k, a)]
xx

  combineEq' :: (k, a) -> [(k, a)] -> [(k, a)]
combineEq' (k, a)
z [] = [(k, a)
z]
  combineEq' z :: (k, a)
z@(k
kz,a
zz) (x :: (k, a)
x@(k
kx,a
xx):[(k, a)]
xs')
    | k
kxk -> k -> Bool
forall a. Eq a => a -> a -> Bool
==k
kz    = let yy :: a
yy = k -> a -> a -> a
f k
kx a
xx a
zz in (k, a) -> [(k, a)] -> [(k, a)]
combineEq' (k
kx,a
yy) [(k, a)]
xs'
    | Bool
otherwise = (k, a)
z(k, a) -> [(k, a)] -> [(k, a)]
forall a. a -> [a] -> [a]
:(k, a) -> [(k, a)] -> [(k, a)]
combineEq' (k, a)
x [(k, a)]
xs'
#if __GLASGOW_HASKELL__
{-# INLINABLE fromDescListWithKey #-}
#endif


-- | \(O(n)\). Build a map from an ascending list of distinct elements in linear time.
-- /The precondition is not checked./
--
-- > fromDistinctAscList [(3,"b"), (5,"a")] == fromList [(3, "b"), (5, "a")]
-- > valid (fromDistinctAscList [(3,"b"), (5,"a")])          == True
-- > valid (fromDistinctAscList [(3,"b"), (5,"a"), (5,"b")]) == False

-- For some reason, when 'singleton' is used in fromDistinctAscList or in
-- create, it is not inlined, so we inline it manually.
fromDistinctAscList :: [(k,a)] -> Map k a
fromDistinctAscList :: [(k, a)] -> Map k a
fromDistinctAscList [] = Map k a
forall k a. Map k a
Tip
fromDistinctAscList ((k
kx0, a
x0) : [(k, a)]
xs0) = Int -> Map k a -> [(k, a)] -> Map k a
forall t k a.
(Num t, Bits t) =>
t -> Map k a -> [(k, a)] -> Map k a
go (Int
1::Int) (Int -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin Int
1 k
kx0 a
x0 Map k a
forall k a. Map k a
Tip Map k a
forall k a. Map k a
Tip) [(k, a)]
xs0
  where
    go :: t -> Map k a -> [(k, a)] -> Map k a
go !t
_ Map k a
t [] = Map k a
t
    go t
s Map k a
l ((k
kx, a
x) : [(k, a)]
xs) = case t -> [(k, a)] -> StrictPair (Map k a) [(k, a)]
forall a k a.
(Num a, Bits a) =>
a -> [(k, a)] -> StrictPair (Map k a) [(k, a)]
create t
s [(k, a)]
xs of
                                (Map k a
r :*: [(k, a)]
ys) -> let !t' :: Map k a
t' = k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
link k
kx a
x Map k a
l Map k a
r
                                              in t -> Map k a -> [(k, a)] -> Map k a
go (t
s t -> Int -> t
forall a. Bits a => a -> Int -> a
`shiftL` Int
1) Map k a
t' [(k, a)]
ys

    create :: a -> [(k, a)] -> StrictPair (Map k a) [(k, a)]
create !a
_ [] = (Map k a
forall k a. Map k a
Tip Map k a -> [(k, a)] -> StrictPair (Map k a) [(k, a)]
forall a b. a -> b -> StrictPair a b
:*: [])
    create a
s xs :: [(k, a)]
xs@((k, a)
x' : [(k, a)]
xs')
      | a
s a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
1 = case (k, a)
x' of (k
kx, a
x) -> (Int -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin Int
1 k
kx a
x Map k a
forall k a. Map k a
Tip Map k a
forall k a. Map k a
Tip Map k a -> [(k, a)] -> StrictPair (Map k a) [(k, a)]
forall a b. a -> b -> StrictPair a b
:*: [(k, a)]
xs')
      | Bool
otherwise = case a -> [(k, a)] -> StrictPair (Map k a) [(k, a)]
create (a
s a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftR` Int
1) [(k, a)]
xs of
                      res :: StrictPair (Map k a) [(k, a)]
res@(Map k a
_ :*: []) -> StrictPair (Map k a) [(k, a)]
res
                      (Map k a
l :*: (k
ky, a
y):[(k, a)]
ys) -> case a -> [(k, a)] -> StrictPair (Map k a) [(k, a)]
create (a
s a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftR` Int
1) [(k, a)]
ys of
                        (Map k a
r :*: [(k, a)]
zs) -> (k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
link k
ky a
y Map k a
l Map k a
r Map k a -> [(k, a)] -> StrictPair (Map k a) [(k, a)]
forall a b. a -> b -> StrictPair a b
:*: [(k, a)]
zs)

-- | \(O(n)\). Build a map from a descending list of distinct elements in linear time.
-- /The precondition is not checked./
--
-- > fromDistinctDescList [(5,"a"), (3,"b")] == fromList [(3, "b"), (5, "a")]
-- > valid (fromDistinctDescList [(5,"a"), (3,"b")])          == True
-- > valid (fromDistinctDescList [(5,"a"), (5,"b"), (3,"b")]) == False
--
-- @since 0.5.8

-- For some reason, when 'singleton' is used in fromDistinctDescList or in
-- create, it is not inlined, so we inline it manually.
fromDistinctDescList :: [(k,a)] -> Map k a
fromDistinctDescList :: [(k, a)] -> Map k a
fromDistinctDescList [] = Map k a
forall k a. Map k a
Tip
fromDistinctDescList ((k
kx0, a
x0) : [(k, a)]
xs0) = Int -> Map k a -> [(k, a)] -> Map k a
forall t k a.
(Num t, Bits t) =>
t -> Map k a -> [(k, a)] -> Map k a
go (Int
1 :: Int) (Int -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin Int
1 k
kx0 a
x0 Map k a
forall k a. Map k a
Tip Map k a
forall k a. Map k a
Tip) [(k, a)]
xs0
  where
     go :: t -> Map k a -> [(k, a)] -> Map k a
go !t
_ Map k a
t [] = Map k a
t
     go t
s Map k a
r ((k
kx, a
x) : [(k, a)]
xs) = case t -> [(k, a)] -> StrictPair (Map k a) [(k, a)]
forall a k a.
(Num a, Bits a) =>
a -> [(k, a)] -> StrictPair (Map k a) [(k, a)]
create t
s [(k, a)]
xs of
                               (Map k a
l :*: [(k, a)]
ys) -> let !t' :: Map k a
t' = k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
link k
kx a
x Map k a
l Map k a
r
                                             in t -> Map k a -> [(k, a)] -> Map k a
go (t
s t -> Int -> t
forall a. Bits a => a -> Int -> a
`shiftL` Int
1) Map k a
t' [(k, a)]
ys

     create :: a -> [(k, a)] -> StrictPair (Map k a) [(k, a)]
create !a
_ [] = (Map k a
forall k a. Map k a
Tip Map k a -> [(k, a)] -> StrictPair (Map k a) [(k, a)]
forall a b. a -> b -> StrictPair a b
:*: [])
     create a
s xs :: [(k, a)]
xs@((k, a)
x' : [(k, a)]
xs')
       | a
s a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
1 = case (k, a)
x' of (k
kx, a
x) -> (Int -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin Int
1 k
kx a
x Map k a
forall k a. Map k a
Tip Map k a
forall k a. Map k a
Tip Map k a -> [(k, a)] -> StrictPair (Map k a) [(k, a)]
forall a b. a -> b -> StrictPair a b
:*: [(k, a)]
xs')
       | Bool
otherwise = case a -> [(k, a)] -> StrictPair (Map k a) [(k, a)]
create (a
s a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftR` Int
1) [(k, a)]
xs of
                       res :: StrictPair (Map k a) [(k, a)]
res@(Map k a
_ :*: []) -> StrictPair (Map k a) [(k, a)]
res
                       (Map k a
r :*: (k
ky, a
y):[(k, a)]
ys) -> case a -> [(k, a)] -> StrictPair (Map k a) [(k, a)]
create (a
s a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftR` Int
1) [(k, a)]
ys of
                         (Map k a
l :*: [(k, a)]
zs) -> (k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
link k
ky a
y Map k a
l Map k a
r Map k a -> [(k, a)] -> StrictPair (Map k a) [(k, a)]
forall a b. a -> b -> StrictPair a b
:*: [(k, a)]
zs)

{-
-- Functions very similar to these were used to implement
-- hedge union, intersection, and difference algorithms that we no
-- longer use. These functions, however, seem likely to be useful
-- in their own right, so I'm leaving them here in case we end up
-- exporting them.

{--------------------------------------------------------------------
  [filterGt b t] filter all keys >[b] from tree [t]
  [filterLt b t] filter all keys <[b] from tree [t]
--------------------------------------------------------------------}
filterGt :: Ord k => k -> Map k v -> Map k v
filterGt !_ Tip = Tip
filterGt !b (Bin _ kx x l r) =
  case compare b kx of LT -> link kx x (filterGt b l) r
                       EQ -> r
                       GT -> filterGt b r
#if __GLASGOW_HASKELL__
{-# INLINABLE filterGt #-}
#endif

filterLt :: Ord k => k -> Map k v -> Map k v
filterLt !_ Tip = Tip
filterLt !b (Bin _ kx x l r) =
  case compare kx b of LT -> link kx x l (filterLt b r)
                       EQ -> l
                       GT -> filterLt b l
#if __GLASGOW_HASKELL__
{-# INLINABLE filterLt #-}
#endif
-}

{--------------------------------------------------------------------
  Split
--------------------------------------------------------------------}
-- | \(O(\log n)\). The expression (@'split' k map@) is a pair @(map1,map2)@ where
-- the keys in @map1@ are smaller than @k@ and the keys in @map2@ larger than @k@.
-- Any key equal to @k@ is found in neither @map1@ nor @map2@.
--
-- > split 2 (fromList [(5,"a"), (3,"b")]) == (empty, fromList [(3,"b"), (5,"a")])
-- > split 3 (fromList [(5,"a"), (3,"b")]) == (empty, singleton 5 "a")
-- > split 4 (fromList [(5,"a"), (3,"b")]) == (singleton 3 "b", singleton 5 "a")
-- > split 5 (fromList [(5,"a"), (3,"b")]) == (singleton 3 "b", empty)
-- > split 6 (fromList [(5,"a"), (3,"b")]) == (fromList [(3,"b"), (5,"a")], empty)

split :: Ord k => k -> Map k a -> (Map k a,Map k a)
split :: k -> Map k a -> (Map k a, Map k a)
split !k
k0 Map k a
t0 = StrictPair (Map k a) (Map k a) -> (Map k a, Map k a)
forall a b. StrictPair a b -> (a, b)
toPair (StrictPair (Map k a) (Map k a) -> (Map k a, Map k a))
-> StrictPair (Map k a) (Map k a) -> (Map k a, Map k a)
forall a b. (a -> b) -> a -> b
$ k -> Map k a -> StrictPair (Map k a) (Map k a)
forall k a. Ord k => k -> Map k a -> StrictPair (Map k a) (Map k a)
go k
k0 Map k a
t0
  where
    go :: k -> Map k a -> StrictPair (Map k a) (Map k a)
go k
k Map k a
t =
      case Map k a
t of
        Map k a
Tip            -> Map k a
forall k a. Map k a
Tip Map k a -> Map k a -> StrictPair (Map k a) (Map k a)
forall a b. a -> b -> StrictPair a b
:*: Map k a
forall k a. Map k a
Tip
        Bin Int
_ k
kx a
x Map k a
l Map k a
r -> case k -> k -> Ordering
forall a. Ord a => a -> a -> Ordering
compare k
k k
kx of
          Ordering
LT -> let (Map k a
lt :*: Map k a
gt) = k -> Map k a -> StrictPair (Map k a) (Map k a)
go k
k Map k a
l in Map k a
lt Map k a -> Map k a -> StrictPair (Map k a) (Map k a)
forall a b. a -> b -> StrictPair a b
:*: k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
link k
kx a
x Map k a
gt Map k a
r
          Ordering
GT -> let (Map k a
lt :*: Map k a
gt) = k -> Map k a -> StrictPair (Map k a) (Map k a)
go k
k Map k a
r in k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
link k
kx a
x Map k a
l Map k a
lt Map k a -> Map k a -> StrictPair (Map k a) (Map k a)
forall a b. a -> b -> StrictPair a b
:*: Map k a
gt
          Ordering
EQ -> (Map k a
l Map k a -> Map k a -> StrictPair (Map k a) (Map k a)
forall a b. a -> b -> StrictPair a b
:*: Map k a
r)
#if __GLASGOW_HASKELL__
{-# INLINABLE split #-}
#endif

-- | \(O(\log n)\). The expression (@'splitLookup' k map@) splits a map just
-- like 'split' but also returns @'lookup' k map@.
--
-- > splitLookup 2 (fromList [(5,"a"), (3,"b")]) == (empty, Nothing, fromList [(3,"b"), (5,"a")])
-- > splitLookup 3 (fromList [(5,"a"), (3,"b")]) == (empty, Just "b", singleton 5 "a")
-- > splitLookup 4 (fromList [(5,"a"), (3,"b")]) == (singleton 3 "b", Nothing, singleton 5 "a")
-- > splitLookup 5 (fromList [(5,"a"), (3,"b")]) == (singleton 3 "b", Just "a", empty)
-- > splitLookup 6 (fromList [(5,"a"), (3,"b")]) == (fromList [(3,"b"), (5,"a")], Nothing, empty)
splitLookup :: Ord k => k -> Map k a -> (Map k a,Maybe a,Map k a)
splitLookup :: k -> Map k a -> (Map k a, Maybe a, Map k a)
splitLookup k
k0 Map k a
m = case k -> Map k a -> StrictTriple (Map k a) (Maybe a) (Map k a)
forall k a.
Ord k =>
k -> Map k a -> StrictTriple (Map k a) (Maybe a) (Map k a)
go k
k0 Map k a
m of
     StrictTriple Map k a
l Maybe a
mv Map k a
r -> (Map k a
l, Maybe a
mv, Map k a
r)
  where
    go :: Ord k => k -> Map k a -> StrictTriple (Map k a) (Maybe a) (Map k a)
    go :: k -> Map k a -> StrictTriple (Map k a) (Maybe a) (Map k a)
go !k
k Map k a
t =
      case Map k a
t of
        Map k a
Tip            -> Map k a
-> Maybe a -> Map k a -> StrictTriple (Map k a) (Maybe a) (Map k a)
forall a b c. a -> b -> c -> StrictTriple a b c
StrictTriple Map k a
forall k a. Map k a
Tip Maybe a
forall a. Maybe a
Nothing Map k a
forall k a. Map k a
Tip
        Bin Int
_ k
kx a
x Map k a
l Map k a
r -> case k -> k -> Ordering
forall a. Ord a => a -> a -> Ordering
compare k
k k
kx of
          Ordering
LT -> let StrictTriple Map k a
lt Maybe a
z Map k a
gt = k -> Map k a -> StrictTriple (Map k a) (Maybe a) (Map k a)
forall k a.
Ord k =>
k -> Map k a -> StrictTriple (Map k a) (Maybe a) (Map k a)
go k
k Map k a
l
                    !gt' :: Map k a
gt' = k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
link k
kx a
x Map k a
gt Map k a
r
                in Map k a
-> Maybe a -> Map k a -> StrictTriple (Map k a) (Maybe a) (Map k a)
forall a b c. a -> b -> c -> StrictTriple a b c
StrictTriple Map k a
lt Maybe a
z Map k a
gt'
          Ordering
GT -> let StrictTriple Map k a
lt Maybe a
z Map k a
gt = k -> Map k a -> StrictTriple (Map k a) (Maybe a) (Map k a)
forall k a.
Ord k =>
k -> Map k a -> StrictTriple (Map k a) (Maybe a) (Map k a)
go k
k Map k a
r
                    !lt' :: Map k a
lt' = k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
link k
kx a
x Map k a
l Map k a
lt
                in Map k a
-> Maybe a -> Map k a -> StrictTriple (Map k a) (Maybe a) (Map k a)
forall a b c. a -> b -> c -> StrictTriple a b c
StrictTriple Map k a
lt' Maybe a
z Map k a
gt
          Ordering
EQ -> Map k a
-> Maybe a -> Map k a -> StrictTriple (Map k a) (Maybe a) (Map k a)
forall a b c. a -> b -> c -> StrictTriple a b c
StrictTriple Map k a
l (a -> Maybe a
forall a. a -> Maybe a
Just a
x) Map k a
r
#if __GLASGOW_HASKELL__
{-# INLINABLE splitLookup #-}
#endif

-- | A variant of 'splitLookup' that indicates only whether the
-- key was present, rather than producing its value. This is used to
-- implement 'intersection' to avoid allocating unnecessary 'Just'
-- constructors.
splitMember :: Ord k => k -> Map k a -> (Map k a,Bool,Map k a)
splitMember :: k -> Map k a -> (Map k a, Bool, Map k a)
splitMember k
k0 Map k a
m = case k -> Map k a -> StrictTriple (Map k a) Bool (Map k a)
forall k a.
Ord k =>
k -> Map k a -> StrictTriple (Map k a) Bool (Map k a)
go k
k0 Map k a
m of
     StrictTriple Map k a
l Bool
mv Map k a
r -> (Map k a
l, Bool
mv, Map k a
r)
  where
    go :: Ord k => k -> Map k a -> StrictTriple (Map k a) Bool (Map k a)
    go :: k -> Map k a -> StrictTriple (Map k a) Bool (Map k a)
go !k
k Map k a
t =
      case Map k a
t of
        Map k a
Tip            -> Map k a -> Bool -> Map k a -> StrictTriple (Map k a) Bool (Map k a)
forall a b c. a -> b -> c -> StrictTriple a b c
StrictTriple Map k a
forall k a. Map k a
Tip Bool
False Map k a
forall k a. Map k a
Tip
        Bin Int
_ k
kx a
x Map k a
l Map k a
r -> case k -> k -> Ordering
forall a. Ord a => a -> a -> Ordering
compare k
k k
kx of
          Ordering
LT -> let StrictTriple Map k a
lt Bool
z Map k a
gt = k -> Map k a -> StrictTriple (Map k a) Bool (Map k a)
forall k a.
Ord k =>
k -> Map k a -> StrictTriple (Map k a) Bool (Map k a)
go k
k Map k a
l
                    !gt' :: Map k a
gt' = k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
link k
kx a
x Map k a
gt Map k a
r
                in Map k a -> Bool -> Map k a -> StrictTriple (Map k a) Bool (Map k a)
forall a b c. a -> b -> c -> StrictTriple a b c
StrictTriple Map k a
lt Bool
z Map k a
gt'
          Ordering
GT -> let StrictTriple Map k a
lt Bool
z Map k a
gt = k -> Map k a -> StrictTriple (Map k a) Bool (Map k a)
forall k a.
Ord k =>
k -> Map k a -> StrictTriple (Map k a) Bool (Map k a)
go k
k Map k a
r
                    !lt' :: Map k a
lt' = k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
link k
kx a
x Map k a
l Map k a
lt
                in Map k a -> Bool -> Map k a -> StrictTriple (Map k a) Bool (Map k a)
forall a b c. a -> b -> c -> StrictTriple a b c
StrictTriple Map k a
lt' Bool
z Map k a
gt
          Ordering
EQ -> Map k a -> Bool -> Map k a -> StrictTriple (Map k a) Bool (Map k a)
forall a b c. a -> b -> c -> StrictTriple a b c
StrictTriple Map k a
l Bool
True Map k a
r
#if __GLASGOW_HASKELL__
{-# INLINABLE splitMember #-}
#endif

data StrictTriple a b c = StrictTriple !a !b !c

{--------------------------------------------------------------------
  Utility functions that maintain the balance properties of the tree.
  All constructors assume that all values in [l] < [k] and all values
  in [r] > [k], and that [l] and [r] are valid trees.

  In order of sophistication:
    [Bin sz k x l r]  The type constructor.
    [bin k x l r]     Maintains the correct size, assumes that both [l]
                      and [r] are balanced with respect to each other.
    [balance k x l r] Restores the balance and size.
                      Assumes that the original tree was balanced and
                      that [l] or [r] has changed by at most one element.
    [link k x l r]    Restores balance and size.

  Furthermore, we can construct a new tree from two trees. Both operations
  assume that all values in [l] < all values in [r] and that [l] and [r]
  are valid:
    [glue l r]        Glues [l] and [r] together. Assumes that [l] and
                      [r] are already balanced with respect to each other.
    [link2 l r]       Merges two trees and restores balance.
--------------------------------------------------------------------}

{--------------------------------------------------------------------
  Link
--------------------------------------------------------------------}
link :: k -> a -> Map k a -> Map k a -> Map k a
link :: k -> a -> Map k a -> Map k a -> Map k a
link k
kx a
x Map k a
Tip Map k a
r  = k -> a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a
insertMin k
kx a
x Map k a
r
link k
kx a
x Map k a
l Map k a
Tip  = k -> a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a
insertMax k
kx a
x Map k a
l
link k
kx a
x l :: Map k a
l@(Bin Int
sizeL k
ky a
y Map k a
ly Map k a
ry) r :: Map k a
r@(Bin Int
sizeR k
kz a
z Map k a
lz Map k a
rz)
  | Int
deltaInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
sizeL Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sizeR  = k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceL k
kz a
z (k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
link k
kx a
x Map k a
l Map k a
lz) Map k a
rz
  | Int
deltaInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
sizeR Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sizeL  = k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceR k
ky a
y Map k a
ly (k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
link k
kx a
x Map k a
ry Map k a
r)
  | Bool
otherwise            = k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
bin k
kx a
x Map k a
l Map k a
r


-- insertMin and insertMax don't perform potentially expensive comparisons.
insertMax,insertMin :: k -> a -> Map k a -> Map k a
insertMax :: k -> a -> Map k a -> Map k a
insertMax k
kx a
x Map k a
t
  = case Map k a
t of
      Map k a
Tip -> k -> a -> Map k a
forall k a. k -> a -> Map k a
singleton k
kx a
x
      Bin Int
_ k
ky a
y Map k a
l Map k a
r
          -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceR k
ky a
y Map k a
l (k -> a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a
insertMax k
kx a
x Map k a
r)

insertMin :: k -> a -> Map k a -> Map k a
insertMin k
kx a
x Map k a
t
  = case Map k a
t of
      Map k a
Tip -> k -> a -> Map k a
forall k a. k -> a -> Map k a
singleton k
kx a
x
      Bin Int
_ k
ky a
y Map k a
l Map k a
r
          -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceL k
ky a
y (k -> a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a
insertMin k
kx a
x Map k a
l) Map k a
r

{--------------------------------------------------------------------
  [link2 l r]: merges two trees.
--------------------------------------------------------------------}
link2 :: Map k a -> Map k a -> Map k a
link2 :: Map k a -> Map k a -> Map k a
link2 Map k a
Tip Map k a
r   = Map k a
r
link2 Map k a
l Map k a
Tip   = Map k a
l
link2 l :: Map k a
l@(Bin Int
sizeL k
kx a
x Map k a
lx Map k a
rx) r :: Map k a
r@(Bin Int
sizeR k
ky a
y Map k a
ly Map k a
ry)
  | Int
deltaInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
sizeL Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sizeR = k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceL k
ky a
y (Map k a -> Map k a -> Map k a
forall k a. Map k a -> Map k a -> Map k a
link2 Map k a
l Map k a
ly) Map k a
ry
  | Int
deltaInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
sizeR Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sizeL = k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceR k
kx a
x Map k a
lx (Map k a -> Map k a -> Map k a
forall k a. Map k a -> Map k a -> Map k a
link2 Map k a
rx Map k a
r)
  | Bool
otherwise           = Map k a -> Map k a -> Map k a
forall k a. Map k a -> Map k a -> Map k a
glue Map k a
l Map k a
r

{--------------------------------------------------------------------
  [glue l r]: glues two trees together.
  Assumes that [l] and [r] are already balanced with respect to each other.
--------------------------------------------------------------------}
glue :: Map k a -> Map k a -> Map k a
glue :: Map k a -> Map k a -> Map k a
glue Map k a
Tip Map k a
r = Map k a
r
glue Map k a
l Map k a
Tip = Map k a
l
glue l :: Map k a
l@(Bin Int
sl k
kl a
xl Map k a
ll Map k a
lr) r :: Map k a
r@(Bin Int
sr k
kr a
xr Map k a
rl Map k a
rr)
  | Int
sl Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
sr = let !(MaxView k
km a
m Map k a
l') = k -> a -> Map k a -> Map k a -> MaxView k a
forall k a. k -> a -> Map k a -> Map k a -> MaxView k a
maxViewSure k
kl a
xl Map k a
ll Map k a
lr in k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceR k
km a
m Map k a
l' Map k a
r
  | Bool
otherwise = let !(MinView k
km a
m Map k a
r') = k -> a -> Map k a -> Map k a -> MinView k a
forall k a. k -> a -> Map k a -> Map k a -> MinView k a
minViewSure k
kr a
xr Map k a
rl Map k a
rr in k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceL k
km a
m Map k a
l Map k a
r'

data MinView k a = MinView !k a !(Map k a)
data MaxView k a = MaxView !k a !(Map k a)

minViewSure :: k -> a -> Map k a -> Map k a -> MinView k a
minViewSure :: k -> a -> Map k a -> Map k a -> MinView k a
minViewSure = k -> a -> Map k a -> Map k a -> MinView k a
forall k a. k -> a -> Map k a -> Map k a -> MinView k a
go
  where
    go :: t -> t -> Map t t -> Map t t -> MinView t t
go t
k t
x Map t t
Tip Map t t
r = t -> t -> Map t t -> MinView t t
forall k a. k -> a -> Map k a -> MinView k a
MinView t
k t
x Map t t
r
    go t
k t
x (Bin Int
_ t
kl t
xl Map t t
ll Map t t
lr) Map t t
r =
      case t -> t -> Map t t -> Map t t -> MinView t t
go t
kl t
xl Map t t
ll Map t t
lr of
        MinView t
km t
xm Map t t
l' -> t -> t -> Map t t -> MinView t t
forall k a. k -> a -> Map k a -> MinView k a
MinView t
km t
xm (t -> t -> Map t t -> Map t t -> Map t t
forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceR t
k t
x Map t t
l' Map t t
r)
{-# NOINLINE minViewSure #-}

maxViewSure :: k -> a -> Map k a -> Map k a -> MaxView k a
maxViewSure :: k -> a -> Map k a -> Map k a -> MaxView k a
maxViewSure = k -> a -> Map k a -> Map k a -> MaxView k a
forall k a. k -> a -> Map k a -> Map k a -> MaxView k a
go
  where
    go :: t -> t -> Map t t -> Map t t -> MaxView t t
go t
k t
x Map t t
l Map t t
Tip = t -> t -> Map t t -> MaxView t t
forall k a. k -> a -> Map k a -> MaxView k a
MaxView t
k t
x Map t t
l
    go t
k t
x Map t t
l (Bin Int
_ t
kr t
xr Map t t
rl Map t t
rr) =
      case t -> t -> Map t t -> Map t t -> MaxView t t
go t
kr t
xr Map t t
rl Map t t
rr of
        MaxView t
km t
xm Map t t
r' -> t -> t -> Map t t -> MaxView t t
forall k a. k -> a -> Map k a -> MaxView k a
MaxView t
km t
xm (t -> t -> Map t t -> Map t t -> Map t t
forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceL t
k t
x Map t t
l Map t t
r')
{-# NOINLINE maxViewSure #-}

-- | \(O(\log n)\). Delete and find the minimal element.
--
-- > deleteFindMin (fromList [(5,"a"), (3,"b"), (10,"c")]) == ((3,"b"), fromList[(5,"a"), (10,"c")])
-- > deleteFindMin empty                                      Error: can not return the minimal element of an empty map

deleteFindMin :: Map k a -> ((k,a),Map k a)
deleteFindMin :: Map k a -> ((k, a), Map k a)
deleteFindMin Map k a
t = case Map k a -> Maybe ((k, a), Map k a)
forall k a. Map k a -> Maybe ((k, a), Map k a)
minViewWithKey Map k a
t of
  Maybe ((k, a), Map k a)
Nothing -> ([Char] -> (k, a)
forall a. HasCallStack => [Char] -> a
error [Char]
"Map.deleteFindMin: can not return the minimal element of an empty map", Map k a
forall k a. Map k a
Tip)
  Just ((k, a), Map k a)
res -> ((k, a), Map k a)
res

-- | \(O(\log n)\). Delete and find the maximal element.
--
-- > deleteFindMax (fromList [(5,"a"), (3,"b"), (10,"c")]) == ((10,"c"), fromList [(3,"b"), (5,"a")])
-- > deleteFindMax empty                                      Error: can not return the maximal element of an empty map

deleteFindMax :: Map k a -> ((k,a),Map k a)
deleteFindMax :: Map k a -> ((k, a), Map k a)
deleteFindMax Map k a
t = case Map k a -> Maybe ((k, a), Map k a)
forall k a. Map k a -> Maybe ((k, a), Map k a)
maxViewWithKey Map k a
t of
  Maybe ((k, a), Map k a)
Nothing -> ([Char] -> (k, a)
forall a. HasCallStack => [Char] -> a
error [Char]
"Map.deleteFindMax: can not return the maximal element of an empty map", Map k a
forall k a. Map k a
Tip)
  Just ((k, a), Map k a)
res -> ((k, a), Map k a)
res

{--------------------------------------------------------------------
  [balance l x r] balances two trees with value x.
  The sizes of the trees should balance after decreasing the
  size of one of them. (a rotation).

  [delta] is the maximal relative difference between the sizes of
          two trees, it corresponds with the [w] in Adams' paper.
  [ratio] is the ratio between an outer and inner sibling of the
          heavier subtree in an unbalanced setting. It determines
          whether a double or single rotation should be performed
          to restore balance. It is corresponds with the inverse
          of $\alpha$ in Adam's article.

  Note that according to the Adam's paper:
  - [delta] should be larger than 4.646 with a [ratio] of 2.
  - [delta] should be larger than 3.745 with a [ratio] of 1.534.

  But the Adam's paper is erroneous:
  - It can be proved that for delta=2 and delta>=5 there does
    not exist any ratio that would work.
  - Delta=4.5 and ratio=2 does not work.

  That leaves two reasonable variants, delta=3 and delta=4,
  both with ratio=2.

  - A lower [delta] leads to a more 'perfectly' balanced tree.
  - A higher [delta] performs less rebalancing.

  In the benchmarks, delta=3 is faster on insert operations,
  and delta=4 has slightly better deletes. As the insert speedup
  is larger, we currently use delta=3.

--------------------------------------------------------------------}
delta,ratio :: Int
delta :: Int
delta = Int
3
ratio :: Int
ratio = Int
2

-- The balance function is equivalent to the following:
--
--   balance :: k -> a -> Map k a -> Map k a -> Map k a
--   balance k x l r
--     | sizeL + sizeR <= 1    = Bin sizeX k x l r
--     | sizeR > delta*sizeL   = rotateL k x l r
--     | sizeL > delta*sizeR   = rotateR k x l r
--     | otherwise             = Bin sizeX k x l r
--     where
--       sizeL = size l
--       sizeR = size r
--       sizeX = sizeL + sizeR + 1
--
--   rotateL :: a -> b -> Map a b -> Map a b -> Map a b
--   rotateL k x l r@(Bin _ _ _ ly ry) | size ly < ratio*size ry = singleL k x l r
--                                     | otherwise               = doubleL k x l r
--
--   rotateR :: a -> b -> Map a b -> Map a b -> Map a b
--   rotateR k x l@(Bin _ _ _ ly ry) r | size ry < ratio*size ly = singleR k x l r
--                                     | otherwise               = doubleR k x l r
--
--   singleL, singleR :: a -> b -> Map a b -> Map a b -> Map a b
--   singleL k1 x1 t1 (Bin _ k2 x2 t2 t3)  = bin k2 x2 (bin k1 x1 t1 t2) t3
--   singleR k1 x1 (Bin _ k2 x2 t1 t2) t3  = bin k2 x2 t1 (bin k1 x1 t2 t3)
--
--   doubleL, doubleR :: a -> b -> Map a b -> Map a b -> Map a b
--   doubleL k1 x1 t1 (Bin _ k2 x2 (Bin _ k3 x3 t2 t3) t4) = bin k3 x3 (bin k1 x1 t1 t2) (bin k2 x2 t3 t4)
--   doubleR k1 x1 (Bin _ k2 x2 t1 (Bin _ k3 x3 t2 t3)) t4 = bin k3 x3 (bin k2 x2 t1 t2) (bin k1 x1 t3 t4)
--
-- It is only written in such a way that every node is pattern-matched only once.

balance :: k -> a -> Map k a -> Map k a -> Map k a
balance :: k -> a -> Map k a -> Map k a -> Map k a
balance k
k a
x Map k a
l Map k a
r = case Map k a
l of
  Map k a
Tip -> case Map k a
r of
           Map k a
Tip -> Int -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin Int
1 k
k a
x Map k a
forall k a. Map k a
Tip Map k a
forall k a. Map k a
Tip
           (Bin Int
_ k
_ a
_ Map k a
Tip Map k a
Tip) -> Int -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin Int
2 k
k a
x Map k a
forall k a. Map k a
Tip Map k a
r
           (Bin Int
_ k
rk a
rx Map k a
Tip rr :: Map k a
rr@(Bin Int
_ k
_ a
_ Map k a
_ Map k a
_)) -> Int -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin Int
3 k
rk a
rx (Int -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin Int
1 k
k a
x Map k a
forall k a. Map k a
Tip Map k a
forall k a. Map k a
Tip) Map k a
rr
           (Bin Int
_ k
rk a
rx (Bin Int
_ k
rlk a
rlx Map k a
_ Map k a
_) Map k a
Tip) -> Int -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin Int
3 k
rlk a
rlx (Int -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin Int
1 k
k a
x Map k a
forall k a. Map k a
Tip Map k a
forall k a. Map k a
Tip) (Int -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin Int
1 k
rk a
rx Map k a
forall k a. Map k a
Tip Map k a
forall k a. Map k a
Tip)
           (Bin Int
rs k
rk a
rx rl :: Map k a
rl@(Bin Int
rls k
rlk a
rlx Map k a
rll Map k a
rlr) rr :: Map k a
rr@(Bin Int
rrs k
_ a
_ Map k a
_ Map k a
_))
             | Int
rls Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
ratioInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
rrs -> Int -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
rs) k
rk a
rx (Int -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
rls) k
k a
x Map k a
forall k a. Map k a
Tip Map k a
rl) Map k a
rr
             | Bool
otherwise -> Int -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
rs) k
rlk a
rlx (Int -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Map k a -> Int
forall k a. Map k a -> Int
size Map k a
rll) k
k a
x Map k a
forall k a. Map k a
Tip Map k a
rll) (Int -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
rrsInt -> Int -> Int
forall a. Num a => a -> a -> a
+Map k a -> Int
forall k a. Map k a -> Int
size Map k a
rlr) k
rk a
rx Map k a
rlr Map k a
rr)

  (Bin Int
ls k
lk a
lx Map k a
ll Map k a
lr) -> case Map k a
r of
           Map k a
Tip -> case (Map k a
ll, Map k a
lr) of
                    (Map k a
Tip, Map k a
Tip) -> Int -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin Int
2 k
k a
x Map k a
l Map k a
forall k a. Map k a
Tip
                    (Map k a
Tip, (Bin Int
_ k
lrk a
lrx Map k a
_ Map k a
_)) -> Int -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin Int
3 k
lrk a
lrx (Int -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin Int
1 k
lk a
lx Map k a
forall k a. Map k a
Tip Map k a
forall k a. Map k a
Tip) (Int -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin Int
1 k
k a
x Map k a
forall k a. Map k a
Tip Map k a
forall k a. Map k a
Tip)
                    ((Bin Int
_ k
_ a
_ Map k a
_ Map k a
_), Map k a
Tip) -> Int -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin Int
3 k
lk a
lx Map k a
ll (Int -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin Int
1 k
k a
x Map k a
forall k a. Map k a
Tip Map k a
forall k a. Map k a
Tip)
                    ((Bin Int
lls k
_ a
_ Map k a
_ Map k a
_), (Bin Int
lrs k
lrk a
lrx Map k a
lrl Map k a
lrr))
                      | Int
lrs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
ratioInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
lls -> Int -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
ls) k
lk a
lx Map k a
ll (Int -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lrs) k
k a
x Map k a
lr Map k a
forall k a. Map k a
Tip)
                      | Bool
otherwise -> Int -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
ls) k
lrk a
lrx (Int -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
llsInt -> Int -> Int
forall a. Num a => a -> a -> a
+Map k a -> Int
forall k a. Map k a -> Int
size Map k a
lrl) k
lk a
lx Map k a
ll Map k a
lrl) (Int -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Map k a -> Int
forall k a. Map k a -> Int
size Map k a
lrr) k
k a
x Map k a
lrr Map k a
forall k a. Map k a
Tip)
           (Bin Int
rs k
rk a
rx Map k a
rl Map k a
rr)
              | Int
rs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
deltaInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
ls  -> case (Map k a
rl, Map k a
rr) of
                   (Bin Int
rls k
rlk a
rlx Map k a
rll Map k a
rlr, Bin Int
rrs k
_ a
_ Map k a
_ Map k a
_)
                     | Int
rls Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
ratioInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
rrs -> Int -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lsInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
rs) k
rk a
rx (Int -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lsInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
rls) k
k a
x Map k a
l Map k a
rl) Map k a
rr
                     | Bool
otherwise -> Int -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lsInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
rs) k
rlk a
rlx (Int -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lsInt -> Int -> Int
forall a. Num a => a -> a -> a
+Map k a -> Int
forall k a. Map k a -> Int
size Map k a
rll) k
k a
x Map k a
l Map k a
rll) (Int -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
rrsInt -> Int -> Int
forall a. Num a => a -> a -> a
+Map k a -> Int
forall k a. Map k a -> Int
size Map k a
rlr) k
rk a
rx Map k a
rlr Map k a
rr)
                   (Map k a
_, Map k a
_) -> [Char] -> Map k a
forall a. HasCallStack => [Char] -> a
error [Char]
"Failure in Data.Map.balance"
              | Int
ls Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
deltaInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
rs  -> case (Map k a
ll, Map k a
lr) of
                   (Bin Int
lls k
_ a
_ Map k a
_ Map k a
_, Bin Int
lrs k
lrk a
lrx Map k a
lrl Map k a
lrr)
                     | Int
lrs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
ratioInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
lls -> Int -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lsInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
rs) k
lk a
lx Map k a
ll (Int -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
rsInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lrs) k
k a
x Map k a
lr Map k a
r)
                     | Bool
otherwise -> Int -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lsInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
rs) k
lrk a
lrx (Int -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
llsInt -> Int -> Int
forall a. Num a => a -> a -> a
+Map k a -> Int
forall k a. Map k a -> Int
size Map k a
lrl) k
lk a
lx Map k a
ll Map k a
lrl) (Int -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
rsInt -> Int -> Int
forall a. Num a => a -> a -> a
+Map k a -> Int
forall k a. Map k a -> Int
size Map k a
lrr) k
k a
x Map k a
lrr Map k a
r)
                   (Map k a
_, Map k a
_) -> [Char] -> Map k a
forall a. HasCallStack => [Char] -> a
error [Char]
"Failure in Data.Map.balance"
              | Bool
otherwise -> Int -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lsInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
rs) k
k a
x Map k a
l Map k a
r
{-# NOINLINE balance #-}

-- Functions balanceL and balanceR are specialised versions of balance.
-- balanceL only checks whether the left subtree is too big,
-- balanceR only checks whether the right subtree is too big.

-- balanceL is called when left subtree might have been inserted to or when
-- right subtree might have been deleted from.
balanceL :: k -> a -> Map k a -> Map k a -> Map k a
balanceL :: k -> a -> Map k a -> Map k a -> Map k a
balanceL k
k a
x Map k a
l Map k a
r = case Map k a
r of
  Map k a
Tip -> case Map k a
l of
           Map k a
Tip -> Int -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin Int
1 k
k a
x Map k a
forall k a. Map k a
Tip Map k a
forall k a. Map k a
Tip
           (Bin Int
_ k
_ a
_ Map k a
Tip Map k a
Tip) -> Int -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin Int
2 k
k a
x Map k a
l Map k a
forall k a. Map k a
Tip
           (Bin Int
_ k
lk a
lx Map k a
Tip (Bin Int
_ k
lrk a
lrx Map k a
_ Map k a
_)) -> Int -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin Int
3 k
lrk a
lrx (Int -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin Int
1 k
lk a
lx Map k a
forall k a. Map k a
Tip Map k a
forall k a. Map k a
Tip) (Int -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin Int
1 k
k a
x Map k a
forall k a. Map k a
Tip Map k a
forall k a. Map k a
Tip)
           (Bin Int
_ k
lk a
lx ll :: Map k a
ll@(Bin Int
_ k
_ a
_ Map k a
_ Map k a
_) Map k a
Tip) -> Int -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin Int
3 k
lk a
lx Map k a
ll (Int -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin Int
1 k
k a
x Map k a
forall k a. Map k a
Tip Map k a
forall k a. Map k a
Tip)
           (Bin Int
ls k
lk a
lx ll :: Map k a
ll@(Bin Int
lls k
_ a
_ Map k a
_ Map k a
_) lr :: Map k a
lr@(Bin Int
lrs k
lrk a
lrx Map k a
lrl Map k a
lrr))
             | Int
lrs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
ratioInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
lls -> Int -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
ls) k
lk a
lx Map k a
ll (Int -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lrs) k
k a
x Map k a
lr Map k a
forall k a. Map k a
Tip)
             | Bool
otherwise -> Int -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
ls) k
lrk a
lrx (Int -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
llsInt -> Int -> Int
forall a. Num a => a -> a -> a
+Map k a -> Int
forall k a. Map k a -> Int
size Map k a
lrl) k
lk a
lx Map k a
ll Map k a
lrl) (Int -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Map k a -> Int
forall k a. Map k a -> Int
size Map k a
lrr) k
k a
x Map k a
lrr Map k a
forall k a. Map k a
Tip)

  (Bin Int
rs k
_ a
_ Map k a
_ Map k a
_) -> case Map k a
l of
           Map k a
Tip -> Int -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
rs) k
k a
x Map k a
forall k a. Map k a
Tip Map k a
r

           (Bin Int
ls k
lk a
lx Map k a
ll Map k a
lr)
              | Int
ls Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
deltaInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
rs  -> case (Map k a
ll, Map k a
lr) of
                   (Bin Int
lls k
_ a
_ Map k a
_ Map k a
_, Bin Int
lrs k
lrk a
lrx Map k a
lrl Map k a
lrr)
                     | Int
lrs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
ratioInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
lls -> Int -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lsInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
rs) k
lk a
lx Map k a
ll (Int -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
rsInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lrs) k
k a
x Map k a
lr Map k a
r)
                     | Bool
otherwise -> Int -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lsInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
rs) k
lrk a
lrx (Int -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
llsInt -> Int -> Int
forall a. Num a => a -> a -> a
+Map k a -> Int
forall k a. Map k a -> Int
size Map k a
lrl) k
lk a
lx Map k a
ll Map k a
lrl) (Int -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
rsInt -> Int -> Int
forall a. Num a => a -> a -> a
+Map k a -> Int
forall k a. Map k a -> Int
size Map k a
lrr) k
k a
x Map k a
lrr Map k a
r)
                   (Map k a
_, Map k a
_) -> [Char] -> Map k a
forall a. HasCallStack => [Char] -> a
error [Char]
"Failure in Data.Map.balanceL"
              | Bool
otherwise -> Int -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lsInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
rs) k
k a
x Map k a
l Map k a
r
{-# NOINLINE balanceL #-}

-- balanceR is called when right subtree might have been inserted to or when
-- left subtree might have been deleted from.
balanceR :: k -> a -> Map k a -> Map k a -> Map k a
balanceR :: k -> a -> Map k a -> Map k a -> Map k a
balanceR k
k a
x Map k a
l Map k a
r = case Map k a
l of
  Map k a
Tip -> case Map k a
r of
           Map k a
Tip -> Int -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin Int
1 k
k a
x Map k a
forall k a. Map k a
Tip Map k a
forall k a. Map k a
Tip
           (Bin Int
_ k
_ a
_ Map k a
Tip Map k a
Tip) -> Int -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin Int
2 k
k a
x Map k a
forall k a. Map k a
Tip Map k a
r
           (Bin Int
_ k
rk a
rx Map k a
Tip rr :: Map k a
rr@(Bin Int
_ k
_ a
_ Map k a
_ Map k a
_)) -> Int -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin Int
3 k
rk a
rx (Int -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin Int
1 k
k a
x Map k a
forall k a. Map k a
Tip Map k a
forall k a. Map k a
Tip) Map k a
rr
           (Bin Int
_ k
rk a
rx (Bin Int
_ k
rlk a
rlx Map k a
_ Map k a
_) Map k a
Tip) -> Int -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin Int
3 k
rlk a
rlx (Int -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin Int
1 k
k a
x Map k a
forall k a. Map k a
Tip Map k a
forall k a. Map k a
Tip) (Int -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin Int
1 k
rk a
rx Map k a
forall k a. Map k a
Tip Map k a
forall k a. Map k a
Tip)
           (Bin Int
rs k
rk a
rx rl :: Map k a
rl@(Bin Int
rls k
rlk a
rlx Map k a
rll Map k a
rlr) rr :: Map k a
rr@(Bin Int
rrs k
_ a
_ Map k a
_ Map k a
_))
             | Int
rls Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
ratioInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
rrs -> Int -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
rs) k
rk a
rx (Int -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
rls) k
k a
x Map k a
forall k a. Map k a
Tip Map k a
rl) Map k a
rr
             | Bool
otherwise -> Int -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
rs) k
rlk a
rlx (Int -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Map k a -> Int
forall k a. Map k a -> Int
size Map k a
rll) k
k a
x Map k a
forall k a. Map k a
Tip Map k a
rll) (Int -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
rrsInt -> Int -> Int
forall a. Num a => a -> a -> a
+Map k a -> Int
forall k a. Map k a -> Int
size Map k a
rlr) k
rk a
rx Map k a
rlr Map k a
rr)

  (Bin Int
ls k
_ a
_ Map k a
_ Map k a
_) -> case Map k a
r of
           Map k a
Tip -> Int -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
ls) k
k a
x Map k a
l Map k a
forall k a. Map k a
Tip

           (Bin Int
rs k
rk a
rx Map k a
rl Map k a
rr)
              | Int
rs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
deltaInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
ls  -> case (Map k a
rl, Map k a
rr) of
                   (Bin Int
rls k
rlk a
rlx Map k a
rll Map k a
rlr, Bin Int
rrs k
_ a
_ Map k a
_ Map k a
_)
                     | Int
rls Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
ratioInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
rrs -> Int -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lsInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
rs) k
rk a
rx (Int -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lsInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
rls) k
k a
x Map k a
l Map k a
rl) Map k a
rr
                     | Bool
otherwise -> Int -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lsInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
rs) k
rlk a
rlx (Int -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lsInt -> Int -> Int
forall a. Num a => a -> a -> a
+Map k a -> Int
forall k a. Map k a -> Int
size Map k a
rll) k
k a
x Map k a
l Map k a
rll) (Int -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
rrsInt -> Int -> Int
forall a. Num a => a -> a -> a
+Map k a -> Int
forall k a. Map k a -> Int
size Map k a
rlr) k
rk a
rx Map k a
rlr Map k a
rr)
                   (Map k a
_, Map k a
_) -> [Char] -> Map k a
forall a. HasCallStack => [Char] -> a
error [Char]
"Failure in Data.Map.balanceR"
              | Bool
otherwise -> Int -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lsInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
rs) k
k a
x Map k a
l Map k a
r
{-# NOINLINE balanceR #-}


{--------------------------------------------------------------------
  The bin constructor maintains the size of the tree
--------------------------------------------------------------------}
bin :: k -> a -> Map k a -> Map k a -> Map k a
bin :: k -> a -> Map k a -> Map k a -> Map k a
bin k
k a
x Map k a
l Map k a
r
  = Int -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin (Map k a -> Int
forall k a. Map k a -> Int
size Map k a
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Map k a -> Int
forall k a. Map k a -> Int
size Map k a
r Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) k
k a
x Map k a
l Map k a
r
{-# INLINE bin #-}


{--------------------------------------------------------------------
  Eq converts the tree to a list. In a lazy setting, this
  actually seems one of the faster methods to compare two trees
  and it is certainly the simplest :-)
--------------------------------------------------------------------}
instance (Eq k,Eq a) => Eq (Map k a) where
  Map k a
t1 == :: Map k a -> Map k a -> Bool
== Map k a
t2  = (Map k a -> Int
forall k a. Map k a -> Int
size Map k a
t1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Map k a -> Int
forall k a. Map k a -> Int
size Map k a
t2) Bool -> Bool -> Bool
&& (Map k a -> [(k, a)]
forall k a. Map k a -> [(k, a)]
toAscList Map k a
t1 [(k, a)] -> [(k, a)] -> Bool
forall a. Eq a => a -> a -> Bool
== Map k a -> [(k, a)]
forall k a. Map k a -> [(k, a)]
toAscList Map k a
t2)

{--------------------------------------------------------------------
  Ord
--------------------------------------------------------------------}

instance (Ord k, Ord v) => Ord (Map k v) where
    compare :: Map k v -> Map k v -> Ordering
compare Map k v
m1 Map k v
m2 = [(k, v)] -> [(k, v)] -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Map k v -> [(k, v)]
forall k a. Map k a -> [(k, a)]
toAscList Map k v
m1) (Map k v -> [(k, v)]
forall k a. Map k a -> [(k, a)]
toAscList Map k v
m2)

{--------------------------------------------------------------------
  Lifted instances
--------------------------------------------------------------------}

-- | @since 0.5.9
instance Eq2 Map where
    liftEq2 :: (a -> b -> Bool) -> (c -> d -> Bool) -> Map a c -> Map b d -> Bool
liftEq2 a -> b -> Bool
eqk c -> d -> Bool
eqv Map a c
m Map b d
n =
        Map a c -> Int
forall k a. Map k a -> Int
size Map a c
m Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Map b d -> Int
forall k a. Map k a -> Int
size Map b d
n Bool -> Bool -> Bool
&& ((a, c) -> (b, d) -> Bool) -> [(a, c)] -> [(b, d)] -> Bool
forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq ((a -> b -> Bool) -> (c -> d -> Bool) -> (a, c) -> (b, d) -> Bool
forall (f :: * -> * -> *) a b c d.
Eq2 f =>
(a -> b -> Bool) -> (c -> d -> Bool) -> f a c -> f b d -> Bool
liftEq2 a -> b -> Bool
eqk c -> d -> Bool
eqv) (Map a c -> [(a, c)]
forall k a. Map k a -> [(k, a)]
toList Map a c
m) (Map b d -> [(b, d)]
forall k a. Map k a -> [(k, a)]
toList Map b d
n)

-- | @since 0.5.9
instance Eq k => Eq1 (Map k) where
    liftEq :: (a -> b -> Bool) -> Map k a -> Map k b -> Bool
liftEq = (k -> k -> Bool) -> (a -> b -> Bool) -> Map k a -> Map k b -> Bool
forall (f :: * -> * -> *) a b c d.
Eq2 f =>
(a -> b -> Bool) -> (c -> d -> Bool) -> f a c -> f b d -> Bool
liftEq2 k -> k -> Bool
forall a. Eq a => a -> a -> Bool
(==)

-- | @since 0.5.9
instance Ord2 Map where
    liftCompare2 :: (a -> b -> Ordering)
-> (c -> d -> Ordering) -> Map a c -> Map b d -> Ordering
liftCompare2 a -> b -> Ordering
cmpk c -> d -> Ordering
cmpv Map a c
m Map b d
n =
        ((a, c) -> (b, d) -> Ordering) -> [(a, c)] -> [(b, d)] -> Ordering
forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare ((a -> b -> Ordering)
-> (c -> d -> Ordering) -> (a, c) -> (b, d) -> Ordering
forall (f :: * -> * -> *) a b c d.
Ord2 f =>
(a -> b -> Ordering)
-> (c -> d -> Ordering) -> f a c -> f b d -> Ordering
liftCompare2 a -> b -> Ordering
cmpk c -> d -> Ordering
cmpv) (Map a c -> [(a, c)]
forall k a. Map k a -> [(k, a)]
toList Map a c
m) (Map b d -> [(b, d)]
forall k a. Map k a -> [(k, a)]
toList Map b d
n)

-- | @since 0.5.9
instance Ord k => Ord1 (Map k) where
    liftCompare :: (a -> b -> Ordering) -> Map k a -> Map k b -> Ordering
liftCompare = (k -> k -> Ordering)
-> (a -> b -> Ordering) -> Map k a -> Map k b -> Ordering
forall (f :: * -> * -> *) a b c d.
Ord2 f =>
(a -> b -> Ordering)
-> (c -> d -> Ordering) -> f a c -> f b d -> Ordering
liftCompare2 k -> k -> Ordering
forall a. Ord a => a -> a -> Ordering
compare

-- | @since 0.5.9
instance Show2 Map where
    liftShowsPrec2 :: (Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> Map a b
-> ShowS
liftShowsPrec2 Int -> a -> ShowS
spk [a] -> ShowS
slk Int -> b -> ShowS
spv [b] -> ShowS
slv Int
d Map a b
m =
        (Int -> [(a, b)] -> ShowS) -> [Char] -> Int -> [(a, b)] -> ShowS
forall a. (Int -> a -> ShowS) -> [Char] -> Int -> a -> ShowS
showsUnaryWith ((Int -> (a, b) -> ShowS)
-> ([(a, b)] -> ShowS) -> Int -> [(a, b)] -> ShowS
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec Int -> (a, b) -> ShowS
sp [(a, b)] -> ShowS
sl) [Char]
"fromList" Int
d (Map a b -> [(a, b)]
forall k a. Map k a -> [(k, a)]
toList Map a b
m)
      where
        sp :: Int -> (a, b) -> ShowS
sp = (Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> (a, b)
-> ShowS
forall (f :: * -> * -> *) a b.
Show2 f =>
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> f a b
-> ShowS
liftShowsPrec2 Int -> a -> ShowS
spk [a] -> ShowS
slk Int -> b -> ShowS
spv [b] -> ShowS
slv
        sl :: [(a, b)] -> ShowS
sl = (Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> [(a, b)]
-> ShowS
forall (f :: * -> * -> *) a b.
Show2 f =>
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> [f a b]
-> ShowS
liftShowList2 Int -> a -> ShowS
spk [a] -> ShowS
slk Int -> b -> ShowS
spv [b] -> ShowS
slv

-- | @since 0.5.9
instance Show k => Show1 (Map k) where
    liftShowsPrec :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Map k a -> ShowS
liftShowsPrec = (Int -> k -> ShowS)
-> ([k] -> ShowS)
-> (Int -> a -> ShowS)
-> ([a] -> ShowS)
-> Int
-> Map k a
-> ShowS
forall (f :: * -> * -> *) a b.
Show2 f =>
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> f a b
-> ShowS
liftShowsPrec2 Int -> k -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec [k] -> ShowS
forall a. Show a => [a] -> ShowS
showList

-- | @since 0.5.9
instance (Ord k, Read k) => Read1 (Map k) where
    liftReadsPrec :: (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (Map k a)
liftReadsPrec Int -> ReadS a
rp ReadS [a]
rl = ([Char] -> ReadS (Map k a)) -> Int -> ReadS (Map k a)
forall a. ([Char] -> ReadS a) -> Int -> ReadS a
readsData (([Char] -> ReadS (Map k a)) -> Int -> ReadS (Map k a))
-> ([Char] -> ReadS (Map k a)) -> Int -> ReadS (Map k a)
forall a b. (a -> b) -> a -> b
$
        (Int -> ReadS [(k, a)])
-> [Char] -> ([(k, a)] -> Map k a) -> [Char] -> ReadS (Map k a)
forall a t.
(Int -> ReadS a) -> [Char] -> (a -> t) -> [Char] -> ReadS t
readsUnaryWith ((Int -> ReadS (k, a)) -> ReadS [(k, a)] -> Int -> ReadS [(k, a)]
forall (f :: * -> *) a.
Read1 f =>
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (f a)
liftReadsPrec Int -> ReadS (k, a)
rp' ReadS [(k, a)]
rl') [Char]
"fromList" [(k, a)] -> Map k a
forall k a. Ord k => [(k, a)] -> Map k a
fromList
      where
        rp' :: Int -> ReadS (k, a)
rp' = (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (k, a)
forall (f :: * -> *) a.
Read1 f =>
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (f a)
liftReadsPrec Int -> ReadS a
rp ReadS [a]
rl
        rl' :: ReadS [(k, a)]
rl' = (Int -> ReadS a) -> ReadS [a] -> ReadS [(k, a)]
forall (f :: * -> *) a.
Read1 f =>
(Int -> ReadS a) -> ReadS [a] -> ReadS [f a]
liftReadList Int -> ReadS a
rp ReadS [a]
rl

{--------------------------------------------------------------------
  Functor
--------------------------------------------------------------------}
instance Functor (Map k) where
  fmap :: (a -> b) -> Map k a -> Map k b
fmap a -> b
f Map k a
m  = (a -> b) -> Map k a -> Map k b
forall a b k. (a -> b) -> Map k a -> Map k b
map a -> b
f Map k a
m
#ifdef __GLASGOW_HASKELL__
  a
_ <$ :: a -> Map k b -> Map k a
<$ Map k b
Tip = Map k a
forall k a. Map k a
Tip
  a
a <$ (Bin Int
sx k
kx b
_ Map k b
l Map k b
r) = Int -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin Int
sx k
kx a
a (a
a a -> Map k b -> Map k a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Map k b
l) (a
a a -> Map k b -> Map k a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Map k b
r)
#endif

-- | Traverses in order of increasing key.
instance Traversable (Map k) where
  traverse :: (a -> f b) -> Map k a -> f (Map k b)
traverse a -> f b
f = (k -> a -> f b) -> Map k a -> f (Map k b)
forall (t :: * -> *) k a b.
Applicative t =>
(k -> a -> t b) -> Map k a -> t (Map k b)
traverseWithKey (\k
_ -> a -> f b
f)
  {-# INLINE traverse #-}

-- | Folds in order of increasing key.
instance Foldable.Foldable (Map k) where
  fold :: Map k m -> m
fold = Map k m -> m
forall a k. Monoid a => Map k a -> a
go
    where go :: Map k a -> a
go Map k a
Tip = a
forall a. Monoid a => a
mempty
          go (Bin Int
1 k
_ a
v Map k a
_ Map k a
_) = a
v
          go (Bin Int
_ k
_ a
v Map k a
l Map k a
r) = Map k a -> a
go Map k a
l a -> a -> a
forall a. Monoid a => a -> a -> a
`mappend` (a
v a -> a -> a
forall a. Monoid a => a -> a -> a
`mappend` Map k a -> a
go Map k a
r)
  {-# INLINABLE fold #-}
  foldr :: (a -> b -> b) -> b -> Map k a -> b
foldr = (a -> b -> b) -> b -> Map k a -> b
forall a b k. (a -> b -> b) -> b -> Map k a -> b
foldr
  {-# INLINE foldr #-}
  foldl :: (b -> a -> b) -> b -> Map k a -> b
foldl = (b -> a -> b) -> b -> Map k a -> b
forall a b k. (a -> b -> a) -> a -> Map k b -> a
foldl
  {-# INLINE foldl #-}
  foldMap :: (a -> m) -> Map k a -> m
foldMap a -> m
f Map k a
t = Map k a -> m
go Map k a
t
    where go :: Map k a -> m
go Map k a
Tip = m
forall a. Monoid a => a
mempty
          go (Bin Int
1 k
_ a
v Map k a
_ Map k a
_) = a -> m
f a
v
          go (Bin Int
_ k
_ a
v Map k a
l Map k a
r) = Map k a -> m
go Map k a
l m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` (a -> m
f a
v m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` Map k a -> m
go Map k a
r)
  {-# INLINE foldMap #-}
  foldl' :: (b -> a -> b) -> b -> Map k a -> b
foldl' = (b -> a -> b) -> b -> Map k a -> b
forall a b k. (a -> b -> a) -> a -> Map k b -> a
foldl'
  {-# INLINE foldl' #-}
  foldr' :: (a -> b -> b) -> b -> Map k a -> b
foldr' = (a -> b -> b) -> b -> Map k a -> b
forall a b k. (a -> b -> b) -> b -> Map k a -> b
foldr'
  {-# INLINE foldr' #-}
  length :: Map k a -> Int
length = Map k a -> Int
forall k a. Map k a -> Int
size
  {-# INLINE length #-}
  null :: Map k a -> Bool
null   = Map k a -> Bool
forall k a. Map k a -> Bool
null
  {-# INLINE null #-}
  toList :: Map k a -> [a]
toList = Map k a -> [a]
forall k a. Map k a -> [a]
elems -- NB: Foldable.toList /= Map.toList
  {-# INLINE toList #-}
  elem :: a -> Map k a -> Bool
elem = a -> Map k a -> Bool
forall t k. Eq t => t -> Map k t -> Bool
go
    where go :: t -> Map k t -> Bool
go !t
_ Map k t
Tip = Bool
False
          go t
x (Bin Int
_ k
_ t
v Map k t
l Map k t
r) = t
x t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
v Bool -> Bool -> Bool
|| t -> Map k t -> Bool
go t
x Map k t
l Bool -> Bool -> Bool
|| t -> Map k t -> Bool
go t
x Map k t
r
  {-# INLINABLE elem #-}
  maximum :: Map k a -> a
maximum = Map k a -> a
forall p k. Ord p => Map k p -> p
start
    where start :: Map k p -> p
start Map k p
Tip = [Char] -> p
forall a. HasCallStack => [Char] -> a
error [Char]
"Data.Foldable.maximum (for Data.Map): empty map"
          start (Bin Int
_ k
_ p
v Map k p
l Map k p
r) = p -> Map k p -> p
forall t k. Ord t => t -> Map k t -> t
go (p -> Map k p -> p
forall t k. Ord t => t -> Map k t -> t
go p
v Map k p
l) Map k p
r

          go :: t -> Map k t -> t
go !t
m Map k t
Tip = t
m
          go t
m (Bin Int
_ k
_ t
v Map k t
l Map k t
r) = t -> Map k t -> t
go (t -> Map k t -> t
go (t -> t -> t
forall a. Ord a => a -> a -> a
max t
m t
v) Map k t
l) Map k t
r
  {-# INLINABLE maximum #-}
  minimum :: Map k a -> a
minimum = Map k a -> a
forall p k. Ord p => Map k p -> p
start
    where start :: Map k p -> p
start Map k p
Tip = [Char] -> p
forall a. HasCallStack => [Char] -> a
error [Char]
"Data.Foldable.minimum (for Data.Map): empty map"
          start (Bin Int
_ k
_ p
v Map k p
l Map k p
r) = p -> Map k p -> p
forall t k. Ord t => t -> Map k t -> t
go (p -> Map k p -> p
forall t k. Ord t => t -> Map k t -> t
go p
v Map k p
l) Map k p
r

          go :: t -> Map k t -> t
go !t
m Map k t
Tip = t
m
          go t
m (Bin Int
_ k
_ t
v Map k t
l Map k t
r) = t -> Map k t -> t
go (t -> Map k t -> t
go (t -> t -> t
forall a. Ord a => a -> a -> a
min t
m t
v) Map k t
l) Map k t
r
  {-# INLINABLE minimum #-}
  sum :: Map k a -> a
sum = (a -> a -> a) -> a -> Map k a -> a
forall a b k. (a -> b -> a) -> a -> Map k b -> a
foldl' a -> a -> a
forall a. Num a => a -> a -> a
(+) a
0
  {-# INLINABLE sum #-}
  product :: Map k a -> a
product = (a -> a -> a) -> a -> Map k a -> a
forall a b k. (a -> b -> a) -> a -> Map k b -> a
foldl' a -> a -> a
forall a. Num a => a -> a -> a
(*) a
1
  {-# INLINABLE product #-}

#if MIN_VERSION_base(4,10,0)
-- | @since 0.6.3.1
instance Bifoldable Map where
  bifold :: Map m m -> m
bifold = Map m m -> m
forall m. Monoid m => Map m m -> m
go
    where go :: Map a a -> a
go Map a a
Tip = a
forall a. Monoid a => a
mempty
          go (Bin Int
1 a
k a
v Map a a
_ Map a a
_) = a
k a -> a -> a
forall a. Monoid a => a -> a -> a
`mappend` a
v
          go (Bin Int
_ a
k a
v Map a a
l Map a a
r) = Map a a -> a
go Map a a
l a -> a -> a
forall a. Monoid a => a -> a -> a
`mappend` (a
k a -> a -> a
forall a. Monoid a => a -> a -> a
`mappend` (a
v a -> a -> a
forall a. Monoid a => a -> a -> a
`mappend` Map a a -> a
go Map a a
r))
  {-# INLINABLE bifold #-}
  bifoldr :: (a -> c -> c) -> (b -> c -> c) -> c -> Map a b -> c
bifoldr a -> c -> c
f b -> c -> c
g c
z = c -> Map a b -> c
go c
z
    where go :: c -> Map a b -> c
go c
z' Map a b
Tip             = c
z'
          go c
z' (Bin Int
_ a
k b
v Map a b
l Map a b
r) = c -> Map a b -> c
go (a -> c -> c
f a
k (b -> c -> c
g b
v (c -> Map a b -> c
go c
z' Map a b
r))) Map a b
l
  {-# INLINE bifoldr #-}
  bifoldl :: (c -> a -> c) -> (c -> b -> c) -> c -> Map a b -> c
bifoldl c -> a -> c
f c -> b -> c
g c
z = c -> Map a b -> c
go c
z
    where go :: c -> Map a b -> c
go c
z' Map a b
Tip             = c
z'
          go c
z' (Bin Int
_ a
k b
v Map a b
l Map a b
r) = c -> Map a b -> c
go (c -> b -> c
g (c -> a -> c
f (c -> Map a b -> c
go c
z' Map a b
l) a
k) b
v) Map a b
r
  {-# INLINE bifoldl #-}
  bifoldMap :: (a -> m) -> (b -> m) -> Map a b -> m
bifoldMap a -> m
f b -> m
g Map a b
t = Map a b -> m
go Map a b
t
    where go :: Map a b -> m
go Map a b
Tip = m
forall a. Monoid a => a
mempty
          go (Bin Int
1 a
k b
v Map a b
_ Map a b
_) = a -> m
f a
k m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` b -> m
g b
v
          go (Bin Int
_ a
k b
v Map a b
l Map a b
r) = Map a b -> m
go Map a b
l m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` (a -> m
f a
k m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` (b -> m
g b
v m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` Map a b -> m
go Map a b
r))
  {-# INLINE bifoldMap #-}
#endif

instance (NFData k, NFData a) => NFData (Map k a) where
    rnf :: Map k a -> ()
rnf Map k a
Tip = ()
    rnf (Bin Int
_ k
kx a
x Map k a
l Map k a
r) = k -> ()
forall a. NFData a => a -> ()
rnf k
kx () -> () -> ()
`seq` a -> ()
forall a. NFData a => a -> ()
rnf a
x () -> () -> ()
`seq` Map k a -> ()
forall a. NFData a => a -> ()
rnf Map k a
l () -> () -> ()
`seq` Map k a -> ()
forall a. NFData a => a -> ()
rnf Map k a
r

{--------------------------------------------------------------------
  Read
--------------------------------------------------------------------}
instance (Ord k, Read k, Read e) => Read (Map k e) where
#ifdef __GLASGOW_HASKELL__
  readPrec :: ReadPrec (Map k e)
readPrec = ReadPrec (Map k e) -> ReadPrec (Map k e)
forall a. ReadPrec a -> ReadPrec a
parens (ReadPrec (Map k e) -> ReadPrec (Map k e))
-> ReadPrec (Map k e) -> ReadPrec (Map k e)
forall a b. (a -> b) -> a -> b
$ Int -> ReadPrec (Map k e) -> ReadPrec (Map k e)
forall a. Int -> ReadPrec a -> ReadPrec a
prec Int
10 (ReadPrec (Map k e) -> ReadPrec (Map k e))
-> ReadPrec (Map k e) -> ReadPrec (Map k e)
forall a b. (a -> b) -> a -> b
$ do
    Ident [Char]
"fromList" <- ReadPrec Lexeme
lexP
    [(k, e)]
xs <- ReadPrec [(k, e)]
forall a. Read a => ReadPrec a
readPrec
    Map k e -> ReadPrec (Map k e)
forall (m :: * -> *) a. Monad m => a -> m a
return ([(k, e)] -> Map k e
forall k a. Ord k => [(k, a)] -> Map k a
fromList [(k, e)]
xs)

  readListPrec :: ReadPrec [Map k e]
readListPrec = ReadPrec [Map k e]
forall a. Read a => ReadPrec [a]
readListPrecDefault
#else
  readsPrec p = readParen (p > 10) $ \ r -> do
    ("fromList",s) <- lex r
    (xs,t) <- reads s
    return (fromList xs,t)
#endif

{--------------------------------------------------------------------
  Show
--------------------------------------------------------------------}
instance (Show k, Show a) => Show (Map k a) where
  showsPrec :: Int -> Map k a -> ShowS
showsPrec Int
d Map k a
m  = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
    [Char] -> ShowS
showString [Char]
"fromList " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(k, a)] -> ShowS
forall a. Show a => a -> ShowS
shows (Map k a -> [(k, a)]
forall k a. Map k a -> [(k, a)]
toList Map k a
m)

{--------------------------------------------------------------------
  Utilities
--------------------------------------------------------------------}

-- | \(O(1)\).  Decompose a map into pieces based on the structure of the underlying
-- tree.  This function is useful for consuming a map in parallel.
--
-- No guarantee is made as to the sizes of the pieces; an internal, but
-- deterministic process determines this.  However, it is guaranteed that the pieces
-- returned will be in ascending order (all elements in the first submap less than all
-- elements in the second, and so on).
--
-- Examples:
--
-- > splitRoot (fromList (zip [1..6] ['a'..])) ==
-- >   [fromList [(1,'a'),(2,'b'),(3,'c')],fromList [(4,'d')],fromList [(5,'e'),(6,'f')]]
--
-- > splitRoot empty == []
--
--  Note that the current implementation does not return more than three submaps,
--  but you should not depend on this behaviour because it can change in the
--  future without notice.
--
-- @since 0.5.4
splitRoot :: Map k b -> [Map k b]
splitRoot :: Map k b -> [Map k b]
splitRoot Map k b
orig =
  case Map k b
orig of
    Map k b
Tip           -> []
    Bin Int
_ k
k b
v Map k b
l Map k b
r -> [Map k b
l, k -> b -> Map k b
forall k a. k -> a -> Map k a
singleton k
k b
v, Map k b
r]
{-# INLINE splitRoot #-}