{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
module Data.Patch.DMapWithMove where
import Data.Patch.Class
import Data.Patch.MapWithMove (PatchMapWithMove (..))
import qualified Data.Patch.MapWithMove as MapWithMove
import Data.Constraint.Extras
import Data.Dependent.Map (DMap)
import Data.Dependent.Sum (DSum (..))
import qualified Data.Dependent.Map as DMap
import Data.Functor.Constant
import Data.Functor.Misc
import Data.Functor.Product
import Data.GADT.Compare (GEq (..), GCompare (..))
import Data.GADT.Show (GShow, gshow)
import Data.Kind (Type)
import qualified Data.Map as Map
import Data.Maybe
import Data.Monoid.DecidablyEmpty
#if !MIN_VERSION_base(4,11,0)
import Data.Semigroup (Semigroup (..))
#endif
import Data.Some (Some, mkSome)
import Data.These
newtype PatchDMapWithMove k v = PatchDMapWithMove (DMap k (NodeInfo k v))
instance GCompare k => DecidablyEmpty (PatchDMapWithMove k v) where
isEmpty :: PatchDMapWithMove k v -> Bool
isEmpty (PatchDMapWithMove DMap k (NodeInfo k v)
m) = DMap k (NodeInfo k v) -> Bool
forall {k1} (k2 :: k1 -> *) (f :: k1 -> *). DMap k2 f -> Bool
DMap.null DMap k (NodeInfo k v)
m
data NodeInfo k v a = NodeInfo
{ forall {k} (k :: k -> *) (v :: k -> *) (a :: k).
NodeInfo k v a -> From k v a
_nodeInfo_from :: !(From k v a)
, forall {k} (k :: k -> *) (v :: k -> *) (a :: k).
NodeInfo k v a -> To k a
_nodeInfo_to :: !(To k a)
}
deriving (Int -> NodeInfo k v a -> ShowS
[NodeInfo k v a] -> ShowS
NodeInfo k v a -> String
(Int -> NodeInfo k v a -> ShowS)
-> (NodeInfo k v a -> String)
-> ([NodeInfo k v a] -> ShowS)
-> Show (NodeInfo k v a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (k :: k -> *) (v :: k -> *) (a :: k).
(Show (v a), Show (k a)) =>
Int -> NodeInfo k v a -> ShowS
forall k (k :: k -> *) (v :: k -> *) (a :: k).
(Show (v a), Show (k a)) =>
[NodeInfo k v a] -> ShowS
forall k (k :: k -> *) (v :: k -> *) (a :: k).
(Show (v a), Show (k a)) =>
NodeInfo k v a -> String
$cshowsPrec :: forall k (k :: k -> *) (v :: k -> *) (a :: k).
(Show (v a), Show (k a)) =>
Int -> NodeInfo k v a -> ShowS
showsPrec :: Int -> NodeInfo k v a -> ShowS
$cshow :: forall k (k :: k -> *) (v :: k -> *) (a :: k).
(Show (v a), Show (k a)) =>
NodeInfo k v a -> String
show :: NodeInfo k v a -> String
$cshowList :: forall k (k :: k -> *) (v :: k -> *) (a :: k).
(Show (v a), Show (k a)) =>
[NodeInfo k v a] -> ShowS
showList :: [NodeInfo k v a] -> ShowS
Show)
data From (k :: a -> Type) (v :: a -> Type) :: a -> Type where
From_Insert :: v a -> From k v a
From_Delete :: From k v a
From_Move :: !(k a) -> From k v a
deriving (Int -> From k v b -> ShowS
[From k v b] -> ShowS
From k v b -> String
(Int -> From k v b -> ShowS)
-> (From k v b -> String)
-> ([From k v b] -> ShowS)
-> Show (From k v b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a (k :: a -> *) (v :: a -> *) (b :: a).
(Show (v b), Show (k b)) =>
Int -> From k v b -> ShowS
forall a (k :: a -> *) (v :: a -> *) (b :: a).
(Show (v b), Show (k b)) =>
[From k v b] -> ShowS
forall a (k :: a -> *) (v :: a -> *) (b :: a).
(Show (v b), Show (k b)) =>
From k v b -> String
$cshowsPrec :: forall a (k :: a -> *) (v :: a -> *) (b :: a).
(Show (v b), Show (k b)) =>
Int -> From k v b -> ShowS
showsPrec :: Int -> From k v b -> ShowS
$cshow :: forall a (k :: a -> *) (v :: a -> *) (b :: a).
(Show (v b), Show (k b)) =>
From k v b -> String
show :: From k v b -> String
$cshowList :: forall a (k :: a -> *) (v :: a -> *) (b :: a).
(Show (v b), Show (k b)) =>
[From k v b] -> ShowS
showList :: [From k v b] -> ShowS
Show, ReadPrec [From k v b]
ReadPrec (From k v b)
Int -> ReadS (From k v b)
ReadS [From k v b]
(Int -> ReadS (From k v b))
-> ReadS [From k v b]
-> ReadPrec (From k v b)
-> ReadPrec [From k v b]
-> Read (From k v b)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall a (k :: a -> *) (v :: a -> *) (b :: a).
(Read (v b), Read (k b)) =>
ReadPrec [From k v b]
forall a (k :: a -> *) (v :: a -> *) (b :: a).
(Read (v b), Read (k b)) =>
ReadPrec (From k v b)
forall a (k :: a -> *) (v :: a -> *) (b :: a).
(Read (v b), Read (k b)) =>
Int -> ReadS (From k v b)
forall a (k :: a -> *) (v :: a -> *) (b :: a).
(Read (v b), Read (k b)) =>
ReadS [From k v b]
$creadsPrec :: forall a (k :: a -> *) (v :: a -> *) (b :: a).
(Read (v b), Read (k b)) =>
Int -> ReadS (From k v b)
readsPrec :: Int -> ReadS (From k v b)
$creadList :: forall a (k :: a -> *) (v :: a -> *) (b :: a).
(Read (v b), Read (k b)) =>
ReadS [From k v b]
readList :: ReadS [From k v b]
$creadPrec :: forall a (k :: a -> *) (v :: a -> *) (b :: a).
(Read (v b), Read (k b)) =>
ReadPrec (From k v b)
readPrec :: ReadPrec (From k v b)
$creadListPrec :: forall a (k :: a -> *) (v :: a -> *) (b :: a).
(Read (v b), Read (k b)) =>
ReadPrec [From k v b]
readListPrec :: ReadPrec [From k v b]
Read, From k v b -> From k v b -> Bool
(From k v b -> From k v b -> Bool)
-> (From k v b -> From k v b -> Bool) -> Eq (From k v b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a (k :: a -> *) (v :: a -> *) (b :: a).
(Eq (v b), Eq (k b)) =>
From k v b -> From k v b -> Bool
$c== :: forall a (k :: a -> *) (v :: a -> *) (b :: a).
(Eq (v b), Eq (k b)) =>
From k v b -> From k v b -> Bool
== :: From k v b -> From k v b -> Bool
$c/= :: forall a (k :: a -> *) (v :: a -> *) (b :: a).
(Eq (v b), Eq (k b)) =>
From k v b -> From k v b -> Bool
/= :: From k v b -> From k v b -> Bool
Eq, Eq (From k v b)
Eq (From k v b) =>
(From k v b -> From k v b -> Ordering)
-> (From k v b -> From k v b -> Bool)
-> (From k v b -> From k v b -> Bool)
-> (From k v b -> From k v b -> Bool)
-> (From k v b -> From k v b -> Bool)
-> (From k v b -> From k v b -> From k v b)
-> (From k v b -> From k v b -> From k v b)
-> Ord (From k v b)
From k v b -> From k v b -> Bool
From k v b -> From k v b -> Ordering
From k v b -> From k v b -> From k v b
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 a (k :: a -> *) (v :: a -> *) (b :: a).
(Ord (v b), Ord (k b)) =>
Eq (From k v b)
forall a (k :: a -> *) (v :: a -> *) (b :: a).
(Ord (v b), Ord (k b)) =>
From k v b -> From k v b -> Bool
forall a (k :: a -> *) (v :: a -> *) (b :: a).
(Ord (v b), Ord (k b)) =>
From k v b -> From k v b -> Ordering
forall a (k :: a -> *) (v :: a -> *) (b :: a).
(Ord (v b), Ord (k b)) =>
From k v b -> From k v b -> From k v b
$ccompare :: forall a (k :: a -> *) (v :: a -> *) (b :: a).
(Ord (v b), Ord (k b)) =>
From k v b -> From k v b -> Ordering
compare :: From k v b -> From k v b -> Ordering
$c< :: forall a (k :: a -> *) (v :: a -> *) (b :: a).
(Ord (v b), Ord (k b)) =>
From k v b -> From k v b -> Bool
< :: From k v b -> From k v b -> Bool
$c<= :: forall a (k :: a -> *) (v :: a -> *) (b :: a).
(Ord (v b), Ord (k b)) =>
From k v b -> From k v b -> Bool
<= :: From k v b -> From k v b -> Bool
$c> :: forall a (k :: a -> *) (v :: a -> *) (b :: a).
(Ord (v b), Ord (k b)) =>
From k v b -> From k v b -> Bool
> :: From k v b -> From k v b -> Bool
$c>= :: forall a (k :: a -> *) (v :: a -> *) (b :: a).
(Ord (v b), Ord (k b)) =>
From k v b -> From k v b -> Bool
>= :: From k v b -> From k v b -> Bool
$cmax :: forall a (k :: a -> *) (v :: a -> *) (b :: a).
(Ord (v b), Ord (k b)) =>
From k v b -> From k v b -> From k v b
max :: From k v b -> From k v b -> From k v b
$cmin :: forall a (k :: a -> *) (v :: a -> *) (b :: a).
(Ord (v b), Ord (k b)) =>
From k v b -> From k v b -> From k v b
min :: From k v b -> From k v b -> From k v b
Ord)
type To = ComposeMaybe
validPatchDMapWithMove :: forall k v. (GCompare k, GShow k) => DMap k (NodeInfo k v) -> Bool
validPatchDMapWithMove :: forall {k} (k :: k -> *) (v :: k -> *).
(GCompare k, GShow k) =>
DMap k (NodeInfo k v) -> Bool
validPatchDMapWithMove = Bool -> Bool
not (Bool -> Bool)
-> (DMap k (NodeInfo k v) -> Bool) -> DMap k (NodeInfo k v) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([String] -> Bool)
-> (DMap k (NodeInfo k v) -> [String])
-> DMap k (NodeInfo k v)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DMap k (NodeInfo k v) -> [String]
forall {k} (k :: k -> *) (v :: k -> *).
(GCompare k, GShow k) =>
DMap k (NodeInfo k v) -> [String]
validationErrorsForPatchDMapWithMove
validationErrorsForPatchDMapWithMove :: forall k v. (GCompare k, GShow k) => DMap k (NodeInfo k v) -> [String]
validationErrorsForPatchDMapWithMove :: forall {k} (k :: k -> *) (v :: k -> *).
(GCompare k, GShow k) =>
DMap k (NodeInfo k v) -> [String]
validationErrorsForPatchDMapWithMove DMap k (NodeInfo k v)
m =
[String]
noSelfMoves [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String]
movesBalanced
where
noSelfMoves :: [String]
noSelfMoves = (DSum k (NodeInfo k v) -> Maybe String)
-> [DSum k (NodeInfo k v)] -> [String]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe DSum k (NodeInfo k v) -> Maybe String
forall {k} {tag :: k -> *} {v :: k -> *}.
(GEq tag, GShow tag) =>
DSum tag (NodeInfo tag v) -> Maybe String
selfMove ([DSum k (NodeInfo k v)] -> [String])
-> (DMap k (NodeInfo k v) -> [DSum k (NodeInfo k v)])
-> DMap k (NodeInfo k v)
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DMap k (NodeInfo k v) -> [DSum k (NodeInfo k v)]
forall {k1} (k2 :: k1 -> *) (f :: k1 -> *).
DMap k2 f -> [DSum k2 f]
DMap.toAscList (DMap k (NodeInfo k v) -> [String])
-> DMap k (NodeInfo k v) -> [String]
forall a b. (a -> b) -> a -> b
$ DMap k (NodeInfo k v)
m
selfMove :: DSum tag (NodeInfo tag v) -> Maybe String
selfMove (tag a
dst :=> NodeInfo (From_Move tag a
src) To tag a
_) | Just a :~: a
_ <- tag a
dst tag a -> tag a -> Maybe (a :~: a)
forall (a :: k) (b :: k). tag a -> tag b -> Maybe (a :~: b)
forall k (f :: k -> *) (a :: k) (b :: k).
GEq f =>
f a -> f b -> Maybe (a :~: b)
`geq` tag a
src = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String
"self move of key " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> tag a -> String
forall {k} (t :: k -> *) (a :: k). GShow t => t a -> String
gshow tag a
src String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" at destination side"
selfMove (tag a
src :=> NodeInfo From tag v a
_ (ComposeMaybe (Just tag a
dst))) | Just a :~: a
_ <- tag a
src tag a -> tag a -> Maybe (a :~: a)
forall (a :: k) (b :: k). tag a -> tag b -> Maybe (a :~: b)
forall k (f :: k -> *) (a :: k) (b :: k).
GEq f =>
f a -> f b -> Maybe (a :~: b)
`geq` tag a
dst = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String
"self move of key " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> tag a -> String
forall {k} (t :: k -> *) (a :: k). GShow t => t a -> String
gshow tag a
dst String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" at source side"
selfMove DSum tag (NodeInfo tag v)
_ = Maybe String
forall a. Maybe a
Nothing
movesBalanced :: [String]
movesBalanced = (DSum k (NodeInfo k v) -> Maybe String)
-> [DSum k (NodeInfo k v)] -> [String]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe DSum k (NodeInfo k v) -> Maybe String
unbalancedMove ([DSum k (NodeInfo k v)] -> [String])
-> (DMap k (NodeInfo k v) -> [DSum k (NodeInfo k v)])
-> DMap k (NodeInfo k v)
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DMap k (NodeInfo k v) -> [DSum k (NodeInfo k v)]
forall {k1} (k2 :: k1 -> *) (f :: k1 -> *).
DMap k2 f -> [DSum k2 f]
DMap.toAscList (DMap k (NodeInfo k v) -> [String])
-> DMap k (NodeInfo k v) -> [String]
forall a b. (a -> b) -> a -> b
$ DMap k (NodeInfo k v)
m
unbalancedMove :: DSum k (NodeInfo k v) -> Maybe String
unbalancedMove (k a
dst :=> NodeInfo (From_Move k a
src) To k a
_) =
case k a -> DMap k (NodeInfo k v) -> Maybe (NodeInfo k v a)
forall {k1} (k2 :: k1 -> *) (f :: k1 -> *) (v :: k1).
GCompare k2 =>
k2 v -> DMap k2 f -> Maybe (f v)
DMap.lookup k a
src DMap k (NodeInfo k v)
m of
Maybe (NodeInfo k v a)
Nothing -> String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String
"unbalanced move at destination key " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> k a -> String
forall {k} (t :: k -> *) (a :: k). GShow t => t a -> String
gshow k a
dst String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" supposedly from " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> k a -> String
forall {k} (t :: k -> *) (a :: k). GShow t => t a -> String
gshow k a
src String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" but source key is not in the patch"
Just (NodeInfo From k v a
_ (ComposeMaybe (Just k a
dst'))) ->
if Maybe (a :~: a) -> Bool
forall a. Maybe a -> Bool
isNothing (k a
dst' k a -> k a -> Maybe (a :~: a)
forall (a :: k) (b :: k). k a -> k b -> Maybe (a :~: b)
forall k (f :: k -> *) (a :: k) (b :: k).
GEq f =>
f a -> f b -> Maybe (a :~: b)
`geq` k a
dst)
then String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String
"unbalanced move at destination key " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> k a -> String
forall {k} (t :: k -> *) (a :: k). GShow t => t a -> String
gshow k a
dst String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" from " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> k a -> String
forall {k} (t :: k -> *) (a :: k). GShow t => t a -> String
gshow k a
src String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" is going to " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> k a -> String
forall {k} (t :: k -> *) (a :: k). GShow t => t a -> String
gshow k a
dst' String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" instead"
else Maybe String
forall a. Maybe a
Nothing
Maybe (NodeInfo k v a)
_ ->
String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String
"unbalanced move at destination key " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> k a -> String
forall {k} (t :: k -> *) (a :: k). GShow t => t a -> String
gshow k a
dst String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" supposedly from " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> k a -> String
forall {k} (t :: k -> *) (a :: k). GShow t => t a -> String
gshow k a
src String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" but source key has no move to key"
unbalancedMove (k a
src :=> NodeInfo From k v a
_ (ComposeMaybe (Just k a
dst))) =
case k a -> DMap k (NodeInfo k v) -> Maybe (NodeInfo k v a)
forall {k1} (k2 :: k1 -> *) (f :: k1 -> *) (v :: k1).
GCompare k2 =>
k2 v -> DMap k2 f -> Maybe (f v)
DMap.lookup k a
dst DMap k (NodeInfo k v)
m of
Maybe (NodeInfo k v a)
Nothing -> String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String
" unbalanced move at source key " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> k a -> String
forall {k} (t :: k -> *) (a :: k). GShow t => t a -> String
gshow k a
src String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" supposedly going to " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> k a -> String
forall {k} (t :: k -> *) (a :: k). GShow t => t a -> String
gshow k a
dst String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" but destination key is not in the patch"
Just (NodeInfo (From_Move k a
src') ComposeMaybe k a
_) ->
if Maybe (a :~: a) -> Bool
forall a. Maybe a -> Bool
isNothing (k a
src' k a -> k a -> Maybe (a :~: a)
forall (a :: k) (b :: k). k a -> k b -> Maybe (a :~: b)
forall k (f :: k -> *) (a :: k) (b :: k).
GEq f =>
f a -> f b -> Maybe (a :~: b)
`geq` k a
src)
then String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String
"unbalanced move at source key " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> k a -> String
forall {k} (t :: k -> *) (a :: k). GShow t => t a -> String
gshow k a
src String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" to " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> k a -> String
forall {k} (t :: k -> *) (a :: k). GShow t => t a -> String
gshow k a
dst String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" is coming from " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> k a -> String
forall {k} (t :: k -> *) (a :: k). GShow t => t a -> String
gshow k a
src' String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" instead"
else Maybe String
forall a. Maybe a
Nothing
Maybe (NodeInfo k v a)
_ ->
String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String
"unbalanced move at source key " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> k a -> String
forall {k} (t :: k -> *) (a :: k). GShow t => t a -> String
gshow k a
src String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" supposedly going to " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> k a -> String
forall {k} (t :: k -> *) (a :: k). GShow t => t a -> String
gshow k a
dst String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" but destination key is not moving"
unbalancedMove DSum k (NodeInfo k v)
_ = Maybe String
forall a. Maybe a
Nothing
instance (GEq k, Has' Eq k (NodeInfo k v)) => Eq (PatchDMapWithMove k v) where
PatchDMapWithMove DMap k (NodeInfo k v)
a == :: PatchDMapWithMove k v -> PatchDMapWithMove k v -> Bool
== PatchDMapWithMove DMap k (NodeInfo k v)
b = DMap k (NodeInfo k v)
a DMap k (NodeInfo k v) -> DMap k (NodeInfo k v) -> Bool
forall a. Eq a => a -> a -> Bool
== DMap k (NodeInfo k v)
b
data Pair1 f g a = Pair1 (f a) (g a)
data Fixup k v a
= Fixup_Delete
| Fixup_Update (These (From k v a) (To k a))
instance GCompare k => Semigroup (PatchDMapWithMove k v) where
PatchDMapWithMove DMap k (NodeInfo k v)
ma <> :: PatchDMapWithMove k v
-> PatchDMapWithMove k v -> PatchDMapWithMove k v
<> PatchDMapWithMove DMap k (NodeInfo k v)
mb = DMap k (NodeInfo k v) -> PatchDMapWithMove k v
forall {k} (k :: k -> *) (v :: k -> *).
DMap k (NodeInfo k v) -> PatchDMapWithMove k v
PatchDMapWithMove DMap k (NodeInfo k v)
m
where
connections :: [DSum k (Pair1 (ComposeMaybe k) (From k v))]
connections = DMap k (Pair1 (ComposeMaybe k) (From k v))
-> [DSum k (Pair1 (ComposeMaybe k) (From k v))]
forall {k1} (k2 :: k1 -> *) (f :: k1 -> *).
DMap k2 f -> [DSum k2 f]
DMap.toList (DMap k (Pair1 (ComposeMaybe k) (From k v))
-> [DSum k (Pair1 (ComposeMaybe k) (From k v))])
-> DMap k (Pair1 (ComposeMaybe k) (From k v))
-> [DSum k (Pair1 (ComposeMaybe k) (From k v))]
forall a b. (a -> b) -> a -> b
$ (forall (v :: k).
k v
-> NodeInfo k v v
-> NodeInfo k v v
-> Pair1 (ComposeMaybe k) (From k v) v)
-> DMap k (NodeInfo k v)
-> DMap k (NodeInfo k v)
-> DMap k (Pair1 (ComposeMaybe k) (From 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
_ NodeInfo k v v
a NodeInfo k v v
b -> ComposeMaybe k v
-> From k v v -> Pair1 (ComposeMaybe k) (From k v) v
forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Pair1 f g a
Pair1 (NodeInfo k v v -> ComposeMaybe k v
forall {k} (k :: k -> *) (v :: k -> *) (a :: k).
NodeInfo k v a -> To k a
_nodeInfo_to NodeInfo k v v
a) (NodeInfo k v v -> From k v v
forall {k} (k :: k -> *) (v :: k -> *) (a :: k).
NodeInfo k v a -> From k v a
_nodeInfo_from NodeInfo k v v
b)) DMap k (NodeInfo k v)
ma DMap k (NodeInfo k v)
mb
h :: DSum k (Pair1 (ComposeMaybe k) (From k v)) -> [DSum k (Fixup k v)]
h :: DSum k (Pair1 (ComposeMaybe k) (From k v)) -> [DSum k (Fixup k v)]
h (k a
_ :=> Pair1 (ComposeMaybe Maybe (k a)
mToAfter) From k v a
editBefore) = case (Maybe (k a)
mToAfter, From k v a
editBefore) of
(Just k a
toAfter, From_Move k a
fromBefore)
| Maybe (a :~: a) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (a :~: a) -> Bool) -> Maybe (a :~: a) -> Bool
forall a b. (a -> b) -> a -> b
$ k a
fromBefore k a -> k a -> Maybe (a :~: a)
forall (a :: k) (b :: k). k a -> k b -> Maybe (a :~: b)
forall k (f :: k -> *) (a :: k) (b :: k).
GEq f =>
f a -> f b -> Maybe (a :~: b)
`geq` k a
toAfter
-> [k a
toAfter k a -> Fixup k v a -> DSum k (Fixup k v)
forall {k} (tag :: k -> *) (f :: k -> *) (a :: k).
tag a -> f a -> DSum tag f
:=> Fixup k v a
forall {k} (k :: k -> *) (v :: k -> *) (a :: k). Fixup k v a
Fixup_Delete]
| Bool
otherwise
-> [ k a
toAfter k a -> Fixup k v a -> DSum k (Fixup k v)
forall {k} (tag :: k -> *) (f :: k -> *) (a :: k).
tag a -> f a -> DSum tag f
:=> These (From k v a) (ComposeMaybe k a) -> Fixup k v a
forall {k} (k :: k -> *) (v :: k -> *) (a :: k).
These (From k v a) (To k a) -> Fixup k v a
Fixup_Update (From k v a -> These (From k v a) (ComposeMaybe k a)
forall a b. a -> These a b
This From k v a
editBefore)
, k a
fromBefore k a -> Fixup k v a -> DSum k (Fixup k v)
forall {k} (tag :: k -> *) (f :: k -> *) (a :: k).
tag a -> f a -> DSum tag f
:=> These (From k v a) (ComposeMaybe k a) -> Fixup k v a
forall {k} (k :: k -> *) (v :: k -> *) (a :: k).
These (From k v a) (To k a) -> Fixup k v a
Fixup_Update (ComposeMaybe k a -> These (From k v a) (ComposeMaybe k a)
forall a b. b -> These a b
That (Maybe (k a) -> ComposeMaybe k a
forall {k} (f :: k -> *) (a :: k). Maybe (f a) -> ComposeMaybe f a
ComposeMaybe Maybe (k a)
mToAfter))
]
(Maybe (k a)
Nothing, From_Move k a
fromBefore) -> [k a
fromBefore k a -> Fixup k v a -> DSum k (Fixup k v)
forall {k} (tag :: k -> *) (f :: k -> *) (a :: k).
tag a -> f a -> DSum tag f
:=> These (From k v a) (ComposeMaybe k a) -> Fixup k v a
forall {k} (k :: k -> *) (v :: k -> *) (a :: k).
These (From k v a) (To k a) -> Fixup k v a
Fixup_Update (ComposeMaybe k a -> These (From k v a) (ComposeMaybe k a)
forall a b. b -> These a b
That (Maybe (k a) -> ComposeMaybe k a
forall {k} (f :: k -> *) (a :: k). Maybe (f a) -> ComposeMaybe f a
ComposeMaybe Maybe (k a)
mToAfter))]
(Just k a
toAfter, From k v a
_) -> [k a
toAfter k a -> Fixup k v a -> DSum k (Fixup k v)
forall {k} (tag :: k -> *) (f :: k -> *) (a :: k).
tag a -> f a -> DSum tag f
:=> These (From k v a) (ComposeMaybe k a) -> Fixup k v a
forall {k} (k :: k -> *) (v :: k -> *) (a :: k).
These (From k v a) (To k a) -> Fixup k v a
Fixup_Update (From k v a -> These (From k v a) (ComposeMaybe k a)
forall a b. a -> These a b
This From k v a
editBefore)]
(Maybe (k a)
Nothing, From k v a
_) -> []
mergeFixups :: p -> Fixup k v a -> Fixup k v a -> Fixup k v a
mergeFixups p
_ Fixup k v a
Fixup_Delete Fixup k v a
Fixup_Delete = Fixup k v a
forall {k} (k :: k -> *) (v :: k -> *) (a :: k). Fixup k v a
Fixup_Delete
mergeFixups p
_ (Fixup_Update These (From k v a) (To k a)
a) (Fixup_Update These (From k v a) (To k a)
b)
| This From k v a
x <- These (From k v a) (To k a)
a, That To k a
y <- These (From k v a) (To k a)
b
= These (From k v a) (To k a) -> Fixup k v a
forall {k} (k :: k -> *) (v :: k -> *) (a :: k).
These (From k v a) (To k a) -> Fixup k v a
Fixup_Update (These (From k v a) (To k a) -> Fixup k v a)
-> These (From k v a) (To k a) -> Fixup k v a
forall a b. (a -> b) -> a -> b
$ From k v a -> To k a -> These (From k v a) (To k a)
forall a b. a -> b -> These a b
These From k v a
x To k a
y
| That To k a
y <- These (From k v a) (To k a)
a, This From k v a
x <- These (From k v a) (To k a)
b
= These (From k v a) (To k a) -> Fixup k v a
forall {k} (k :: k -> *) (v :: k -> *) (a :: k).
These (From k v a) (To k a) -> Fixup k v a
Fixup_Update (These (From k v a) (To k a) -> Fixup k v a)
-> These (From k v a) (To k a) -> Fixup k v a
forall a b. (a -> b) -> a -> b
$ From k v a -> To k a -> These (From k v a) (To k a)
forall a b. a -> b -> These a b
These From k v a
x To k a
y
mergeFixups p
_ Fixup k v a
_ Fixup k v a
_ = String -> Fixup k v a
forall a. HasCallStack => String -> a
error String
"PatchDMapWithMove: incompatible fixups"
fixups :: DMap k (Fixup k v)
fixups = (forall (v :: k). k v -> Fixup k v v -> Fixup k v v -> Fixup k v v)
-> [DSum k (Fixup k v)] -> DMap k (Fixup k v)
forall {k1} (k2 :: k1 -> *) (f :: k1 -> *).
GCompare k2 =>
(forall (v :: k1). k2 v -> f v -> f v -> f v)
-> [DSum k2 f] -> DMap k2 f
DMap.fromListWithKey k v -> Fixup k v v -> Fixup k v v -> Fixup k v v
forall (v :: k). k v -> Fixup k v v -> Fixup k v v -> Fixup k v v
forall {k} {p} {k :: k -> *} {v :: k -> *} {a :: k}.
p -> Fixup k v a -> Fixup k v a -> Fixup k v a
mergeFixups ([DSum k (Fixup k v)] -> DMap k (Fixup k v))
-> [DSum k (Fixup k v)] -> DMap k (Fixup k v)
forall a b. (a -> b) -> a -> b
$ (DSum k (Pair1 (ComposeMaybe k) (From k v))
-> [DSum k (Fixup k v)])
-> [DSum k (Pair1 (ComposeMaybe k) (From k v))]
-> [DSum k (Fixup k v)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap DSum k (Pair1 (ComposeMaybe k) (From k v)) -> [DSum k (Fixup k v)]
h [DSum k (Pair1 (ComposeMaybe k) (From k v))]
connections
combineNodeInfos :: p -> NodeInfo k v a -> NodeInfo k v a -> NodeInfo k v a
combineNodeInfos p
_ NodeInfo k v a
nia NodeInfo k v a
nib = NodeInfo
{ _nodeInfo_from :: From k v a
_nodeInfo_from = NodeInfo k v a -> From k v a
forall {k} (k :: k -> *) (v :: k -> *) (a :: k).
NodeInfo k v a -> From k v a
_nodeInfo_from NodeInfo k v a
nia
, _nodeInfo_to :: To k a
_nodeInfo_to = NodeInfo k v a -> To k a
forall {k} (k :: k -> *) (v :: k -> *) (a :: k).
NodeInfo k v a -> To k a
_nodeInfo_to NodeInfo k v a
nib
}
applyFixup :: p -> NodeInfo k v a -> Fixup k v a -> Maybe (NodeInfo k v a)
applyFixup p
_ NodeInfo k v a
ni = \case
Fixup k v a
Fixup_Delete -> Maybe (NodeInfo k v a)
forall a. Maybe a
Nothing
Fixup_Update These (From k v a) (To k a)
u -> NodeInfo k v a -> Maybe (NodeInfo k v a)
forall a. a -> Maybe a
Just (NodeInfo k v a -> Maybe (NodeInfo k v a))
-> NodeInfo k v a -> Maybe (NodeInfo k v a)
forall a b. (a -> b) -> a -> b
$ NodeInfo
{ _nodeInfo_from :: From k v a
_nodeInfo_from = From k v a -> Maybe (From k v a) -> From k v a
forall a. a -> Maybe a -> a
fromMaybe (NodeInfo k v a -> From k v a
forall {k} (k :: k -> *) (v :: k -> *) (a :: k).
NodeInfo k v a -> From k v a
_nodeInfo_from NodeInfo k v a
ni) (Maybe (From k v a) -> From k v a)
-> Maybe (From k v a) -> From k v a
forall a b. (a -> b) -> a -> b
$ These (From k v a) (To k a) -> Maybe (From k v a)
forall a b. These a b -> Maybe a
getHere These (From k v a) (To k a)
u
, _nodeInfo_to :: To k a
_nodeInfo_to = To k a -> Maybe (To k a) -> To k a
forall a. a -> Maybe a -> a
fromMaybe (NodeInfo k v a -> To k a
forall {k} (k :: k -> *) (v :: k -> *) (a :: k).
NodeInfo k v a -> To k a
_nodeInfo_to NodeInfo k v a
ni) (Maybe (To k a) -> To k a) -> Maybe (To k a) -> To k a
forall a b. (a -> b) -> a -> b
$ These (From k v a) (To k a) -> Maybe (To k a)
forall a b. These a b -> Maybe b
getThere These (From k v a) (To k a)
u
}
m :: DMap k (NodeInfo k v)
m = (forall (v :: k).
k v -> NodeInfo k v v -> Fixup k v v -> Maybe (NodeInfo k v v))
-> DMap k (NodeInfo k v)
-> DMap k (Fixup k v)
-> DMap k (NodeInfo k v)
forall {k1} (k2 :: k1 -> *) (f :: k1 -> *) (g :: k1 -> *).
GCompare k2 =>
(forall (v :: k1). k2 v -> f v -> g v -> Maybe (f v))
-> DMap k2 f -> DMap k2 g -> DMap k2 f
DMap.differenceWithKey k v -> NodeInfo k v v -> Fixup k v v -> Maybe (NodeInfo k v v)
forall (v :: k).
k v -> NodeInfo k v v -> Fixup k v v -> Maybe (NodeInfo k v v)
forall {k} {p} {k :: k -> *} {v :: k -> *} {a :: k}.
p -> NodeInfo k v a -> Fixup k v a -> Maybe (NodeInfo k v a)
applyFixup ((forall (v :: k).
k v -> NodeInfo k v v -> NodeInfo k v v -> NodeInfo k v v)
-> DMap k (NodeInfo k v)
-> DMap k (NodeInfo k v)
-> DMap k (NodeInfo k v)
forall {k1} (k2 :: k1 -> *) (f :: k1 -> *).
GCompare k2 =>
(forall (v :: k1). k2 v -> f v -> f v -> f v)
-> DMap k2 f -> DMap k2 f -> DMap k2 f
DMap.unionWithKey k v -> NodeInfo k v v -> NodeInfo k v v -> NodeInfo k v v
forall (v :: k).
k v -> NodeInfo k v v -> NodeInfo k v v -> NodeInfo k v v
forall {k} {p} {k :: k -> *} {v :: k -> *} {a :: k} {v :: k -> *}.
p -> NodeInfo k v a -> NodeInfo k v a -> NodeInfo k v a
combineNodeInfos DMap k (NodeInfo k v)
ma DMap k (NodeInfo k v)
mb) DMap k (Fixup k v)
fixups
getHere :: These a b -> Maybe a
getHere :: forall a b. These a b -> Maybe a
getHere = \case
This a
a -> a -> Maybe a
forall a. a -> Maybe a
Just a
a
These a
a b
_ -> a -> Maybe a
forall a. a -> Maybe a
Just a
a
That b
_ -> Maybe a
forall a. Maybe a
Nothing
getThere :: These a b -> Maybe b
getThere :: forall a b. These a b -> Maybe b
getThere = \case
This a
_ -> Maybe b
forall a. Maybe a
Nothing
These a
_ b
b -> b -> Maybe b
forall a. a -> Maybe a
Just b
b
That b
b -> b -> Maybe b
forall a. a -> Maybe a
Just b
b
instance GCompare k => Monoid (PatchDMapWithMove k v) where
mempty :: PatchDMapWithMove k v
mempty = DMap k (NodeInfo k v) -> PatchDMapWithMove k v
forall {k} (k :: k -> *) (v :: k -> *).
DMap k (NodeInfo k v) -> PatchDMapWithMove k v
PatchDMapWithMove DMap k (NodeInfo k v)
forall a. Monoid a => a
mempty
mappend :: PatchDMapWithMove k v
-> PatchDMapWithMove k v -> PatchDMapWithMove k v
mappend = PatchDMapWithMove k v
-> PatchDMapWithMove k v -> PatchDMapWithMove k v
forall a. Semigroup a => a -> a -> a
(<>)
insertDMapKey :: k a -> v a -> PatchDMapWithMove k v
insertDMapKey :: forall {k} (k :: k -> *) (a :: k) (v :: k -> *).
k a -> v a -> PatchDMapWithMove k v
insertDMapKey k a
k v a
v =
DMap k (NodeInfo k v) -> PatchDMapWithMove k v
forall {k} (k :: k -> *) (v :: k -> *).
DMap k (NodeInfo k v) -> PatchDMapWithMove k v
PatchDMapWithMove (DMap k (NodeInfo k v) -> PatchDMapWithMove k v)
-> (NodeInfo k v a -> DMap k (NodeInfo k v))
-> NodeInfo k v a
-> PatchDMapWithMove k v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k a -> NodeInfo k v a -> DMap k (NodeInfo k v)
forall {k1} (k2 :: k1 -> *) (v :: k1) (f :: k1 -> *).
k2 v -> f v -> DMap k2 f
DMap.singleton k a
k (NodeInfo k v a -> PatchDMapWithMove k v)
-> NodeInfo k v a -> PatchDMapWithMove k v
forall a b. (a -> b) -> a -> b
$ From k v a -> To k a -> NodeInfo k v a
forall {k} (k :: k -> *) (v :: k -> *) (a :: k).
From k v a -> To k a -> NodeInfo k v a
NodeInfo (v a -> From k v a
forall {a} (v :: a -> *) (a :: a) (k :: a -> *). v a -> From k v a
From_Insert v a
v) (Maybe (k a) -> To k a
forall {k} (f :: k -> *) (a :: k). Maybe (f a) -> ComposeMaybe f a
ComposeMaybe Maybe (k a)
forall a. Maybe a
Nothing)
moveDMapKey :: GCompare k => k a -> k a -> PatchDMapWithMove k v
moveDMapKey :: forall {k} (k :: k -> *) (a :: k) (v :: k -> *).
GCompare k =>
k a -> k a -> PatchDMapWithMove k v
moveDMapKey k a
src k a
dst = case k a
src k a -> k a -> Maybe (a :~: a)
forall (a :: k) (b :: k). k a -> k b -> Maybe (a :~: b)
forall k (f :: k -> *) (a :: k) (b :: k).
GEq f =>
f a -> f b -> Maybe (a :~: b)
`geq` k a
dst of
Maybe (a :~: a)
Nothing -> DMap k (NodeInfo k v) -> PatchDMapWithMove k v
forall {k} (k :: k -> *) (v :: k -> *).
DMap k (NodeInfo k v) -> PatchDMapWithMove k v
PatchDMapWithMove (DMap k (NodeInfo k v) -> PatchDMapWithMove k v)
-> DMap k (NodeInfo k v) -> PatchDMapWithMove k v
forall a b. (a -> b) -> a -> b
$ [DSum k (NodeInfo k v)] -> DMap k (NodeInfo k v)
forall {k1} (k2 :: k1 -> *) (f :: k1 -> *).
GCompare k2 =>
[DSum k2 f] -> DMap k2 f
DMap.fromList
[ k a
dst k a -> NodeInfo k v a -> DSum k (NodeInfo k v)
forall {k} (tag :: k -> *) (f :: k -> *) (a :: k).
tag a -> f a -> DSum tag f
:=> From k v a -> To k a -> NodeInfo k v a
forall {k} (k :: k -> *) (v :: k -> *) (a :: k).
From k v a -> To k a -> NodeInfo k v a
NodeInfo (k a -> From k v a
forall {a} (k :: a -> *) (a :: a) (v :: a -> *). k a -> From k v a
From_Move k a
src) (Maybe (k a) -> To k a
forall {k} (f :: k -> *) (a :: k). Maybe (f a) -> ComposeMaybe f a
ComposeMaybe Maybe (k a)
forall a. Maybe a
Nothing)
, k a
src k a -> NodeInfo k v a -> DSum k (NodeInfo k v)
forall {k} (tag :: k -> *) (f :: k -> *) (a :: k).
tag a -> f a -> DSum tag f
:=> From k v a -> To k a -> NodeInfo k v a
forall {k} (k :: k -> *) (v :: k -> *) (a :: k).
From k v a -> To k a -> NodeInfo k v a
NodeInfo From k v a
forall {a} (k :: a -> *) (v :: a -> *) (a :: a). From k v a
From_Delete (Maybe (k a) -> To k a
forall {k} (f :: k -> *) (a :: k). Maybe (f a) -> ComposeMaybe f a
ComposeMaybe (Maybe (k a) -> To k a) -> Maybe (k a) -> To k a
forall a b. (a -> b) -> a -> b
$ k a -> Maybe (k a)
forall a. a -> Maybe a
Just k a
dst)
]
Just a :~: a
_ -> PatchDMapWithMove k v
forall a. Monoid a => a
mempty
swapDMapKey :: GCompare k => k a -> k a -> PatchDMapWithMove k v
swapDMapKey :: forall {k} (k :: k -> *) (a :: k) (v :: k -> *).
GCompare k =>
k a -> k a -> PatchDMapWithMove k v
swapDMapKey k a
src k a
dst = case k a
src k a -> k a -> Maybe (a :~: a)
forall (a :: k) (b :: k). k a -> k b -> Maybe (a :~: b)
forall k (f :: k -> *) (a :: k) (b :: k).
GEq f =>
f a -> f b -> Maybe (a :~: b)
`geq` k a
dst of
Maybe (a :~: a)
Nothing -> DMap k (NodeInfo k v) -> PatchDMapWithMove k v
forall {k} (k :: k -> *) (v :: k -> *).
DMap k (NodeInfo k v) -> PatchDMapWithMove k v
PatchDMapWithMove (DMap k (NodeInfo k v) -> PatchDMapWithMove k v)
-> DMap k (NodeInfo k v) -> PatchDMapWithMove k v
forall a b. (a -> b) -> a -> b
$ [DSum k (NodeInfo k v)] -> DMap k (NodeInfo k v)
forall {k1} (k2 :: k1 -> *) (f :: k1 -> *).
GCompare k2 =>
[DSum k2 f] -> DMap k2 f
DMap.fromList
[ k a
dst k a -> NodeInfo k v a -> DSum k (NodeInfo k v)
forall {k} (tag :: k -> *) (f :: k -> *) (a :: k).
tag a -> f a -> DSum tag f
:=> From k v a -> To k a -> NodeInfo k v a
forall {k} (k :: k -> *) (v :: k -> *) (a :: k).
From k v a -> To k a -> NodeInfo k v a
NodeInfo (k a -> From k v a
forall {a} (k :: a -> *) (a :: a) (v :: a -> *). k a -> From k v a
From_Move k a
src) (Maybe (k a) -> To k a
forall {k} (f :: k -> *) (a :: k). Maybe (f a) -> ComposeMaybe f a
ComposeMaybe (Maybe (k a) -> To k a) -> Maybe (k a) -> To k a
forall a b. (a -> b) -> a -> b
$ k a -> Maybe (k a)
forall a. a -> Maybe a
Just k a
src)
, k a
src k a -> NodeInfo k v a -> DSum k (NodeInfo k v)
forall {k} (tag :: k -> *) (f :: k -> *) (a :: k).
tag a -> f a -> DSum tag f
:=> From k v a -> To k a -> NodeInfo k v a
forall {k} (k :: k -> *) (v :: k -> *) (a :: k).
From k v a -> To k a -> NodeInfo k v a
NodeInfo (k a -> From k v a
forall {a} (k :: a -> *) (a :: a) (v :: a -> *). k a -> From k v a
From_Move k a
dst) (Maybe (k a) -> To k a
forall {k} (f :: k -> *) (a :: k). Maybe (f a) -> ComposeMaybe f a
ComposeMaybe (Maybe (k a) -> To k a) -> Maybe (k a) -> To k a
forall a b. (a -> b) -> a -> b
$ k a -> Maybe (k a)
forall a. a -> Maybe a
Just k a
dst)
]
Just a :~: a
_ -> PatchDMapWithMove k v
forall a. Monoid a => a
mempty
deleteDMapKey :: k a -> PatchDMapWithMove k v
deleteDMapKey :: forall {k} (k :: k -> *) (a :: k) (v :: k -> *).
k a -> PatchDMapWithMove k v
deleteDMapKey k a
k = DMap k (NodeInfo k v) -> PatchDMapWithMove k v
forall {k} (k :: k -> *) (v :: k -> *).
DMap k (NodeInfo k v) -> PatchDMapWithMove k v
PatchDMapWithMove (DMap k (NodeInfo k v) -> PatchDMapWithMove k v)
-> DMap k (NodeInfo k v) -> PatchDMapWithMove k v
forall a b. (a -> b) -> a -> b
$ k a -> NodeInfo k v a -> DMap k (NodeInfo k v)
forall {k1} (k2 :: k1 -> *) (v :: k1) (f :: k1 -> *).
k2 v -> f v -> DMap k2 f
DMap.singleton k a
k (NodeInfo k v a -> DMap k (NodeInfo k v))
-> NodeInfo k v a -> DMap k (NodeInfo k v)
forall a b. (a -> b) -> a -> b
$ From k v a -> To k a -> NodeInfo k v a
forall {k} (k :: k -> *) (v :: k -> *) (a :: k).
From k v a -> To k a -> NodeInfo k v a
NodeInfo From k v a
forall {a} (k :: a -> *) (v :: a -> *) (a :: a). From k v a
From_Delete (To k a -> NodeInfo k v a) -> To k a -> NodeInfo k v a
forall a b. (a -> b) -> a -> b
$ Maybe (k a) -> To k a
forall {k} (f :: k -> *) (a :: k). Maybe (f a) -> ComposeMaybe f a
ComposeMaybe Maybe (k a)
forall a. Maybe a
Nothing
unPatchDMapWithMove :: PatchDMapWithMove k v -> DMap k (NodeInfo k v)
unPatchDMapWithMove :: forall {k} (k :: k -> *) (v :: k -> *).
PatchDMapWithMove k v -> DMap k (NodeInfo k v)
unPatchDMapWithMove (PatchDMapWithMove DMap k (NodeInfo k v)
p) = DMap k (NodeInfo k v)
p
unsafePatchDMapWithMove :: DMap k (NodeInfo k v) -> PatchDMapWithMove k v
unsafePatchDMapWithMove :: forall {k} (k :: k -> *) (v :: k -> *).
DMap k (NodeInfo k v) -> PatchDMapWithMove k v
unsafePatchDMapWithMove = DMap k (NodeInfo k v) -> PatchDMapWithMove k v
forall {k} (k :: k -> *) (v :: k -> *).
DMap k (NodeInfo k v) -> PatchDMapWithMove k v
PatchDMapWithMove
patchDMapWithMove :: (GCompare k, GShow k) => DMap k (NodeInfo k v) -> Either [String] (PatchDMapWithMove k v)
patchDMapWithMove :: forall {k} (k :: k -> *) (v :: k -> *).
(GCompare k, GShow k) =>
DMap k (NodeInfo k v) -> Either [String] (PatchDMapWithMove k v)
patchDMapWithMove DMap k (NodeInfo k v)
dm =
case DMap k (NodeInfo k v) -> [String]
forall {k} (k :: k -> *) (v :: k -> *).
(GCompare k, GShow k) =>
DMap k (NodeInfo k v) -> [String]
validationErrorsForPatchDMapWithMove DMap k (NodeInfo k v)
dm of
[] -> PatchDMapWithMove k v -> Either [String] (PatchDMapWithMove k v)
forall a b. b -> Either a b
Right (PatchDMapWithMove k v -> Either [String] (PatchDMapWithMove k v))
-> PatchDMapWithMove k v -> Either [String] (PatchDMapWithMove k v)
forall a b. (a -> b) -> a -> b
$ DMap k (NodeInfo k v) -> PatchDMapWithMove k v
forall {k} (k :: k -> *) (v :: k -> *).
DMap k (NodeInfo k v) -> PatchDMapWithMove k v
unsafePatchDMapWithMove DMap k (NodeInfo k v)
dm
[String]
errs -> [String] -> Either [String] (PatchDMapWithMove k v)
forall a b. a -> Either a b
Left [String]
errs
mapPatchDMapWithMove :: forall k v v'. (forall a. v a -> v' a) -> PatchDMapWithMove k v -> PatchDMapWithMove k v'
mapPatchDMapWithMove :: forall {k} (k :: k -> *) (v :: k -> *) (v' :: k -> *).
(forall (a :: k). v a -> v' a)
-> PatchDMapWithMove k v -> PatchDMapWithMove k v'
mapPatchDMapWithMove forall (a :: k). v a -> v' a
f (PatchDMapWithMove DMap k (NodeInfo k v)
p) = DMap k (NodeInfo k v') -> PatchDMapWithMove k v'
forall {k} (k :: k -> *) (v :: k -> *).
DMap k (NodeInfo k v) -> PatchDMapWithMove k v
PatchDMapWithMove (DMap k (NodeInfo k v') -> PatchDMapWithMove k v')
-> DMap k (NodeInfo k v') -> PatchDMapWithMove k v'
forall a b. (a -> b) -> a -> b
$
(forall (v :: k). NodeInfo k v v -> NodeInfo k v' v)
-> DMap k (NodeInfo k v) -> DMap k (NodeInfo k v')
forall {k1} (f :: k1 -> *) (g :: k1 -> *) (k2 :: k1 -> *).
(forall (v :: k1). f v -> g v) -> DMap k2 f -> DMap k2 g
DMap.map (\NodeInfo k v v
ni -> NodeInfo k v v
ni { _nodeInfo_from = g $ _nodeInfo_from ni }) DMap k (NodeInfo k v)
p
where g :: forall a. From k v a -> From k v' a
g :: forall (a :: k). From k v a -> From k v' a
g = \case
From_Insert v a
v -> v' a -> From k v' a
forall {a} (v :: a -> *) (a :: a) (k :: a -> *). v a -> From k v a
From_Insert (v' a -> From k v' a) -> v' a -> From k v' a
forall a b. (a -> b) -> a -> b
$ v a -> v' a
forall (a :: k). v a -> v' a
f v a
v
From k v a
From_Delete -> From k v' a
forall {a} (k :: a -> *) (v :: a -> *) (a :: a). From k v a
From_Delete
From_Move k a
k -> k a -> From k v' a
forall {a} (k :: a -> *) (a :: a) (v :: a -> *). k a -> From k v a
From_Move k a
k
traversePatchDMapWithMove :: forall m k v v'. Applicative m => (forall a. v a -> m (v' a)) -> PatchDMapWithMove k v -> m (PatchDMapWithMove k v')
traversePatchDMapWithMove :: forall {k} (m :: * -> *) (k :: k -> *) (v :: k -> *)
(v' :: k -> *).
Applicative m =>
(forall (a :: k). v a -> m (v' a))
-> PatchDMapWithMove k v -> m (PatchDMapWithMove k v')
traversePatchDMapWithMove forall (a :: k). v a -> m (v' a)
f = (forall (a :: k). k a -> v a -> m (v' a))
-> PatchDMapWithMove k v -> m (PatchDMapWithMove k v')
forall {k} (m :: * -> *) (k :: k -> *) (v :: k -> *)
(v' :: k -> *).
Applicative m =>
(forall (a :: k). k a -> v a -> m (v' a))
-> PatchDMapWithMove k v -> m (PatchDMapWithMove k v')
traversePatchDMapWithMoveWithKey ((forall (a :: k). k a -> v a -> m (v' a))
-> PatchDMapWithMove k v -> m (PatchDMapWithMove k v'))
-> (forall (a :: k). k a -> v a -> m (v' a))
-> PatchDMapWithMove k v
-> m (PatchDMapWithMove k v')
forall a b. (a -> b) -> a -> b
$ (v a -> m (v' a)) -> k a -> v a -> m (v' a)
forall a b. a -> b -> a
const v a -> m (v' a)
forall (a :: k). v a -> m (v' a)
f
traversePatchDMapWithMoveWithKey :: forall m k v v'. Applicative m => (forall a. k a -> v a -> m (v' a)) -> PatchDMapWithMove k v -> m (PatchDMapWithMove k v')
traversePatchDMapWithMoveWithKey :: forall {k} (m :: * -> *) (k :: k -> *) (v :: k -> *)
(v' :: k -> *).
Applicative m =>
(forall (a :: k). k a -> v a -> m (v' a))
-> PatchDMapWithMove k v -> m (PatchDMapWithMove k v')
traversePatchDMapWithMoveWithKey forall (a :: k). k a -> v a -> m (v' a)
f (PatchDMapWithMove DMap k (NodeInfo k v)
p) = DMap k (NodeInfo k v') -> PatchDMapWithMove k v'
forall {k} (k :: k -> *) (v :: k -> *).
DMap k (NodeInfo k v) -> PatchDMapWithMove k v
PatchDMapWithMove (DMap k (NodeInfo k v') -> PatchDMapWithMove k v')
-> m (DMap k (NodeInfo k v')) -> m (PatchDMapWithMove k v')
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (v :: k). k v -> NodeInfo k v v -> m (NodeInfo k v' v))
-> DMap k (NodeInfo k v) -> m (DMap k (NodeInfo k 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 ((From k v v -> m (From k v' v))
-> NodeInfo k v v -> m (NodeInfo k v' v)
forall {k} (f :: * -> *) (k :: k -> *) (v :: k -> *) (a :: k)
(v' :: k -> *).
Functor f =>
(From k v a -> f (From k v' a))
-> NodeInfo k v a -> f (NodeInfo k v' a)
nodeInfoMapFromM ((From k v v -> m (From k v' v))
-> NodeInfo k v v -> m (NodeInfo k v' v))
-> (k v -> From k v v -> m (From k v' v))
-> k v
-> NodeInfo k v v
-> m (NodeInfo k v' v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k v -> From k v v -> m (From k v' v)
forall (a :: k). k a -> From k v a -> m (From k v' a)
g) DMap k (NodeInfo k v)
p
where g :: forall a. k a -> From k v a -> m (From k v' a)
g :: forall (a :: k). k a -> From k v a -> m (From k v' a)
g k a
k = \case
From_Insert v a
v -> v' a -> From k v' a
forall {a} (v :: a -> *) (a :: a) (k :: a -> *). v a -> From k v a
From_Insert (v' a -> From k v' a) -> m (v' a) -> m (From k v' a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> k a -> v a -> m (v' a)
forall (a :: k). k a -> v a -> m (v' a)
f k a
k v a
v
From k v a
From_Delete -> From k v' a -> m (From k v' a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure From k v' a
forall {a} (k :: a -> *) (v :: a -> *) (a :: a). From k v a
From_Delete
From_Move k a
fromKey -> From k v' a -> m (From k v' a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (From k v' a -> m (From k v' a)) -> From k v' a -> m (From k v' a)
forall a b. (a -> b) -> a -> b
$ k a -> From k v' a
forall {a} (k :: a -> *) (a :: a) (v :: a -> *). k a -> From k v a
From_Move k a
fromKey
nodeInfoMapFrom :: (From k v a -> From k v' a) -> NodeInfo k v a -> NodeInfo k v' a
nodeInfoMapFrom :: forall {k} (k :: k -> *) (v :: k -> *) (a :: k) (v' :: k -> *).
(From k v a -> From k v' a) -> NodeInfo k v a -> NodeInfo k v' a
nodeInfoMapFrom From k v a -> From k v' a
f NodeInfo k v a
ni = NodeInfo k v a
ni { _nodeInfo_from = f $ _nodeInfo_from ni }
nodeInfoMapFromM :: Functor f => (From k v a -> f (From k v' a)) -> NodeInfo k v a -> f (NodeInfo k v' a)
nodeInfoMapFromM :: forall {k} (f :: * -> *) (k :: k -> *) (v :: k -> *) (a :: k)
(v' :: k -> *).
Functor f =>
(From k v a -> f (From k v' a))
-> NodeInfo k v a -> f (NodeInfo k v' a)
nodeInfoMapFromM From k v a -> f (From k v' a)
f NodeInfo k v a
ni = (From k v' a -> NodeInfo k v' a)
-> f (From k v' a) -> f (NodeInfo k v' a)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\From k v' a
result -> NodeInfo k v a
ni { _nodeInfo_from = result }) (f (From k v' a) -> f (NodeInfo k v' a))
-> f (From k v' a) -> f (NodeInfo k v' a)
forall a b. (a -> b) -> a -> b
$ From k v a -> f (From k v' a)
f (From k v a -> f (From k v' a)) -> From k v a -> f (From k v' a)
forall a b. (a -> b) -> a -> b
$ NodeInfo k v a -> From k v a
forall {k} (k :: k -> *) (v :: k -> *) (a :: k).
NodeInfo k v a -> From k v a
_nodeInfo_from NodeInfo k v a
ni
weakenPatchDMapWithMoveWith :: forall k v v'. (forall a. v a -> v') -> PatchDMapWithMove k v -> PatchMapWithMove (Some k) v'
weakenPatchDMapWithMoveWith :: forall {k} (k :: k -> *) (v :: k -> *) v'.
(forall (a :: k). v a -> v')
-> PatchDMapWithMove k v -> PatchMapWithMove (Some k) v'
weakenPatchDMapWithMoveWith forall (a :: k). v a -> v'
f (PatchDMapWithMove DMap k (NodeInfo k v)
p) = Map (Some k) (NodeInfo (Some k) v') -> PatchMapWithMove (Some k) v'
forall k v. Map k (NodeInfo k v) -> PatchMapWithMove k v
PatchMapWithMove (Map (Some k) (NodeInfo (Some k) v')
-> PatchMapWithMove (Some k) v')
-> Map (Some k) (NodeInfo (Some k) v')
-> PatchMapWithMove (Some k) v'
forall a b. (a -> b) -> a -> b
$ (forall (a :: k). NodeInfo k v a -> NodeInfo (Some k) v')
-> DMap k (NodeInfo k v) -> Map (Some k) (NodeInfo (Some k) v')
forall {k1} (v :: k1 -> *) v' (k2 :: k1 -> *).
(forall (a :: k1). v a -> v') -> DMap k2 v -> Map (Some k2) v'
weakenDMapWith NodeInfo k v a -> NodeInfo (Some k) v'
forall (a :: k). NodeInfo k v a -> NodeInfo (Some k) v'
g DMap k (NodeInfo k v)
p
where g :: forall a. NodeInfo k v a -> MapWithMove.NodeInfo (Some k) v'
g :: forall (a :: k). NodeInfo k v a -> NodeInfo (Some k) v'
g NodeInfo k v a
ni = MapWithMove.NodeInfo
{ _nodeInfo_from :: From (Some k) v'
MapWithMove._nodeInfo_from = case NodeInfo k v a -> From k v a
forall {k} (k :: k -> *) (v :: k -> *) (a :: k).
NodeInfo k v a -> From k v a
_nodeInfo_from NodeInfo k v a
ni of
From_Insert v a
v -> v' -> From (Some k) v'
forall v k. v -> From k v
MapWithMove.From_Insert (v' -> From (Some k) v') -> v' -> From (Some k) v'
forall a b. (a -> b) -> a -> b
$ v a -> v'
forall (a :: k). v a -> v'
f v a
v
From k v a
From_Delete -> From (Some k) v'
forall k v. From k v
MapWithMove.From_Delete
From_Move k a
k -> Some k -> From (Some k) v'
forall k v. k -> From k v
MapWithMove.From_Move (Some k -> From (Some k) v') -> Some k -> From (Some k) v'
forall a b. (a -> b) -> a -> b
$ k a -> Some k
forall {k} (tag :: k -> *) (a :: k). tag a -> Some tag
mkSome k a
k
, _nodeInfo_to :: To (Some k)
MapWithMove._nodeInfo_to = k a -> Some k
forall {k} (tag :: k -> *) (a :: k). tag a -> Some tag
mkSome (k a -> Some k) -> Maybe (k a) -> To (Some k)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ComposeMaybe k a -> Maybe (k a)
forall {k} (f :: k -> *) (a :: k). ComposeMaybe f a -> Maybe (f a)
getComposeMaybe (NodeInfo k v a -> ComposeMaybe k a
forall {k} (k :: k -> *) (v :: k -> *) (a :: k).
NodeInfo k v a -> To k a
_nodeInfo_to NodeInfo k v a
ni)
}
patchDMapWithMoveToPatchMapWithMoveWith :: forall k v v' a. (v a -> v') -> PatchDMapWithMove (Const2 k a) v -> PatchMapWithMove k v'
patchDMapWithMoveToPatchMapWithMoveWith :: forall {k} k (v :: k -> *) v' (a :: k).
(v a -> v')
-> PatchDMapWithMove (Const2 k a) v -> PatchMapWithMove k v'
patchDMapWithMoveToPatchMapWithMoveWith v a -> v'
f (PatchDMapWithMove DMap (Const2 k a) (NodeInfo (Const2 k a) v)
p) = Map k (NodeInfo k v') -> PatchMapWithMove k v'
forall k v. Map k (NodeInfo k v) -> PatchMapWithMove k v
PatchMapWithMove (Map k (NodeInfo k v') -> PatchMapWithMove k v')
-> Map k (NodeInfo k v') -> PatchMapWithMove k v'
forall a b. (a -> b) -> a -> b
$ (NodeInfo (Const2 k a) v a -> NodeInfo k v')
-> DMap (Const2 k a) (NodeInfo (Const2 k a) v)
-> Map k (NodeInfo k v')
forall {k1} (f :: k1 -> *) (v :: k1) v' k2.
(f v -> v') -> DMap (Const2 k2 v) f -> Map k2 v'
dmapToMapWith NodeInfo (Const2 k a) v a -> NodeInfo k v'
g DMap (Const2 k a) (NodeInfo (Const2 k a) v)
p
where g :: NodeInfo (Const2 k a) v a -> MapWithMove.NodeInfo k v'
g :: NodeInfo (Const2 k a) v a -> NodeInfo k v'
g NodeInfo (Const2 k a) v a
ni = MapWithMove.NodeInfo
{ _nodeInfo_from :: From k v'
MapWithMove._nodeInfo_from = case NodeInfo (Const2 k a) v a -> From (Const2 k a) v a
forall {k} (k :: k -> *) (v :: k -> *) (a :: k).
NodeInfo k v a -> From k v a
_nodeInfo_from NodeInfo (Const2 k a) v a
ni of
From_Insert v a
v -> v' -> From k v'
forall v k. v -> From k v
MapWithMove.From_Insert (v' -> From k v') -> v' -> From k v'
forall a b. (a -> b) -> a -> b
$ v a -> v'
f v a
v
From (Const2 k a) v a
From_Delete -> From k v'
forall k v. From k v
MapWithMove.From_Delete
From_Move (Const2 k
k) -> k -> From k v'
forall k v. k -> From k v
MapWithMove.From_Move k
k
, _nodeInfo_to :: To k
MapWithMove._nodeInfo_to = Const2 k a a -> k
forall {x} k (v :: x) (v' :: x). Const2 k v v' -> k
unConst2 (Const2 k a a -> k) -> Maybe (Const2 k a a) -> To k
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ComposeMaybe (Const2 k a) a -> Maybe (Const2 k a a)
forall {k} (f :: k -> *) (a :: k). ComposeMaybe f a -> Maybe (f a)
getComposeMaybe (NodeInfo (Const2 k a) v a -> ComposeMaybe (Const2 k a) a
forall {k} (k :: k -> *) (v :: k -> *) (a :: k).
NodeInfo k v a -> To k a
_nodeInfo_to NodeInfo (Const2 k a) v a
ni)
}
const2PatchDMapWithMoveWith :: forall k v v' a. (v -> v' a) -> PatchMapWithMove k v -> PatchDMapWithMove (Const2 k a) v'
const2PatchDMapWithMoveWith :: forall {k} k v (v' :: k -> *) (a :: k).
(v -> v' a)
-> PatchMapWithMove k v -> PatchDMapWithMove (Const2 k a) v'
const2PatchDMapWithMoveWith v -> v' a
f (PatchMapWithMove Map k (NodeInfo k v)
p) = DMap (Const2 k a) (NodeInfo (Const2 k a) v')
-> PatchDMapWithMove (Const2 k a) v'
forall {k} (k :: k -> *) (v :: k -> *).
DMap k (NodeInfo k v) -> PatchDMapWithMove k v
PatchDMapWithMove (DMap (Const2 k a) (NodeInfo (Const2 k a) v')
-> PatchDMapWithMove (Const2 k a) v')
-> DMap (Const2 k a) (NodeInfo (Const2 k a) v')
-> PatchDMapWithMove (Const2 k a) v'
forall a b. (a -> b) -> a -> b
$ [DSum (Const2 k a) (NodeInfo (Const2 k a) v')]
-> DMap (Const2 k a) (NodeInfo (Const2 k a) v')
forall {k1} (k2 :: k1 -> *) (f :: k1 -> *).
[DSum k2 f] -> DMap k2 f
DMap.fromDistinctAscList ([DSum (Const2 k a) (NodeInfo (Const2 k a) v')]
-> DMap (Const2 k a) (NodeInfo (Const2 k a) v'))
-> [DSum (Const2 k a) (NodeInfo (Const2 k a) v')]
-> DMap (Const2 k a) (NodeInfo (Const2 k a) v')
forall a b. (a -> b) -> a -> b
$ (k, NodeInfo k v) -> DSum (Const2 k a) (NodeInfo (Const2 k a) v')
g ((k, NodeInfo k v) -> DSum (Const2 k a) (NodeInfo (Const2 k a) v'))
-> [(k, NodeInfo k v)]
-> [DSum (Const2 k a) (NodeInfo (Const2 k a) v')]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map k (NodeInfo k v) -> [(k, NodeInfo k v)]
forall k a. Map k a -> [(k, a)]
Map.toAscList Map k (NodeInfo k v)
p
where g :: (k, MapWithMove.NodeInfo k v) -> DSum (Const2 k a) (NodeInfo (Const2 k a) v')
g :: (k, NodeInfo k v) -> DSum (Const2 k a) (NodeInfo (Const2 k a) v')
g (k
k, NodeInfo k v
ni) = k -> Const2 k a a
forall {x} a (b :: x). a -> Const2 a b b
Const2 k
k Const2 k a a
-> NodeInfo (Const2 k a) v' a
-> DSum (Const2 k a) (NodeInfo (Const2 k a) v')
forall {k} (tag :: k -> *) (f :: k -> *) (a :: k).
tag a -> f a -> DSum tag f
:=> NodeInfo
{ _nodeInfo_from :: From (Const2 k a) v' a
_nodeInfo_from = case NodeInfo k v -> From k v
forall k v. NodeInfo k v -> From k v
MapWithMove._nodeInfo_from NodeInfo k v
ni of
MapWithMove.From_Insert v
v -> v' a -> From (Const2 k a) v' a
forall {a} (v :: a -> *) (a :: a) (k :: a -> *). v a -> From k v a
From_Insert (v' a -> From (Const2 k a) v' a) -> v' a -> From (Const2 k a) v' a
forall a b. (a -> b) -> a -> b
$ v -> v' a
f v
v
From k v
MapWithMove.From_Delete -> From (Const2 k a) v' a
forall {a} (k :: a -> *) (v :: a -> *) (a :: a). From k v a
From_Delete
MapWithMove.From_Move k
fromKey -> Const2 k a a -> From (Const2 k a) v' a
forall {a} (k :: a -> *) (a :: a) (v :: a -> *). k a -> From k v a
From_Move (Const2 k a a -> From (Const2 k a) v' a)
-> Const2 k a a -> From (Const2 k a) v' a
forall a b. (a -> b) -> a -> b
$ k -> Const2 k a a
forall {x} a (b :: x). a -> Const2 a b b
Const2 k
fromKey
, _nodeInfo_to :: To (Const2 k a) a
_nodeInfo_to = Maybe (Const2 k a a) -> To (Const2 k a) a
forall {k} (f :: k -> *) (a :: k). Maybe (f a) -> ComposeMaybe f a
ComposeMaybe (Maybe (Const2 k a a) -> To (Const2 k a) a)
-> Maybe (Const2 k a a) -> To (Const2 k a) a
forall a b. (a -> b) -> a -> b
$ k -> Const2 k a a
forall {x} a (b :: x). a -> Const2 a b b
Const2 (k -> Const2 k a a) -> Maybe k -> Maybe (Const2 k a a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NodeInfo k v -> Maybe k
forall k v. NodeInfo k v -> To k
MapWithMove._nodeInfo_to NodeInfo k v
ni
}
instance GCompare k => Patch (PatchDMapWithMove k v) where
type PatchTarget (PatchDMapWithMove k v) = DMap k v
apply :: PatchDMapWithMove k v
-> PatchTarget (PatchDMapWithMove k v)
-> Maybe (PatchTarget (PatchDMapWithMove k v))
apply (PatchDMapWithMove DMap k (NodeInfo k v)
p) PatchTarget (PatchDMapWithMove 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 (PatchDMapWithMove 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 -> NodeInfo k v v -> Maybe (v v))
-> DMap k (NodeInfo k 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 k v -> NodeInfo k v v -> Maybe (v v)
forall (v :: k). k v -> NodeInfo k v v -> Maybe (v v)
insertFunc DMap k (NodeInfo k v)
p
insertFunc :: forall a. k a -> NodeInfo k v a -> Maybe (v a)
insertFunc :: forall (v :: k). k v -> NodeInfo k v v -> Maybe (v v)
insertFunc k a
_ NodeInfo k v a
ni = case NodeInfo k v a -> From k v a
forall {k} (k :: k -> *) (v :: k -> *) (a :: k).
NodeInfo k v a -> From k v a
_nodeInfo_from NodeInfo k v a
ni of
From_Insert v a
v -> v a -> Maybe (v a)
forall a. a -> Maybe a
Just v a
v
From_Move k a
k -> k a -> DMap k v -> Maybe (v a)
forall {k1} (k2 :: k1 -> *) (f :: k1 -> *) (v :: k1).
GCompare k2 =>
k2 v -> DMap k2 f -> Maybe (f v)
DMap.lookup k a
k DMap k v
PatchTarget (PatchDMapWithMove k v)
old
From k v a
From_Delete -> Maybe (v a)
forall a. Maybe a
Nothing
deletions :: DMap k (Constant ())
deletions = (forall (v :: k). k v -> NodeInfo k v v -> Maybe (Constant () v))
-> DMap k (NodeInfo k 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 k v -> NodeInfo k v v -> Maybe (Constant () v)
forall (v :: k). k v -> NodeInfo k v v -> Maybe (Constant () v)
deleteFunc DMap k (NodeInfo k v)
p
deleteFunc :: forall a. k a -> NodeInfo k v a -> Maybe (Constant () a)
deleteFunc :: forall (v :: k). k v -> NodeInfo k v v -> Maybe (Constant () v)
deleteFunc k a
_ NodeInfo k v a
ni = case NodeInfo k v a -> From k v a
forall {k} (k :: k -> *) (v :: k -> *) (a :: k).
NodeInfo k v a -> From k v a
_nodeInfo_from NodeInfo k v a
ni of
From k v a
From_Delete -> Constant () a -> Maybe (Constant () a)
forall a. a -> Maybe a
Just (Constant () a -> Maybe (Constant () a))
-> Constant () a -> Maybe (Constant () a)
forall a b. (a -> b) -> a -> b
$ () -> Constant () a
forall {k} a (b :: k). a -> Constant a b
Constant ()
From k v a
_ -> Maybe (Constant () a)
forall a. Maybe a
Nothing
getDeletionsAndMoves :: GCompare k => PatchDMapWithMove k v -> DMap k v' -> DMap k (Product v' (ComposeMaybe k))
getDeletionsAndMoves :: forall {k} (k :: k -> *) (v :: k -> *) (v' :: k -> *).
GCompare k =>
PatchDMapWithMove k v
-> DMap k v' -> DMap k (Product v' (ComposeMaybe k))
getDeletionsAndMoves (PatchDMapWithMove DMap k (NodeInfo k v)
p) DMap k v'
m = (forall (v :: k).
k v -> v' v -> NodeInfo k v v -> Product v' (ComposeMaybe k) v)
-> DMap k v'
-> DMap k (NodeInfo k v)
-> DMap k (Product v' (ComposeMaybe k))
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 -> NodeInfo k v v -> Product v' (ComposeMaybe k) v
forall (v :: k).
k v -> v' v -> NodeInfo k v v -> Product v' (ComposeMaybe k) v
forall {k} {p} {f :: k -> *} {a :: k} {k :: k -> *} {v :: k -> *}.
p -> f a -> NodeInfo k v a -> Product f (ComposeMaybe k) a
f DMap k v'
m DMap k (NodeInfo k v)
p
where f :: p -> f a -> NodeInfo k v a -> Product f (ComposeMaybe k) a
f p
_ f a
v NodeInfo k v a
ni = f a -> ComposeMaybe k a -> Product f (ComposeMaybe k) a
forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Pair f a
v (ComposeMaybe k a -> Product f (ComposeMaybe k) a)
-> ComposeMaybe k a -> Product f (ComposeMaybe k) a
forall a b. (a -> b) -> a -> b
$ NodeInfo k v a -> ComposeMaybe k a
forall {k} (k :: k -> *) (v :: k -> *) (a :: k).
NodeInfo k v a -> To k a
_nodeInfo_to NodeInfo k v a
ni