{-# LANGUAGE CPP #-}
{-# LANGUAGE BangPatterns #-}
#if defined(__GLASGOW_HASKELL__)
{-# LANGUAGE Trustworthy #-}
#endif
{-# OPTIONS_HADDOCK not-home #-}

#include "containers.h"

-----------------------------------------------------------------------------
-- |
-- Module      :  Data.Strict.Map.Autogen.Strict.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 ordered maps from keys to values
-- (dictionaries).
--
-- API of this module is strict in both the keys and the values.
-- If you need value-lazy maps, use "Data.Strict.Map.Autogen.Lazy" instead.
-- The 'Map' type is shared between the lazy and strict modules,
-- meaning that the same 'Map' value can be passed to functions in
-- both modules (although that is rarely needed).
--
-- These modules are intended to be imported qualified, to avoid name
-- clashes with Prelude functions, e.g.
--
-- >  import qualified Data.Strict.Map.Autogen.Strict 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'.
--
-- /Warning/: The size of the map must not exceed @maxBound::Int@. Violation of
-- this condition is not detected and if the size limit is exceeded, its
-- behaviour is undefined.
--
-- Operation comments contain the operation time complexity in
-- the Big-O notation (<http://en.wikipedia.org/wiki/Big_O_notation>).
--
-- Be aware that the 'Functor', 'Traversable' and 'Data.Data.Data' instances
-- are the same as for the "Data.Strict.Map.Autogen.Lazy" module, so if they are used
-- on strict maps, the resulting maps will be lazy.
-----------------------------------------------------------------------------

-- See the notes at the beginning of Data.Strict.Map.Autogen.Internal.

module Data.Strict.Map.Autogen.Strict.Internal
    (
    -- * Strictness properties
    -- $strictness

    -- * Map type
    Map(..)          -- instance Eq,Show,Read
    , L.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
    , merge
    , runWhenMatched
    , runWhenMissing

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

    -- *** Covariant maps for tactics
    , mapWhenMissing
    , mapWhenMatched

    -- ** 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
    , restrictKeys
    , withoutKeys
    , partition
    , partitionWithKey
    , takeWhileAntitone
    , dropWhileAntitone
    , spanAntitone

    , 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

    -- * Debugging
#ifdef __GLASGOW_HASKELL__
    , showTree
    , showTreeWith
#endif
    , valid
    ) where

import Prelude hiding (lookup,map,filter,foldr,foldl,null,take,drop,splitAt)

import Data.Strict.Map.Autogen.Internal
  ( Map (..)
  , AreWeStrict (..)
  , WhenMissing (..)
  , WhenMatched (..)
  , runWhenMatched
  , runWhenMissing
  , SimpleWhenMissing
  , SimpleWhenMatched
  , preserveMissing
  , preserveMissing'
  , dropMissing
  , filterMissing
  , filterAMissing
  , merge
  , mergeA
  , (!)
  , (!?)
  , (\\)
  , argSet
  , assocs
  , atKeyImpl
  , atKeyPlain
  , balance
  , balanceL
  , balanceR
  , compose
  , elemAt
  , elems
  , empty
  , delete
  , deleteAt
  , deleteFindMax
  , deleteFindMin
  , deleteMin
  , deleteMax
  , difference
  , disjoint
  , drop
  , dropWhileAntitone
  , filter
  , filterWithKey
  , findIndex
  , findMax
  , findMin
  , foldl
  , foldl'
  , foldlWithKey
  , foldlWithKey'
  , foldMapWithKey
  , foldr
  , foldr'
  , foldrWithKey
  , foldrWithKey'
  , glue
  , insertMax
  , intersection
  , isProperSubmapOf
  , isProperSubmapOfBy
  , isSubmapOf
  , isSubmapOfBy
  , keys
  , keysSet
  , link
  , lookup
  , lookupGE
  , lookupGT
  , lookupIndex
  , lookupLE
  , lookupLT
  , lookupMin
  , lookupMax
  , mapKeys
  , mapKeysMonotonic
  , maxView
  , maxViewWithKey
  , member
  , link2
  , minView
  , minViewWithKey
  , notMember
  , null
  , partition
  , partitionWithKey
  , restrictKeys
  , size
  , spanAntitone
  , split
  , splitAt
  , splitLookup
  , splitRoot
  , take
  , takeWhileAntitone
  , toList
  , toAscList
  , toDescList
  , union
  , unions
  , withoutKeys )

#if defined(__GLASGOW_HASKELL__)
import Data.Strict.Map.Autogen.Internal.DeprecatedShowTree (showTree, showTreeWith)
#endif
import Data.Strict.Map.Autogen.Internal.Debug (valid)

import Control.Applicative (Const (..), liftA3)
import Data.Semigroup (Arg (..))
import qualified Data.Set.Internal as Set
import qualified Data.Strict.Map.Autogen.Internal as L
import Data.Strict.ContainersUtils.Autogen.StrictPair

import Data.Bits (shiftL, shiftR)
#ifdef __GLASGOW_HASKELL__
import Data.Coerce
#endif

#ifdef __GLASGOW_HASKELL__
import Data.Functor.Identity (Identity (..))
#endif

import qualified Data.Foldable as Foldable

-- $strictness
--
-- This module satisfies the following strictness properties:
--
-- 1. Key arguments are evaluated to WHNF;
--
-- 2. Keys and values are evaluated to WHNF before they are stored in
--    the map.
--
-- Here's an example illustrating the first property:
--
-- > delete undefined m  ==  undefined
--
-- Here are some examples that illustrate the second property:
--
-- > map (\ v -> undefined) m  ==  undefined      -- m is not empty
-- > mapKeys (\ k -> undefined) m  ==  undefined  -- m is not empty

-- [Note: Pointer equality for sharing]
--
-- We use pointer equality to enhance sharing between the arguments
-- of some functions and their results. Notably, we use it
-- for insert, delete, union, intersection, and difference. We do
-- *not* use it for functions, like insertWith, unionWithKey,
-- intersectionWith, etc., that allow the user to modify the elements.
-- While we *could* do so, we would only get sharing under fairly
-- narrow conditions and at a relatively high cost. It does not seem
-- worth the price.

{--------------------------------------------------------------------
  Query
--------------------------------------------------------------------}

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

-- See Map.Internal.Note: Local 'go' functions and capturing
findWithDefault :: Ord k => a -> k -> Map k a -> a
findWithDefault :: forall k a. Ord k => a -> k -> Map k a -> a
findWithDefault a
def k
k = k
k seq :: forall a b. a -> b -> b
`seq` Map k a -> a
go
  where
    go :: Map k a -> a
go Map k a
Tip = a
def
    go (Bin Size
_ k
kx a
x Map k a
l Map k a
r) = case forall a. Ord a => a -> a -> Ordering
compare k
k k
kx of
      Ordering
LT -> Map k a -> a
go Map k a
l
      Ordering
GT -> Map k a -> a
go Map k a
r
      Ordering
EQ -> a
x
#if __GLASGOW_HASKELL__
{-# INLINABLE findWithDefault #-}
#else
{-# INLINE findWithDefault #-}
#endif

{--------------------------------------------------------------------
  Construction
--------------------------------------------------------------------}

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

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

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

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

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

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

insertWithR :: Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
insertWithR :: forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
insertWithR = forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
go
  where
    go :: Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
    go :: forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
go a -> a -> a
_ !k
kx a
x Map k a
Tip = forall k a. k -> a -> Map k a
singleton k
kx a
x
    go a -> a -> a
f !k
kx a
x (Bin Size
sy k
ky a
y Map k a
l Map k a
r) =
        case forall a. Ord a => a -> a -> Ordering
compare k
kx k
ky of
            Ordering
LT -> forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceL k
ky a
y (forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
go a -> a -> a
f k
kx a
x Map k a
l) Map k a
r
            Ordering
GT -> forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceR k
ky a
y Map k a
l (forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
go a -> a -> a
f k
kx a
x Map k a
r)
            Ordering
EQ -> let !y' :: a
y' = a -> a -> a
f a
y a
x in forall k a. Size -> k -> a -> Map k a -> Map k a -> Map k a
Bin Size
sy k
ky a
y' 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 Map.Internal.Note: Type of local 'go' function
insertWithKey :: Ord k => (k -> a -> a -> a) -> k -> a -> Map k a -> Map k a
insertWithKey :: forall k a.
Ord k =>
(k -> a -> a -> a) -> k -> a -> Map k a -> Map k a
insertWithKey = forall k a.
Ord k =>
(k -> a -> a -> a) -> k -> a -> Map k a -> Map k a
go
  where
    go :: Ord k => (k -> a -> a -> a) -> k -> a -> Map k a -> Map k a
    -- Forcing `kx` may look redundant, but it's possible `compare` will
    -- be lazy.
    go :: forall k a.
Ord k =>
(k -> a -> a -> a) -> k -> a -> Map k a -> Map k a
go k -> a -> a -> a
_ !k
kx a
x Map k a
Tip = forall k a. k -> a -> Map k a
singleton k
kx a
x
    go k -> a -> a -> a
f k
kx a
x (Bin Size
sy k
ky a
y Map k a
l Map k a
r) =
        case forall a. Ord a => a -> a -> Ordering
compare k
kx k
ky of
            Ordering
LT -> forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceL k
ky a
y (forall k a.
Ord k =>
(k -> a -> a -> a) -> k -> a -> Map k a -> Map k a
go k -> a -> a -> a
f k
kx a
x Map k a
l) Map k a
r
            Ordering
GT -> forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceR k
ky a
y Map k a
l (forall k a.
Ord k =>
(k -> a -> a -> a) -> k -> a -> Map k a -> Map k a
go k -> a -> a -> a
f k
kx a
x Map k a
r)
            Ordering
EQ -> let !x' :: a
x' = k -> a -> a -> a
f k
kx a
x a
y
                  in forall k a. Size -> k -> a -> Map k a -> Map k a -> Map k a
Bin Size
sy k
kx a
x' Map k a
l Map k a
r
#if __GLASGOW_HASKELL__
{-# INLINABLE insertWithKey #-}
#else
{-# INLINE insertWithKey #-}
#endif

insertWithKeyR :: Ord k => (k -> a -> a -> a) -> k -> a -> Map k a -> Map k a
insertWithKeyR :: forall k a.
Ord k =>
(k -> a -> a -> a) -> k -> a -> Map k a -> Map k a
insertWithKeyR = forall k a.
Ord k =>
(k -> a -> a -> a) -> k -> a -> Map k a -> Map k a
go
  where
    go :: Ord k => (k -> a -> a -> a) -> k -> a -> Map k a -> Map k a
    -- Forcing `kx` may look redundant, but it's possible `compare` will
    -- be lazy.
    go :: forall k a.
Ord k =>
(k -> a -> a -> a) -> k -> a -> Map k a -> Map k a
go k -> a -> a -> a
_ !k
kx a
x Map k a
Tip = forall k a. k -> a -> Map k a
singleton k
kx a
x
    go k -> a -> a -> a
f k
kx a
x (Bin Size
sy k
ky a
y Map k a
l Map k a
r) =
        case forall a. Ord a => a -> a -> Ordering
compare k
kx k
ky of
            Ordering
LT -> forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceL k
ky a
y (forall k a.
Ord k =>
(k -> a -> a -> a) -> k -> a -> Map k a -> Map k a
go k -> a -> a -> a
f k
kx a
x Map k a
l) Map k a
r
            Ordering
GT -> forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceR k
ky a
y Map k a
l (forall k a.
Ord k =>
(k -> a -> a -> a) -> k -> a -> Map k a -> Map k a
go k -> a -> a -> a
f k
kx a
x Map k a
r)
            Ordering
EQ -> let !y' :: a
y' = k -> a -> a -> a
f k
ky a
y a
x
                  in forall k a. Size -> k -> a -> Map k a -> Map k a -> Map k a
Bin Size
sy k
ky a
y' 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 Map.Internal.Note: Type of local 'go' function
insertLookupWithKey :: Ord k => (k -> a -> a -> a) -> k -> a -> Map k a
                    -> (Maybe a, Map k a)
insertLookupWithKey :: forall k a.
Ord k =>
(k -> a -> a -> a) -> k -> a -> Map k a -> (Maybe a, Map k a)
insertLookupWithKey k -> a -> a -> a
f0 k
kx0 a
x0 Map k a
t0 = forall a b. StrictPair a b -> (a, b)
toPair forall a b. (a -> b) -> a -> b
$ 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
kx0 a
x0 Map k a
t0
  where
    go :: Ord k => (k -> a -> a -> a) -> k -> a -> Map k a -> StrictPair (Maybe a) (Map k a)
    go :: forall k a.
Ord k =>
(k -> a -> a -> a)
-> k -> a -> Map k a -> StrictPair (Maybe a) (Map k a)
go k -> a -> a -> a
_ !k
kx a
x Map k a
Tip = forall a. Maybe a
Nothing forall a b. a -> b -> StrictPair a b
:*: forall k a. k -> a -> Map k a
singleton k
kx a
x
    go k -> a -> a -> a
f k
kx a
x (Bin Size
sy k
ky a
y Map k a
l Map k a
r) =
        case forall a. Ord a => a -> a -> Ordering
compare k
kx k
ky of
            Ordering
LT -> let (Maybe a
found :*: Map k a
l') = forall k a.
Ord k =>
(k -> a -> a -> a)
-> k -> a -> Map k a -> StrictPair (Maybe a) (Map k a)
go k -> a -> a -> a
f k
kx a
x Map k a
l
                  in Maybe a
found forall a b. a -> b -> StrictPair a b
:*: 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
            Ordering
GT -> let (Maybe a
found :*: Map k a
r') = forall k a.
Ord k =>
(k -> a -> a -> a)
-> k -> a -> Map k a -> StrictPair (Maybe a) (Map k a)
go k -> a -> a -> a
f k
kx a
x Map k a
r
                  in Maybe a
found forall a b. a -> b -> StrictPair a b
:*: 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'
            Ordering
EQ -> let x' :: a
x' = k -> a -> a -> a
f k
kx a
x a
y
                  in a
x' seq :: forall a b. a -> b -> b
`seq` (forall a. a -> Maybe a
Just a
y forall a b. a -> b -> StrictPair a b
:*: forall k a. Size -> k -> a -> Map k a -> Map k a -> Map k a
Bin Size
sy k
kx a
x' Map k a
l Map k a
r)
#if __GLASGOW_HASKELL__
{-# INLINABLE insertLookupWithKey #-}
#else
{-# INLINE insertLookupWithKey #-}
#endif

{--------------------------------------------------------------------
  Deletion
--------------------------------------------------------------------}

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

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

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

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

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

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

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

-- See Map.Internal.Note: Type of local 'go' function
updateWithKey :: Ord k => (k -> a -> Maybe a) -> k -> Map k a -> Map k a
updateWithKey :: forall k a. Ord k => (k -> a -> Maybe a) -> k -> Map k a -> Map k a
updateWithKey = forall k a. Ord k => (k -> a -> Maybe a) -> k -> Map k a -> Map k a
go
  where
    go :: Ord k => (k -> a -> Maybe a) -> k -> Map k a -> Map k a
    go :: forall k a. Ord k => (k -> a -> Maybe a) -> k -> Map k a -> Map k a
go k -> a -> Maybe a
_ !k
_ Map k a
Tip = forall k a. Map k a
Tip
    go k -> a -> Maybe a
f k
k(Bin Size
sx k
kx a
x Map k a
l Map k a
r) =
        case forall a. Ord a => a -> a -> Ordering
compare k
k k
kx of
           Ordering
LT -> forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceR k
kx a
x (forall k a. Ord k => (k -> a -> Maybe a) -> k -> Map k a -> Map k a
go k -> a -> Maybe a
f k
k Map k a
l) Map k a
r
           Ordering
GT -> forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceL k
kx a
x Map k a
l (forall k a. Ord k => (k -> a -> Maybe a) -> k -> Map k a -> Map k a
go k -> a -> Maybe a
f k
k Map k a
r)
           Ordering
EQ -> case k -> a -> Maybe a
f k
kx a
x of
                   Just a
x' -> a
x' seq :: forall a b. a -> b -> b
`seq` forall k a. Size -> k -> a -> Map k a -> Map k a -> Map k a
Bin Size
sx k
kx a
x' Map k a
l Map k a
r
                   Maybe a
Nothing -> 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 Map.Internal.Note: Type of local 'go' function
updateLookupWithKey :: Ord k => (k -> a -> Maybe a) -> k -> Map k a -> (Maybe a,Map k a)
updateLookupWithKey :: forall k a.
Ord k =>
(k -> a -> Maybe a) -> k -> Map k a -> (Maybe a, Map k a)
updateLookupWithKey k -> a -> Maybe a
f0 k
k0 Map k a
t0 = forall a b. StrictPair a b -> (a, b)
toPair forall a b. (a -> b) -> a -> b
$ 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 Map k a
t0
 where
   go :: Ord k => (k -> a -> Maybe a) -> k -> Map k a -> StrictPair (Maybe a) (Map k a)
   go :: forall k a.
Ord k =>
(k -> a -> Maybe a)
-> k -> Map k a -> StrictPair (Maybe a) (Map k a)
go k -> a -> Maybe a
_ !k
_ Map k a
Tip = (forall a. Maybe a
Nothing forall a b. a -> b -> StrictPair a b
:*: forall k a. Map k a
Tip)
   go k -> a -> Maybe a
f k
k (Bin Size
sx k
kx a
x Map k a
l Map k a
r) =
          case forall a. Ord a => a -> a -> Ordering
compare k
k k
kx of
               Ordering
LT -> let (Maybe a
found :*: Map k a
l') = forall k a.
Ord k =>
(k -> a -> Maybe a)
-> k -> Map k a -> StrictPair (Maybe a) (Map k a)
go k -> a -> Maybe a
f k
k Map k a
l
                     in Maybe a
found forall a b. a -> b -> StrictPair a b
:*: forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceR k
kx a
x Map k a
l' Map k a
r
               Ordering
GT -> let (Maybe a
found :*: Map k a
r') = forall k a.
Ord k =>
(k -> a -> Maybe a)
-> k -> Map k a -> StrictPair (Maybe a) (Map k a)
go k -> a -> Maybe a
f k
k Map k a
r
                     in Maybe a
found forall a b. a -> b -> StrictPair a b
:*: forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceL k
kx a
x Map k a
l Map k a
r'
               Ordering
EQ -> case k -> a -> Maybe a
f k
kx a
x of
                       Just a
x' -> a
x' seq :: forall a b. a -> b -> b
`seq` (forall a. a -> Maybe a
Just a
x' forall a b. a -> b -> StrictPair a b
:*: forall k a. Size -> k -> a -> Map k a -> Map k a -> Map k a
Bin Size
sx k
kx a
x' Map k a
l Map k a
r)
                       Maybe a
Nothing -> (forall a. a -> Maybe a
Just a
x forall a b. a -> b -> StrictPair a b
:*: 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 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 Map.Internal.Note: Type of local 'go' function
alter :: Ord k => (Maybe a -> Maybe a) -> k -> Map k a -> Map k a
alter :: forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
alter = forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
go
  where
    go :: Ord k => (Maybe a -> Maybe a) -> k -> Map k a -> Map k a
    go :: forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
go Maybe a -> Maybe a
f !k
k Map k a
Tip = case Maybe a -> Maybe a
f forall a. Maybe a
Nothing of
               Maybe a
Nothing -> forall k a. Map k a
Tip
               Just a
x  -> forall k a. k -> a -> Map k a
singleton k
k a
x

    go Maybe a -> Maybe a
f k
k (Bin Size
sx k
kx a
x Map k a
l Map k a
r) = case forall a. Ord a => a -> a -> Ordering
compare k
k k
kx of
               Ordering
LT -> forall k a. k -> a -> Map k a -> Map k a -> Map k a
balance k
kx a
x (forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
go Maybe a -> Maybe a
f k
k Map k a
l) Map k a
r
               Ordering
GT -> forall k a. k -> a -> Map k a -> Map k a -> Map k a
balance k
kx a
x Map k a
l (forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
go Maybe a -> Maybe a
f k
k Map k a
r)
               Ordering
EQ -> case Maybe a -> Maybe a
f (forall a. a -> Maybe a
Just a
x) of
                       Just a
x' -> a
x' seq :: forall a b. a -> b -> b
`seq` forall k a. Size -> k -> a -> Map k a -> Map k a -> Map k a
Bin Size
sx k
kx a
x' Map k a
l Map k a
r
                       Maybe a
Nothing -> 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

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

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

{--------------------------------------------------------------------
  Indexing
--------------------------------------------------------------------}

-- | \(O(\log n)\). Update the element at /index/. Calls 'error' when an
-- invalid index is used.
--
-- > updateAt (\ _ _ -> Just "x") 0    (fromList [(5,"a"), (3,"b")]) == fromList [(3, "x"), (5, "a")]
-- > updateAt (\ _ _ -> Just "x") 1    (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "x")]
-- > updateAt (\ _ _ -> Just "x") 2    (fromList [(5,"a"), (3,"b")])    Error: index out of range
-- > updateAt (\ _ _ -> Just "x") (-1) (fromList [(5,"a"), (3,"b")])    Error: index out of range
-- > updateAt (\_ _  -> Nothing)  0    (fromList [(5,"a"), (3,"b")]) == singleton 5 "a"
-- > updateAt (\_ _  -> Nothing)  1    (fromList [(5,"a"), (3,"b")]) == singleton 3 "b"
-- > updateAt (\_ _  -> Nothing)  2    (fromList [(5,"a"), (3,"b")])    Error: index out of range
-- > updateAt (\_ _  -> Nothing)  (-1) (fromList [(5,"a"), (3,"b")])    Error: index out of range

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

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

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

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

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

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


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

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

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

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

{--------------------------------------------------------------------
  Union.
--------------------------------------------------------------------}

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

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

{--------------------------------------------------------------------
  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
unionWith :: forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
unionWith a -> a -> a
_f Map k a
t1 Map k a
Tip = Map k a
t1
unionWith a -> a -> a
f Map k a
t1 (Bin Size
_ k
k a
x Map k a
Tip Map k a
Tip) = forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
insertWithR a -> a -> a
f k
k a
x Map k a
t1
unionWith a -> a -> a
f (Bin Size
_ k
k a
x Map k a
Tip Map k a
Tip) Map k a
t2 = forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
insertWith a -> a -> a
f k
k a
x Map k a
t2
unionWith a -> a -> a
_f Map k a
Tip Map k a
t2 = Map k a
t2
unionWith a -> a -> a
f (Bin Size
_ k
k1 a
x1 Map k a
l1 Map k a
r1) Map k a
t2 = case 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) -> forall k a. k -> a -> Map k a -> Map k a -> Map k a
link k
k1 a
x1' (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) (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)
    where !x1' :: a
x1' = forall b a. b -> (a -> b) -> Maybe a -> b
maybe a
x1 (a -> a -> a
f a
x1) Maybe a
mb
#if __GLASGOW_HASKELL__
{-# INLINABLE unionWith #-}
#endif

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

unionWithKey :: Ord k => (k -> a -> a -> a) -> Map k a -> Map k a -> Map k a
unionWithKey :: forall k a.
Ord k =>
(k -> a -> a -> a) -> Map k a -> Map k a -> Map k a
unionWithKey k -> a -> a -> a
_f Map k a
t1 Map k a
Tip = Map k a
t1
unionWithKey k -> a -> a -> a
f Map k a
t1 (Bin Size
_ k
k a
x Map k a
Tip Map k a
Tip) = forall k a.
Ord k =>
(k -> a -> a -> a) -> k -> a -> Map k a -> Map k a
insertWithKeyR k -> a -> a -> a
f k
k a
x Map k a
t1
unionWithKey k -> a -> a -> a
f (Bin Size
_ k
k a
x Map k a
Tip Map k a
Tip) Map k a
t2 = forall k a.
Ord k =>
(k -> a -> a -> a) -> k -> a -> Map k a -> Map k a
insertWithKey k -> a -> a -> a
f k
k a
x Map k a
t2
unionWithKey k -> a -> a -> a
_f Map k a
Tip Map k a
t2 = Map k a
t2
unionWithKey k -> a -> a -> a
f (Bin Size
_ k
k1 a
x1 Map k a
l1 Map k a
r1) Map k a
t2 = case 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) -> forall k a. k -> a -> Map k a -> Map k a -> Map k a
link k
k1 a
x1' (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) (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)
    where !x1' :: a
x1' = forall b a. b -> (a -> b) -> Maybe a -> b
maybe a
x1 (k -> a -> a -> a
f k
k1 a
x1) Maybe a
mb
#if __GLASGOW_HASKELL__
{-# INLINABLE unionWithKey #-}
#endif

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

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

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

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

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


{--------------------------------------------------------------------
  Intersection
--------------------------------------------------------------------}

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

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

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

-- | Map covariantly over a @'WhenMissing' f k x@.
mapWhenMissing :: Functor f => (a -> b) -> WhenMissing f k x a -> WhenMissing f k x b
mapWhenMissing :: forall (f :: * -> *) a b k x.
Functor f =>
(a -> b) -> WhenMissing f k x a -> WhenMissing f k x b
mapWhenMissing a -> b
f WhenMissing f k x a
q = WhenMissing
  { missingSubtree :: Map k x -> f (Map k b)
missingSubtree = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b k. (a -> b) -> Map k a -> Map k b
map a -> b
f) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) k x y.
WhenMissing f k x y -> Map k x -> f (Map k y)
missingSubtree WhenMissing f k x a
q
  , missingKey :: k -> x -> f (Maybe b)
missingKey = \k
k x
x -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Maybe a -> Maybe a
forceMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) k x y.
WhenMissing f k x y -> k -> x -> f (Maybe y)
missingKey WhenMissing f k x a
q k
k x
x}

-- | Map covariantly over a @'WhenMatched' f k x y@.
mapWhenMatched :: Functor f => (a -> b) -> WhenMatched f k x y a -> WhenMatched f k x y b
mapWhenMatched :: forall (f :: * -> *) a b k x y.
Functor f =>
(a -> b) -> WhenMatched f k x y a -> WhenMatched f k x y b
mapWhenMatched a -> b
f WhenMatched f k x y a
q = WhenMatched
  { matchedKey :: k -> x -> y -> f (Maybe b)
matchedKey = \k
k x
x y
y -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Maybe a -> Maybe a
forceMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) forall a b. (a -> b) -> 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
q k
k x
x y
y }

-- | 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
-- @
zipWithMaybeMatched :: Applicative f
                    => (k -> x -> y -> Maybe z)
                    -> WhenMatched f k x y z
zipWithMaybeMatched :: forall (f :: * -> *) k x y z.
Applicative f =>
(k -> x -> y -> Maybe z) -> WhenMatched f k x y z
zipWithMaybeMatched k -> x -> y -> Maybe z
f = forall (f :: * -> *) k x y z.
(k -> x -> y -> f (Maybe z)) -> WhenMatched f k x y z
WhenMatched forall a b. (a -> b) -> a -> b
$
  \k
k x
x y
y -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$! forall a. Maybe a -> Maybe a
forceMaybe 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.
zipWithMaybeAMatched :: Applicative f
                     => (k -> x -> y -> f (Maybe z))
                     -> WhenMatched f k x y z
zipWithMaybeAMatched :: forall (f :: * -> *) k x y z.
Applicative f =>
(k -> x -> y -> f (Maybe z)) -> WhenMatched f k x y z
zipWithMaybeAMatched k -> x -> y -> f (Maybe z)
f = forall (f :: * -> *) k x y z.
(k -> x -> y -> f (Maybe z)) -> WhenMatched f k x y z
WhenMatched forall a b. (a -> b) -> a -> b
$
  \ k
k x
x y
y -> forall a. Maybe a -> Maybe a
forceMaybe forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> k -> x -> y -> f (Maybe z)
f k
k x
x y
y
{-# INLINE zipWithMaybeAMatched #-}

-- | 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.
zipWithAMatched :: Applicative f
                => (k -> x -> y -> f z)
                -> WhenMatched f k x y z
zipWithAMatched :: forall (f :: * -> *) k x y z.
Applicative f =>
(k -> x -> y -> f z) -> WhenMatched f k x y z
zipWithAMatched k -> x -> y -> f z
f = forall (f :: * -> *) k x y z.
(k -> x -> y -> f (Maybe z)) -> WhenMatched f k x y z
WhenMatched forall a b. (a -> b) -> a -> b
$
  \ k
k x
x y
y -> (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$!) 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 use the result in the merged map.
--
-- @
-- zipWithMatched :: (k -> x -> y -> z)
--                -> SimpleWhenMatched k x y z
-- @
zipWithMatched :: Applicative f
               => (k -> x -> y -> z) -> WhenMatched f k x y z
zipWithMatched :: forall (f :: * -> *) k x y z.
Applicative f =>
(k -> x -> y -> z) -> WhenMatched f k x y z
zipWithMatched k -> x -> y -> z
f = forall (f :: * -> *) k x y z.
(k -> x -> y -> f (Maybe z)) -> WhenMatched f k x y z
WhenMatched forall a b. (a -> b) -> a -> b
$
  \k
k x
x y
y -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$! forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! k -> x -> y -> z
f k
k x
x y
y
{-# INLINE zipWithMatched #-}

-- | 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.
mapMaybeMissing :: Applicative f => (k -> x -> Maybe y) -> WhenMissing f k x y
mapMaybeMissing :: forall (f :: * -> *) k x y.
Applicative f =>
(k -> x -> Maybe y) -> WhenMissing f k x y
mapMaybeMissing k -> x -> Maybe y
f = WhenMissing
  { missingSubtree :: Map k x -> f (Map k y)
missingSubtree = \Map k x
m -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$! 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 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$! forall a. Maybe a -> Maybe a
forceMaybe forall a b. (a -> b) -> a -> b
$! k -> x -> Maybe y
f k
k x
x }
{-# INLINE mapMaybeMissing #-}

-- | 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.
mapMissing :: Applicative f => (k -> x -> y) -> WhenMissing f k x y
mapMissing :: forall (f :: * -> *) k x y.
Applicative f =>
(k -> x -> y) -> WhenMissing f k x y
mapMissing k -> x -> y
f = WhenMissing
  { missingSubtree :: Map k x -> f (Map k y)
missingSubtree = \Map k x
m -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$! 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 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$! forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! k -> x -> y
f k
k x
x }
{-# INLINE mapMissing #-}

-- | 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.
traverseMaybeMissing :: Applicative f
                     => (k -> x -> f (Maybe y)) -> WhenMissing f k x y
traverseMaybeMissing :: forall (f :: * -> *) k x y.
Applicative f =>
(k -> x -> f (Maybe y)) -> WhenMissing f k x y
traverseMaybeMissing k -> x -> f (Maybe y)
f = WhenMissing
  { missingSubtree :: Map k x -> f (Map k y)
missingSubtree = 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
k x
x -> forall a. Maybe a -> Maybe a
forceMaybe forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> k -> x -> f (Maybe y)
f k
k x
x }
{-# INLINE traverseMaybeMissing #-}

-- | Traverse over the entries whose keys are missing from the other map.
traverseMissing :: Applicative f
                     => (k -> x -> f y) -> WhenMissing f k x y
traverseMissing :: forall (f :: * -> *) k x y.
Applicative f =>
(k -> x -> f y) -> WhenMissing f k x y
traverseMissing k -> x -> f y
f = WhenMissing
  { missingSubtree :: Map k x -> f (Map k y)
missingSubtree = 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 -> (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$!) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> k -> x -> f y
f k
k x
x }
{-# INLINE traverseMissing #-}

forceMaybe :: Maybe a -> Maybe a
forceMaybe :: forall a. Maybe a -> Maybe a
forceMaybe Maybe a
Nothing = forall a. Maybe a
Nothing
forceMaybe m :: Maybe a
m@(Just !a
_) = Maybe a
m
{-# INLINE forceMaybe #-}

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

-- | \(O(n+m)\). An unsafe universal combining function.
--
-- WARNING: This function can produce corrupt maps and its results
-- may depend on the internal structures of its inputs. Users should
-- prefer 'Data.Strict.Map.Autogen.Merge.Strict.merge' or
-- 'Data.Strict.Map.Autogen.Merge.Strict.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@ or
-- @'filterWithKey' 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 :: forall k a b c.
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
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 Size
_ 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 (forall k a. k -> a -> Map k a
singleton k
kx a
x) of
                     Map k c
Tip -> forall k a. Map k a -> Map k a -> Map k a
link2 Map k c
l' Map k c
r'
                     (Bin Size
_ k
_ c
x' Map k c
Tip Map k c
Tip) -> 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
_ -> 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 -> forall k a. Map k a -> Map k a -> Map k a
link2 Map k c
l' Map k c
r'
                     Just c
x' -> 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) = 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 #-}

{--------------------------------------------------------------------
  Filter and partition
--------------------------------------------------------------------}

-- | \(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 :: forall a b k. (a -> Maybe b) -> Map k a -> Map k b
mapMaybe a -> Maybe b
f = 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 :: forall k a b. (k -> a -> Maybe b) -> Map k a -> Map k b
mapMaybeWithKey k -> a -> Maybe b
_ Map k a
Tip = forall k a. Map k a
Tip
mapMaybeWithKey k -> a -> Maybe b
f (Bin Size
_ 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  -> b
y seq :: forall a b. a -> b -> b
`seq` forall k a. k -> a -> Map k a -> Map k a -> Map k a
link k
kx b
y (forall k a b. (k -> a -> Maybe b) -> Map k a -> Map k b
mapMaybeWithKey k -> a -> Maybe b
f Map k a
l) (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 -> forall k a. Map k a -> Map k a -> Map k a
link2 (forall k a b. (k -> a -> Maybe b) -> Map k a -> Map k b
mapMaybeWithKey k -> a -> Maybe b
f Map k a
l) (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 :: forall (f :: * -> *) k a b.
Applicative f =>
(k -> a -> f (Maybe b)) -> Map k a -> f (Map k b)
traverseMaybeWithKey = forall (f :: * -> *) k a b.
Applicative f =>
(k -> a -> f (Maybe b)) -> Map k a -> f (Map k b)
go
  where
    go :: (t -> t -> f (Maybe a)) -> Map t t -> f (Map t a)
go t -> t -> f (Maybe a)
_ Map t t
Tip = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall k a. Map k a
Tip
    go t -> t -> f (Maybe a)
f (Bin Size
_ t
kx t
x Map t t
Tip Map t t
Tip) = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall k a. Map k a
Tip (\ !a
x' -> forall k a. Size -> k -> a -> Map k a -> Map k a -> Map k a
Bin Size
1 t
kx a
x' forall k a. Map k a
Tip forall k a. Map k a
Tip) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t -> t -> f (Maybe a)
f t
kx t
x
    go t -> t -> f (Maybe a)
f (Bin Size
_ t
kx t
x Map t t
l Map t t
r) = forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 forall {a}. Map t a -> Maybe a -> Map t a -> Map t a
combine ((t -> t -> f (Maybe a)) -> Map t t -> f (Map t a)
go t -> t -> f (Maybe a)
f Map t t
l) (t -> t -> f (Maybe a)
f t
kx t
x) ((t -> t -> f (Maybe a)) -> Map t t -> f (Map t a)
go t -> t -> f (Maybe a)
f Map t t
r)
      where
        combine :: Map t a -> Maybe a -> Map t a -> Map t a
combine !Map t a
l' Maybe a
mx !Map t a
r' = case Maybe a
mx of
          Maybe a
Nothing -> forall k a. Map k a -> Map k a -> Map k a
link2 Map t a
l' Map t a
r'
          Just !a
x' -> forall k a. k -> a -> Map k a -> Map k a -> Map k a
link t
kx a
x' Map t a
l' Map t 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 :: forall a b c k. (a -> Either b c) -> Map k a -> (Map k b, Map k c)
mapEither a -> Either b c
f Map k a
m
  = 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 :: forall k a b c.
(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 = forall a b. StrictPair a b -> (a, b)
toPair forall a b. (a -> b) -> a -> b
$ 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 = (forall k a. Map k a
Tip forall a b. a -> b -> StrictPair a b
:*: forall k a. Map k a
Tip)
    go k -> t -> Either a a
f (Bin Size
_ 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  -> a
y seq :: forall a b. a -> b -> b
`seq` (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 forall a b. a -> b -> StrictPair a b
:*: forall k a. Map k a -> Map k a -> Map k a
link2 Map k a
l2 Map k a
r2)
      Right a
z -> a
z seq :: forall a b. a -> b -> b
`seq` (forall k a. Map k a -> Map k a -> Map k a
link2 Map k a
l1 Map k a
r1 forall a b. a -> b -> StrictPair a b
:*: forall k a. k -> a -> Map k a -> Map k a -> Map k a
link k
kx a
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 :: forall a b k. (a -> b) -> Map k a -> Map k b
map a -> b
f = forall {k}. Map k a -> Map k b
go
  where
    go :: Map k a -> Map k b
go Map k a
Tip = forall k a. Map k a
Tip
    go (Bin Size
sx k
kx a
x Map k a
l Map k a
r) = let !x' :: b
x' = a -> b
f a
x in forall k a. Size -> k -> a -> Map k a -> Map k a -> Map k a
Bin Size
sx k
kx b
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 `go` to let `map` inline. This is important if `f` is a constant
-- function.

#ifdef __GLASGOW_HASKELL__
{-# NOINLINE [1] map #-}
{-# RULES
"map/map" forall f g xs . map f (map g xs) = map (\x -> f $! g x) xs
"map/mapL" forall f g xs . map f (L.map g xs) = map (\x -> f (g x)) xs
 #-}
#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 :: forall k a b. (k -> a -> b) -> Map k a -> Map k b
mapWithKey k -> a -> b
_ Map k a
Tip = forall k a. Map k a
Tip
mapWithKey k -> a -> b
f (Bin Size
sx k
kx a
x Map k a
l Map k a
r) =
  let x' :: b
x' = k -> a -> b
f k
kx a
x
  in b
x' seq :: forall a b. a -> b -> b
`seq` forall k a. Size -> k -> a -> Map k a -> Map k a -> Map k a
Bin Size
sx k
kx b
x' (forall k a b. (k -> a -> b) -> Map k a -> Map k b
mapWithKey k -> a -> b
f Map k a
l) (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/mapWithKeyL" forall f g xs . mapWithKey f (L.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
"mapWithKey/mapL" forall f g xs . mapWithKey f (L.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
"map/mapWithKeyL" forall f g xs . map f (L.mapWithKey g xs) =
  mapWithKey (\k a -> f (g k a)) xs
 #-}
#endif

-- | \(O(n)\).
-- @'traverseWithKey' f m == 'fromList' <$> 'traverse' (\(k, v) -> (\v' -> v' \`seq\` (k,v')) <$> f k v) ('toList' m)@
-- That is, it behaves much like a regular 'traverse' except that the traversing
-- function also has access to the key associated with a value and the values are
-- forced before they are installed in the result map.
--
-- > 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 :: forall (t :: * -> *) k a b.
Applicative t =>
(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 = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall k a. Map k a
Tip
    go (Bin Size
1 k
k a
v Map k a
_ Map k a
_) = (\ !b
v' -> forall k a. Size -> k -> a -> Map k a -> Map k a -> Map k a
Bin Size
1 k
k b
v' forall k a. Map k a
Tip forall k a. Map k a
Tip) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> k -> a -> t b
f k
k a
v
    go (Bin Size
s k
k a
v Map k a
l Map k a
r) = forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 (\ Map k b
l' !b
v' Map k b
r' -> forall k a. Size -> k -> a -> Map k a -> Map k a -> Map k a
Bin Size
s k
k b
v' Map k b
l' Map k b
r') (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 :: forall a b c k. (a -> b -> (a, c)) -> a -> Map k b -> (a, Map k c)
mapAccum a -> b -> (a, c)
f a
a Map k b
m
  = 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 :: forall a k b c.
(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
  = 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 :: forall a k b c.
(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,forall k a. Map k a
Tip)
mapAccumL a -> k -> b -> (a, c)
f a
a (Bin Size
sx k
kx b
x Map k b
l Map k b
r) =
  let (a
a1,Map k c
l') = 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') = 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 c
x' seq :: forall a b. a -> b -> b
`seq` (a
a3,forall k a. Size -> k -> a -> Map k a -> Map k a -> Map k a
Bin Size
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 :: forall a k b c.
(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,forall k a. Map k a
Tip)
mapAccumRWithKey a -> k -> b -> (a, c)
f a
a (Bin Size
sx k
kx b
x Map k b
l Map k b
r) =
  let (a
a1,Map k c
r') = 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') = 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 c
x' seq :: forall a b. a -> b -> b
`seq` (a
a3,forall k a. Size -> k -> a -> Map k a -> Map k a -> Map k a
Bin Size
sx k
kx c
x' Map k c
l' Map k c
r')

-- | \(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 :: forall k2 a k1.
Ord k2 =>
(a -> a -> a) -> (k1 -> k2) -> Map k1 a -> Map k2 a
mapKeysWith a -> a -> a
c k1 -> k2
f = forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
fromListWith a -> a -> a
c forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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) forall a. a -> [a] -> [a]
: [(k2, a)]
xs) []
#if __GLASGOW_HASKELL__
{-# INLINABLE mapKeysWith #-}
#endif

{--------------------------------------------------------------------
  Conversions
--------------------------------------------------------------------}

-- | \(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 :: forall k a. (k -> a) -> Set k -> Map k a
fromSet k -> a
_ Set k
Set.Tip = forall k a. Map k a
Tip
fromSet k -> a
f (Set.Bin Size
sz k
x Set k
l Set k
r) = case k -> a
f k
x of a
v -> a
v seq :: forall a b. a -> b -> b
`seq` forall k a. Size -> k -> a -> Map k a -> Map k a -> Map k a
Bin Size
sz k
x a
v (forall k a. (k -> a) -> Set k -> Map k a
fromSet k -> a
f Set k
l) (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 :: forall k a. Set (Arg k a) -> Map k a
fromArgSet Set (Arg k a)
Set.Tip = forall k a. Map k a
Tip
fromArgSet (Set.Bin Size
sz (Arg k
x a
v) Set (Arg k a)
l Set (Arg k a)
r) = a
v seq :: forall a b. a -> b -> b
`seq` forall k a. Size -> k -> a -> Map k a -> Map k a -> Map k a
Bin Size
sz k
x a
v (forall k a. Set (Arg k a) -> Map k a
fromArgSet Set (Arg k a)
l) (forall k a. Set (Arg k a) -> Map k a
fromArgSet Set (Arg k a)
r)

{--------------------------------------------------------------------
  Lists
--------------------------------------------------------------------}
-- | \(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 :: forall k a. Ord k => [(k, a)] -> Map k a
fromList [] = forall k a. Map k a
Tip
fromList [(k
kx, a
x)] = a
x seq :: forall a b. a -> b -> b
`seq` forall k a. Size -> k -> a -> Map k a -> Map k a -> Map k a
Bin Size
1 k
kx a
x forall k a. Map k a
Tip forall k a. Map k a
Tip
fromList ((k
kx0, a
x0) : [(k, a)]
xs0) | forall {a} {b}. Ord a => a -> [(a, b)] -> Bool
not_ordered k
kx0 [(k, a)]
xs0 = a
x0 seq :: forall a b. a -> b -> b
`seq` forall {t :: * -> *} {k} {a}.
(Foldable t, Ord k) =>
Map k a -> t (k, a) -> Map k a
fromList' (forall k a. Size -> k -> a -> Map k a -> Map k a -> Map k a
Bin Size
1 k
kx0 a
x0 forall k a. Map k a
Tip forall k a. Map k a
Tip) [(k, a)]
xs0
                           | Bool
otherwise = a
x0 seq :: forall a b. a -> b -> b
`seq` forall {k} {t} {a}.
(Ord k, Num t, Bits t) =>
t -> Map k a -> [(k, a)] -> Map k a
go (Size
1::Int) (forall k a. Size -> k -> a -> Map k a -> Map k a -> Map k a
Bin Size
1 k
kx0 a
x0 forall k a. Map k a
Tip 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 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 = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Foldable.foldl' 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) = 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)] = a
x seq :: forall a b. a -> b -> b
`seq` 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) | forall {a} {b}. Ord a => a -> [(a, b)] -> Bool
not_ordered k
kx [(k, a)]
xss = 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 forall {t} {a} {a}.
(Num t, Ord a, Bits t) =>
t -> [(a, a)] -> (Map a a, [(a, a)], [(a, a)])
create t
s [(k, a)]
xss of
                                  (Map k a
r, [(k, a)]
ys, []) -> a
x seq :: forall a b. a -> b -> b
`seq` t -> Map k a -> [(k, a)] -> Map k a
go (t
s forall a. Bits a => a -> Size -> a
`shiftL` Size
1) (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) -> a
x seq :: forall a b. a -> b -> b
`seq` forall {t :: * -> *} {k} {a}.
(Foldable t, Ord k) =>
Map k a -> t (k, a) -> Map k a
fromList' (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 :: t -> [(a, a)] -> (Map a a, [(a, a)], [(a, a)])
create !t
_ [] = (forall k a. Map k a
Tip, [], [])
    create t
s xs :: [(a, a)]
xs@((a, a)
xp : [(a, a)]
xss)
      | t
s forall a. Eq a => a -> a -> Bool
== t
1 = case (a, a)
xp of (a
kx, a
x) | forall {a} {b}. Ord a => a -> [(a, b)] -> Bool
not_ordered a
kx [(a, a)]
xss -> a
x seq :: forall a b. a -> b -> b
`seq` (forall k a. Size -> k -> a -> Map k a -> Map k a -> Map k a
Bin Size
1 a
kx a
x forall k a. Map k a
Tip forall k a. Map k a
Tip, [], [(a, a)]
xss)
                                    | Bool
otherwise -> a
x seq :: forall a b. a -> b -> b
`seq` (forall k a. Size -> k -> a -> Map k a -> Map k a -> Map k a
Bin Size
1 a
kx a
x forall k a. Map k a
Tip forall k a. Map k a
Tip, [(a, a)]
xss, [])
      | Bool
otherwise = case t -> [(a, a)] -> (Map a a, [(a, a)], [(a, a)])
create (t
s forall a. Bits a => a -> Size -> a
`shiftR` Size
1) [(a, a)]
xs of
                      res :: (Map a a, [(a, a)], [(a, a)])
res@(Map a a
_, [], [(a, a)]
_) -> (Map a a, [(a, a)], [(a, a)])
res
                      (Map a a
l, [(a
ky, a
y)], [(a, a)]
zs) -> a
y seq :: forall a b. a -> b -> b
`seq` (forall k a. k -> a -> Map k a -> Map k a
insertMax a
ky a
y Map a a
l, [], [(a, a)]
zs)
                      (Map a a
l, ys :: [(a, a)]
ys@((a
ky, a
y):[(a, a)]
yss), [(a, a)]
_) | forall {a} {b}. Ord a => a -> [(a, b)] -> Bool
not_ordered a
ky [(a, a)]
yss -> (Map a a
l, [], [(a, a)]
ys)
                                               | Bool
otherwise -> case t -> [(a, a)] -> (Map a a, [(a, a)], [(a, a)])
create (t
s forall a. Bits a => a -> Size -> a
`shiftR` Size
1) [(a, a)]
yss of
                                                   (Map a a
r, [(a, a)]
zs, [(a, a)]
ws) -> a
y seq :: forall a b. a -> b -> b
`seq` (forall k a. k -> a -> Map k a -> Map k a -> Map k a
link a
ky a
y Map a a
l Map a a
r, [(a, a)]
zs, [(a, 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 :: forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
fromListWith a -> a -> a
f [(k, a)]
xs
  = 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 :: forall k a. Ord k => (k -> a -> a -> a) -> [(k, a)] -> Map k a
fromListWithKey k -> a -> a -> a
f [(k, a)]
xs
  = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Foldable.foldl' Map k a -> (k, a) -> Map k a
ins 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) = 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

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

  Note that if [xs] is ascending then:
    fromAscList xs       == fromList xs
    fromAscListWith f xs == fromListWith f xs

  If [xs] is descending then:
    fromDescList xs       == fromList xs
    fromDescListWith 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 :: forall k a. Eq k => [(k, a)] -> Map k a
fromAscList [(k, a)]
xs
  = forall k a. Eq k => (k -> a -> a -> a) -> [(k, a)] -> Map k a
fromAscListWithKey (\k
_ a
x a
_ -> a
x) [(k, a)]
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,"a")] == fromList [(3, "b"), (5, "b")]
-- > valid (fromDescList [(5,"a"), (5,"b"), (3,"b")]) == True
-- > valid (fromDescList [(5,"a"), (3,"b"), (5,"b")]) == False
fromDescList :: Eq k => [(k,a)] -> Map k a
fromDescList :: forall k a. Eq k => [(k, a)] -> Map k a
fromDescList [(k, a)]
xs
  = forall k a. Eq k => (k -> a -> a -> a) -> [(k, a)] -> Map k a
fromDescListWithKey (\k
_ a
x a
_ -> a
x) [(k, a)]
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 :: forall k a. Eq k => (a -> a -> a) -> [(k, a)] -> Map k a
fromAscListWith a -> a -> a
f [(k, a)]
xs
  = 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

fromDescListWith :: Eq k => (a -> a -> a) -> [(k,a)] -> Map k a
fromDescListWith :: forall k a. Eq k => (a -> a -> a) -> [(k, a)] -> Map k a
fromDescListWith a -> a -> a
f [(k, a)]
xs
  = 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 :: forall k a. Eq k => (k -> a -> a -> a) -> [(k, a)] -> Map k a
fromAscListWithKey k -> a -> a -> a
f [(k, a)]
xs
  = forall k a. [(k, a)] -> Map k a
fromDistinctAscList (forall {p}. p -> [(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 :: p -> [(k, a)] -> [(k, a)]
combineEq p
_ [(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
kxforall a. Eq a => a -> a -> Bool
==k
kz    = let yy :: a
yy = k -> a -> a -> a
f k
kx a
xx a
zz in a
yy seq :: forall a b. a -> b -> b
`seq` (k, a) -> [(k, a)] -> [(k, a)]
combineEq' (k
kx,a
yy) [(k, a)]
xs'
    | Bool
otherwise = (k, a)
zforall 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 :: forall k a. Eq k => (k -> a -> a -> a) -> [(k, a)] -> Map k a
fromDescListWithKey k -> a -> a -> a
f [(k, a)]
xs
  = forall k a. [(k, a)] -> Map k a
fromDistinctDescList (forall {p}. p -> [(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 :: p -> [(k, a)] -> [(k, a)]
combineEq p
_ [(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
kxforall a. Eq a => a -> a -> Bool
==k
kz    = let yy :: a
yy = k -> a -> a -> a
f k
kx a
xx a
zz in a
yy seq :: forall a b. a -> b -> b
`seq` (k, a) -> [(k, a)] -> [(k, a)]
combineEq' (k
kx,a
yy) [(k, a)]
xs'
    | Bool
otherwise = (k, a)
zforall 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 :: forall k a. [(k, a)] -> Map k a
fromDistinctAscList [] = forall k a. Map k a
Tip
fromDistinctAscList ((k
kx0, a
x0) : [(k, a)]
xs0) = a
x0 seq :: forall a b. a -> b -> b
`seq` forall {t} {k} {a}.
(Num t, Bits t) =>
t -> Map k a -> [(k, a)] -> Map k a
go (Size
1::Int) (forall k a. Size -> k -> a -> Map k a -> Map k a -> Map k a
Bin Size
1 k
kx0 a
x0 forall k a. Map k a
Tip 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 forall {t} {k} {a}.
(Num t, Bits t) =>
t -> [(k, a)] -> StrictPair (Map k a) [(k, a)]
create t
s [(k, a)]
xs of
        (Map k a
r :*: [(k, a)]
ys) -> a
x seq :: forall a b. a -> b -> b
`seq` let !t' :: Map k a
t' = 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 forall a. Bits a => a -> Size -> a
`shiftL` Size
1) Map k a
t' [(k, a)]
ys

    create :: t -> [(k, a)] -> StrictPair (Map k a) [(k, a)]
create !t
_ [] = (forall k a. Map k a
Tip forall a b. a -> b -> StrictPair a b
:*: [])
    create t
s xs :: [(k, a)]
xs@((k, a)
x' : [(k, a)]
xs')
      | t
s forall a. Eq a => a -> a -> Bool
== t
1 = case (k, a)
x' of (k
kx, a
x) -> a
x seq :: forall a b. a -> b -> b
`seq` (forall k a. Size -> k -> a -> Map k a -> Map k a -> Map k a
Bin Size
1 k
kx a
x forall k a. Map k a
Tip forall k a. Map k a
Tip forall a b. a -> b -> StrictPair a b
:*: [(k, a)]
xs')
      | Bool
otherwise = case t -> [(k, a)] -> StrictPair (Map k a) [(k, a)]
create (t
s forall a. Bits a => a -> Size -> a
`shiftR` Size
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 t -> [(k, a)] -> StrictPair (Map k a) [(k, a)]
create (t
s forall a. Bits a => a -> Size -> a
`shiftR` Size
1) [(k, a)]
ys of
                        (Map k a
r :*: [(k, a)]
zs) -> a
y seq :: forall a b. a -> b -> b
`seq` (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 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"), (3,"b"), (3,"a")]) == False

-- 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 :: forall k a. [(k, a)] -> Map k a
fromDistinctDescList [] = forall k a. Map k a
Tip
fromDistinctDescList ((k
kx0, a
x0) : [(k, a)]
xs0) = a
x0 seq :: forall a b. a -> b -> b
`seq` forall {t} {k} {a}.
(Num t, Bits t) =>
t -> Map k a -> [(k, a)] -> Map k a
go (Size
1::Int) (forall k a. Size -> k -> a -> Map k a -> Map k a -> Map k a
Bin Size
1 k
kx0 a
x0 forall k a. Map k a
Tip 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 forall {t} {k} {a}.
(Num t, Bits t) =>
t -> [(k, a)] -> StrictPair (Map k a) [(k, a)]
create t
s [(k, a)]
xs of
        (Map k a
l :*: [(k, a)]
ys) -> a
x seq :: forall a b. a -> b -> b
`seq` let !t' :: Map k a
t' = 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 forall a. Bits a => a -> Size -> a
`shiftL` Size
1) Map k a
t' [(k, a)]
ys

    create :: t -> [(k, a)] -> StrictPair (Map k a) [(k, a)]
create !t
_ [] = (forall k a. Map k a
Tip forall a b. a -> b -> StrictPair a b
:*: [])
    create t
s xs :: [(k, a)]
xs@((k, a)
x' : [(k, a)]
xs')
      | t
s forall a. Eq a => a -> a -> Bool
== t
1 = case (k, a)
x' of (k
kx, a
x) -> a
x seq :: forall a b. a -> b -> b
`seq` (forall k a. Size -> k -> a -> Map k a -> Map k a -> Map k a
Bin Size
1 k
kx a
x forall k a. Map k a
Tip forall k a. Map k a
Tip forall a b. a -> b -> StrictPair a b
:*: [(k, a)]
xs')
      | Bool
otherwise = case t -> [(k, a)] -> StrictPair (Map k a) [(k, a)]
create (t
s forall a. Bits a => a -> Size -> a
`shiftR` Size
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 t -> [(k, a)] -> StrictPair (Map k a) [(k, a)]
create (t
s forall a. Bits a => a -> Size -> a
`shiftR` Size
1) [(k, a)]
ys of
                        (Map k a
l :*: [(k, a)]
zs) -> a
y seq :: forall a b. a -> b -> b
`seq` (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 forall a b. a -> b -> StrictPair a b
:*: [(k, a)]
zs)