diff --git a/ChangeLog.md b/ChangeLog.md
index fb061bb4..925e9ab4 100644
--- a/ChangeLog.md
+++ b/ChangeLog.md
@@ -1,5 +1,11 @@
 # Revision history for patch
 
+## Unreleased
+
+* `PatchMapWithMove` supports moves with a patch.
+
+* `PatchDMapWithMove` supports moves with a patch.
+
 ## 0.0.7.0 - 2022-06-23
 
 * Use `commutative-semigroups` for `Commutative`, making `Additive` a
diff --git a/patch.cabal b/patch.cabal
index 32bef287..08993fcd 100644
--- a/patch.cabal
+++ b/patch.cabal
@@ -48,12 +48,15 @@ library
   if impl(ghc < 8.6) -- really, if base < 8.12
     build-depends: base-orphans >= 0.8 && < 0.9
 
-  exposed-modules: Data.Functor.Misc
+  exposed-modules: Control.Category.DecidablyEmpty
+                 , Data.Functor.Misc
                  , Data.Monoid.DecidablyEmpty
                  , Data.Patch
                  , Data.Patch.Class
                  , Data.Patch.DMap
                  , Data.Patch.DMapWithMove
+                 , Data.Patch.DMapWithPatchingMove
+                 , Data.Patch.DMapWithPatchingMove.By
                  , Data.Patch.IntMap
                  , Data.Patch.Map
                  , Data.Patch.MapWithMove
@@ -66,6 +69,7 @@ library
 
   if flag(split-these)
     build-depends: these >= 1 && <1.2
+                 , these-lens >= 1 && <1.1
                  , semialign >=1 && <1.3
                  , monoidal-containers >= 0.6 && < 0.7
   else
diff --git a/src/Control/Category/DecidablyEmpty.hs b/src/Control/Category/DecidablyEmpty.hs
new file mode 100644
index 00000000..ddcd600d
--- /dev/null
+++ b/src/Control/Category/DecidablyEmpty.hs
@@ -0,0 +1,9 @@
+{-# LANGUAGE TypeOperators #-}
+-- TODO upstream somwhere else?
+module Control.Category.DecidablyEmpty where
+
+import Control.Category
+import Data.Type.Equality
+
+class Category c => DecidablyEmpty c where
+  isId :: c a b -> Maybe (a :~: b)
diff --git a/src/Data/Functor/Misc.hs b/src/Data/Functor/Misc.hs
index 89dfcfe7..50ef7403 100644
--- a/src/Data/Functor/Misc.hs
+++ b/src/Data/Functor/Misc.hs
@@ -1,6 +1,6 @@
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE DeriveTraversable #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
@@ -21,6 +21,7 @@ are relevant to the use of 'Functor'-based datastructures like
 module Data.Functor.Misc
   ( -- * Const2
     Const2 (..)
+  , First2 (..)
   , unConst2
   , dmapToMap
   , dmapToIntMap
@@ -52,6 +53,7 @@ import qualified Data.IntMap as IntMap
 import Data.Kind (Type)
 import Data.Map (Map)
 import qualified Data.Map as Map
+import qualified Data.Semigroupoid as Cat
 import Data.Some (Some, mkSome)
 import Data.These
 import Data.Type.Equality ((:~:)(Refl))
@@ -68,15 +70,15 @@ data Const2 :: Type -> x -> x -> Type where
   Const2 :: k -> Const2 k v v
   deriving (Typeable)
 
--- | Extract the value from a Const2
-unConst2 :: Const2 k v v' -> k
-unConst2 (Const2 k) = k
-
 deriving instance Eq k => Eq (Const2 k v v')
 deriving instance Ord k => Ord (Const2 k v v')
 deriving instance Show k => Show (Const2 k v v')
 deriving instance Read k => Read (Const2 k v v)
 
+-- | Extract the value from a Const2
+unConst2 :: Const2 k v v' -> k
+unConst2 (Const2 k) = k
+
 instance Show k => GShow (Const2 k v) where
   gshowsPrec n x@(Const2 _) = showsPrec n x
 
@@ -92,6 +94,14 @@ instance Ord k => GCompare (Const2 k v) where
     EQ -> GEQ
     GT -> GGT
 
+newtype First2 (t :: k -> Type) (a :: k) (b :: k) = First2 (t b)
+  deriving ( Show, Read, Eq, Ord
+           , Functor, Foldable, Traversable
+           )
+
+instance Cat.Semigroupoid (First2 x) where
+  First2 x `o` ~(First2 _) = First2 x
+
 -- | Convert a 'DMap' to a regular 'Map'
 dmapToMap :: DMap (Const2 k v) Identity -> Map k v
 dmapToMap = Map.fromDistinctAscList . map (\(Const2 k :=> Identity v) -> (k, v)) . DMap.toAscList
diff --git a/src/Data/Patch.hs b/src/Data/Patch.hs
index 71a187d3..a6e10b1b 100644
--- a/src/Data/Patch.hs
+++ b/src/Data/Patch.hs
@@ -33,6 +33,12 @@ import Data.Patch.DMapWithMove as X
   , traversePatchDMapWithMoveWithKey, unPatchDMapWithMove
   , unsafePatchDMapWithMove, weakenPatchDMapWithMoveWith
   )
+import Data.Patch.DMapWithPatchingMove as X
+  ( PatchDMapWithPatchingMove, const2PatchDMapWithPatchingMoveWith, mapPatchDMapWithPatchingMove
+  , patchDMapWithPatchingMoveToPatchMapWithPatchingMoveWith
+  , traversePatchDMapWithPatchingMoveWithKey, unPatchDMapWithPatchingMove
+  , unsafePatchDMapWithPatchingMove, weakenPatchDMapWithPatchingMoveWith
+  )
 import Data.Patch.IntMap as X hiding (getDeletions)
 import Data.Patch.Map as X
 import Data.Patch.MapWithMove as X
@@ -50,8 +56,10 @@ class (Semigroup q, Monoid q) => Group q where
 -- | The elements of an 'Commutative' 'Semigroup' can be considered as patches of their own type.
 newtype AdditivePatch p = AdditivePatch { unAdditivePatch :: p }
 
-instance Commutative p => Patch (AdditivePatch p) where
+instance Commutative p => PatchHet (AdditivePatch p) where
+  type PatchSource (AdditivePatch p) = p
   type PatchTarget (AdditivePatch p) = p
+instance Commutative p => Patch (AdditivePatch p) where
   apply (AdditivePatch p) q = Just $ p <> q
 
 instance (Ord k, Group q) => Group (MonoidalMap k q) where
@@ -59,8 +67,8 @@ instance (Ord k, Group q) => Group (MonoidalMap k q) where
 
 -- | Trivial group.
 instance Group () where
-  negateG _ = ()
-  _ ~~ _ = ()
+  negateG ~() = ()
+  ~() ~~ ~() = ()
 
 -- | Product group.  A Pair of groups gives rise to a group
 instance (Group a, Group b) => Group (a, b) where
@@ -81,8 +89,8 @@ instance (Group (f a), Group (g a)) => Group ((f :*: g) a) where
 
 -- | Trivial group, Functor style
 instance Group (Proxy x) where
-  negateG _ = Proxy
-  _ ~~ _ = Proxy
+  negateG ~Proxy = Proxy
+  ~Proxy ~~ ~Proxy = Proxy
 
 -- | Const lifts groups into a functor.
 deriving instance Group a => Group (Const a x)
diff --git a/src/Data/Patch/Class.hs b/src/Data/Patch/Class.hs
index 55c512fb..491cf4ee 100644
--- a/src/Data/Patch/Class.hs
+++ b/src/Data/Patch/Class.hs
@@ -1,6 +1,15 @@
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE DefaultSignatures #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE PolyKinds #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE StandaloneDeriving #-}
 
 {-|
 Description: The module provides the 'Patch' class.
@@ -9,20 +18,49 @@ This is a class for types which represent changes made to other types
 -}
 module Data.Patch.Class where
 
+import qualified Data.Semigroupoid as Cat
+import qualified Control.Category as Cat
 import Data.Functor.Identity
+import Data.Functor.Misc
 import Data.Kind (Type)
 import Data.Maybe
 #if !MIN_VERSION_base(4,11,0)
 import Data.Semigroup (Semigroup(..))
 #endif
 import Data.Proxy
+import Data.Typeable
+
+class PatchHet p where
+  type PatchSource p :: Type
+  type PatchTarget p :: Type
+  -- | Apply the patch @p a@ to the value @a@.  If no change is needed, return
+  -- 'Nothing'.
+  applyHet
+    :: p
+    -> PatchSource p
+    -> Either (PatchSource p :~: PatchTarget p) (PatchTarget p)
+  default applyHet
+    :: Patch p
+    => p
+    -> PatchSource p
+    -> Either (PatchSource p :~: PatchTarget p) (PatchTarget p)
+  applyHet p a = case apply p a of
+    Nothing -> Left Refl
+    Just a' -> Right a'
+
+-- | Apply a 'PatchHet'; if it does nothing, return the original value
+applyAlwaysHet :: PatchHet p => p -> PatchSource p -> PatchTarget p
+applyAlwaysHet p t = case applyHet p t of
+  Left Refl -> t
+  Right t' -> t'
 
 -- | A 'Patch' type represents a kind of change made to a datastructure.
 --
 -- If an instance of 'Patch' is also an instance of 'Semigroup', it should obey
 -- the law that @applyAlways (f <> g) == applyAlways f . applyAlways g@.
-class Patch p where
-  type PatchTarget p :: Type
+class ( PatchHet p
+      , PatchSource p ~ PatchTarget p
+      ) => Patch p where
   -- | Apply the patch @p a@ to the value @a@.  If no change is needed, return
   -- 'Nothing'.
   apply :: p -> PatchTarget p -> Maybe (PatchTarget p)
@@ -32,19 +70,123 @@ applyAlways :: Patch p => p -> PatchTarget p -> PatchTarget p
 applyAlways p t = fromMaybe t $ apply p t
 
 -- | 'Identity' can be used as a 'Patch' that always fully replaces the value
-instance Patch (Identity a) where
+instance PatchHet (Identity a) where
+  type PatchSource (Identity a) = a
   type PatchTarget (Identity a) = a
+instance Patch (Identity a) where
   apply (Identity a) _ = Just a
 
 -- | 'Proxy' can be used as a 'Patch' that does nothing.
-instance forall (a :: Type). Patch (Proxy a) where
+instance forall (a :: Type). PatchHet (Proxy a) where
+  type PatchSource (Proxy a) = a
   type PatchTarget (Proxy a) = a
+instance forall (a :: Type). Patch (Proxy a) where
   apply ~Proxy _ = Nothing
 
 -- | Like '(.)', but composes functions that return patches rather than
 -- functions that return new values.  The Semigroup instance for patches must
 -- apply patches right-to-left, like '(.)'.
-composePatchFunctions :: (Patch p, Semigroup p) => (PatchTarget p -> p) -> (PatchTarget p -> p) -> PatchTarget p -> p
+composePatchFunctions
+  :: (Patch p, Semigroup p)
+  => (PatchTarget p -> p)
+  -> (PatchTarget p -> p)
+  -> PatchTarget p -> p
 composePatchFunctions g f a =
   let fp = f a
   in g (applyAlways fp a) <> fp
+
+
+class PatchHet2Base (p :: k -> k -> Type) where
+  type PatchSource1 p :: k -> Type
+  type PatchTarget1 p :: k -> Type
+
+class ( PatchHet2Base p
+      , PatchHet (p from to)
+      , PatchSource1 p from ~ PatchSource (p from to)
+      , PatchTarget1 p to ~ PatchTarget (p from to)
+      ) => PatchHet2Locally (p :: k -> k -> Type) from to where
+instance ( PatchHet2Base p
+         , PatchHet (p from to)
+         , PatchSource1 p from ~ PatchSource (p from to)
+         , PatchTarget1 p to ~ PatchTarget (p from to)
+         ) => PatchHet2Locally (p :: k -> k -> Type) from to where
+
+applyHet2Locally
+  :: PatchHet2Locally p from to
+  => p from to
+  -> PatchSource1 p from
+  -> Either (PatchSource1 p from :~: PatchTarget1 p to) (PatchTarget1 p to)
+applyHet2Locally = applyHet
+
+applyAlwaysHet2Locally
+  :: PatchHet2Locally p from to
+  => p from to
+  -> PatchSource1 p from
+  -> PatchTarget1 p to
+applyAlwaysHet2Locally = applyAlwaysHet
+
+-- TODO once we can use quantified constraints, perhaps combine PatchHet2Base and
+-- PatchHet2Locally, or at least get rid of this.
+class PatchHet2Base p => PatchHet2 (p :: k -> k -> Type) where
+  applyHet2
+    :: p from to
+    -> PatchSource1 p from
+    -> Either (PatchSource1 p from :~: PatchTarget1 p to) (PatchTarget1 p to)
+
+applyAlwaysHet2
+  :: PatchHet2 p
+  => p from to
+  -> PatchSource1 p from
+  -> PatchTarget1 p to
+applyAlwaysHet2 p t = case applyHet2 p t of
+  Left Refl -> t
+  Right t' -> t'
+
+-- | Connect the classes without quanitified constraints
+newtype ProjectLocal p from to = ProjectLocal { unProjectLocal :: p from to }
+  deriving newtype Cat.Semigroupoid
+
+instance PatchHet2 p => PatchHet (ProjectLocal p from to) where
+  type PatchSource (ProjectLocal p from to) = PatchSource1 p from
+  type PatchTarget (ProjectLocal p from to) = PatchTarget1 p to
+  applyHet (ProjectLocal p) = applyHet2 p
+
+instance PatchHet2 p => PatchHet2Base (ProjectLocal p) where
+  type PatchSource1 (ProjectLocal p) = PatchSource1 p
+  type PatchTarget1 (ProjectLocal p) = PatchTarget1 p
+
+class ( PatchHet2Base p
+      , PatchSource1 p ~ PatchTarget1 p
+      ) => Patch2 p
+instance ( PatchHet2Base p
+         , PatchSource1 p ~ PatchTarget1 p
+         ) => Patch2 p
+
+-- | 'First2' can be used as a 'Patch' that always fully replaces the value
+instance PatchHet (First2 (t :: k -> Type) (from :: k) (to :: k)) where
+  type PatchSource (First2 t from to) = t from
+  type PatchTarget (First2 t from to) = t to
+  applyHet (First2 val) _ = Right val
+
+data IndexedEq :: (k -> Type) -> k -> k -> Type where
+  IndexedRefl :: IndexedEq k x x
+  deriving (Typeable)
+
+deriving instance Eq (IndexedEq k x y)
+deriving instance Ord (IndexedEq k x y)
+deriving instance Show (IndexedEq k x y)
+deriving instance Read (IndexedEq k x x)
+
+instance Cat.Category (IndexedEq x) where
+  id = IndexedRefl
+  IndexedRefl . IndexedRefl = IndexedRefl
+
+-- | 'IndexedEq' can be used as a 'Patch' that always does nothing
+instance PatchHet (IndexedEq (t :: k -> Type) (a :: k) (b :: k)) where
+  type PatchSource (IndexedEq t a b) = t a
+  type PatchTarget (IndexedEq t a b) = t b
+  applyHet IndexedRefl _ = Left Refl
+
+instance PatchHet2Base (IndexedEq (t :: k -> Type) :: k -> k -> Type) where
+  type PatchSource1 (IndexedEq t) = t
+  type PatchTarget1 (IndexedEq t) = t
diff --git a/src/Data/Patch/DMap.hs b/src/Data/Patch/DMap.hs
index 7d12ad55..cb3f518b 100644
--- a/src/Data/Patch/DMap.hs
+++ b/src/Data/Patch/DMap.hs
@@ -47,8 +47,10 @@ instance GCompare k => DecidablyEmpty (PatchDMap k v) where
   isEmpty (PatchDMap m) = DMap.null m
 
 -- | Apply the insertions or deletions to a given 'DMap'.
-instance GCompare k => Patch (PatchDMap k v) where
+instance GCompare k => PatchHet (PatchDMap k v) where
+  type PatchSource (PatchDMap k v) = DMap k v
   type PatchTarget (PatchDMap k v) = DMap k v
+instance GCompare k => Patch (PatchDMap k v) where
   apply (PatchDMap diff) old = Just $! insertions `DMap.union` (old `DMap.difference` 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.mapMaybeWithKey (const $ getComposeMaybe) diff
           deletions = DMap.mapMaybeWithKey (const $ nothingToJust . getComposeMaybe) diff
diff --git a/src/Data/Patch/DMapWithMove.hs b/src/Data/Patch/DMapWithMove.hs
index b2dcdd37..81107cbd 100644
--- a/src/Data/Patch/DMapWithMove.hs
+++ b/src/Data/Patch/DMapWithMove.hs
@@ -356,8 +356,11 @@ const2PatchDMapWithMoveWith f (PatchMapWithMove p) = PatchDMapWithMove $ DMap.fr
           }
 
 -- | Apply the insertions, deletions, and moves to a given 'DMap'.
-instance GCompare k => Patch (PatchDMapWithMove k v) where
+instance GCompare k => PatchHet (PatchDMapWithMove k v) where
+  type PatchSource (PatchDMapWithMove k v) = DMap k v
   type PatchTarget (PatchDMapWithMove k v) = DMap k v
+
+instance GCompare k => Patch (PatchDMapWithMove k v) where
   apply (PatchDMapWithMove p) old = Just $! insertions `DMap.union` (old `DMap.difference` 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.mapMaybeWithKey insertFunc p
           insertFunc :: forall a. k a -> NodeInfo k v a -> Maybe (v a)
diff --git a/src/Data/Patch/DMapWithPatchingMove.hs b/src/Data/Patch/DMapWithPatchingMove.hs
new file mode 100644
index 00000000..13324294
--- /dev/null
+++ b/src/Data/Patch/DMapWithPatchingMove.hs
@@ -0,0 +1,623 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE InstanceSigs #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE PatternGuards #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE Rank2Types #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE UndecidableSuperClasses #-}
+
+-- |Module containing @'PatchDMapWithPatchingMove' k v@ and associated functions, which represents a 'Patch' to a @'DMap' k v@ which can insert, update, delete, and
+-- move values between keys.
+module Data.Patch.DMapWithPatchingMove where
+
+import qualified Control.Category as Cat
+import qualified Control.Category.DecidablyEmpty as Cat
+
+import Data.Constraint.Extras (Has')
+import Data.Dependent.Map (DMap)
+import Data.Dependent.Sum (DSum (..))
+import qualified Data.Dependent.Map as DMap
+import Data.Functor.Constant (Constant (..))
+import Data.Functor.Misc
+  ( Const2 (..)
+  , weakenDMapWith
+  , dmapToMapWith
+  )
+import Data.Functor.Const (Const (..))
+import Data.Functor.Product (Product (..))
+import Data.GADT.Compare (GEq (..), GCompare (..))
+import Data.GADT.Show (GRead, GShow, gshow)
+import qualified Data.Map as Map
+import Data.Kind (Type)
+import Data.Maybe
+import Data.Monoid.DecidablyEmpty
+import Data.Semigroupoid as Cat
+#if !MIN_VERSION_base(4,11,0)
+import Data.Semigroup (Semigroup (..), (<>))
+#endif
+import Data.Some (Some (Some), mkSome)
+import Data.Proxy (Proxy (..))
+import Data.These (These (..))
+import Data.Type.Equality ((:~:)(..))
+
+import Data.Patch.Class
+  ( Patch (..), PatchHet (..)
+  , PatchHet2 (..), PatchSource1, PatchTarget1
+  , applyAlwaysHet2
+  , IndexedEq (..)
+  )
+import Data.Patch.MapWithPatchingMove (PatchMapWithPatchingMove (..))
+import qualified Data.Patch.MapWithPatchingMove as MapWithPatchingMove
+
+-- | Like 'PatchMapWithPatchingMove', but for 'DMap'. Each key carries a 'NodeInfo'
+-- which describes how it will be changed by the patch and connects move sources
+-- and destinations.
+--
+-- Invariants:
+--
+--  * A key should not move to itself.
+--
+--  * A move should always be represented with both the destination key (as a
+--    'From_Move') and the source key (as a @'ComposeMaybe' ('Just'
+--    destination)@)
+newtype PatchDMapWithPatchingMove k v = PatchDMapWithPatchingMove (DMap k (NodeInfo k v))
+
+--deriving instance ( GShow k
+--                  , HasZip Show k p
+--                  , Has' Show k (PatchTarget1 p)
+--                  ) => Show (PatchDMapWithPatchingMove k p)
+--deriving instance ( GRead k
+--                  , HasZip Read k p
+--                  , Has' Read k (PatchTarget1 p)
+--                  ) => Read (PatchDMapWithPatchingMove k p)
+--deriving instance ( GEq k
+--                  , HasZip Eq k p
+--                  , Has' Eq k (PatchTarget1 p)
+--                  ) => Eq (PatchDMapWithPatchingMove k p)
+--deriving instance ( GCompare k
+--                  , HasZip Ord k p
+--                  , Has' Ord k (PatchTarget1 p)
+--                  ) => Ord (PatchDMapWithPatchingMove k p)
+
+-- It won't let me derive for some reason
+instance ( GCompare k
+         , Cat.DecidablyEmpty v
+         , Cat.Semigroupoid v
+         , PatchHet2 v
+         , PatchSource1 v ~ PatchTarget1 v
+         ) => DecidablyEmpty (PatchDMapWithPatchingMove k v) where
+  isEmpty (PatchDMapWithPatchingMove m) = DMap.null m
+
+-- | Structure which represents what changes apply to a particular key.
+-- @_nodeInfo_from@ specifies what happens to this key, and in particular what
+-- other key the current key is moving from, while @_nodeInfo_to@ specifies what
+-- key the current key is moving to if involved in a move.
+data NodeInfo k p a = NodeInfo
+  { _nodeInfo_from :: !(From k p a)
+  -- ^ Change applying to the current key, be it an insert, move, or delete.
+  , _nodeInfo_to :: !(To k)
+  -- ^ Where this key is moving to, if involved in a move. Should only be
+  -- @ComposeMaybe (Just k)@ when there is a corresponding 'From_Move'.
+  }
+
+--deriving instance ( Show (k a)
+--                  , Show (p a a)
+--                  , Show (PatchTarget1 p a)
+--                  ) => Show (NodeInfo k p a)
+--deriving instance ( Read (k a)
+--                  , Read (p a a)
+--                  , Read (PatchTarget1 p a)
+--                  ) => Read (NodeInfo k p a)
+--deriving instance ( Eq (k a)
+--                  , Eq (p a a)
+--                  , Eq (PatchTarget1 p a)
+--                  ) => Eq (NodeInfo k p a)
+--deriving instance ( Ord (k a)
+--                  , Ord (p a a)
+--                  , Ord (PatchTarget1 p a)
+--                  ) => Ord (NodeInfo k p a)
+
+-- | Structure describing a particular change to a key, be it inserting a new
+-- key (@From_Insert@), updating an existing key (@From_Insert@ again), deleting
+-- a key (@From_Delete@), or moving a key (@From_Move@).
+--
+-- This type isn't used directly as the from field patch, but is instead wrapped
+-- in an existential. However, it is nice to be able to reason about this in
+-- isolation as it is itself a @Semigroupoid@ when the underlying patch is.
+data From (k :: a -> Type) (p :: a -> a -> Type) :: a -> Type where
+  -- | Insert a new or update an existing key with the given value @PatchTarget1
+  -- p a@
+  From_Insert :: PatchTarget1 p to -> From k p to
+  -- | Delete the existing key
+  From_Delete :: From k p to
+  -- | Move the value from the given key @k a@ to this key. The source key
+  -- should also have an entry in the patch giving the current key as
+  -- @_nodeInfo_to@, usually but not necessarily with @From_Delete@.
+  From_Move :: !(DSum k (Flip p to)) -> From k p to
+
+deriving instance ( Show (k a), GShow k
+                  , Has' Show k (Flip p a)
+                  , Show (PatchTarget1 p a)
+                  ) => Show (From k p a)
+deriving instance ( Read (k a), GRead k
+                  , Has' Read k (Flip p a)
+                  , Read (PatchTarget1 p a)
+                  ) => Read (From k p a)
+deriving instance ( GEq k
+                  , Has' Eq k (Flip p a)
+                  , Eq (PatchTarget1 p a)
+                  ) => Eq (From k p a)
+deriving instance ( GCompare k
+                  , Has' Eq k (Flip p a) -- superclass bug
+                  , Has' Ord k (Flip p a)
+                  , Ord (PatchTarget1 p a)
+                  ) => Ord (From k p a)
+
+newtype Flip p to from = Flip (p from to)
+
+instance Cat.Category p => Cat.Category (Flip (p :: k -> k -> Type)) where
+  id = Flip Cat.id
+  Flip y . Flip x = Flip $ x Cat.. y
+
+-- | The "to" part of a 'NodeInfo'. Rather than be built out of @From@ like @From@
+-- is, we store just the information necessary to compose a @To@ and @From@ like
+-- @oLocal@ composes two @From@s.
+data To (k :: a -> Type) where
+  -- | Delete or leave in place
+  To_NonMove :: To k
+  -- | Move the value from the given key @k a@ to this key. The target key
+  -- should also have an entry in the patch giving the current key in
+  -- @_nodeInfo_from@, usually but not necessarily with @To_Delete@.
+  To_Move :: !(Some k) -> To k
+
+deriving instance GShow k => Show (To k)
+deriving instance GRead k => Read (To k)
+deriving instance GEq k => Eq (To k)
+deriving instance GCompare k => Ord (To k)
+
+-- |Test whether a 'PatchDMapWithPatchingMove' satisfies its invariants.
+validPatchDMapWithPatchingMove
+  :: forall k v
+  .  (GCompare k, GShow k)
+  => DMap k (NodeInfo k v)
+  -> Bool
+validPatchDMapWithPatchingMove = not . null . validationErrorsForPatchDMapWithPatchingMove
+
+-- |Enumerate what reasons a 'PatchDMapWithPatchingMove' doesn't satisfy its invariants, returning @[]@ if it's valid.
+validationErrorsForPatchDMapWithPatchingMove
+  :: forall k v
+  .  (GCompare k, GShow k)
+  => DMap k (NodeInfo k v)
+  -> [String]
+validationErrorsForPatchDMapWithPatchingMove m =
+  noSelfMoves <> movesBalanced
+  where
+    noSelfMoves = mapMaybe selfMove . DMap.toAscList $ m
+    selfMove (dst :=> NodeInfo (From_Move (src :=> _)) _)
+      | Just _ <- dst `geq` src = Just $ "self move of key " <> gshow src <> " at destination side"
+    selfMove (src :=> NodeInfo _ (To_Move (Some dst)))
+      | Just _ <- src `geq` dst = Just $ "self move of key " <> gshow dst <> " at source side"
+    selfMove _ = Nothing
+    movesBalanced = mapMaybe unbalancedMove . DMap.toAscList $ m
+    unbalancedMove (dst :=> NodeInfo (From_Move (src :=> _)) _) =
+      case DMap.lookup src m of
+        Nothing -> Just $ "unbalanced move at destination key " <> gshow dst <> " supposedly from " <> gshow src <> " but source key is not in the patch"
+        Just (NodeInfo _ (To_Move (Some dst'))) ->
+          if isNothing (dst' `geq` dst)
+            then Just $ "unbalanced move at destination key " <> gshow dst <> " from " <> gshow src <> " is going to " <> gshow dst' <> " instead"
+            else Nothing
+        _ ->
+          Just $ "unbalanced move at destination key " <> gshow dst <> " supposedly from " <> gshow src <> " but source key has no move to key"
+    unbalancedMove (src :=> NodeInfo _ (To_Move (Some dst))) =
+      case DMap.lookup dst m of
+        Nothing -> Just $ " unbalanced move at source key " <> gshow src <> " supposedly going to " <> gshow dst <> " but destination key is not in the patch"
+        Just (NodeInfo (From_Move (src' :=> _)) _) ->
+          if isNothing (src' `geq` src)
+            then Just $ "unbalanced move at source key " <> gshow src <> " to " <> gshow dst <> " is coming from " <> gshow src' <> " instead"
+            else Nothing
+
+        _ ->
+          Just $ "unbalanced move at source key " <> gshow src <> " supposedly going to " <> gshow dst <> " but destination key is not moving"
+    unbalancedMove _ = Nothing
+
+
+data ToFrom k p a = ToFrom (To k) (From k p a)
+
+-- | Helper data structure used for composing patches using the monoid instance.
+data Fixup k p
+   = Fixup_Delete
+   | Fixup_Update (These (DSum k (From k p)) (To k))
+
+-- | Compose patches having the same effect as applying the patches in turn:
+-- @'applyAlways' (p <> q) == 'applyAlways' p . 'applyAlways' q@
+instance forall k p
+         . ( GCompare k
+           , Cat.Semigroupoid p
+           , Cat.DecidablyEmpty p
+           , PatchHet2 p
+           , PatchSource1 p ~ PatchTarget1 p
+           )
+         => Semigroup (PatchDMapWithPatchingMove k p) where
+  PatchDMapWithPatchingMove ma <> PatchDMapWithPatchingMove mb = PatchDMapWithPatchingMove m
+    where
+      connections :: [DSum k (ToFrom k p)]
+      connections = DMap.toList $ DMap.intersectionWithKey
+        (\_ a b -> ToFrom (_nodeInfo_to a) (_nodeInfo_from b))
+        ma
+        mb
+      h :: DSum k (ToFrom k p) -> [DSum k (Const (Fixup k p))]
+      h ((between :: k between) :=> ToFrom editAfter editBefore) = case (editAfter, editBefore) of
+        (To_Move (Some (toAfter :: k after)), From_Move ((fromBefore :: k before) :=> Flip p) :: From k p between) ->
+          case Cat.isId p of
+            Just Refl ->
+              [ toAfter :=> Const Fixup_Delete ]
+            Nothing ->
+              [ toAfter :=> Const (Fixup_Update $ This $ between :=> editBefore)
+              , fromBefore :=> Const (Fixup_Update $ That editAfter)
+              ]
+        (To_NonMove, From_Move (fromBefore :=> _)) ->
+          -- The item is destroyed in the second patch, so indicate that it is
+          -- destroyed in the source map
+          [fromBefore :=> Const (Fixup_Update $ That To_NonMove)]
+        (To_Move (Some toAfter), _) ->
+          [toAfter :=> Const (Fixup_Update $ This $ between :=> editBefore)]
+        (To_NonMove, _) ->
+          []
+      mergeFixups _ (Const Fixup_Delete) (Const Fixup_Delete) = Const $ Fixup_Delete
+      mergeFixups _ (Const (Fixup_Update a)) (Const (Fixup_Update b))
+        | This x <- a, That y <- b
+        = Const $ Fixup_Update $ These x y
+        | That y <- a, This x <- b
+        = Const $ Fixup_Update $ These x y
+      mergeFixups _ _ _ = error "PatchDMapWithPatchingMove: incompatible fixups"
+      fixups = DMap.fromListWithKey mergeFixups $ concatMap h connections
+      combineNodeInfos _ nia nib = NodeInfo
+        { _nodeInfo_from = _nodeInfo_from nia
+        , _nodeInfo_to = _nodeInfo_to nib
+        }
+      applyFixup :: k a -> NodeInfo k p a -> Const (Fixup k p) a -> Maybe (NodeInfo k p a)
+      applyFixup _ ni (Const fixup) = case fixup of
+        Fixup_Delete -> Nothing
+        Fixup_Update u -> Just $ NodeInfo
+          { _nodeInfo_from = case _nodeInfo_from ni of
+              f@(From_Move ((between0 :: k between0) :=> Flip (p' :: p between0 a))) -> case getHere u of -- The `from` fixup comes from the "old" patch
+                Nothing -> f -- If there's no `from` fixup, just use the "new" `from`
+                Just ((between1 :: k between1) :=> frm) -> case geq between0 between1 of
+                  Nothing -> error "PatchMapWithPatchingMove: fixup joined-on key did not match"
+                  Just Refl -> case frm of
+                    From_Insert v -> From_Insert $ applyAlwaysHet2 p' v
+                    From_Delete -> From_Delete
+                    From_Move (oldKey :=> Flip (p :: p oldKey between1)) -> From_Move $ oldKey :=> Flip (p' `o` p :: p oldKey a)
+              _ -> error "PatchMapWithPatchingMove: fixup for non-move From"
+          , _nodeInfo_to = fromMaybe (_nodeInfo_to ni) $ getThere u
+          }
+      m = DMap.differenceWithKey applyFixup (DMap.unionWithKey combineNodeInfos ma mb) fixups
+      getHere :: These a b -> Maybe a
+      getHere = \case
+        This a -> Just a
+        These a _ -> Just a
+        That _ -> Nothing
+      getThere :: These a b -> Maybe b
+      getThere = \case
+        This _ -> Nothing
+        These _ b -> Just b
+        That b -> Just b
+
+-- | Compose patches having the same effect as applying the patches in turn:
+-- @'applyAlways' (p <> q) == 'applyAlways' p . 'applyAlways' q@
+instance ( GCompare k
+         , Cat.Semigroupoid p
+         , Cat.DecidablyEmpty p
+         , PatchHet2 p
+         , PatchSource1 p ~ PatchTarget1 p
+         ) => Monoid (PatchDMapWithPatchingMove k p) where
+  mempty = PatchDMapWithPatchingMove mempty
+  mappend = (<>)
+
+{-
+mappendPatchDMapWithPatchingMoveSlow :: forall k v.  (ShowTag k v, GCompare k) => PatchDMapWithPatchingMove k v -> PatchDMapWithPatchingMove k v -> PatchDMapWithPatchingMove k v
+PatchDMapWithPatchingMove dstAfter srcAfter `mappendPatchDMapWithPatchingMoveSlow` PatchDMapWithPatchingMove dstBefore srcBefore = PatchDMapWithPatchingMove dst src
+  where
+    getDstAction k m = fromMaybe (From_Move k) $ DMap.lookup k m -- Any key that isn't present is treated as that key moving to itself
+    removeRedundantDst toKey (From_Move fromKey) | isJust (toKey `geq` fromKey) = Nothing
+    removeRedundantDst _ a = Just a
+    f :: forall a. k a -> From k v a -> Maybe (From k v a)
+    f toKey _ = removeRedundantDst toKey $ case getDstAction toKey dstAfter of
+      From_Move fromKey -> getDstAction fromKey dstBefore
+      nonMove -> nonMove
+    dst = DMap.mapMaybeWithKey f $ DMap.union dstAfter dstBefore
+    getSrcAction k m = fromMaybe (ComposeMaybe $ Just k) $ DMap.lookup k m
+    removeRedundantSrc fromKey (ComposeMaybe (Just toKey)) | isJust (fromKey `geq` toKey) = Nothing
+    removeRedundantSrc _ a = Just a
+    g :: forall a. k a -> ComposeMaybe k a -> Maybe (ComposeMaybe k a)
+    g fromKey _ = removeRedundantSrc fromKey $ case getSrcAction fromKey srcBefore of
+      ComposeMaybe Nothing -> ComposeMaybe Nothing
+      ComposeMaybe (Just toKeyBefore) -> getSrcAction toKeyBefore srcAfter
+    src = DMap.mapMaybeWithKey g $ DMap.union srcAfter srcBefore
+-}
+
+-- | Make a @'PatchDMapWithPatchingMove' k v@ which has the effect of inserting or
+-- updating a value @PatchTarget1 p a@ to the given key @k a@, like
+-- 'DMap.insert'.
+insertDMapKey :: k a -> PatchTarget1 p a -> PatchDMapWithPatchingMove k p
+insertDMapKey k v =
+  PatchDMapWithPatchingMove . DMap.singleton k $ NodeInfo (From_Insert v) To_NonMove
+
+-- | Make a @'PatchDMapWithPatchingMove' k v@ which has the effect of moving the value
+-- from the first key @k a@ to the second key @k a@, equivalent to:
+--
+-- @
+--     'DMap.delete' src (maybe dmap ('DMap.insert' dst) (DMap.lookup src dmap))
+-- @
+moveDMapKey
+  :: GCompare k
+  => k a -> k a -> PatchDMapWithPatchingMove k (IndexedEq v)
+moveDMapKey src dst = case src `geq` dst of
+  Nothing -> PatchDMapWithPatchingMove $ DMap.fromList
+    [ dst :=> NodeInfo (From_Move (src :=> Flip IndexedRefl)) To_NonMove
+    , src :=> NodeInfo From_Delete (To_Move $ Some dst)
+    ]
+  Just _ -> PatchDMapWithPatchingMove DMap.empty
+
+-- | Make a @'PatchDMapWithPatchingMove' k v@ which has the effect of swapping two keys
+-- in the mapping, equivalent to:
+--
+-- @
+--     let aMay = DMap.lookup a dmap
+--         bMay = DMap.lookup b dmap
+--     in maybe id (DMap.insert a) (bMay <> aMay)
+--      . maybe id (DMap.insert b) (aMay <> bMay)
+--      . DMap.delete a . DMap.delete b $ dmap
+-- @
+swapDMapKey :: GCompare k => k a -> k a -> PatchDMapWithPatchingMove k (IndexedEq v)
+swapDMapKey src dst = case src `geq` dst of
+  Nothing -> PatchDMapWithPatchingMove $ DMap.fromList
+    [ dst :=> NodeInfo (From_Move (src :=> Flip IndexedRefl)) (To_Move $ Some src)
+    , src :=> NodeInfo (From_Move (dst :=> Flip IndexedRefl)) (To_Move $ Some dst)
+    ]
+  Just _ -> PatchDMapWithPatchingMove DMap.empty
+
+-- | Make a @'PatchDMapWithPatchingMove' k v@ which has the effect of deleting a key in
+-- the mapping, equivalent to 'DMap.delete'.
+deleteDMapKey :: k a -> PatchDMapWithPatchingMove k v
+deleteDMapKey k = PatchDMapWithPatchingMove $ DMap.singleton k $ NodeInfo From_Delete To_NonMove
+
+{-
+k1, k2 :: Const2 Int () ()
+k1 = Const2 1
+k2 = Const2 2
+p1, p2 :: PatchDMapWithPatchingMove (Const2 Int ()) Identity
+p1 = moveDMapKey k1 k2
+p2 = moveDMapKey k2 k1
+p12 = p1 <> p2
+p21 = p2 <> p1
+p12Slow = p1 `mappendPatchDMapWithPatchingMoveSlow` p2
+p21Slow = p2 `mappendPatchDMapWithPatchingMoveSlow` p1
+
+testPatchDMapWithPatchingMove = do
+  print p1
+  print p2
+  print $ p12 == deleteDMapKey k1
+  print $ p21 == deleteDMapKey k2
+  print $ p12Slow == deleteDMapKey k1
+  print $ p21Slow == deleteDMapKey k2
+
+dst (PatchDMapWithPatchingMove x _) = x
+src (PatchDMapWithPatchingMove _ x) = x
+-}
+
+-- | Extract the 'DMap' representing the patch changes from the
+-- 'PatchDMapWithPatchingMove'.
+unPatchDMapWithPatchingMove :: PatchDMapWithPatchingMove k v -> DMap k (NodeInfo k v)
+unPatchDMapWithPatchingMove (PatchDMapWithPatchingMove p) = p
+
+-- | Wrap a 'DMap' representing patch changes into a 'PatchDMapWithPatchingMove',
+-- without checking any invariants.
+--
+-- __Warning:__ when using this function, you must ensure that the invariants of 'PatchDMapWithPatchingMove' are preserved; they will not be checked.
+unsafePatchDMapWithPatchingMove :: DMap k (NodeInfo k v) -> PatchDMapWithPatchingMove k v
+unsafePatchDMapWithPatchingMove = PatchDMapWithPatchingMove
+
+-- | Wrap a 'DMap' representing patch changes into a 'PatchDMapWithPatchingMove' while
+-- checking invariants. If the invariants are satisfied, @Right p@ is returned
+-- otherwise @Left errors@.
+patchDMapWithPatchingMove :: (GCompare k, GShow k) => DMap k (NodeInfo k v) -> Either [String] (PatchDMapWithPatchingMove k v)
+patchDMapWithPatchingMove dm =
+  case validationErrorsForPatchDMapWithPatchingMove dm of
+    [] -> Right $ unsafePatchDMapWithPatchingMove dm
+    errs -> Left errs
+
+-- | Map a natural transform @v -> v'@ over the given patch, transforming
+-- @'PatchDMapWithPatchingMove' k v@ into @'PatchDMapWithPatchingMove' k v'@.
+mapPatchDMapWithPatchingMove
+  :: forall k p p'
+  .  (forall a. PatchTarget1 p a -> PatchTarget1 p' a)
+  -> (forall from to. p from to -> p' from to)
+  -> PatchDMapWithPatchingMove k p
+  -> PatchDMapWithPatchingMove k p'
+mapPatchDMapWithPatchingMove f g (PatchDMapWithPatchingMove m) =
+  PatchDMapWithPatchingMove $ DMap.map (\ni -> NodeInfo
+    { _nodeInfo_from = h $ _nodeInfo_from ni
+    , _nodeInfo_to = _nodeInfo_to ni
+    }) m
+  where h :: forall a. From k p a -> From k p' a
+        h = \case
+          From_Insert v -> From_Insert $ f v
+          From_Delete -> From_Delete
+          From_Move (k :=> Flip p) -> From_Move $ k :=> Flip (g p)
+
+-- | Traverse an effectful function @forall a. PatchTarget1 p a -> m (v ' a)@
+-- over the given patch, transforming @'PatchDMapWithPatchingMove' k v@ into @m
+-- ('PatchDMapWithPatchingMove' k v')@.
+traversePatchDMapWithPatchingMove
+  :: forall m k p p'
+  . Applicative m
+  => (forall a. PatchTarget1 p a -> m (PatchTarget1 p' a))
+  -> (forall from to. p from to -> m (p' from to))
+  -> PatchDMapWithPatchingMove k p
+  -> m (PatchDMapWithPatchingMove k p')
+traversePatchDMapWithPatchingMove f g = traversePatchDMapWithPatchingMoveWithKey
+  (\_ -> f)
+  (\_ _ -> g)
+
+-- | Map an effectful function @forall a. k a -> PatchTarget1 p a -> m (v ' a)@
+-- over the given patch, transforming @'PatchDMapWithPatchingMove' k v@ into @m
+-- ('PatchDMapWithPatchingMove' k v')@.
+traversePatchDMapWithPatchingMoveWithKey
+  :: forall m k p p'
+  . Applicative m
+  => (forall a. k a -> PatchTarget1 p a -> m (PatchTarget1 p' a))
+  -> (forall from to. k from -> k to -> p from to -> m (p' from to))
+  -> PatchDMapWithPatchingMove k p
+  -> m (PatchDMapWithPatchingMove k p')
+traversePatchDMapWithPatchingMoveWithKey f g (PatchDMapWithPatchingMove m) =
+  PatchDMapWithPatchingMove <$> DMap.traverseWithKey (\k ni -> NodeInfo
+    <$> h k (_nodeInfo_from ni)
+    <*> pure (_nodeInfo_to ni)) m
+  where h :: forall a. k a -> From k p a -> m (From k p' a)
+        h k = \case
+          From_Insert v -> From_Insert <$> f k v
+          From_Delete -> pure From_Delete
+          From_Move (fromKey :=> Flip p) -> From_Move . (fromKey :=>) . Flip <$> g fromKey k p
+
+-- | Map a function which transforms @'From k PatchTarget1 p a@ into a @'From k
+-- PatchTarget1 p' a@ over a @'NodeInfo' k PatchTarget1 p a@.
+nodeInfoMapFrom
+  :: (From k p a -> From k p' a)
+  -> (To k -> To k)
+  -> NodeInfo k p a
+  -> NodeInfo k p' a
+nodeInfoMapFrom f g ni = NodeInfo
+  { _nodeInfo_from = f $ _nodeInfo_from ni
+  , _nodeInfo_to = g $ _nodeInfo_to ni
+  }
+
+-- | Map an effectful function which transforms @'From k PatchTarget1 p a@ into
+-- a @f ('From k PatchTarget1 p' a)@ over a @'NodeInfo' k PatchTarget1 p a@.
+nodeInfoMapFromM
+  :: Applicative f
+  => (From k p a -> f (From k p' a))
+  -> (To k -> f (To k))
+  -> NodeInfo k p a
+  -> f (NodeInfo k p' a)
+nodeInfoMapFromM f g ni = NodeInfo
+  <$> f (_nodeInfo_from ni)
+  <*> g (_nodeInfo_to ni)
+
+-- | Weaken a 'PatchDMapWithPatchingMove' to a 'PatchMapWithPatchingMove' by weakening the keys
+-- from @k a@ to @'Some' k@ and applying a given weakening function
+-- @PatchTarget1 p a -> v'@ to values.
+weakenPatchDMapWithPatchingMoveWith
+  :: forall k p p'
+  .  (forall a. PatchTarget1 p a -> PatchTarget p')
+  -> (forall from to. p from to -> p')
+  -> PatchDMapWithPatchingMove k p
+  -> PatchMapWithPatchingMove (Some k) p'
+weakenPatchDMapWithPatchingMoveWith f g (PatchDMapWithPatchingMove m) =
+  PatchMapWithPatchingMove $ weakenDMapWith h m
+  where h :: forall a. NodeInfo k p a -> MapWithPatchingMove.NodeInfo (Some k) p'
+        h ni = MapWithPatchingMove.NodeInfo
+          { MapWithPatchingMove._nodeInfo_from = case _nodeInfo_from ni of
+              From_Insert v -> MapWithPatchingMove.From_Insert $ f v
+              From_Delete -> MapWithPatchingMove.From_Delete
+              From_Move (k :=> Flip p) -> MapWithPatchingMove.From_Move (mkSome k) $ g p
+          , MapWithPatchingMove._nodeInfo_to = case _nodeInfo_to ni of
+              To_NonMove -> Nothing
+              To_Move (Some k) -> Just (mkSome k)
+          }
+
+-- | "Weaken" a @'PatchDMapWithPatchingMove' (Const2 k a) v@ to a @'PatchMapWithPatchingMove' k
+-- v'@. Weaken is in scare quotes because the 'Const2' has already disabled any
+-- dependency in the typing and all points are already @a@, hence the function
+-- to map each value to @v'@ is not higher rank.
+patchDMapWithPatchingMoveToPatchMapWithPatchingMoveWith
+  :: forall k p p' a
+  . (PatchTarget1 p a -> PatchTarget p')
+  -> (p a a -> p')
+  -> PatchDMapWithPatchingMove (Const2 k a) p
+  -> PatchMapWithPatchingMove k p'
+patchDMapWithPatchingMoveToPatchMapWithPatchingMoveWith f g (PatchDMapWithPatchingMove m) =
+  PatchMapWithPatchingMove $ dmapToMapWith h m
+  where h :: NodeInfo (Const2 k a) p a -> MapWithPatchingMove.NodeInfo k p'
+        h ni = MapWithPatchingMove.NodeInfo
+          { MapWithPatchingMove._nodeInfo_from = case _nodeInfo_from ni of
+              From_Insert v -> MapWithPatchingMove.From_Insert $ f v
+              From_Delete -> MapWithPatchingMove.From_Delete
+              From_Move (Const2 k :=> Flip p) -> MapWithPatchingMove.From_Move k $ g p
+          , MapWithPatchingMove._nodeInfo_to = case _nodeInfo_to ni of
+              To_NonMove -> Nothing
+              To_Move (Some (Const2 k)) -> Just k
+          }
+
+-- | "Strengthen" a @'PatchMapWithPatchingMove' k v@ into a @'PatchDMapWithPatchingMove
+-- ('Const2' k a)@; that is, turn a non-dependently-typed patch into a
+-- dependently typed one but which always has a constant key type represented by
+-- 'Const2'. Apply the given function to each @v@ to produce a @PatchTarget1 p'
+-- a@. Completemented by 'patchDMapWithPatchingMoveToPatchMapWithPatchingMoveWith'
+const2PatchDMapWithPatchingMoveWith
+  :: forall k v v' a
+  .  (v -> v' a)
+  -> PatchMapWithPatchingMove k (Proxy v)
+  -> PatchDMapWithPatchingMove (Const2 k a) (IndexedEq v')
+const2PatchDMapWithPatchingMoveWith f (PatchMapWithPatchingMove p) =
+  PatchDMapWithPatchingMove $ DMap.fromDistinctAscList $ g <$> Map.toAscList p
+  where g :: (k, MapWithPatchingMove.NodeInfo k (Proxy v))
+          -> DSum (Const2 k a) (NodeInfo (Const2 k a) (IndexedEq v'))
+        g (k, ni) = Const2 k :=> NodeInfo
+          { _nodeInfo_from = case MapWithPatchingMove._nodeInfo_from ni of
+              MapWithPatchingMove.From_Insert v -> From_Insert $ f v
+              MapWithPatchingMove.From_Delete -> From_Delete
+              MapWithPatchingMove.From_Move fromKey Proxy -> From_Move $ Const2 fromKey :=> Flip IndexedRefl
+          , _nodeInfo_to = case MapWithPatchingMove._nodeInfo_to ni of
+              Nothing -> To_NonMove
+              Just toKey -> To_Move $ Some (Const2 toKey)
+          }
+
+-- | Apply the insertions, deletions, and moves to a given 'DMap'.
+instance ( GCompare k
+         , PatchHet2 p
+         , PatchSource1 p ~ PatchTarget1 p
+         ) => PatchHet (PatchDMapWithPatchingMove k p) where
+  type PatchSource (PatchDMapWithPatchingMove k p) = DMap k (PatchSource1 p)
+  type PatchTarget (PatchDMapWithPatchingMove k p) = DMap k (PatchTarget1 p)
+
+instance ( GCompare k
+         , PatchHet2 p
+         , PatchSource1 p ~ PatchTarget1 p
+         ) => Patch (PatchDMapWithPatchingMove k p) where
+  apply (PatchDMapWithPatchingMove m) old = Just $! insertions `DMap.union` (old `DMap.difference` 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.mapMaybeWithKey insertFunc m
+          insertFunc :: forall a. k a -> NodeInfo k p a -> Maybe (PatchTarget1 p a)
+          insertFunc _ ni = case _nodeInfo_from ni of
+            From_Insert v -> Just v
+            From_Move (k :=> Flip p) -> applyAlwaysHet2 p <$> DMap.lookup k old
+            From_Delete -> Nothing
+          deletions = DMap.mapMaybeWithKey deleteFunc m
+          deleteFunc :: forall a. k a -> NodeInfo k p a -> Maybe (Constant () a)
+          deleteFunc _ ni = case _nodeInfo_from ni of
+            From_Delete -> Just $ Constant ()
+            _ -> Nothing
+
+-- | Get the values that will be replaced, deleted, or moved if the given patch
+-- is applied to the given 'DMap'.
+getDeletionsAndMoves
+  :: ( GCompare k
+     , PatchSource1 p ~ PatchTarget1 p
+     )
+  => PatchDMapWithPatchingMove k p
+  -> DMap k (PatchSource1 p)
+  -> DMap k (Product (PatchTarget1 p) (Const (To k)))
+getDeletionsAndMoves (PatchDMapWithPatchingMove p) m = DMap.intersectionWithKey f m p
+  where f _ v ni = Pair v $ Const $ _nodeInfo_to ni
diff --git a/src/Data/Patch/DMapWithPatchingMove/By.hs b/src/Data/Patch/DMapWithPatchingMove/By.hs
new file mode 100644
index 00000000..0ddf5f8b
--- /dev/null
+++ b/src/Data/Patch/DMapWithPatchingMove/By.hs
@@ -0,0 +1,90 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE InstanceSigs #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE Rank2Types #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE UndecidableSuperClasses #-}
+
+module Data.Patch.DMapWithPatchingMove.By where
+
+import Data.Kind (Type)
+import Data.Semigroupoid as Cat
+
+import Data.Patch.Class
+
+-- | Structure describing a particular change to a key, be it inserting a new
+-- key (@By_Insert@), updating an existing key (@By_Insert@ again), deleting
+-- a key (@By_Delete@), or moving a key (@By_Move@).
+--
+-- This type isn't used directly as the from field patch, but is instead wrapped
+-- in an existential. However, it is nice to be able to reason about this in
+-- isolation as it is itself a @Semigroupoid@ when the underlying patch is.
+data By (k :: a -> Type) (p :: a -> a -> Type) :: a -> a -> Type where
+  -- | Insert a new or update an existing key with the given value @PatchTarget1
+  -- p a@
+  By_Insert :: PatchTarget1 p to -> By k p from to
+  -- | Delete the existing key
+  By_Delete :: By k p from to
+  -- | Move the value from the given key @k a@ to this key. The source key
+  -- should also have an entry in the patch giving the current key as
+  -- @_nodeInfo_to@, usually but not necessarily with @By_Delete@.
+  By_Move :: !(k from) -> p from to -> By k p from to
+
+deriving instance ( Show (k from), Show (k to)
+                  , Show (p from to)
+                  , Show (PatchTarget1 p to)
+                  ) => Show (By k p from to)
+deriving instance ( Read (k from), Read (k to)
+                  , Read (p from to)
+                  , Read (PatchTarget1 p to)
+                  ) => Read (By k p from to)
+deriving instance ( Eq (k from), Eq (k to)
+                  , Eq (p from to)
+                  , Eq (PatchTarget1 p to)
+                  ) => Eq (By k p from to)
+deriving instance ( Ord (k from), Ord (k to)
+                  , Ord (p from to)
+                  , Ord (PatchTarget1 p to)
+                  ) => Ord (By k p from to)
+
+mapByPatch
+  :: PatchTarget1 p0 ~ PatchTarget1 p1
+  => (p0 from to -> p1 from to)
+  -> By k p0 from to
+  -> By k p1 from to
+mapByPatch f = \case
+  By_Insert v -> By_Insert v
+  By_Delete -> By_Delete
+  By_Move k p -> By_Move k $ f p
+
+-- | Compose patches having the same effect as applying the patches in turn:
+-- @'applyAlways' (p <> q) == 'applyAlways' p . 'applyAlways' q@
+instance ( PatchSource1 p ~ PatchTarget1 p
+         , Cat.Semigroupoid p
+         , PatchHet2 p
+         ) => Cat.Semigroupoid (By k p) where
+  o p0 p1 = mapByPatch unProjectLocal $
+    oLocal (mapByPatch ProjectLocal p0) (mapByPatch ProjectLocal p1)
+
+oLocal
+  :: ( PatchSource1 p ~ PatchTarget1 p
+     , PatchHet2Locally p between after
+     , Cat.Semigroupoid p
+     )
+  => By k p between after
+  -> By k p before between
+  -> By k p before after
+By_Insert new `oLocal` _ = By_Insert new
+By_Delete `oLocal` _ = By_Delete
+By_Move _ x `oLocal` By_Insert y = By_Insert $ applyAlwaysHet2Locally x y
+By_Move _ x `oLocal` By_Move src y = By_Move src $ x `o` y
+By_Move _ _ `oLocal` By_Delete = By_Delete
diff --git a/src/Data/Patch/IntMap.hs b/src/Data/Patch/IntMap.hs
index 9866596f..81dcac4f 100644
--- a/src/Data/Patch/IntMap.hs
+++ b/src/Data/Patch/IntMap.hs
@@ -47,8 +47,10 @@ deriving instance Semigroup (PatchIntMap v)
 makeWrapped ''PatchIntMap
 
 -- | Apply the insertions or deletions to a given 'IntMap'.
-instance Patch (PatchIntMap a) where
+instance PatchHet (PatchIntMap a) where
+  type PatchSource (PatchIntMap a) = IntMap a
   type PatchTarget (PatchIntMap a) = IntMap a
+instance Patch (PatchIntMap a) where
   apply (PatchIntMap p) v = if IntMap.null p then Nothing else Just $
     let removes = IntMap.filter isNothing p
         adds = IntMap.mapMaybe id p
diff --git a/src/Data/Patch/Map.hs b/src/Data/Patch/Map.hs
index c9712551..352749f4 100644
--- a/src/Data/Patch/Map.hs
+++ b/src/Data/Patch/Map.hs
@@ -55,8 +55,10 @@ instance Ord k => Semigroup (PatchMap k v) where
   stimes = stimesIdempotentMonoid
 
 -- | Apply the insertions or deletions to a given 'Map'.
-instance Ord k => Patch (PatchMap k v) where
+instance Ord k => PatchHet (PatchMap k v) where
+  type PatchSource (PatchMap k v) = Map k v
   type PatchTarget (PatchMap k v) = Map k v
+instance Ord k => Patch (PatchMap k v) where
   {-# INLINABLE apply #-}
   apply (PatchMap p) old = Just $! insertions `Map.union` (old `Map.difference` deletions) --TODO: return Nothing sometimes --Note: the strict application here is critical to ensuring that incremental merges don't hold onto all their prerequisite events forever; can we make this more robust?
     where insertions = Map.mapMaybeWithKey (const id) p
diff --git a/src/Data/Patch/MapWithMove.hs b/src/Data/Patch/MapWithMove.hs
index d0c834e0..f274b1f5 100644
--- a/src/Data/Patch/MapWithMove.hs
+++ b/src/Data/Patch/MapWithMove.hs
@@ -190,8 +190,11 @@ unsafePatchMapWithMove :: Map k (NodeInfo k v) -> PatchMapWithMove k v
 unsafePatchMapWithMove = coerce PM.unsafePatchMapWithPatchingMove
 
 -- | Apply the insertions, deletions, and moves to a given 'Map'
-instance Ord k => Patch (PatchMapWithMove k v) where
+instance Ord k => PatchHet (PatchMapWithMove k v) where
+  type PatchSource (PatchMapWithMove k v) = Map k v
   type PatchTarget (PatchMapWithMove k v) = Map k v
+
+instance Ord k => Patch (PatchMapWithMove k v) where
   apply (PatchMapWithMove' p) = apply p
 
 -- | Returns all the new elements that will be added to the 'Map'.
diff --git a/src/Data/Patch/MapWithPatchingMove.hs b/src/Data/Patch/MapWithPatchingMove.hs
index 2202ed63..e7ae42e9 100644
--- a/src/Data/Patch/MapWithPatchingMove.hs
+++ b/src/Data/Patch/MapWithPatchingMove.hs
@@ -174,8 +174,11 @@ unsafePatchMapWithPatchingMove
 unsafePatchMapWithPatchingMove = PatchMapWithPatchingMove
 
 -- | Apply the insertions, deletions, and moves to a given 'Map'
-instance (Ord k, Patch p) => Patch (PatchMapWithPatchingMove k p) where
+instance (Ord k, Patch p) => PatchHet (PatchMapWithPatchingMove k p) where
+  type PatchSource (PatchMapWithPatchingMove k p) = Map k (PatchSource p)
   type PatchTarget (PatchMapWithPatchingMove k p) = Map k (PatchTarget p)
+
+instance (Ord k, Patch p) => Patch (PatchMapWithPatchingMove k p) where
   -- 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
@@ -381,7 +384,10 @@ instance ( Ord k
             -> [ (toAfter, Fixup_Update (This editBefore))
                , (fromBefore, Fixup_Update (That mToAfter))
                ]
-        (Nothing, From_Move fromBefore _) -> [(fromBefore, Fixup_Update (That mToAfter))] -- The item is destroyed in the second patch, so indicate that it is destroyed in the source map
+        (Nothing, From_Move fromBefore _) ->
+           -- The item is destroyed in the second patch, so indicate that it is
+           -- destroyed in the source map
+           [(fromBefore, Fixup_Update (That mToAfter))]
         (Just toAfter, _) -> [(toAfter, Fixup_Update (This editBefore))]
         (Nothing, _) -> []
       mergeFixups _ Fixup_Delete Fixup_Delete = Fixup_Delete
diff --git a/src/Data/Patch/PatchOrReplacement.hs b/src/Data/Patch/PatchOrReplacement.hs
index a61ddd0c..6fb44c02 100644
--- a/src/Data/Patch/PatchOrReplacement.hs
+++ b/src/Data/Patch/PatchOrReplacement.hs
@@ -56,8 +56,14 @@ traversePatchOrReplacement f g = \case
 
 -- | To apply a @'PatchOrReplacement' p@ apply the the underlying @p@ or
 -- substitute the replacement @'PatchTarget' p@.
-instance Patch p => Patch (PatchOrReplacement p) where
+instance PatchHet p => PatchHet (PatchOrReplacement p) where
+  type PatchSource (PatchOrReplacement p) = PatchSource p
   type PatchTarget (PatchOrReplacement p) = PatchTarget p
+  applyHet = \case
+    PatchOrReplacement_Patch p -> applyHet p
+    PatchOrReplacement_Replacement v -> \_ -> Right v
+
+instance Patch p => Patch (PatchOrReplacement p) where
   apply = \case
     PatchOrReplacement_Patch p -> apply p
     PatchOrReplacement_Replacement v -> \_ -> Just v