{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Ouroboros.Consensus.Ledger.Tables.Diff (
    -- * Types
    Delta (..)
  , Diff (..)
    -- * Conversion
  , keysSet
    -- * Construction
  , diff
    -- ** Maps
  , fromMap
  , fromMapDeletes
  , fromMapInserts
    -- ** Set
  , fromSetDeletes
    -- ** Lists
  , fromList
  , fromListDeletes
  , fromListInserts
    -- * Query
    -- ** Size
  , null
  , numDeletes
  , numInserts
  , size
    -- * Applying diffs
  , applyDiff
  , applyDiffForKeys
    -- * Filter
  , filterWithKeyOnly
  , foldMapDelta
  , traverseDeltaWithKey_
  ) where

import           Control.Monad (void)
import           Data.Bifunctor
import           Data.Foldable (foldMap')
import qualified Data.Map.Merge.Strict as Merge
import           Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import           Data.Monoid
import           Data.Set (Set)
import qualified Data.Set as Set
import           GHC.Generics
import           NoThunks.Class
import           Prelude hiding (null)

{------------------------------------------------------------------------------
  Types
------------------------------------------------------------------------------}

newtype Diff k v = Diff (Map k (Delta v))
  deriving stock (Int -> Diff k v -> ShowS
[Diff k v] -> ShowS
Diff k v -> String
(Int -> Diff k v -> ShowS)
-> (Diff k v -> String) -> ([Diff k v] -> ShowS) -> Show (Diff k v)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k v. (Show k, Show v) => Int -> Diff k v -> ShowS
forall k v. (Show k, Show v) => [Diff k v] -> ShowS
forall k v. (Show k, Show v) => Diff k v -> String
$cshowsPrec :: forall k v. (Show k, Show v) => Int -> Diff k v -> ShowS
showsPrec :: Int -> Diff k v -> ShowS
$cshow :: forall k v. (Show k, Show v) => Diff k v -> String
show :: Diff k v -> String
$cshowList :: forall k v. (Show k, Show v) => [Diff k v] -> ShowS
showList :: [Diff k v] -> ShowS
Show, Diff k v -> Diff k v -> Bool
(Diff k v -> Diff k v -> Bool)
-> (Diff k v -> Diff k v -> Bool) -> Eq (Diff k v)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k v. (Eq k, Eq v) => Diff k v -> Diff k v -> Bool
$c== :: forall k v. (Eq k, Eq v) => Diff k v -> Diff k v -> Bool
== :: Diff k v -> Diff k v -> Bool
$c/= :: forall k v. (Eq k, Eq v) => Diff k v -> Diff k v -> Bool
/= :: Diff k v -> Diff k v -> Bool
Eq)
  deriving (forall x. Diff k v -> Rep (Diff k v) x)
-> (forall x. Rep (Diff k v) x -> Diff k v) -> Generic (Diff k v)
forall x. Rep (Diff k v) x -> Diff k v
forall x. Diff k v -> Rep (Diff k v) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall k v x. Rep (Diff k v) x -> Diff k v
forall k v x. Diff k v -> Rep (Diff k v) x
$cfrom :: forall k v x. Diff k v -> Rep (Diff k v) x
from :: forall x. Diff k v -> Rep (Diff k v) x
$cto :: forall k v x. Rep (Diff k v) x -> Diff k v
to :: forall x. Rep (Diff k v) x -> Diff k v
Generic
  deriving newtype Context -> Diff k v -> IO (Maybe ThunkInfo)
Proxy (Diff k v) -> String
(Context -> Diff k v -> IO (Maybe ThunkInfo))
-> (Context -> Diff k v -> IO (Maybe ThunkInfo))
-> (Proxy (Diff k v) -> String)
-> NoThunks (Diff k v)
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
forall k v.
(NoThunks k, NoThunks v) =>
Context -> Diff k v -> IO (Maybe ThunkInfo)
forall k v. (NoThunks k, NoThunks v) => Proxy (Diff k v) -> String
$cnoThunks :: forall k v.
(NoThunks k, NoThunks v) =>
Context -> Diff k v -> IO (Maybe ThunkInfo)
noThunks :: Context -> Diff k v -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall k v.
(NoThunks k, NoThunks v) =>
Context -> Diff k v -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> Diff k v -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall k v. (NoThunks k, NoThunks v) => Proxy (Diff k v) -> String
showTypeOf :: Proxy (Diff k v) -> String
NoThunks

-- | Custom 'Functor' instance, since @'Functor' ('Map' k)@ is actually the
-- 'Functor' instance for a lazy Map.
instance Functor (Diff k) where
  fmap :: forall a b. (a -> b) -> Diff k a -> Diff k b
fmap a -> b
f (Diff Map k (Delta a)
m) = Map k (Delta b) -> Diff k b
forall k v. Map k (Delta v) -> Diff k v
Diff (Map k (Delta b) -> Diff k b) -> Map k (Delta b) -> Diff k b
forall a b. (a -> b) -> a -> b
$ (Delta a -> Delta b) -> Map k (Delta a) -> Map k (Delta b)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map ((a -> b) -> Delta a -> Delta b
forall a b. (a -> b) -> Delta a -> Delta b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) Map k (Delta a)
m

instance Ord k => Semigroup (Diff k v) where
  (Diff Map k (Delta v)
m1) <> :: Diff k v -> Diff k v -> Diff k v
<> (Diff Map k (Delta v)
m2) = Map k (Delta v) -> Diff k v
forall k v. Map k (Delta v) -> Diff k v
Diff (Map k (Delta v) -> Diff k v) -> Map k (Delta v) -> Diff k v
forall a b. (a -> b) -> a -> b
$ (Delta v -> Delta v -> Delta v)
-> Map k (Delta v) -> Map k (Delta v) -> Map k (Delta v)
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith Delta v -> Delta v -> Delta v
forall a. Semigroup a => a -> a -> a
(<>) Map k (Delta v)
m1 Map k (Delta v)
m2

instance Ord k => Monoid (Diff k v) where
  mempty :: Diff k v
mempty = Map k (Delta v) -> Diff k v
forall k v. Map k (Delta v) -> Diff k v
Diff Map k (Delta v)
forall a. Monoid a => a
mempty

data Delta v =
    Insert !v
  | Delete
  deriving stock (Int -> Delta v -> ShowS
[Delta v] -> ShowS
Delta v -> String
(Int -> Delta v -> ShowS)
-> (Delta v -> String) -> ([Delta v] -> ShowS) -> Show (Delta v)
forall v. Show v => Int -> Delta v -> ShowS
forall v. Show v => [Delta v] -> ShowS
forall v. Show v => Delta v -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall v. Show v => Int -> Delta v -> ShowS
showsPrec :: Int -> Delta v -> ShowS
$cshow :: forall v. Show v => Delta v -> String
show :: Delta v -> String
$cshowList :: forall v. Show v => [Delta v] -> ShowS
showList :: [Delta v] -> ShowS
Show, Delta v -> Delta v -> Bool
(Delta v -> Delta v -> Bool)
-> (Delta v -> Delta v -> Bool) -> Eq (Delta v)
forall v. Eq v => Delta v -> Delta v -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall v. Eq v => Delta v -> Delta v -> Bool
== :: Delta v -> Delta v -> Bool
$c/= :: forall v. Eq v => Delta v -> Delta v -> Bool
/= :: Delta v -> Delta v -> Bool
Eq, (forall a b. (a -> b) -> Delta a -> Delta b)
-> (forall a b. a -> Delta b -> Delta a) -> Functor Delta
forall a b. a -> Delta b -> Delta a
forall a b. (a -> b) -> Delta a -> Delta b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Delta a -> Delta b
fmap :: forall a b. (a -> b) -> Delta a -> Delta b
$c<$ :: forall a b. a -> Delta b -> Delta a
<$ :: forall a b. a -> Delta b -> Delta a
Functor)
  deriving (forall x. Delta v -> Rep (Delta v) x)
-> (forall x. Rep (Delta v) x -> Delta v) -> Generic (Delta v)
forall x. Rep (Delta v) x -> Delta v
forall x. Delta v -> Rep (Delta v) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall v x. Rep (Delta v) x -> Delta v
forall v x. Delta v -> Rep (Delta v) x
$cfrom :: forall v x. Delta v -> Rep (Delta v) x
from :: forall x. Delta v -> Rep (Delta v) x
$cto :: forall v x. Rep (Delta v) x -> Delta v
to :: forall x. Rep (Delta v) x -> Delta v
Generic
  deriving Context -> Delta v -> IO (Maybe ThunkInfo)
Proxy (Delta v) -> String
(Context -> Delta v -> IO (Maybe ThunkInfo))
-> (Context -> Delta v -> IO (Maybe ThunkInfo))
-> (Proxy (Delta v) -> String)
-> NoThunks (Delta v)
forall v. NoThunks v => Context -> Delta v -> IO (Maybe ThunkInfo)
forall v. NoThunks v => Proxy (Delta v) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: forall v. NoThunks v => Context -> Delta v -> IO (Maybe ThunkInfo)
noThunks :: Context -> Delta v -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall v. NoThunks v => Context -> Delta v -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> Delta v -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall v. NoThunks v => Proxy (Delta v) -> String
showTypeOf :: Proxy (Delta v) -> String
NoThunks

-- | Right-biased
instance Semigroup (Delta v) where
  Delta v
_d1 <> :: Delta v -> Delta v -> Delta v
<> Delta v
d2 = Delta v
d2

{------------------------------------------------------------------------------
  Conversion
------------------------------------------------------------------------------}

keysSet :: Diff k v -> Set k
keysSet :: forall k v. Diff k v -> Set k
keysSet (Diff Map k (Delta v)
m) = Map k (Delta v) -> Set k
forall k a. Map k a -> Set k
Map.keysSet Map k (Delta v)
m

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

diff :: (Ord k, Eq v) => Map k v -> Map k v -> Diff k v
diff :: forall k v. (Ord k, Eq v) => Map k v -> Map k v -> Diff k v
diff Map k v
m1 Map k v
m2 = Map k (Delta v) -> Diff k v
forall k v. Map k (Delta v) -> Diff k v
Diff (Map k (Delta v) -> Diff k v) -> Map k (Delta v) -> Diff k v
forall a b. (a -> b) -> a -> b
$
    SimpleWhenMissing k v (Delta v)
-> SimpleWhenMissing k v (Delta v)
-> SimpleWhenMatched k v v (Delta v)
-> Map k v
-> Map k v
-> Map k (Delta v)
forall k a c b.
Ord k =>
SimpleWhenMissing k a c
-> SimpleWhenMissing k b c
-> SimpleWhenMatched k a b c
-> Map k a
-> Map k b
-> Map k c
Merge.merge
      ((k -> v -> Delta v) -> SimpleWhenMissing k v (Delta v)
forall (f :: * -> *) k x y.
Applicative f =>
(k -> x -> y) -> WhenMissing f k x y
Merge.mapMissing ((k -> v -> Delta v) -> SimpleWhenMissing k v (Delta v))
-> (k -> v -> Delta v) -> SimpleWhenMissing k v (Delta v)
forall a b. (a -> b) -> a -> b
$ \k
_k v
_v -> Delta v
forall v. Delta v
Delete)
      ((k -> v -> Delta v) -> SimpleWhenMissing k v (Delta v)
forall (f :: * -> *) k x y.
Applicative f =>
(k -> x -> y) -> WhenMissing f k x y
Merge.mapMissing ((k -> v -> Delta v) -> SimpleWhenMissing k v (Delta v))
-> (k -> v -> Delta v) -> SimpleWhenMissing k v (Delta v)
forall a b. (a -> b) -> a -> b
$ \k
_k v
v -> v -> Delta v
forall v. v -> Delta v
Insert v
v)
      ((k -> v -> v -> Maybe (Delta v))
-> SimpleWhenMatched k v v (Delta v)
forall (f :: * -> *) k x y z.
Applicative f =>
(k -> x -> y -> Maybe z) -> WhenMatched f k x y z
Merge.zipWithMaybeMatched ((k -> v -> v -> Maybe (Delta v))
 -> SimpleWhenMatched k v v (Delta v))
-> (k -> v -> v -> Maybe (Delta v))
-> SimpleWhenMatched k v v (Delta v)
forall a b. (a -> b) -> a -> b
$ \ k
_k v
v1 v
v2 ->
        if v
v1 v -> v -> Bool
forall a. Eq a => a -> a -> Bool
== v
v2 then Maybe (Delta v)
forall a. Maybe a
Nothing
                    else Delta v -> Maybe (Delta v)
forall a. a -> Maybe a
Just (v -> Delta v
forall v. v -> Delta v
Insert v
v2))
      Map k v
m1
      Map k v
m2

fromMap :: Map k (Delta v) -> Diff k v
fromMap :: forall k v. Map k (Delta v) -> Diff k v
fromMap = Map k (Delta v) -> Diff k v
forall k v. Map k (Delta v) -> Diff k v
Diff

fromMapInserts :: Map k v -> Diff k v
fromMapInserts :: forall k v. Map k v -> Diff k v
fromMapInserts = Map k (Delta v) -> Diff k v
forall k v. Map k (Delta v) -> Diff k v
Diff (Map k (Delta v) -> Diff k v)
-> (Map k v -> Map k (Delta v)) -> Map k v -> Diff k v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (v -> Delta v) -> Map k v -> Map k (Delta v)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map v -> Delta v
forall v. v -> Delta v
Insert

fromMapDeletes :: Map k v -> Diff k v
fromMapDeletes :: forall k v. Map k v -> Diff k v
fromMapDeletes = Map k (Delta v) -> Diff k v
forall k v. Map k (Delta v) -> Diff k v
Diff (Map k (Delta v) -> Diff k v)
-> (Map k v -> Map k (Delta v)) -> Map k v -> Diff k v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (v -> Delta v) -> Map k v -> Map k (Delta v)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (Delta v -> v -> Delta v
forall a b. a -> b -> a
const Delta v
forall v. Delta v
Delete)

fromSetDeletes :: Set k -> Diff k v
fromSetDeletes :: forall k v. Set k -> Diff k v
fromSetDeletes = Map k (Delta v) -> Diff k v
forall k v. Map k (Delta v) -> Diff k v
Diff (Map k (Delta v) -> Diff k v)
-> (Set k -> Map k (Delta v)) -> Set k -> Diff k v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (k -> Delta v) -> Set k -> Map k (Delta v)
forall k a. (k -> a) -> Set k -> Map k a
Map.fromSet (Delta v -> k -> Delta v
forall a b. a -> b -> a
const Delta v
forall v. Delta v
Delete)

fromList :: Ord k => [(k, Delta v)] -> Diff k v
fromList :: forall k v. Ord k => [(k, Delta v)] -> Diff k v
fromList = Map k (Delta v) -> Diff k v
forall k v. Map k (Delta v) -> Diff k v
Diff (Map k (Delta v) -> Diff k v)
-> ([(k, Delta v)] -> Map k (Delta v))
-> [(k, Delta v)]
-> Diff k v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(k, Delta v)] -> Map k (Delta v)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList

fromListInserts :: Ord k => [(k, v)] -> Diff k v
fromListInserts :: forall k v. Ord k => [(k, v)] -> Diff k v
fromListInserts = Map k (Delta v) -> Diff k v
forall k v. Map k (Delta v) -> Diff k v
Diff (Map k (Delta v) -> Diff k v)
-> ([(k, v)] -> Map k (Delta v)) -> [(k, v)] -> Diff k v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(k, Delta v)] -> Map k (Delta v)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(k, Delta v)] -> Map k (Delta v))
-> ([(k, v)] -> [(k, Delta v)]) -> [(k, v)] -> Map k (Delta v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((k, v) -> (k, Delta v)) -> [(k, v)] -> [(k, Delta v)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((v -> Delta v) -> (k, v) -> (k, Delta v)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second v -> Delta v
forall v. v -> Delta v
Insert)

fromListDeletes :: Ord k => [(k, v)] -> Diff k v
fromListDeletes :: forall k v. Ord k => [(k, v)] -> Diff k v
fromListDeletes = Map k (Delta v) -> Diff k v
forall k v. Map k (Delta v) -> Diff k v
Diff (Map k (Delta v) -> Diff k v)
-> ([(k, v)] -> Map k (Delta v)) -> [(k, v)] -> Diff k v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(k, Delta v)] -> Map k (Delta v)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(k, Delta v)] -> Map k (Delta v))
-> ([(k, v)] -> [(k, Delta v)]) -> [(k, v)] -> Map k (Delta v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((k, v) -> (k, Delta v)) -> [(k, v)] -> [(k, Delta v)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((v -> Delta v) -> (k, v) -> (k, Delta v)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (Delta v -> v -> Delta v
forall a b. a -> b -> a
const Delta v
forall v. Delta v
Delete))

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

null :: Diff k v -> Bool
null :: forall k v. Diff k v -> Bool
null (Diff Map k (Delta v)
m) = Map k (Delta v) -> Bool
forall k a. Map k a -> Bool
Map.null Map k (Delta v)
m

size :: Diff k v -> Int
size :: forall k v. Diff k v -> Int
size (Diff Map k (Delta v)
m) = Map k (Delta v) -> Int
forall k a. Map k a -> Int
Map.size Map k (Delta v)
m

numInserts :: Diff k v -> Int
numInserts :: forall k v. Diff k v -> Int
numInserts (Diff Map k (Delta v)
m) = Sum Int -> Int
forall a. Sum a -> a
getSum (Sum Int -> Int) -> Sum Int -> Int
forall a b. (a -> b) -> a -> b
$ (Delta v -> Sum Int) -> Map k (Delta v) -> Sum Int
forall m a. Monoid m => (a -> m) -> Map k a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap' Delta v -> Sum Int
forall {a} {v}. Num a => Delta v -> a
f Map k (Delta v)
m
  where
    f :: Delta v -> a
f (Insert v
_) = a
1
    f Delta v
Delete     = a
0

numDeletes :: Diff k v -> Int
numDeletes :: forall k v. Diff k v -> Int
numDeletes (Diff Map k (Delta v)
m) = Sum Int -> Int
forall a. Sum a -> a
getSum (Sum Int -> Int) -> Sum Int -> Int
forall a b. (a -> b) -> a -> b
$ (Delta v -> Sum Int) -> Map k (Delta v) -> Sum Int
forall m a. Monoid m => (a -> m) -> Map k a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap' Delta v -> Sum Int
forall {a} {v}. Num a => Delta v -> a
f Map k (Delta v)
m
  where
    f :: Delta v -> a
f (Insert v
_) = a
0
    f Delta v
Delete     = a
1

{------------------------------------------------------------------------------
  Applying diffs
------------------------------------------------------------------------------}

applyDiff ::
     Ord k
  => Map k v
  -> Diff k v
  -> Map k v
applyDiff :: forall k v. Ord k => Map k v -> Diff k v -> Map k v
applyDiff Map k v
m (Diff Map k (Delta v)
diffs) =
    SimpleWhenMissing k v v
-> SimpleWhenMissing k (Delta v) v
-> SimpleWhenMatched k v (Delta v) v
-> Map k v
-> Map k (Delta v)
-> Map k v
forall k a c b.
Ord k =>
SimpleWhenMissing k a c
-> SimpleWhenMissing k b c
-> SimpleWhenMatched k a b c
-> Map k a
-> Map k b
-> Map k c
Merge.merge
      SimpleWhenMissing k v v
forall (f :: * -> *) k x. Applicative f => WhenMissing f k x x
Merge.preserveMissing
      ((k -> Delta v -> Maybe v) -> SimpleWhenMissing k (Delta v) v
forall (f :: * -> *) k x y.
Applicative f =>
(k -> x -> Maybe y) -> WhenMissing f k x y
Merge.mapMaybeMissing k -> Delta v -> Maybe v
forall k v. k -> Delta v -> Maybe v
newKeys)
      ((k -> v -> Delta v -> Maybe v) -> SimpleWhenMatched k v (Delta v) v
forall (f :: * -> *) k x y z.
Applicative f =>
(k -> x -> y -> Maybe z) -> WhenMatched f k x y z
Merge.zipWithMaybeMatched k -> v -> Delta v -> Maybe v
forall k v. k -> v -> Delta v -> Maybe v
oldKeys)
      Map k v
m
      Map k (Delta v)
diffs
  where
    newKeys :: k -> Delta v -> Maybe v
    newKeys :: forall k v. k -> Delta v -> Maybe v
newKeys k
_k (Insert v
x) = v -> Maybe v
forall a. a -> Maybe a
Just v
x
    newKeys k
_k Delta v
Delete     = Maybe v
forall a. Maybe a
Nothing

    oldKeys :: k -> v -> Delta v -> Maybe v
    oldKeys :: forall k v. k -> v -> Delta v -> Maybe v
oldKeys k
_k v
_v1 (Insert v
x) = v -> Maybe v
forall a. a -> Maybe a
Just v
x
    oldKeys k
_k v
_v1 Delta v
Delete     = Maybe v
forall a. Maybe a
Nothing

applyDiffForKeys ::
     Ord k
  => Map k v
  -> Set k
  -> Diff k v
  -> Map k v
applyDiffForKeys :: forall k v. Ord k => Map k v -> Set k -> Diff k v -> Map k v
applyDiffForKeys Map k v
m Set k
ks (Diff Map k (Delta v)
diffs) =
  Map k v -> Diff k v -> Map k v
forall k v. Ord k => Map k v -> Diff k v -> Map k v
applyDiff
    Map k v
m
    (Map k (Delta v) -> Diff k v
forall k v. Map k (Delta v) -> Diff k v
Diff (Map k (Delta v) -> Diff k v) -> Map k (Delta v) -> Diff k v
forall a b. (a -> b) -> a -> b
$ Map k (Delta v)
diffs Map k (Delta v) -> Set k -> Map k (Delta v)
forall k a. Ord k => Map k a -> Set k -> Map k a
`Map.restrictKeys` (Map k v -> Set k
forall k a. Map k a -> Set k
Map.keysSet Map k v
m Set k -> Set k -> Set k
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` Set k
ks))

{-------------------------------------------------------------------------------
  Filter
-------------------------------------------------------------------------------}

filterWithKeyOnly :: (k -> Bool) -> Diff k v -> Diff k v
filterWithKeyOnly :: forall k v. (k -> Bool) -> Diff k v -> Diff k v
filterWithKeyOnly k -> Bool
f (Diff Map k (Delta v)
m) = Map k (Delta v) -> Diff k v
forall k v. Map k (Delta v) -> Diff k v
Diff (Map k (Delta v) -> Diff k v) -> Map k (Delta v) -> Diff k v
forall a b. (a -> b) -> a -> b
$ (k -> Delta v -> Bool) -> Map k (Delta v) -> Map k (Delta v)
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey (Bool -> Delta v -> Bool
forall a b. a -> b -> a
const (Bool -> Delta v -> Bool) -> (k -> Bool) -> k -> Delta v -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k -> Bool
f) Map k (Delta v)
m

{-------------------------------------------------------------------------------
  Traversals and folds
-------------------------------------------------------------------------------}

-- | Traversal with keys over the deltas.
traverseDeltaWithKey_ ::
     Applicative t
  => (k -> Delta v -> t a)
  -> Diff k v
  -> t ()
traverseDeltaWithKey_ :: forall (t :: * -> *) k v a.
Applicative t =>
(k -> Delta v -> t a) -> Diff k v -> t ()
traverseDeltaWithKey_ k -> Delta v -> t a
f (Diff Map k (Delta v)
m) = t (Map k a) -> t ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (t (Map k a) -> t ()) -> t (Map k a) -> t ()
forall a b. (a -> b) -> a -> b
$ (k -> Delta v -> t a) -> Map k (Delta v) -> t (Map k a)
forall (t :: * -> *) k a b.
Applicative t =>
(k -> a -> t b) -> Map k a -> t (Map k b)
Map.traverseWithKey k -> Delta v -> t a
f Map k (Delta v)
m

-- | @'foldMap'@ over the deltas.
foldMapDelta :: Monoid m => (Delta v -> m) -> Diff k v -> m
foldMapDelta :: forall m v k. Monoid m => (Delta v -> m) -> Diff k v -> m
foldMapDelta Delta v -> m
f (Diff Map k (Delta v)
m) = (Delta v -> m) -> Map k (Delta v) -> m
forall m a. Monoid m => (a -> m) -> Map k a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Delta v -> m
f Map k (Delta v)
m