{-|
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 :: forall {k} (k :: k -> *) (a :: k -> *).
OrdF k =>
Pair k a -> Pair k a -> Ordering
comparePairKeys (Pair k tp
x a tp
_) (Pair k tp
y a tp
_) = forall {k} (x :: k) (y :: k). OrderingF x y -> Ordering
toOrdering (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 :: forall {v} (k :: v -> *) (a :: v -> *). MapF k a
empty = forall {v} (k :: v -> *) (a :: v -> *). MapF k a
Tip

-- | Return true if map is empty
null :: MapF k a -> Bool
null :: forall {v} (k :: v -> *) (a :: v -> *). 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 :: forall {v} (k :: v -> *) (tp :: v) (a :: v -> *).
k tp -> a tp -> MapF k a
singleton k tp
k a tp
x = forall {v} (k :: v -> *) (tp :: v) (a :: v -> *).
Size -> k tp -> a tp -> MapF k a -> MapF k a -> MapF k a
Bin Size
1 k tp
k a tp
x forall {v} (k :: v -> *) (a :: v -> *). MapF k a
Tip 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) = forall e t. e -> t -> t -> TreeApp e t
BinTree (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 = forall e t. TreeApp e t
TipTree

  tip :: MapF k a
tip = 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 = forall {v} (k :: v -> *) (tp :: v) (a :: v -> *).
Size -> k tp -> a tp -> MapF k a -> MapF k a -> MapF k a
Bin (forall t e. IsBinTree t e => t -> Size
size MapF k a
l forall a. Num a => a -> a -> a
+ forall t e. IsBinTree t e => t -> Size
size MapF k a
r 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 = forall t e. IsBinTree t e => t -> Size
size MapF k a
x forall a. Eq a => a -> a -> Bool
== forall t e. IsBinTree t e => t -> Size
size MapF k a
y Bool -> Bool -> Bool
&& forall {k} (k :: k -> *) (a :: k -> *). MapF k a -> [Pair k a]
toList MapF k a
x forall a. Eq a => a -> a -> Bool
== 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 {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
_ MapF ktp f
Tip = 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) = forall {v} (k :: v -> *) (tp :: v) (a :: v -> *).
Size -> k tp -> a tp -> MapF k a -> MapF k a -> MapF k a
Bin Size
sx ktp x
kx (forall (tp :: v). ktp tp -> f tp -> g tp
f ktp x
kx f x
x) (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 {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 {v} (f :: v -> *) (g :: v -> *) (ktp :: v -> *).
(forall (tp :: v). f tp -> g tp) -> MapF ktp f -> MapF ktp g
map forall (tp :: v). f tp -> g tp
f = 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 -> 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 {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)
_ MapF k f
Tip = 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 forall (tp :: v). k tp -> f tp -> Maybe (g tp)
f k x
k f x
x of
    Just g x
y -> forall c e. IsBinTree c e => e -> c -> c -> c
Bin.link (forall {k} (a :: k -> *) (tp :: k) (b :: k -> *).
a tp -> b tp -> Pair a b
Pair k x
k g x
y) (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 {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 -> forall c e. IsBinTree c e => c -> c -> c
Bin.merge (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 {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 {v} (f :: v -> *) (g :: v -> *) (ktp :: v -> *).
(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 {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 -> 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 {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)
_ MapF ktp f
Tip = forall (f :: * -> *) a. Applicative f => a -> f a
pure 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' -> forall {v} (k :: v -> *) (tp :: v) (a :: v -> *).
Size -> k tp -> a tp -> 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') forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (tp :: v). f tp -> m (g tp)
f f x
x forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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 {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)
_ MapF ktp f
Tip = forall (f :: * -> *) a. Applicative f => a -> f a
pure 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' -> forall {v} (k :: v -> *) (tp :: v) (a :: v -> *).
Size -> k tp -> a tp -> 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') forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (tp :: v). ktp tp -> f tp -> m (g tp)
f ktp x
kx f x
x forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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 {v} (m :: * -> *) (ktp :: v -> *) (f :: v -> *).
Applicative m =>
(forall (tp :: v). ktp tp -> f tp -> m ()) -> MapF ktp f -> m ()
traverseWithKey_ = \forall (tp :: v). ktp tp -> f tp -> m ()
f -> 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 -> forall (tp :: v). ktp tp -> f tp -> m ()
f ktp s
k f s
v forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m ()
r) (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 {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))
_ MapF k a
Tip = forall (f :: * -> *) a. Applicative f => a -> f a
pure 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) = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall {v} (k :: v -> *) (a :: v -> *). MapF k a
Tip (\b x
x' -> forall {v} (k :: v -> *) (tp :: v) (a :: v -> *).
Size -> k tp -> a tp -> MapF k a -> MapF k a -> MapF k a
Bin Size
1 k x
kx b x
x' forall {v} (k :: v -> *) (a :: v -> *). MapF k a
Tip forall {v} (k :: v -> *) (a :: v -> *). MapF k a
Tip) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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) =
    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 {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) (forall (tp :: v). k tp -> a tp -> f (Maybe (b tp))
f k x
kx a x
x) (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' = seq :: forall a b. a -> b -> b
seq MapF k b
l' forall a b. (a -> b) -> a -> b
$ seq :: forall a b. a -> b -> b
seq MapF k b
r' forall a b. (a -> b) -> a -> b
$
      case Maybe (b x)
mx of
        Just b x
x' -> forall c e. IsBinTree c e => e -> c -> c -> c
Bin.link (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 -> 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 :: forall (x :: a). k x -> Traversal' (MapF k v) (v x)
ixF k x
i v x -> f (v x)
f MapF k v
m = forall a. Updated a -> a
updatedValue forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing) (\v x
x -> forall v. v -> UpdateRequest v
Set 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 :: forall (x :: a). 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 = forall a. Updated a -> a
updatedValue forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 forall a. Maybe a
Nothing) (\v x
x -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall v. UpdateRequest v
Delete forall v. v -> UpdateRequest v
Set forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (v x) -> f (Maybe (v x))
f (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 :: forall {v} (k :: v -> *) (tp :: v) (a :: v -> *).
OrdF k =>
k tp -> MapF k a -> Maybe (a tp)
lookup k tp
k0 = seq :: forall a b. a -> b -> b
seq k tp
k0 (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 :: forall {v} (k :: v -> *) (tp :: v) (a :: v -> *).
OrdF k =>
k tp -> MapF k a -> Maybe (a tp)
go k tp
_ MapF k a
Tip = 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 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 -> 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 -> 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 -> 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 :: forall {v} (k :: v -> *) (a :: v -> *) (tp :: v).
OrdF k =>
a tp -> k tp -> MapF k a -> a tp
findWithDefault = \a tp
def k tp
k -> seq :: forall a b. a -> b -> b
seq k tp
k (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 :: 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
_ 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 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 -> 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 -> 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 x
x
{-# INLINABLE findWithDefault #-}

-- | Return true if key is bound in map.
member :: OrdF k => k tp -> MapF k a -> Bool
member :: forall {v} (k :: v -> *) (tp :: v) (a :: v -> *).
OrdF k =>
k tp -> MapF k a -> Bool
member k tp
k0 = seq :: forall a b. a -> b -> b
seq k tp
k0 (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 :: forall {v} (k :: v -> *) (tp :: v) (a :: v -> *).
OrdF k =>
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 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 -> 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 -> 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 :: forall {v} (k :: v -> *) (tp :: v) (a :: v -> *).
OrdF k =>
k tp -> MapF k a -> Bool
notMember k tp
k MapF k a
m = Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ 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 (f :: k -> *) (g :: k -> *).
(forall (x :: k). f x -> g x) -> MapF ktp f -> MapF ktp g
fmapF = 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 (e :: k -> *) b.
(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 (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 (m :: * -> *) (e :: k -> *) (f :: k -> *).
Applicative m =>
(forall (s :: k). e s -> m (f s)) -> MapF ktp e -> m (MapF ktp f)
traverseF = 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 {v} (ktp :: v -> *) (rtp :: v -> *).
(forall (tp :: v). ktp tp -> String)
-> (forall (tp :: v). rtp tp -> String) -> MapF ktp rtp -> String
showMap forall k (f :: k -> *) (tp :: k). ShowF f => f tp -> String
showF 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 :: forall {k} (k :: k -> *) (a :: k -> *). MapF k a -> [Some k]
keys = 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 -> forall k (f :: k -> *) (x :: k). f x -> Some f
Some k s
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 :: forall {k} (k :: k -> *) (a :: k -> *). MapF k a -> [Some a]
elems = 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 -> forall k (f :: k -> *) (x :: k). f x -> Some f
Some a s
e 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 {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
_ 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 {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 = forall (s :: v). b -> k s -> a s -> b
f b
lz k x
kx a x
x
   in 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 {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
_ 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 {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 = seq :: forall a b. a -> b -> b
seq b
lz forall a b. (a -> b) -> a -> b
$ forall (s :: v). b -> k s -> a s -> b
f b
lz k x
kx a x
x
   in seq :: forall a b. a -> b -> b
seq b
kz forall a b. (a -> b) -> 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 {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
_ 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 {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 (forall (s :: v). k s -> a s -> b -> b
f k x
kx a x
x (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 {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
_ 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 {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 = seq :: forall a b. a -> b -> b
seq b
rz forall a b. (a -> b) -> a -> b
$ forall (s :: v). k s -> a s -> b -> b
f k x
kx a x
x b
rz
   in seq :: forall a b. a -> b -> b
seq b
kz forall a b. (a -> b) -> 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 {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
_ MapF k a
Tip = 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 {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 forall a. Semigroup a => a -> a -> a
<> forall (s :: v). k s -> a s -> m
f k x
kx a x
x forall a. Semigroup a => a -> a -> a
<> 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 {v} (m :: * -> *) b (k :: v -> *) (a :: v -> *).
Monad m =>
(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 {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 ->  forall (s :: v). b -> k s -> a s -> m b
f b
z k s
k a s
a forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= b -> m b
r) 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 {v} (m :: * -> *) (k :: v -> *) (a :: v -> *) b.
Monad m =>
(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 {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 ->  forall (s :: v). k s -> a s -> b -> m b
f k s
k a s
a b
z forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= b -> m b
r) 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 {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
ppk forall (tp :: v). rtp tp -> String
ppv MapF ktp rtp
m = String
"{ " forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
", " [String]
l forall a. [a] -> [a] -> [a]
++ String
" }"
  where l :: [String]
l = 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 -> (forall (tp :: v). ktp tp -> String
ppk ktp s
k forall a. [a] -> [a] -> [a]
++ String
" -> " forall a. [a] -> [a] -> [a]
++ forall (tp :: v). rtp tp -> String
ppv rtp s
a) 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 {v} (f :: v -> *) (k :: v -> *).
(forall (tp :: v). f tp -> Bool) -> MapF k f -> MapF k f
filter forall (tp :: v). f tp -> Bool
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 -> 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 {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
_ MapF k f
Tip = 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)
  | forall (tp :: v). k tp -> f tp -> Bool
f k x
k f x
x     = forall c e. IsBinTree c e => e -> c -> c -> c
Bin.link (forall {k} (a :: k -> *) (tp :: k) (b :: k -> *).
a tp -> b tp -> Pair a b
Pair k x
k f x
x) (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 {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 = forall c e. IsBinTree c e => c -> c -> c
Bin.merge (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 {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 :: forall {k} (k :: k -> *) (tp :: k) (a :: k -> *).
OrdF k =>
k tp -> Pair k a -> Ordering
compareKeyPair k tp
k = \(Pair k tp
x a tp
_) -> forall {k} (x :: k) (y :: k). OrderingF x y -> Ordering
toOrdering (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 :: forall {v} (k :: v -> *) (tp :: v) (v :: v -> *).
OrdF k =>
k tp -> MapF k v -> MapF k v
filterGt k tp
k MapF k v
m = forall a. a -> MaybeS a -> a
fromMaybeS MapF k v
m (forall c e. IsBinTree c e => (e -> Ordering) -> c -> MaybeS c
Bin.filterGt (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 :: forall {v} (k :: v -> *) (tp :: v) (v :: v -> *).
OrdF k =>
k tp -> MapF k v -> MapF k v
filterLt k tp
k MapF k v
m = forall a. a -> MaybeS a -> a
fromMaybeS MapF k v
m (forall c e. IsBinTree c e => (e -> Ordering) -> c -> MaybeS c
Bin.filterLt (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 :: 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
v MapF k a
m -> seq :: forall a b. a -> b -> b
seq k tp
k forall a b. (a -> b) -> a -> b
$ forall a. Updated a -> a
updatedValue (forall c e.
IsBinTree c e =>
(e -> e -> Ordering) -> e -> c -> Updated c
Bin.insert forall {k} (k :: k -> *) (a :: k -> *).
OrdF k =>
Pair k a -> Pair k a -> Ordering
comparePairKeys (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 :: 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 = seq :: forall a b. a -> b -> b
seq k tp
k forall a b. (a -> b) -> a -> b
$
  case MapF k a
t of
    MapF k a
Tip -> forall a. a -> Updated a
Bin.Updated (forall {v} (k :: v -> *) (tp :: v) (a :: v -> *).
Size -> k tp -> a tp -> MapF k a -> MapF k a -> MapF k a
Bin Size
1 k tp
k a tp
v forall {v} (k :: v -> *) (a :: v -> *). MapF k a
Tip 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 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 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'   -> forall a. a -> Updated a
Bin.Updated   (forall c e. IsBinTree c e => e -> c -> c -> c
Bin.balanceL (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' -> forall a. a -> Updated a
Bin.Unchanged (forall {v} (k :: v -> *) (tp :: v) (a :: v -> *).
Size -> k tp -> a tp -> 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 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'   -> forall a. a -> Updated a
Bin.Updated   (forall c e. IsBinTree c e => e -> c -> c -> c
Bin.balanceR (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' -> forall a. a -> Updated a
Bin.Unchanged (forall {v} (k :: v -> *) (tp :: v) (a :: v -> *).
Size -> k tp -> a tp -> 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 -> forall a. a -> Updated a
Bin.Unchanged (forall {v} (k :: v -> *) (tp :: v) (a :: v -> *).
Size -> k tp -> a tp -> 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 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 :: forall {v} (k :: v -> *) (a :: v -> *) (tp :: v).
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
f k tp
k a tp
v MapF k a
t -> seq :: forall a b. a -> b -> b
seq k tp
k forall a b. (a -> b) -> a -> b
$ forall a. Updated a -> a
updatedValue (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 :: forall {v} (k :: v -> *) (tp :: v) (v :: v -> *).
OrdF k =>
k tp -> MapF k v -> MapF k v
delete = \k tp
k MapF k a
m -> seq :: forall a b. a -> b -> b
seq k tp
k forall a b. (a -> b) -> a -> b
$ forall a. a -> MaybeS a -> a
fromMaybeS MapF k a
m forall a b. (a -> b) -> a -> b
$ forall c e. IsBinTree c e => (e -> Ordering) -> c -> MaybeS c
Bin.delete (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 :: forall {k} (k :: k -> *) (tp :: k) (a :: k -> *).
OrdF k =>
k tp -> Pair k a -> Ordering
p k tp
k (Pair k tp
kx a tp
_) = forall {k} (x :: k) (y :: k). OrderingF x y -> Ordering
toOrdering (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 :: forall {v} (k :: v -> *) (a :: v -> *).
OrdF k =>
MapF k a -> MapF k a -> MapF k a
union MapF k a
t1 MapF k a
t2 = forall c e. IsBinTree c e => (e -> e -> Ordering) -> c -> c -> c
Bin.union 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' :: 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 =
  case 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 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  = forall {v} (k :: v -> *) (a :: v -> *). AtKeyResult k a
AtKeyUnchanged
            ins (Just a tp
v) = forall {v} (k :: v -> *) (a :: v -> *). MapF k a -> AtKeyResult k a
AtKeyInserted (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 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 = forall {v} (k :: v -> *) (a :: v -> *). AtKeyResult k a
AtKeyUnchanged
                ins (AtKeyInserted MapF k a
l') = forall {v} (k :: v -> *) (a :: v -> *). MapF k a -> AtKeyResult k a
AtKeyInserted (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') = forall {v} (k :: v -> *) (a :: v -> *). MapF k a -> AtKeyResult k a
AtKeyModified (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') = forall {v} (k :: v -> *) (a :: v -> *). MapF k a -> AtKeyResult k a
AtKeyDeleted  (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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 = forall {v} (k :: v -> *) (a :: v -> *). AtKeyResult k a
AtKeyUnchanged
                ins (AtKeyInserted MapF k a
r') = forall {v} (k :: v -> *) (a :: v -> *). MapF k a -> AtKeyResult k a
AtKeyInserted (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') = forall {v} (k :: v -> *) (a :: v -> *). MapF k a -> AtKeyResult k a
AtKeyModified (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') = forall {v} (k :: v -> *) (a :: v -> *). MapF k a -> AtKeyResult k a
AtKeyDeleted  (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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a tp -> f (UpdateRequest (a tp))
onFound a tp
y
          where ins :: UpdateRequest (a tp) -> AtKeyResult k a
ins UpdateRequest (a tp)
Keep    = forall {v} (k :: v -> *) (a :: v -> *). AtKeyResult k a
AtKeyUnchanged
                ins (Set a tp
x) = forall {v} (k :: v -> *) (a :: v -> *). MapF k a -> AtKeyResult k a
AtKeyModified (forall c e. IsBinTree c e => e -> c -> c -> c
bin (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  = forall {v} (k :: v -> *) (a :: v -> *). MapF k a -> AtKeyResult k a
AtKeyDeleted (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 :: 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 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 = forall a. a -> Updated a
Unchanged MapF k a
t
        ins (AtKeyInserted MapF k a
t') = forall a. a -> Updated a
Updated MapF k a
t'
        ins (AtKeyModified MapF k a
t') = forall a. a -> Updated a
Updated MapF k a
t'
        ins (AtKeyDeleted  MapF k a
t') = 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 :: forall {v} (k :: v -> *) (a :: v -> *).
OrdF k =>
[Pair k a] -> MapF k a
fromList = 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) -> 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) 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 :: forall {k} (k :: k -> *) (a :: k -> *). MapF k a -> [Pair k a]
toAscList = 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 -> forall {k} (a :: k -> *) (tp :: k) (b :: k -> *).
a tp -> b tp -> Pair a b
Pair k s
k a s
x 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 :: forall {k} (k :: k -> *) (a :: k -> *). MapF k a -> [Pair k a]
toDescList = 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 -> forall {k} (a :: k -> *) (tp :: k) (b :: k -> *).
a tp -> b tp -> Pair a b
Pair k s
k a s
x 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 :: forall {k} (k :: k -> *) (a :: k -> *). MapF k a -> [Pair k a]
toList = 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 k (m :: * -> *) (t :: * -> *) (a :: k -> *) (v :: k -> *).
(Monad m, Foldable t, OrdF a) =>
(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 = 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 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 -> 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) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 k (m :: * -> *) (t :: * -> *) (a :: k -> *) (v :: k -> *).
(Monad m, Foldable t, OrdF a) =>
(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 = 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 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 -> 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) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 :: forall {v} (k :: v -> *) (x :: v) (a :: v -> *).
OrdF k =>
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 = 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 :: forall {v} (k :: v -> *) (x :: v) (a :: v -> *).
OrdF k =>
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 = 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 :: 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 (Bin Size
_ k x
k a x
_ MapF k a
_ MapF k a
r)
  | k x
k forall k (ktp :: k -> *) (x :: k) (y :: k).
OrdF ktp =>
ktp x -> ktp y -> Bool
`leqF` k x
lo = 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 forall k (ktp :: k -> *) (x :: k) (y :: k).
OrdF ktp =>
ktp x -> ktp y -> Bool
`geqF` k y
hi = 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 :: 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)
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 = 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 = 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 = 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 :: 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 tp
lk MaybeS (k y)
NothingS MapF k a
t = 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 :: 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 t' :: MapF k a
t'@(Bin Size
_ k x
kx a x
x MapF k a
l MapF k a
r) =
           case 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 -> forall f s. f -> s -> PairS f s
Bin.PairS (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 -> forall f s. f -> s -> PairS f s
Bin.PairS (forall a. a -> Maybe a
Just a x
x) MapF k a
r
             OrderingF tp x
GTF -> 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 = forall f s. f -> s -> PairS f s
Bin.PairS forall a. Maybe a
Nothing forall {v} (k :: v -> *) (a :: v -> *). MapF k a
Tip
trimLookupLo k tp
lk (JustS k y
hk) MapF k a
t = 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 :: 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 t' :: MapF k a
t'@(Bin Size
_ k x
kx a x
x MapF k a
l MapF k a
r) =
          case 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 forall k (ktp :: k -> *) (x :: k) (y :: k).
OrdF ktp =>
ktp x -> ktp y -> Bool
`ltF` k y
hi -> forall f s. f -> s -> PairS f s
Bin.PairS (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 -> 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 -> forall f s. f -> s -> PairS f s
Bin.PairS (forall a. a -> Maybe a
Just a x
x) (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 -> 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 = forall f s. f -> s -> PairS f s
Bin.PairS forall a. Maybe a
Nothing forall {v} (k :: v -> *) (a :: v -> *). MapF k a
Tip

        lesser :: OrdF k => k y -> MapF k a -> MapF k a
        lesser :: forall {v} (k :: v -> *) (tp :: v) (v :: v -> *).
OrdF k =>
k tp -> MapF k v -> MapF k v
lesser k y
hi (Bin Size
_ k x
k a x
_ MapF k a
l MapF k a
_) | k x
k forall k (ktp :: k -> *) (x :: k) (y :: k).
OrdF ktp =>
ktp x -> ktp y -> Bool
`geqF` k y
hi = 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 {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 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 = forall (x :: v) (y :: v).
MaybeS (k x)
-> MaybeS (k y) -> MapF k a -> MapF k b -> m (MapF k c)
hedgeMerge forall v. MaybeS v
NothingS 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 :: 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)
_   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 forall a b. (a -> b) -> a -> b
$ forall c e. IsBinTree c e => e -> c -> c -> c
Bin.link (forall {k} (a :: k -> *) (tp :: k) (b :: k -> *).
a tp -> b tp -> Pair a b
Pair k x
kx b x
x) (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) (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 = 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 = 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) = forall c e. IsBinTree c e => e -> c -> c -> c
Bin.link (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
_ = 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 = forall c e. IsBinTree c e => c -> c -> c
Bin.merge
            resolve_f (Just c x
x') = forall c e. IsBinTree c e => e -> c -> c -> c
Bin.link (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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MapF k a -> m (MapF k c)
g1 (forall {v} (k :: v -> *) (tp :: v) (a :: v -> *).
k tp -> a tp -> MapF k a
singleton k x
kx a x
x)
                           forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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 (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)
                           forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (tp :: v). k tp -> a tp -> b tp -> m (Maybe (c tp))
f k x
kx a x
x b x
x2
                          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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 (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)
                          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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 = 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 {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 a -> MapF k c
g1 MapF k b -> MapF k c
g2 MapF k a
x MapF k b
y = forall a. Identity a -> a
runIdentity forall a b. (a -> b) -> a -> b
$
  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 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$! forall (tp :: v). k tp -> a tp -> b tp -> Maybe (c tp)
f k tp
k a tp
a b tp
b) (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. MapF k a -> MapF k c
g1) (forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 {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 b -> MapF k c
intersectWithKeyMaybe forall (tp :: v). k tp -> a tp -> b tp -> Maybe (c tp)
f = 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 (forall a b. a -> b -> a
const forall {v} (k :: v -> *) (a :: v -> *). MapF k a
empty) (forall a b. a -> b -> a
const forall {v} (k :: v -> *) (a :: v -> *). MapF k a
empty)