{-|
Module      : What4.Utils.AnnotatedMap
Description : A finite map data structure with monoidal annotations
Copyright   : (c) Galois Inc, 2019-2020
License     : BSD3
Maintainer  : huffman@galois.com

A finite map data structure with monoidal annotations.
-}

{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}

module What4.Utils.AnnotatedMap
  ( AnnotatedMap
  , null
  , empty
  , singleton
  , size
  , lookup
  , delete
  , annotation
  , toList
  , fromAscList
  , insert
  , alter
  , alterF
  , union
  , unionWith
  , unionWithKeyMaybe
  , filter
  , mapMaybe
  , traverseMaybeWithKey
  , difference
  , mergeWithKey
  , mergeWithKeyM
  , mergeA
  , eqBy
  ) where

import           Data.Functor.Identity
import qualified Data.Foldable as Foldable
import           Data.Foldable (foldl')
import           Prelude hiding (null, filter, lookup)

import qualified Data.FingerTree as FT
import           Data.FingerTree ((><), (<|))

----------------------------------------------------------------------
-- Operations on FingerTrees

filterFingerTree ::
  FT.Measured v a =>
  (a -> Bool) -> FT.FingerTree v a -> FT.FingerTree v a
filterFingerTree :: (a -> Bool) -> FingerTree v a -> FingerTree v a
filterFingerTree a -> Bool
p =
  (FingerTree v a -> a -> FingerTree v a)
-> FingerTree v a -> FingerTree v a -> FingerTree v a
forall (t :: Type -> Type) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\FingerTree v a
xs a
x -> if a -> Bool
p a
x then FingerTree v a
xs FingerTree v a -> a -> FingerTree v a
forall v a. Measured v a => FingerTree v a -> a -> FingerTree v a
FT.|> a
x else FingerTree v a
xs) FingerTree v a
forall v a. Measured v a => FingerTree v a
FT.empty

mapMaybeFingerTree ::
  (FT.Measured v1 a1, FT.Measured v2 a2) =>
  (a1 -> Maybe a2) -> FT.FingerTree v1 a1 -> FT.FingerTree v2 a2
mapMaybeFingerTree :: (a1 -> Maybe a2) -> FingerTree v1 a1 -> FingerTree v2 a2
mapMaybeFingerTree a1 -> Maybe a2
f =
  (FingerTree v2 a2 -> a1 -> FingerTree v2 a2)
-> FingerTree v2 a2 -> FingerTree v1 a1 -> FingerTree v2 a2
forall (t :: Type -> Type) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\FingerTree v2 a2
xs a1
x -> FingerTree v2 a2
-> (a2 -> FingerTree v2 a2) -> Maybe a2 -> FingerTree v2 a2
forall b a. b -> (a -> b) -> Maybe a -> b
maybe FingerTree v2 a2
xs (FingerTree v2 a2
xs FingerTree v2 a2 -> a2 -> FingerTree v2 a2
forall v a. Measured v a => FingerTree v a -> a -> FingerTree v a
FT.|>) (a1 -> Maybe a2
f a1
x)) FingerTree v2 a2
forall v a. Measured v a => FingerTree v a
FT.empty

traverseMaybeFingerTree ::
  (Applicative f, FT.Measured v1 a1, FT.Measured v2 a2) =>
  (a1 -> f (Maybe a2)) -> FT.FingerTree v1 a1 -> f (FT.FingerTree v2 a2)
traverseMaybeFingerTree :: (a1 -> f (Maybe a2)) -> FingerTree v1 a1 -> f (FingerTree v2 a2)
traverseMaybeFingerTree a1 -> f (Maybe a2)
f =
   (f (FingerTree v2 a2) -> a1 -> f (FingerTree v2 a2))
-> f (FingerTree v2 a2) -> FingerTree v1 a1 -> f (FingerTree v2 a2)
forall (t :: Type -> Type) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\f (FingerTree v2 a2)
m a1
x -> FingerTree v2 a2 -> Maybe a2 -> FingerTree v2 a2
forall v a.
Measured v a =>
FingerTree v a -> Maybe a -> FingerTree v a
rebuild (FingerTree v2 a2 -> Maybe a2 -> FingerTree v2 a2)
-> f (FingerTree v2 a2) -> f (Maybe a2 -> FingerTree v2 a2)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> f (FingerTree v2 a2)
m f (Maybe a2 -> FingerTree v2 a2)
-> f (Maybe a2) -> f (FingerTree v2 a2)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> a1 -> f (Maybe a2)
f a1
x) (FingerTree v2 a2 -> f (FingerTree v2 a2)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure FingerTree v2 a2
forall v a. Measured v a => FingerTree v a
FT.empty)
 where
 rebuild :: FingerTree v a -> Maybe a -> FingerTree v a
rebuild FingerTree v a
ys Maybe a
Nothing  = FingerTree v a
ys
 rebuild FingerTree v a
ys (Just a
y) = FingerTree v a
ys FingerTree v a -> a -> FingerTree v a
forall v a. Measured v a => FingerTree v a -> a -> FingerTree v a
FT.|> a
y

----------------------------------------------------------------------
-- Tags

data Tag k v = NoTag | Tag !Int k v
-- The Int is there to support the size function.

instance (Ord k, Semigroup v) => Semigroup (Tag k v) where
  <> :: Tag k v -> Tag k v -> Tag k v
(<>) = Tag k v -> Tag k v -> Tag k v
forall k v. (Ord k, Semigroup v) => Tag k v -> Tag k v -> Tag k v
unionTag

instance (Ord k, Semigroup v) => Monoid (Tag k v) where
  mempty :: Tag k v
mempty  = Tag k v
forall k v. Tag k v
NoTag
  mappend :: Tag k v -> Tag k v -> Tag k v
mappend = Tag k v -> Tag k v -> Tag k v
forall k v. (Ord k, Semigroup v) => Tag k v -> Tag k v -> Tag k v
unionTag

unionTag :: (Ord k, Semigroup v) => Tag k v -> Tag k v -> Tag k v
unionTag :: Tag k v -> Tag k v -> Tag k v
unionTag Tag k v
x Tag k v
NoTag = Tag k v
x
unionTag Tag k v
NoTag Tag k v
y = Tag k v
y
unionTag (Tag Int
ix k
_ v
vx) (Tag Int
iy k
ky v
vy) =
  Int -> k -> v -> Tag k v
forall k v. Int -> k -> v -> Tag k v
Tag (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
iy) k
ky (v
vx v -> v -> v
forall a. Semigroup a => a -> a -> a
<> v
vy)

----------------------------------------------------------------------

newtype AnnotatedMap k v a =
  AnnotatedMap { AnnotatedMap k v a -> FingerTree (Tag k v) (Entry k v a)
annotatedMap :: FT.FingerTree (Tag k v) (Entry k v a) }
  -- Invariant: The entries in the fingertree must be sorted by key,
  -- strictly increasing from left to right.

data Entry k v a = Entry k v a
  deriving (a -> Entry k v b -> Entry k v a
(a -> b) -> Entry k v a -> Entry k v b
(forall a b. (a -> b) -> Entry k v a -> Entry k v b)
-> (forall a b. a -> Entry k v b -> Entry k v a)
-> Functor (Entry k v)
forall a b. a -> Entry k v b -> Entry k v a
forall a b. (a -> b) -> Entry k v a -> Entry k v b
forall k v a b. a -> Entry k v b -> Entry k v a
forall k v a b. (a -> b) -> Entry k v a -> Entry k v b
forall (f :: Type -> Type).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Entry k v b -> Entry k v a
$c<$ :: forall k v a b. a -> Entry k v b -> Entry k v a
fmap :: (a -> b) -> Entry k v a -> Entry k v b
$cfmap :: forall k v a b. (a -> b) -> Entry k v a -> Entry k v b
Functor, Entry k v a -> Bool
(a -> m) -> Entry k v a -> m
(a -> b -> b) -> b -> Entry k v a -> b
(forall m. Monoid m => Entry k v m -> m)
-> (forall m a. Monoid m => (a -> m) -> Entry k v a -> m)
-> (forall m a. Monoid m => (a -> m) -> Entry k v a -> m)
-> (forall a b. (a -> b -> b) -> b -> Entry k v a -> b)
-> (forall a b. (a -> b -> b) -> b -> Entry k v a -> b)
-> (forall b a. (b -> a -> b) -> b -> Entry k v a -> b)
-> (forall b a. (b -> a -> b) -> b -> Entry k v a -> b)
-> (forall a. (a -> a -> a) -> Entry k v a -> a)
-> (forall a. (a -> a -> a) -> Entry k v a -> a)
-> (forall a. Entry k v a -> [a])
-> (forall a. Entry k v a -> Bool)
-> (forall a. Entry k v a -> Int)
-> (forall a. Eq a => a -> Entry k v a -> Bool)
-> (forall a. Ord a => Entry k v a -> a)
-> (forall a. Ord a => Entry k v a -> a)
-> (forall a. Num a => Entry k v a -> a)
-> (forall a. Num a => Entry k v a -> a)
-> Foldable (Entry k v)
forall a. Eq a => a -> Entry k v a -> Bool
forall a. Num a => Entry k v a -> a
forall a. Ord a => Entry k v a -> a
forall m. Monoid m => Entry k v m -> m
forall a. Entry k v a -> Bool
forall a. Entry k v a -> Int
forall a. Entry k v a -> [a]
forall a. (a -> a -> a) -> Entry k v a -> a
forall m a. Monoid m => (a -> m) -> Entry k v a -> m
forall b a. (b -> a -> b) -> b -> Entry k v a -> b
forall a b. (a -> b -> b) -> b -> Entry k v a -> b
forall k v a. Eq a => a -> Entry k v a -> Bool
forall k v a. Num a => Entry k v a -> a
forall k v a. Ord a => Entry k v a -> a
forall k v m. Monoid m => Entry k v m -> m
forall k v a. Entry k v a -> Bool
forall k v a. Entry k v a -> Int
forall k v a. Entry k v a -> [a]
forall k v a. (a -> a -> a) -> Entry k v a -> a
forall k v m a. Monoid m => (a -> m) -> Entry k v a -> m
forall k v b a. (b -> a -> b) -> b -> Entry k v a -> b
forall k v a b. (a -> b -> b) -> b -> Entry k v a -> b
forall (t :: Type -> Type).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: Entry k v a -> a
$cproduct :: forall k v a. Num a => Entry k v a -> a
sum :: Entry k v a -> a
$csum :: forall k v a. Num a => Entry k v a -> a
minimum :: Entry k v a -> a
$cminimum :: forall k v a. Ord a => Entry k v a -> a
maximum :: Entry k v a -> a
$cmaximum :: forall k v a. Ord a => Entry k v a -> a
elem :: a -> Entry k v a -> Bool
$celem :: forall k v a. Eq a => a -> Entry k v a -> Bool
length :: Entry k v a -> Int
$clength :: forall k v a. Entry k v a -> Int
null :: Entry k v a -> Bool
$cnull :: forall k v a. Entry k v a -> Bool
toList :: Entry k v a -> [a]
$ctoList :: forall k v a. Entry k v a -> [a]
foldl1 :: (a -> a -> a) -> Entry k v a -> a
$cfoldl1 :: forall k v a. (a -> a -> a) -> Entry k v a -> a
foldr1 :: (a -> a -> a) -> Entry k v a -> a
$cfoldr1 :: forall k v a. (a -> a -> a) -> Entry k v a -> a
foldl' :: (b -> a -> b) -> b -> Entry k v a -> b
$cfoldl' :: forall k v b a. (b -> a -> b) -> b -> Entry k v a -> b
foldl :: (b -> a -> b) -> b -> Entry k v a -> b
$cfoldl :: forall k v b a. (b -> a -> b) -> b -> Entry k v a -> b
foldr' :: (a -> b -> b) -> b -> Entry k v a -> b
$cfoldr' :: forall k v a b. (a -> b -> b) -> b -> Entry k v a -> b
foldr :: (a -> b -> b) -> b -> Entry k v a -> b
$cfoldr :: forall k v a b. (a -> b -> b) -> b -> Entry k v a -> b
foldMap' :: (a -> m) -> Entry k v a -> m
$cfoldMap' :: forall k v m a. Monoid m => (a -> m) -> Entry k v a -> m
foldMap :: (a -> m) -> Entry k v a -> m
$cfoldMap :: forall k v m a. Monoid m => (a -> m) -> Entry k v a -> m
fold :: Entry k v m -> m
$cfold :: forall k v m. Monoid m => Entry k v m -> m
Foldable, Functor (Entry k v)
Foldable (Entry k v)
Functor (Entry k v)
-> Foldable (Entry k v)
-> (forall (f :: Type -> Type) a b.
    Applicative f =>
    (a -> f b) -> Entry k v a -> f (Entry k v b))
-> (forall (f :: Type -> Type) a.
    Applicative f =>
    Entry k v (f a) -> f (Entry k v a))
-> (forall (m :: Type -> Type) a b.
    Monad m =>
    (a -> m b) -> Entry k v a -> m (Entry k v b))
-> (forall (m :: Type -> Type) a.
    Monad m =>
    Entry k v (m a) -> m (Entry k v a))
-> Traversable (Entry k v)
(a -> f b) -> Entry k v a -> f (Entry k v b)
forall k v. Functor (Entry k v)
forall k v. Foldable (Entry k v)
forall k v (m :: Type -> Type) a.
Monad m =>
Entry k v (m a) -> m (Entry k v a)
forall k v (f :: Type -> Type) a.
Applicative f =>
Entry k v (f a) -> f (Entry k v a)
forall k v (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> Entry k v a -> m (Entry k v b)
forall k v (f :: Type -> Type) a b.
Applicative f =>
(a -> f b) -> Entry k v a -> f (Entry k v b)
forall (t :: Type -> Type).
Functor t
-> Foldable t
-> (forall (f :: Type -> Type) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: Type -> Type) a.
    Applicative f =>
    t (f a) -> f (t a))
-> (forall (m :: Type -> Type) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: Type -> Type) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: Type -> Type) a.
Monad m =>
Entry k v (m a) -> m (Entry k v a)
forall (f :: Type -> Type) a.
Applicative f =>
Entry k v (f a) -> f (Entry k v a)
forall (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> Entry k v a -> m (Entry k v b)
forall (f :: Type -> Type) a b.
Applicative f =>
(a -> f b) -> Entry k v a -> f (Entry k v b)
sequence :: Entry k v (m a) -> m (Entry k v a)
$csequence :: forall k v (m :: Type -> Type) a.
Monad m =>
Entry k v (m a) -> m (Entry k v a)
mapM :: (a -> m b) -> Entry k v a -> m (Entry k v b)
$cmapM :: forall k v (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> Entry k v a -> m (Entry k v b)
sequenceA :: Entry k v (f a) -> f (Entry k v a)
$csequenceA :: forall k v (f :: Type -> Type) a.
Applicative f =>
Entry k v (f a) -> f (Entry k v a)
traverse :: (a -> f b) -> Entry k v a -> f (Entry k v b)
$ctraverse :: forall k v (f :: Type -> Type) a b.
Applicative f =>
(a -> f b) -> Entry k v a -> f (Entry k v b)
$cp2Traversable :: forall k v. Foldable (Entry k v)
$cp1Traversable :: forall k v. Functor (Entry k v)
Traversable)

keyOf :: Entry k v a -> k
keyOf :: Entry k v a -> k
keyOf (Entry k
k v
_ a
_) = k
k

valOf :: Entry k v a -> (v, a)
valOf :: Entry k v a -> (v, a)
valOf (Entry k
_ v
v a
a) = (v
v, a
a)

instance (Ord k, Semigroup v) => FT.Measured (Tag k v) (Entry k v a) where
  measure :: Entry k v a -> Tag k v
measure (Entry k
k v
v a
_) = Int -> k -> v -> Tag k v
forall k v. Int -> k -> v -> Tag k v
Tag Int
1 k
k v
v

instance (Ord k, Semigroup v) => Functor (AnnotatedMap k v) where
  fmap :: (a -> b) -> AnnotatedMap k v a -> AnnotatedMap k v b
fmap a -> b
f (AnnotatedMap FingerTree (Tag k v) (Entry k v a)
ft) =
    FingerTree (Tag k v) (Entry k v b) -> AnnotatedMap k v b
forall k v a.
FingerTree (Tag k v) (Entry k v a) -> AnnotatedMap k v a
AnnotatedMap ((Entry k v a -> Entry k v b)
-> FingerTree (Tag k v) (Entry k v a)
-> FingerTree (Tag k v) (Entry k v b)
forall a b v. (a -> b) -> FingerTree v a -> FingerTree v b
FT.unsafeFmap ((a -> b) -> Entry k v a -> Entry k v b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) FingerTree (Tag k v) (Entry k v a)
ft)

instance (Ord k, Semigroup v) => Foldable.Foldable (AnnotatedMap k v) where
  foldr :: (a -> b -> b) -> b -> AnnotatedMap k v a -> b
foldr a -> b -> b
f b
z (AnnotatedMap FingerTree (Tag k v) (Entry k v a)
ft) =
    (a -> b -> b) -> b -> [a] -> b
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> b -> b
f b
z [ a
a | Entry k
_ v
_ a
a <- FingerTree (Tag k v) (Entry k v a) -> [Entry k v a]
forall (t :: Type -> Type) a. Foldable t => t a -> [a]
Foldable.toList FingerTree (Tag k v) (Entry k v a)
ft ]

instance (Ord k, Semigroup v) => Traversable (AnnotatedMap k v) where
  traverse :: (a -> f b) -> AnnotatedMap k v a -> f (AnnotatedMap k v b)
traverse a -> f b
f (AnnotatedMap FingerTree (Tag k v) (Entry k v a)
ft) =
    FingerTree (Tag k v) (Entry k v b) -> AnnotatedMap k v b
forall k v a.
FingerTree (Tag k v) (Entry k v a) -> AnnotatedMap k v a
AnnotatedMap (FingerTree (Tag k v) (Entry k v b) -> AnnotatedMap k v b)
-> f (FingerTree (Tag k v) (Entry k v b)) -> f (AnnotatedMap k v b)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (Entry k v a -> f (Entry k v b))
-> FingerTree (Tag k v) (Entry k v a)
-> f (FingerTree (Tag k v) (Entry k v b))
forall (f :: Type -> Type) a b v.
Applicative f =>
(a -> f b) -> FingerTree v a -> f (FingerTree v b)
FT.unsafeTraverse ((a -> f b) -> Entry k v a -> f (Entry k v b)
forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f) FingerTree (Tag k v) (Entry k v a)
ft

annotation :: (Ord k, Semigroup v) => AnnotatedMap k v a -> Maybe v
annotation :: AnnotatedMap k v a -> Maybe v
annotation (AnnotatedMap FingerTree (Tag k v) (Entry k v a)
ft) =
  case FingerTree (Tag k v) (Entry k v a) -> Tag k v
forall v a. Measured v a => a -> v
FT.measure FingerTree (Tag k v) (Entry k v a)
ft of
    Tag Int
_ k
_ v
v -> v -> Maybe v
forall a. a -> Maybe a
Just v
v
    Tag k v
NoTag     -> Maybe v
forall a. Maybe a
Nothing

toList :: AnnotatedMap k v a -> [(k, a)]
toList :: AnnotatedMap k v a -> [(k, a)]
toList (AnnotatedMap FingerTree (Tag k v) (Entry k v a)
ft) =
  [ (k
k, a
a) | Entry k
k v
_ a
a <- FingerTree (Tag k v) (Entry k v a) -> [Entry k v a]
forall (t :: Type -> Type) a. Foldable t => t a -> [a]
Foldable.toList FingerTree (Tag k v) (Entry k v a)
ft ]

fromAscList :: (Ord k, Semigroup v) => [(k,v,a)] -> AnnotatedMap k v a
fromAscList :: [(k, v, a)] -> AnnotatedMap k v a
fromAscList = FingerTree (Tag k v) (Entry k v a) -> AnnotatedMap k v a
forall k v a.
FingerTree (Tag k v) (Entry k v a) -> AnnotatedMap k v a
AnnotatedMap (FingerTree (Tag k v) (Entry k v a) -> AnnotatedMap k v a)
-> ([(k, v, a)] -> FingerTree (Tag k v) (Entry k v a))
-> [(k, v, a)]
-> AnnotatedMap k v a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Entry k v a] -> FingerTree (Tag k v) (Entry k v a)
forall v a. Measured v a => [a] -> FingerTree v a
FT.fromList ([Entry k v a] -> FingerTree (Tag k v) (Entry k v a))
-> ([(k, v, a)] -> [Entry k v a])
-> [(k, v, a)]
-> FingerTree (Tag k v) (Entry k v a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((k, v, a) -> Entry k v a) -> [(k, v, a)] -> [Entry k v a]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (k, v, a) -> Entry k v a
forall k v a. (k, v, a) -> Entry k v a
f
  where
    f :: (k, v, a) -> Entry k v a
f (k
k, v
v, a
a) = k -> v -> a -> Entry k v a
forall k v a. k -> v -> a -> Entry k v a
Entry k
k v
v a
a

listEqBy :: (a -> a -> Bool) -> [a] -> [a] -> Bool
listEqBy :: (a -> a -> Bool) -> [a] -> [a] -> Bool
listEqBy a -> a -> Bool
_ [] [] = Bool
True
listEqBy a -> a -> Bool
f (a
x : [a]
xs) (a
y : [a]
ys)
  | a -> a -> Bool
f a
x a
y = (a -> a -> Bool) -> [a] -> [a] -> Bool
forall a. (a -> a -> Bool) -> [a] -> [a] -> Bool
listEqBy a -> a -> Bool
f [a]
xs [a]
ys
listEqBy a -> a -> Bool
_ [a]
_ [a]
_ = Bool
False

eqBy :: Eq k => (a -> a -> Bool) -> AnnotatedMap k v a -> AnnotatedMap k v a -> Bool
eqBy :: (a -> a -> Bool)
-> AnnotatedMap k v a -> AnnotatedMap k v a -> Bool
eqBy a -> a -> Bool
f AnnotatedMap k v a
x AnnotatedMap k v a
y = ((k, a) -> (k, a) -> Bool) -> [(k, a)] -> [(k, a)] -> Bool
forall a. (a -> a -> Bool) -> [a] -> [a] -> Bool
listEqBy (\(k
kx,a
ax) (k
ky,a
ay) -> k
kx k -> k -> Bool
forall a. Eq a => a -> a -> Bool
== k
ky Bool -> Bool -> Bool
&& a -> a -> Bool
f a
ax a
ay) (AnnotatedMap k v a -> [(k, a)]
forall k v a. AnnotatedMap k v a -> [(k, a)]
toList AnnotatedMap k v a
x) (AnnotatedMap k v a -> [(k, a)]
forall k v a. AnnotatedMap k v a -> [(k, a)]
toList AnnotatedMap k v a
y)

null :: AnnotatedMap k v a -> Bool
null :: AnnotatedMap k v a -> Bool
null (AnnotatedMap FingerTree (Tag k v) (Entry k v a)
ft) = FingerTree (Tag k v) (Entry k v a) -> Bool
forall v a. FingerTree v a -> Bool
FT.null FingerTree (Tag k v) (Entry k v a)
ft

empty :: (Ord k, Semigroup v) => AnnotatedMap k v a
empty :: AnnotatedMap k v a
empty = FingerTree (Tag k v) (Entry k v a) -> AnnotatedMap k v a
forall k v a.
FingerTree (Tag k v) (Entry k v a) -> AnnotatedMap k v a
AnnotatedMap FingerTree (Tag k v) (Entry k v a)
forall v a. Measured v a => FingerTree v a
FT.empty

singleton :: (Ord k, Semigroup v) => k -> v -> a -> AnnotatedMap k v a
singleton :: k -> v -> a -> AnnotatedMap k v a
singleton k
k v
v a
a =
  FingerTree (Tag k v) (Entry k v a) -> AnnotatedMap k v a
forall k v a.
FingerTree (Tag k v) (Entry k v a) -> AnnotatedMap k v a
AnnotatedMap (Entry k v a -> FingerTree (Tag k v) (Entry k v a)
forall v a. Measured v a => a -> FingerTree v a
FT.singleton (k -> v -> a -> Entry k v a
forall k v a. k -> v -> a -> Entry k v a
Entry k
k v
v a
a))

size :: (Ord k, Semigroup v) => AnnotatedMap k v a -> Int
size :: AnnotatedMap k v a -> Int
size (AnnotatedMap FingerTree (Tag k v) (Entry k v a)
ft) =
  case FingerTree (Tag k v) (Entry k v a) -> Tag k v
forall v a. Measured v a => a -> v
FT.measure FingerTree (Tag k v) (Entry k v a)
ft of
    Tag Int
i k
_ v
_ -> Int
i
    Tag k v
NoTag     -> Int
0

splitAtKey ::
  (Ord k, Semigroup v) =>
  k -> FT.FingerTree (Tag k v) (Entry k v a) ->
  ( FT.FingerTree (Tag k v) (Entry k v a)
  , Maybe (Entry k v a)
  , FT.FingerTree (Tag k v) (Entry k v a)
  )
splitAtKey :: k
-> FingerTree (Tag k v) (Entry k v a)
-> (FingerTree (Tag k v) (Entry k v a), Maybe (Entry k v a),
    FingerTree (Tag k v) (Entry k v a))
splitAtKey k
k FingerTree (Tag k v) (Entry k v a)
ft =
  case FingerTree (Tag k v) (Entry k v a)
-> ViewL (FingerTree (Tag k v)) (Entry k v a)
forall v a.
Measured v a =>
FingerTree v a -> ViewL (FingerTree v) a
FT.viewl FingerTree (Tag k v) (Entry k v a)
r of
    Entry k v a
e FT.:< FingerTree (Tag k v) (Entry k v a)
r' | k
k k -> k -> Bool
forall a. Eq a => a -> a -> Bool
== Entry k v a -> k
forall k v a. Entry k v a -> k
keyOf Entry k v a
e -> (FingerTree (Tag k v) (Entry k v a)
l, Entry k v a -> Maybe (Entry k v a)
forall a. a -> Maybe a
Just Entry k v a
e, FingerTree (Tag k v) (Entry k v a)
r')
    ViewL (FingerTree (Tag k v)) (Entry k v a)
_ -> (FingerTree (Tag k v) (Entry k v a)
l, Maybe (Entry k v a)
forall a. Maybe a
Nothing, FingerTree (Tag k v) (Entry k v a)
r)
  where
    (FingerTree (Tag k v) (Entry k v a)
l, FingerTree (Tag k v) (Entry k v a)
r) = (Tag k v -> Bool)
-> FingerTree (Tag k v) (Entry k v a)
-> (FingerTree (Tag k v) (Entry k v a),
    FingerTree (Tag k v) (Entry k v a))
forall v a.
Measured v a =>
(v -> Bool) -> FingerTree v a -> (FingerTree v a, FingerTree v a)
FT.split Tag k v -> Bool
forall v. Tag k v -> Bool
found FingerTree (Tag k v) (Entry k v a)
ft
    found :: Tag k v -> Bool
found Tag k v
NoTag = Bool
False
    found (Tag Int
_ k
k' v
_) = k
k k -> k -> Bool
forall a. Ord a => a -> a -> Bool
<= k
k'

insert ::
  (Ord k, Semigroup v) =>
  k -> v -> a -> AnnotatedMap k v a -> AnnotatedMap k v a
insert :: k -> v -> a -> AnnotatedMap k v a -> AnnotatedMap k v a
insert k
k v
v a
a (AnnotatedMap FingerTree (Tag k v) (Entry k v a)
ft) =
  FingerTree (Tag k v) (Entry k v a) -> AnnotatedMap k v a
forall k v a.
FingerTree (Tag k v) (Entry k v a) -> AnnotatedMap k v a
AnnotatedMap (FingerTree (Tag k v) (Entry k v a)
l FingerTree (Tag k v) (Entry k v a)
-> FingerTree (Tag k v) (Entry k v a)
-> FingerTree (Tag k v) (Entry k v a)
forall v a.
Measured v a =>
FingerTree v a -> FingerTree v a -> FingerTree v a
>< (k -> v -> a -> Entry k v a
forall k v a. k -> v -> a -> Entry k v a
Entry k
k v
v a
a Entry k v a
-> FingerTree (Tag k v) (Entry k v a)
-> FingerTree (Tag k v) (Entry k v a)
forall v a. Measured v a => a -> FingerTree v a -> FingerTree v a
<| FingerTree (Tag k v) (Entry k v a)
r))
  where
    (FingerTree (Tag k v) (Entry k v a)
l, Maybe (Entry k v a)
_, FingerTree (Tag k v) (Entry k v a)
r) = k
-> FingerTree (Tag k v) (Entry k v a)
-> (FingerTree (Tag k v) (Entry k v a), Maybe (Entry k v a),
    FingerTree (Tag k v) (Entry k v a))
forall k v a.
(Ord k, Semigroup v) =>
k
-> FingerTree (Tag k v) (Entry k v a)
-> (FingerTree (Tag k v) (Entry k v a), Maybe (Entry k v a),
    FingerTree (Tag k v) (Entry k v a))
splitAtKey k
k FingerTree (Tag k v) (Entry k v a)
ft

lookup :: (Ord k, Semigroup v) => k -> AnnotatedMap k v a -> Maybe (v, a)
lookup :: k -> AnnotatedMap k v a -> Maybe (v, a)
lookup k
k (AnnotatedMap FingerTree (Tag k v) (Entry k v a)
ft) = Entry k v a -> (v, a)
forall k v a. Entry k v a -> (v, a)
valOf (Entry k v a -> (v, a)) -> Maybe (Entry k v a) -> Maybe (v, a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Entry k v a)
m
  where
    (FingerTree (Tag k v) (Entry k v a)
_, Maybe (Entry k v a)
m, FingerTree (Tag k v) (Entry k v a)
_) = k
-> FingerTree (Tag k v) (Entry k v a)
-> (FingerTree (Tag k v) (Entry k v a), Maybe (Entry k v a),
    FingerTree (Tag k v) (Entry k v a))
forall k v a.
(Ord k, Semigroup v) =>
k
-> FingerTree (Tag k v) (Entry k v a)
-> (FingerTree (Tag k v) (Entry k v a), Maybe (Entry k v a),
    FingerTree (Tag k v) (Entry k v a))
splitAtKey k
k FingerTree (Tag k v) (Entry k v a)
ft

delete :: (Ord k, Semigroup v) => k -> AnnotatedMap k v a -> AnnotatedMap k v a
delete :: k -> AnnotatedMap k v a -> AnnotatedMap k v a
delete k
k m :: AnnotatedMap k v a
m@(AnnotatedMap FingerTree (Tag k v) (Entry k v a)
ft) =
  case k
-> FingerTree (Tag k v) (Entry k v a)
-> (FingerTree (Tag k v) (Entry k v a), Maybe (Entry k v a),
    FingerTree (Tag k v) (Entry k v a))
forall k v a.
(Ord k, Semigroup v) =>
k
-> FingerTree (Tag k v) (Entry k v a)
-> (FingerTree (Tag k v) (Entry k v a), Maybe (Entry k v a),
    FingerTree (Tag k v) (Entry k v a))
splitAtKey k
k FingerTree (Tag k v) (Entry k v a)
ft of
    (FingerTree (Tag k v) (Entry k v a)
_, Maybe (Entry k v a)
Nothing, FingerTree (Tag k v) (Entry k v a)
_) -> AnnotatedMap k v a
m
    (FingerTree (Tag k v) (Entry k v a)
l, Just Entry k v a
_, FingerTree (Tag k v) (Entry k v a)
r)  -> FingerTree (Tag k v) (Entry k v a) -> AnnotatedMap k v a
forall k v a.
FingerTree (Tag k v) (Entry k v a) -> AnnotatedMap k v a
AnnotatedMap (FingerTree (Tag k v) (Entry k v a)
l FingerTree (Tag k v) (Entry k v a)
-> FingerTree (Tag k v) (Entry k v a)
-> FingerTree (Tag k v) (Entry k v a)
forall v a.
Measured v a =>
FingerTree v a -> FingerTree v a -> FingerTree v a
>< FingerTree (Tag k v) (Entry k v a)
r)

alter ::
  (Ord k, Semigroup v) =>
  (Maybe (v, a) -> Maybe (v, a)) -> k -> AnnotatedMap k v a -> AnnotatedMap k v a
alter :: (Maybe (v, a) -> Maybe (v, a))
-> k -> AnnotatedMap k v a -> AnnotatedMap k v a
alter Maybe (v, a) -> Maybe (v, a)
f k
k (AnnotatedMap FingerTree (Tag k v) (Entry k v a)
ft) =
  case Maybe (v, a) -> Maybe (v, a)
f ((Entry k v a -> (v, a)) -> Maybe (Entry k v a) -> Maybe (v, a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Entry k v a -> (v, a)
forall k v a. Entry k v a -> (v, a)
valOf Maybe (Entry k v a)
m) of
    Maybe (v, a)
Nothing -> FingerTree (Tag k v) (Entry k v a) -> AnnotatedMap k v a
forall k v a.
FingerTree (Tag k v) (Entry k v a) -> AnnotatedMap k v a
AnnotatedMap (FingerTree (Tag k v) (Entry k v a)
l FingerTree (Tag k v) (Entry k v a)
-> FingerTree (Tag k v) (Entry k v a)
-> FingerTree (Tag k v) (Entry k v a)
forall v a.
Measured v a =>
FingerTree v a -> FingerTree v a -> FingerTree v a
>< FingerTree (Tag k v) (Entry k v a)
r)
    Just (v
v, a
a) -> FingerTree (Tag k v) (Entry k v a) -> AnnotatedMap k v a
forall k v a.
FingerTree (Tag k v) (Entry k v a) -> AnnotatedMap k v a
AnnotatedMap (FingerTree (Tag k v) (Entry k v a)
l FingerTree (Tag k v) (Entry k v a)
-> FingerTree (Tag k v) (Entry k v a)
-> FingerTree (Tag k v) (Entry k v a)
forall v a.
Measured v a =>
FingerTree v a -> FingerTree v a -> FingerTree v a
>< (k -> v -> a -> Entry k v a
forall k v a. k -> v -> a -> Entry k v a
Entry k
k v
v a
a Entry k v a
-> FingerTree (Tag k v) (Entry k v a)
-> FingerTree (Tag k v) (Entry k v a)
forall v a. Measured v a => a -> FingerTree v a -> FingerTree v a
<| FingerTree (Tag k v) (Entry k v a)
r))
  where
    (FingerTree (Tag k v) (Entry k v a)
l, Maybe (Entry k v a)
m, FingerTree (Tag k v) (Entry k v a)
r) = k
-> FingerTree (Tag k v) (Entry k v a)
-> (FingerTree (Tag k v) (Entry k v a), Maybe (Entry k v a),
    FingerTree (Tag k v) (Entry k v a))
forall k v a.
(Ord k, Semigroup v) =>
k
-> FingerTree (Tag k v) (Entry k v a)
-> (FingerTree (Tag k v) (Entry k v a), Maybe (Entry k v a),
    FingerTree (Tag k v) (Entry k v a))
splitAtKey k
k FingerTree (Tag k v) (Entry k v a)
ft

alterF ::
  (Functor f, Ord k, Semigroup v) =>
  (Maybe (v, a) -> f (Maybe (v, a))) -> k -> AnnotatedMap k v a -> f (AnnotatedMap k v a)
alterF :: (Maybe (v, a) -> f (Maybe (v, a)))
-> k -> AnnotatedMap k v a -> f (AnnotatedMap k v a)
alterF Maybe (v, a) -> f (Maybe (v, a))
f k
k (AnnotatedMap FingerTree (Tag k v) (Entry k v a)
ft) = Maybe (v, a) -> AnnotatedMap k v a
rebuild (Maybe (v, a) -> AnnotatedMap k v a)
-> f (Maybe (v, a)) -> f (AnnotatedMap k v a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (v, a) -> f (Maybe (v, a))
f ((Entry k v a -> (v, a)) -> Maybe (Entry k v a) -> Maybe (v, a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Entry k v a -> (v, a)
forall k v a. Entry k v a -> (v, a)
valOf Maybe (Entry k v a)
m)
  where
    (FingerTree (Tag k v) (Entry k v a)
l, Maybe (Entry k v a)
m, FingerTree (Tag k v) (Entry k v a)
r) = k
-> FingerTree (Tag k v) (Entry k v a)
-> (FingerTree (Tag k v) (Entry k v a), Maybe (Entry k v a),
    FingerTree (Tag k v) (Entry k v a))
forall k v a.
(Ord k, Semigroup v) =>
k
-> FingerTree (Tag k v) (Entry k v a)
-> (FingerTree (Tag k v) (Entry k v a), Maybe (Entry k v a),
    FingerTree (Tag k v) (Entry k v a))
splitAtKey k
k FingerTree (Tag k v) (Entry k v a)
ft

    rebuild :: Maybe (v, a) -> AnnotatedMap k v a
rebuild Maybe (v, a)
Nothing       = FingerTree (Tag k v) (Entry k v a) -> AnnotatedMap k v a
forall k v a.
FingerTree (Tag k v) (Entry k v a) -> AnnotatedMap k v a
AnnotatedMap (FingerTree (Tag k v) (Entry k v a)
l FingerTree (Tag k v) (Entry k v a)
-> FingerTree (Tag k v) (Entry k v a)
-> FingerTree (Tag k v) (Entry k v a)
forall v a.
Measured v a =>
FingerTree v a -> FingerTree v a -> FingerTree v a
>< FingerTree (Tag k v) (Entry k v a)
r)
    rebuild (Just (v
v, a
a)) = FingerTree (Tag k v) (Entry k v a) -> AnnotatedMap k v a
forall k v a.
FingerTree (Tag k v) (Entry k v a) -> AnnotatedMap k v a
AnnotatedMap (FingerTree (Tag k v) (Entry k v a)
l FingerTree (Tag k v) (Entry k v a)
-> FingerTree (Tag k v) (Entry k v a)
-> FingerTree (Tag k v) (Entry k v a)
forall v a.
Measured v a =>
FingerTree v a -> FingerTree v a -> FingerTree v a
>< (k -> v -> a -> Entry k v a
forall k v a. k -> v -> a -> Entry k v a
Entry k
k v
v a
a) Entry k v a
-> FingerTree (Tag k v) (Entry k v a)
-> FingerTree (Tag k v) (Entry k v a)
forall v a. Measured v a => a -> FingerTree v a -> FingerTree v a
<| FingerTree (Tag k v) (Entry k v a)
r)


union ::
  (Ord k, Semigroup v) =>
  AnnotatedMap k v a -> AnnotatedMap k v a -> AnnotatedMap k v a
union :: AnnotatedMap k v a -> AnnotatedMap k v a -> AnnotatedMap k v a
union = (Entry k v a -> Entry k v a -> Maybe (Entry k v a))
-> AnnotatedMap k v a -> AnnotatedMap k v a -> AnnotatedMap k v a
forall k v a.
(Ord k, Semigroup v) =>
(Entry k v a -> Entry k v a -> Maybe (Entry k v a))
-> AnnotatedMap k v a -> AnnotatedMap k v a -> AnnotatedMap k v a
unionGeneric (Maybe (Entry k v a) -> Entry k v a -> Maybe (Entry k v a)
forall a b. a -> b -> a
const (Maybe (Entry k v a) -> Entry k v a -> Maybe (Entry k v a))
-> (Entry k v a -> Maybe (Entry k v a))
-> Entry k v a
-> Entry k v a
-> Maybe (Entry k v a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Entry k v a -> Maybe (Entry k v a)
forall a. a -> Maybe a
Just)

unionWith ::
  (Ord k, Semigroup v) =>
  ((v, a) -> (v, a) -> (v, a)) ->
  AnnotatedMap k v a -> AnnotatedMap k v a -> AnnotatedMap k v a
unionWith :: ((v, a) -> (v, a) -> (v, a))
-> AnnotatedMap k v a -> AnnotatedMap k v a -> AnnotatedMap k v a
unionWith (v, a) -> (v, a) -> (v, a)
f = (Entry k v a -> Entry k v a -> Maybe (Entry k v a))
-> AnnotatedMap k v a -> AnnotatedMap k v a -> AnnotatedMap k v a
forall k v a.
(Ord k, Semigroup v) =>
(Entry k v a -> Entry k v a -> Maybe (Entry k v a))
-> AnnotatedMap k v a -> AnnotatedMap k v a -> AnnotatedMap k v a
unionGeneric Entry k v a -> Entry k v a -> Maybe (Entry k v a)
forall k k. Entry k v a -> Entry k v a -> Maybe (Entry k v a)
g
  where
    g :: Entry k v a -> Entry k v a -> Maybe (Entry k v a)
g (Entry k
k v
v1 a
x1) (Entry k
_ v
v2 a
x2) = Entry k v a -> Maybe (Entry k v a)
forall a. a -> Maybe a
Just (k -> v -> a -> Entry k v a
forall k v a. k -> v -> a -> Entry k v a
Entry k
k v
v3 a
x3)
      where (v
v3, a
x3) = (v, a) -> (v, a) -> (v, a)
f (v
v1, a
x1) (v
v2, a
x2)

unionWithKeyMaybe ::
  (Ord k, Semigroup v) =>
  (k -> a -> a -> Maybe (v, a)) ->
  AnnotatedMap k v a -> AnnotatedMap k v a -> AnnotatedMap k v a
unionWithKeyMaybe :: (k -> a -> a -> Maybe (v, a))
-> AnnotatedMap k v a -> AnnotatedMap k v a -> AnnotatedMap k v a
unionWithKeyMaybe k -> a -> a -> Maybe (v, a)
f = (Entry k v a -> Entry k v a -> Maybe (Entry k v a))
-> AnnotatedMap k v a -> AnnotatedMap k v a -> AnnotatedMap k v a
forall k v a.
(Ord k, Semigroup v) =>
(Entry k v a -> Entry k v a -> Maybe (Entry k v a))
-> AnnotatedMap k v a -> AnnotatedMap k v a -> AnnotatedMap k v a
unionGeneric Entry k v a -> Entry k v a -> Maybe (Entry k v a)
forall v k v. Entry k v a -> Entry k v a -> Maybe (Entry k v a)
g
  where g :: Entry k v a -> Entry k v a -> Maybe (Entry k v a)
g (Entry k
k v
_ a
x) (Entry k
_ v
_ a
y) = ((v, a) -> Entry k v a) -> Maybe (v, a) -> Maybe (Entry k v a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(v
v, a
z) -> k -> v -> a -> Entry k v a
forall k v a. k -> v -> a -> Entry k v a
Entry k
k v
v a
z) (k -> a -> a -> Maybe (v, a)
f k
k a
x a
y)

unionGeneric ::
  (Ord k, Semigroup v) =>
  (Entry k v a -> Entry k v a -> Maybe (Entry k v a)) ->
  AnnotatedMap k v a -> AnnotatedMap k v a -> AnnotatedMap k v a
unionGeneric :: (Entry k v a -> Entry k v a -> Maybe (Entry k v a))
-> AnnotatedMap k v a -> AnnotatedMap k v a -> AnnotatedMap k v a
unionGeneric Entry k v a -> Entry k v a -> Maybe (Entry k v a)
f (AnnotatedMap FingerTree (Tag k v) (Entry k v a)
ft1) (AnnotatedMap FingerTree (Tag k v) (Entry k v a)
ft2) = FingerTree (Tag k v) (Entry k v a) -> AnnotatedMap k v a
forall k v a.
FingerTree (Tag k v) (Entry k v a) -> AnnotatedMap k v a
AnnotatedMap (FingerTree (Tag k v) (Entry k v a)
-> FingerTree (Tag k v) (Entry k v a)
-> FingerTree (Tag k v) (Entry k v a)
merge1 FingerTree (Tag k v) (Entry k v a)
ft1 FingerTree (Tag k v) (Entry k v a)
ft2)
  where
    merge1 :: FingerTree (Tag k v) (Entry k v a)
-> FingerTree (Tag k v) (Entry k v a)
-> FingerTree (Tag k v) (Entry k v a)
merge1 FingerTree (Tag k v) (Entry k v a)
xs FingerTree (Tag k v) (Entry k v a)
ys =
      case FingerTree (Tag k v) (Entry k v a)
-> ViewL (FingerTree (Tag k v)) (Entry k v a)
forall v a.
Measured v a =>
FingerTree v a -> ViewL (FingerTree v) a
FT.viewl FingerTree (Tag k v) (Entry k v a)
xs of
        ViewL (FingerTree (Tag k v)) (Entry k v a)
FT.EmptyL -> FingerTree (Tag k v) (Entry k v a)
ys
        Entry k v a
x FT.:< FingerTree (Tag k v) (Entry k v a)
xs' ->
          case Maybe (Entry k v a)
ym of
            Maybe (Entry k v a)
Nothing -> FingerTree (Tag k v) (Entry k v a)
ys1 FingerTree (Tag k v) (Entry k v a)
-> FingerTree (Tag k v) (Entry k v a)
-> FingerTree (Tag k v) (Entry k v a)
forall v a.
Measured v a =>
FingerTree v a -> FingerTree v a -> FingerTree v a
>< (Entry k v a
x Entry k v a
-> FingerTree (Tag k v) (Entry k v a)
-> FingerTree (Tag k v) (Entry k v a)
forall v a. Measured v a => a -> FingerTree v a -> FingerTree v a
<| FingerTree (Tag k v) (Entry k v a)
-> FingerTree (Tag k v) (Entry k v a)
-> FingerTree (Tag k v) (Entry k v a)
merge2 FingerTree (Tag k v) (Entry k v a)
xs' FingerTree (Tag k v) (Entry k v a)
ys2)
            Just Entry k v a
y ->
              case Entry k v a -> Entry k v a -> Maybe (Entry k v a)
f Entry k v a
x Entry k v a
y of
                Maybe (Entry k v a)
Nothing -> FingerTree (Tag k v) (Entry k v a)
ys1 FingerTree (Tag k v) (Entry k v a)
-> FingerTree (Tag k v) (Entry k v a)
-> FingerTree (Tag k v) (Entry k v a)
forall v a.
Measured v a =>
FingerTree v a -> FingerTree v a -> FingerTree v a
>< FingerTree (Tag k v) (Entry k v a)
-> FingerTree (Tag k v) (Entry k v a)
-> FingerTree (Tag k v) (Entry k v a)
merge2 FingerTree (Tag k v) (Entry k v a)
xs' FingerTree (Tag k v) (Entry k v a)
ys2
                Just Entry k v a
z -> FingerTree (Tag k v) (Entry k v a)
ys1 FingerTree (Tag k v) (Entry k v a)
-> FingerTree (Tag k v) (Entry k v a)
-> FingerTree (Tag k v) (Entry k v a)
forall v a.
Measured v a =>
FingerTree v a -> FingerTree v a -> FingerTree v a
>< (Entry k v a
z Entry k v a
-> FingerTree (Tag k v) (Entry k v a)
-> FingerTree (Tag k v) (Entry k v a)
forall v a. Measured v a => a -> FingerTree v a -> FingerTree v a
<| FingerTree (Tag k v) (Entry k v a)
-> FingerTree (Tag k v) (Entry k v a)
-> FingerTree (Tag k v) (Entry k v a)
merge2 FingerTree (Tag k v) (Entry k v a)
xs' FingerTree (Tag k v) (Entry k v a)
ys2)
          where
            (FingerTree (Tag k v) (Entry k v a)
ys1, Maybe (Entry k v a)
ym, FingerTree (Tag k v) (Entry k v a)
ys2) = k
-> FingerTree (Tag k v) (Entry k v a)
-> (FingerTree (Tag k v) (Entry k v a), Maybe (Entry k v a),
    FingerTree (Tag k v) (Entry k v a))
forall k v a.
(Ord k, Semigroup v) =>
k
-> FingerTree (Tag k v) (Entry k v a)
-> (FingerTree (Tag k v) (Entry k v a), Maybe (Entry k v a),
    FingerTree (Tag k v) (Entry k v a))
splitAtKey (Entry k v a -> k
forall k v a. Entry k v a -> k
keyOf Entry k v a
x) FingerTree (Tag k v) (Entry k v a)
ys

    merge2 :: FingerTree (Tag k v) (Entry k v a)
-> FingerTree (Tag k v) (Entry k v a)
-> FingerTree (Tag k v) (Entry k v a)
merge2 FingerTree (Tag k v) (Entry k v a)
xs FingerTree (Tag k v) (Entry k v a)
ys =
      case FingerTree (Tag k v) (Entry k v a)
-> ViewL (FingerTree (Tag k v)) (Entry k v a)
forall v a.
Measured v a =>
FingerTree v a -> ViewL (FingerTree v) a
FT.viewl FingerTree (Tag k v) (Entry k v a)
ys of
        ViewL (FingerTree (Tag k v)) (Entry k v a)
FT.EmptyL -> FingerTree (Tag k v) (Entry k v a)
xs
        Entry k v a
y FT.:< FingerTree (Tag k v) (Entry k v a)
ys' ->
          case Maybe (Entry k v a)
xm of
            Maybe (Entry k v a)
Nothing -> FingerTree (Tag k v) (Entry k v a)
xs1 FingerTree (Tag k v) (Entry k v a)
-> FingerTree (Tag k v) (Entry k v a)
-> FingerTree (Tag k v) (Entry k v a)
forall v a.
Measured v a =>
FingerTree v a -> FingerTree v a -> FingerTree v a
>< (Entry k v a
y Entry k v a
-> FingerTree (Tag k v) (Entry k v a)
-> FingerTree (Tag k v) (Entry k v a)
forall v a. Measured v a => a -> FingerTree v a -> FingerTree v a
<| FingerTree (Tag k v) (Entry k v a)
-> FingerTree (Tag k v) (Entry k v a)
-> FingerTree (Tag k v) (Entry k v a)
merge1 FingerTree (Tag k v) (Entry k v a)
xs2 FingerTree (Tag k v) (Entry k v a)
ys')
            Just Entry k v a
x ->
              case Entry k v a -> Entry k v a -> Maybe (Entry k v a)
f Entry k v a
x Entry k v a
y of
                Maybe (Entry k v a)
Nothing -> FingerTree (Tag k v) (Entry k v a)
xs1 FingerTree (Tag k v) (Entry k v a)
-> FingerTree (Tag k v) (Entry k v a)
-> FingerTree (Tag k v) (Entry k v a)
forall v a.
Measured v a =>
FingerTree v a -> FingerTree v a -> FingerTree v a
>< FingerTree (Tag k v) (Entry k v a)
-> FingerTree (Tag k v) (Entry k v a)
-> FingerTree (Tag k v) (Entry k v a)
merge1 FingerTree (Tag k v) (Entry k v a)
xs2 FingerTree (Tag k v) (Entry k v a)
ys'
                Just Entry k v a
z -> FingerTree (Tag k v) (Entry k v a)
xs1 FingerTree (Tag k v) (Entry k v a)
-> FingerTree (Tag k v) (Entry k v a)
-> FingerTree (Tag k v) (Entry k v a)
forall v a.
Measured v a =>
FingerTree v a -> FingerTree v a -> FingerTree v a
>< (Entry k v a
z Entry k v a
-> FingerTree (Tag k v) (Entry k v a)
-> FingerTree (Tag k v) (Entry k v a)
forall v a. Measured v a => a -> FingerTree v a -> FingerTree v a
<| FingerTree (Tag k v) (Entry k v a)
-> FingerTree (Tag k v) (Entry k v a)
-> FingerTree (Tag k v) (Entry k v a)
merge1 FingerTree (Tag k v) (Entry k v a)
xs2 FingerTree (Tag k v) (Entry k v a)
ys')
          where
            (FingerTree (Tag k v) (Entry k v a)
xs1, Maybe (Entry k v a)
xm, FingerTree (Tag k v) (Entry k v a)
xs2) = k
-> FingerTree (Tag k v) (Entry k v a)
-> (FingerTree (Tag k v) (Entry k v a), Maybe (Entry k v a),
    FingerTree (Tag k v) (Entry k v a))
forall k v a.
(Ord k, Semigroup v) =>
k
-> FingerTree (Tag k v) (Entry k v a)
-> (FingerTree (Tag k v) (Entry k v a), Maybe (Entry k v a),
    FingerTree (Tag k v) (Entry k v a))
splitAtKey (Entry k v a -> k
forall k v a. Entry k v a -> k
keyOf Entry k v a
y) FingerTree (Tag k v) (Entry k v a)
xs

filter ::
  (Ord k, Semigroup v) =>
  (a -> Bool) -> AnnotatedMap k v a -> AnnotatedMap k v a
filter :: (a -> Bool) -> AnnotatedMap k v a -> AnnotatedMap k v a
filter a -> Bool
f (AnnotatedMap FingerTree (Tag k v) (Entry k v a)
ft) = FingerTree (Tag k v) (Entry k v a) -> AnnotatedMap k v a
forall k v a.
FingerTree (Tag k v) (Entry k v a) -> AnnotatedMap k v a
AnnotatedMap ((Entry k v a -> Bool)
-> FingerTree (Tag k v) (Entry k v a)
-> FingerTree (Tag k v) (Entry k v a)
forall v a.
Measured v a =>
(a -> Bool) -> FingerTree v a -> FingerTree v a
filterFingerTree Entry k v a -> Bool
forall k v. Entry k v a -> Bool
g FingerTree (Tag k v) (Entry k v a)
ft)
  where g :: Entry k v a -> Bool
g (Entry k
_ v
_ a
a) = a -> Bool
f a
a

mapMaybe ::
  (Ord k, Semigroup v) =>
  (a -> Maybe b) ->
  AnnotatedMap k v a -> AnnotatedMap k v b
mapMaybe :: (a -> Maybe b) -> AnnotatedMap k v a -> AnnotatedMap k v b
mapMaybe a -> Maybe b
f (AnnotatedMap FingerTree (Tag k v) (Entry k v a)
ft) =
  FingerTree (Tag k v) (Entry k v b) -> AnnotatedMap k v b
forall k v a.
FingerTree (Tag k v) (Entry k v a) -> AnnotatedMap k v a
AnnotatedMap ((Entry k v a -> Maybe (Entry k v b))
-> FingerTree (Tag k v) (Entry k v a)
-> FingerTree (Tag k v) (Entry k v b)
forall v1 a1 v2 a2.
(Measured v1 a1, Measured v2 a2) =>
(a1 -> Maybe a2) -> FingerTree v1 a1 -> FingerTree v2 a2
mapMaybeFingerTree Entry k v a -> Maybe (Entry k v b)
forall k v. Entry k v a -> Maybe (Entry k v b)
g FingerTree (Tag k v) (Entry k v a)
ft)
  where g :: Entry k v a -> Maybe (Entry k v b)
g (Entry k
k v
v a
a) = k -> v -> b -> Entry k v b
forall k v a. k -> v -> a -> Entry k v a
Entry k
k v
v (b -> Entry k v b) -> Maybe b -> Maybe (Entry k v b)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> Maybe b
f a
a

traverseMaybeWithKey ::
  (Applicative f, Ord k, Semigroup v1, Semigroup v2) =>
  (k -> v1 -> a1 -> f (Maybe (v2, a2))) ->
  AnnotatedMap k v1 a1 -> f (AnnotatedMap k v2 a2)
traverseMaybeWithKey :: (k -> v1 -> a1 -> f (Maybe (v2, a2)))
-> AnnotatedMap k v1 a1 -> f (AnnotatedMap k v2 a2)
traverseMaybeWithKey k -> v1 -> a1 -> f (Maybe (v2, a2))
f (AnnotatedMap FingerTree (Tag k v1) (Entry k v1 a1)
ft) =
  FingerTree (Tag k v2) (Entry k v2 a2) -> AnnotatedMap k v2 a2
forall k v a.
FingerTree (Tag k v) (Entry k v a) -> AnnotatedMap k v a
AnnotatedMap (FingerTree (Tag k v2) (Entry k v2 a2) -> AnnotatedMap k v2 a2)
-> f (FingerTree (Tag k v2) (Entry k v2 a2))
-> f (AnnotatedMap k v2 a2)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (Entry k v1 a1 -> f (Maybe (Entry k v2 a2)))
-> FingerTree (Tag k v1) (Entry k v1 a1)
-> f (FingerTree (Tag k v2) (Entry k v2 a2))
forall (f :: Type -> Type) v1 a1 v2 a2.
(Applicative f, Measured v1 a1, Measured v2 a2) =>
(a1 -> f (Maybe a2)) -> FingerTree v1 a1 -> f (FingerTree v2 a2)
traverseMaybeFingerTree Entry k v1 a1 -> f (Maybe (Entry k v2 a2))
g FingerTree (Tag k v1) (Entry k v1 a1)
ft
  where
    g :: Entry k v1 a1 -> f (Maybe (Entry k v2 a2))
g (Entry k
k v1
v1 a1
x1) = ((v2, a2) -> Entry k v2 a2)
-> Maybe (v2, a2) -> Maybe (Entry k v2 a2)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(v2
v2, a2
x2) -> k -> v2 -> a2 -> Entry k v2 a2
forall k v a. k -> v -> a -> Entry k v a
Entry k
k v2
v2 a2
x2) (Maybe (v2, a2) -> Maybe (Entry k v2 a2))
-> f (Maybe (v2, a2)) -> f (Maybe (Entry k v2 a2))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> k -> v1 -> a1 -> f (Maybe (v2, a2))
f k
k v1
v1 a1
x1

difference ::
  (Ord k, Semigroup v, Semigroup w) =>
  AnnotatedMap k v a -> AnnotatedMap k w b -> AnnotatedMap k v a
difference :: AnnotatedMap k v a -> AnnotatedMap k w b -> AnnotatedMap k v a
difference AnnotatedMap k v a
a AnnotatedMap k w b
b = Identity (AnnotatedMap k v a) -> AnnotatedMap k v a
forall a. Identity a -> a
runIdentity (Identity (AnnotatedMap k v a) -> AnnotatedMap k v a)
-> Identity (AnnotatedMap k v a) -> AnnotatedMap k v a
forall a b. (a -> b) -> a -> b
$ (Entry k v a -> Entry k w b -> Identity (Maybe (Entry k v a)))
-> (AnnotatedMap k v a -> Identity (AnnotatedMap k v a))
-> (AnnotatedMap k w b -> Identity (AnnotatedMap k v a))
-> AnnotatedMap k v a
-> AnnotatedMap k w b
-> Identity (AnnotatedMap k v a)
forall k u v w (m :: Type -> Type) a b c.
(Ord k, Semigroup u, Semigroup v, Semigroup w, Applicative m) =>
(Entry k u a -> Entry k v b -> m (Maybe (Entry k w c)))
-> (AnnotatedMap k u a -> m (AnnotatedMap k w c))
-> (AnnotatedMap k v b -> m (AnnotatedMap k w c))
-> AnnotatedMap k u a
-> AnnotatedMap k v b
-> m (AnnotatedMap k w c)
mergeGeneric (\Entry k v a
_ Entry k w b
_ -> Maybe (Entry k v a) -> Identity (Maybe (Entry k v a))
forall a. a -> Identity a
Identity Maybe (Entry k v a)
forall a. Maybe a
Nothing) AnnotatedMap k v a -> Identity (AnnotatedMap k v a)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Identity (AnnotatedMap k v a)
-> AnnotatedMap k w b -> Identity (AnnotatedMap k v a)
forall a b. a -> b -> a
const (AnnotatedMap k v a -> Identity (AnnotatedMap k v a)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure AnnotatedMap k v a
forall k v a. (Ord k, Semigroup v) => AnnotatedMap k v a
empty)) AnnotatedMap k v a
a AnnotatedMap k w b
b

mergeWithKey ::
  (Ord k, Semigroup u, Semigroup v, Semigroup w) =>
  (k -> (u, a) -> (v, b) -> Maybe (w, c)) {- ^ for keys present in both maps -} ->
  (AnnotatedMap k u a -> AnnotatedMap k w c) {- ^ for subtrees only in first map -} ->
  (AnnotatedMap k v b -> AnnotatedMap k w c) {- ^ for subtrees only in second map -} ->
  AnnotatedMap k u a -> AnnotatedMap k v b -> AnnotatedMap k w c
mergeWithKey :: (k -> (u, a) -> (v, b) -> Maybe (w, c))
-> (AnnotatedMap k u a -> AnnotatedMap k w c)
-> (AnnotatedMap k v b -> AnnotatedMap k w c)
-> AnnotatedMap k u a
-> AnnotatedMap k v b
-> AnnotatedMap k w c
mergeWithKey k -> (u, a) -> (v, b) -> Maybe (w, c)
f AnnotatedMap k u a -> AnnotatedMap k w c
g1 AnnotatedMap k v b -> AnnotatedMap k w c
g2 AnnotatedMap k u a
m1 AnnotatedMap k v b
m2 = Identity (AnnotatedMap k w c) -> AnnotatedMap k w c
forall a. Identity a -> a
runIdentity (Identity (AnnotatedMap k w c) -> AnnotatedMap k w c)
-> Identity (AnnotatedMap k w c) -> AnnotatedMap k w c
forall a b. (a -> b) -> a -> b
$ (Entry k u a -> Entry k v b -> Identity (Maybe (Entry k w c)))
-> (AnnotatedMap k u a -> Identity (AnnotatedMap k w c))
-> (AnnotatedMap k v b -> Identity (AnnotatedMap k w c))
-> AnnotatedMap k u a
-> AnnotatedMap k v b
-> Identity (AnnotatedMap k w c)
forall k u v w (m :: Type -> Type) a b c.
(Ord k, Semigroup u, Semigroup v, Semigroup w, Applicative m) =>
(Entry k u a -> Entry k v b -> m (Maybe (Entry k w c)))
-> (AnnotatedMap k u a -> m (AnnotatedMap k w c))
-> (AnnotatedMap k v b -> m (AnnotatedMap k w c))
-> AnnotatedMap k u a
-> AnnotatedMap k v b
-> m (AnnotatedMap k w c)
mergeGeneric Entry k u a -> Entry k v b -> Identity (Maybe (Entry k w c))
forall k.
Entry k u a -> Entry k v b -> Identity (Maybe (Entry k w c))
f' (AnnotatedMap k w c -> Identity (AnnotatedMap k w c)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (AnnotatedMap k w c -> Identity (AnnotatedMap k w c))
-> (AnnotatedMap k u a -> AnnotatedMap k w c)
-> AnnotatedMap k u a
-> Identity (AnnotatedMap k w c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnnotatedMap k u a -> AnnotatedMap k w c
g1) (AnnotatedMap k w c -> Identity (AnnotatedMap k w c)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (AnnotatedMap k w c -> Identity (AnnotatedMap k w c))
-> (AnnotatedMap k v b -> AnnotatedMap k w c)
-> AnnotatedMap k v b
-> Identity (AnnotatedMap k w c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnnotatedMap k v b -> AnnotatedMap k w c
g2) AnnotatedMap k u a
m1 AnnotatedMap k v b
m2
  where
    f' :: Entry k u a -> Entry k v b -> Identity (Maybe (Entry k w c))
f' (Entry k
k u
u a
a) (Entry k
_ v
v b
b) =
      Maybe (Entry k w c) -> Identity (Maybe (Entry k w c))
forall a. a -> Identity a
Identity (Maybe (Entry k w c) -> Identity (Maybe (Entry k w c)))
-> Maybe (Entry k w c) -> Identity (Maybe (Entry k w c))
forall a b. (a -> b) -> a -> b
$
      case k -> (u, a) -> (v, b) -> Maybe (w, c)
f k
k (u
u, a
a) (v
v, b
b) of
        Maybe (w, c)
Nothing -> Maybe (Entry k w c)
forall a. Maybe a
Nothing
        Just (w
w, c
c) -> Entry k w c -> Maybe (Entry k w c)
forall a. a -> Maybe a
Just (k -> w -> c -> Entry k w c
forall k v a. k -> v -> a -> Entry k v a
Entry k
k w
w c
c)

mergeA ::
  (Ord k, Semigroup v, Applicative f) =>
  (k -> (v, a) -> (v, a) -> f (v,a)) ->
  AnnotatedMap k v a -> AnnotatedMap k v a -> f (AnnotatedMap k v a)
mergeA :: (k -> (v, a) -> (v, a) -> f (v, a))
-> AnnotatedMap k v a
-> AnnotatedMap k v a
-> f (AnnotatedMap k v a)
mergeA k -> (v, a) -> (v, a) -> f (v, a)
f AnnotatedMap k v a
m1 AnnotatedMap k v a
m2 = (Entry k v a -> Entry k v a -> f (Maybe (Entry k v a)))
-> (AnnotatedMap k v a -> f (AnnotatedMap k v a))
-> (AnnotatedMap k v a -> f (AnnotatedMap k v a))
-> AnnotatedMap k v a
-> AnnotatedMap k v a
-> f (AnnotatedMap k v a)
forall k u v w (m :: Type -> Type) a b c.
(Ord k, Semigroup u, Semigroup v, Semigroup w, Applicative m) =>
(Entry k u a -> Entry k v b -> m (Maybe (Entry k w c)))
-> (AnnotatedMap k u a -> m (AnnotatedMap k w c))
-> (AnnotatedMap k v b -> m (AnnotatedMap k w c))
-> AnnotatedMap k u a
-> AnnotatedMap k v b
-> m (AnnotatedMap k w c)
mergeGeneric Entry k v a -> Entry k v a -> f (Maybe (Entry k v a))
forall k. Entry k v a -> Entry k v a -> f (Maybe (Entry k v a))
f' AnnotatedMap k v a -> f (AnnotatedMap k v a)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure AnnotatedMap k v a -> f (AnnotatedMap k v a)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure AnnotatedMap k v a
m1 AnnotatedMap k v a
m2
  where
    f' :: Entry k v a -> Entry k v a -> f (Maybe (Entry k v a))
f' (Entry k
k v
v1 a
x1) (Entry k
_ v
v2 a
x2) = k -> (v, a) -> Maybe (Entry k v a)
forall k v a. k -> (v, a) -> Maybe (Entry k v a)
g k
k ((v, a) -> Maybe (Entry k v a))
-> f (v, a) -> f (Maybe (Entry k v a))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> k -> (v, a) -> (v, a) -> f (v, a)
f k
k (v
v1, a
x1) (v
v2, a
x2)
    g :: k -> (v, a) -> Maybe (Entry k v a)
g k
k (v
v, a
x) = Entry k v a -> Maybe (Entry k v a)
forall a. a -> Maybe a
Just (k -> v -> a -> Entry k v a
forall k v a. k -> v -> a -> Entry k v a
Entry k
k v
v a
x)

mergeWithKeyM :: (Ord k, Semigroup u, Semigroup v, Semigroup w, Applicative m) =>
  (k -> (u, a) -> (v, b) -> m (w, c)) ->
  (k -> (u, a) -> m (w, c)) ->
  (k -> (v, b) -> m (w, c)) ->
  AnnotatedMap k u a -> AnnotatedMap k v b -> m (AnnotatedMap k w c)
mergeWithKeyM :: (k -> (u, a) -> (v, b) -> m (w, c))
-> (k -> (u, a) -> m (w, c))
-> (k -> (v, b) -> m (w, c))
-> AnnotatedMap k u a
-> AnnotatedMap k v b
-> m (AnnotatedMap k w c)
mergeWithKeyM k -> (u, a) -> (v, b) -> m (w, c)
both k -> (u, a) -> m (w, c)
left k -> (v, b) -> m (w, c)
right = (Entry k u a -> Entry k v b -> m (Maybe (Entry k w c)))
-> (AnnotatedMap k u a -> m (AnnotatedMap k w c))
-> (AnnotatedMap k v b -> m (AnnotatedMap k w c))
-> AnnotatedMap k u a
-> AnnotatedMap k v b
-> m (AnnotatedMap k w c)
forall k u v w (m :: Type -> Type) a b c.
(Ord k, Semigroup u, Semigroup v, Semigroup w, Applicative m) =>
(Entry k u a -> Entry k v b -> m (Maybe (Entry k w c)))
-> (AnnotatedMap k u a -> m (AnnotatedMap k w c))
-> (AnnotatedMap k v b -> m (AnnotatedMap k w c))
-> AnnotatedMap k u a
-> AnnotatedMap k v b
-> m (AnnotatedMap k w c)
mergeGeneric Entry k u a -> Entry k v b -> m (Maybe (Entry k w c))
forall k. Entry k u a -> Entry k v b -> m (Maybe (Entry k w c))
both' AnnotatedMap k u a -> m (AnnotatedMap k w c)
left' AnnotatedMap k v b -> m (AnnotatedMap k w c)
right'
  where
    both' :: Entry k u a -> Entry k v b -> m (Maybe (Entry k w c))
both' (Entry k
k u
u a
a) (Entry k
_ v
v b
b) = k -> (w, c) -> Maybe (Entry k w c)
forall k v a. k -> (v, a) -> Maybe (Entry k v a)
q k
k ((w, c) -> Maybe (Entry k w c))
-> m (w, c) -> m (Maybe (Entry k w c))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> k -> (u, a) -> (v, b) -> m (w, c)
both k
k (u
u, a
a) (v
v, b
b)
    left' :: AnnotatedMap k u a -> m (AnnotatedMap k w c)
left'  AnnotatedMap k u a
m = FingerTree (Tag k w) (Entry k w c) -> AnnotatedMap k w c
forall k v a.
FingerTree (Tag k v) (Entry k v a) -> AnnotatedMap k v a
AnnotatedMap (FingerTree (Tag k w) (Entry k w c) -> AnnotatedMap k w c)
-> m (FingerTree (Tag k w) (Entry k w c)) -> m (AnnotatedMap k w c)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (Entry k u a -> m (Maybe (Entry k w c)))
-> FingerTree (Tag k u) (Entry k u a)
-> m (FingerTree (Tag k w) (Entry k w c))
forall (f :: Type -> Type) v1 a1 v2 a2.
(Applicative f, Measured v1 a1, Measured v2 a2) =>
(a1 -> f (Maybe a2)) -> FingerTree v1 a1 -> f (FingerTree v2 a2)
traverseMaybeFingerTree Entry k u a -> m (Maybe (Entry k w c))
fl (AnnotatedMap k u a -> FingerTree (Tag k u) (Entry k u a)
forall k v a.
AnnotatedMap k v a -> FingerTree (Tag k v) (Entry k v a)
annotatedMap AnnotatedMap k u a
m)
    right' :: AnnotatedMap k v b -> m (AnnotatedMap k w c)
right' AnnotatedMap k v b
m = FingerTree (Tag k w) (Entry k w c) -> AnnotatedMap k w c
forall k v a.
FingerTree (Tag k v) (Entry k v a) -> AnnotatedMap k v a
AnnotatedMap (FingerTree (Tag k w) (Entry k w c) -> AnnotatedMap k w c)
-> m (FingerTree (Tag k w) (Entry k w c)) -> m (AnnotatedMap k w c)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (Entry k v b -> m (Maybe (Entry k w c)))
-> FingerTree (Tag k v) (Entry k v b)
-> m (FingerTree (Tag k w) (Entry k w c))
forall (f :: Type -> Type) v1 a1 v2 a2.
(Applicative f, Measured v1 a1, Measured v2 a2) =>
(a1 -> f (Maybe a2)) -> FingerTree v1 a1 -> f (FingerTree v2 a2)
traverseMaybeFingerTree Entry k v b -> m (Maybe (Entry k w c))
fr (AnnotatedMap k v b -> FingerTree (Tag k v) (Entry k v b)
forall k v a.
AnnotatedMap k v a -> FingerTree (Tag k v) (Entry k v a)
annotatedMap AnnotatedMap k v b
m)

    fl :: Entry k u a -> m (Maybe (Entry k w c))
fl (Entry k
k u
v a
x) = k -> (w, c) -> Maybe (Entry k w c)
forall k v a. k -> (v, a) -> Maybe (Entry k v a)
q k
k ((w, c) -> Maybe (Entry k w c))
-> m (w, c) -> m (Maybe (Entry k w c))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> k -> (u, a) -> m (w, c)
left k
k (u
v, a
x)
    fr :: Entry k v b -> m (Maybe (Entry k w c))
fr (Entry k
k v
v b
x) = k -> (w, c) -> Maybe (Entry k w c)
forall k v a. k -> (v, a) -> Maybe (Entry k v a)
q k
k ((w, c) -> Maybe (Entry k w c))
-> m (w, c) -> m (Maybe (Entry k w c))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> k -> (v, b) -> m (w, c)
right k
k (v
v, b
x)

    q :: k -> (v, a) -> Maybe (Entry k v a)
q k
k (v
a, a
b) = Entry k v a -> Maybe (Entry k v a)
forall a. a -> Maybe a
Just (k -> v -> a -> Entry k v a
forall k v a. k -> v -> a -> Entry k v a
Entry k
k v
a a
b)


mergeGeneric ::
  (Ord k, Semigroup u, Semigroup v, Semigroup w, Applicative m) =>
  (Entry k u a -> Entry k v b -> m (Maybe (Entry k w c))) {- ^ for keys present in both maps -} ->
  (AnnotatedMap k u a -> m (AnnotatedMap k w c)) {- ^ for subtrees only in first map -} ->
  (AnnotatedMap k v b -> m (AnnotatedMap k w c)) {- ^ for subtrees only in second map -} ->
  AnnotatedMap k u a -> AnnotatedMap k v b -> m (AnnotatedMap k w c)
mergeGeneric :: (Entry k u a -> Entry k v b -> m (Maybe (Entry k w c)))
-> (AnnotatedMap k u a -> m (AnnotatedMap k w c))
-> (AnnotatedMap k v b -> m (AnnotatedMap k w c))
-> AnnotatedMap k u a
-> AnnotatedMap k v b
-> m (AnnotatedMap k w c)
mergeGeneric Entry k u a -> Entry k v b -> m (Maybe (Entry k w c))
f AnnotatedMap k u a -> m (AnnotatedMap k w c)
g1 AnnotatedMap k v b -> m (AnnotatedMap k w c)
g2 (AnnotatedMap FingerTree (Tag k u) (Entry k u a)
ft1) (AnnotatedMap FingerTree (Tag k v) (Entry k v b)
ft2) = FingerTree (Tag k w) (Entry k w c) -> AnnotatedMap k w c
forall k v a.
FingerTree (Tag k v) (Entry k v a) -> AnnotatedMap k v a
AnnotatedMap (FingerTree (Tag k w) (Entry k w c) -> AnnotatedMap k w c)
-> m (FingerTree (Tag k w) (Entry k w c)) -> m (AnnotatedMap k w c)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (FingerTree (Tag k u) (Entry k u a)
-> FingerTree (Tag k v) (Entry k v b)
-> m (FingerTree (Tag k w) (Entry k w c))
merge1 FingerTree (Tag k u) (Entry k u a)
ft1 FingerTree (Tag k v) (Entry k v b)
ft2)
  where
    g1' :: FingerTree (Tag k u) (Entry k u a)
-> m (FingerTree (Tag k w) (Entry k w c))
g1' FingerTree (Tag k u) (Entry k u a)
ft = AnnotatedMap k w c -> FingerTree (Tag k w) (Entry k w c)
forall k v a.
AnnotatedMap k v a -> FingerTree (Tag k v) (Entry k v a)
annotatedMap (AnnotatedMap k w c -> FingerTree (Tag k w) (Entry k w c))
-> m (AnnotatedMap k w c) -> m (FingerTree (Tag k w) (Entry k w c))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> AnnotatedMap k u a -> m (AnnotatedMap k w c)
g1 (FingerTree (Tag k u) (Entry k u a) -> AnnotatedMap k u a
forall k v a.
FingerTree (Tag k v) (Entry k v a) -> AnnotatedMap k v a
AnnotatedMap FingerTree (Tag k u) (Entry k u a)
ft)
    g2' :: FingerTree (Tag k v) (Entry k v b)
-> m (FingerTree (Tag k w) (Entry k w c))
g2' FingerTree (Tag k v) (Entry k v b)
ft = AnnotatedMap k w c -> FingerTree (Tag k w) (Entry k w c)
forall k v a.
AnnotatedMap k v a -> FingerTree (Tag k v) (Entry k v a)
annotatedMap (AnnotatedMap k w c -> FingerTree (Tag k w) (Entry k w c))
-> m (AnnotatedMap k w c) -> m (FingerTree (Tag k w) (Entry k w c))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> AnnotatedMap k v b -> m (AnnotatedMap k w c)
g2 (FingerTree (Tag k v) (Entry k v b) -> AnnotatedMap k v b
forall k v a.
FingerTree (Tag k v) (Entry k v a) -> AnnotatedMap k v a
AnnotatedMap FingerTree (Tag k v) (Entry k v b)
ft)

    rebuild :: FingerTree v a -> Maybe a -> FingerTree v a -> FingerTree v a
rebuild FingerTree v a
l Maybe a
Nothing FingerTree v a
r  = FingerTree v a
l FingerTree v a -> FingerTree v a -> FingerTree v a
forall v a.
Measured v a =>
FingerTree v a -> FingerTree v a -> FingerTree v a
>< FingerTree v a
r
    rebuild FingerTree v a
l (Just a
x) FingerTree v a
r = FingerTree v a
l FingerTree v a -> FingerTree v a -> FingerTree v a
forall v a.
Measured v a =>
FingerTree v a -> FingerTree v a -> FingerTree v a
>< (a
x a -> FingerTree v a -> FingerTree v a
forall v a. Measured v a => a -> FingerTree v a -> FingerTree v a
<| FingerTree v a
r)

    merge1 :: FingerTree (Tag k u) (Entry k u a)
-> FingerTree (Tag k v) (Entry k v b)
-> m (FingerTree (Tag k w) (Entry k w c))
merge1 FingerTree (Tag k u) (Entry k u a)
xs FingerTree (Tag k v) (Entry k v b)
ys =
      case FingerTree (Tag k u) (Entry k u a)
-> ViewL (FingerTree (Tag k u)) (Entry k u a)
forall v a.
Measured v a =>
FingerTree v a -> ViewL (FingerTree v) a
FT.viewl FingerTree (Tag k u) (Entry k u a)
xs of
        ViewL (FingerTree (Tag k u)) (Entry k u a)
FT.EmptyL -> FingerTree (Tag k v) (Entry k v b)
-> m (FingerTree (Tag k w) (Entry k w c))
g2' FingerTree (Tag k v) (Entry k v b)
ys
        Entry k u a
x FT.:< FingerTree (Tag k u) (Entry k u a)
xs' ->
          let (FingerTree (Tag k v) (Entry k v b)
ys1, Maybe (Entry k v b)
ym, FingerTree (Tag k v) (Entry k v b)
ys2) = k
-> FingerTree (Tag k v) (Entry k v b)
-> (FingerTree (Tag k v) (Entry k v b), Maybe (Entry k v b),
    FingerTree (Tag k v) (Entry k v b))
forall k v a.
(Ord k, Semigroup v) =>
k
-> FingerTree (Tag k v) (Entry k v a)
-> (FingerTree (Tag k v) (Entry k v a), Maybe (Entry k v a),
    FingerTree (Tag k v) (Entry k v a))
splitAtKey (Entry k u a -> k
forall k v a. Entry k v a -> k
keyOf Entry k u a
x) FingerTree (Tag k v) (Entry k v b)
ys in
          case Maybe (Entry k v b)
ym of
            Maybe (Entry k v b)
Nothing -> FingerTree (Tag k w) (Entry k w c)
-> FingerTree (Tag k w) (Entry k w c)
-> FingerTree (Tag k w) (Entry k w c)
forall v a.
Measured v a =>
FingerTree v a -> FingerTree v a -> FingerTree v a
(><) (FingerTree (Tag k w) (Entry k w c)
 -> FingerTree (Tag k w) (Entry k w c)
 -> FingerTree (Tag k w) (Entry k w c))
-> m (FingerTree (Tag k w) (Entry k w c))
-> m (FingerTree (Tag k w) (Entry k w c)
      -> FingerTree (Tag k w) (Entry k w c))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> FingerTree (Tag k v) (Entry k v b)
-> m (FingerTree (Tag k w) (Entry k w c))
g2' FingerTree (Tag k v) (Entry k v b)
ys1 m (FingerTree (Tag k w) (Entry k w c)
   -> FingerTree (Tag k w) (Entry k w c))
-> m (FingerTree (Tag k w) (Entry k w c))
-> m (FingerTree (Tag k w) (Entry k w c))
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> FingerTree (Tag k u) (Entry k u a)
-> FingerTree (Tag k v) (Entry k v b)
-> m (FingerTree (Tag k w) (Entry k w c))
merge2 FingerTree (Tag k u) (Entry k u a)
xs FingerTree (Tag k v) (Entry k v b)
ys2
            Just Entry k v b
y  -> FingerTree (Tag k w) (Entry k w c)
-> Maybe (Entry k w c)
-> FingerTree (Tag k w) (Entry k w c)
-> FingerTree (Tag k w) (Entry k w c)
forall v a.
Measured v a =>
FingerTree v a -> Maybe a -> FingerTree v a -> FingerTree v a
rebuild (FingerTree (Tag k w) (Entry k w c)
 -> Maybe (Entry k w c)
 -> FingerTree (Tag k w) (Entry k w c)
 -> FingerTree (Tag k w) (Entry k w c))
-> m (FingerTree (Tag k w) (Entry k w c))
-> m (Maybe (Entry k w c)
      -> FingerTree (Tag k w) (Entry k w c)
      -> FingerTree (Tag k w) (Entry k w c))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> FingerTree (Tag k v) (Entry k v b)
-> m (FingerTree (Tag k w) (Entry k w c))
g2' FingerTree (Tag k v) (Entry k v b)
ys1 m (Maybe (Entry k w c)
   -> FingerTree (Tag k w) (Entry k w c)
   -> FingerTree (Tag k w) (Entry k w c))
-> m (Maybe (Entry k w c))
-> m (FingerTree (Tag k w) (Entry k w c)
      -> FingerTree (Tag k w) (Entry k w c))
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Entry k u a -> Entry k v b -> m (Maybe (Entry k w c))
f Entry k u a
x Entry k v b
y m (FingerTree (Tag k w) (Entry k w c)
   -> FingerTree (Tag k w) (Entry k w c))
-> m (FingerTree (Tag k w) (Entry k w c))
-> m (FingerTree (Tag k w) (Entry k w c))
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> FingerTree (Tag k u) (Entry k u a)
-> FingerTree (Tag k v) (Entry k v b)
-> m (FingerTree (Tag k w) (Entry k w c))
merge2 FingerTree (Tag k u) (Entry k u a)
xs' FingerTree (Tag k v) (Entry k v b)
ys2

    merge2 :: FingerTree (Tag k u) (Entry k u a)
-> FingerTree (Tag k v) (Entry k v b)
-> m (FingerTree (Tag k w) (Entry k w c))
merge2 FingerTree (Tag k u) (Entry k u a)
xs FingerTree (Tag k v) (Entry k v b)
ys =
      case FingerTree (Tag k v) (Entry k v b)
-> ViewL (FingerTree (Tag k v)) (Entry k v b)
forall v a.
Measured v a =>
FingerTree v a -> ViewL (FingerTree v) a
FT.viewl FingerTree (Tag k v) (Entry k v b)
ys of
        ViewL (FingerTree (Tag k v)) (Entry k v b)
FT.EmptyL -> FingerTree (Tag k u) (Entry k u a)
-> m (FingerTree (Tag k w) (Entry k w c))
g1' FingerTree (Tag k u) (Entry k u a)
xs
        Entry k v b
y FT.:< FingerTree (Tag k v) (Entry k v b)
ys' ->
          let (FingerTree (Tag k u) (Entry k u a)
xs1, Maybe (Entry k u a)
xm, FingerTree (Tag k u) (Entry k u a)
xs2) = k
-> FingerTree (Tag k u) (Entry k u a)
-> (FingerTree (Tag k u) (Entry k u a), Maybe (Entry k u a),
    FingerTree (Tag k u) (Entry k u a))
forall k v a.
(Ord k, Semigroup v) =>
k
-> FingerTree (Tag k v) (Entry k v a)
-> (FingerTree (Tag k v) (Entry k v a), Maybe (Entry k v a),
    FingerTree (Tag k v) (Entry k v a))
splitAtKey (Entry k v b -> k
forall k v a. Entry k v a -> k
keyOf Entry k v b
y) FingerTree (Tag k u) (Entry k u a)
xs in
          case Maybe (Entry k u a)
xm of
            Maybe (Entry k u a)
Nothing -> FingerTree (Tag k w) (Entry k w c)
-> FingerTree (Tag k w) (Entry k w c)
-> FingerTree (Tag k w) (Entry k w c)
forall v a.
Measured v a =>
FingerTree v a -> FingerTree v a -> FingerTree v a
(><) (FingerTree (Tag k w) (Entry k w c)
 -> FingerTree (Tag k w) (Entry k w c)
 -> FingerTree (Tag k w) (Entry k w c))
-> m (FingerTree (Tag k w) (Entry k w c))
-> m (FingerTree (Tag k w) (Entry k w c)
      -> FingerTree (Tag k w) (Entry k w c))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> FingerTree (Tag k u) (Entry k u a)
-> m (FingerTree (Tag k w) (Entry k w c))
g1' FingerTree (Tag k u) (Entry k u a)
xs1 m (FingerTree (Tag k w) (Entry k w c)
   -> FingerTree (Tag k w) (Entry k w c))
-> m (FingerTree (Tag k w) (Entry k w c))
-> m (FingerTree (Tag k w) (Entry k w c))
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> FingerTree (Tag k u) (Entry k u a)
-> FingerTree (Tag k v) (Entry k v b)
-> m (FingerTree (Tag k w) (Entry k w c))
merge1 FingerTree (Tag k u) (Entry k u a)
xs2 FingerTree (Tag k v) (Entry k v b)
ys
            Just Entry k u a
x  -> FingerTree (Tag k w) (Entry k w c)
-> Maybe (Entry k w c)
-> FingerTree (Tag k w) (Entry k w c)
-> FingerTree (Tag k w) (Entry k w c)
forall v a.
Measured v a =>
FingerTree v a -> Maybe a -> FingerTree v a -> FingerTree v a
rebuild (FingerTree (Tag k w) (Entry k w c)
 -> Maybe (Entry k w c)
 -> FingerTree (Tag k w) (Entry k w c)
 -> FingerTree (Tag k w) (Entry k w c))
-> m (FingerTree (Tag k w) (Entry k w c))
-> m (Maybe (Entry k w c)
      -> FingerTree (Tag k w) (Entry k w c)
      -> FingerTree (Tag k w) (Entry k w c))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> FingerTree (Tag k u) (Entry k u a)
-> m (FingerTree (Tag k w) (Entry k w c))
g1' FingerTree (Tag k u) (Entry k u a)
xs1 m (Maybe (Entry k w c)
   -> FingerTree (Tag k w) (Entry k w c)
   -> FingerTree (Tag k w) (Entry k w c))
-> m (Maybe (Entry k w c))
-> m (FingerTree (Tag k w) (Entry k w c)
      -> FingerTree (Tag k w) (Entry k w c))
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Entry k u a -> Entry k v b -> m (Maybe (Entry k w c))
f Entry k u a
x Entry k v b
y m (FingerTree (Tag k w) (Entry k w c)
   -> FingerTree (Tag k w) (Entry k w c))
-> m (FingerTree (Tag k w) (Entry k w c))
-> m (FingerTree (Tag k w) (Entry k w c))
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> FingerTree (Tag k u) (Entry k u a)
-> FingerTree (Tag k v) (Entry k v b)
-> m (FingerTree (Tag k w) (Entry k w c))
merge1 FingerTree (Tag k u) (Entry k u a)
xs2 FingerTree (Tag k v) (Entry k v b)
ys'