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

{-|
Description: A basic 'Patch' on 'DMap'

Patches of this type consist only of insertions (including 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 { forall {k} (k :: k -> *) (v :: k -> *).
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 {k} (v :: k -> *) (v' :: k -> *) (k :: k -> *).
(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 a b. (a -> b) -> Maybe a -> Maybe b
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 {k} (f :: * -> *) (v :: k -> *) (v' :: k -> *)
       (k :: k -> *).
Applicative f =>
(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 {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 -> 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 Maybe (v v)
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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe 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 {k} (v :: k -> *) v' (k :: k -> *).
(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 a b. (a -> b) -> Maybe a -> Maybe b
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 :: forall {k} (v :: k -> *) (a :: k) v' k.
(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 a b. (a -> b) -> Maybe a -> Maybe b
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 :: forall {k} k v (v' :: k -> *) (a :: k).
(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} a (b :: x). a -> Const2 a b b
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 :: forall {k} v (f :: k -> *) (a :: k).
(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} a (b :: x). a -> Const2 a b b
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 :: forall {k} (k :: k -> *) (v :: k -> *) (v' :: k -> *).
GCompare k =>
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