diff --git a/ChangeLog.md b/ChangeLog.md
--- a/ChangeLog.md
+++ b/ChangeLog.md
@@ -1,24 +1,35 @@
 # Revision history for patch
 
-## 0.0.4.0
+## 0.0.5.0 - 2021-12-17
 
+* `Additive` now lives in `Data.Semigroup.Additive`, but is still reexported
+  from `Data.Patch` for compatability.
+
+* Rewrite `PatchMapWithMove` in terms of `PatchMapWithPatchingMove`.
+  Care is taken to make this not a breaking change.
+  In particular, `PatchMapWithMove` is a newtype of `PatchMapWithPatchingMove`, as is the `NodeInfo` and `From` of `PatchMapWithPatchingMove`'s versions of those.
+  There are complete constructor and field patterns too, and everything is
+  exported under the newtype as real constructors and fields would be.
+
+## 0.0.4.0 - 2021-04-20
+
 * Enable PolyKinds
 
-## 0.0.3.2
+## 0.0.3.2 - 2020-11-06
 
 * Update version bounds
 
-## 0.0.3.1
+## 0.0.3.1 - 2020-02-05
 
 * Replace `fromJust` with something easier to debug.
 
-## 0.0.3.0
+## 0.0.3.0 - 2020-02-05
 
 * Create `PatchMapWithPatchingMove` variant which supports moves with a patch.
 
 * Create `DecidablyEmpty` subclass of `Monoid`.
 
-## 0.0.2.0
+## 0.0.2.0 - 2020-01-17
 
 * Consistently provide:
 
@@ -30,16 +41,16 @@
 
   for `PatchMap`, `PatchIntMap`, and `PatchMapWithMove`.
 
-## 0.0.1.0
+## 0.0.1.0 - 2020-01-09
 
 * Support older GHCs with `split-these` flag.
 
 * Additional instances for the `Group` class for basic types.
 
-## 0.0.0.1
+## 0.0.0.1 - 2020-01-08
 
 * Remove unneeded dependencies
 
-## 0.0.0.0
+## 0.0.0.0 - 2020-01-08
 
 * Extract patching functionality from Reflex.
diff --git a/patch.cabal b/patch.cabal
--- a/patch.cabal
+++ b/patch.cabal
@@ -1,5 +1,5 @@
 Name: patch
-Version: 0.0.4.0
+Version: 0.0.5.0
 Synopsis: Data structures for describing changes to other data structures.
 Description:
   Data structures for describing changes to other data structures.
@@ -41,7 +41,7 @@
                , lens >= 4.7 && < 5
                , semigroupoids >= 4.0 && < 6
                , transformers >= 0.5.6.0 && < 0.6
-               , witherable >= 0.3 && < 0.4
+               , witherable >= 0.3 && < 0.5
 
   exposed-modules: Data.Functor.Misc
                  , Data.Monoid.DecidablyEmpty
@@ -53,6 +53,7 @@
                  , Data.Patch.Map
                  , Data.Patch.MapWithMove
                  , Data.Patch.MapWithPatchingMove
+                 , Data.Semigroup.Additive
 
   ghc-options: -Wall -fwarn-redundant-constraints -fwarn-tabs
   default-extensions: PolyKinds
@@ -64,6 +65,19 @@
   else
     build-depends: these >= 0.4 && <0.9
                  , monoidal-containers == 0.4.0.0
+
+test-suite tests
+  default-language: Haskell2010
+  type: exitcode-stdio-1.0
+  main-is: tests.hs
+  hs-source-dirs: test
+  build-depends: base
+               , patch
+               , containers
+               , hedgehog
+               , HUnit
+  if impl(ghcjs)
+    buildable: False
 
 test-suite hlint
   default-language: Haskell2010
diff --git a/src/Data/Patch.hs b/src/Data/Patch.hs
--- a/src/Data/Patch.hs
+++ b/src/Data/Patch.hs
@@ -23,6 +23,7 @@
 #endif
 import GHC.Generics
 
+import Data.Semigroup.Additive as X
 import Data.Patch.Class as X
 import Data.Patch.DMap as X hiding (getDeletions)
 import Data.Patch.DMapWithMove as X
@@ -45,9 +46,6 @@
   (~~) :: q -> q -> q
   r ~~ s = r <> negateG s
 
--- | An 'Additive' 'Semigroup' is one where (<>) is commutative
-class Semigroup q => Additive q where
-
 -- | The elements of an 'Additive' 'Semigroup' can be considered as patches of their own type.
 newtype AdditivePatch p = AdditivePatch { unAdditivePatch :: p }
 
@@ -58,19 +56,15 @@
 instance (Ord k, Group q) => Group (MonoidalMap k q) where
   negateG = fmap negateG
 
-instance (Ord k, Additive q) => Additive (MonoidalMap k q)
-
 -- | Trivial group.
 instance Group () where
   negateG _ = ()
   _ ~~ _ = ()
-instance Additive ()
 
 -- | Product group.  A Pair of groups gives rise to a group
 instance (Group a, Group b) => Group (a, b) where
   negateG (a, b) = (negateG a, negateG b)
   (a, b) ~~ (c, d) = (a ~~ c, b ~~ d)
-instance (Additive a, Additive b) => Additive (a, b)
 
 -- See https://gitlab.haskell.org/ghc/ghc/issues/11135#note_111802 for the reason Compose is not also provided.
 -- Base does not define Monoid (Compose f g a) so this is the best we can
@@ -78,29 +72,24 @@
 instance Group (f (g a)) => Group ((f :.: g) a) where
   negateG (Comp1 xs) = Comp1 (negateG xs)
   Comp1 xs ~~ Comp1 ys = Comp1 (xs ~~ ys)
-instance Additive (f (g a)) => Additive ((f :.: g) a)
 
 -- | Product of groups, Functor style.
 instance (Group (f a), Group (g a)) => Group ((f :*: g) a) where
   negateG (a :*: b) = negateG a :*: negateG b
   (a :*: b) ~~ (c :*: d) = (a ~~ c) :*: (b ~~ d)
-instance (Additive (f a), Additive (g a)) => Additive ((f :*: g) a)
 
 -- | Trivial group, Functor style
 instance Group (Proxy x) where
   negateG _ = Proxy
   _ ~~ _ = Proxy
-instance Additive (Proxy x)
 
 -- | Const lifts groups into a functor.
 deriving instance Group a => Group (Const a x)
-instance Additive a => Additive (Const a x)
--- | Ideitnty lifts groups pointwise (at only one point)
+
+-- | Identity lifts groups pointwise (at only one point)
 deriving instance Group a => Group (Identity a)
-instance Additive a => Additive (Identity a)
 
 -- | Functions lift groups pointwise.
 instance Group b => Group (a -> b) where
   negateG f = negateG . f
   (~~) = liftA2 (~~)
-instance Additive b => Additive (a -> b)
diff --git a/src/Data/Patch/Class.hs b/src/Data/Patch/Class.hs
--- a/src/Data/Patch/Class.hs
+++ b/src/Data/Patch/Class.hs
@@ -1,9 +1,11 @@
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeFamilies #-}
 -- | The interface for types which represent changes made to other types
 module Data.Patch.Class where
 
 import Data.Functor.Identity
+import Data.Kind (Type)
 import Data.Maybe
 #if !MIN_VERSION_base(4,11,0)
 import Data.Semigroup (Semigroup(..))
@@ -15,7 +17,7 @@
 -- 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 PatchTarget p :: Type
   -- | Apply the patch @p a@ to the value @a@.  If no change is needed, return
   -- 'Nothing'.
   apply :: p -> PatchTarget p -> Maybe (PatchTarget p)
@@ -30,7 +32,7 @@
   apply (Identity a) _ = Just a
 
 -- | 'Proxy' can be used as a 'Patch' that does nothing.
-instance Patch (Proxy (a :: *)) where
+instance forall (a :: Type). Patch (Proxy a) where
   type PatchTarget (Proxy a) = a
   apply ~Proxy _ = Nothing
 
diff --git a/src/Data/Patch/DMapWithMove.hs b/src/Data/Patch/DMapWithMove.hs
--- a/src/Data/Patch/DMapWithMove.hs
+++ b/src/Data/Patch/DMapWithMove.hs
@@ -220,8 +220,8 @@
 -- @
 --     let aMay = DMap.lookup a dmap
 --         bMay = DMap.lookup b dmap
---     in maybe id (DMap.insert a) (bMay `mplus` aMay)
---      . maybe id (DMap.insert b) (aMay `mplus` bMay)
+--     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 -> PatchDMapWithMove k v
diff --git a/src/Data/Patch/MapWithMove.hs b/src/Data/Patch/MapWithMove.hs
--- a/src/Data/Patch/MapWithMove.hs
+++ b/src/Data/Patch/MapWithMove.hs
@@ -2,98 +2,150 @@
 {-# LANGUAGE DeriveTraversable #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE PatternGuards #-}
+{-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE ViewPatterns #-}
 
 -- | 'Patch'es on 'Map' that can insert, delete, and move values from one key to
 -- another
-module Data.Patch.MapWithMove where
+module Data.Patch.MapWithMove
+  ( PatchMapWithMove
+    ( PatchMapWithMove
+    , unPatchMapWithMove
+    , ..
+    )
+  , patchMapWithMove
+  , patchMapWithMoveInsertAll
+  , insertMapKey
+  , moveMapKey
+  , swapMapKey
+  , deleteMapKey
+  , unsafePatchMapWithMove
+  , patchMapWithMoveNewElements
+  , patchMapWithMoveNewElementsMap
+  , patchThatSortsMapWith
+  , patchThatChangesAndSortsMapWith
+  , patchThatChangesMap
 
+  -- * Node Info
+  , NodeInfo
+    ( NodeInfo
+    , _nodeInfo_to
+    , _nodeInfo_from
+    , ..
+    )
+  , bitraverseNodeInfo
+  , nodeInfoMapFrom
+  , nodeInfoMapMFrom
+  , nodeInfoSetTo
+
+  -- * From
+  , From
+    ( From_Insert
+    , From_Delete
+    , From_Move
+    , ..
+    )
+  , bitraverseFrom
+
+  -- * To
+  , To
+  ) where
+
+import Data.Coerce
+import Data.Kind (Type)
 import Data.Patch.Class
+import Data.Patch.MapWithPatchingMove (PatchMapWithPatchingMove(..), To)
+import qualified Data.Patch.MapWithPatchingMove as PM -- already a transparent synonym
 
-import Control.Arrow
-import Control.Lens hiding (from, to)
-import Control.Monad.Trans.State
-import Data.Foldable
-import Data.Function
+import Control.Lens
 import Data.List
 import Data.Map (Map)
 import qualified Data.Map as Map
-import Data.Maybe
+import Data.Proxy
 #if !MIN_VERSION_base(4,11,0)
 import Data.Semigroup (Semigroup (..))
 #endif
-import qualified Data.Set as Set
-import Data.These (These(..))
-import Data.Tuple
+import Data.Traversable (foldMapDefault)
 
 -- | Patch a Map with additions, deletions, and moves.  Invariant: If key @k1@
 -- is coming from @From_Move k2@, then key @k2@ should be going to @Just k1@,
 -- and vice versa.  There should never be any unpaired From/To keys.
-newtype PatchMapWithMove k v = PatchMapWithMove
-  { -- | Extract the internal representation of the 'PatchMapWithMove'
-    unPatchMapWithMove :: Map k (NodeInfo k v)
+newtype PatchMapWithMove k (v :: Type) = PatchMapWithMove'
+  { -- | Extract the underlying 'PatchMapWithPatchingMove k (Proxy v)'
+    unPatchMapWithMove' :: PatchMapWithPatchingMove k (Proxy v)
   }
   deriving ( Show, Read, Eq, Ord
-           , Functor, Foldable, Traversable
+-- Haddock cannot handle documentation here before GHC 8.6
+           ,
+#if __GLASGOW_HASKELL__ >= 806
+             -- | Compose patches having the same effect as applying the
+             -- patches in turn: @'applyAlways' (p <> q) == 'applyAlways' p .
+             -- 'applyAlways' q@
+#endif
+             Semigroup
+           , Monoid
            )
 
--- | Holds the information about each key: where its new value should come from,
--- and where its old value should go to
-data NodeInfo k v = NodeInfo
-  { _nodeInfo_from :: !(From k v)
-    -- ^ Where do we get the new value for this key?
-  , _nodeInfo_to :: !(To k)
-    -- ^ If the old value is being kept (i.e. moved rather than deleted or
-    -- replaced), where is it going?
-  }
-  deriving (Show, Read, Eq, Ord, Functor, Foldable, Traversable)
+pattern Coerce :: Coercible a b => a -> b
+pattern Coerce x <- (coerce -> x)
+  where Coerce x = coerce x
 
--- | Describe how a key's new value should be produced
-data From k v
-   = From_Insert v -- ^ Insert the given value here
-   | From_Delete -- ^ Delete the existing value, if any, from here
-   | From_Move !k -- ^ Move the value here from the given key
-   deriving (Show, Read, Eq, Ord, Functor, Foldable, Traversable)
+{-# COMPLETE PatchMapWithMove #-}
+pattern PatchMapWithMove :: Map k (NodeInfo k v) -> PatchMapWithMove k v
+-- | Extract the representation of the 'PatchMapWithMove' as a map of
+-- 'NodeInfo'.
+unPatchMapWithMove :: PatchMapWithMove k v -> Map k (NodeInfo k v)
+pattern PatchMapWithMove { unPatchMapWithMove } = PatchMapWithMove' (PatchMapWithPatchingMove (Coerce unPatchMapWithMove))
 
--- | Describe where a key's old value will go.  If this is 'Just', that means
--- the key's old value will be moved to the given other key; if it is 'Nothing',
--- that means it will be deleted.
-type To = Maybe
+_PatchMapWithMove
+  :: Iso
+       (PatchMapWithMove k0 v0)
+       (PatchMapWithMove k1 v1)
+       (Map k0 (NodeInfo k0 v0))
+       (Map k1 (NodeInfo k1 v1))
+_PatchMapWithMove = iso unPatchMapWithMove PatchMapWithMove
 
-makeWrapped ''PatchMapWithMove
+instance Functor (PatchMapWithMove k) where
+  fmap f = runIdentity . traverse (Identity . f)
 
+instance Foldable (PatchMapWithMove k) where
+  foldMap = foldMapDefault
+
+instance Traversable (PatchMapWithMove k) where
+  traverse =
+    _PatchMapWithMove .
+    traverse .
+    traverse
+
 instance FunctorWithIndex k (PatchMapWithMove k)
 instance FoldableWithIndex k (PatchMapWithMove k)
 instance TraversableWithIndex k (PatchMapWithMove k) where
   itraverse = itraversed . Indexed
-  itraversed = _Wrapped .> itraversed <. traversed
+  itraversed =
+    _PatchMapWithMove .>
+    itraversed <.
+    traverse
 
 -- | Create a 'PatchMapWithMove', validating it
 patchMapWithMove :: Ord k => Map k (NodeInfo k v) -> Maybe (PatchMapWithMove k v)
-patchMapWithMove m = if valid then Just $ PatchMapWithMove m else Nothing
-  where valid = forwardLinks == backwardLinks
-        forwardLinks = Map.mapMaybe _nodeInfo_to m
-        backwardLinks = Map.fromList $ catMaybes $ flip fmap (Map.toList m) $ \(to, v) ->
-          case _nodeInfo_from v of
-            From_Move from -> Just (from, to)
-            _ -> Nothing
+patchMapWithMove = fmap PatchMapWithMove' . PM.patchMapWithPatchingMove . coerce
 
 -- | Create a 'PatchMapWithMove' that inserts everything in the given 'Map'
 patchMapWithMoveInsertAll :: Map k v -> PatchMapWithMove k v
-patchMapWithMoveInsertAll m = PatchMapWithMove $ flip fmap m $ \v -> NodeInfo
-  { _nodeInfo_from = From_Insert v
-  , _nodeInfo_to = Nothing
-  }
+patchMapWithMoveInsertAll = PatchMapWithMove' . PM.patchMapWithPatchingMoveInsertAll
 
 -- | Make a @'PatchMapWithMove' k v@ which has the effect of inserting or updating a value @v@ to the given key @k@, like 'Map.insert'.
 insertMapKey :: k -> v -> PatchMapWithMove k v
-insertMapKey k v = PatchMapWithMove . Map.singleton k $ NodeInfo (From_Insert v) Nothing
+insertMapKey k v = PatchMapWithMove' $ PM.insertMapKey k v
 
 -- |Make a @'PatchMapWithMove' k v@ which has the effect of moving the value from the first key @k@ to the second key @k@, equivalent to:
 --
@@ -101,84 +153,53 @@
 --     'Map.delete' src (maybe map ('Map.insert' dst) (Map.lookup src map))
 -- @
 moveMapKey :: Ord k => k -> k -> PatchMapWithMove k v
-moveMapKey src dst
-  | src == dst = mempty
-  | otherwise =
-      PatchMapWithMove $ Map.fromList
-        [ (dst, NodeInfo (From_Move src) Nothing)
-        , (src, NodeInfo From_Delete (Just dst))
-        ]
+moveMapKey src dst = PatchMapWithMove' $ PM.moveMapKey src dst
 
 -- |Make a @'PatchMapWithMove' k v@ which has the effect of swapping two keys in the mapping, equivalent to:
 --
 -- @
 --     let aMay = Map.lookup a map
 --         bMay = Map.lookup b map
---     in maybe id (Map.insert a) (bMay `mplus` aMay)
---      . maybe id (Map.insert b) (aMay `mplus` bMay)
+--     in maybe id (Map.insert a) (bMay <> aMay)
+--      . maybe id (Map.insert b) (aMay <> bMay)
 --      . Map.delete a . Map.delete b $ map
 -- @
 swapMapKey :: Ord k => k -> k -> PatchMapWithMove k v
-swapMapKey src dst
-  | src == dst = mempty
-  | otherwise =
-    PatchMapWithMove $ Map.fromList
-      [ (dst, NodeInfo (From_Move src) (Just src))
-      , (src, NodeInfo (From_Move dst) (Just dst))
-      ]
+swapMapKey src dst = PatchMapWithMove' $ PM.swapMapKey src dst
 
 -- |Make a @'PatchMapWithMove' k v@ which has the effect of deleting a key in the mapping, equivalent to 'Map.delete'.
 deleteMapKey :: k -> PatchMapWithMove k v
-deleteMapKey k = PatchMapWithMove . Map.singleton k $ NodeInfo From_Delete Nothing
+deleteMapKey = PatchMapWithMove' . PM.deleteMapKey
 
 -- | Wrap a @'Map' k (NodeInfo k v)@ representing patch changes into a @'PatchMapWithMove' k v@, without checking any invariants.
 --
 -- __Warning:__ when using this function, you must ensure that the invariants of 'PatchMapWithMove' are preserved; they will not be checked.
 unsafePatchMapWithMove :: Map k (NodeInfo k v) -> PatchMapWithMove k v
-unsafePatchMapWithMove = PatchMapWithMove
+unsafePatchMapWithMove = coerce PM.unsafePatchMapWithPatchingMove
 
 -- | Apply the insertions, deletions, and moves to a given 'Map'
 instance Ord k => Patch (PatchMapWithMove k v) where
   type PatchTarget (PatchMapWithMove k v) = Map k v
-  apply (PatchMapWithMove 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 = flip Map.mapMaybeWithKey p $ \_ ni -> case _nodeInfo_from ni of
-            From_Insert v -> Just v
-            From_Move k -> Map.lookup k old
-            From_Delete -> Nothing
-          deletions = flip Map.mapMaybeWithKey p $ \_ ni -> case _nodeInfo_from ni of
-            From_Delete -> Just ()
-            _ -> Nothing
+  apply (PatchMapWithMove' p) = apply p
 
 -- | Returns all the new elements that will be added to the 'Map'.
 patchMapWithMoveNewElements :: PatchMapWithMove k v -> [v]
-patchMapWithMoveNewElements = Map.elems . patchMapWithMoveNewElementsMap
+patchMapWithMoveNewElements = PM.patchMapWithPatchingMoveNewElements . unPatchMapWithMove'
 
 -- | Return a @'Map' k v@ with all the inserts/updates from the given @'PatchMapWithMove' k v@.
 patchMapWithMoveNewElementsMap :: PatchMapWithMove k v -> Map k v
-patchMapWithMoveNewElementsMap (PatchMapWithMove p) = Map.mapMaybe f p
-  where f ni = case _nodeInfo_from ni of
-          From_Insert v -> Just v
-          From_Move _ -> Nothing
-          From_Delete -> Nothing
+patchMapWithMoveNewElementsMap = PM.patchMapWithPatchingMoveNewElementsMap . unPatchMapWithMove'
 
 -- | Create a 'PatchMapWithMove' that, if applied to the given 'Map', will sort
 -- its values using the given ordering function.  The set keys of the 'Map' is
 -- not changed.
 patchThatSortsMapWith :: Ord k => (v -> v -> Ordering) -> Map k v -> PatchMapWithMove k v
-patchThatSortsMapWith cmp m = PatchMapWithMove $ Map.fromList $ catMaybes $ zipWith g unsorted sorted
-  where unsorted = Map.toList m
-        sorted = sortBy (cmp `on` snd) unsorted
-        f (to, _) (from, _) = if to == from then Nothing else
-          Just (from, to)
-        reverseMapping = Map.fromList $ catMaybes $ zipWith f unsorted sorted
-        g (to, _) (from, _) = if to == from then Nothing else
-          let Just movingTo = Map.lookup to reverseMapping
-          in Just (to, NodeInfo (From_Move from) $ Just movingTo)
+patchThatSortsMapWith cmp = PatchMapWithMove' . PM.patchThatSortsMapWith cmp
 
 -- | Create a 'PatchMapWithMove' that, if applied to the first 'Map' provided,
 -- will produce a 'Map' with the same values as the second 'Map' but with the
 -- values sorted with the given ordering function.
-patchThatChangesAndSortsMapWith :: forall k v. (Ord k, Ord v) => (v -> v -> Ordering) -> Map k v -> Map k v -> PatchMapWithMove k v
+patchThatChangesAndSortsMapWith :: (Ord k, Ord v) => (v -> v -> Ordering) -> Map k v -> Map k v -> PatchMapWithMove k v
 patchThatChangesAndSortsMapWith cmp oldByIndex newByIndexUnsorted = patchThatChangesMap oldByIndex newByIndex
   where newList = Map.toList newByIndexUnsorted
         newByIndex = Map.fromList $ zip (fst <$> newList) $ sortBy cmp $ snd <$> newList
@@ -186,104 +207,106 @@
 -- | Create a 'PatchMapWithMove' that, if applied to the first 'Map' provided,
 -- will produce the second 'Map'.
 patchThatChangesMap :: (Ord k, Ord v) => Map k v -> Map k v -> PatchMapWithMove k v
-patchThatChangesMap oldByIndex newByIndex = patch
-  where oldByValue = Map.fromListWith Set.union $ swap . first Set.singleton <$> Map.toList oldByIndex
-        (insertsAndMoves, unusedValuesByValue) = flip runState oldByValue $ do
-          let f k v = do
-                remainingValues <- get
-                let putRemainingKeys remainingKeys = put $ if Set.null remainingKeys
-                      then Map.delete v remainingValues
-                      else Map.insert v remainingKeys remainingValues
-                case Map.lookup v remainingValues of
-                  Nothing -> return $ NodeInfo (From_Insert v) $ Just undefined -- There's no existing value we can take
-                  Just fromKs ->
-                    if k `Set.member` fromKs
-                    then do
-                      putRemainingKeys $ Set.delete k fromKs
-                      return $ NodeInfo (From_Move k) $ Just undefined -- There's an existing value, and it's here, so no patch necessary
-                    else do
-                      (fromK, remainingKeys) <- return $
-                        fromMaybe (error "PatchMapWithMove.patchThatChangesMap: impossible: fromKs was empty") $
-                        Set.minView fromKs -- There's an existing value, but it's not here; move it here
-                      putRemainingKeys remainingKeys
-                      return $ NodeInfo (From_Move fromK) $ Just undefined
-          Map.traverseWithKey f newByIndex
-        unusedOldKeys = fold unusedValuesByValue
-        pointlessMove k = \case
-          From_Move k' | k == k' -> True
-          _ -> False
-        keyWasMoved k = if k `Map.member` oldByIndex && not (k `Set.member` unusedOldKeys)
-          then Just undefined
-          else Nothing
-        patch = unsafePatchMapWithMove $ Map.filterWithKey (\k -> not . pointlessMove k . _nodeInfo_from) $ Map.mergeWithKey (\k a _ -> Just $ nodeInfoSetTo (keyWasMoved k) a) (Map.mapWithKey $ \k -> nodeInfoSetTo $ keyWasMoved k) (Map.mapWithKey $ \k _ -> NodeInfo From_Delete $ keyWasMoved k) insertsAndMoves oldByIndex
+patchThatChangesMap oldByIndex newByIndex = PatchMapWithMove' $
+  PM.patchThatChangesMap oldByIndex newByIndex
 
+--
+-- NodeInfo
+--
+
+-- | Holds the information about each key: where its new value should come from,
+-- and where its old value should go to
+newtype NodeInfo k (v :: Type) = NodeInfo' { unNodeInfo' :: PM.NodeInfo k (Proxy v) }
+
+deriving instance (Show k, Show p) => Show (NodeInfo k p)
+deriving instance (Read k, Read p) => Read (NodeInfo k p)
+deriving instance (Eq k, Eq p) => Eq (NodeInfo k p)
+deriving instance (Ord k, Ord p) => Ord (NodeInfo k p)
+
+{-# COMPLETE NodeInfo #-}
+pattern NodeInfo :: To k -> From k v -> NodeInfo k v
+_nodeInfo_to :: NodeInfo k v -> To k
+_nodeInfo_from :: NodeInfo k v -> From k v
+pattern NodeInfo { _nodeInfo_to, _nodeInfo_from } = NodeInfo'
+  PM.NodeInfo
+    { PM._nodeInfo_to = _nodeInfo_to
+    , PM._nodeInfo_from = Coerce _nodeInfo_from
+    }
+
+_NodeInfo
+  :: Iso
+       (NodeInfo k0 v0)
+       (NodeInfo k1 v1)
+       (PM.NodeInfo k0 (Proxy v0))
+       (PM.NodeInfo k1 (Proxy v1))
+_NodeInfo = iso unNodeInfo' NodeInfo'
+
+instance Functor (NodeInfo k) where
+  fmap f = runIdentity . traverse (Identity . f)
+
+instance Foldable (NodeInfo k) where
+  foldMap = foldMapDefault
+
+instance Traversable (NodeInfo k) where
+  traverse = bitraverseNodeInfo pure
+
+bitraverseNodeInfo
+  :: Applicative f
+  => (k0 -> f k1)
+  -> (v0 -> f v1)
+  -> NodeInfo k0 v0 -> f (NodeInfo k1 v1)
+bitraverseNodeInfo fk fv = fmap NodeInfo'
+  . PM.bitraverseNodeInfo fk (\ ~Proxy -> pure Proxy) fv
+  . coerce
+
 -- | Change the 'From' value of a 'NodeInfo'
 nodeInfoMapFrom :: (From k v -> From k v) -> NodeInfo k v -> NodeInfo k v
-nodeInfoMapFrom f ni = ni { _nodeInfo_from = f $ _nodeInfo_from ni }
+nodeInfoMapFrom f = coerce $ PM.nodeInfoMapFrom (unFrom' . f . From')
 
 -- | Change the 'From' value of a 'NodeInfo', using a 'Functor' (or
 -- 'Applicative', 'Monad', etc.) action to get the new value
-nodeInfoMapMFrom :: Functor f => (From k v -> f (From k v)) -> NodeInfo k v -> f (NodeInfo k v)
-nodeInfoMapMFrom f ni = fmap (\result -> ni { _nodeInfo_from = result }) $ f $ _nodeInfo_from ni
+nodeInfoMapMFrom
+  :: Functor f
+  => (From k v -> f (From k v))
+  -> NodeInfo k v -> f (NodeInfo k v)
+nodeInfoMapMFrom f = fmap NodeInfo'
+  . PM.nodeInfoMapMFrom (fmap unFrom' . f . From')
+  . coerce
 
 -- | Set the 'To' field of a 'NodeInfo'
 nodeInfoSetTo :: To k -> NodeInfo k v -> NodeInfo k v
-nodeInfoSetTo to ni = ni { _nodeInfo_to = to }
+nodeInfoSetTo = coerce . PM.nodeInfoSetTo
 
--- |Helper data structure used for composing patches using the monoid instance.
-data Fixup k v
-   = Fixup_Delete
-   | Fixup_Update (These (From k v) (To k))
+--
+-- From
+--
 
--- |Compose patches having the same effect as applying the patches in turn: @'applyAlways' (p <> q) == 'applyAlways' p . 'applyAlways' q@
-instance Ord k => Semigroup (PatchMapWithMove k v) where
-  PatchMapWithMove ma <> PatchMapWithMove mb = PatchMapWithMove m
-    where
-      connections = Map.toList $ Map.intersectionWithKey (\_ a b -> (_nodeInfo_to a, _nodeInfo_from b)) ma mb
-      h :: (k, (Maybe k, From k v)) -> [(k, Fixup k v)]
-      h (_, (mToAfter, editBefore)) = case (mToAfter, editBefore) of
-        (Just toAfter, From_Move fromBefore)
-          | fromBefore == toAfter
-            -> [(toAfter, Fixup_Delete)]
-          | otherwise
-            -> [ (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
-        (Just toAfter, _) -> [(toAfter, Fixup_Update (This editBefore))]
-        (Nothing, _) -> []
-      mergeFixups _ Fixup_Delete Fixup_Delete = Fixup_Delete
-      mergeFixups _ (Fixup_Update a) (Fixup_Update b)
-        | This x <- a, That y <- b
-        = Fixup_Update $ These x y
-        | That y <- a, This x <- b
-        = Fixup_Update $ These x y
-      mergeFixups _ _ _ = error "PatchMapWithMove: incompatible fixups"
-      fixups = Map.fromListWithKey mergeFixups $ concatMap h connections
-      combineNodeInfos _ nia nib = NodeInfo
-        { _nodeInfo_from = _nodeInfo_from nia
-        , _nodeInfo_to = _nodeInfo_to nib
-        }
-      applyFixup _ ni = \case
-        Fixup_Delete -> Nothing
-        Fixup_Update u -> Just $ NodeInfo
-          { _nodeInfo_from = fromMaybe (_nodeInfo_from ni) $ getHere u
-          , _nodeInfo_to = fromMaybe (_nodeInfo_to ni) $ getThere u
-          }
-      m = Map.differenceWithKey applyFixup (Map.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
+-- | Describe how a key's new value should be produced
+newtype From k (v :: Type) = From' { unFrom' :: PM.From k (Proxy v) }
 
---TODO: Figure out how to implement this in terms of PatchDMapWithMove rather than duplicating it here
--- |Compose patches having the same effect as applying the patches in turn: @'applyAlways' (p <> q) == 'applyAlways' p . 'applyAlways' q@
-instance Ord k => Monoid (PatchMapWithMove k v) where
-  mempty = PatchMapWithMove mempty
-  mappend = (<>)
+{-# COMPLETE From_Insert, From_Delete, From_Move #-}
+
+-- | Insert the given value here
+pattern From_Insert :: v -> From k v
+pattern From_Insert v = From' (PM.From_Insert v)
+
+-- | Delete the existing value, if any, from here
+pattern From_Delete :: From k v
+pattern From_Delete = From' PM.From_Delete
+
+-- | Move the value here from the given key
+pattern From_Move :: k -> From k v
+pattern From_Move k = From' (PM.From_Move k Proxy)
+
+bitraverseFrom
+  :: Applicative f
+  => (k0 -> f k1)
+  -> (v0 -> f v1)
+  -> From k0 v0 -> f (From k1 v1)
+bitraverseFrom fk fv = fmap From'
+  . PM.bitraverseFrom fk (\ ~Proxy -> pure Proxy) fv
+  . coerce
+
+makeWrapped ''PatchMapWithMove
+makeWrapped ''NodeInfo
+makeWrapped ''From
diff --git a/src/Data/Patch/MapWithPatchingMove.hs b/src/Data/Patch/MapWithPatchingMove.hs
--- a/src/Data/Patch/MapWithPatchingMove.hs
+++ b/src/Data/Patch/MapWithPatchingMove.hs
@@ -13,14 +13,45 @@
 
 -- | 'Patch'es on 'Map' that can insert, delete, and move values from one key to
 -- another
-module Data.Patch.MapWithPatchingMove where
+module Data.Patch.MapWithPatchingMove
+  ( PatchMapWithPatchingMove (..)
+  , patchMapWithPatchingMove
+  , patchMapWithPatchingMoveInsertAll
+  , insertMapKey
+  , moveMapKey
+  , swapMapKey
+  , deleteMapKey
+  , unsafePatchMapWithPatchingMove
+  , patchMapWithPatchingMoveNewElements
+  , patchMapWithPatchingMoveNewElementsMap
+  , patchThatSortsMapWith
+  , patchThatChangesAndSortsMapWith
+  , patchThatChangesMap
 
+  -- * Node Info
+  , NodeInfo (..)
+  , bitraverseNodeInfo
+  , nodeInfoMapFrom
+  , nodeInfoMapMFrom
+  , nodeInfoSetTo
+
+  -- * From
+  , From(..)
+  , bitraverseFrom
+
+  -- * To
+  , To
+
+  -- TODO internals module
+  , Fixup (..)
+  ) where
+
 import Data.Patch.Class
 
-import Control.Arrow
+import Control.Lens hiding (from, to)
 import Control.Lens.TH (makeWrapped)
-import Control.Monad.Trans.State
-import Data.Foldable
+import Data.Align (align)
+import Data.Foldable (toList)
 import Data.Function
 import Data.List
 import Data.Map (Map)
@@ -30,9 +61,9 @@
 import Data.Semigroup (Semigroup (..))
 #endif
 import Data.Monoid.DecidablyEmpty
+import Data.Set (Set)
 import qualified Data.Set as Set
 import Data.These (These (..))
-import Data.Tuple
 
 -- | Patch a Map with additions, deletions, and moves.  Invariant: If key @k1@
 -- is coming from @From_Move k2@, then key @k2@ should be going to @Just k1@,
@@ -55,57 +86,6 @@
                   , Patch p
                   ) => DecidablyEmpty (PatchMapWithPatchingMove k p)
 
--- | Holds the information about each key: where its new value should come from,
--- and where its old value should go to
-data NodeInfo k p = NodeInfo
-  { _nodeInfo_from :: !(From k p)
-    -- ^ Where do we get the new value for this key?
-  , _nodeInfo_to :: !(To k)
-    -- ^ If the old value is being kept (i.e. moved rather than deleted or
-    -- replaced), where is it going?
-  }
-deriving instance (Show k, Show p, Show (PatchTarget p)) => Show (NodeInfo k p)
-deriving instance (Read k, Read p, Read (PatchTarget p)) => Read (NodeInfo k p)
-deriving instance (Eq k, Eq p, Eq (PatchTarget p)) => Eq (NodeInfo k p)
-deriving instance (Ord k, Ord p, Ord (PatchTarget p)) => Ord (NodeInfo k p)
-
-bitraverseNodeInfo
-  :: Applicative f
-  => (k0 -> f k1)
-  -> (p0 -> f p1)
-  -> (PatchTarget p0 -> f (PatchTarget p1))
-  -> NodeInfo k0 p0 -> f (NodeInfo k1 p1)
-bitraverseNodeInfo fk fp fpt (NodeInfo from to) = NodeInfo
-  <$> bitraverseFrom fk fp fpt from
-  <*> traverse fk to
-
--- | Describe how a key's new value should be produced
-data From k p
-   = From_Insert (PatchTarget p) -- ^ Insert the given value here
-   | From_Delete -- ^ Delete the existing value, if any, from here
-   | From_Move !k !p -- ^ Move the value here from the given key, and apply the given patch
-
-bitraverseFrom
-  :: Applicative f
-  => (k0 -> f k1)
-  -> (p0 -> f p1)
-  -> (PatchTarget p0 -> f (PatchTarget p1))
-  -> From k0 p0 -> f (From k1 p1)
-bitraverseFrom fk fp fpt = \case
-  From_Insert pt -> From_Insert <$> fpt pt
-  From_Delete -> pure From_Delete
-  From_Move k p -> From_Move <$> fk k <*> fp p
-
-deriving instance (Show k, Show p, Show (PatchTarget p)) => Show (From k p)
-deriving instance (Read k, Read p, Read (PatchTarget p)) => Read (From k p)
-deriving instance (Eq k, Eq p, Eq (PatchTarget p)) => Eq (From k p)
-deriving instance (Ord k, Ord p, Ord (PatchTarget p)) => Ord (From k p)
-
--- | Describe where a key's old value will go.  If this is 'Just', that means
--- the key's old value will be moved to the given other key; if it is 'Nothing',
--- that means it will be deleted.
-type To = Maybe
-
 -- | Create a 'PatchMapWithPatchingMove', validating it
 patchMapWithPatchingMove
   :: Ord k => Map k (NodeInfo k p) -> Maybe (PatchMapWithPatchingMove k p)
@@ -156,8 +136,8 @@
 -- @
 --     let aMay = Map.lookup a map
 --         bMay = Map.lookup b map
---     in maybe id (Map.insert a) (bMay `mplus` aMay)
---      . maybe id (Map.insert b) (aMay `mplus` bMay)
+--     in maybe id (Map.insert a) (bMay <> aMay)
+--      . maybe id (Map.insert b) (aMay <> bMay)
 --      . Map.delete a . Map.delete b $ map
 -- @
 swapMapKey
@@ -249,40 +229,71 @@
 
 -- | Create a 'PatchMapWithPatchingMove' that, if applied to the first 'Map' provided,
 -- will produce the second 'Map'.
+-- Note: this will never produce a patch on a value.
 patchThatChangesMap
-  :: (Ord k, Ord (PatchTarget p), Monoid p)
+  :: forall k p
+  .  (Ord k, Ord (PatchTarget p), Monoid p)
   => Map k (PatchTarget p) -> Map k (PatchTarget p) -> PatchMapWithPatchingMove k p
 patchThatChangesMap oldByIndex newByIndex = patch
-  where oldByValue = Map.fromListWith Set.union $ swap . first Set.singleton <$> Map.toList oldByIndex
-        (insertsAndMoves, unusedValuesByValue) = flip runState oldByValue $ do
-          let f k v = do
-                remainingValues <- get
-                let putRemainingKeys remainingKeys = put $ if Set.null remainingKeys
-                      then Map.delete v remainingValues
-                      else Map.insert v remainingKeys remainingValues
-                case Map.lookup v remainingValues of
-                  Nothing -> return $ NodeInfo (From_Insert v) $ Just undefined -- There's no existing value we can take
-                  Just fromKs ->
-                    if k `Set.member` fromKs
-                    then do
-                      putRemainingKeys $ Set.delete k fromKs
-                      return $ NodeInfo (From_Move k mempty) $ Just undefined -- There's an existing value, and it's here, so no patch necessary
-                    else do
-                      (fromK, remainingKeys) <- return $
-                        fromMaybe (error "PatchMapWithPatchingMove.patchThatChangesMap: impossible: fromKs was empty") $
-                        Set.minView fromKs -- There's an existing value, but it's not here; move it here
-                      putRemainingKeys remainingKeys
-                      return $ NodeInfo (From_Move fromK mempty) $ Just undefined
-          Map.traverseWithKey f newByIndex
-        unusedOldKeys = fold unusedValuesByValue
-        pointlessMove k = \case
-          From_Move k' _ | k == k' -> True
-          _ -> False
-        keyWasMoved k = if k `Map.member` oldByIndex && not (k `Set.member` unusedOldKeys)
-          then Just undefined
-          else Nothing
-        patch = unsafePatchMapWithPatchingMove $ Map.filterWithKey (\k -> not . pointlessMove k . _nodeInfo_from) $ Map.mergeWithKey (\k a _ -> Just $ nodeInfoSetTo (keyWasMoved k) a) (Map.mapWithKey $ \k -> nodeInfoSetTo $ keyWasMoved k) (Map.mapWithKey $ \k _ -> NodeInfo From_Delete $ keyWasMoved k) insertsAndMoves oldByIndex
+  where invert :: Map k (PatchTarget p) -> Map (PatchTarget p) (Set k)
+        invert = Map.fromListWith (<>) . fmap (\(k, v) -> (v, Set.singleton k)) . Map.toList
+        -- In the places where we use unionDistinct, a non-distinct key indicates a bug in this function
+        unionDistinct :: forall k' v'. Ord k' => Map k' v' -> Map k' v' -> Map k' v'
+        unionDistinct = Map.unionWith (error "patchThatChangesMap: non-distinct keys")
+        unionPairDistinct :: (Map k (From k v), Map k (To k)) -> (Map k (From k v), Map k (To k)) -> (Map k (From k v), Map k (To k))
+        unionPairDistinct (oldFroms, oldTos) (newFroms, newTos) = (unionDistinct oldFroms newFroms, unionDistinct oldTos newTos)
+        -- Generate patch info for a single value
+        -- Keys that are found in both the old and new sets will not be patched
+        -- Keys that are found in only the old set will be moved to a new position if any are available; otherwise they will be deleted
+        -- Keys that are found in only the new set will be populated by moving an old key if any are available; otherwise they will be inserted
+        patchSingleValue :: PatchTarget p -> Set k -> Set k -> (Map k (From k p), Map k (To k))
+        patchSingleValue v oldKeys newKeys = foldl' unionPairDistinct mempty $ align (toList $ oldKeys `Set.difference` newKeys) (toList $ newKeys `Set.difference` oldKeys) <&> \case
+          This oldK -> (mempty, Map.singleton oldK Nothing) -- There's nowhere for this value to go, so we know we are deleting it
+          That newK -> (Map.singleton newK $ From_Insert v, mempty) -- There's nowhere fo this value to come from, so we know we are inserting it
+          These oldK newK -> (Map.singleton newK $ From_Move oldK mempty, Map.singleton oldK $ Just newK)
+        -- Run patchSingleValue on a These.  Missing old or new sets are considered empty
+        patchSingleValueThese :: PatchTarget p -> These (Set k) (Set k) -> (Map k (From k p), Map k (To k))
+        patchSingleValueThese v = \case
+          This oldKeys -> patchSingleValue v oldKeys mempty
+          That newKeys -> patchSingleValue v mempty newKeys
+          These oldKeys newKeys -> patchSingleValue v oldKeys newKeys
+        -- Generate froms and tos for all values, then merge them together
+        (froms, tos) = foldl' unionPairDistinct mempty $ Map.mapWithKey patchSingleValueThese $ align (invert oldByIndex) (invert newByIndex)
+        patch = unsafePatchMapWithPatchingMove $ align froms tos <&> \case
+          This from -> NodeInfo from Nothing -- Since we don't have a 'to' record for this key, that must mean it isn't being moved anywhere, so it should be deleted.
+          That to -> NodeInfo From_Delete to -- Since we don't have a 'from' record for this key, it must be getting deleted
+          These from to -> NodeInfo from to
 
+--
+-- NodeInfo
+--
+
+-- | Holds the information about each key: where its new value should come from,
+-- and where its old value should go to
+data NodeInfo k p = NodeInfo
+  { _nodeInfo_from :: !(From k p)
+    -- ^ Where do we get the new value for this key?
+  , _nodeInfo_to :: !(To k)
+    -- ^ If the old value is being kept (i.e. moved rather than deleted or
+    -- replaced), where is it going?
+  }
+deriving instance (Show k, Show p, Show (PatchTarget p)) => Show (NodeInfo k p)
+deriving instance (Read k, Read p, Read (PatchTarget p)) => Read (NodeInfo k p)
+deriving instance (Eq k, Eq p, Eq (PatchTarget p)) => Eq (NodeInfo k p)
+deriving instance (Ord k, Ord p, Ord (PatchTarget p)) => Ord (NodeInfo k p)
+
+-- | Traverse the 'NodeInfo' over the key, patch, and patch target. Because of
+-- the type families here, this doesn't it any bi- or tri-traversal class.
+bitraverseNodeInfo
+  :: Applicative f
+  => (k0 -> f k1)
+  -> (p0 -> f p1)
+  -> (PatchTarget p0 -> f (PatchTarget p1))
+  -> NodeInfo k0 p0 -> f (NodeInfo k1 p1)
+bitraverseNodeInfo fk fp fpt (NodeInfo from to) = NodeInfo
+  <$> bitraverseFrom fk fp fpt from
+  <*> traverse fk to
+
 -- | Change the 'From' value of a 'NodeInfo'
 nodeInfoMapFrom
   :: (From k v -> From k v) -> NodeInfo k v -> NodeInfo k v
@@ -298,6 +309,47 @@
 nodeInfoSetTo
   :: To k -> NodeInfo k v -> NodeInfo k v
 nodeInfoSetTo to ni = ni { _nodeInfo_to = to }
+
+--
+-- From
+--
+
+-- | Describe how a key's new value should be produced
+data From k p
+   = From_Insert (PatchTarget p) -- ^ Insert the given value here
+   | From_Delete -- ^ Delete the existing value, if any, from here
+   | From_Move !k !p -- ^ Move the value here from the given key, and apply the given patch
+
+deriving instance (Show k, Show p, Show (PatchTarget p)) => Show (From k p)
+deriving instance (Read k, Read p, Read (PatchTarget p)) => Read (From k p)
+deriving instance (Eq k, Eq p, Eq (PatchTarget p)) => Eq (From k p)
+deriving instance (Ord k, Ord p, Ord (PatchTarget p)) => Ord (From k p)
+
+-- | Traverse the 'From' over the key, patch, and patch target. Because of
+-- the type families here, this doesn't it any bi- or tri-traversal class.
+bitraverseFrom
+  :: Applicative f
+  => (k0 -> f k1)
+  -> (p0 -> f p1)
+  -> (PatchTarget p0 -> f (PatchTarget p1))
+  -> From k0 p0 -> f (From k1 p1)
+bitraverseFrom fk fp fpt = \case
+  From_Insert pt -> From_Insert <$> fpt pt
+  From_Delete -> pure From_Delete
+  From_Move k p -> From_Move <$> fk k <*> fp p
+
+--
+-- To
+--
+
+-- | Describe where a key's old value will go.  If this is 'Just', that means
+-- the key's old value will be moved to the given other key; if it is 'Nothing',
+-- that means it will be deleted.
+type To = Maybe
+
+--
+-- Fixup
+--
 
 -- | Helper data structure used for composing patches using the monoid instance.
 data Fixup k v
diff --git a/src/Data/Semigroup/Additive.hs b/src/Data/Semigroup/Additive.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Semigroup/Additive.hs
@@ -0,0 +1,52 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE TypeFamilies #-}
+-- |
+-- Module:
+--   Data.Semigroup.Additive
+-- Description:
+--   This module defines a class for commutative semigroups, until it is moved
+--   to another library.
+module Data.Semigroup.Additive
+  ( Additive
+  ) where
+
+import Data.Functor.Const (Const (..))
+import Data.Functor.Identity
+-- For base-orphans, TODO don't cheat.
+import Data.Map.Monoidal ()
+import Data.Proxy
+#if !MIN_VERSION_base(4,11,0)
+import Data.Semigroup (Semigroup (..))
+#endif
+import GHC.Generics
+
+-- | An 'Additive' 'Semigroup' is one where (<>) is commutative
+class Semigroup q => Additive q where
+
+-- | Trivial additive semigroup.
+instance Additive ()
+
+-- | Product additive semigroup.
+-- A Pair of additive semigroups gives rise to a additive semigroup
+instance (Additive a, Additive b) => Additive (a, b)
+
+-- See https://gitlab.haskell.org/ghc/ghc/issues/11135#note_111802 for the reason Compose is not also provided.
+-- Base does not define Monoid (Compose f g a) so this is the best we can
+-- really do for functor composition.
+instance Additive (f (g a)) => Additive ((f :.: g) a)
+
+-- | Product of additive semigroups, Functor style.
+instance (Additive (f a), Additive (g a)) => Additive ((f :*: g) a)
+
+-- | Trivial additive semigroup, Functor style
+instance Additive (Proxy x)
+
+-- | Const lifts additive semigroups into a functor.
+instance Additive a => Additive (Const a x)
+
+-- | Identity lifts additive semigroups pointwise (at only one point)
+instance Additive a => Additive (Identity a)
+
+-- | Functions lift additive semigroups pointwise.
+instance Additive b => Additive (a -> b)
diff --git a/test/tests.hs b/test/tests.hs
new file mode 100644
--- /dev/null
+++ b/test/tests.hs
@@ -0,0 +1,43 @@
+{-# LANGUAGE TemplateHaskell #-}
+module Main where
+
+import Test.HUnit (runTestTT, (~:), assertEqual, errors, failures, test)
+import Data.Patch ( Patch(apply) )
+import Data.Patch.MapWithMove ( patchThatChangesMap )
+import Data.Map as Map ( Map, fromList, singleton )
+import Hedgehog (checkParallel, discover, Property, property, forAll, PropertyT, (===))
+import Hedgehog.Gen as Gen ( int )
+import Hedgehog.Range as Range ( linear )
+import Control.Monad (replicateM)
+import System.Exit (exitFailure, exitSuccess)
+import Data.Sequence as Seq ( foldMapWithIndex, replicateM )
+
+main :: IO ()
+main = do
+   counts <- runTestTT $ test [
+      "Simple Move" ~: (do
+         let mapBefore = Map.fromList [(0,1)]
+             mapAfter = Map.fromList [(0,0),(1,1)]
+             patch = patchThatChangesMap mapBefore mapAfter
+             afterPatch = apply patch mapBefore
+         assertEqual "Patch creates the same Map" (Just mapAfter) afterPatch),
+      "Property Checks" ~: propertyChecks
+    ]
+   if errors counts + failures counts == 0 then exitSuccess else exitFailure
+
+propertyChecks :: IO Bool
+propertyChecks = checkParallel $$(discover)
+
+prop_patchThatChangesMap :: Property
+prop_patchThatChangesMap = property $ do
+   mapBefore <- makeRandomIntMap
+   mapAfter <- makeRandomIntMap
+   let patch = patchThatChangesMap mapBefore mapAfter
+   Just mapAfter === apply patch mapBefore
+
+makeRandomIntMap :: Monad m => PropertyT m (Map Int Int)
+makeRandomIntMap = do
+   let genNum = Gen.int (Range.linear 0 100)
+   length <- forAll genNum
+   listOfNumbers <- forAll $ Seq.replicateM length genNum
+   pure $ Seq.foldMapWithIndex Map.singleton listOfNumbers