{-# LANGUAGE DeriveAnyClass             #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE DeriveTraversable          #-}
{-# LANGUAGE DerivingStrategies         #-}
{-# LANGUAGE GeneralisedNewtypeDeriving #-}
{-# LANGUAGE InstanceSigs               #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE StandaloneDeriving         #-}
{-# LANGUAGE TupleSections              #-}

-- | See the module documentation for "Data.Map.Diff.Strict".
module Data.Map.Diff.Strict.Internal (
    -- * Types
    Delta (..)
  , DeltaHistory (..)
  , Diff (..)
    -- * Conversion
  , keysSet
    -- * Construction
  , diff
  , empty
    -- ** Maps
  , fromMap
  , fromMapDeletes
  , fromMapInserts
    -- ** Lists
  , fromList
  , fromListDeletes
  , fromListDeltaHistories
  , fromListInserts
    -- ** Delta history
  , singleton
  , singletonDelete
  , singletonInsert
    -- * Deconstruction
    -- ** Delta history
  , last
    -- * Query
    -- ** Size
  , null
  , numDeletes
  , numInserts
  , size
    -- * Applying diffs
  , applyDiff
  , applyDiffForKeys
    -- * Folds and traversals
  , foldMapDelta
  , mapMaybeDiff
  , traverseDeltaWithKey_
    -- * Filter
  , filterOnlyKey
  ) where

import           Control.Monad (void)
import           Data.Bifunctor (Bifunctor (second))
import           Data.Foldable (foldMap', toList)
import qualified Data.Map.Merge.Strict as Merge
import           Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import qualified Data.Maybe as Maybe
import           Data.Monoid (Sum (..))
import           Data.Semigroup.Cancellative (LeftCancellative,
                     LeftReductive (..), RightCancellative, RightReductive (..))
import qualified Data.Sequence as Seq
import           Data.Sequence.NonEmpty (NESeq (..), nonEmptySeq)
import qualified Data.Sequence.NonEmpty as NESeq
import           Data.Sequence.NonEmpty.Extra ()
import           Data.Set (Set)
import qualified Data.Set as Set
import           GHC.Generics (Generic)
import           NoThunks.Class (NoThunks (..))
import           Prelude hiding (last, length, null, splitAt)

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

-- | A diff for key-value stores.
newtype Diff k v = Diff (Map k (DeltaHistory v))
  deriving stock ((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, 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 anyclass (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 (DeltaHistory a)
m) = Map k (DeltaHistory b) -> Diff k b
forall k v. Map k (DeltaHistory v) -> Diff k v
Diff (Map k (DeltaHistory b) -> Diff k b)
-> Map k (DeltaHistory b) -> Diff k b
forall a b. (a -> b) -> a -> b
$ (DeltaHistory a -> DeltaHistory b)
-> Map k (DeltaHistory a) -> Map k (DeltaHistory b)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map ((a -> b) -> DeltaHistory a -> DeltaHistory b
forall a b. (a -> b) -> DeltaHistory a -> DeltaHistory b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) Map k (DeltaHistory a)
m

-- | A non-empty history of changes to a value in a key-value store.
--
-- A history has an implicit sense of ordering according to time: from left to
-- right. This means that the leftmost element in the history is the /earliest/
-- change, while the rightmost element in the history is the /latest/ change.
newtype DeltaHistory v = DeltaHistory { forall v. DeltaHistory v -> NESeq (Delta v)
getDeltaHistory :: NESeq (Delta v) }
  deriving stock ((forall x. DeltaHistory v -> Rep (DeltaHistory v) x)
-> (forall x. Rep (DeltaHistory v) x -> DeltaHistory v)
-> Generic (DeltaHistory v)
forall x. Rep (DeltaHistory v) x -> DeltaHistory v
forall x. DeltaHistory v -> Rep (DeltaHistory v) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall v x. Rep (DeltaHistory v) x -> DeltaHistory v
forall v x. DeltaHistory v -> Rep (DeltaHistory v) x
$cfrom :: forall v x. DeltaHistory v -> Rep (DeltaHistory v) x
from :: forall x. DeltaHistory v -> Rep (DeltaHistory v) x
$cto :: forall v x. Rep (DeltaHistory v) x -> DeltaHistory v
to :: forall x. Rep (DeltaHistory v) x -> DeltaHistory v
Generic, Int -> DeltaHistory v -> ShowS
[DeltaHistory v] -> ShowS
DeltaHistory v -> String
(Int -> DeltaHistory v -> ShowS)
-> (DeltaHistory v -> String)
-> ([DeltaHistory v] -> ShowS)
-> Show (DeltaHistory v)
forall v. Show v => Int -> DeltaHistory v -> ShowS
forall v. Show v => [DeltaHistory v] -> ShowS
forall v. Show v => DeltaHistory v -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall v. Show v => Int -> DeltaHistory v -> ShowS
showsPrec :: Int -> DeltaHistory v -> ShowS
$cshow :: forall v. Show v => DeltaHistory v -> String
show :: DeltaHistory v -> String
$cshowList :: forall v. Show v => [DeltaHistory v] -> ShowS
showList :: [DeltaHistory v] -> ShowS
Show, DeltaHistory v -> DeltaHistory v -> Bool
(DeltaHistory v -> DeltaHistory v -> Bool)
-> (DeltaHistory v -> DeltaHistory v -> Bool)
-> Eq (DeltaHistory v)
forall v. Eq v => DeltaHistory v -> DeltaHistory v -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall v. Eq v => DeltaHistory v -> DeltaHistory v -> Bool
== :: DeltaHistory v -> DeltaHistory v -> Bool
$c/= :: forall v. Eq v => DeltaHistory v -> DeltaHistory v -> Bool
/= :: DeltaHistory v -> DeltaHistory v -> Bool
Eq, (forall a b. (a -> b) -> DeltaHistory a -> DeltaHistory b)
-> (forall a b. a -> DeltaHistory b -> DeltaHistory a)
-> Functor DeltaHistory
forall a b. a -> DeltaHistory b -> DeltaHistory a
forall a b. (a -> b) -> DeltaHistory a -> DeltaHistory 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) -> DeltaHistory a -> DeltaHistory b
fmap :: forall a b. (a -> b) -> DeltaHistory a -> DeltaHistory b
$c<$ :: forall a b. a -> DeltaHistory b -> DeltaHistory a
<$ :: forall a b. a -> DeltaHistory b -> DeltaHistory a
Functor)
  deriving newtype (Context -> DeltaHistory v -> IO (Maybe ThunkInfo)
Proxy (DeltaHistory v) -> String
(Context -> DeltaHistory v -> IO (Maybe ThunkInfo))
-> (Context -> DeltaHistory v -> IO (Maybe ThunkInfo))
-> (Proxy (DeltaHistory v) -> String)
-> NoThunks (DeltaHistory v)
forall v.
NoThunks v =>
Context -> DeltaHistory v -> IO (Maybe ThunkInfo)
forall v. NoThunks v => Proxy (DeltaHistory 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 -> DeltaHistory v -> IO (Maybe ThunkInfo)
noThunks :: Context -> DeltaHistory v -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall v.
NoThunks v =>
Context -> DeltaHistory v -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> DeltaHistory v -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall v. NoThunks v => Proxy (DeltaHistory v) -> String
showTypeOf :: Proxy (DeltaHistory v) -> String
NoThunks)

-- | A change to a value in a key-value store.
data Delta v =
      Insert !v
    | Delete
  deriving stock ((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, 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, (forall m. Monoid m => Delta m -> m)
-> (forall m a. Monoid m => (a -> m) -> Delta a -> m)
-> (forall m a. Monoid m => (a -> m) -> Delta a -> m)
-> (forall a b. (a -> b -> b) -> b -> Delta a -> b)
-> (forall a b. (a -> b -> b) -> b -> Delta a -> b)
-> (forall b a. (b -> a -> b) -> b -> Delta a -> b)
-> (forall b a. (b -> a -> b) -> b -> Delta a -> b)
-> (forall a. (a -> a -> a) -> Delta a -> a)
-> (forall a. (a -> a -> a) -> Delta a -> a)
-> (forall a. Delta a -> [a])
-> (forall a. Delta a -> Bool)
-> (forall a. Delta a -> Int)
-> (forall a. Eq a => a -> Delta a -> Bool)
-> (forall a. Ord a => Delta a -> a)
-> (forall a. Ord a => Delta a -> a)
-> (forall a. Num a => Delta a -> a)
-> (forall a. Num a => Delta a -> a)
-> Foldable Delta
forall a. Eq a => a -> Delta a -> Bool
forall a. Num a => Delta a -> a
forall a. Ord a => Delta a -> a
forall m. Monoid m => Delta m -> m
forall a. Delta a -> Bool
forall a. Delta a -> Int
forall a. Delta a -> [a]
forall a. (a -> a -> a) -> Delta a -> a
forall m a. Monoid m => (a -> m) -> Delta a -> m
forall b a. (b -> a -> b) -> b -> Delta a -> b
forall a b. (a -> b -> b) -> b -> Delta a -> b
forall (t :: * -> *).
(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
$cfold :: forall m. Monoid m => Delta m -> m
fold :: forall m. Monoid m => Delta m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Delta a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Delta a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Delta a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> Delta a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> Delta a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Delta a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Delta a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Delta a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Delta a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Delta a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Delta a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> Delta a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> Delta a -> a
foldr1 :: forall a. (a -> a -> a) -> Delta a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Delta a -> a
foldl1 :: forall a. (a -> a -> a) -> Delta a -> a
$ctoList :: forall a. Delta a -> [a]
toList :: forall a. Delta a -> [a]
$cnull :: forall a. Delta a -> Bool
null :: forall a. Delta a -> Bool
$clength :: forall a. Delta a -> Int
length :: forall a. Delta a -> Int
$celem :: forall a. Eq a => a -> Delta a -> Bool
elem :: forall a. Eq a => a -> Delta a -> Bool
$cmaximum :: forall a. Ord a => Delta a -> a
maximum :: forall a. Ord a => Delta a -> a
$cminimum :: forall a. Ord a => Delta a -> a
minimum :: forall a. Ord a => Delta a -> a
$csum :: forall a. Num a => Delta a -> a
sum :: forall a. Num a => Delta a -> a
$cproduct :: forall a. Num a => Delta a -> a
product :: forall a. Num a => Delta a -> a
Foldable, Functor Delta
Foldable Delta
(Functor Delta, Foldable Delta) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> Delta a -> f (Delta b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Delta (f a) -> f (Delta a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Delta a -> m (Delta b))
-> (forall (m :: * -> *) a. Monad m => Delta (m a) -> m (Delta a))
-> Traversable Delta
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Delta (m a) -> m (Delta a)
forall (f :: * -> *) a. Applicative f => Delta (f a) -> f (Delta a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Delta a -> m (Delta b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Delta a -> f (Delta b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Delta a -> f (Delta b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Delta a -> f (Delta b)
$csequenceA :: forall (f :: * -> *) a. Applicative f => Delta (f a) -> f (Delta a)
sequenceA :: forall (f :: * -> *) a. Applicative f => Delta (f a) -> f (Delta a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Delta a -> m (Delta b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Delta a -> m (Delta b)
$csequence :: forall (m :: * -> *) a. Monad m => Delta (m a) -> m (Delta a)
sequence :: forall (m :: * -> *) a. Monad m => Delta (m a) -> m (Delta a)
Traversable)
  deriving anyclass (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)

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

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

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

-- | Compute the difference between @'Map'@s.
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 (DeltaHistory v) -> Diff k v
forall k v. Map k (DeltaHistory v) -> Diff k v
Diff (Map k (DeltaHistory v) -> Diff k v)
-> Map k (DeltaHistory v) -> Diff k v
forall a b. (a -> b) -> a -> b
$
    SimpleWhenMissing k v (DeltaHistory v)
-> SimpleWhenMissing k v (DeltaHistory v)
-> SimpleWhenMatched k v v (DeltaHistory v)
-> Map k v
-> Map k v
-> Map k (DeltaHistory 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 -> DeltaHistory v)
-> SimpleWhenMissing k v (DeltaHistory v)
forall (f :: * -> *) k x y.
Applicative f =>
(k -> x -> y) -> WhenMissing f k x y
Merge.mapMissing ((k -> v -> DeltaHistory v)
 -> SimpleWhenMissing k v (DeltaHistory v))
-> (k -> v -> DeltaHistory v)
-> SimpleWhenMissing k v (DeltaHistory v)
forall a b. (a -> b) -> a -> b
$ \k
_k v
_v -> DeltaHistory v
forall v. DeltaHistory v
singletonDelete)
      ((k -> v -> DeltaHistory v)
-> SimpleWhenMissing k v (DeltaHistory v)
forall (f :: * -> *) k x y.
Applicative f =>
(k -> x -> y) -> WhenMissing f k x y
Merge.mapMissing ((k -> v -> DeltaHistory v)
 -> SimpleWhenMissing k v (DeltaHistory v))
-> (k -> v -> DeltaHistory v)
-> SimpleWhenMissing k v (DeltaHistory v)
forall a b. (a -> b) -> a -> b
$ \k
_k v
v -> v -> DeltaHistory v
forall v. v -> DeltaHistory v
singletonInsert v
v)
      ((k -> v -> v -> Maybe (DeltaHistory v))
-> SimpleWhenMatched k v v (DeltaHistory 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 (DeltaHistory v))
 -> SimpleWhenMatched k v v (DeltaHistory v))
-> (k -> v -> v -> Maybe (DeltaHistory v))
-> SimpleWhenMatched k v v (DeltaHistory 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 (DeltaHistory v)
forall a. Maybe a
Nothing
        else
          DeltaHistory v -> Maybe (DeltaHistory v)
forall a. a -> Maybe a
Just (DeltaHistory v -> Maybe (DeltaHistory v))
-> DeltaHistory v -> Maybe (DeltaHistory v)
forall a b. (a -> b) -> a -> b
$ DeltaHistory v
forall v. DeltaHistory v
singletonDelete DeltaHistory v -> DeltaHistory v -> DeltaHistory v
forall a. Semigroup a => a -> a -> a
<> v -> DeltaHistory v
forall v. v -> DeltaHistory v
singletonInsert v
v2
      )
      Map k v
m1
      Map k v
m2

empty :: Diff k v
empty :: forall k v. Diff k v
empty = Map k (DeltaHistory v) -> Diff k v
forall k v. Map k (DeltaHistory v) -> Diff k v
Diff Map k (DeltaHistory v)
forall k a. Map k a
Map.empty

-- | @'fromMap' m@ creates a @'Diff'@ from the inserts and deletes in @m@.
fromMap :: Map k (Delta v) -> Diff k v
fromMap :: forall k v. Map k (Delta v) -> Diff k v
fromMap = Map k (DeltaHistory v) -> Diff k v
forall k v. Map k (DeltaHistory v) -> Diff k v
Diff (Map k (DeltaHistory v) -> Diff k v)
-> (Map k (Delta v) -> Map k (DeltaHistory v))
-> Map k (Delta v)
-> Diff k v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Delta v -> DeltaHistory v)
-> Map k (Delta v) -> Map k (DeltaHistory v)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map Delta v -> DeltaHistory v
forall v. Delta v -> DeltaHistory v
singleton

-- | @'fromMapInserts' m@ creates a @'Diff'@ that inserts all values in @m@.
fromMapInserts :: Map k v -> Diff k v
fromMapInserts :: forall k v. Map k v -> Diff k v
fromMapInserts = Map k (DeltaHistory v) -> Diff k v
forall k v. Map k (DeltaHistory v) -> Diff k v
Diff (Map k (DeltaHistory v) -> Diff k v)
-> (Map k v -> Map k (DeltaHistory v)) -> Map k v -> Diff k v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (v -> DeltaHistory v) -> Map k v -> Map k (DeltaHistory v)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map v -> DeltaHistory v
forall v. v -> DeltaHistory v
singletonInsert

-- | @'fromMapDeletes' m@ creates a @'Diff'@ that deletes all values in @m@.
fromMapDeletes :: Map k v -> Diff k v
fromMapDeletes :: forall k v. Map k v -> Diff k v
fromMapDeletes = Map k (DeltaHistory v) -> Diff k v
forall k v. Map k (DeltaHistory v) -> Diff k v
Diff (Map k (DeltaHistory v) -> Diff k v)
-> (Map k v -> Map k (DeltaHistory v)) -> Map k v -> Diff k v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (v -> DeltaHistory v) -> Map k v -> Map k (DeltaHistory v)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (DeltaHistory v -> v -> DeltaHistory v
forall a b. a -> b -> a
const DeltaHistory v
forall v. DeltaHistory v
singletonDelete)

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

-- | @'fromList' xs@ creates a @'Diff'@ from the inserts and deletes in @xs@.
fromList :: Ord k => [(k, Delta v)] -> Diff k v
fromList :: forall k v. Ord k => [(k, Delta v)] -> Diff k v
fromList = [(k, DeltaHistory v)] -> Diff k v
forall k v. Ord k => [(k, DeltaHistory v)] -> Diff k v
fromListDeltaHistories ([(k, DeltaHistory v)] -> Diff k v)
-> ([(k, Delta v)] -> [(k, DeltaHistory v)])
-> [(k, Delta v)]
-> Diff k v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((k, Delta v) -> (k, DeltaHistory v))
-> [(k, Delta v)] -> [(k, DeltaHistory v)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Delta v -> DeltaHistory v) -> (k, Delta v) -> (k, DeltaHistory 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 -> DeltaHistory v
forall v. Delta v -> DeltaHistory v
singleton)

-- | @'fromListInserts' xs@ creates a @'Diff'@ that inserts all values in @xs@.
fromListInserts :: Ord k => [(k, v)] -> Diff k v
fromListInserts :: forall k v. Ord k => [(k, v)] -> Diff k v
fromListInserts = [(k, DeltaHistory v)] -> Diff k v
forall k v. Ord k => [(k, DeltaHistory v)] -> Diff k v
fromListDeltaHistories ([(k, DeltaHistory v)] -> Diff k v)
-> ([(k, v)] -> [(k, DeltaHistory v)]) -> [(k, v)] -> Diff k v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((k, v) -> (k, DeltaHistory v))
-> [(k, v)] -> [(k, DeltaHistory v)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((v -> DeltaHistory v) -> (k, v) -> (k, DeltaHistory 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 -> DeltaHistory v
forall v. v -> DeltaHistory v
singletonInsert)

-- | @'fromListDeletes' xs@ creates a @'Diff'@ that deletes all values in @xs@.
fromListDeletes :: Ord k => [k] -> Diff k v
fromListDeletes :: forall k v. Ord k => [k] -> Diff k v
fromListDeletes = [(k, DeltaHistory v)] -> Diff k v
forall k v. Ord k => [(k, DeltaHistory v)] -> Diff k v
fromListDeltaHistories ([(k, DeltaHistory v)] -> Diff k v)
-> ([k] -> [(k, DeltaHistory v)]) -> [k] -> Diff k v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (k -> (k, DeltaHistory v)) -> [k] -> [(k, DeltaHistory v)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (,DeltaHistory v
forall v. DeltaHistory v
singletonDelete)

singleton :: Delta v -> DeltaHistory v
singleton :: forall v. Delta v -> DeltaHistory v
singleton = NESeq (Delta v) -> DeltaHistory v
forall v. NESeq (Delta v) -> DeltaHistory v
DeltaHistory (NESeq (Delta v) -> DeltaHistory v)
-> (Delta v -> NESeq (Delta v)) -> Delta v -> DeltaHistory v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Delta v -> NESeq (Delta v)
forall a. a -> NESeq a
NESeq.singleton

singletonInsert :: v -> DeltaHistory v
singletonInsert :: forall v. v -> DeltaHistory v
singletonInsert = Delta v -> DeltaHistory v
forall v. Delta v -> DeltaHistory v
singleton (Delta v -> DeltaHistory v)
-> (v -> Delta v) -> v -> DeltaHistory v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Delta v
forall v. v -> Delta v
Insert

singletonDelete :: DeltaHistory v
singletonDelete :: forall v. DeltaHistory v
singletonDelete = Delta v -> DeltaHistory v
forall v. Delta v -> DeltaHistory v
singleton Delta v
forall v. Delta v
Delete

{------------------------------------------------------------------------------
  Deconstruction
------------------------------------------------------------------------------}

last :: DeltaHistory v -> Delta v
last :: forall v. DeltaHistory v -> Delta v
last (DeltaHistory (Seq (Delta v)
_ NESeq.:||> Delta v
e)) = Delta v
e

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

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

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

-- | @'numInserts' d@ returns the number of inserts in the diff @d@.
--
-- Note: that is, the number of diff histories that have inserts as their last
-- change.
numInserts :: Diff k v -> Int
numInserts :: forall k v. Diff k v -> Int
numInserts (Diff Map k (DeltaHistory v)
m) = Sum Int -> Int
forall a. Sum a -> a
getSum (Sum Int -> Int) -> Sum Int -> Int
forall a b. (a -> b) -> a -> b
$ (DeltaHistory v -> Sum Int) -> Map k (DeltaHistory 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' DeltaHistory v -> Sum Int
forall {a} {v}. Num a => DeltaHistory v -> a
f Map k (DeltaHistory v)
m
  where
    f :: DeltaHistory v -> a
f DeltaHistory v
h = case DeltaHistory v -> Delta v
forall v. DeltaHistory v -> Delta v
last DeltaHistory v
h of
      Insert v
_ -> a
1
      Delta v
Delete   -> a
0

-- | @'numDeletes' d@ returns the number of deletes in the diff @d@.
--
-- Note: that is, the number of diff histories that have deletes as their last
-- change.
numDeletes :: Diff k v -> Int
numDeletes :: forall k v. Diff k v -> Int
numDeletes (Diff Map k (DeltaHistory v)
m) = Sum Int -> Int
forall a. Sum a -> a
getSum (Sum Int -> Int) -> Sum Int -> Int
forall a b. (a -> b) -> a -> b
$ (DeltaHistory v -> Sum Int) -> Map k (DeltaHistory 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' DeltaHistory v -> Sum Int
forall {a} {v}. Num a => DeltaHistory v -> a
f Map k (DeltaHistory v)
m
  where
    f :: DeltaHistory v -> a
f DeltaHistory v
h = case DeltaHistory v -> Delta v
forall v. DeltaHistory v -> Delta v
last DeltaHistory v
h of
      Insert v
_ -> a
0
      Delta v
Delete   -> a
1

{------------------------------------------------------------------------------
  Instances
------------------------------------------------------------------------------}

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

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

instance (Ord k, Eq v) => LeftReductive (Diff k v) where
  stripPrefix :: Diff k v -> Diff k v -> Maybe (Diff k v)
  stripPrefix :: Diff k v -> Diff k v -> Maybe (Diff k v)
stripPrefix (Diff Map k (DeltaHistory v)
m1) (Diff Map k (DeltaHistory v)
m2) = Map k (DeltaHistory v) -> Diff k v
forall k v. Map k (DeltaHistory v) -> Diff k v
Diff (Map k (DeltaHistory v) -> Diff k v)
-> Maybe (Map k (DeltaHistory v)) -> Maybe (Diff k v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
      WhenMissing Maybe k (DeltaHistory v) (DeltaHistory v)
-> WhenMissing Maybe k (DeltaHistory v) (DeltaHistory v)
-> WhenMatched
     Maybe k (DeltaHistory v) (DeltaHistory v) (DeltaHistory v)
-> Map k (DeltaHistory v)
-> Map k (DeltaHistory v)
-> Maybe (Map k (DeltaHistory v))
forall (f :: * -> *) k a c b.
(Applicative f, Ord k) =>
WhenMissing f k a c
-> WhenMissing f k b c
-> WhenMatched f k a b c
-> Map k a
-> Map k b
-> f (Map k c)
Merge.mergeA
        ((k -> DeltaHistory v -> Maybe (DeltaHistory v))
-> WhenMissing Maybe k (DeltaHistory v) (DeltaHistory v)
forall (f :: * -> *) k x y.
Applicative f =>
(k -> x -> f y) -> WhenMissing f k x y
Merge.traverseMissing ((k -> DeltaHistory v -> Maybe (DeltaHistory v))
 -> WhenMissing Maybe k (DeltaHistory v) (DeltaHistory v))
-> (k -> DeltaHistory v -> Maybe (DeltaHistory v))
-> WhenMissing Maybe k (DeltaHistory v) (DeltaHistory v)
forall a b. (a -> b) -> a -> b
$ \k
_ DeltaHistory v
_ -> Maybe (DeltaHistory v)
forall a. Maybe a
Nothing)
        WhenMissing Maybe k (DeltaHistory v) (DeltaHistory v)
forall (f :: * -> *) k x. Applicative f => WhenMissing f k x x
Merge.preserveMissing
        ((k
 -> DeltaHistory v
 -> DeltaHistory v
 -> Maybe (Maybe (DeltaHistory v)))
-> WhenMatched
     Maybe k (DeltaHistory v) (DeltaHistory v) (DeltaHistory v)
forall (f :: * -> *) k x y z.
Applicative f =>
(k -> x -> y -> f (Maybe z)) -> WhenMatched f k x y z
Merge.zipWithMaybeAMatched k
-> DeltaHistory v
-> DeltaHistory v
-> Maybe (Maybe (DeltaHistory v))
f)
        Map k (DeltaHistory v)
m1
        Map k (DeltaHistory v)
m2
    where
      f :: k
        -> DeltaHistory v
        -> DeltaHistory v
        -> Maybe (Maybe (DeltaHistory v))
      f :: k
-> DeltaHistory v
-> DeltaHistory v
-> Maybe (Maybe (DeltaHistory v))
f k
_ DeltaHistory v
h1 DeltaHistory v
h2 = (NESeq (Delta v) -> DeltaHistory v)
-> Maybe (NESeq (Delta v)) -> Maybe (DeltaHistory v)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NESeq (Delta v) -> DeltaHistory v
forall v. NESeq (Delta v) -> DeltaHistory v
DeltaHistory (Maybe (NESeq (Delta v)) -> Maybe (DeltaHistory v))
-> (Seq (Delta v) -> Maybe (NESeq (Delta v)))
-> Seq (Delta v)
-> Maybe (DeltaHistory v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq (Delta v) -> Maybe (NESeq (Delta v))
forall a. Seq a -> Maybe (NESeq a)
NESeq.nonEmptySeq (Seq (Delta v) -> Maybe (DeltaHistory v))
-> Maybe (Seq (Delta v)) -> Maybe (Maybe (DeltaHistory v))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
          Seq (Delta v) -> Seq (Delta v) -> Maybe (Seq (Delta v))
forall m. LeftReductive m => m -> m -> Maybe m
stripPrefix
            (NESeq (Delta v) -> Seq (Delta v)
forall a. NESeq a -> Seq a
NESeq.toSeq (NESeq (Delta v) -> Seq (Delta v))
-> NESeq (Delta v) -> Seq (Delta v)
forall a b. (a -> b) -> a -> b
$ DeltaHistory v -> NESeq (Delta v)
forall v. DeltaHistory v -> NESeq (Delta v)
getDeltaHistory DeltaHistory v
h1)
            (NESeq (Delta v) -> Seq (Delta v)
forall a. NESeq a -> Seq a
NESeq.toSeq (NESeq (Delta v) -> Seq (Delta v))
-> NESeq (Delta v) -> Seq (Delta v)
forall a b. (a -> b) -> a -> b
$ DeltaHistory v -> NESeq (Delta v)
forall v. DeltaHistory v -> NESeq (Delta v)
getDeltaHistory DeltaHistory v
h2)

instance (Ord k, Eq v) => RightReductive (Diff k v) where
  stripSuffix :: Diff k v -> Diff k v -> Maybe (Diff k v)
  stripSuffix :: Diff k v -> Diff k v -> Maybe (Diff k v)
stripSuffix (Diff Map k (DeltaHistory v)
m1) (Diff Map k (DeltaHistory v)
m2) = Map k (DeltaHistory v) -> Diff k v
forall k v. Map k (DeltaHistory v) -> Diff k v
Diff (Map k (DeltaHistory v) -> Diff k v)
-> Maybe (Map k (DeltaHistory v)) -> Maybe (Diff k v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
      WhenMissing Maybe k (DeltaHistory v) (DeltaHistory v)
-> WhenMissing Maybe k (DeltaHistory v) (DeltaHistory v)
-> WhenMatched
     Maybe k (DeltaHistory v) (DeltaHistory v) (DeltaHistory v)
-> Map k (DeltaHistory v)
-> Map k (DeltaHistory v)
-> Maybe (Map k (DeltaHistory v))
forall (f :: * -> *) k a c b.
(Applicative f, Ord k) =>
WhenMissing f k a c
-> WhenMissing f k b c
-> WhenMatched f k a b c
-> Map k a
-> Map k b
-> f (Map k c)
Merge.mergeA
        ((k -> DeltaHistory v -> Maybe (DeltaHistory v))
-> WhenMissing Maybe k (DeltaHistory v) (DeltaHistory v)
forall (f :: * -> *) k x y.
Applicative f =>
(k -> x -> f y) -> WhenMissing f k x y
Merge.traverseMissing ((k -> DeltaHistory v -> Maybe (DeltaHistory v))
 -> WhenMissing Maybe k (DeltaHistory v) (DeltaHistory v))
-> (k -> DeltaHistory v -> Maybe (DeltaHistory v))
-> WhenMissing Maybe k (DeltaHistory v) (DeltaHistory v)
forall a b. (a -> b) -> a -> b
$ \k
_ DeltaHistory v
_ -> Maybe (DeltaHistory v)
forall a. Maybe a
Nothing)
        WhenMissing Maybe k (DeltaHistory v) (DeltaHistory v)
forall (f :: * -> *) k x. Applicative f => WhenMissing f k x x
Merge.preserveMissing
        ((k
 -> DeltaHistory v
 -> DeltaHistory v
 -> Maybe (Maybe (DeltaHistory v)))
-> WhenMatched
     Maybe k (DeltaHistory v) (DeltaHistory v) (DeltaHistory v)
forall (f :: * -> *) k x y z.
Applicative f =>
(k -> x -> y -> f (Maybe z)) -> WhenMatched f k x y z
Merge.zipWithMaybeAMatched k
-> DeltaHistory v
-> DeltaHistory v
-> Maybe (Maybe (DeltaHistory v))
f)
        Map k (DeltaHistory v)
m1
        Map k (DeltaHistory v)
m2
    where
      f :: k
        -> DeltaHistory v
        -> DeltaHistory v
        -> Maybe (Maybe (DeltaHistory v))
      f :: k
-> DeltaHistory v
-> DeltaHistory v
-> Maybe (Maybe (DeltaHistory v))
f k
_ DeltaHistory v
h1 DeltaHistory v
h2 = (NESeq (Delta v) -> DeltaHistory v)
-> Maybe (NESeq (Delta v)) -> Maybe (DeltaHistory v)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NESeq (Delta v) -> DeltaHistory v
forall v. NESeq (Delta v) -> DeltaHistory v
DeltaHistory (Maybe (NESeq (Delta v)) -> Maybe (DeltaHistory v))
-> (Seq (Delta v) -> Maybe (NESeq (Delta v)))
-> Seq (Delta v)
-> Maybe (DeltaHistory v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq (Delta v) -> Maybe (NESeq (Delta v))
forall a. Seq a -> Maybe (NESeq a)
NESeq.nonEmptySeq (Seq (Delta v) -> Maybe (DeltaHistory v))
-> Maybe (Seq (Delta v)) -> Maybe (Maybe (DeltaHistory v))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
          Seq (Delta v) -> Seq (Delta v) -> Maybe (Seq (Delta v))
forall m. RightReductive m => m -> m -> Maybe m
stripSuffix
            (NESeq (Delta v) -> Seq (Delta v)
forall a. NESeq a -> Seq a
NESeq.toSeq (NESeq (Delta v) -> Seq (Delta v))
-> NESeq (Delta v) -> Seq (Delta v)
forall a b. (a -> b) -> a -> b
$ DeltaHistory v -> NESeq (Delta v)
forall v. DeltaHistory v -> NESeq (Delta v)
getDeltaHistory DeltaHistory v
h1)
            (NESeq (Delta v) -> Seq (Delta v)
forall a. NESeq a -> Seq a
NESeq.toSeq (NESeq (Delta v) -> Seq (Delta v))
-> NESeq (Delta v) -> Seq (Delta v)
forall a b. (a -> b) -> a -> b
$ DeltaHistory v -> NESeq (Delta v)
forall v. DeltaHistory v -> NESeq (Delta v)
getDeltaHistory DeltaHistory v
h2)

instance (Ord k, Eq v) => LeftCancellative (Diff k v)
instance (Ord k, Eq v) => RightCancellative (Diff k v)

deriving newtype instance Semigroup (DeltaHistory v)

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

-- | Applies a diff to a @'Map'@.
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 (DeltaHistory v)
diffs) =
    SimpleWhenMissing k v v
-> SimpleWhenMissing k (DeltaHistory v) v
-> SimpleWhenMatched k v (DeltaHistory v) v
-> Map k v
-> Map k (DeltaHistory 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 -> DeltaHistory v -> Maybe v)
-> SimpleWhenMissing k (DeltaHistory v) v
forall (f :: * -> *) k x y.
Applicative f =>
(k -> x -> Maybe y) -> WhenMissing f k x y
Merge.mapMaybeMissing k -> DeltaHistory v -> Maybe v
forall k v. k -> DeltaHistory v -> Maybe v
newKeys)
      ((k -> v -> DeltaHistory v -> Maybe v)
-> SimpleWhenMatched k v (DeltaHistory 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 -> DeltaHistory v -> Maybe v
forall k v. k -> v -> DeltaHistory v -> Maybe v
oldKeys)
      Map k v
m
      Map k (DeltaHistory v)
diffs
  where
    newKeys :: k -> DeltaHistory v -> Maybe v
    newKeys :: forall k v. k -> DeltaHistory v -> Maybe v
newKeys k
_k DeltaHistory v
h = case DeltaHistory v -> Delta v
forall v. DeltaHistory v -> Delta v
last DeltaHistory v
h of
      Insert v
x -> v -> Maybe v
forall a. a -> Maybe a
Just v
x
      Delta v
Delete   -> Maybe v
forall a. Maybe a
Nothing

    oldKeys :: k -> v -> DeltaHistory v -> Maybe v
    oldKeys :: forall k v. k -> v -> DeltaHistory v -> Maybe v
oldKeys k
_k v
_v1 DeltaHistory v
h = case DeltaHistory v -> Delta v
forall v. DeltaHistory v -> Delta v
last DeltaHistory v
h of
      Insert v
x -> v -> Maybe v
forall a. a -> Maybe a
Just v
x
      Delta v
Delete   -> Maybe v
forall a. Maybe a
Nothing

-- | Applies a diff to a @'Map'@ for a specific set of keys.
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 (DeltaHistory 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 (DeltaHistory v) -> Diff k v
forall k v. Map k (DeltaHistory v) -> Diff k v
Diff (Map k (DeltaHistory v) -> Diff k v)
-> Map k (DeltaHistory v) -> Diff k v
forall a b. (a -> b) -> a -> b
$ Map k (DeltaHistory v)
diffs Map k (DeltaHistory v) -> Set k -> Map k (DeltaHistory 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))

{------------------------------------------------------------------------------
  Folds and traversals
------------------------------------------------------------------------------}

-- | @'foldMap'@ over the last delta in each delta history.
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 (DeltaHistory v)
m) =
  (DeltaHistory v -> m) -> Map k (DeltaHistory 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 (Delta v -> m)
-> (DeltaHistory v -> Delta v) -> DeltaHistory v -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NESeq (Delta v) -> Delta v
forall a. NESeq a -> a
NESeq.last (NESeq (Delta v) -> Delta v)
-> (DeltaHistory v -> NESeq (Delta v)) -> DeltaHistory v -> Delta v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DeltaHistory v -> NESeq (Delta v)
forall v. DeltaHistory v -> NESeq (Delta v)
getDeltaHistory) Map k (DeltaHistory v)
m

-- | Traversal with keys over the last delta in each delta history.
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 (DeltaHistory 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 -> DeltaHistory v -> t a)
-> Map k (DeltaHistory 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 -> DeltaHistory v -> t a
g Map k (DeltaHistory v)
m
  where
    g :: k -> DeltaHistory v -> t a
g k
k DeltaHistory v
dh = k -> Delta v -> t a
f k
k (DeltaHistory v -> Delta v
forall v. DeltaHistory v -> Delta v
last DeltaHistory v
dh)

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

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

mapMaybeSeq :: (v -> Maybe v') -> DeltaHistory v -> Maybe (DeltaHistory v')
mapMaybeSeq :: forall v v'.
(v -> Maybe v') -> DeltaHistory v -> Maybe (DeltaHistory v')
mapMaybeSeq v -> Maybe v'
f =
    (NESeq (Delta v') -> DeltaHistory v')
-> Maybe (NESeq (Delta v')) -> Maybe (DeltaHistory v')
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NESeq (Delta v') -> DeltaHistory v'
forall v. NESeq (Delta v) -> DeltaHistory v
DeltaHistory
  (Maybe (NESeq (Delta v')) -> Maybe (DeltaHistory v'))
-> (DeltaHistory v -> Maybe (NESeq (Delta v')))
-> DeltaHistory v
-> Maybe (DeltaHistory v')
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq (Delta v') -> Maybe (NESeq (Delta v'))
forall a. Seq a -> Maybe (NESeq a)
nonEmptySeq
  (Seq (Delta v') -> Maybe (NESeq (Delta v')))
-> (DeltaHistory v -> Seq (Delta v'))
-> DeltaHistory v
-> Maybe (NESeq (Delta v'))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Delta v'] -> Seq (Delta v')
forall a. [a] -> Seq a
Seq.fromList
  ([Delta v'] -> Seq (Delta v'))
-> (DeltaHistory v -> [Delta v'])
-> DeltaHistory v
-> Seq (Delta v')
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Delta v -> Maybe (Delta v')) -> [Delta v] -> [Delta v']
forall a b. (a -> Maybe b) -> [a] -> [b]
Maybe.mapMaybe ((v -> Maybe v') -> Delta v -> Maybe (Delta v')
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Delta a -> f (Delta b)
traverse v -> Maybe v'
f)
  ([Delta v] -> [Delta v'])
-> (DeltaHistory v -> [Delta v]) -> DeltaHistory v -> [Delta v']
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NESeq (Delta v) -> [Delta v]
forall a. NESeq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
  (NESeq (Delta v) -> [Delta v])
-> (DeltaHistory v -> NESeq (Delta v))
-> DeltaHistory v
-> [Delta v]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DeltaHistory v -> NESeq (Delta v)
forall v. DeltaHistory v -> NESeq (Delta v)
getDeltaHistory

mapMaybeDiff :: (v -> Maybe v') -> Diff k v -> Diff k v'
mapMaybeDiff :: forall v v' k. (v -> Maybe v') -> Diff k v -> Diff k v'
mapMaybeDiff v -> Maybe v'
f (Diff Map k (DeltaHistory v)
d) = Map k (DeltaHistory v') -> Diff k v'
forall k v. Map k (DeltaHistory v) -> Diff k v
Diff (Map k (DeltaHistory v') -> Diff k v')
-> Map k (DeltaHistory v') -> Diff k v'
forall a b. (a -> b) -> a -> b
$ (DeltaHistory v -> Maybe (DeltaHistory v'))
-> Map k (DeltaHistory v) -> Map k (DeltaHistory v')
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe ((v -> Maybe v') -> DeltaHistory v -> Maybe (DeltaHistory v')
forall v v'.
(v -> Maybe v') -> DeltaHistory v -> Maybe (DeltaHistory v')
mapMaybeSeq v -> Maybe v'
f) Map k (DeltaHistory v)
d