{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}

-- | 'Patch'es on 'Map' that consist only of insertions (including overwrites)
-- and deletions
module Data.Patch.Map where

import Data.Patch.Class

import Control.Lens
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Maybe
import Data.Monoid.DecidablyEmpty
import Data.Semigroup (Semigroup (..), stimesIdempotentMonoid)

-- | A set of changes to a 'Map'.  Any element may be inserted/updated or
-- deleted.  Insertions are represented as values wrapped in 'Just', while
-- deletions are represented as 'Nothing's
newtype PatchMap k v = PatchMap { PatchMap k v -> Map k (Maybe v)
unPatchMap :: Map k (Maybe v) }
  deriving ( Int -> PatchMap k v -> ShowS
[PatchMap k v] -> ShowS
PatchMap k v -> String
(Int -> PatchMap k v -> ShowS)
-> (PatchMap k v -> String)
-> ([PatchMap k v] -> ShowS)
-> Show (PatchMap k v)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k v. (Show k, Show v) => Int -> PatchMap k v -> ShowS
forall k v. (Show k, Show v) => [PatchMap k v] -> ShowS
forall k v. (Show k, Show v) => PatchMap k v -> String
showList :: [PatchMap k v] -> ShowS
$cshowList :: forall k v. (Show k, Show v) => [PatchMap k v] -> ShowS
show :: PatchMap k v -> String
$cshow :: forall k v. (Show k, Show v) => PatchMap k v -> String
showsPrec :: Int -> PatchMap k v -> ShowS
$cshowsPrec :: forall k v. (Show k, Show v) => Int -> PatchMap k v -> ShowS
Show, ReadPrec [PatchMap k v]
ReadPrec (PatchMap k v)
Int -> ReadS (PatchMap k v)
ReadS [PatchMap k v]
(Int -> ReadS (PatchMap k v))
-> ReadS [PatchMap k v]
-> ReadPrec (PatchMap k v)
-> ReadPrec [PatchMap k v]
-> Read (PatchMap k v)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall k v. (Ord k, Read k, Read v) => ReadPrec [PatchMap k v]
forall k v. (Ord k, Read k, Read v) => ReadPrec (PatchMap k v)
forall k v. (Ord k, Read k, Read v) => Int -> ReadS (PatchMap k v)
forall k v. (Ord k, Read k, Read v) => ReadS [PatchMap k v]
readListPrec :: ReadPrec [PatchMap k v]
$creadListPrec :: forall k v. (Ord k, Read k, Read v) => ReadPrec [PatchMap k v]
readPrec :: ReadPrec (PatchMap k v)
$creadPrec :: forall k v. (Ord k, Read k, Read v) => ReadPrec (PatchMap k v)
readList :: ReadS [PatchMap k v]
$creadList :: forall k v. (Ord k, Read k, Read v) => ReadS [PatchMap k v]
readsPrec :: Int -> ReadS (PatchMap k v)
$creadsPrec :: forall k v. (Ord k, Read k, Read v) => Int -> ReadS (PatchMap k v)
Read, PatchMap k v -> PatchMap k v -> Bool
(PatchMap k v -> PatchMap k v -> Bool)
-> (PatchMap k v -> PatchMap k v -> Bool) -> Eq (PatchMap k v)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k v. (Eq k, Eq v) => PatchMap k v -> PatchMap k v -> Bool
/= :: PatchMap k v -> PatchMap k v -> Bool
$c/= :: forall k v. (Eq k, Eq v) => PatchMap k v -> PatchMap k v -> Bool
== :: PatchMap k v -> PatchMap k v -> Bool
$c== :: forall k v. (Eq k, Eq v) => PatchMap k v -> PatchMap k v -> Bool
Eq, Eq (PatchMap k v)
Eq (PatchMap k v)
-> (PatchMap k v -> PatchMap k v -> Ordering)
-> (PatchMap k v -> PatchMap k v -> Bool)
-> (PatchMap k v -> PatchMap k v -> Bool)
-> (PatchMap k v -> PatchMap k v -> Bool)
-> (PatchMap k v -> PatchMap k v -> Bool)
-> (PatchMap k v -> PatchMap k v -> PatchMap k v)
-> (PatchMap k v -> PatchMap k v -> PatchMap k v)
-> Ord (PatchMap k v)
PatchMap k v -> PatchMap k v -> Bool
PatchMap k v -> PatchMap k v -> Ordering
PatchMap k v -> PatchMap k v -> PatchMap k v
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall k v. (Ord k, Ord v) => Eq (PatchMap k v)
forall k v. (Ord k, Ord v) => PatchMap k v -> PatchMap k v -> Bool
forall k v.
(Ord k, Ord v) =>
PatchMap k v -> PatchMap k v -> Ordering
forall k v.
(Ord k, Ord v) =>
PatchMap k v -> PatchMap k v -> PatchMap k v
min :: PatchMap k v -> PatchMap k v -> PatchMap k v
$cmin :: forall k v.
(Ord k, Ord v) =>
PatchMap k v -> PatchMap k v -> PatchMap k v
max :: PatchMap k v -> PatchMap k v -> PatchMap k v
$cmax :: forall k v.
(Ord k, Ord v) =>
PatchMap k v -> PatchMap k v -> PatchMap k v
>= :: PatchMap k v -> PatchMap k v -> Bool
$c>= :: forall k v. (Ord k, Ord v) => PatchMap k v -> PatchMap k v -> Bool
> :: PatchMap k v -> PatchMap k v -> Bool
$c> :: forall k v. (Ord k, Ord v) => PatchMap k v -> PatchMap k v -> Bool
<= :: PatchMap k v -> PatchMap k v -> Bool
$c<= :: forall k v. (Ord k, Ord v) => PatchMap k v -> PatchMap k v -> Bool
< :: PatchMap k v -> PatchMap k v -> Bool
$c< :: forall k v. (Ord k, Ord v) => PatchMap k v -> PatchMap k v -> Bool
compare :: PatchMap k v -> PatchMap k v -> Ordering
$ccompare :: forall k v.
(Ord k, Ord v) =>
PatchMap k v -> PatchMap k v -> Ordering
$cp1Ord :: forall k v. (Ord k, Ord v) => Eq (PatchMap k v)
Ord
           , PatchMap k a -> Bool
(a -> m) -> PatchMap k a -> m
(a -> b -> b) -> b -> PatchMap k a -> b
(forall m. Monoid m => PatchMap k m -> m)
-> (forall m a. Monoid m => (a -> m) -> PatchMap k a -> m)
-> (forall m a. Monoid m => (a -> m) -> PatchMap k a -> m)
-> (forall a b. (a -> b -> b) -> b -> PatchMap k a -> b)
-> (forall a b. (a -> b -> b) -> b -> PatchMap k a -> b)
-> (forall b a. (b -> a -> b) -> b -> PatchMap k a -> b)
-> (forall b a. (b -> a -> b) -> b -> PatchMap k a -> b)
-> (forall a. (a -> a -> a) -> PatchMap k a -> a)
-> (forall a. (a -> a -> a) -> PatchMap k a -> a)
-> (forall a. PatchMap k a -> [a])
-> (forall a. PatchMap k a -> Bool)
-> (forall a. PatchMap k a -> Int)
-> (forall a. Eq a => a -> PatchMap k a -> Bool)
-> (forall a. Ord a => PatchMap k a -> a)
-> (forall a. Ord a => PatchMap k a -> a)
-> (forall a. Num a => PatchMap k a -> a)
-> (forall a. Num a => PatchMap k a -> a)
-> Foldable (PatchMap k)
forall a. Eq a => a -> PatchMap k a -> Bool
forall a. Num a => PatchMap k a -> a
forall a. Ord a => PatchMap k a -> a
forall m. Monoid m => PatchMap k m -> m
forall a. PatchMap k a -> Bool
forall a. PatchMap k a -> Int
forall a. PatchMap k a -> [a]
forall a. (a -> a -> a) -> PatchMap k a -> a
forall k a. Eq a => a -> PatchMap k a -> Bool
forall k a. Num a => PatchMap k a -> a
forall k a. Ord a => PatchMap k a -> a
forall m a. Monoid m => (a -> m) -> PatchMap k a -> m
forall k m. Monoid m => PatchMap k m -> m
forall k a. PatchMap k a -> Bool
forall k a. PatchMap k a -> Int
forall k a. PatchMap k a -> [a]
forall b a. (b -> a -> b) -> b -> PatchMap k a -> b
forall a b. (a -> b -> b) -> b -> PatchMap k a -> b
forall k a. (a -> a -> a) -> PatchMap k a -> a
forall k m a. Monoid m => (a -> m) -> PatchMap k a -> m
forall k b a. (b -> a -> b) -> b -> PatchMap k a -> b
forall k a b. (a -> b -> b) -> b -> PatchMap k 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
product :: PatchMap k a -> a
$cproduct :: forall k a. Num a => PatchMap k a -> a
sum :: PatchMap k a -> a
$csum :: forall k a. Num a => PatchMap k a -> a
minimum :: PatchMap k a -> a
$cminimum :: forall k a. Ord a => PatchMap k a -> a
maximum :: PatchMap k a -> a
$cmaximum :: forall k a. Ord a => PatchMap k a -> a
elem :: a -> PatchMap k a -> Bool
$celem :: forall k a. Eq a => a -> PatchMap k a -> Bool
length :: PatchMap k a -> Int
$clength :: forall k a. PatchMap k a -> Int
null :: PatchMap k a -> Bool
$cnull :: forall k a. PatchMap k a -> Bool
toList :: PatchMap k a -> [a]
$ctoList :: forall k a. PatchMap k a -> [a]
foldl1 :: (a -> a -> a) -> PatchMap k a -> a
$cfoldl1 :: forall k a. (a -> a -> a) -> PatchMap k a -> a
foldr1 :: (a -> a -> a) -> PatchMap k a -> a
$cfoldr1 :: forall k a. (a -> a -> a) -> PatchMap k a -> a
foldl' :: (b -> a -> b) -> b -> PatchMap k a -> b
$cfoldl' :: forall k b a. (b -> a -> b) -> b -> PatchMap k a -> b
foldl :: (b -> a -> b) -> b -> PatchMap k a -> b
$cfoldl :: forall k b a. (b -> a -> b) -> b -> PatchMap k a -> b
foldr' :: (a -> b -> b) -> b -> PatchMap k a -> b
$cfoldr' :: forall k a b. (a -> b -> b) -> b -> PatchMap k a -> b
foldr :: (a -> b -> b) -> b -> PatchMap k a -> b
$cfoldr :: forall k a b. (a -> b -> b) -> b -> PatchMap k a -> b
foldMap' :: (a -> m) -> PatchMap k a -> m
$cfoldMap' :: forall k m a. Monoid m => (a -> m) -> PatchMap k a -> m
foldMap :: (a -> m) -> PatchMap k a -> m
$cfoldMap :: forall k m a. Monoid m => (a -> m) -> PatchMap k a -> m
fold :: PatchMap k m -> m
$cfold :: forall k m. Monoid m => PatchMap k m -> m
Foldable, Functor (PatchMap k)
Foldable (PatchMap k)
Functor (PatchMap k)
-> Foldable (PatchMap k)
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> PatchMap k a -> f (PatchMap k b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    PatchMap k (f a) -> f (PatchMap k a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> PatchMap k a -> m (PatchMap k b))
-> (forall (m :: * -> *) a.
    Monad m =>
    PatchMap k (m a) -> m (PatchMap k a))
-> Traversable (PatchMap k)
(a -> f b) -> PatchMap k a -> f (PatchMap k b)
forall k. Functor (PatchMap k)
forall k. Foldable (PatchMap k)
forall k (m :: * -> *) a.
Monad m =>
PatchMap k (m a) -> m (PatchMap k a)
forall k (f :: * -> *) a.
Applicative f =>
PatchMap k (f a) -> f (PatchMap k a)
forall k (m :: * -> *) a b.
Monad m =>
(a -> m b) -> PatchMap k a -> m (PatchMap k b)
forall k (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> PatchMap k a -> f (PatchMap k b)
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 =>
PatchMap k (m a) -> m (PatchMap k a)
forall (f :: * -> *) a.
Applicative f =>
PatchMap k (f a) -> f (PatchMap k a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> PatchMap k a -> m (PatchMap k b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> PatchMap k a -> f (PatchMap k b)
sequence :: PatchMap k (m a) -> m (PatchMap k a)
$csequence :: forall k (m :: * -> *) a.
Monad m =>
PatchMap k (m a) -> m (PatchMap k a)
mapM :: (a -> m b) -> PatchMap k a -> m (PatchMap k b)
$cmapM :: forall k (m :: * -> *) a b.
Monad m =>
(a -> m b) -> PatchMap k a -> m (PatchMap k b)
sequenceA :: PatchMap k (f a) -> f (PatchMap k a)
$csequenceA :: forall k (f :: * -> *) a.
Applicative f =>
PatchMap k (f a) -> f (PatchMap k a)
traverse :: (a -> f b) -> PatchMap k a -> f (PatchMap k b)
$ctraverse :: forall k (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> PatchMap k a -> f (PatchMap k b)
$cp2Traversable :: forall k. Foldable (PatchMap k)
$cp1Traversable :: forall k. Functor (PatchMap k)
Traversable
           , Monoid (PatchMap k v)
Monoid (PatchMap k v)
-> (PatchMap k v -> Bool) -> DecidablyEmpty (PatchMap k v)
PatchMap k v -> Bool
forall a. Monoid a -> (a -> Bool) -> DecidablyEmpty a
forall k v. Ord k => Monoid (PatchMap k v)
forall k v. Ord k => PatchMap k v -> Bool
isEmpty :: PatchMap k v -> Bool
$cisEmpty :: forall k v. Ord k => PatchMap k v -> Bool
$cp1DecidablyEmpty :: forall k v. Ord k => Monoid (PatchMap k v)
DecidablyEmpty
           )

-- | 'fmap'ping a 'PatchMap' will alter all of the values it will insert.
-- Deletions are unaffected.
deriving instance Functor (PatchMap k)
-- | The empty 'PatchMap' contains no insertions or deletions
deriving instance Ord k => Monoid (PatchMap k v)

-- | @a <> b@ will apply the changes of @b@ and then apply the changes of @a@.
-- If the same key is modified by both patches, the one on the left will take
-- precedence.
instance Ord k => Semigroup (PatchMap k v) where
  PatchMap Map k (Maybe v)
a <> :: PatchMap k v -> PatchMap k v -> PatchMap k v
<> PatchMap Map k (Maybe v)
b = Map k (Maybe v) -> PatchMap k v
forall k v. Map k (Maybe v) -> PatchMap k v
PatchMap (Map k (Maybe v) -> PatchMap k v)
-> Map k (Maybe v) -> PatchMap k v
forall a b. (a -> b) -> a -> b
$ Map k (Maybe v)
a Map k (Maybe v) -> Map k (Maybe v) -> Map k (Maybe v)
forall a. Monoid a => a -> a -> a
`mappend` Map k (Maybe v)
b --TODO: Add a semigroup instance for Map
  -- PatchMap is idempotent, so stimes n is id for every n
  stimes :: b -> PatchMap k v -> PatchMap k v
stimes = b -> PatchMap k v -> PatchMap k v
forall b a. (Integral b, Monoid a) => b -> a -> a
stimesIdempotentMonoid

-- | Apply the insertions or deletions to a given 'Map'.
instance Ord k => Patch (PatchMap k v) where
  type PatchTarget (PatchMap k v) = Map k v
  {-# INLINABLE apply #-}
  apply :: PatchMap k v
-> PatchTarget (PatchMap k v) -> Maybe (PatchTarget (PatchMap k v))
apply (PatchMap Map k (Maybe v)
p) PatchTarget (PatchMap k v)
old = Map k v -> Maybe (Map k v)
forall a. a -> Maybe a
Just (Map k v -> Maybe (Map k v)) -> Map k v -> Maybe (Map k v)
forall a b. (a -> b) -> a -> b
$! Map k v
insertions Map k v -> Map k v -> Map k v
forall k a. Ord k => Map k a -> Map k a -> Map k a
`Map.union` (Map k v
PatchTarget (PatchMap k v)
old Map k v -> Map k () -> Map k v
forall k a b. Ord k => Map k a -> Map k b -> Map k a
`Map.difference` Map k ()
deletions) --TODO: return Nothing sometimes --Note: the strict application here is critical to ensuring that incremental merges don't hold onto all their prerequisite events forever; can we make this more robust?
    where insertions :: Map k v
insertions = (k -> Maybe v -> Maybe v) -> Map k (Maybe v) -> Map k v
forall k a b. (k -> a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybeWithKey ((Maybe v -> Maybe v) -> k -> Maybe v -> Maybe v
forall a b. a -> b -> a
const Maybe v -> Maybe v
forall a. a -> a
id) Map k (Maybe v)
p
          deletions :: Map k ()
deletions = (k -> Maybe v -> Maybe ()) -> Map k (Maybe v) -> Map k ()
forall k a b. (k -> a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybeWithKey ((Maybe v -> Maybe ()) -> k -> Maybe v -> Maybe ()
forall a b. a -> b -> a
const Maybe v -> Maybe ()
forall a. Maybe a -> Maybe ()
nothingToJust) Map k (Maybe v)
p
          nothingToJust :: Maybe a -> Maybe ()
nothingToJust = \case
            Maybe a
Nothing -> () -> Maybe ()
forall a. a -> Maybe a
Just ()
            Just a
_ -> Maybe ()
forall a. Maybe a
Nothing

instance FunctorWithIndex k (PatchMap k)
instance FoldableWithIndex k (PatchMap k)
instance TraversableWithIndex k (PatchMap k) where
  itraverse :: (k -> a -> f b) -> PatchMap k a -> f (PatchMap k b)
itraverse = Indexed k a (f b) -> PatchMap k a -> f (PatchMap k b)
forall i (t :: * -> *) a b.
TraversableWithIndex i t =>
IndexedTraversal i (t a) (t b) a b
itraversed (Indexed k a (f b) -> PatchMap k a -> f (PatchMap k b))
-> ((k -> a -> f b) -> Indexed k a (f b))
-> (k -> a -> f b)
-> PatchMap k a
-> f (PatchMap k b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (k -> a -> f b) -> Indexed k a (f b)
forall i a b. (i -> a -> b) -> Indexed i a b
Indexed
  itraversed :: p a (f b) -> PatchMap k a -> f (PatchMap k b)
itraversed = (Map k (Maybe a) -> f (Map k (Maybe b)))
-> PatchMap k a -> f (PatchMap k b)
forall s t. Rewrapping s t => Iso s t (Unwrapped s) (Unwrapped t)
_Wrapped ((Map k (Maybe a) -> f (Map k (Maybe b)))
 -> PatchMap k a -> f (PatchMap k b))
-> (p a (f b) -> Map k (Maybe a) -> f (Map k (Maybe b)))
-> p a (f b)
-> PatchMap k a
-> f (PatchMap k b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.> Indexed k (Maybe a) (f (Maybe b))
-> Map k (Maybe a) -> f (Map k (Maybe b))
forall i (t :: * -> *) a b.
TraversableWithIndex i t =>
IndexedTraversal i (t a) (t b) a b
itraversed (Indexed k (Maybe a) (f (Maybe b))
 -> Map k (Maybe a) -> f (Map k (Maybe b)))
-> ((a -> f b) -> Maybe a -> f (Maybe b))
-> p a (f b)
-> Map k (Maybe a)
-> f (Map k (Maybe b))
forall i (p :: * -> * -> *) s t r a b.
Indexable i p =>
(Indexed i s t -> r) -> ((a -> b) -> s -> t) -> p a b -> r
<. (a -> f b) -> Maybe a -> f (Maybe b)
forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal Int (f a) (f b) a b
traversed

-- | Returns all the new elements that will be added to the 'Map'
patchMapNewElements :: PatchMap k v -> [v]
patchMapNewElements :: PatchMap k v -> [v]
patchMapNewElements (PatchMap Map k (Maybe v)
p) = [Maybe v] -> [v]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe v] -> [v]) -> [Maybe v] -> [v]
forall a b. (a -> b) -> a -> b
$ Map k (Maybe v) -> [Maybe v]
forall k a. Map k a -> [a]
Map.elems Map k (Maybe v)
p

-- | Returns all the new elements that will be added to the 'Map'
patchMapNewElementsMap :: PatchMap k v -> Map k v
patchMapNewElementsMap :: PatchMap k v -> Map k v
patchMapNewElementsMap (PatchMap Map k (Maybe v)
p) = (Maybe v -> Maybe v) -> Map k (Maybe v) -> Map k v
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe Maybe v -> Maybe v
forall a. a -> a
id Map k (Maybe v)
p

makeWrapped ''PatchMap