{-|
Description : Finite maps with parameterized key and value types
Copyright   : (c) Galois, Inc 2014-2019

This module defines finite maps where the key and value types are
parameterized by an arbitrary kind.

Some code was adapted from containers.
-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeInType #-}
module Data.Parameterized.Map
  ( MapF
    -- * Construction
  , Data.Parameterized.Map.empty
  , singleton
  , insert
  , insertWith
  , delete
  , union
  , intersectWithKeyMaybe
    -- * Query
  , null
  , lookup
  , findWithDefault
  , member
  , notMember
  , size
    -- * Conversion
  , keys
  , elems
  , fromList
  , toList
  , toAscList
  , toDescList
  , fromKeys
  , fromKeysM
   -- * Filter
  , filter
  , filterWithKey
  , filterGt
  , filterLt
    -- * Folds
  , foldlWithKey
  , foldlWithKey'
  , foldrWithKey
  , foldrWithKey'
  , foldMapWithKey
  , foldlMWithKey
  , foldrMWithKey
    -- * Traversals
  , map
  , mapWithKey
  , mapMaybe
  , mapMaybeWithKey
  , traverseWithKey
  , traverseWithKey_
  , traverseMaybeWithKey
    -- * Complex interface.
  , UpdateRequest(..)
  , Updated(..)
  , updatedValue
  , updateAtKey
  , mergeWithKey
  , mergeWithKeyM
  , module Data.Parameterized.Classes
    -- * Pair
  , Pair(..)
  ) where

import           Control.Applicative hiding (empty)
import           Control.Lens (Traversal', Lens')
import           Control.Monad.Identity
import           Data.Kind (Type)
import           Data.List (intercalate, foldl')
import           Data.Monoid
import           Prelude hiding (filter, lookup, map, traverse, null)

import           Data.Parameterized.Classes
import           Data.Parameterized.Some
import           Data.Parameterized.Pair ( Pair(..) )
import           Data.Parameterized.TraversableF
import           Data.Parameterized.Utils.BinTree
  ( MaybeS(..)
  , fromMaybeS
  , Updated(..)
  , updatedValue
  , TreeApp(..)
  , bin
  , IsBinTree(..)
  , balanceL
  , balanceR
  , glue
  )
import qualified Data.Parameterized.Utils.BinTree as Bin

------------------------------------------------------------------------
-- * Pair

comparePairKeys :: OrdF k => Pair k a -> Pair k a -> Ordering
comparePairKeys :: Pair k a -> Pair k a -> Ordering
comparePairKeys (Pair k tp
x a tp
_) (Pair k tp
y a tp
_) = OrderingF tp tp -> Ordering
forall k (x :: k) (y :: k). OrderingF x y -> Ordering
toOrdering (k tp -> k tp -> OrderingF tp tp
forall k (ktp :: k -> *) (x :: k) (y :: k).
OrdF ktp =>
ktp x -> ktp y -> OrderingF x y
compareF k tp
x k tp
y)
{-# INLINABLE comparePairKeys #-}

------------------------------------------------------------------------
-- MapF

-- | A map from parameterized keys to values with the same parameter type.
data MapF (k :: v -> Type) (a :: v -> Type) where
  Bin :: {-# UNPACK #-}
         !Size -- Number of elements in tree.
      -> !(k x)
      -> !(a x)
      -> !(MapF k a)
      -> !(MapF k a)
      -> MapF k a
  Tip :: MapF k a

type Size = Int

-- | Return empty map
empty :: MapF k a
empty :: MapF k a
empty = MapF k a
forall v (k :: v -> *) (a :: v -> *). MapF k a
Tip

-- | Return true if map is empty
null :: MapF k a -> Bool
null :: MapF k a -> Bool
null MapF k a
Tip = Bool
True
null Bin{} = Bool
False

-- | Return map containing a single element
singleton :: k tp -> a tp -> MapF k a
singleton :: k tp -> a tp -> MapF k a
singleton k tp
k a tp
x = Size -> k tp -> a tp -> MapF k a -> MapF k a -> MapF k a
forall v (k :: v -> *) (x :: v) (a :: v -> *).
Size -> k x -> a x -> MapF k a -> MapF k a -> MapF k a
Bin Size
1 k tp
k a tp
x MapF k a
forall v (k :: v -> *) (a :: v -> *). MapF k a
Tip MapF k a
forall v (k :: v -> *) (a :: v -> *). MapF k a
Tip

instance Bin.IsBinTree (MapF k a) (Pair k a) where
  asBin :: MapF k a -> TreeApp (Pair k a) (MapF k a)
asBin (Bin Size
_ k x
k a x
v MapF k a
l MapF k a
r) = Pair k a -> MapF k a -> MapF k a -> TreeApp (Pair k a) (MapF k a)
forall e t. e -> t -> t -> TreeApp e t
BinTree (k x -> a x -> Pair k a
forall k (a :: k -> *) (tp :: k) (b :: k -> *).
a tp -> b tp -> Pair a b
Pair k x
k a x
v) MapF k a
l MapF k a
r
  asBin MapF k a
Tip = TreeApp (Pair k a) (MapF k a)
forall e t. TreeApp e t
TipTree

  tip :: MapF k a
tip = MapF k a
forall v (k :: v -> *) (a :: v -> *). MapF k a
Tip
  bin :: Pair k a -> MapF k a -> MapF k a -> MapF k a
bin (Pair k tp
k a tp
v) MapF k a
l MapF k a
r = Size -> k tp -> a tp -> MapF k a -> MapF k a -> MapF k a
forall v (k :: v -> *) (x :: v) (a :: v -> *).
Size -> k x -> a x -> MapF k a -> MapF k a -> MapF k a
Bin (MapF k a -> Size
forall t e. IsBinTree t e => t -> Size
size MapF k a
l Size -> Size -> Size
forall a. Num a => a -> a -> a
+ MapF k a -> Size
forall t e. IsBinTree t e => t -> Size
size MapF k a
r Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Size
1) k tp
k a tp
v MapF k a
l MapF k a
r

  size :: MapF k a -> Size
size MapF k a
Tip              = Size
0
  size (Bin Size
sz k x
_ a x
_ MapF k a
_ MapF k a
_) = Size
sz

instance (TestEquality k, EqF a) => Eq (MapF k a) where
  MapF k a
x == :: MapF k a -> MapF k a -> Bool
== MapF k a
y = MapF k a -> Size
forall t e. IsBinTree t e => t -> Size
size MapF k a
x Size -> Size -> Bool
forall a. Eq a => a -> a -> Bool
== MapF k a -> Size
forall t e. IsBinTree t e => t -> Size
size MapF k a
y Bool -> Bool -> Bool
&& MapF k a -> [Pair k a]
forall k (k :: k -> *) (a :: k -> *). MapF k a -> [Pair k a]
toList MapF k a
x [Pair k a] -> [Pair k a] -> Bool
forall a. Eq a => a -> a -> Bool
== MapF k a -> [Pair k a]
forall k (k :: k -> *) (a :: k -> *). MapF k a -> [Pair k a]
toList MapF k a
y

------------------------------------------------------------------------
-- * Traversals

#ifdef __GLASGOW_HASKELL__
{-# NOINLINE [1] map #-}
{-# NOINLINE [1] traverse #-}
{-# RULES
"map/map" forall (f :: (forall tp . f tp -> g tp)) (g :: (forall tp . g tp -> h tp)) xs
               . map g (map f xs) = map (g . f) xs
"map/traverse" forall (f :: (forall tp . f tp -> m (g tp))) (g :: (forall tp . g tp -> h tp)) xs
               . fmap (map g) (traverse f xs) = traverse (\v -> g <$> f v) xs
"traverse/map"
  forall (f :: (forall tp . f tp -> g tp)) (g :: (forall tp . g tp -> m (h tp))) xs
       . traverse g (map f xs) = traverse (\v -> g (f v)) xs
"traverse/traverse"
  forall (f :: (forall tp . f tp -> m (g tp))) (g :: (forall tp . g tp -> m (h tp))) xs
       . traverse f xs >>= traverse g = traverse (\v -> f v >>= g) xs
 #-}
#endif

-- | Apply function to all elements in map.
mapWithKey
  :: (forall tp . ktp tp -> f tp -> g tp)
  -> MapF ktp f
  -> MapF ktp g
mapWithKey :: (forall (tp :: v). ktp tp -> f tp -> g tp)
-> MapF ktp f -> MapF ktp g
mapWithKey forall (tp :: v). ktp tp -> f tp -> g tp
_ MapF ktp f
Tip = MapF ktp g
forall v (k :: v -> *) (a :: v -> *). MapF k a
Tip
mapWithKey forall (tp :: v). ktp tp -> f tp -> g tp
f (Bin Size
sx ktp x
kx f x
x MapF ktp f
l MapF ktp f
r) = Size -> ktp x -> g x -> MapF ktp g -> MapF ktp g -> MapF ktp g
forall v (k :: v -> *) (x :: v) (a :: v -> *).
Size -> k x -> a x -> MapF k a -> MapF k a -> MapF k a
Bin Size
sx ktp x
kx (ktp x -> f x -> g x
forall (tp :: v). ktp tp -> f tp -> g tp
f ktp x
kx f x
x) ((forall (tp :: v). ktp tp -> f tp -> g tp)
-> MapF ktp f -> MapF ktp g
forall v (ktp :: v -> *) (f :: v -> *) (g :: v -> *).
(forall (tp :: v). ktp tp -> f tp -> g tp)
-> MapF ktp f -> MapF ktp g
mapWithKey forall (tp :: v). ktp tp -> f tp -> g tp
f MapF ktp f
l) ((forall (tp :: v). ktp tp -> f tp -> g tp)
-> MapF ktp f -> MapF ktp g
forall v (ktp :: v -> *) (f :: v -> *) (g :: v -> *).
(forall (tp :: v). ktp tp -> f tp -> g tp)
-> MapF ktp f -> MapF ktp g
mapWithKey forall (tp :: v). ktp tp -> f tp -> g tp
f MapF ktp f
r)

-- | Modify elements in a map
map :: (forall tp . f tp -> g tp) -> MapF ktp f -> MapF ktp g
map :: (forall (tp :: v). f tp -> g tp) -> MapF ktp f -> MapF ktp g
map forall (tp :: v). f tp -> g tp
f = (forall (tp :: v). ktp tp -> f tp -> g tp)
-> MapF ktp f -> MapF ktp g
forall v (ktp :: v -> *) (f :: v -> *) (g :: v -> *).
(forall (tp :: v). ktp tp -> f tp -> g tp)
-> MapF ktp f -> MapF ktp g
mapWithKey (\ktp tp
_ f tp
x -> f tp -> g tp
forall (tp :: v). f tp -> g tp
f f tp
x)

-- | Map keys and elements and collect `Just` results.
mapMaybeWithKey :: (forall tp . k tp -> f tp -> Maybe (g tp)) -> MapF k f -> MapF k g
mapMaybeWithKey :: (forall (tp :: v). k tp -> f tp -> Maybe (g tp))
-> MapF k f -> MapF k g
mapMaybeWithKey forall (tp :: v). k tp -> f tp -> Maybe (g tp)
_ MapF k f
Tip = MapF k g
forall v (k :: v -> *) (a :: v -> *). MapF k a
Tip
mapMaybeWithKey forall (tp :: v). k tp -> f tp -> Maybe (g tp)
f (Bin Size
_ k x
k f x
x MapF k f
l MapF k f
r) =
  case k x -> f x -> Maybe (g x)
forall (tp :: v). k tp -> f tp -> Maybe (g tp)
f k x
k f x
x of
    Just g x
y -> Pair k g -> MapF k g -> MapF k g -> MapF k g
forall c e. IsBinTree c e => e -> c -> c -> c
Bin.link (k x -> g x -> Pair k g
forall k (a :: k -> *) (tp :: k) (b :: k -> *).
a tp -> b tp -> Pair a b
Pair k x
k g x
y) ((forall (tp :: v). k tp -> f tp -> Maybe (g tp))
-> MapF k f -> MapF k g
forall v (k :: v -> *) (f :: v -> *) (g :: v -> *).
(forall (tp :: v). k tp -> f tp -> Maybe (g tp))
-> MapF k f -> MapF k g
mapMaybeWithKey forall (tp :: v). k tp -> f tp -> Maybe (g tp)
f MapF k f
l) ((forall (tp :: v). k tp -> f tp -> Maybe (g tp))
-> MapF k f -> MapF k g
forall v (k :: v -> *) (f :: v -> *) (g :: v -> *).
(forall (tp :: v). k tp -> f tp -> Maybe (g tp))
-> MapF k f -> MapF k g
mapMaybeWithKey forall (tp :: v). k tp -> f tp -> Maybe (g tp)
f MapF k f
r)
    Maybe (g x)
Nothing -> MapF k g -> MapF k g -> MapF k g
forall c e. IsBinTree c e => c -> c -> c
Bin.merge ((forall (tp :: v). k tp -> f tp -> Maybe (g tp))
-> MapF k f -> MapF k g
forall v (k :: v -> *) (f :: v -> *) (g :: v -> *).
(forall (tp :: v). k tp -> f tp -> Maybe (g tp))
-> MapF k f -> MapF k g
mapMaybeWithKey forall (tp :: v). k tp -> f tp -> Maybe (g tp)
f MapF k f
l) ((forall (tp :: v). k tp -> f tp -> Maybe (g tp))
-> MapF k f -> MapF k g
forall v (k :: v -> *) (f :: v -> *) (g :: v -> *).
(forall (tp :: v). k tp -> f tp -> Maybe (g tp))
-> MapF k f -> MapF k g
mapMaybeWithKey forall (tp :: v). k tp -> f tp -> Maybe (g tp)
f MapF k f
r)

-- | Map elements and collect `Just` results.
mapMaybe :: (forall tp . f tp -> Maybe (g tp)) -> MapF ktp f -> MapF ktp g
mapMaybe :: (forall (tp :: v). f tp -> Maybe (g tp))
-> MapF ktp f -> MapF ktp g
mapMaybe forall (tp :: v). f tp -> Maybe (g tp)
f = (forall (tp :: v). ktp tp -> f tp -> Maybe (g tp))
-> MapF ktp f -> MapF ktp g
forall v (k :: v -> *) (f :: v -> *) (g :: v -> *).
(forall (tp :: v). k tp -> f tp -> Maybe (g tp))
-> MapF k f -> MapF k g
mapMaybeWithKey (\ktp tp
_ f tp
x -> f tp -> Maybe (g tp)
forall (tp :: v). f tp -> Maybe (g tp)
f f tp
x)

-- | Traverse elements in a map
traverse :: Applicative m => (forall tp . f tp -> m (g tp)) -> MapF ktp f -> m (MapF ktp g)
traverse :: (forall (tp :: v). f tp -> m (g tp))
-> MapF ktp f -> m (MapF ktp g)
traverse forall (tp :: v). f tp -> m (g tp)
_ MapF ktp f
Tip = MapF ktp g -> m (MapF ktp g)
forall (f :: * -> *) a. Applicative f => a -> f a
pure MapF ktp g
forall v (k :: v -> *) (a :: v -> *). MapF k a
Tip
traverse forall (tp :: v). f tp -> m (g tp)
f (Bin Size
sx ktp x
kx f x
x MapF ktp f
l MapF ktp f
r) =
  (\MapF ktp g
l' g x
x' MapF ktp g
r' -> Size -> ktp x -> g x -> MapF ktp g -> MapF ktp g -> MapF ktp g
forall v (k :: v -> *) (x :: v) (a :: v -> *).
Size -> k x -> a x -> MapF k a -> MapF k a -> MapF k a
Bin Size
sx ktp x
kx g x
x' MapF ktp g
l' MapF ktp g
r') (MapF ktp g -> g x -> MapF ktp g -> MapF ktp g)
-> m (MapF ktp g) -> m (g x -> MapF ktp g -> MapF ktp g)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (tp :: v). f tp -> m (g tp))
-> MapF ktp f -> m (MapF ktp g)
forall v (m :: * -> *) (f :: v -> *) (g :: v -> *) (ktp :: v -> *).
Applicative m =>
(forall (tp :: v). f tp -> m (g tp))
-> MapF ktp f -> m (MapF ktp g)
traverse forall (tp :: v). f tp -> m (g tp)
f MapF ktp f
l m (g x -> MapF ktp g -> MapF ktp g)
-> m (g x) -> m (MapF ktp g -> MapF ktp g)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f x -> m (g x)
forall (tp :: v). f tp -> m (g tp)
f f x
x m (MapF ktp g -> MapF ktp g) -> m (MapF ktp g) -> m (MapF ktp g)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall (tp :: v). f tp -> m (g tp))
-> MapF ktp f -> m (MapF ktp g)
forall v (m :: * -> *) (f :: v -> *) (g :: v -> *) (ktp :: v -> *).
Applicative m =>
(forall (tp :: v). f tp -> m (g tp))
-> MapF ktp f -> m (MapF ktp g)
traverse forall (tp :: v). f tp -> m (g tp)
f MapF ktp f
r

-- | Traverse elements in a map
traverseWithKey
  :: Applicative m
  => (forall tp . ktp tp -> f tp -> m (g tp))
  -> MapF ktp f
  -> m (MapF ktp g)
traverseWithKey :: (forall (tp :: v). ktp tp -> f tp -> m (g tp))
-> MapF ktp f -> m (MapF ktp g)
traverseWithKey forall (tp :: v). ktp tp -> f tp -> m (g tp)
_ MapF ktp f
Tip = MapF ktp g -> m (MapF ktp g)
forall (f :: * -> *) a. Applicative f => a -> f a
pure MapF ktp g
forall v (k :: v -> *) (a :: v -> *). MapF k a
Tip
traverseWithKey forall (tp :: v). ktp tp -> f tp -> m (g tp)
f (Bin Size
sx ktp x
kx f x
x MapF ktp f
l MapF ktp f
r) =
   (\MapF ktp g
l' g x
x' MapF ktp g
r' -> Size -> ktp x -> g x -> MapF ktp g -> MapF ktp g -> MapF ktp g
forall v (k :: v -> *) (x :: v) (a :: v -> *).
Size -> k x -> a x -> MapF k a -> MapF k a -> MapF k a
Bin Size
sx ktp x
kx g x
x' MapF ktp g
l' MapF ktp g
r') (MapF ktp g -> g x -> MapF ktp g -> MapF ktp g)
-> m (MapF ktp g) -> m (g x -> MapF ktp g -> MapF ktp g)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (tp :: v). ktp tp -> f tp -> m (g tp))
-> MapF ktp f -> m (MapF ktp g)
forall v (m :: * -> *) (ktp :: v -> *) (f :: v -> *) (g :: v -> *).
Applicative m =>
(forall (tp :: v). ktp tp -> f tp -> m (g tp))
-> MapF ktp f -> m (MapF ktp g)
traverseWithKey forall (tp :: v). ktp tp -> f tp -> m (g tp)
f MapF ktp f
l m (g x -> MapF ktp g -> MapF ktp g)
-> m (g x) -> m (MapF ktp g -> MapF ktp g)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ktp x -> f x -> m (g x)
forall (tp :: v). ktp tp -> f tp -> m (g tp)
f ktp x
kx f x
x m (MapF ktp g -> MapF ktp g) -> m (MapF ktp g) -> m (MapF ktp g)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall (tp :: v). ktp tp -> f tp -> m (g tp))
-> MapF ktp f -> m (MapF ktp g)
forall v (m :: * -> *) (ktp :: v -> *) (f :: v -> *) (g :: v -> *).
Applicative m =>
(forall (tp :: v). ktp tp -> f tp -> m (g tp))
-> MapF ktp f -> m (MapF ktp g)
traverseWithKey forall (tp :: v). ktp tp -> f tp -> m (g tp)
f MapF ktp f
r

-- | Traverse elements in a map without returning result.
traverseWithKey_
  :: Applicative m
  => (forall tp . ktp tp -> f tp -> m ())
  -> MapF ktp f
  -> m ()
traverseWithKey_ :: (forall (tp :: v). ktp tp -> f tp -> m ()) -> MapF ktp f -> m ()
traverseWithKey_ = \forall (tp :: v). ktp tp -> f tp -> m ()
f -> (forall (s :: v). ktp s -> f s -> m () -> m ())
-> m () -> MapF ktp f -> m ()
forall v (k :: v -> *) (a :: v -> *) b.
(forall (s :: v). k s -> a s -> b -> b) -> b -> MapF k a -> b
foldrWithKey (\ktp s
k f s
v m ()
r -> ktp s -> f s -> m ()
forall (tp :: v). ktp tp -> f tp -> m ()
f ktp s
k f s
v m () -> m () -> m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m ()
r) (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
{-# INLINABLE traverseWithKey_ #-}

-- | Traverse keys\/values and collect the 'Just' results.
traverseMaybeWithKey :: Applicative f
                     => (forall tp . k tp -> a tp -> f (Maybe (b tp)))
                     -> MapF k a -> f (MapF k b)
traverseMaybeWithKey :: (forall (tp :: v). k tp -> a tp -> f (Maybe (b tp)))
-> MapF k a -> f (MapF k b)
traverseMaybeWithKey forall (tp :: v). k tp -> a tp -> f (Maybe (b tp))
_ MapF k a
Tip = MapF k b -> f (MapF k b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure MapF k b
forall v (k :: v -> *) (a :: v -> *). MapF k a
Tip
traverseMaybeWithKey forall (tp :: v). k tp -> a tp -> f (Maybe (b tp))
f (Bin Size
_ k x
kx a x
x MapF k a
Tip MapF k a
Tip) = MapF k b -> (b x -> MapF k b) -> Maybe (b x) -> MapF k b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe MapF k b
forall v (k :: v -> *) (a :: v -> *). MapF k a
Tip (\b x
x' -> Size -> k x -> b x -> MapF k b -> MapF k b -> MapF k b
forall v (k :: v -> *) (x :: v) (a :: v -> *).
Size -> k x -> a x -> MapF k a -> MapF k a -> MapF k a
Bin Size
1 k x
kx b x
x' MapF k b
forall v (k :: v -> *) (a :: v -> *). MapF k a
Tip MapF k b
forall v (k :: v -> *) (a :: v -> *). MapF k a
Tip) (Maybe (b x) -> MapF k b) -> f (Maybe (b x)) -> f (MapF k b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> k x -> a x -> f (Maybe (b x))
forall (tp :: v). k tp -> a tp -> f (Maybe (b tp))
f k x
kx a x
x
traverseMaybeWithKey forall (tp :: v). k tp -> a tp -> f (Maybe (b tp))
f (Bin Size
_ k x
kx a x
x MapF k a
l MapF k a
r) =
    (MapF k b -> Maybe (b x) -> MapF k b -> MapF k b)
-> f (MapF k b) -> f (Maybe (b x)) -> f (MapF k b) -> f (MapF k b)
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 MapF k b -> Maybe (b x) -> MapF k b -> MapF k b
combine ((forall (tp :: v). k tp -> a tp -> f (Maybe (b tp)))
-> MapF k a -> f (MapF k b)
forall v (f :: * -> *) (k :: v -> *) (a :: v -> *) (b :: v -> *).
Applicative f =>
(forall (tp :: v). k tp -> a tp -> f (Maybe (b tp)))
-> MapF k a -> f (MapF k b)
traverseMaybeWithKey forall (tp :: v). k tp -> a tp -> f (Maybe (b tp))
f MapF k a
l) (k x -> a x -> f (Maybe (b x))
forall (tp :: v). k tp -> a tp -> f (Maybe (b tp))
f k x
kx a x
x) ((forall (tp :: v). k tp -> a tp -> f (Maybe (b tp)))
-> MapF k a -> f (MapF k b)
forall v (f :: * -> *) (k :: v -> *) (a :: v -> *) (b :: v -> *).
Applicative f =>
(forall (tp :: v). k tp -> a tp -> f (Maybe (b tp)))
-> MapF k a -> f (MapF k b)
traverseMaybeWithKey forall (tp :: v). k tp -> a tp -> f (Maybe (b tp))
f MapF k a
r)
  where
    combine :: MapF k b -> Maybe (b x) -> MapF k b -> MapF k b
combine MapF k b
l' Maybe (b x)
mx MapF k b
r' = MapF k b -> MapF k b -> MapF k b
seq MapF k b
l' (MapF k b -> MapF k b) -> MapF k b -> MapF k b
forall a b. (a -> b) -> a -> b
$ MapF k b -> MapF k b -> MapF k b
seq MapF k b
r' (MapF k b -> MapF k b) -> MapF k b -> MapF k b
forall a b. (a -> b) -> a -> b
$
      case Maybe (b x)
mx of
        Just b x
x' -> Pair k b -> MapF k b -> MapF k b -> MapF k b
forall c e. IsBinTree c e => e -> c -> c -> c
Bin.link (k x -> b x -> Pair k b
forall k (a :: k -> *) (tp :: k) (b :: k -> *).
a tp -> b tp -> Pair a b
Pair k x
kx b x
x') MapF k b
l' MapF k b
r'
        Maybe (b x)
Nothing -> MapF k b -> MapF k b -> MapF k b
forall c e. IsBinTree c e => c -> c -> c
Bin.merge MapF k b
l' MapF k b
r'
{-# INLINABLE traverseMaybeWithKey #-}

type instance IndexF   (MapF k v) = k
type instance IxValueF (MapF k v) = v

-- | Turn a map key into a traversal that visits the indicated element in the map, if it exists.
instance forall a (k:: a -> Type) v. OrdF k => IxedF a (MapF k v) where
  ixF :: k x -> Traversal' (MapF k v) (v x)
  ixF :: k x -> Traversal' (MapF k v) (v x)
ixF k x
i v x -> f (v x)
f MapF k v
m = Updated (MapF k v) -> MapF k v
forall a. Updated a -> a
updatedValue (Updated (MapF k v) -> MapF k v)
-> f (Updated (MapF k v)) -> f (MapF k v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> k x
-> f (Maybe (v x))
-> (v x -> f (UpdateRequest (v x)))
-> MapF k v
-> f (Updated (MapF k v))
forall v (k :: v -> *) (f :: * -> *) (tp :: v) (a :: v -> *).
(OrdF k, Functor f) =>
k tp
-> f (Maybe (a tp))
-> (a tp -> f (UpdateRequest (a tp)))
-> MapF k a
-> f (Updated (MapF k a))
updateAtKey k x
i (Maybe (v x) -> f (Maybe (v x))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (v x)
forall a. Maybe a
Nothing) (\v x
x -> v x -> UpdateRequest (v x)
forall v. v -> UpdateRequest v
Set (v x -> UpdateRequest (v x)) -> f (v x) -> f (UpdateRequest (v x))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> v x -> f (v x)
f v x
x) MapF k v
m

-- | Turn a map key into a lens that points into the indicated position in the map.
instance forall a (k:: a -> Type) v. OrdF k => AtF a (MapF k v) where
  atF :: k x -> Lens' (MapF k v) (Maybe (v x))
  atF :: k x -> Lens' (MapF k v) (Maybe (v x))
atF k x
i Maybe (v x) -> f (Maybe (v x))
f MapF k v
m = Updated (MapF k v) -> MapF k v
forall a. Updated a -> a
updatedValue (Updated (MapF k v) -> MapF k v)
-> f (Updated (MapF k v)) -> f (MapF k v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> k x
-> f (Maybe (v x))
-> (v x -> f (UpdateRequest (v x)))
-> MapF k v
-> f (Updated (MapF k v))
forall v (k :: v -> *) (f :: * -> *) (tp :: v) (a :: v -> *).
(OrdF k, Functor f) =>
k tp
-> f (Maybe (a tp))
-> (a tp -> f (UpdateRequest (a tp)))
-> MapF k a
-> f (Updated (MapF k a))
updateAtKey k x
i (Maybe (v x) -> f (Maybe (v x))
f Maybe (v x)
forall a. Maybe a
Nothing) (\v x
x -> UpdateRequest (v x)
-> (v x -> UpdateRequest (v x))
-> Maybe (v x)
-> UpdateRequest (v x)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe UpdateRequest (v x)
forall v. UpdateRequest v
Delete v x -> UpdateRequest (v x)
forall v. v -> UpdateRequest v
Set (Maybe (v x) -> UpdateRequest (v x))
-> f (Maybe (v x)) -> f (UpdateRequest (v x))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (v x) -> f (Maybe (v x))
f (v x -> Maybe (v x)
forall a. a -> Maybe a
Just v x
x)) MapF k v
m


-- | Lookup value in map.
lookup :: OrdF k => k tp -> MapF k a -> Maybe (a tp)
lookup :: k tp -> MapF k a -> Maybe (a tp)
lookup k tp
k0 = k tp -> (MapF k a -> Maybe (a tp)) -> MapF k a -> Maybe (a tp)
seq k tp
k0 (k tp -> MapF k a -> Maybe (a tp)
forall v (k :: v -> *) (tp :: v) (a :: v -> *).
OrdF k =>
k tp -> MapF k a -> Maybe (a tp)
go k tp
k0)
  where
    go :: OrdF k => k tp -> MapF k a -> Maybe (a tp)
    go :: k tp -> MapF k a -> Maybe (a tp)
go k tp
_ MapF k a
Tip = Maybe (a tp)
forall a. Maybe a
Nothing
    go k tp
k (Bin Size
_ k x
kx a x
x MapF k a
l MapF k a
r) =
      case k tp -> k x -> OrderingF tp x
forall k (ktp :: k -> *) (x :: k) (y :: k).
OrdF ktp =>
ktp x -> ktp y -> OrderingF x y
compareF k tp
k k x
kx of
        OrderingF tp x
LTF -> k tp -> MapF k a -> Maybe (a tp)
forall v (k :: v -> *) (tp :: v) (a :: v -> *).
OrdF k =>
k tp -> MapF k a -> Maybe (a tp)
go k tp
k MapF k a
l
        OrderingF tp x
GTF -> k tp -> MapF k a -> Maybe (a tp)
forall v (k :: v -> *) (tp :: v) (a :: v -> *).
OrdF k =>
k tp -> MapF k a -> Maybe (a tp)
go k tp
k MapF k a
r
        OrderingF tp x
EQF -> a x -> Maybe (a x)
forall a. a -> Maybe a
Just a x
x
{-# INLINABLE lookup #-}

-- | @findWithDefault d k m@ returns the value bound to @k@ in the map @m@, or @d@
-- if @k@ is not bound in the map.
findWithDefault :: OrdF k => a tp -> k tp -> MapF k a -> a tp
findWithDefault :: a tp -> k tp -> MapF k a -> a tp
findWithDefault = \a tp
def k tp
k -> k tp -> (MapF k a -> a tp) -> MapF k a -> a tp
seq k tp
k (a tp -> k tp -> MapF k a -> a tp
forall v (k :: v -> *) (a :: v -> *) (tp :: v).
OrdF k =>
a tp -> k tp -> MapF k a -> a tp
go a tp
def k tp
k)
  where
    go :: OrdF k => a tp -> k tp -> MapF k a -> a tp
    go :: a tp -> k tp -> MapF k a -> a tp
go a tp
d k tp
_ MapF k a
Tip = a tp
d
    go a tp
d k tp
k (Bin Size
_ k x
kx a x
x MapF k a
l MapF k a
r) =
      case k tp -> k x -> OrderingF tp x
forall k (ktp :: k -> *) (x :: k) (y :: k).
OrdF ktp =>
ktp x -> ktp y -> OrderingF x y
compareF k tp
k k x
kx of
        OrderingF tp x
LTF -> a tp -> k tp -> MapF k a -> a tp
forall v (k :: v -> *) (a :: v -> *) (tp :: v).
OrdF k =>
a tp -> k tp -> MapF k a -> a tp
go a tp
d k tp
k MapF k a
l
        OrderingF tp x
GTF -> a tp -> k tp -> MapF k a -> a tp
forall v (k :: v -> *) (a :: v -> *) (tp :: v).
OrdF k =>
a tp -> k tp -> MapF k a -> a tp
go a tp
d k tp
k MapF k a
r
        OrderingF tp x
EQF -> a tp
a x
x
{-# INLINABLE findWithDefault #-}

-- | Return true if key is bound in map.
member :: OrdF k => k tp -> MapF k a -> Bool
member :: k tp -> MapF k a -> Bool
member k tp
k0 = k tp -> (MapF k a -> Bool) -> MapF k a -> Bool
seq k tp
k0 (k tp -> MapF k a -> Bool
forall v (k :: v -> *) (tp :: v) (a :: v -> *).
OrdF k =>
k tp -> MapF k a -> Bool
go k tp
k0)
  where
    go :: OrdF k => k tp -> MapF k a -> Bool
    go :: k tp -> MapF k a -> Bool
go k tp
_ MapF k a
Tip = Bool
False
    go k tp
k (Bin Size
_ k x
kx a x
_ MapF k a
l MapF k a
r) =
      case k tp -> k x -> OrderingF tp x
forall k (ktp :: k -> *) (x :: k) (y :: k).
OrdF ktp =>
ktp x -> ktp y -> OrderingF x y
compareF k tp
k k x
kx of
        OrderingF tp x
LTF -> k tp -> MapF k a -> Bool
forall v (k :: v -> *) (tp :: v) (a :: v -> *).
OrdF k =>
k tp -> MapF k a -> Bool
go k tp
k MapF k a
l
        OrderingF tp x
GTF -> k tp -> MapF k a -> Bool
forall v (k :: v -> *) (tp :: v) (a :: v -> *).
OrdF k =>
k tp -> MapF k a -> Bool
go k tp
k MapF k a
r
        OrderingF tp x
EQF -> Bool
True
{-# INLINABLE member #-}

-- | Return true if key is not bound in map.
notMember :: OrdF k => k tp -> MapF k a -> Bool
notMember :: k tp -> MapF k a -> Bool
notMember k tp
k MapF k a
m = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ k tp -> MapF k a -> Bool
forall v (k :: v -> *) (tp :: v) (a :: v -> *).
OrdF k =>
k tp -> MapF k a -> Bool
member k tp
k MapF k a
m
{-# INLINABLE notMember #-}

instance FunctorF (MapF ktp) where
  fmapF :: (forall (x :: k). f x -> g x) -> MapF ktp f -> MapF ktp g
fmapF = (forall (x :: k). f x -> g x) -> MapF ktp f -> MapF ktp g
forall v (f :: v -> *) (g :: v -> *) (ktp :: v -> *).
(forall (tp :: v). f tp -> g tp) -> MapF ktp f -> MapF ktp g
map

instance FoldableF (MapF ktp) where
  foldrF :: (forall (s :: k). e s -> b -> b) -> b -> MapF ktp e -> b
foldrF forall (s :: k). e s -> b -> b
f b
z = b -> MapF ktp e -> b
go b
z
    where go :: b -> MapF ktp e -> b
go b
z' MapF ktp e
Tip             = b
z'
          go b
z' (Bin Size
_ ktp x
_ e x
x MapF ktp e
l MapF ktp e
r) = b -> MapF ktp e -> b
go (e x -> b -> b
forall (s :: k). e s -> b -> b
f e x
x (b -> MapF ktp e -> b
go b
z' MapF ktp e
r)) MapF ktp e
l

instance TraversableF (MapF ktp) where
  traverseF :: (forall (s :: k). e s -> m (f s)) -> MapF ktp e -> m (MapF ktp f)
traverseF = (forall (s :: k). e s -> m (f s)) -> MapF ktp e -> m (MapF ktp f)
forall v (m :: * -> *) (f :: v -> *) (g :: v -> *) (ktp :: v -> *).
Applicative m =>
(forall (tp :: v). f tp -> m (g tp))
-> MapF ktp f -> m (MapF ktp g)
traverse

instance (ShowF ktp, ShowF rtp) => Show (MapF ktp rtp) where
  show :: MapF ktp rtp -> String
show MapF ktp rtp
m = (forall (tp :: v). ktp tp -> String)
-> (forall (tp :: v). rtp tp -> String) -> MapF ktp rtp -> String
forall v (ktp :: v -> *) (rtp :: v -> *).
(forall (tp :: v). ktp tp -> String)
-> (forall (tp :: v). rtp tp -> String) -> MapF ktp rtp -> String
showMap forall (tp :: v). ktp tp -> String
forall k (f :: k -> *) (tp :: k). ShowF f => f tp -> String
showF forall (tp :: v). rtp tp -> String
forall k (f :: k -> *) (tp :: k). ShowF f => f tp -> String
showF MapF ktp rtp
m

-- | Return all keys of the map in ascending order.
keys :: MapF k a -> [Some k]
keys :: MapF k a -> [Some k]
keys = (forall (s :: k). k s -> a s -> [Some k] -> [Some k])
-> [Some k] -> MapF k a -> [Some k]
forall v (k :: v -> *) (a :: v -> *) b.
(forall (s :: v). k s -> a s -> b -> b) -> b -> MapF k a -> b
foldrWithKey (\k s
k a s
_ [Some k]
l -> k s -> Some k
forall k (f :: k -> *) (x :: k). f x -> Some f
Some k s
k Some k -> [Some k] -> [Some k]
forall a. a -> [a] -> [a]
: [Some k]
l) []

-- | Return all elements of the map in the ascending order of their keys.
elems :: MapF k a -> [Some a]
elems :: MapF k a -> [Some a]
elems = (forall (s :: k). a s -> [Some a] -> [Some a])
-> [Some a] -> MapF k a -> [Some a]
forall k (t :: (k -> *) -> *) (e :: k -> *) b.
FoldableF t =>
(forall (s :: k). e s -> b -> b) -> b -> t e -> b
foldrF (\a s
e [Some a]
l -> a s -> Some a
forall k (f :: k -> *) (x :: k). f x -> Some f
Some a s
e Some a -> [Some a] -> [Some a]
forall a. a -> [a] -> [a]
: [Some a]
l) []

-- | Perform a left fold with the key also provided.
foldlWithKey :: (forall s . b -> k s -> a s -> b) -> b -> MapF k a -> b
foldlWithKey :: (forall (s :: v). b -> k s -> a s -> b) -> b -> MapF k a -> b
foldlWithKey forall (s :: v). b -> k s -> a s -> b
_ b
z MapF k a
Tip = b
z
foldlWithKey forall (s :: v). b -> k s -> a s -> b
f b
z (Bin Size
_ k x
kx a x
x MapF k a
l MapF k a
r) =
  let lz :: b
lz = (forall (s :: v). b -> k s -> a s -> b) -> b -> MapF k a -> b
forall v b (k :: v -> *) (a :: v -> *).
(forall (s :: v). b -> k s -> a s -> b) -> b -> MapF k a -> b
foldlWithKey forall (s :: v). b -> k s -> a s -> b
f b
z MapF k a
l
      kz :: b
kz = b -> k x -> a x -> b
forall (s :: v). b -> k s -> a s -> b
f b
lz k x
kx a x
x
   in (forall (s :: v). b -> k s -> a s -> b) -> b -> MapF k a -> b
forall v b (k :: v -> *) (a :: v -> *).
(forall (s :: v). b -> k s -> a s -> b) -> b -> MapF k a -> b
foldlWithKey forall (s :: v). b -> k s -> a s -> b
f b
kz MapF k a
r

-- | Perform a strict left fold with the key also provided.
foldlWithKey' :: (forall s . b -> k s -> a s -> b) -> b -> MapF k a -> b
foldlWithKey' :: (forall (s :: v). b -> k s -> a s -> b) -> b -> MapF k a -> b
foldlWithKey' forall (s :: v). b -> k s -> a s -> b
_ b
z MapF k a
Tip = b
z
foldlWithKey' forall (s :: v). b -> k s -> a s -> b
f b
z (Bin Size
_ k x
kx a x
x MapF k a
l MapF k a
r) =
  let lz :: b
lz = (forall (s :: v). b -> k s -> a s -> b) -> b -> MapF k a -> b
forall v b (k :: v -> *) (a :: v -> *).
(forall (s :: v). b -> k s -> a s -> b) -> b -> MapF k a -> b
foldlWithKey forall (s :: v). b -> k s -> a s -> b
f b
z MapF k a
l
      kz :: b
kz = b -> b -> b
seq b
lz (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$ b -> k x -> a x -> b
forall (s :: v). b -> k s -> a s -> b
f b
lz k x
kx a x
x
   in b -> b -> b
seq b
kz (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$ (forall (s :: v). b -> k s -> a s -> b) -> b -> MapF k a -> b
forall v b (k :: v -> *) (a :: v -> *).
(forall (s :: v). b -> k s -> a s -> b) -> b -> MapF k a -> b
foldlWithKey forall (s :: v). b -> k s -> a s -> b
f b
kz MapF k a
r

-- | Perform a right fold with the key also provided.
foldrWithKey :: (forall s . k s -> a s -> b -> b) -> b -> MapF k a -> b
foldrWithKey :: (forall (s :: v). k s -> a s -> b -> b) -> b -> MapF k a -> b
foldrWithKey forall (s :: v). k s -> a s -> b -> b
_ b
z MapF k a
Tip = b
z
foldrWithKey forall (s :: v). k s -> a s -> b -> b
f b
z (Bin Size
_ k x
kx a x
x MapF k a
l MapF k a
r) =
  (forall (s :: v). k s -> a s -> b -> b) -> b -> MapF k a -> b
forall v (k :: v -> *) (a :: v -> *) b.
(forall (s :: v). k s -> a s -> b -> b) -> b -> MapF k a -> b
foldrWithKey forall (s :: v). k s -> a s -> b -> b
f (k x -> a x -> b -> b
forall (s :: v). k s -> a s -> b -> b
f k x
kx a x
x ((forall (s :: v). k s -> a s -> b -> b) -> b -> MapF k a -> b
forall v (k :: v -> *) (a :: v -> *) b.
(forall (s :: v). k s -> a s -> b -> b) -> b -> MapF k a -> b
foldrWithKey forall (s :: v). k s -> a s -> b -> b
f b
z MapF k a
r)) MapF k a
l

-- | Perform a strict right fold with the key also provided.
foldrWithKey' :: (forall s . k s -> a s -> b -> b) -> b -> MapF k a -> b
foldrWithKey' :: (forall (s :: v). k s -> a s -> b -> b) -> b -> MapF k a -> b
foldrWithKey' forall (s :: v). k s -> a s -> b -> b
_ b
z MapF k a
Tip = b
z
foldrWithKey' forall (s :: v). k s -> a s -> b -> b
f b
z (Bin Size
_ k x
kx a x
x MapF k a
l MapF k a
r) =
  let rz :: b
rz = (forall (s :: v). k s -> a s -> b -> b) -> b -> MapF k a -> b
forall v (k :: v -> *) (a :: v -> *) b.
(forall (s :: v). k s -> a s -> b -> b) -> b -> MapF k a -> b
foldrWithKey forall (s :: v). k s -> a s -> b -> b
f b
z MapF k a
r
      kz :: b
kz = b -> b -> b
seq b
rz (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$ k x -> a x -> b -> b
forall (s :: v). k s -> a s -> b -> b
f k x
kx a x
x b
rz
   in b -> b -> b
seq b
kz (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$ (forall (s :: v). k s -> a s -> b -> b) -> b -> MapF k a -> b
forall v (k :: v -> *) (a :: v -> *) b.
(forall (s :: v). k s -> a s -> b -> b) -> b -> MapF k a -> b
foldrWithKey forall (s :: v). k s -> a s -> b -> b
f b
kz MapF k a
l

-- | Fold the keys and values using the given monoid.
foldMapWithKey :: Monoid m => (forall s . k s -> a s -> m) -> MapF k a -> m
foldMapWithKey :: (forall (s :: v). k s -> a s -> m) -> MapF k a -> m
foldMapWithKey forall (s :: v). k s -> a s -> m
_ MapF k a
Tip = m
forall a. Monoid a => a
mempty
foldMapWithKey forall (s :: v). k s -> a s -> m
f (Bin Size
_ k x
kx a x
x MapF k a
l MapF k a
r) = (forall (s :: v). k s -> a s -> m) -> MapF k a -> m
forall v m (k :: v -> *) (a :: v -> *).
Monoid m =>
(forall (s :: v). k s -> a s -> m) -> MapF k a -> m
foldMapWithKey forall (s :: v). k s -> a s -> m
f MapF k a
l m -> m -> m
forall a. Semigroup a => a -> a -> a
<> k x -> a x -> m
forall (s :: v). k s -> a s -> m
f k x
kx a x
x m -> m -> m
forall a. Semigroup a => a -> a -> a
<> (forall (s :: v). k s -> a s -> m) -> MapF k a -> m
forall v m (k :: v -> *) (a :: v -> *).
Monoid m =>
(forall (s :: v). k s -> a s -> m) -> MapF k a -> m
foldMapWithKey forall (s :: v). k s -> a s -> m
f MapF k a
r

-- | A monadic left-to-right fold over keys and values in the map.
foldlMWithKey :: Monad m => (forall s . b -> k s -> a s -> m b) -> b -> MapF k a -> m b
foldlMWithKey :: (forall (s :: v). b -> k s -> a s -> m b) -> b -> MapF k a -> m b
foldlMWithKey forall (s :: v). b -> k s -> a s -> m b
f b
z0 MapF k a
m = (forall (s :: v). k s -> a s -> (b -> m b) -> b -> m b)
-> (b -> m b) -> MapF k a -> b -> m b
forall v (k :: v -> *) (a :: v -> *) b.
(forall (s :: v). k s -> a s -> b -> b) -> b -> MapF k a -> b
foldrWithKey (\k s
k a s
a b -> m b
r b
z ->  b -> k s -> a s -> m b
forall (s :: v). b -> k s -> a s -> m b
f b
z k s
k a s
a m b -> (b -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= b -> m b
r) b -> m b
forall (f :: * -> *) a. Applicative f => a -> f a
pure MapF k a
m b
z0

-- | A monadic right-to-left fold over keys and values in the map.
foldrMWithKey :: Monad m => (forall s . k s -> a s -> b -> m b) -> b -> MapF k a -> m b
foldrMWithKey :: (forall (s :: v). k s -> a s -> b -> m b) -> b -> MapF k a -> m b
foldrMWithKey forall (s :: v). k s -> a s -> b -> m b
f b
z0 MapF k a
m = (forall (s :: v). (b -> m b) -> k s -> a s -> b -> m b)
-> (b -> m b) -> MapF k a -> b -> m b
forall v b (k :: v -> *) (a :: v -> *).
(forall (s :: v). b -> k s -> a s -> b) -> b -> MapF k a -> b
foldlWithKey (\b -> m b
r k s
k a s
a b
z ->  k s -> a s -> b -> m b
forall (s :: v). k s -> a s -> b -> m b
f k s
k a s
a b
z m b -> (b -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= b -> m b
r) b -> m b
forall (f :: * -> *) a. Applicative f => a -> f a
pure MapF k a
m b
z0

-- | Pretty print keys and values in map.
showMap :: (forall tp . ktp tp -> String)
        -> (forall tp . rtp tp -> String)
        -> MapF ktp rtp
        -> String
showMap :: (forall (tp :: v). ktp tp -> String)
-> (forall (tp :: v). rtp tp -> String) -> MapF ktp rtp -> String
showMap forall (tp :: v). ktp tp -> String
ppk forall (tp :: v). rtp tp -> String
ppv MapF ktp rtp
m = String
"{ " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " [String]
l String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" }"
  where l :: [String]
l = (forall (s :: v). ktp s -> rtp s -> [String] -> [String])
-> [String] -> MapF ktp rtp -> [String]
forall v (k :: v -> *) (a :: v -> *) b.
(forall (s :: v). k s -> a s -> b -> b) -> b -> MapF k a -> b
foldrWithKey (\ktp s
k rtp s
a [String]
l0 -> (ktp s -> String
forall (tp :: v). ktp tp -> String
ppk ktp s
k String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" -> " String -> ShowS
forall a. [a] -> [a] -> [a]
++ rtp s -> String
forall (tp :: v). rtp tp -> String
ppv rtp s
a) String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
l0) [] MapF ktp rtp
m

------------------------------------------------------------------------
-- filter

-- | Return entries with values that satisfy a predicate.
filter :: (forall tp . f tp -> Bool) -> MapF k f -> MapF k f
filter :: (forall (tp :: v). f tp -> Bool) -> MapF k f -> MapF k f
filter forall (tp :: v). f tp -> Bool
f = (forall (tp :: v). k tp -> f tp -> Bool) -> MapF k f -> MapF k f
forall v (k :: v -> *) (f :: v -> *).
(forall (tp :: v). k tp -> f tp -> Bool) -> MapF k f -> MapF k f
filterWithKey (\k tp
_ f tp
v -> f tp -> Bool
forall (tp :: v). f tp -> Bool
f f tp
v)

-- | Return key-value pairs that satisfy a predicate.
filterWithKey :: (forall tp . k tp -> f tp -> Bool) -> MapF k f -> MapF k f
filterWithKey :: (forall (tp :: v). k tp -> f tp -> Bool) -> MapF k f -> MapF k f
filterWithKey forall (tp :: v). k tp -> f tp -> Bool
_ MapF k f
Tip = MapF k f
forall v (k :: v -> *) (a :: v -> *). MapF k a
Tip
filterWithKey forall (tp :: v). k tp -> f tp -> Bool
f (Bin Size
_ k x
k f x
x MapF k f
l MapF k f
r)
  | k x -> f x -> Bool
forall (tp :: v). k tp -> f tp -> Bool
f k x
k f x
x     = Pair k f -> MapF k f -> MapF k f -> MapF k f
forall c e. IsBinTree c e => e -> c -> c -> c
Bin.link (k x -> f x -> Pair k f
forall k (a :: k -> *) (tp :: k) (b :: k -> *).
a tp -> b tp -> Pair a b
Pair k x
k f x
x) ((forall (tp :: v). k tp -> f tp -> Bool) -> MapF k f -> MapF k f
forall v (k :: v -> *) (f :: v -> *).
(forall (tp :: v). k tp -> f tp -> Bool) -> MapF k f -> MapF k f
filterWithKey forall (tp :: v). k tp -> f tp -> Bool
f MapF k f
l) ((forall (tp :: v). k tp -> f tp -> Bool) -> MapF k f -> MapF k f
forall v (k :: v -> *) (f :: v -> *).
(forall (tp :: v). k tp -> f tp -> Bool) -> MapF k f -> MapF k f
filterWithKey forall (tp :: v). k tp -> f tp -> Bool
f MapF k f
r)
  | Bool
otherwise = MapF k f -> MapF k f -> MapF k f
forall c e. IsBinTree c e => c -> c -> c
Bin.merge ((forall (tp :: v). k tp -> f tp -> Bool) -> MapF k f -> MapF k f
forall v (k :: v -> *) (f :: v -> *).
(forall (tp :: v). k tp -> f tp -> Bool) -> MapF k f -> MapF k f
filterWithKey forall (tp :: v). k tp -> f tp -> Bool
f MapF k f
l) ((forall (tp :: v). k tp -> f tp -> Bool) -> MapF k f -> MapF k f
forall v (k :: v -> *) (f :: v -> *).
(forall (tp :: v). k tp -> f tp -> Bool) -> MapF k f -> MapF k f
filterWithKey forall (tp :: v). k tp -> f tp -> Bool
f MapF k f
r)

compareKeyPair :: OrdF k => k tp -> Pair k a -> Ordering
compareKeyPair :: k tp -> Pair k a -> Ordering
compareKeyPair k tp
k = \(Pair k tp
x a tp
_) -> OrderingF tp tp -> Ordering
forall k (x :: k) (y :: k). OrderingF x y -> Ordering
toOrdering (k tp -> k tp -> OrderingF tp tp
forall k (ktp :: k -> *) (x :: k) (y :: k).
OrdF ktp =>
ktp x -> ktp y -> OrderingF x y
compareF k tp
k k tp
x)

-- | @filterGt k m@ returns submap of @m@ that only contains entries
-- that are larger than @k@.
filterGt :: OrdF k => k tp -> MapF k v -> MapF k v
filterGt :: k tp -> MapF k v -> MapF k v
filterGt k tp
k MapF k v
m = MapF k v -> MaybeS (MapF k v) -> MapF k v
forall a. a -> MaybeS a -> a
fromMaybeS MapF k v
m ((Pair k v -> Ordering) -> MapF k v -> MaybeS (MapF k v)
forall c e. IsBinTree c e => (e -> Ordering) -> c -> MaybeS c
Bin.filterGt (k tp -> Pair k v -> Ordering
forall k (k :: k -> *) (tp :: k) (a :: k -> *).
OrdF k =>
k tp -> Pair k a -> Ordering
compareKeyPair k tp
k) MapF k v
m)
{-# INLINABLE filterGt #-}

-- | @filterLt k m@ returns submap of @m@ that only contains entries
-- that are smaller than @k@.
filterLt :: OrdF k => k tp -> MapF k v -> MapF k v
filterLt :: k tp -> MapF k v -> MapF k v
filterLt k tp
k MapF k v
m = MapF k v -> MaybeS (MapF k v) -> MapF k v
forall a. a -> MaybeS a -> a
fromMaybeS MapF k v
m ((Pair k v -> Ordering) -> MapF k v -> MaybeS (MapF k v)
forall c e. IsBinTree c e => (e -> Ordering) -> c -> MaybeS c
Bin.filterLt (k tp -> Pair k v -> Ordering
forall k (k :: k -> *) (tp :: k) (a :: k -> *).
OrdF k =>
k tp -> Pair k a -> Ordering
compareKeyPair k tp
k) MapF k v
m)
{-# INLINABLE filterLt #-}

------------------------------------------------------------------------
-- User operations

-- | Insert a binding into the map, replacing the existing binding if needed.
insert :: OrdF k => k tp -> a tp -> MapF k a -> MapF k a
insert :: k tp -> a tp -> MapF k a -> MapF k a
insert = \k tp
k a tp
v MapF k a
m -> k tp -> MapF k a -> MapF k a
seq k tp
k (MapF k a -> MapF k a) -> MapF k a -> MapF k a
forall a b. (a -> b) -> a -> b
$ Updated (MapF k a) -> MapF k a
forall a. Updated a -> a
updatedValue ((Pair k a -> Pair k a -> Ordering)
-> Pair k a -> MapF k a -> Updated (MapF k a)
forall c e.
IsBinTree c e =>
(e -> e -> Ordering) -> e -> c -> Updated c
Bin.insert Pair k a -> Pair k a -> Ordering
forall k (k :: k -> *) (a :: k -> *).
OrdF k =>
Pair k a -> Pair k a -> Ordering
comparePairKeys (k tp -> a tp -> Pair k a
forall k (a :: k -> *) (tp :: k) (b :: k -> *).
a tp -> b tp -> Pair a b
Pair k tp
k a tp
v) MapF k a
m)
{-# INLINABLE insert #-}
-- {-# SPECIALIZE Bin.insert :: OrdF k => Pair k a -> MapF k a -> Updated (MapF k a) #-}

-- | Insert a binding into the map, replacing the existing binding if needed.
insertWithImpl :: OrdF k => (a tp -> a tp -> a tp) -> k tp -> a tp -> MapF k a -> Updated (MapF k a)
insertWithImpl :: (a tp -> a tp -> a tp)
-> k tp -> a tp -> MapF k a -> Updated (MapF k a)
insertWithImpl a tp -> a tp -> a tp
f k tp
k a tp
v MapF k a
t = k tp -> Updated (MapF k a) -> Updated (MapF k a)
seq k tp
k (Updated (MapF k a) -> Updated (MapF k a))
-> Updated (MapF k a) -> Updated (MapF k a)
forall a b. (a -> b) -> a -> b
$
  case MapF k a
t of
    MapF k a
Tip -> MapF k a -> Updated (MapF k a)
forall a. a -> Updated a
Bin.Updated (Size -> k tp -> a tp -> MapF k a -> MapF k a -> MapF k a
forall v (k :: v -> *) (x :: v) (a :: v -> *).
Size -> k x -> a x -> MapF k a -> MapF k a -> MapF k a
Bin Size
1 k tp
k a tp
v MapF k a
forall v (k :: v -> *) (a :: v -> *). MapF k a
Tip MapF k a
forall v (k :: v -> *) (a :: v -> *). MapF k a
Tip)
    Bin Size
sz k x
yk a x
yv MapF k a
l MapF k a
r ->
      case k tp -> k x -> OrderingF tp x
forall k (ktp :: k -> *) (x :: k) (y :: k).
OrdF ktp =>
ktp x -> ktp y -> OrderingF x y
compareF k tp
k k x
yk of
        OrderingF tp x
LTF ->
          case (a tp -> a tp -> a tp)
-> k tp -> a tp -> MapF k a -> Updated (MapF k a)
forall v (k :: v -> *) (a :: v -> *) (tp :: v).
OrdF k =>
(a tp -> a tp -> a tp)
-> k tp -> a tp -> MapF k a -> Updated (MapF k a)
insertWithImpl a tp -> a tp -> a tp
f k tp
k a tp
v MapF k a
l of
            Bin.Updated MapF k a
l'   -> MapF k a -> Updated (MapF k a)
forall a. a -> Updated a
Bin.Updated   (Pair k a -> MapF k a -> MapF k a -> MapF k a
forall c e. IsBinTree c e => e -> c -> c -> c
Bin.balanceL (k x -> a x -> Pair k a
forall k (a :: k -> *) (tp :: k) (b :: k -> *).
a tp -> b tp -> Pair a b
Pair k x
yk a x
yv) MapF k a
l' MapF k a
r)
            Bin.Unchanged MapF k a
l' -> MapF k a -> Updated (MapF k a)
forall a. a -> Updated a
Bin.Unchanged (Size -> k x -> a x -> MapF k a -> MapF k a -> MapF k a
forall v (k :: v -> *) (x :: v) (a :: v -> *).
Size -> k x -> a x -> MapF k a -> MapF k a -> MapF k a
Bin Size
sz k x
yk a x
yv MapF k a
l' MapF k a
r)
        OrderingF tp x
GTF ->
          case (a tp -> a tp -> a tp)
-> k tp -> a tp -> MapF k a -> Updated (MapF k a)
forall v (k :: v -> *) (a :: v -> *) (tp :: v).
OrdF k =>
(a tp -> a tp -> a tp)
-> k tp -> a tp -> MapF k a -> Updated (MapF k a)
insertWithImpl a tp -> a tp -> a tp
f k tp
k a tp
v MapF k a
r of
            Bin.Updated MapF k a
r'   -> MapF k a -> Updated (MapF k a)
forall a. a -> Updated a
Bin.Updated   (Pair k a -> MapF k a -> MapF k a -> MapF k a
forall c e. IsBinTree c e => e -> c -> c -> c
Bin.balanceR (k x -> a x -> Pair k a
forall k (a :: k -> *) (tp :: k) (b :: k -> *).
a tp -> b tp -> Pair a b
Pair k x
yk a x
yv) MapF k a
l MapF k a
r')
            Bin.Unchanged MapF k a
r' -> MapF k a -> Updated (MapF k a)
forall a. a -> Updated a
Bin.Unchanged (Size -> k x -> a x -> MapF k a -> MapF k a -> MapF k a
forall v (k :: v -> *) (x :: v) (a :: v -> *).
Size -> k x -> a x -> MapF k a -> MapF k a -> MapF k a
Bin Size
sz k x
yk a x
yv MapF k a
l MapF k a
r')
        OrderingF tp x
EQF -> MapF k a -> Updated (MapF k a)
forall a. a -> Updated a
Bin.Unchanged (Size -> k x -> a x -> MapF k a -> MapF k a -> MapF k a
forall v (k :: v -> *) (x :: v) (a :: v -> *).
Size -> k x -> a x -> MapF k a -> MapF k a -> MapF k a
Bin Size
sz k x
yk (a tp -> a tp -> a tp
f a tp
v a tp
a x
yv) MapF k a
l MapF k a
r)
{-# INLINABLE insertWithImpl #-}

-- | @insertWith f new m@ inserts the binding into @m@.
--
-- It inserts @f new old@ if @m@ already contains an equivalent value
-- @old@, and @new@ otherwise.  It returns an 'Unchanged' value if the
-- map stays the same size and an 'Updated' value if a new entry was
-- inserted.
insertWith :: OrdF k => (a tp -> a tp -> a tp) -> k tp -> a tp -> MapF k a -> MapF k a
insertWith :: (a tp -> a tp -> a tp) -> k tp -> a tp -> MapF k a -> MapF k a
insertWith = \a tp -> a tp -> a tp
f k tp
k a tp
v MapF k a
t -> k tp -> MapF k a -> MapF k a
seq k tp
k (MapF k a -> MapF k a) -> MapF k a -> MapF k a
forall a b. (a -> b) -> a -> b
$ Updated (MapF k a) -> MapF k a
forall a. Updated a -> a
updatedValue ((a tp -> a tp -> a tp)
-> k tp -> a tp -> MapF k a -> Updated (MapF k a)
forall v (k :: v -> *) (a :: v -> *) (tp :: v).
OrdF k =>
(a tp -> a tp -> a tp)
-> k tp -> a tp -> MapF k a -> Updated (MapF k a)
insertWithImpl a tp -> a tp -> a tp
f k tp
k a tp
v MapF k a
t)
{-# INLINABLE insertWith #-}

-- | Delete a value from the map if present.
delete :: OrdF k => k tp -> MapF k a -> MapF k a
delete :: k tp -> MapF k a -> MapF k a
delete = \k tp
k MapF k a
m -> k tp -> MapF k a -> MapF k a
seq k tp
k (MapF k a -> MapF k a) -> MapF k a -> MapF k a
forall a b. (a -> b) -> a -> b
$ MapF k a -> MaybeS (MapF k a) -> MapF k a
forall a. a -> MaybeS a -> a
fromMaybeS MapF k a
m (MaybeS (MapF k a) -> MapF k a) -> MaybeS (MapF k a) -> MapF k a
forall a b. (a -> b) -> a -> b
$ (Pair k a -> Ordering) -> MapF k a -> MaybeS (MapF k a)
forall c e. IsBinTree c e => (e -> Ordering) -> c -> MaybeS c
Bin.delete (k tp -> Pair k a -> Ordering
forall k (k :: k -> *) (tp :: k) (a :: k -> *).
OrdF k =>
k tp -> Pair k a -> Ordering
p k tp
k) MapF k a
m
  where p :: OrdF k => k tp -> Pair k a -> Ordering
        p :: k tp -> Pair k a -> Ordering
p k tp
k (Pair k tp
kx a tp
_) = OrderingF tp tp -> Ordering
forall k (x :: k) (y :: k). OrderingF x y -> Ordering
toOrdering (k tp -> k tp -> OrderingF tp tp
forall k (ktp :: k -> *) (x :: k) (y :: k).
OrdF ktp =>
ktp x -> ktp y -> OrderingF x y
compareF k tp
k k tp
kx)
{-# INLINABLE delete #-}
{-# SPECIALIZE Bin.delete :: (Pair k a -> Ordering) -> MapF k a -> MaybeS (MapF k a) #-}

-- | Left-biased union of two maps. The resulting map will contain the
-- union of the keys of the two arguments. When a key is contained in
-- both maps the value from the first map will be preserved.
union :: OrdF k => MapF k a -> MapF k a -> MapF k a
union :: MapF k a -> MapF k a -> MapF k a
union MapF k a
t1 MapF k a
t2 = (Pair k a -> Pair k a -> Ordering)
-> MapF k a -> MapF k a -> MapF k a
forall c e. IsBinTree c e => (e -> e -> Ordering) -> c -> c -> c
Bin.union Pair k a -> Pair k a -> Ordering
forall k (k :: k -> *) (a :: k -> *).
OrdF k =>
Pair k a -> Pair k a -> Ordering
comparePairKeys MapF k a
t1 MapF k a
t2
{-# INLINABLE union #-}
-- {-# SPECIALIZE Bin.union compare :: OrdF k => MapF k a -> MapF k a -> MapF k a #-}

------------------------------------------------------------------------
-- updateAtKey

-- | 'UpdateRequest' tells what to do with a found value
data UpdateRequest v
   = -- | Keep the current value.
     Keep
     -- | Set the value to a new value.
   | Set !v
     -- | Delete a value.
   | Delete

data AtKeyResult k a where
  AtKeyUnchanged :: AtKeyResult k a
  AtKeyInserted :: MapF k a -> AtKeyResult k a
  AtKeyModified :: MapF k a -> AtKeyResult k a
  AtKeyDeleted  :: MapF k a -> AtKeyResult k a

atKey' :: (OrdF k, Functor f)
       => k tp
       -> f (Maybe (a tp)) -- ^ Function to call if no element is found.
       -> (a tp -> f (UpdateRequest (a tp)))
       -> MapF k a
       -> f (AtKeyResult k a)
atKey' :: k tp
-> f (Maybe (a tp))
-> (a tp -> f (UpdateRequest (a tp)))
-> MapF k a
-> f (AtKeyResult k a)
atKey' k tp
k f (Maybe (a tp))
onNotFound a tp -> f (UpdateRequest (a tp))
onFound MapF k a
t =
  case MapF k a -> TreeApp (Pair k a) (MapF k a)
forall t e. IsBinTree t e => t -> TreeApp e t
asBin MapF k a
t of
    TreeApp (Pair k a) (MapF k a)
TipTree -> Maybe (a tp) -> AtKeyResult k a
ins (Maybe (a tp) -> AtKeyResult k a)
-> f (Maybe (a tp)) -> f (AtKeyResult k a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (Maybe (a tp))
onNotFound
      where ins :: Maybe (a tp) -> AtKeyResult k a
ins Maybe (a tp)
Nothing  = AtKeyResult k a
forall v (k :: v -> *) (a :: v -> *). AtKeyResult k a
AtKeyUnchanged
            ins (Just a tp
v) = MapF k a -> AtKeyResult k a
forall v (k :: v -> *) (a :: v -> *). MapF k a -> AtKeyResult k a
AtKeyInserted (k tp -> a tp -> MapF k a
forall v (k :: v -> *) (tp :: v) (a :: v -> *).
k tp -> a tp -> MapF k a
singleton k tp
k a tp
v)
    BinTree yp :: Pair k a
yp@(Pair k tp
kx a tp
y) MapF k a
l MapF k a
r ->
      case k tp -> k tp -> OrderingF tp tp
forall k (ktp :: k -> *) (x :: k) (y :: k).
OrdF ktp =>
ktp x -> ktp y -> OrderingF x y
compareF k tp
k k tp
kx of
        OrderingF tp tp
LTF -> AtKeyResult k a -> AtKeyResult k a
ins (AtKeyResult k a -> AtKeyResult k a)
-> f (AtKeyResult k a) -> f (AtKeyResult k a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> k tp
-> f (Maybe (a tp))
-> (a tp -> f (UpdateRequest (a tp)))
-> MapF k a
-> f (AtKeyResult k a)
forall v (k :: v -> *) (f :: * -> *) (tp :: v) (a :: v -> *).
(OrdF k, Functor f) =>
k tp
-> f (Maybe (a tp))
-> (a tp -> f (UpdateRequest (a tp)))
-> MapF k a
-> f (AtKeyResult k a)
atKey' k tp
k f (Maybe (a tp))
onNotFound a tp -> f (UpdateRequest (a tp))
onFound MapF k a
l
          where ins :: AtKeyResult k a -> AtKeyResult k a
ins AtKeyResult k a
AtKeyUnchanged = AtKeyResult k a
forall v (k :: v -> *) (a :: v -> *). AtKeyResult k a
AtKeyUnchanged
                ins (AtKeyInserted MapF k a
l') = MapF k a -> AtKeyResult k a
forall v (k :: v -> *) (a :: v -> *). MapF k a -> AtKeyResult k a
AtKeyInserted (Pair k a -> MapF k a -> MapF k a -> MapF k a
forall c e. IsBinTree c e => e -> c -> c -> c
balanceL Pair k a
yp MapF k a
l' MapF k a
r)
                ins (AtKeyModified MapF k a
l') = MapF k a -> AtKeyResult k a
forall v (k :: v -> *) (a :: v -> *). MapF k a -> AtKeyResult k a
AtKeyModified (Pair k a -> MapF k a -> MapF k a -> MapF k a
forall c e. IsBinTree c e => e -> c -> c -> c
bin      Pair k a
yp MapF k a
l' MapF k a
r)
                ins (AtKeyDeleted  MapF k a
l') = MapF k a -> AtKeyResult k a
forall v (k :: v -> *) (a :: v -> *). MapF k a -> AtKeyResult k a
AtKeyDeleted  (Pair k a -> MapF k a -> MapF k a -> MapF k a
forall c e. IsBinTree c e => e -> c -> c -> c
balanceR Pair k a
yp MapF k a
l' MapF k a
r)
        OrderingF tp tp
GTF -> AtKeyResult k a -> AtKeyResult k a
ins (AtKeyResult k a -> AtKeyResult k a)
-> f (AtKeyResult k a) -> f (AtKeyResult k a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> k tp
-> f (Maybe (a tp))
-> (a tp -> f (UpdateRequest (a tp)))
-> MapF k a
-> f (AtKeyResult k a)
forall v (k :: v -> *) (f :: * -> *) (tp :: v) (a :: v -> *).
(OrdF k, Functor f) =>
k tp
-> f (Maybe (a tp))
-> (a tp -> f (UpdateRequest (a tp)))
-> MapF k a
-> f (AtKeyResult k a)
atKey' k tp
k f (Maybe (a tp))
onNotFound a tp -> f (UpdateRequest (a tp))
onFound MapF k a
r
          where ins :: AtKeyResult k a -> AtKeyResult k a
ins AtKeyResult k a
AtKeyUnchanged = AtKeyResult k a
forall v (k :: v -> *) (a :: v -> *). AtKeyResult k a
AtKeyUnchanged
                ins (AtKeyInserted MapF k a
r') = MapF k a -> AtKeyResult k a
forall v (k :: v -> *) (a :: v -> *). MapF k a -> AtKeyResult k a
AtKeyInserted (Pair k a -> MapF k a -> MapF k a -> MapF k a
forall c e. IsBinTree c e => e -> c -> c -> c
balanceR Pair k a
yp MapF k a
l MapF k a
r')
                ins (AtKeyModified MapF k a
r') = MapF k a -> AtKeyResult k a
forall v (k :: v -> *) (a :: v -> *). MapF k a -> AtKeyResult k a
AtKeyModified (Pair k a -> MapF k a -> MapF k a -> MapF k a
forall c e. IsBinTree c e => e -> c -> c -> c
bin      Pair k a
yp MapF k a
l MapF k a
r')
                ins (AtKeyDeleted  MapF k a
r') = MapF k a -> AtKeyResult k a
forall v (k :: v -> *) (a :: v -> *). MapF k a -> AtKeyResult k a
AtKeyDeleted  (Pair k a -> MapF k a -> MapF k a -> MapF k a
forall c e. IsBinTree c e => e -> c -> c -> c
balanceL Pair k a
yp MapF k a
l MapF k a
r')
        OrderingF tp tp
EQF -> UpdateRequest (a tp) -> AtKeyResult k a
ins (UpdateRequest (a tp) -> AtKeyResult k a)
-> f (UpdateRequest (a tp)) -> f (AtKeyResult k a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a tp -> f (UpdateRequest (a tp))
onFound a tp
a tp
y
          where ins :: UpdateRequest (a tp) -> AtKeyResult k a
ins UpdateRequest (a tp)
Keep    = AtKeyResult k a
forall v (k :: v -> *) (a :: v -> *). AtKeyResult k a
AtKeyUnchanged
                ins (Set a tp
x) = MapF k a -> AtKeyResult k a
forall v (k :: v -> *) (a :: v -> *). MapF k a -> AtKeyResult k a
AtKeyModified (Pair k a -> MapF k a -> MapF k a -> MapF k a
forall c e. IsBinTree c e => e -> c -> c -> c
bin (k tp -> a tp -> Pair k a
forall k (a :: k -> *) (tp :: k) (b :: k -> *).
a tp -> b tp -> Pair a b
Pair k tp
kx a tp
x) MapF k a
l MapF k a
r)
                ins UpdateRequest (a tp)
Delete  = MapF k a -> AtKeyResult k a
forall v (k :: v -> *) (a :: v -> *). MapF k a -> AtKeyResult k a
AtKeyDeleted (MapF k a -> MapF k a -> MapF k a
forall c e. IsBinTree c e => c -> c -> c
glue MapF k a
l MapF k a
r)
{-# INLINABLE atKey' #-}

-- | Log-time algorithm that allows a value at a specific key to be added, replaced,
-- or deleted.
updateAtKey :: (OrdF k, Functor f)
            => k tp -- ^ Key to update
            -> f (Maybe (a tp))
               -- ^ Action to call if nothing is found
            -> (a tp -> f (UpdateRequest (a tp)))
               -- ^ Action to call if value is found.
            -> MapF k a
               -- ^ Map to update
            -> f (Updated (MapF k a))
updateAtKey :: k tp
-> f (Maybe (a tp))
-> (a tp -> f (UpdateRequest (a tp)))
-> MapF k a
-> f (Updated (MapF k a))
updateAtKey k tp
k f (Maybe (a tp))
onNotFound a tp -> f (UpdateRequest (a tp))
onFound MapF k a
t = AtKeyResult k a -> Updated (MapF k a)
ins (AtKeyResult k a -> Updated (MapF k a))
-> f (AtKeyResult k a) -> f (Updated (MapF k a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> k tp
-> f (Maybe (a tp))
-> (a tp -> f (UpdateRequest (a tp)))
-> MapF k a
-> f (AtKeyResult k a)
forall v (k :: v -> *) (f :: * -> *) (tp :: v) (a :: v -> *).
(OrdF k, Functor f) =>
k tp
-> f (Maybe (a tp))
-> (a tp -> f (UpdateRequest (a tp)))
-> MapF k a
-> f (AtKeyResult k a)
atKey' k tp
k f (Maybe (a tp))
onNotFound a tp -> f (UpdateRequest (a tp))
onFound MapF k a
t
  where ins :: AtKeyResult k a -> Updated (MapF k a)
ins AtKeyResult k a
AtKeyUnchanged = MapF k a -> Updated (MapF k a)
forall a. a -> Updated a
Unchanged MapF k a
t
        ins (AtKeyInserted MapF k a
t') = MapF k a -> Updated (MapF k a)
forall a. a -> Updated a
Updated MapF k a
t'
        ins (AtKeyModified MapF k a
t') = MapF k a -> Updated (MapF k a)
forall a. a -> Updated a
Updated MapF k a
t'
        ins (AtKeyDeleted  MapF k a
t') = MapF k a -> Updated (MapF k a)
forall a. a -> Updated a
Updated MapF k a
t'
{-# INLINABLE updateAtKey #-}

-- | Create a Map from a list of pairs.
fromList :: OrdF k => [Pair k a] -> MapF k a
fromList :: [Pair k a] -> MapF k a
fromList = (MapF k a -> Pair k a -> MapF k a)
-> MapF k a -> [Pair k a] -> MapF k a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\MapF k a
m (Pair k tp
k a tp
a) -> k tp -> a tp -> MapF k a -> MapF k a
forall v (k :: v -> *) (tp :: v) (a :: v -> *).
OrdF k =>
k tp -> a tp -> MapF k a -> MapF k a
insert k tp
k a tp
a MapF k a
m) MapF k a
forall v (k :: v -> *) (a :: v -> *). MapF k a
Data.Parameterized.Map.empty

-- | Return list of key-values pairs in map in ascending order.
toAscList :: MapF k a -> [Pair k a]
toAscList :: MapF k a -> [Pair k a]
toAscList = (forall (s :: k). k s -> a s -> [Pair k a] -> [Pair k a])
-> [Pair k a] -> MapF k a -> [Pair k a]
forall v (k :: v -> *) (a :: v -> *) b.
(forall (s :: v). k s -> a s -> b -> b) -> b -> MapF k a -> b
foldrWithKey (\k s
k a s
x [Pair k a]
l -> k s -> a s -> Pair k a
forall k (a :: k -> *) (tp :: k) (b :: k -> *).
a tp -> b tp -> Pair a b
Pair k s
k a s
x Pair k a -> [Pair k a] -> [Pair k a]
forall a. a -> [a] -> [a]
: [Pair k a]
l) []

-- | Return list of key-values pairs in map in descending order.
toDescList :: MapF k a -> [Pair k a]
toDescList :: MapF k a -> [Pair k a]
toDescList = (forall (s :: k). [Pair k a] -> k s -> a s -> [Pair k a])
-> [Pair k a] -> MapF k a -> [Pair k a]
forall v b (k :: v -> *) (a :: v -> *).
(forall (s :: v). b -> k s -> a s -> b) -> b -> MapF k a -> b
foldlWithKey (\[Pair k a]
l k s
k a s
x -> k s -> a s -> Pair k a
forall k (a :: k -> *) (tp :: k) (b :: k -> *).
a tp -> b tp -> Pair a b
Pair k s
k a s
x Pair k a -> [Pair k a] -> [Pair k a]
forall a. a -> [a] -> [a]
: [Pair k a]
l) []

-- | Return list of key-values pairs in map.
toList :: MapF k a -> [Pair k a]
toList :: MapF k a -> [Pair k a]
toList = MapF k a -> [Pair k a]
forall k (k :: k -> *) (a :: k -> *). MapF k a -> [Pair k a]
toAscList

-- | Generate a map from a foldable collection of keys and a
-- function from keys to values.
fromKeys :: forall k m (t :: Type -> Type) (a :: k -> Type) (v :: k -> Type)
          .  (Monad m, Foldable t, OrdF a)
            => (forall tp . a tp -> m (v tp))
            -- ^ Function for evaluating a register value.
            -> t (Some a)
               -- ^ Set of X86 registers
            -> m (MapF a v)
fromKeys :: (forall (tp :: k). a tp -> m (v tp)) -> t (Some a) -> m (MapF a v)
fromKeys forall (tp :: k). a tp -> m (v tp)
f = (MapF a v -> Some a -> m (MapF a v))
-> MapF a v -> t (Some a) -> m (MapF a v)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM MapF a v -> Some a -> m (MapF a v)
go MapF a v
forall v (k :: v -> *) (a :: v -> *). MapF k a
empty
  where go :: MapF a v -> Some a -> m (MapF a v)
        go :: MapF a v -> Some a -> m (MapF a v)
go MapF a v
m (Some a x
k) = (\v x
v -> a x -> v x -> MapF a v -> MapF a v
forall v (k :: v -> *) (tp :: v) (a :: v -> *).
OrdF k =>
k tp -> a tp -> MapF k a -> MapF k a
insert a x
k v x
v MapF a v
m) (v x -> MapF a v) -> m (v x) -> m (MapF a v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a x -> m (v x)
forall (tp :: k). a tp -> m (v tp)
f a x
k

-- | Generate a map from a foldable collection of keys and a monadic
-- function from keys to values.
fromKeysM :: forall k m (t :: Type -> Type) (a :: k -> Type) (v :: k -> Type)
          .  (Monad m, Foldable t, OrdF a)
           => (forall tp . a tp -> m (v tp))
           -- ^ Function for evaluating an input value to store the result in the map.
           -> t (Some a)
           -- ^ Set of input values (traversed via folding)
           -> m (MapF a v)
fromKeysM :: (forall (tp :: k). a tp -> m (v tp)) -> t (Some a) -> m (MapF a v)
fromKeysM forall (tp :: k). a tp -> m (v tp)
f = (MapF a v -> Some a -> m (MapF a v))
-> MapF a v -> t (Some a) -> m (MapF a v)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM MapF a v -> Some a -> m (MapF a v)
go MapF a v
forall v (k :: v -> *) (a :: v -> *). MapF k a
empty
  where go :: MapF a v -> Some a -> m (MapF a v)
        go :: MapF a v -> Some a -> m (MapF a v)
go MapF a v
m (Some a x
k) = (\v x
v -> a x -> v x -> MapF a v -> MapF a v
forall v (k :: v -> *) (tp :: v) (a :: v -> *).
OrdF k =>
k tp -> a tp -> MapF k a -> MapF k a
insert a x
k v x
v MapF a v
m) (v x -> MapF a v) -> m (v x) -> m (MapF a v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a x -> m (v x)
forall (tp :: k). a tp -> m (v tp)
f a x
k

filterGtMaybe :: OrdF k => MaybeS (k x) -> MapF k a -> MapF k a
filterGtMaybe :: MaybeS (k x) -> MapF k a -> MapF k a
filterGtMaybe MaybeS (k x)
NothingS MapF k a
m = MapF k a
m
filterGtMaybe (JustS k x
k) MapF k a
m = k x -> MapF k a -> MapF k a
forall v (k :: v -> *) (tp :: v) (v :: v -> *).
OrdF k =>
k tp -> MapF k v -> MapF k v
filterGt k x
k MapF k a
m

filterLtMaybe :: OrdF k => MaybeS (k x) -> MapF k a -> MapF k a
filterLtMaybe :: MaybeS (k x) -> MapF k a -> MapF k a
filterLtMaybe MaybeS (k x)
NothingS MapF k a
m = MapF k a
m
filterLtMaybe (JustS k x
k) MapF k a
m = k x -> MapF k a -> MapF k a
forall v (k :: v -> *) (tp :: v) (v :: v -> *).
OrdF k =>
k tp -> MapF k v -> MapF k v
filterLt k x
k MapF k a
m

-- | Returns only entries that are strictly between the two keys.
filterMiddle :: OrdF k => k x -> k y -> MapF k a -> MapF k a
filterMiddle :: k x -> k y -> MapF k a -> MapF k a
filterMiddle k x
lo k y
hi (Bin Size
_ k x
k a x
_ MapF k a
_ MapF k a
r)
  | k x
k k x -> k x -> Bool
forall k (ktp :: k -> *) (x :: k) (y :: k).
OrdF ktp =>
ktp x -> ktp y -> Bool
`leqF` k x
lo = k x -> k y -> MapF k a -> MapF k a
forall v (k :: v -> *) (x :: v) (y :: v) (a :: v -> *).
OrdF k =>
k x -> k y -> MapF k a -> MapF k a
filterMiddle k x
lo k y
hi MapF k a
r
filterMiddle k x
lo k y
hi (Bin Size
_ k x
k a x
_ MapF k a
l MapF k a
_)
  | k x
k k x -> k y -> Bool
forall k (ktp :: k -> *) (x :: k) (y :: k).
OrdF ktp =>
ktp x -> ktp y -> Bool
`geqF` k y
hi = k x -> k y -> MapF k a -> MapF k a
forall v (k :: v -> *) (x :: v) (y :: v) (a :: v -> *).
OrdF k =>
k x -> k y -> MapF k a -> MapF k a
filterMiddle k x
lo k y
hi MapF k a
l
filterMiddle k x
_  k y
_  MapF k a
t = MapF k a
t
{-# INLINABLE filterMiddle #-}

{--------------------------------------------------------------------
  [trim blo bhi t] trims away all subtrees that surely contain no
  values between the range [blo] to [bhi]. The returned tree is either
  empty or the key of the root is between @blo@ and @bhi@.
--------------------------------------------------------------------}
trim :: OrdF k => MaybeS (k x) -> MaybeS (k y) -> MapF k a -> MapF k a
trim :: MaybeS (k x) -> MaybeS (k y) -> MapF k a -> MapF k a
trim MaybeS (k x)
NothingS   MaybeS (k y)
NothingS   MapF k a
t = MapF k a
t
trim (JustS k x
lk) MaybeS (k y)
NothingS   MapF k a
t = k x -> MapF k a -> MapF k a
forall v (k :: v -> *) (tp :: v) (v :: v -> *).
OrdF k =>
k tp -> MapF k v -> MapF k v
filterGt k x
lk MapF k a
t
trim MaybeS (k x)
NothingS   (JustS k y
hk) MapF k a
t = k y -> MapF k a -> MapF k a
forall v (k :: v -> *) (tp :: v) (v :: v -> *).
OrdF k =>
k tp -> MapF k v -> MapF k v
filterLt k y
hk MapF k a
t
trim (JustS k x
lk) (JustS k y
hk) MapF k a
t = k x -> k y -> MapF k a -> MapF k a
forall v (k :: v -> *) (x :: v) (y :: v) (a :: v -> *).
OrdF k =>
k x -> k y -> MapF k a -> MapF k a
filterMiddle k x
lk k y
hk MapF k a
t

-- Helper function for 'mergeWithKeyM'. The @'trimLookupLo' lk hk t@ performs both
-- @'trim' (JustS lk) hk t@ and @'lookup' lk t@.

-- See Note: Type of local 'go' function
trimLookupLo :: OrdF k => k tp -> MaybeS (k y) -> MapF k a -> Bin.PairS (Maybe (a tp)) (MapF k a)
trimLookupLo :: k tp -> MaybeS (k y) -> MapF k a -> PairS (Maybe (a tp)) (MapF k a)
trimLookupLo k tp
lk MaybeS (k y)
NothingS MapF k a
t = k tp -> MapF k a -> PairS (Maybe (a tp)) (MapF k a)
forall v (k :: v -> *) (tp :: v) (a :: v -> *).
OrdF k =>
k tp -> MapF k a -> PairS (Maybe (a tp)) (MapF k a)
greater k tp
lk MapF k a
t
  where greater :: OrdF k => k tp -> MapF k a -> Bin.PairS (Maybe (a tp)) (MapF k a)
        greater :: k tp -> MapF k a -> PairS (Maybe (a tp)) (MapF k a)
greater k tp
lo t' :: MapF k a
t'@(Bin Size
_ k x
kx a x
x MapF k a
l MapF k a
r) =
           case k tp -> k x -> OrderingF tp x
forall k (ktp :: k -> *) (x :: k) (y :: k).
OrdF ktp =>
ktp x -> ktp y -> OrderingF x y
compareF k tp
lo k x
kx of
             OrderingF tp x
LTF -> Maybe (a tp) -> MapF k a -> PairS (Maybe (a tp)) (MapF k a)
forall f s. f -> s -> PairS f s
Bin.PairS (k tp -> MapF k a -> Maybe (a tp)
forall v (k :: v -> *) (tp :: v) (a :: v -> *).
OrdF k =>
k tp -> MapF k a -> Maybe (a tp)
lookup k tp
lo MapF k a
l) MapF k a
t'
             OrderingF tp x
EQF -> Maybe (a x) -> MapF k a -> PairS (Maybe (a x)) (MapF k a)
forall f s. f -> s -> PairS f s
Bin.PairS (a x -> Maybe (a x)
forall a. a -> Maybe a
Just a x
x) MapF k a
r
             OrderingF tp x
GTF -> k tp -> MapF k a -> PairS (Maybe (a tp)) (MapF k a)
forall v (k :: v -> *) (tp :: v) (a :: v -> *).
OrdF k =>
k tp -> MapF k a -> PairS (Maybe (a tp)) (MapF k a)
greater k tp
lo MapF k a
r
        greater k tp
_ MapF k a
Tip = Maybe (a tp) -> MapF k a -> PairS (Maybe (a tp)) (MapF k a)
forall f s. f -> s -> PairS f s
Bin.PairS Maybe (a tp)
forall a. Maybe a
Nothing MapF k a
forall v (k :: v -> *) (a :: v -> *). MapF k a
Tip
trimLookupLo k tp
lk (JustS k y
hk) MapF k a
t = k tp -> k y -> MapF k a -> PairS (Maybe (a tp)) (MapF k a)
forall v (k :: v -> *) (tp :: v) (y :: v) (a :: v -> *).
OrdF k =>
k tp -> k y -> MapF k a -> PairS (Maybe (a tp)) (MapF k a)
middle k tp
lk k y
hk MapF k a
t
  where middle :: OrdF k => k tp -> k y -> MapF k a -> Bin.PairS (Maybe (a tp)) (MapF k a)
        middle :: k tp -> k y -> MapF k a -> PairS (Maybe (a tp)) (MapF k a)
middle k tp
lo k y
hi t' :: MapF k a
t'@(Bin Size
_ k x
kx a x
x MapF k a
l MapF k a
r) =
          case k tp -> k x -> OrderingF tp x
forall k (ktp :: k -> *) (x :: k) (y :: k).
OrdF ktp =>
ktp x -> ktp y -> OrderingF x y
compareF k tp
lo k x
kx of
            OrderingF tp x
LTF | k x
kx k x -> k y -> Bool
forall k (ktp :: k -> *) (x :: k) (y :: k).
OrdF ktp =>
ktp x -> ktp y -> Bool
`ltF` k y
hi -> Maybe (a tp) -> MapF k a -> PairS (Maybe (a tp)) (MapF k a)
forall f s. f -> s -> PairS f s
Bin.PairS (k tp -> MapF k a -> Maybe (a tp)
forall v (k :: v -> *) (tp :: v) (a :: v -> *).
OrdF k =>
k tp -> MapF k a -> Maybe (a tp)
lookup k tp
lo MapF k a
l) MapF k a
t'
                | Bool
otherwise -> k tp -> k y -> MapF k a -> PairS (Maybe (a tp)) (MapF k a)
forall v (k :: v -> *) (tp :: v) (y :: v) (a :: v -> *).
OrdF k =>
k tp -> k y -> MapF k a -> PairS (Maybe (a tp)) (MapF k a)
middle k tp
lo k y
hi MapF k a
l
            OrderingF tp x
EQF -> Maybe (a x) -> MapF k a -> PairS (Maybe (a x)) (MapF k a)
forall f s. f -> s -> PairS f s
Bin.PairS (a x -> Maybe (a x)
forall a. a -> Maybe a
Just a x
x) (k y -> MapF k a -> MapF k a
forall v (k :: v -> *) (tp :: v) (v :: v -> *).
OrdF k =>
k tp -> MapF k v -> MapF k v
lesser k y
hi MapF k a
r)
            OrderingF tp x
GTF -> k tp -> k y -> MapF k a -> PairS (Maybe (a tp)) (MapF k a)
forall v (k :: v -> *) (tp :: v) (y :: v) (a :: v -> *).
OrdF k =>
k tp -> k y -> MapF k a -> PairS (Maybe (a tp)) (MapF k a)
middle k tp
lo k y
hi MapF k a
r
        middle k tp
_ k y
_ MapF k a
Tip = Maybe (a tp) -> MapF k a -> PairS (Maybe (a tp)) (MapF k a)
forall f s. f -> s -> PairS f s
Bin.PairS Maybe (a tp)
forall a. Maybe a
Nothing MapF k a
forall v (k :: v -> *) (a :: v -> *). MapF k a
Tip

        lesser :: OrdF k => k y -> MapF k a -> MapF k a
        lesser :: k y -> MapF k a -> MapF k a
lesser k y
hi (Bin Size
_ k x
k a x
_ MapF k a
l MapF k a
_) | k x
k k x -> k y -> Bool
forall k (ktp :: k -> *) (x :: k) (y :: k).
OrdF ktp =>
ktp x -> ktp y -> Bool
`geqF` k y
hi = k y -> MapF k a -> MapF k a
forall v (k :: v -> *) (tp :: v) (v :: v -> *).
OrdF k =>
k tp -> MapF k v -> MapF k v
lesser k y
hi MapF k a
l
        lesser k y
_ MapF k a
t' = MapF k a
t'

-- | Merge bindings in two maps using monadic actions to get a third.
--
-- The first function is used to merge elements that occur under the
-- same key in both maps. Return Just to add an entry into the
-- resulting map under this key or Nothing to remove this key from the
-- resulting map.
--
-- The second function will be applied to submaps of the first map
-- argument where no keys overlap with the second map argument. The
-- result of this function must be a map with a subset of the keys of
-- its argument.  This means the function can alter the values of its
-- argument and it can remove key-value pairs from it, but it can
-- break `MapF` ordering invariants if it introduces new keys.
--
-- Third function is analogous to the second function except that it applies
-- to the second map argument of 'mergeWithKeyM' instead of the first.
--
-- Common examples of the two functions include 'id' when constructing a union
-- or 'const' 'empty' when constructing an intersection.
mergeWithKeyM :: forall k a b c m
               . (Applicative m, OrdF k)
              => (forall tp . k tp -> a tp -> b tp -> m (Maybe (c tp)))
              -> (MapF k a -> m (MapF k c))
              -> (MapF k b -> m (MapF k c))
              -> MapF k a
              -> MapF k b
              -> m (MapF k c)
mergeWithKeyM :: (forall (tp :: v). k tp -> a tp -> b tp -> m (Maybe (c tp)))
-> (MapF k a -> m (MapF k c))
-> (MapF k b -> m (MapF k c))
-> MapF k a
-> MapF k b
-> m (MapF k c)
mergeWithKeyM forall (tp :: v). k tp -> a tp -> b tp -> m (Maybe (c tp))
f MapF k a -> m (MapF k c)
g1 MapF k b -> m (MapF k c)
g2 = MapF k a -> MapF k b -> m (MapF k c)
go
  where
    go :: MapF k a -> MapF k b -> m (MapF k c)
go MapF k a
Tip MapF k b
t2 = MapF k b -> m (MapF k c)
g2 MapF k b
t2
    go MapF k a
t1 MapF k b
Tip = MapF k a -> m (MapF k c)
g1 MapF k a
t1
    go MapF k a
t1 MapF k b
t2 = MaybeS (k Any)
-> MaybeS (k Any) -> MapF k a -> MapF k b -> m (MapF k c)
forall (x :: v) (y :: v).
MaybeS (k x)
-> MaybeS (k y) -> MapF k a -> MapF k b -> m (MapF k c)
hedgeMerge MaybeS (k Any)
forall v. MaybeS v
NothingS MaybeS (k Any)
forall v. MaybeS v
NothingS MapF k a
t1 MapF k b
t2

    hedgeMerge :: MaybeS (k x) -> MaybeS (k y) -> MapF k a -> MapF k b -> m (MapF k c)
    hedgeMerge :: MaybeS (k x)
-> MaybeS (k y) -> MapF k a -> MapF k b -> m (MapF k c)
hedgeMerge MaybeS (k x)
_   MaybeS (k y)
_   MapF k a
t1  MapF k b
Tip = MapF k a -> m (MapF k c)
g1 MapF k a
t1
    hedgeMerge MaybeS (k x)
blo MaybeS (k y)
bhi MapF k a
Tip (Bin Size
_ k x
kx b x
x MapF k b
l MapF k b
r) =
      MapF k b -> m (MapF k c)
g2 (MapF k b -> m (MapF k c)) -> MapF k b -> m (MapF k c)
forall a b. (a -> b) -> a -> b
$ Pair k b -> MapF k b -> MapF k b -> MapF k b
forall c e. IsBinTree c e => e -> c -> c -> c
Bin.link (k x -> b x -> Pair k b
forall k (a :: k -> *) (tp :: k) (b :: k -> *).
a tp -> b tp -> Pair a b
Pair k x
kx b x
x) (MaybeS (k x) -> MapF k b -> MapF k b
forall v (k :: v -> *) (x :: v) (a :: v -> *).
OrdF k =>
MaybeS (k x) -> MapF k a -> MapF k a
filterGtMaybe MaybeS (k x)
blo MapF k b
l) (MaybeS (k y) -> MapF k b -> MapF k b
forall v (k :: v -> *) (x :: v) (a :: v -> *).
OrdF k =>
MaybeS (k x) -> MapF k a -> MapF k a
filterLtMaybe MaybeS (k y)
bhi MapF k b
r)
    hedgeMerge MaybeS (k x)
blo MaybeS (k y)
bhi (Bin Size
_ k x
kx a x
x MapF k a
l MapF k a
r) MapF k b
t2 =
        let Bin.PairS Maybe (b x)
found MapF k b
trim_t2 = k x -> MaybeS (k y) -> MapF k b -> PairS (Maybe (b x)) (MapF k b)
forall v (k :: v -> *) (tp :: v) (y :: v) (a :: v -> *).
OrdF k =>
k tp -> MaybeS (k y) -> MapF k a -> PairS (Maybe (a tp)) (MapF k a)
trimLookupLo k x
kx MaybeS (k y)
bhi MapF k b
t2
            resolve_g1 :: MapF k c -> MapF k c -> MapF k c -> MapF k c
            resolve_g1 :: MapF k c -> MapF k c -> MapF k c -> MapF k c
resolve_g1 MapF k c
Tip = MapF k c -> MapF k c -> MapF k c
forall c e. IsBinTree c e => c -> c -> c
Bin.merge
            resolve_g1 (Bin Size
_ k x
k' c x
x' MapF k c
Tip MapF k c
Tip) = Pair k c -> MapF k c -> MapF k c -> MapF k c
forall c e. IsBinTree c e => e -> c -> c -> c
Bin.link (k x -> c x -> Pair k c
forall k (a :: k -> *) (tp :: k) (b :: k -> *).
a tp -> b tp -> Pair a b
Pair k x
k' c x
x')
            resolve_g1 MapF k c
_ = String -> MapF k c -> MapF k c -> MapF k c
forall a. HasCallStack => String -> a
error String
"mergeWithKey: Bad function g1"
            resolve_f :: Maybe (c x) -> MapF k c -> MapF k c -> MapF k c
resolve_f Maybe (c x)
Nothing = MapF k c -> MapF k c -> MapF k c
forall c e. IsBinTree c e => c -> c -> c
Bin.merge
            resolve_f (Just c x
x') = Pair k c -> MapF k c -> MapF k c -> MapF k c
forall c e. IsBinTree c e => e -> c -> c -> c
Bin.link (k x -> c x -> Pair k c
forall k (a :: k -> *) (tp :: k) (b :: k -> *).
a tp -> b tp -> Pair a b
Pair k x
kx c x
x')
         in case Maybe (b x)
found of
              Maybe (b x)
Nothing ->
                MapF k c -> MapF k c -> MapF k c -> MapF k c
resolve_g1 (MapF k c -> MapF k c -> MapF k c -> MapF k c)
-> m (MapF k c) -> m (MapF k c -> MapF k c -> MapF k c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MapF k a -> m (MapF k c)
g1 (k x -> a x -> MapF k a
forall v (k :: v -> *) (tp :: v) (a :: v -> *).
k tp -> a tp -> MapF k a
singleton k x
kx a x
x)
                           m (MapF k c -> MapF k c -> MapF k c)
-> m (MapF k c) -> m (MapF k c -> MapF k c)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> MaybeS (k x)
-> MaybeS (k x) -> MapF k a -> MapF k b -> m (MapF k c)
forall (x :: v) (y :: v).
MaybeS (k x)
-> MaybeS (k y) -> MapF k a -> MapF k b -> m (MapF k c)
hedgeMerge MaybeS (k x)
blo MaybeS (k x)
bmi MapF k a
l (MaybeS (k x) -> MaybeS (k x) -> MapF k b -> MapF k b
forall v (k :: v -> *) (x :: v) (y :: v) (a :: v -> *).
OrdF k =>
MaybeS (k x) -> MaybeS (k y) -> MapF k a -> MapF k a
trim MaybeS (k x)
blo MaybeS (k x)
bmi MapF k b
t2)
                           m (MapF k c -> MapF k c) -> m (MapF k c) -> m (MapF k c)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> MaybeS (k x)
-> MaybeS (k y) -> MapF k a -> MapF k b -> m (MapF k c)
forall (x :: v) (y :: v).
MaybeS (k x)
-> MaybeS (k y) -> MapF k a -> MapF k b -> m (MapF k c)
hedgeMerge MaybeS (k x)
bmi MaybeS (k y)
bhi MapF k a
r MapF k b
trim_t2
              Just b x
x2 ->
                Maybe (c x) -> MapF k c -> MapF k c -> MapF k c
resolve_f (Maybe (c x) -> MapF k c -> MapF k c -> MapF k c)
-> m (Maybe (c x)) -> m (MapF k c -> MapF k c -> MapF k c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> k x -> a x -> b x -> m (Maybe (c x))
forall (tp :: v). k tp -> a tp -> b tp -> m (Maybe (c tp))
f k x
kx a x
x b x
x2
                          m (MapF k c -> MapF k c -> MapF k c)
-> m (MapF k c) -> m (MapF k c -> MapF k c)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> MaybeS (k x)
-> MaybeS (k x) -> MapF k a -> MapF k b -> m (MapF k c)
forall (x :: v) (y :: v).
MaybeS (k x)
-> MaybeS (k y) -> MapF k a -> MapF k b -> m (MapF k c)
hedgeMerge MaybeS (k x)
blo MaybeS (k x)
bmi MapF k a
l (MaybeS (k x) -> MaybeS (k x) -> MapF k b -> MapF k b
forall v (k :: v -> *) (x :: v) (y :: v) (a :: v -> *).
OrdF k =>
MaybeS (k x) -> MaybeS (k y) -> MapF k a -> MapF k a
trim MaybeS (k x)
blo MaybeS (k x)
bmi MapF k b
t2)
                          m (MapF k c -> MapF k c) -> m (MapF k c) -> m (MapF k c)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> MaybeS (k x)
-> MaybeS (k y) -> MapF k a -> MapF k b -> m (MapF k c)
forall (x :: v) (y :: v).
MaybeS (k x)
-> MaybeS (k y) -> MapF k a -> MapF k b -> m (MapF k c)
hedgeMerge MaybeS (k x)
bmi MaybeS (k y)
bhi MapF k a
r MapF k b
trim_t2
      where bmi :: MaybeS (k x)
bmi = k x -> MaybeS (k x)
forall v. v -> MaybeS v
JustS k x
kx

{-# INLINABLE mergeWithKeyM #-}

-- | Merge bindings in two maps to get a third.
--
-- The first function is used to merge elements that occur under the
-- same key in both maps. Return Just to add an entry into the
-- resulting map under this key or Nothing to remove this key from the
-- resulting map.
--
-- The second function will be applied to submaps of the first map
-- argument where no keys overlap with the second map argument. The
-- result of this function must be a map with a subset of the keys of
-- its argument.  This means the function can alter the values of its
-- argument and it can remove key-value pairs from it, but it can
-- break `MapF` ordering invariants if it introduces new keys.
--
-- Third function is analogous to the second function except that it applies
-- to the second map argument of 'mergeWithKeyM' instead of the first.
--
-- Common examples of the two functions include 'id' when constructing a union
-- or 'const' 'empty' when constructing an intersection.
mergeWithKey :: forall k a b c
               . OrdF k
              => (forall tp . k tp -> a tp -> b tp -> Maybe (c tp))
              -> (MapF k a -> MapF k c)
              -> (MapF k b -> MapF k c)
              -> MapF k a
              -> MapF k b
              -> MapF k c
mergeWithKey :: (forall (tp :: v). k tp -> a tp -> b tp -> Maybe (c tp))
-> (MapF k a -> MapF k c)
-> (MapF k b -> MapF k c)
-> MapF k a
-> MapF k b
-> MapF k c
mergeWithKey forall (tp :: v). k tp -> a tp -> b tp -> Maybe (c tp)
f MapF k a -> MapF k c
g1 MapF k b -> MapF k c
g2 MapF k a
x MapF k b
y = Identity (MapF k c) -> MapF k c
forall a. Identity a -> a
runIdentity (Identity (MapF k c) -> MapF k c)
-> Identity (MapF k c) -> MapF k c
forall a b. (a -> b) -> a -> b
$
  (forall (tp :: v). k tp -> a tp -> b tp -> Identity (Maybe (c tp)))
-> (MapF k a -> Identity (MapF k c))
-> (MapF k b -> Identity (MapF k c))
-> MapF k a
-> MapF k b
-> Identity (MapF k c)
forall v (k :: v -> *) (a :: v -> *) (b :: v -> *) (c :: v -> *)
       (m :: * -> *).
(Applicative m, OrdF k) =>
(forall (tp :: v). k tp -> a tp -> b tp -> m (Maybe (c tp)))
-> (MapF k a -> m (MapF k c))
-> (MapF k b -> m (MapF k c))
-> MapF k a
-> MapF k b
-> m (MapF k c)
mergeWithKeyM (\k tp
k a tp
a b tp
b -> Maybe (c tp) -> Identity (Maybe (c tp))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (c tp) -> Identity (Maybe (c tp)))
-> Maybe (c tp) -> Identity (Maybe (c tp))
forall a b. (a -> b) -> a -> b
$! k tp -> a tp -> b tp -> Maybe (c tp)
forall (tp :: v). k tp -> a tp -> b tp -> Maybe (c tp)
f k tp
k a tp
a b tp
b) (MapF k c -> Identity (MapF k c)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MapF k c -> Identity (MapF k c))
-> (MapF k a -> MapF k c) -> MapF k a -> Identity (MapF k c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MapF k a -> MapF k c
g1) (MapF k c -> Identity (MapF k c)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MapF k c -> Identity (MapF k c))
-> (MapF k b -> MapF k c) -> MapF k b -> Identity (MapF k c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MapF k b -> MapF k c
g2) MapF k a
x MapF k b
y

-- | Applies a function to the pairwise common elements of two maps.
--
-- Formally, we have that @intersectWithKeyMaybe f x y@ contains a
-- binding from a key @k@ to a value @v@ if and only if @x@ and @y@
-- bind @k@ to @x_k@ and @y_k@ and @f x_k y_k = Just v@.
intersectWithKeyMaybe :: OrdF k
                      => (forall tp . k tp -> a tp -> b tp -> Maybe (c tp))
                      -> MapF k a
                      -> MapF k b
                      -> MapF k c
intersectWithKeyMaybe :: (forall (tp :: v). k tp -> a tp -> b tp -> Maybe (c tp))
-> MapF k a -> MapF k b -> MapF k c
intersectWithKeyMaybe forall (tp :: v). k tp -> a tp -> b tp -> Maybe (c tp)
f = (forall (tp :: v). k tp -> a tp -> b tp -> Maybe (c tp))
-> (MapF k a -> MapF k c)
-> (MapF k b -> MapF k c)
-> MapF k a
-> MapF k b
-> MapF k c
forall v (k :: v -> *) (a :: v -> *) (b :: v -> *) (c :: v -> *).
OrdF k =>
(forall (tp :: v). k tp -> a tp -> b tp -> Maybe (c tp))
-> (MapF k a -> MapF k c)
-> (MapF k b -> MapF k c)
-> MapF k a
-> MapF k b
-> MapF k c
mergeWithKey forall (tp :: v). k tp -> a tp -> b tp -> Maybe (c tp)
f (MapF k c -> MapF k a -> MapF k c
forall a b. a -> b -> a
const MapF k c
forall v (k :: v -> *) (a :: v -> *). MapF k a
empty) (MapF k c -> MapF k b -> MapF k c
forall a b. a -> b -> a
const MapF k c
forall v (k :: v -> *) (a :: v -> *). MapF k a
empty)