{-# LANGUAGE CPP #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
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)
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)
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
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)
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
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
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
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
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
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
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)
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)
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