{-# LANGUAGE CPP #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}

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

import Data.Patch.Class
import Data.Patch.IntMap
import Data.Patch.Map

import Data.Dependent.Map (DMap)
import Data.Dependent.Sum (DSum (..))
import Data.GADT.Compare (GCompare (..))
import qualified Data.Dependent.Map as DMap
import Data.Functor.Constant
import Data.Functor.Misc
import qualified Data.IntMap as IntMap
import qualified Data.Map as Map
import Data.Monoid.DecidablyEmpty
#if !MIN_VERSION_base(4,11,0)
import Data.Semigroup (Semigroup (..))
#endif
import Data.Some (Some)

-- | A set of changes to a 'DMap'.  Any element may be inserted/updated or deleted.
-- Insertions are represented as @'ComposeMaybe' (Just value)@,
-- while deletions are represented as @'ComposeMaybe' Nothing@.
newtype PatchDMap k v = PatchDMap { PatchDMap k v -> DMap k (ComposeMaybe v)
unPatchDMap :: DMap k (ComposeMaybe v) }

deriving instance GCompare k => Semigroup (PatchDMap k v)

deriving instance GCompare k => Monoid (PatchDMap k v)

-- It won't let me derive for some reason
instance GCompare k => DecidablyEmpty (PatchDMap k v) where
  isEmpty :: PatchDMap k v -> Bool
isEmpty (PatchDMap DMap k (ComposeMaybe v)
m) = DMap k (ComposeMaybe v) -> Bool
forall k1 (k2 :: k1 -> *) (f :: k1 -> *). DMap k2 f -> Bool
DMap.null DMap k (ComposeMaybe v)
m

-- | Apply the insertions or deletions to a given 'DMap'.
instance GCompare k => Patch (PatchDMap k v) where
  type PatchTarget (PatchDMap k v) = DMap k v
  apply :: PatchDMap k v
-> PatchTarget (PatchDMap k v)
-> Maybe (PatchTarget (PatchDMap k v))
apply (PatchDMap DMap k (ComposeMaybe v)
diff) PatchTarget (PatchDMap k v)
old = DMap k v -> Maybe (DMap k v)
forall a. a -> Maybe a
Just (DMap k v -> Maybe (DMap k v)) -> DMap k v -> Maybe (DMap k v)
forall a b. (a -> b) -> a -> b
$! DMap k v
insertions DMap k v -> DMap k v -> DMap k v
forall k1 (k2 :: k1 -> *) (f :: k1 -> *).
GCompare k2 =>
DMap k2 f -> DMap k2 f -> DMap k2 f
`DMap.union` (DMap k v
PatchTarget (PatchDMap k v)
old DMap k v -> DMap k (Constant ()) -> DMap k v
forall k1 (k2 :: k1 -> *) (f :: k1 -> *) (g :: k1 -> *).
GCompare k2 =>
DMap k2 f -> DMap k2 g -> DMap k2 f
`DMap.difference` DMap k (Constant ())
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 :: DMap k v
insertions = (forall (v :: k). k v -> ComposeMaybe v v -> Maybe (v v))
-> DMap k (ComposeMaybe v) -> DMap k v
forall k1 (k2 :: k1 -> *) (f :: k1 -> *) (g :: k1 -> *).
GCompare k2 =>
(forall (v :: k1). k2 v -> f v -> Maybe (g v))
-> DMap k2 f -> DMap k2 g
DMap.mapMaybeWithKey ((ComposeMaybe v v -> Maybe (v v))
-> k v -> ComposeMaybe v v -> Maybe (v v)
forall a b. a -> b -> a
const ((ComposeMaybe v v -> Maybe (v v))
 -> k v -> ComposeMaybe v v -> Maybe (v v))
-> (ComposeMaybe v v -> Maybe (v v))
-> k v
-> ComposeMaybe v v
-> Maybe (v v)
forall a b. (a -> b) -> a -> b
$ ComposeMaybe v v -> Maybe (v v)
forall k (f :: k -> *) (a :: k). ComposeMaybe f a -> Maybe (f a)
getComposeMaybe) DMap k (ComposeMaybe v)
diff
          deletions :: DMap k (Constant ())
deletions = (forall (v :: k). k v -> ComposeMaybe v v -> Maybe (Constant () v))
-> DMap k (ComposeMaybe v) -> DMap k (Constant ())
forall k1 (k2 :: k1 -> *) (f :: k1 -> *) (g :: k1 -> *).
GCompare k2 =>
(forall (v :: k1). k2 v -> f v -> Maybe (g v))
-> DMap k2 f -> DMap k2 g
DMap.mapMaybeWithKey ((ComposeMaybe v v -> Maybe (Constant () v))
-> k v -> ComposeMaybe v v -> Maybe (Constant () v)
forall a b. a -> b -> a
const ((ComposeMaybe v v -> Maybe (Constant () v))
 -> k v -> ComposeMaybe v v -> Maybe (Constant () v))
-> (ComposeMaybe v v -> Maybe (Constant () v))
-> k v
-> ComposeMaybe v v
-> Maybe (Constant () v)
forall a b. (a -> b) -> a -> b
$ Maybe (v v) -> Maybe (Constant () v)
forall k a (b :: k). Maybe a -> Maybe (Constant () b)
nothingToJust (Maybe (v v) -> Maybe (Constant () v))
-> (ComposeMaybe v v -> Maybe (v v))
-> ComposeMaybe v v
-> Maybe (Constant () v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ComposeMaybe v v -> Maybe (v v)
forall k (f :: k -> *) (a :: k). ComposeMaybe f a -> Maybe (f a)
getComposeMaybe) DMap k (ComposeMaybe v)
diff
          nothingToJust :: Maybe a -> Maybe (Constant () b)
nothingToJust = \case
            Maybe a
Nothing -> Constant () b -> Maybe (Constant () b)
forall a. a -> Maybe a
Just (Constant () b -> Maybe (Constant () b))
-> Constant () b -> Maybe (Constant () b)
forall a b. (a -> b) -> a -> b
$ () -> Constant () b
forall k a (b :: k). a -> Constant a b
Constant ()
            Just a
_ -> Maybe (Constant () b)
forall a. Maybe a
Nothing

-- | Map a function @v a -> v' a@ over any inserts/updates in the given
-- @'PatchDMap' k v@ to produce a @'PatchDMap' k v'@.
mapPatchDMap :: (forall a. v a -> v' a) -> PatchDMap k v -> PatchDMap k v'
mapPatchDMap :: (forall (a :: k). v a -> v' a) -> PatchDMap k v -> PatchDMap k v'
mapPatchDMap forall (a :: k). v a -> v' a
f (PatchDMap DMap k (ComposeMaybe v)
p) = DMap k (ComposeMaybe v') -> PatchDMap k v'
forall k (k :: k -> *) (v :: k -> *).
DMap k (ComposeMaybe v) -> PatchDMap k v
PatchDMap (DMap k (ComposeMaybe v') -> PatchDMap k v')
-> DMap k (ComposeMaybe v') -> PatchDMap k v'
forall a b. (a -> b) -> a -> b
$ (forall (v :: k). ComposeMaybe v v -> ComposeMaybe v' v)
-> DMap k (ComposeMaybe v) -> DMap k (ComposeMaybe v')
forall k1 (f :: k1 -> *) (g :: k1 -> *) (k2 :: k1 -> *).
(forall (v :: k1). f v -> g v) -> DMap k2 f -> DMap k2 g
DMap.map (Maybe (v' v) -> ComposeMaybe v' v
forall k (f :: k -> *) (a :: k). Maybe (f a) -> ComposeMaybe f a
ComposeMaybe (Maybe (v' v) -> ComposeMaybe v' v)
-> (ComposeMaybe v v -> Maybe (v' v))
-> ComposeMaybe v v
-> ComposeMaybe v' v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (v v -> v' v) -> Maybe (v v) -> Maybe (v' v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap v v -> v' v
forall (a :: k). v a -> v' a
f (Maybe (v v) -> Maybe (v' v))
-> (ComposeMaybe v v -> Maybe (v v))
-> ComposeMaybe v v
-> Maybe (v' v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ComposeMaybe v v -> Maybe (v v)
forall k (f :: k -> *) (a :: k). ComposeMaybe f a -> Maybe (f a)
getComposeMaybe) DMap k (ComposeMaybe v)
p

-- | Map an effectful function @v a -> f (v' a)@ over any inserts/updates in the given
-- @'PatchDMap' k v@ to produce a @'PatchDMap' k v'@.
traversePatchDMap :: Applicative f => (forall a. v a -> f (v' a)) -> PatchDMap k v -> f (PatchDMap k v')
traversePatchDMap :: (forall (a :: k). v a -> f (v' a))
-> PatchDMap k v -> f (PatchDMap k v')
traversePatchDMap forall (a :: k). v a -> f (v' a)
f = (forall (a :: k). k a -> v a -> f (v' a))
-> PatchDMap k v -> f (PatchDMap k v')
forall k (m :: * -> *) (k :: k -> *) (v :: k -> *) (v' :: k -> *).
Applicative m =>
(forall (a :: k). k a -> v a -> m (v' a))
-> PatchDMap k v -> m (PatchDMap k v')
traversePatchDMapWithKey ((forall (a :: k). k a -> v a -> f (v' a))
 -> PatchDMap k v -> f (PatchDMap k v'))
-> (forall (a :: k). k a -> v a -> f (v' a))
-> PatchDMap k v
-> f (PatchDMap k v')
forall a b. (a -> b) -> a -> b
$ (v a -> f (v' a)) -> k a -> v a -> f (v' a)
forall a b. a -> b -> a
const v a -> f (v' a)
forall (a :: k). v a -> f (v' a)
f

-- | Map an effectful function @k a -> v a -> f (v' a)@ over any inserts/updates
-- in the given @'PatchDMap' k v@ to produce a @'PatchDMap' k v'@.
traversePatchDMapWithKey :: Applicative m => (forall a. k a -> v a -> m (v' a)) -> PatchDMap k v -> m (PatchDMap k v')
traversePatchDMapWithKey :: (forall (a :: k). k a -> v a -> m (v' a))
-> PatchDMap k v -> m (PatchDMap k v')
traversePatchDMapWithKey forall (a :: k). k a -> v a -> m (v' a)
f (PatchDMap DMap k (ComposeMaybe v)
p) = DMap k (ComposeMaybe v') -> PatchDMap k v'
forall k (k :: k -> *) (v :: k -> *).
DMap k (ComposeMaybe v) -> PatchDMap k v
PatchDMap (DMap k (ComposeMaybe v') -> PatchDMap k v')
-> m (DMap k (ComposeMaybe v')) -> m (PatchDMap k v')
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (v :: k). k v -> ComposeMaybe v v -> m (ComposeMaybe v' v))
-> DMap k (ComposeMaybe v) -> m (DMap k (ComposeMaybe v'))
forall k1 (t :: * -> *) (k2 :: k1 -> *) (f :: k1 -> *)
       (g :: k1 -> *).
Applicative t =>
(forall (v :: k1). k2 v -> f v -> t (g v))
-> DMap k2 f -> t (DMap k2 g)
DMap.traverseWithKey (\k v
k (ComposeMaybe v) -> Maybe (v' v) -> ComposeMaybe v' v
forall k (f :: k -> *) (a :: k). Maybe (f a) -> ComposeMaybe f a
ComposeMaybe (Maybe (v' v) -> ComposeMaybe v' v)
-> m (Maybe (v' v)) -> m (ComposeMaybe v' v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (v v -> m (v' v)) -> Maybe (v v) -> m (Maybe (v' v))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (k v -> v v -> m (v' v)
forall (a :: k). k a -> v a -> m (v' a)
f k v
k) Maybe (v v)
v) DMap k (ComposeMaybe v)
p

-- | Weaken a @'PatchDMap' k v@ to a @'PatchMap' (Some k) v'@ using a function
-- @v a -> v'@ to weaken each value contained in the patch.
weakenPatchDMapWith :: (forall a. v a -> v') -> PatchDMap k v -> PatchMap (Some k) v'
weakenPatchDMapWith :: (forall (a :: k). v a -> v')
-> PatchDMap k v -> PatchMap (Some k) v'
weakenPatchDMapWith forall (a :: k). v a -> v'
f (PatchDMap DMap k (ComposeMaybe v)
p) = Map (Some k) (Maybe v') -> PatchMap (Some k) v'
forall k v. Map k (Maybe v) -> PatchMap k v
PatchMap (Map (Some k) (Maybe v') -> PatchMap (Some k) v')
-> Map (Some k) (Maybe v') -> PatchMap (Some k) v'
forall a b. (a -> b) -> a -> b
$ (forall (a :: k). ComposeMaybe v a -> Maybe v')
-> DMap k (ComposeMaybe v) -> Map (Some k) (Maybe v')
forall k1 (v :: k1 -> *) v' (k2 :: k1 -> *).
(forall (a :: k1). v a -> v') -> DMap k2 v -> Map (Some k2) v'
weakenDMapWith ((v a -> v') -> Maybe (v a) -> Maybe v'
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap v a -> v'
forall (a :: k). v a -> v'
f (Maybe (v a) -> Maybe v')
-> (ComposeMaybe v a -> Maybe (v a))
-> ComposeMaybe v a
-> Maybe v'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ComposeMaybe v a -> Maybe (v a)
forall k (f :: k -> *) (a :: k). ComposeMaybe f a -> Maybe (f a)
getComposeMaybe) DMap k (ComposeMaybe v)
p

-- | Convert a weak @'PatchDMap' ('Const2' k a) v@ where the @a@ is known by way of
-- the @Const2@ into a @'PatchMap' k v'@ using a rank 1 function @v a -> v'@.
patchDMapToPatchMapWith :: (v a -> v') -> PatchDMap (Const2 k a) v -> PatchMap k v'
patchDMapToPatchMapWith :: (v a -> v') -> PatchDMap (Const2 k a) v -> PatchMap k v'
patchDMapToPatchMapWith v a -> v'
f (PatchDMap DMap (Const2 k a) (ComposeMaybe v)
p) = 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
$ (ComposeMaybe v a -> Maybe v')
-> DMap (Const2 k a) (ComposeMaybe v) -> Map k (Maybe v')
forall k1 (f :: k1 -> *) (v :: k1) v' k2.
(f v -> v') -> DMap (Const2 k2 v) f -> Map k2 v'
dmapToMapWith ((v a -> v') -> Maybe (v a) -> Maybe v'
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap v a -> v'
f (Maybe (v a) -> Maybe v')
-> (ComposeMaybe v a -> Maybe (v a))
-> ComposeMaybe v a
-> Maybe v'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ComposeMaybe v a -> Maybe (v a)
forall k (f :: k -> *) (a :: k). ComposeMaybe f a -> Maybe (f a)
getComposeMaybe) DMap (Const2 k a) (ComposeMaybe v)
p

-- | Convert a @'PatchMap' k v@ into a @'PatchDMap' ('Const2' k a) v'@ using a function @v -> v' a@.
const2PatchDMapWith :: forall k v v' a. (v -> v' a) -> PatchMap k v -> PatchDMap (Const2 k a) v'
const2PatchDMapWith :: (v -> v' a) -> PatchMap k v -> PatchDMap (Const2 k a) v'
const2PatchDMapWith v -> v' a
f (PatchMap Map k (Maybe v)
p) = DMap (Const2 k a) (ComposeMaybe v') -> PatchDMap (Const2 k a) v'
forall k (k :: k -> *) (v :: k -> *).
DMap k (ComposeMaybe v) -> PatchDMap k v
PatchDMap (DMap (Const2 k a) (ComposeMaybe v') -> PatchDMap (Const2 k a) v')
-> DMap (Const2 k a) (ComposeMaybe v') -> PatchDMap (Const2 k a) v'
forall a b. (a -> b) -> a -> b
$ [DSum (Const2 k a) (ComposeMaybe v')]
-> DMap (Const2 k a) (ComposeMaybe v')
forall k1 (k2 :: k1 -> *) (f :: k1 -> *). [DSum k2 f] -> DMap k2 f
DMap.fromDistinctAscList ([DSum (Const2 k a) (ComposeMaybe v')]
 -> DMap (Const2 k a) (ComposeMaybe v'))
-> [DSum (Const2 k a) (ComposeMaybe v')]
-> DMap (Const2 k a) (ComposeMaybe v')
forall a b. (a -> b) -> a -> b
$ (k, Maybe v) -> DSum (Const2 k a) (ComposeMaybe v')
g ((k, Maybe v) -> DSum (Const2 k a) (ComposeMaybe v'))
-> [(k, Maybe v)] -> [DSum (Const2 k a) (ComposeMaybe v')]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map k (Maybe v) -> [(k, Maybe v)]
forall k a. Map k a -> [(k, a)]
Map.toAscList Map k (Maybe v)
p
  where g :: (k, Maybe v) -> DSum (Const2 k a) (ComposeMaybe v')
        g :: (k, Maybe v) -> DSum (Const2 k a) (ComposeMaybe v')
g (k
k, Maybe v
e) = k -> Const2 k a a
forall x k (v :: x). k -> Const2 k v v
Const2 k
k Const2 k a a
-> ComposeMaybe v' a -> DSum (Const2 k a) (ComposeMaybe v')
forall k (tag :: k -> *) (f :: k -> *) (a :: k).
tag a -> f a -> DSum tag f
:=> Maybe (v' a) -> ComposeMaybe v' a
forall k (f :: k -> *) (a :: k). Maybe (f a) -> ComposeMaybe f a
ComposeMaybe (v -> v' a
f (v -> v' a) -> Maybe v -> Maybe (v' a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe v
e)

-- | Convert a @'PatchIntMap' v@ into a @'PatchDMap' ('Const2' Int a) v'@ using a function @v -> v' a@.
const2IntPatchDMapWith :: forall v f a. (v -> f a) -> PatchIntMap v -> PatchDMap (Const2 IntMap.Key a) f
const2IntPatchDMapWith :: (v -> f a) -> PatchIntMap v -> PatchDMap (Const2 Key a) f
const2IntPatchDMapWith v -> f a
f (PatchIntMap IntMap (Maybe v)
p) = DMap (Const2 Key a) (ComposeMaybe f) -> PatchDMap (Const2 Key a) f
forall k (k :: k -> *) (v :: k -> *).
DMap k (ComposeMaybe v) -> PatchDMap k v
PatchDMap (DMap (Const2 Key a) (ComposeMaybe f)
 -> PatchDMap (Const2 Key a) f)
-> DMap (Const2 Key a) (ComposeMaybe f)
-> PatchDMap (Const2 Key a) f
forall a b. (a -> b) -> a -> b
$ [DSum (Const2 Key a) (ComposeMaybe f)]
-> DMap (Const2 Key a) (ComposeMaybe f)
forall k1 (k2 :: k1 -> *) (f :: k1 -> *). [DSum k2 f] -> DMap k2 f
DMap.fromDistinctAscList ([DSum (Const2 Key a) (ComposeMaybe f)]
 -> DMap (Const2 Key a) (ComposeMaybe f))
-> [DSum (Const2 Key a) (ComposeMaybe f)]
-> DMap (Const2 Key a) (ComposeMaybe f)
forall a b. (a -> b) -> a -> b
$ (Key, Maybe v) -> DSum (Const2 Key a) (ComposeMaybe f)
g ((Key, Maybe v) -> DSum (Const2 Key a) (ComposeMaybe f))
-> [(Key, Maybe v)] -> [DSum (Const2 Key a) (ComposeMaybe f)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IntMap (Maybe v) -> [(Key, Maybe v)]
forall a. IntMap a -> [(Key, a)]
IntMap.toAscList IntMap (Maybe v)
p
  where g :: (IntMap.Key, Maybe v) -> DSum (Const2 IntMap.Key a) (ComposeMaybe f)
        g :: (Key, Maybe v) -> DSum (Const2 Key a) (ComposeMaybe f)
g (Key
k, Maybe v
e) = Key -> Const2 Key a a
forall x k (v :: x). k -> Const2 k v v
Const2 Key
k Const2 Key a a
-> ComposeMaybe f a -> DSum (Const2 Key a) (ComposeMaybe f)
forall k (tag :: k -> *) (f :: k -> *) (a :: k).
tag a -> f a -> DSum tag f
:=> Maybe (f a) -> ComposeMaybe f a
forall k (f :: k -> *) (a :: k). Maybe (f a) -> ComposeMaybe f a
ComposeMaybe (v -> f a
f (v -> f a) -> Maybe v -> Maybe (f a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe v
e)

-- | Get the values that will be replaced or deleted if the given patch is applied to the given 'DMap'.
getDeletions :: GCompare k => PatchDMap k v -> DMap k v' -> DMap k v'
getDeletions :: PatchDMap k v -> DMap k v' -> DMap k v'
getDeletions (PatchDMap DMap k (ComposeMaybe v)
p) DMap k v'
m = (forall (v :: k). k v -> v' v -> ComposeMaybe v v -> v' v)
-> DMap k v' -> DMap k (ComposeMaybe v) -> DMap k v'
forall k1 (k2 :: k1 -> *) (f :: k1 -> *) (g :: k1 -> *)
       (h :: k1 -> *).
GCompare k2 =>
(forall (v :: k1). k2 v -> f v -> g v -> h v)
-> DMap k2 f -> DMap k2 g -> DMap k2 h
DMap.intersectionWithKey (\k v
_ v' v
v ComposeMaybe v v
_ -> v' v
v) DMap k v'
m DMap k (ComposeMaybe v)
p