diff --git a/ChangeLog.md b/ChangeLog.md
--- a/ChangeLog.md
+++ b/ChangeLog.md
@@ -1,5 +1,19 @@
 # Revision history for reflex
 
+## 0.6.4
+
+* Support GHC 8.8
+
+* Add `Reflex.Query.Base.mapQueryT`. See that module for documentation
+
+* The `Reflex.Patch.*` modules were moved to the `patch` library.
+  They are `Data.Patch.*` there, but reexported under their old names for backwards compatability here.
+
+* Additional instances for `Query` classes for basic types.
+
+* Add cabal flags `debug-propagation` and `debug-event-cycles` to build in debugging
+  code for performance and for cyclic dependencies between events
+
 ## 0.6.3
 
 * `Data.WeakBag.traverse` and `Data.FastWeakBag.traverse` have been deprecated.
diff --git a/reflex.cabal b/reflex.cabal
--- a/reflex.cabal
+++ b/reflex.cabal
@@ -1,5 +1,5 @@
 Name: reflex
-Version: 0.6.3
+Version: 0.6.4
 Synopsis: Higher-order Functional Reactive Programming
 Description: Reflex is a high-performance, deterministic, higher-order Functional Reactive Programming system
 License: BSD3
@@ -9,7 +9,7 @@
 Stability: Experimental
 Category: FRP
 Build-type: Simple
-Cabal-version: >=1.9.2
+Cabal-version: 1.22
 homepage: https://reflex-frp.org
 bug-reports: https://github.com/reflex-frp/reflex/issues
 extra-source-files:
@@ -18,7 +18,7 @@
   ChangeLog.md
 
 tested-with:
-  GHC  ==8.0.2 || ==8.2.2 || ==8.4.4 || ==8.6.5,
+  GHC  ==8.0.2 || ==8.2.2 || ==8.4.4 || ==8.6.5 || ==8.8.1,
   GHCJS ==8.4
 
 flag use-reflex-optimizer
@@ -41,16 +41,27 @@
   default: False
   manual: True
 
+flag debug-propagation
+  description: Enable debugging of spider internals
+  default: False
+  manual: True
+
+flag debug-cycles
+  description: Enable debugging of event cycles
+  default: False
+  manual: True
+
 flag split-these
   description: Use split these/semialign packages
   manual:      False
   default:     True
 
 library
+  default-language: Haskell2010
   hs-source-dirs: src
   build-depends:
     MemoTrie == 0.6.*,
-    base >= 4.9 && < 4.13,
+    base >= 4.9 && < 4.14,
     bifunctors >= 5.2 && < 5.6,
     comonad >= 5.0.4 && < 5.1,
     constraints-extras >= 0.3 && < 0.4,
@@ -61,16 +72,17 @@
     lens >= 4.7 && < 5,
     monad-control >= 1.0.1 && < 1.1,
     mtl >= 2.1 && < 2.3,
+    patch >= 0.0.1 && < 0.1,
     prim-uniq >= 0.1.0.1 && < 0.2,
     primitive >= 0.5 && < 0.8,
-    profunctors >= 5.3 && < 5.5,
+    profunctors >= 5.3 && < 5.6,
     random == 1.1.*,
     ref-tf == 0.4.*,
     reflection == 2.1.*,
     semigroupoids >= 4.0 && < 6,
     stm >= 2.4 && < 2.6,
     syb >= 0.5 && < 0.8,
-    time >= 1.4 && < 1.9,
+    time >= 1.4 && < 1.10,
     transformers >= 0.5.6.0 && < 0.6,
     unbounded-delays >= 0.1.0.0 && < 0.2,
     witherable >= 0.3 && < 0.3.2
@@ -88,7 +100,6 @@
     Data.AppendMap,
     Data.FastMutableIntMap,
     Data.FastWeakBag,
-    Data.Functor.Misc,
     Data.Map.Misc,
     Data.WeakBag,
     Reflex,
@@ -110,13 +121,6 @@
     Reflex.Host.Class,
     Reflex.Network,
     Reflex.NotReady.Class,
-    Reflex.Patch,
-    Reflex.Patch.Class,
-    Reflex.Patch.DMap,
-    Reflex.Patch.DMapWithMove,
-    Reflex.Patch.IntMap,
-    Reflex.Patch.Map,
-    Reflex.Patch.MapWithMove,
     Reflex.PerformEvent.Base,
     Reflex.PerformEvent.Class,
     Reflex.PostBuild.Base,
@@ -135,6 +139,16 @@
     Reflex.Widget.Basic,
     Reflex.Workflow
 
+  reexported-modules:
+    patch:Data.Functor.Misc,
+    patch:Data.Patch as Reflex.Patch,
+    patch:Data.Patch.Class as Reflex.Patch.Class,
+    patch:Data.Patch.DMap as Reflex.Patch.DMap,
+    patch:Data.Patch.DMapWithMove as Reflex.Patch.DMapWithMove,
+    patch:Data.Patch.IntMap as Reflex.Patch.IntMap,
+    patch:Data.Patch.Map as Reflex.Patch.Map,
+    patch:Data.Patch.MapWithMove as Reflex.Patch.MapWithMove
+
   ghc-options: -Wall -fwarn-redundant-constraints -fwarn-tabs -funbox-strict-fields -O2 -fspecialise-aggressively
 
   if flag(debug-trace-events)
@@ -146,13 +160,19 @@
     build-depends: ghc
     exposed-modules: Reflex.Optimizer
 
+  if flag(debug-propagation)
+    cpp-options: -DDEBUG -DDEBUG_TRACE_PROPAGATION -DDEBUG_TRACE_INVALIDATION
+
+  if flag(debug-cycles)
+    cpp-options: -DDEBUG_CYCLES
+
   if flag(use-template-haskell)
     cpp-options: -DUSE_TEMPLATE_HASKELL
     build-depends:
       dependent-sum >= 0.6 && < 0.7,
-      haskell-src-exts >= 1.16 && < 1.22,
+      haskell-src-exts >= 1.16 && < 1.23,
       haskell-src-meta >= 0.6 && < 0.9,
-      template-haskell >= 2.9 && < 2.15
+      template-haskell >= 2.9 && < 2.16
     exposed-modules:
       Reflex.Dynamic.TH
     other-extensions: TemplateHaskell
@@ -167,6 +187,7 @@
     build-depends: ghcjs-base
 
 test-suite semantics
+  default-language: Haskell2010
   type: exitcode-stdio-1.0
   main-is: semantics.hs
   hs-source-dirs: test
@@ -192,6 +213,7 @@
     Reflex.TestPlan
 
 test-suite CrossImpl
+  default-language: Haskell2010
   type: exitcode-stdio-1.0
   main-is: Reflex/Test/CrossImpl.hs
   hs-source-dirs: test
@@ -213,6 +235,7 @@
     Reflex.Plan.Pure
 
 test-suite hlint
+  default-language: Haskell2010
   type: exitcode-stdio-1.0
   main-is: hlint.hs
   hs-source-dirs: test
@@ -225,6 +248,7 @@
     buildable: False
 
 test-suite EventWriterT
+  default-language: Haskell2010
   type: exitcode-stdio-1.0
   main-is: EventWriterT.hs
   hs-source-dirs: test
@@ -244,30 +268,59 @@
     build-depends: these-lens
 
   other-modules:
-    Reflex.Test
-    Reflex.TestPlan
-    Reflex.Plan.Reflex
-    Reflex.Plan.Pure
     Test.Run
 
 
-test-suite RequesterT
+test-suite DebugCycles
+  default-language: Haskell2010
   type: exitcode-stdio-1.0
-  main-is: RequesterT.hs
+  main-is: DebugCycles.hs
   hs-source-dirs: test
+  ghc-options: -threaded
   build-depends: base
                , containers
                , deepseq
-               , dependent-sum
                , dependent-map
+               , dependent-sum
+               , hspec
                , lens
                , mtl
                , these
                , transformers
                , reflex
                , ref-tf
+               , witherable
+               , proctest
 
+
   if flag(split-these)
+    build-depends: these-lens, semialign
+
+  other-modules:
+    Test.Run
+
+
+test-suite RequesterT
+  default-language: Haskell2010
+  type: exitcode-stdio-1.0
+  main-is: RequesterT.hs
+  hs-source-dirs: test
+  build-depends: base
+               , constraints
+               , constraints-extras
+               , containers
+               , deepseq
+               , dependent-map
+               , dependent-sum
+               , lens
+               , mtl
+               , ref-tf
+               , reflex
+               , text
+               , these
+               , transformers
+
+  if flag(split-these)
     build-depends: these-lens
 
   other-modules:
@@ -275,7 +328,23 @@
     Reflex.Plan.Pure
     Test.Run
 
+test-suite Adjustable
+  default-language: Haskell2010
+  type: exitcode-stdio-1.0
+  main-is: Adjustable.hs
+  hs-source-dirs: test
+  build-depends: base
+               , containers
+               , dependent-sum
+               , reflex
+               , ref-tf
+               , these
+
+  other-modules:
+    Test.Run
+
 test-suite QueryT
+  default-language: Haskell2010
   type: exitcode-stdio-1.0
   main-is: QueryT.hs
   hs-source-dirs: test
@@ -287,6 +356,7 @@
                , lens
                , monoidal-containers
                , mtl
+               , patch
                , ref-tf
                , reflex
                , these
@@ -302,6 +372,7 @@
     Reflex.Plan.Pure
 
 test-suite GC-Semantics
+  default-language: Haskell2010
   type: exitcode-stdio-1.0
   main-is: GC.hs
   hs-source-dirs: test
@@ -311,6 +382,7 @@
                , dependent-map
                , deepseq
                , mtl
+               , patch
                , these
                , transformers
                , reflex
@@ -326,6 +398,7 @@
     Test.Run
 
 test-suite rootCleanup
+  default-language: Haskell2010
   type: exitcode-stdio-1.0
   main-is: rootCleanup.hs
   hs-source-dirs: test
@@ -343,6 +416,7 @@
     Test.Run
 
 benchmark spider-bench
+  default-language: Haskell2010
   type: exitcode-stdio-1.0
   hs-source-dirs: bench test
   main-is: Main.hs
@@ -367,6 +441,7 @@
     Reflex.Bench.Focused
 
 benchmark saulzar-bench
+  default-language: Haskell2010
   type: exitcode-stdio-1.0
   hs-source-dirs: bench test
   c-sources: bench-cbits/checkCapability.c
diff --git a/src/Data/AppendMap.hs b/src/Data/AppendMap.hs
--- a/src/Data/AppendMap.hs
+++ b/src/Data/AppendMap.hs
@@ -71,7 +71,7 @@
        then Nothing
        else Just bs
 
--- TODO: Move instances to `Reflex.Patch`
+-- TODO: Move instances to `Data.Patch`
 -- | Displays a 'MonoidalMap' as a tree. See 'Data.Map.Lazy.showTree' for details.
 showTree :: forall k a. (Show k, Show a) => MonoidalMap k a -> String
 showTree = coerce (Map.showTree :: Map k a -> String)
diff --git a/src/Data/FastMutableIntMap.hs b/src/Data/FastMutableIntMap.hs
--- a/src/Data/FastMutableIntMap.hs
+++ b/src/Data/FastMutableIntMap.hs
@@ -21,6 +21,7 @@
   , patchIntMapNewElements
   , patchIntMapNewElementsMap
   , getDeletions
+  , toList
   ) where
 
 --TODO: Pure JS version
@@ -34,8 +35,8 @@
 import Data.IntMap.Strict (IntMap)
 import qualified Data.IntMap.Strict as IntMap
 import Data.IORef
-import Reflex.Patch.Class
-import Reflex.Patch.IntMap
+import Data.Patch.Class
+import Data.Patch.IntMap
 
 -- | A 'FastMutableIntMap' holds a map of values of type @a@ and allows low-overhead modifications via IO.
 -- Operations on 'FastMutableIntMap' run in IO.
@@ -84,10 +85,13 @@
   writeIORef r IntMap.empty
   return result
 
--- | Updates the value of a 'FastMutableIntMap' with the given patch (see 'Reflex.Patch.IntMap'),
+-- | Updates the value of a 'FastMutableIntMap' with the given patch (see 'Data.Patch.IntMap'),
 -- and returns an 'IntMap' with the modified keys and values.
 applyPatch :: FastMutableIntMap a -> PatchIntMap a -> IO (IntMap a)
 applyPatch (FastMutableIntMap r) p@(PatchIntMap m) = do
   v <- readIORef r
   writeIORef r $! applyAlways p v
   return $ IntMap.intersection v m
+
+toList :: FastMutableIntMap a -> IO [(Int, a)]
+toList (FastMutableIntMap r) = IntMap.toList <$> readIORef r
diff --git a/src/Data/Functor/Misc.hs b/src/Data/Functor/Misc.hs
deleted file mode 100644
--- a/src/Data/Functor/Misc.hs
+++ /dev/null
@@ -1,234 +0,0 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE DeriveFunctor #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE GADTs #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE PatternSynonyms #-}
-{-# LANGUAGE PolyKinds #-}
-{-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE StandaloneDeriving #-}
-#ifdef USE_REFLEX_OPTIMIZER
-{-# OPTIONS_GHC -fplugin=Reflex.Optimizer #-}
-#endif
--- | This module provides types and functions with no particular theme, but
--- which are relevant to the use of 'Functor'-based datastructures like
--- 'Data.Dependent.Map.DMap'.
-module Data.Functor.Misc
-  ( -- * Const2
-    Const2 (..)
-  , unConst2
-  , dmapToMap
-  , dmapToIntMap
-  , dmapToMapWith
-  , mapToDMap
-  , weakenDMapWith
-    -- * WrapArg
-  , WrapArg (..)
-    -- * Convenience functions for DMap
-  , mapWithFunctorToDMap
-  , intMapWithFunctorToDMap
-  , mapKeyValuePairsMonotonic
-  , combineDMapsWithKey
-  , EitherTag (..)
-  , dmapToThese
-  , eitherToDSum
-  , dsumToEither
-  , ComposeMaybe (..)
-  ) where
-
-import Control.Applicative ((<$>))
-import Control.Monad.Identity
-import Data.Dependent.Map (DMap)
-import qualified Data.Dependent.Map as DMap
-import Data.Dependent.Sum
-import Data.GADT.Compare
-import Data.GADT.Show
-import Data.IntMap (IntMap)
-import qualified Data.IntMap as IntMap
-import Data.Map (Map)
-import qualified Data.Map as Map
-import Data.Some (Some(Some))
-import Data.These
-import Data.Typeable hiding (Refl)
-
---------------------------------------------------------------------------------
--- Const2
---------------------------------------------------------------------------------
-
--- | 'Const2' stores a value of a given type 'k' and ensures that a particular
--- type 'v' is always given for the last type parameter
-data Const2 :: * -> x -> x -> * 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)
-
-instance Show k => GShow (Const2 k v) where
-  gshowsPrec n x@(Const2 _) = showsPrec n x
-
-instance Eq k => GEq (Const2 k v) where
-  geq (Const2 a) (Const2 b) =
-    if a == b
-    then Just Refl
-    else Nothing
-
-instance Ord k => GCompare (Const2 k v) where
-  gcompare (Const2 a) (Const2 b) = case compare a b of
-    LT -> GLT
-    EQ -> GEQ
-    GT -> GGT
-
--- | 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
-
--- | Convert a 'DMap' to an 'IntMap'
-dmapToIntMap :: DMap (Const2 IntMap.Key v) Identity -> IntMap v
-dmapToIntMap = IntMap.fromDistinctAscList . map (\(Const2 k :=> Identity v) -> (k, v)) . DMap.toAscList
-
--- | Convert a 'DMap' to a regular 'Map', applying the given function to remove
--- the wrapping 'Functor'
-dmapToMapWith :: (f v -> v') -> DMap (Const2 k v) f -> Map k v'
-dmapToMapWith f = Map.fromDistinctAscList . map (\(Const2 k :=> v) -> (k, f v)) . DMap.toAscList
-
--- | Convert a regular 'Map' to a 'DMap'
-mapToDMap :: Map k v -> DMap (Const2 k v) Identity
-mapToDMap = DMap.fromDistinctAscList . map (\(k, v) -> Const2 k :=> Identity v) . Map.toAscList
-
--- | Convert a regular 'Map', where the values are already wrapped in a functor,
--- to a 'DMap'
-mapWithFunctorToDMap :: Map k (f v) -> DMap (Const2 k v) f
-mapWithFunctorToDMap = DMap.fromDistinctAscList . map (\(k, v) -> Const2 k :=> v) . Map.toAscList
-
--- | Convert a regular 'IntMap', where the values are already wrapped in a
--- functor, to a 'DMap'
-intMapWithFunctorToDMap :: IntMap (f v) -> DMap (Const2 IntMap.Key v) f
-intMapWithFunctorToDMap = DMap.fromDistinctAscList . map (\(k, v) -> Const2 k :=> v) . IntMap.toAscList
-
--- | Convert a 'DMap' to a regular 'Map' by forgetting the types associated with
--- the keys, using a function to remove the wrapping 'Functor'
-weakenDMapWith :: (forall a. v a -> v') -> DMap k v -> Map (Some k) v'
-weakenDMapWith f = Map.fromDistinctAscList . map (\(k :=> v) -> (Some k, f v)) . DMap.toAscList
-
---------------------------------------------------------------------------------
--- WrapArg
---------------------------------------------------------------------------------
-
--- | 'WrapArg' can be used to tag a value in one functor with a type
--- representing another functor.  This was primarily used with dependent-map <
--- 0.2, in which the value type was not wrapped in a separate functor.
-data WrapArg :: (k -> *) -> (k -> *) -> * -> * where
-  WrapArg :: f a -> WrapArg g f (g a)
-
-deriving instance Eq (f a) => Eq (WrapArg g f (g' a))
-deriving instance Ord (f a) => Ord (WrapArg g f (g' a))
-deriving instance Show (f a) => Show (WrapArg g f (g' a))
-deriving instance Read (f a) => Read (WrapArg g f (g a))
-
-instance GEq f => GEq (WrapArg g f) where
-  geq (WrapArg a) (WrapArg b) = (\Refl -> Refl) <$> geq a b
-
-instance GCompare f => GCompare (WrapArg g f) where
-  gcompare (WrapArg a) (WrapArg b) = case gcompare a b of
-    GLT -> GLT
-    GEQ -> GEQ
-    GGT -> GGT
-
---------------------------------------------------------------------------------
--- Convenience functions for DMap
---------------------------------------------------------------------------------
-
--- | Map over all key/value pairs in a 'DMap', potentially altering the key as
--- well as the value.  The provided function MUST preserve the ordering of the
--- keys, or the resulting 'DMap' will be malformed.
-mapKeyValuePairsMonotonic :: (DSum k v -> DSum k' v') -> DMap k v -> DMap k' v'
-mapKeyValuePairsMonotonic f = DMap.fromDistinctAscList . map f . DMap.toAscList
-
-{-# INLINE combineDMapsWithKey #-}
--- | Union two 'DMap's of different types, yielding another type.  Each key that
--- is present in either input map will be present in the output.
-combineDMapsWithKey :: forall f g h i.
-                       GCompare f
-                    => (forall a. f a -> These (g a) (h a) -> i a)
-                    -> DMap f g
-                    -> DMap f h
-                    -> DMap f i
-combineDMapsWithKey f mg mh = DMap.fromList $ go (DMap.toList mg) (DMap.toList mh)
-  where go :: [DSum f g] -> [DSum f h] -> [DSum f i]
-        go [] hs = map (\(hk :=> hv) -> hk :=> f hk (That hv)) hs
-        go gs [] = map (\(gk :=> gv) -> gk :=> f gk (This gv)) gs
-        go gs@((gk :=> gv) : gs') hs@((hk :=> hv) : hs') = case gk `gcompare` hk of
-          GLT -> (gk :=> f gk (This gv)) : go gs' hs
-          GEQ -> (gk :=> f gk (These gv hv)) : go gs' hs'
-          GGT -> (hk :=> f hk (That hv)) : go gs hs'
-
--- | Extract the values of a 'DMap' of 'EitherTag's.
-dmapToThese :: DMap (EitherTag a b) Identity -> Maybe (These a b)
-dmapToThese m = case (DMap.lookup LeftTag m, DMap.lookup RightTag m) of
-  (Nothing, Nothing) -> Nothing
-  (Just (Identity a), Nothing) -> Just $ This a
-  (Nothing, Just (Identity b)) -> Just $ That b
-  (Just (Identity a), Just (Identity b)) -> Just $ These a b
-
--- | Tag type for 'Either' to use it as a 'DSum'.
-data EitherTag l r a where
-  LeftTag :: EitherTag l r l
-  RightTag :: EitherTag l r r
-  deriving (Typeable)
-
-deriving instance Show (EitherTag l r a)
-deriving instance Eq (EitherTag l r a)
-deriving instance Ord (EitherTag l r a)
-
-instance GEq (EitherTag l r) where
-  geq a b = case (a, b) of
-    (LeftTag, LeftTag) -> Just Refl
-    (RightTag, RightTag) -> Just Refl
-    _ -> Nothing
-
-instance GCompare (EitherTag l r) where
-  gcompare a b = case (a, b) of
-    (LeftTag, LeftTag) -> GEQ
-    (LeftTag, RightTag) -> GLT
-    (RightTag, LeftTag) -> GGT
-    (RightTag, RightTag) -> GEQ
-
-instance GShow (EitherTag l r) where
-  gshowsPrec _ a = case a of
-    LeftTag -> showString "LeftTag"
-    RightTag -> showString "RightTag"
-
--- | Convert 'Either' to a 'DSum'. Inverse of 'dsumToEither'.
-eitherToDSum :: Either a b -> DSum (EitherTag a b) Identity
-eitherToDSum = \case
-  Left a -> (LeftTag :=> Identity a)
-  Right b -> (RightTag :=> Identity b)
-
--- | Convert 'DSum' to 'Either'. Inverse of 'eitherToDSum'.
-dsumToEither :: DSum (EitherTag a b) Identity -> Either a b
-dsumToEither = \case
-  (LeftTag :=> Identity a) -> Left a
-  (RightTag :=> Identity b) -> Right b
-
---------------------------------------------------------------------------------
--- ComposeMaybe
---------------------------------------------------------------------------------
-
--- | We can't use @Compose Maybe@ instead of 'ComposeMaybe', because that would
--- make the 'f' parameter have a nominal type role.  We need f to be
--- representational so that we can use safe 'coerce'.
-newtype ComposeMaybe f a =
-  ComposeMaybe { getComposeMaybe :: Maybe (f a) } deriving (Show, Eq, Ord)
-
-deriving instance Functor f => Functor (ComposeMaybe f)
diff --git a/src/Data/Map/Misc.hs b/src/Data/Map/Misc.hs
--- a/src/Data/Map/Misc.hs
+++ b/src/Data/Map/Misc.hs
@@ -43,7 +43,7 @@
 
 -- |Given a @'Map' k (Maybe v)@ representing keys to insert/update (@Just@) or delete (@Nothing@), produce a new map from the given input @'Map' k v@.
 --
--- See also 'Reflex.Patch.Map' and 'Reflex.Patch.MapWithMove'.
+-- See also 'Data.Patch.Map' and 'Data.Patch.MapWithMove'.
 applyMap :: Ord k => Map k (Maybe v) -> Map k v -> Map k v
 applyMap patch old = insertions `Map.union` (old `Map.difference` deletions)
   where (deletions, insertions) = Map.mapEither maybeToEither patch
diff --git a/src/Reflex/Adjustable/Class.hs b/src/Reflex/Adjustable/Class.hs
--- a/src/Reflex/Adjustable/Class.hs
+++ b/src/Reflex/Adjustable/Class.hs
@@ -39,7 +39,7 @@
 import Data.Map (Map)
 
 import Reflex.Class
-import Reflex.Patch.DMapWithMove
+import Data.Patch.DMapWithMove
 
 -- | A 'Monad' that supports adjustment over time.  After an action has been
 -- run, if the given events fire, it will adjust itself so that its net effect
diff --git a/src/Reflex/Class.hs b/src/Reflex/Class.hs
--- a/src/Reflex/Class.hs
+++ b/src/Reflex/Class.hs
@@ -29,7 +29,7 @@
 --   convenience functions for working with 'Event's, 'Behavior's, and other
 --   signals.
 module Reflex.Class
-  ( module Reflex.Patch
+  ( module Data.Patch
     -- * Primitives
   , Reflex (..)
   , mergeInt
@@ -200,7 +200,7 @@
 import qualified Data.Dependent.Map as DMap
 import Data.Functor.Compose
 import Data.Functor.Product
-import Data.GADT.Compare (GEq (..), GCompare (..), (:~:) (..))
+import Data.GADT.Compare (GEq (..), GCompare (..))
 import Data.FastMutableIntMap (PatchIntMap)
 import Data.Foldable
 import Data.Functor.Bind
@@ -210,17 +210,18 @@
 import qualified Data.IntMap.Strict as IntMap
 import Data.List.NonEmpty (NonEmpty (..))
 import Data.Map (Map)
-import Data.Semigroup (Semigroup, sconcat, stimes, (<>))
+import Data.Semigroup (Semigroup (..))
 import Data.Some (Some(Some))
 import Data.String
 import Data.These
 import Data.Type.Coercion
+import Data.Type.Equality ((:~:) (..))
 import Data.Witherable (Filterable(..))
 import qualified Data.Witherable as W
 import Reflex.FunctorMaybe (FunctorMaybe)
 import qualified Reflex.FunctorMaybe
-import Reflex.Patch
-import qualified Reflex.Patch.MapWithMove as PatchMapWithMove
+import Data.Patch
+import qualified Data.Patch.MapWithMove as PatchMapWithMove
 
 import Debug.Trace (trace)
 
@@ -286,7 +287,8 @@
   -- | Create an 'Event' that will occur whenever the currently-selected input
   -- 'Event' occurs
   switch :: Behavior t (Event t a) -> Event t a
-  -- | Create an 'Event' that will occur whenever the input event is occurring -- and its occurrence value, another 'Event', is also occurring
+  -- | Create an 'Event' that will occur whenever the input event is occurring -- and its occurrence value, another 'Event', is also occurring.
+  --   You maybe looking for '@switchHold@ @never@' instead.
   coincidence :: Event t (Event t a) -> Event t a
   -- | Extract the 'Behavior' of a 'Dynamic'.
   current :: Dynamic t a -> Behavior t a
@@ -662,7 +664,9 @@
   a >>= f = pull $ sample a >>= sample . f
   -- Note: it is tempting to write (_ >> b = b); however, this would result in (fail x >> return y) succeeding (returning y), which violates the law that (a >> b = a >>= \_ -> b), since the implementation of (>>=) above actually will fail.  Since we can't examine 'Behavior's other than by using sample, I don't think it's possible to write (>>) to be more efficient than the (>>=) above.
   return = constant
+#if !MIN_VERSION_base(4,13,0)
   fail = error "Monad (Behavior t) does not support fail"
+#endif
 
 instance (Reflex t, Monoid a) => Monoid (Behavior t a) where
   mempty = constant mempty
diff --git a/src/Reflex/Dynamic.hs b/src/Reflex/Dynamic.hs
--- a/src/Reflex/Dynamic.hs
+++ b/src/Reflex/Dynamic.hs
@@ -87,11 +87,12 @@
 import Data.Dependent.Map (DMap)
 import qualified Data.Dependent.Map as DMap
 import Data.Dependent.Sum (DSum (..))
-import Data.GADT.Compare ((:~:) (..), GCompare (..), GEq (..), GOrdering (..))
+import Data.GADT.Compare (GCompare (..), GEq (..), GOrdering (..))
 import Data.Map (Map)
 import Data.Maybe
 import Data.Monoid ((<>))
 import Data.These
+import Data.Type.Equality ((:~:) (..))
 
 import Debug.Trace
 
diff --git a/src/Reflex/DynamicWriter/Base.hs b/src/Reflex/DynamicWriter/Base.hs
--- a/src/Reflex/DynamicWriter/Base.hs
+++ b/src/Reflex/DynamicWriter/Base.hs
@@ -44,7 +44,7 @@
 import Reflex.DynamicWriter.Class
 import Reflex.EventWriter.Class (EventWriter, tellEvent)
 import Reflex.Host.Class
-import qualified Reflex.Patch.MapWithMove as MapWithMove
+import qualified Data.Patch.MapWithMove as MapWithMove
 import Reflex.PerformEvent.Class
 import Reflex.PostBuild.Class
 import Reflex.Query.Class
diff --git a/src/Reflex/Patch.hs b/src/Reflex/Patch.hs
deleted file mode 100644
--- a/src/Reflex/Patch.hs
+++ /dev/null
@@ -1,46 +0,0 @@
-{-# LANGUAGE TypeFamilies #-}
--- |
--- Module:
---   Reflex.Patch
--- Description:
---   This module defines the 'Patch' class, which is used by Reflex to manage
---   changes to 'Reflex.Class.Incremental' values.
-module Reflex.Patch
-  ( module Reflex.Patch
-  , module X
-  ) where
-
-import Reflex.Patch.Class as X
-import Reflex.Patch.DMap as X hiding (getDeletions)
-import Reflex.Patch.DMapWithMove as X (PatchDMapWithMove, const2PatchDMapWithMoveWith, mapPatchDMapWithMove,
-                                       patchDMapWithMoveToPatchMapWithMoveWith,
-                                       traversePatchDMapWithMoveWithKey, unPatchDMapWithMove,
-                                       unsafePatchDMapWithMove, weakenPatchDMapWithMoveWith)
-import Reflex.Patch.IntMap as X hiding (getDeletions)
-import Reflex.Patch.Map as X
-import Reflex.Patch.MapWithMove as X (PatchMapWithMove, patchMapWithMoveNewElements,
-                                      patchMapWithMoveNewElementsMap, unPatchMapWithMove,
-                                      unsafePatchMapWithMove)
-import Data.Map.Monoidal (MonoidalMap)
-import Data.Semigroup (Semigroup (..), (<>))
-
--- | A 'Group' is a 'Monoid' where every element has an inverse.
-class (Semigroup q, Monoid q) => Group q where
-  negateG :: q -> q
-  (~~) :: 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 }
-
-instance Additive p => Patch (AdditivePatch p) where
-  type PatchTarget (AdditivePatch p) = p
-  apply (AdditivePatch p) q = Just $ p <> q
-
-instance (Ord k, Group q) => Group (MonoidalMap k q) where
-  negateG = fmap negateG
-
-instance (Ord k, Additive q) => Additive (MonoidalMap k q)
diff --git a/src/Reflex/Patch/Class.hs b/src/Reflex/Patch/Class.hs
deleted file mode 100644
--- a/src/Reflex/Patch/Class.hs
+++ /dev/null
@@ -1,34 +0,0 @@
-{-# LANGUAGE TypeFamilies #-}
--- | The interface for types which represent changes made to other types
-module Reflex.Patch.Class where
-
-import Control.Monad.Identity
-import Data.Maybe
-import Data.Semigroup (Semigroup(..))
-
--- | 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 :: *
-  -- | Apply the patch @p a@ to the value @a@.  If no change is needed, return
-  -- 'Nothing'.
-  apply :: p -> PatchTarget p -> Maybe (PatchTarget p)
-
--- | Apply a 'Patch'; if it does nothing, return the original value
-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
-  type PatchTarget (Identity a) = a
-  apply (Identity a) _ = Just a
-
--- | 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 g f a =
-  let fp = f a
-  in g (applyAlways fp a) <> fp
diff --git a/src/Reflex/Patch/DMap.hs b/src/Reflex/Patch/DMap.hs
deleted file mode 100644
--- a/src/Reflex/Patch/DMap.hs
+++ /dev/null
@@ -1,82 +0,0 @@
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE PolyKinds #-}
-{-# LANGUAGE Rank2Types #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE StandaloneDeriving #-}
-{-# LANGUAGE TypeFamilies #-}
--- | 'Patch'es on 'DMap' that consist only of insertions (or overwrites) and deletions.
-module Reflex.Patch.DMap where
-
-import Reflex.Patch.Class
-import Reflex.Patch.IntMap
-import Reflex.Patch.Map
-
-import Data.Dependent.Map (DMap, DSum (..), GCompare (..))
-import qualified Data.Dependent.Map as DMap
-import Data.Functor.Constant
-import Data.Functor.Misc
-import qualified Data.IntMap as IntMap
-import qualified Data.Map as Map
-import Data.Semigroup (Semigroup (..))
-import Data.Some (Some)
-
--- | A set of changes to a 'DMap'.  Any element may be inserted/updated or deleted.
--- Insertions are represented as @'ComposeMaybe' (Just value)@,
--- while deletions are represented as @'ComposeMaybe' Nothing@.
-newtype PatchDMap k v = PatchDMap { unPatchDMap :: DMap k (ComposeMaybe v) }
-
-deriving instance GCompare k => Semigroup (PatchDMap k v)
-
-deriving instance GCompare k => Monoid (PatchDMap k v)
-
--- | Apply the insertions or deletions to a given 'DMap'.
-instance GCompare k => Patch (PatchDMap k v) where
-  type PatchTarget (PatchDMap k v) = DMap k v
-  apply (PatchDMap 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
-          nothingToJust = \case
-            Nothing -> Just $ Constant ()
-            Just _ -> Nothing
-
--- | Map a function @v a -> v' a@ over any inserts/updates in the given
--- @'PatchDMap' k v@ to produce a @'PatchDMap' k v'@.
-mapPatchDMap :: (forall a. v a -> v' a) -> PatchDMap k v -> PatchDMap k v'
-mapPatchDMap f (PatchDMap p) = PatchDMap $ DMap.map (ComposeMaybe . fmap f . getComposeMaybe) p
-
--- | Map an effectful function @v a -> f (v' a)@ over any inserts/updates in the given
--- @'PatchDMap' k v@ to produce a @'PatchDMap' k v'@.
-traversePatchDMap :: Applicative f => (forall a. v a -> f (v' a)) -> PatchDMap k v -> f (PatchDMap k v')
-traversePatchDMap f = traversePatchDMapWithKey $ const f
-
--- | Map an effectful function @k a -> v a -> f (v' a)@ over any inserts/updates
--- in the given @'PatchDMap' k v@ to produce a @'PatchDMap' k v'@.
-traversePatchDMapWithKey :: Applicative m => (forall a. k a -> v a -> m (v' a)) -> PatchDMap k v -> m (PatchDMap k v')
-traversePatchDMapWithKey f (PatchDMap p) = PatchDMap <$> DMap.traverseWithKey (\k (ComposeMaybe v) -> ComposeMaybe <$> traverse (f k) v) p
-
--- | Weaken a @'PatchDMap' k v@ to a @'PatchMap' (Some k) v'@ using a function
--- @v a -> v'@ to weaken each value contained in the patch.
-weakenPatchDMapWith :: (forall a. v a -> v') -> PatchDMap k v -> PatchMap (Some k) v'
-weakenPatchDMapWith f (PatchDMap p) = PatchMap $ weakenDMapWith (fmap f . getComposeMaybe) p
-
--- | Convert a weak @'PatchDMap' ('Const2' k a) v@ where the @a@ is known by way of
--- the @Const2@ into a @'PatchMap' k v'@ using a rank 1 function @v a -> v'@.
-patchDMapToPatchMapWith :: (v a -> v') -> PatchDMap (Const2 k a) v -> PatchMap k v'
-patchDMapToPatchMapWith f (PatchDMap p) = PatchMap $ dmapToMapWith (fmap f . getComposeMaybe) p
-
--- | Convert a @'PatchMap' k v@ into a @'PatchDMap' ('Const2' k a) v'@ using a function @v -> v' a@.
-const2PatchDMapWith :: forall k v v' a. (v -> v' a) -> PatchMap k v -> PatchDMap (Const2 k a) v'
-const2PatchDMapWith f (PatchMap p) = PatchDMap $ DMap.fromDistinctAscList $ g <$> Map.toAscList p
-  where g :: (k, Maybe v) -> DSum (Const2 k a) (ComposeMaybe v')
-        g (k, e) = Const2 k :=> ComposeMaybe (f <$> e)
-
--- | Convert a @'PatchIntMap' v@ into a @'PatchDMap' ('Const2' Int a) v'@ using a function @v -> v' a@.
-const2IntPatchDMapWith :: forall v f a. (v -> f a) -> PatchIntMap v -> PatchDMap (Const2 IntMap.Key a) f
-const2IntPatchDMapWith f (PatchIntMap p) = PatchDMap $ DMap.fromDistinctAscList $ g <$> IntMap.toAscList p
-  where g :: (IntMap.Key, Maybe v) -> DSum (Const2 IntMap.Key a) (ComposeMaybe f)
-        g (k, e) = Const2 k :=> ComposeMaybe (f <$> e)
-
--- | Get the values that will be replaced or deleted if the given patch is applied to the given 'DMap'.
-getDeletions :: GCompare k => PatchDMap k v -> DMap k v' -> DMap k v'
-getDeletions (PatchDMap p) m = DMap.intersectionWithKey (\_ v _ -> v) m p
diff --git a/src/Reflex/Patch/DMapWithMove.hs b/src/Reflex/Patch/DMapWithMove.hs
deleted file mode 100644
--- a/src/Reflex/Patch/DMapWithMove.hs
+++ /dev/null
@@ -1,363 +0,0 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE GADTs #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE PatternGuards #-}
-{-# LANGUAGE PolyKinds #-}
-{-# LANGUAGE Rank2Types #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE UndecidableInstances #-}
-
--- |Module containing @'PatchDMapWithMove' 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 Reflex.Patch.DMapWithMove where
-
-import Reflex.Patch.Class
-import Reflex.Patch.MapWithMove (PatchMapWithMove (..))
-import qualified Reflex.Patch.MapWithMove as MapWithMove
-
-import Data.Constraint.Extras
-import Data.Dependent.Map (DMap, DSum (..), GCompare (..))
-import qualified Data.Dependent.Map as DMap
-import Data.Functor.Constant
-import Data.Functor.Misc
-import Data.Functor.Product
-import Data.GADT.Compare (GEq (..))
-import Data.GADT.Show (GShow, gshow)
-import qualified Data.Map as Map
-import Data.Maybe
-import Data.Semigroup (Semigroup (..), (<>))
-import Data.Some (Some(Some))
-import Data.These
-
--- | Like 'PatchMapWithMove', 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 PatchDMapWithMove k v = PatchDMapWithMove (DMap k (NodeInfo k v))
-
--- |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 v a = NodeInfo
-  { _nodeInfo_from :: !(From k v a)
-  -- ^Change applying to the current key, be it an insert, move, or delete.
-  , _nodeInfo_to :: !(To k a)
-  -- ^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 (Show)
-
--- |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@).
-data From (k :: a -> *) (v :: a -> *) :: a -> * where
-  -- |Insert a new or update an existing key with the given value @v a@
-  From_Insert :: v a -> From k v a
-  -- |Delete the existing key
-  From_Delete :: From k v a
-  -- |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 :: !(k a) -> From k v a
-  deriving (Show, Read, Eq, Ord)
-
--- |Type alias for the "to" part of a 'NodeInfo'. @'ComposeMaybe' ('Just' k)@ means the key is moving to another key, @ComposeMaybe Nothing@ for any other
--- operation.
-type To = ComposeMaybe
-
--- |Test whether a 'PatchDMapWithMove' satisfies its invariants.
-validPatchDMapWithMove :: forall k v. (GCompare k, GShow k) => DMap k (NodeInfo k v) -> Bool
-validPatchDMapWithMove = not . null . validationErrorsForPatchDMapWithMove
-
--- |Enumerate what reasons a 'PatchDMapWithMove' doesn't satisfy its invariants, returning @[]@ if it's valid.
-validationErrorsForPatchDMapWithMove :: forall k v. (GCompare k, GShow k) => DMap k (NodeInfo k v) -> [String]
-validationErrorsForPatchDMapWithMove 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 _ (ComposeMaybe (Just 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 _ (ComposeMaybe (Just 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 _ (ComposeMaybe (Just 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
-
--- |Test whether two @'PatchDMapWithMove' k v@ contain the same patch operations.
-instance (GEq k, Has' Eq k (NodeInfo k v)) => Eq (PatchDMapWithMove k v) where
-    PatchDMapWithMove a == PatchDMapWithMove b = a == b
-
--- |Higher kinded 2-tuple, identical to @Data.Functor.Product@ from base ≥ 4.9
-data Pair1 f g a = Pair1 (f a) (g a)
-
--- |Helper data structure used for composing patches using the monoid instance.
-data Fixup k v a
-   = Fixup_Delete
-   | Fixup_Update (These (From k v a) (To k a))
-
--- |Compose patches having the same effect as applying the patches in turn: @'applyAlways' (p <> q) == 'applyAlways' p . 'applyAlways' q@
-instance GCompare k => Semigroup (PatchDMapWithMove k v) where
-  PatchDMapWithMove ma <> PatchDMapWithMove mb = PatchDMapWithMove m
-    where
-      connections = DMap.toList $ DMap.intersectionWithKey (\_ a b -> Pair1 (_nodeInfo_to a) (_nodeInfo_from b)) ma mb
-      h :: DSum k (Pair1 (ComposeMaybe k) (From k v)) -> [DSum k (Fixup k v)]
-      h (_ :=> Pair1 (ComposeMaybe mToAfter) editBefore) = case (mToAfter, editBefore) of
-        (Just toAfter, From_Move fromBefore)
-          | isJust $ fromBefore `geq` toAfter
-            -> [toAfter :=> Fixup_Delete]
-          | otherwise
-            -> [ toAfter :=> Fixup_Update (This editBefore)
-               , fromBefore :=> Fixup_Update (That (ComposeMaybe mToAfter))
-               ]
-        (Nothing, From_Move fromBefore) -> [fromBefore :=> Fixup_Update (That (ComposeMaybe 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 "PatchDMapWithMove: incompatible fixups"
-      fixups = DMap.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 = 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 => Monoid (PatchDMapWithMove k v) where
-  mempty = PatchDMapWithMove mempty
-  mappend = (<>)
-
-{-
-mappendPatchDMapWithMoveSlow :: forall k v. (ShowTag k v, GCompare k) => PatchDMapWithMove k v -> PatchDMapWithMove k v -> PatchDMapWithMove k v
-PatchDMapWithMove dstAfter srcAfter `mappendPatchDMapWithMoveSlow` PatchDMapWithMove dstBefore srcBefore = PatchDMapWithMove 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 @'PatchDMapWithMove' k v@ which has the effect of inserting or updating a value @v a@ to the given key @k a@, like 'DMap.insert'.
-insertDMapKey :: k a -> v a -> PatchDMapWithMove k v
-insertDMapKey k v =
-  PatchDMapWithMove . DMap.singleton k $ NodeInfo (From_Insert v) (ComposeMaybe Nothing)
-
--- |Make a @'PatchDMapWithMove' 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 -> PatchDMapWithMove k v
-moveDMapKey src dst = case src `geq` dst of
-  Nothing -> PatchDMapWithMove $ DMap.fromList
-    [ dst :=> NodeInfo (From_Move src) (ComposeMaybe Nothing)
-    , src :=> NodeInfo From_Delete (ComposeMaybe $ Just dst)
-    ]
-  Just _ -> mempty
-
--- |Make a @'PatchDMapWithMove' 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 `mplus` aMay)
---      . maybe id (DMap.insert b) (aMay `mplus` bMay)
---      . DMap.delete a . DMap.delete b $ dmap
--- @
-swapDMapKey :: GCompare k => k a -> k a -> PatchDMapWithMove k v
-swapDMapKey src dst = case src `geq` dst of
-  Nothing -> PatchDMapWithMove $ DMap.fromList
-    [ dst :=> NodeInfo (From_Move src) (ComposeMaybe $ Just src)
-    , src :=> NodeInfo (From_Move dst) (ComposeMaybe $ Just dst)
-    ]
-  Just _ -> mempty
-
--- |Make a @'PatchDMapWithMove' k v@ which has the effect of deleting a key in the mapping, equivalent to 'DMap.delete'.
-deleteDMapKey :: k a -> PatchDMapWithMove k v
-deleteDMapKey k = PatchDMapWithMove $ DMap.singleton k $ NodeInfo From_Delete $ ComposeMaybe Nothing
-
-{-
-k1, k2 :: Const2 Int () ()
-k1 = Const2 1
-k2 = Const2 2
-p1, p2 :: PatchDMapWithMove (Const2 Int ()) Identity
-p1 = moveDMapKey k1 k2
-p2 = moveDMapKey k2 k1
-p12 = p1 <> p2
-p21 = p2 <> p1
-p12Slow = p1 `mappendPatchDMapWithMoveSlow` p2
-p21Slow = p2 `mappendPatchDMapWithMoveSlow` p1
-
-testPatchDMapWithMove = do
-  print p1
-  print p2
-  print $ p12 == deleteDMapKey k1
-  print $ p21 == deleteDMapKey k2
-  print $ p12Slow == deleteDMapKey k1
-  print $ p21Slow == deleteDMapKey k2
-
-dst (PatchDMapWithMove x _) = x
-src (PatchDMapWithMove _ x) = x
--}
-
--- |Extract the 'DMap' representing the patch changes from the 'PatchDMapWithMove'.
-unPatchDMapWithMove :: PatchDMapWithMove k v -> DMap k (NodeInfo k v)
-unPatchDMapWithMove (PatchDMapWithMove p) = p
-
--- |Wrap a 'DMap' representing patch changes into a 'PatchDMapWithMove', without checking any invariants.
---
--- __Warning:__ when using this function, you must ensure that the invariants of 'PatchDMapWithMove' are preserved; they will not be checked.
-unsafePatchDMapWithMove :: DMap k (NodeInfo k v) -> PatchDMapWithMove k v
-unsafePatchDMapWithMove = PatchDMapWithMove
-
--- |Wrap a 'DMap' representing patch changes into a 'PatchDMapWithMove' while checking invariants. If the invariants are satisfied, @Right p@ is returned
--- otherwise @Left errors@.
-patchDMapWithMove :: (GCompare k, GShow k) => DMap k (NodeInfo k v) -> Either [String] (PatchDMapWithMove k v)
-patchDMapWithMove dm =
-  case validationErrorsForPatchDMapWithMove dm of
-    [] -> Right $ unsafePatchDMapWithMove dm
-    errs -> Left errs
-
--- |Map a natural transform @v -> v'@ over the given patch, transforming @'PatchDMapWithMove' k v@ into @'PatchDMapWithMove' k v'@.
-mapPatchDMapWithMove :: forall k v v'. (forall a. v a -> v' a) -> PatchDMapWithMove k v -> PatchDMapWithMove k v'
-mapPatchDMapWithMove f (PatchDMapWithMove p) = PatchDMapWithMove $
-  DMap.map (\ni -> ni { _nodeInfo_from = g $ _nodeInfo_from ni }) p
-  where g :: forall a. From k v a -> From k v' a
-        g = \case
-          From_Insert v -> From_Insert $ f v
-          From_Delete -> From_Delete
-          From_Move k -> From_Move k
-
--- |Traverse an effectful function @forall a. v a -> m (v ' a)@ over the given patch, transforming @'PatchDMapWithMove' k v@ into @m ('PatchDMapWithMove' k v')@.
-traversePatchDMapWithMove :: forall m k v v'. Applicative m => (forall a. v a -> m (v' a)) -> PatchDMapWithMove k v -> m (PatchDMapWithMove k v')
-traversePatchDMapWithMove f = traversePatchDMapWithMoveWithKey $ const f
-
--- |Map an effectful function @forall a. k a -> v a -> m (v ' a)@ over the given patch, transforming @'PatchDMapWithMove' k v@ into @m ('PatchDMapWithMove' k v')@.
-traversePatchDMapWithMoveWithKey :: forall m k v v'. Applicative m => (forall a. k a -> v a -> m (v' a)) -> PatchDMapWithMove k v -> m (PatchDMapWithMove k v')
-traversePatchDMapWithMoveWithKey f (PatchDMapWithMove p) = PatchDMapWithMove <$> DMap.traverseWithKey (nodeInfoMapFromM . g) p
-  where g :: forall a. k a -> From k v a -> m (From k v' a)
-        g k = \case
-          From_Insert v -> From_Insert <$> f k v
-          From_Delete -> pure From_Delete
-          From_Move fromKey -> pure $ From_Move fromKey
-
--- |Map a function which transforms @'From' k v a@ into a @'From' k v' a@ over a @'NodeInfo' k v a@.
-nodeInfoMapFrom :: (From k v a -> From k v' a) -> NodeInfo k v a -> NodeInfo k v' a
-nodeInfoMapFrom f ni = ni { _nodeInfo_from = f $ _nodeInfo_from ni }
-
--- |Map an effectful function which transforms @'From' k v a@ into a @f ('From' k v' a)@ over a @'NodeInfo' k v a@.
-nodeInfoMapFromM :: Functor f => (From k v a -> f (From k v' a)) -> NodeInfo k v a -> f (NodeInfo k v' a)
-nodeInfoMapFromM f ni = fmap (\result -> ni { _nodeInfo_from = result }) $ f $ _nodeInfo_from ni
-
--- |Weaken a 'PatchDMapWithMove' to a 'PatchMapWithMove' by weakening the keys from @k a@ to @'Some' k@ and applying a given weakening function @v a -> v'@ to
--- values.
-weakenPatchDMapWithMoveWith :: forall k v v'. (forall a. v a -> v') -> PatchDMapWithMove k v -> PatchMapWithMove (Some k) v'
-weakenPatchDMapWithMoveWith f (PatchDMapWithMove p) = PatchMapWithMove $ weakenDMapWith g p
-  where g :: forall a. NodeInfo k v a -> MapWithMove.NodeInfo (Some k) v'
-        g ni = MapWithMove.NodeInfo
-          { MapWithMove._nodeInfo_from = case _nodeInfo_from ni of
-              From_Insert v -> MapWithMove.From_Insert $ f v
-              From_Delete -> MapWithMove.From_Delete
-              From_Move k -> MapWithMove.From_Move $ Some k
-          , MapWithMove._nodeInfo_to = Some <$> getComposeMaybe (_nodeInfo_to ni)
-          }
-
--- |"Weaken" a @'PatchDMapWithMove' (Const2 k a) v@ to a @'PatchMapWithMove' 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.
-patchDMapWithMoveToPatchMapWithMoveWith :: forall k v v' a. (v a -> v') -> PatchDMapWithMove (Const2 k a) v -> PatchMapWithMove k v'
-patchDMapWithMoveToPatchMapWithMoveWith f (PatchDMapWithMove p) = PatchMapWithMove $ dmapToMapWith g p
-  where g :: NodeInfo (Const2 k a) v a -> MapWithMove.NodeInfo k v'
-        g ni = MapWithMove.NodeInfo
-          { MapWithMove._nodeInfo_from = case _nodeInfo_from ni of
-              From_Insert v -> MapWithMove.From_Insert $ f v
-              From_Delete -> MapWithMove.From_Delete
-              From_Move (Const2 k) -> MapWithMove.From_Move k
-          , MapWithMove._nodeInfo_to = unConst2 <$> getComposeMaybe (_nodeInfo_to ni)
-          }
-
--- |"Strengthen" a @'PatchMapWithMove' k v@ into a @'PatchDMapWithMove ('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 @v' a@.
--- Completemented by 'patchDMapWithMoveToPatchMapWithMoveWith'
-const2PatchDMapWithMoveWith :: forall k v v' a. (v -> v' a) -> PatchMapWithMove k v -> PatchDMapWithMove (Const2 k a) v'
-const2PatchDMapWithMoveWith f (PatchMapWithMove p) = PatchDMapWithMove $ DMap.fromDistinctAscList $ g <$> Map.toAscList p
-  where g :: (k, MapWithMove.NodeInfo k v) -> DSum (Const2 k a) (NodeInfo (Const2 k a) v')
-        g (k, ni) = Const2 k :=> NodeInfo
-          { _nodeInfo_from = case MapWithMove._nodeInfo_from ni of
-              MapWithMove.From_Insert v -> From_Insert $ f v
-              MapWithMove.From_Delete -> From_Delete
-              MapWithMove.From_Move fromKey -> From_Move $ Const2 fromKey
-          , _nodeInfo_to = ComposeMaybe $ Const2 <$> MapWithMove._nodeInfo_to ni
-          }
-
--- | Apply the insertions, deletions, and moves to a given 'DMap'.
-instance GCompare k => Patch (PatchDMapWithMove k v) where
-  type PatchTarget (PatchDMapWithMove k v) = DMap k v
-  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)
-          insertFunc _ ni = case _nodeInfo_from ni of
-            From_Insert v -> Just v
-            From_Move k -> DMap.lookup k old
-            From_Delete -> Nothing
-          deletions = DMap.mapMaybeWithKey deleteFunc p
-          deleteFunc :: forall a. k a -> NodeInfo k v 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 => PatchDMapWithMove k v -> DMap k v' -> DMap k (Product v' (ComposeMaybe k))
-getDeletionsAndMoves (PatchDMapWithMove p) m = DMap.intersectionWithKey f m p
-  where f _ v ni = Pair v $ _nodeInfo_to ni
diff --git a/src/Reflex/Patch/IntMap.hs b/src/Reflex/Patch/IntMap.hs
deleted file mode 100644
--- a/src/Reflex/Patch/IntMap.hs
+++ /dev/null
@@ -1,59 +0,0 @@
-{-# LANGUAGE DeriveFoldable #-}
-{-# LANGUAGE DeriveFunctor #-}
-{-# LANGUAGE DeriveTraversable #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE TypeFamilies #-}
--- | Module containing 'PatchIntMap', a 'Patch' for 'IntMap' which allows for
--- insert/update or delete of associations.
-module Reflex.Patch.IntMap where
-
-import Data.IntMap.Strict (IntMap)
-import qualified Data.IntMap.Strict as IntMap
-import Data.Maybe
-import Data.Semigroup
-import Reflex.Patch.Class
-
--- | 'Patch' for 'IntMap' which represents insertion or deletion of keys in the mapping.
--- Internally represented by 'IntMap (Maybe a)', where @Just@ means insert/update
--- and @Nothing@ means delete.
-newtype PatchIntMap a = PatchIntMap (IntMap (Maybe a)) deriving (Functor, Foldable, Traversable, Monoid)
-
--- | Apply the insertions or deletions to a given 'IntMap'.
-instance Patch (PatchIntMap a) where
-  type PatchTarget (PatchIntMap a) = IntMap a
-  apply (PatchIntMap p) v = if IntMap.null p then Nothing else Just $
-    let removes = IntMap.filter isNothing p
-        adds = IntMap.mapMaybe id p
-    in IntMap.union adds $ v `IntMap.difference` removes
-
--- | @a <> b@ will apply the changes of @b@ and then apply the changes of @a@.
--- If the same key is modified by both patches, the one on the left will take
--- precedence.
-instance Semigroup (PatchIntMap v) where
-  PatchIntMap a <> PatchIntMap b = PatchIntMap $ a `mappend` b --TODO: Add a semigroup instance for Map
-  -- PatchMap is idempotent, so stimes n is id for every n
-  stimes = stimesIdempotentMonoid
-
--- | Map a function @Int -> a -> b@ over all @a@s in the given @'PatchIntMap' a@
--- (that is, all inserts/updates), producing a @PatchIntMap b@.
-mapIntMapPatchWithKey :: (Int -> a -> b) -> PatchIntMap a -> PatchIntMap b
-mapIntMapPatchWithKey f (PatchIntMap m) = PatchIntMap $ IntMap.mapWithKey (\ k mv -> f k <$> mv) m
-
--- | Map an effectful function @Int -> a -> f b@ over all @a@s in the given @'PatchIntMap' a@
--- (that is, all inserts/updates), producing a @f (PatchIntMap b)@.
-traverseIntMapPatchWithKey :: Applicative f => (Int -> a -> f b) -> PatchIntMap a -> f (PatchIntMap b)
-traverseIntMapPatchWithKey f (PatchIntMap m) = PatchIntMap <$> IntMap.traverseWithKey (\k mv -> traverse (f k) mv) m
-
--- | Extract all @a@s inserted/updated by the given @'PatchIntMap' a@.
-patchIntMapNewElements :: PatchIntMap a -> [a]
-patchIntMapNewElements (PatchIntMap m) = catMaybes $ IntMap.elems m
-
--- | Convert the given @'PatchIntMap' a@ into an @'IntMap' a@ with all
--- the inserts/updates in the given patch.
-patchIntMapNewElementsMap :: PatchIntMap a -> IntMap a
-patchIntMapNewElementsMap (PatchIntMap m) = IntMap.mapMaybe id m
-
--- | Subset the given @'IntMap' a@ to contain only the keys that would be
--- deleted by the given @'PatchIntMap' a@.
-getDeletions :: PatchIntMap v -> IntMap v' -> IntMap v'
-getDeletions (PatchIntMap m) v = IntMap.intersection v m
diff --git a/src/Reflex/Patch/Map.hs b/src/Reflex/Patch/Map.hs
deleted file mode 100644
--- a/src/Reflex/Patch/Map.hs
+++ /dev/null
@@ -1,55 +0,0 @@
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE TypeFamilies #-}
--- | 'Patch'es on 'Map' that consist only of insertions (including overwrites)
--- and deletions
-module Reflex.Patch.Map where
-
-import Reflex.Patch.Class
-
-import Data.Map (Map)
-import qualified Data.Map as Map
-import Data.Maybe
-import Data.Semigroup
-
--- | A set of changes to a 'Map'.  Any element may be inserted/updated or
--- deleted.  Insertions are represented as values wrapped in 'Just', while
--- deletions are represented as 'Nothing's
-newtype PatchMap k v = PatchMap { unPatchMap :: Map k (Maybe v) }
-  deriving (Show, Read, Eq, Ord)
-
--- | Apply the insertions or deletions to a given 'Map'.
-instance Ord k => Patch (PatchMap k v) where
-  type PatchTarget (PatchMap k v) = Map k v
-  {-# 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
-          deletions = Map.mapMaybeWithKey (const nothingToJust) p
-          nothingToJust = \case
-            Nothing -> Just ()
-            Just _ -> Nothing
-
--- | @a <> b@ will apply the changes of @b@ and then apply the changes of @a@.
--- If the same key is modified by both patches, the one on the left will take
--- precedence.
-instance Ord k => Semigroup (PatchMap k v) where
-  PatchMap a <> PatchMap b = PatchMap $ a `mappend` b --TODO: Add a semigroup instance for Map
-  -- PatchMap is idempotent, so stimes n is id for every n
-  stimes = stimesIdempotentMonoid
-
--- | The empty 'PatchMap' contains no insertions or deletions
-instance Ord k => Monoid (PatchMap k v) where
-  mempty = PatchMap mempty
-  mappend = (<>)
-
--- | 'fmap'ping a 'PatchMap' will alter all of the values it will insert.
--- Deletions are unaffected.
-instance Functor (PatchMap k) where
-  fmap f = PatchMap . fmap (fmap f) . unPatchMap
-
--- | Returns all the new elements that will be added to the 'Map'
-patchMapNewElements :: PatchMap k v -> [v]
-patchMapNewElements (PatchMap p) = catMaybes $ Map.elems p
-
--- | Returns all the new elements that will be added to the 'Map'
-patchMapNewElementsMap :: PatchMap k v -> Map k v
-patchMapNewElementsMap (PatchMap p) = Map.mapMaybe id p
diff --git a/src/Reflex/Patch/MapWithMove.hs b/src/Reflex/Patch/MapWithMove.hs
deleted file mode 100644
--- a/src/Reflex/Patch/MapWithMove.hs
+++ /dev/null
@@ -1,270 +0,0 @@
-{-# LANGUAGE DeriveFoldable #-}
-{-# LANGUAGE DeriveFunctor #-}
-{-# LANGUAGE DeriveTraversable #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE PatternGuards #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeFamilies #-}
--- | 'Patch'es on 'Map' that can insert, delete, and move values from one key to
--- another
-module Reflex.Patch.MapWithMove where
-
-import Reflex.Patch.Class
-
-import Control.Arrow
-import Control.Monad.State
-import Data.Foldable
-import Data.Function
-import Data.List
-import Data.Map (Map)
-import qualified Data.Map as Map
-import Data.Maybe
-import Data.Semigroup (Semigroup (..), (<>))
-import qualified Data.Set as Set
-import Data.These (These(..))
-import Data.Tuple
-
--- | Patch a DMap 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 (Map k (NodeInfo k v)) deriving (Show, Eq, Ord, Functor, Foldable, Traversable)
-
--- | 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)
-
--- | 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)
-
--- | 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 '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
-
--- | 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
-  }
-
--- | Extract the internal representation of the 'PatchMapWithMove'
-unPatchMapWithMove :: PatchMapWithMove k v -> Map k (NodeInfo k v)
-unPatchMapWithMove (PatchMapWithMove p) = p
-
--- | 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
-
--- |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:
---
--- @
---     '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))
-        ]
-
--- |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)
---      . 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))
-      ]
-
--- |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
-
--- | 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
-
--- | 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
-
--- | Returns all the new elements that will be added to the 'Map'.
-patchMapWithMoveNewElements :: PatchMapWithMove k v -> [v]
-patchMapWithMoveNewElements = Map.elems . patchMapWithMoveNewElementsMap
-
--- | 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
-
--- | 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)
-
--- | 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 cmp oldByIndex newByIndexUnsorted = patchThatChangesMap oldByIndex newByIndex
-  where newList = Map.toList newByIndexUnsorted
-        newByIndex = Map.fromList $ zip (fst <$> newList) $ sortBy cmp $ snd <$> newList
-
--- | 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 . fromJust $ 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
-
--- | 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 }
-
--- | 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
-
--- | Set the 'To' field of a 'NodeInfo'
-nodeInfoSetTo :: To k -> NodeInfo k v -> NodeInfo k v
-nodeInfoSetTo to ni = ni { _nodeInfo_to = to }
-
--- |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))
-
--- |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
-
---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 = (<>)
diff --git a/src/Reflex/Query/Base.hs b/src/Reflex/Query/Base.hs
--- a/src/Reflex/Query/Base.hs
+++ b/src/Reflex/Query/Base.hs
@@ -16,6 +16,7 @@
   , mapQueryResult
   , dynWithQueryT
   , withQueryT
+  , mapQueryT
   ) where
 
 import Control.Applicative (liftA2)
@@ -46,7 +47,7 @@
 import Reflex.EventWriter.Base
 import Reflex.EventWriter.Class
 import Reflex.Host.Class
-import qualified Reflex.Patch.MapWithMove as MapWithMove
+import qualified Data.Patch.MapWithMove as MapWithMove
 import Reflex.PerformEvent.Class
 import Reflex.PostBuild.Class
 import Reflex.Query.Class
@@ -286,6 +287,10 @@
     (fmap (mapQuery f) (sample (currentIncremental q)))
     (fmapCheap (AdditivePatch . mapQuery f . unAdditivePatch) $ updatedIncremental q)
   return result
+
+-- | Maps a function over a 'QueryT' that can change the underlying monad
+mapQueryT :: (forall b. m b -> n b) -> QueryT t q m a -> QueryT t q n a
+mapQueryT f (QueryT a) = QueryT $ mapStateT (mapEventWriterT (mapReaderT f)) a
 
 -- | dynWithQueryT's (Dynamic t QueryMorphism) argument needs to be a group homomorphism at all times in order to behave correctly
 dynWithQueryT :: (MonadFix m, PostBuild t m, Group q, Additive q, Group q', Additive q', Query q')
diff --git a/src/Reflex/Query/Class.hs b/src/Reflex/Query/Class.hs
--- a/src/Reflex/Query/Class.hs
+++ b/src/Reflex/Query/Class.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
@@ -21,6 +22,7 @@
   , MonadQuery (..)
   , tellQueryDyn
   , queryDyn
+  , subQuery
   , mapQuery
   , mapQueryResult
   ) where
@@ -35,6 +37,9 @@
 import qualified Data.Map.Monoidal as MonoidalMap
 import Data.Semigroup (Semigroup(..))
 import Foreign.Storable
+import Data.Void
+import Data.Monoid hiding ((<>))
+import Control.Applicative
 
 import Reflex.Class
 
@@ -50,6 +55,37 @@
   type QueryResult (MonoidalMap k v) = MonoidalMap k (QueryResult v)
   crop q r = MonoidalMap.intersectionWith (flip crop) r q
 
+-- | the result of two queries is both results.
+instance (Query a, Query b) => Query (a, b) where
+  type QueryResult (a, b) = (QueryResult a, QueryResult b)
+  crop (x, x') (y, y') = (crop x y, crop x' y')
+
+-- | Trivial queries have trivial results.
+instance Query () where
+  type QueryResult () = ()
+  crop _ _ = ()
+
+-- | The result of an absurd query is trivial; If you can ask the question, the
+-- answer cannot tell you anything you didn't already know.
+--
+-- 'QueryResult Void = @Void@' seems like it would also work, but that has
+-- problems of robustness. In some applications, an unasked question can still
+-- be answered, so it is important that the result is inhabited even when the
+-- question isn't. Applications that wish to prevent this can mandate that the
+-- query result be paired with the query: then the whole response will be
+-- uninhabited as desired.
+instance Query Void where
+  type QueryResult Void = ()
+  crop = absurd
+
+#if MIN_VERSION_base(4,12,0)
+-- | We can lift queries into monoidal containers.
+-- But beware of Applicatives whose monoid is different from (pure mempty, liftA2 mappend)
+instance (Query q, Applicative f) => Query (Ap f q) where
+  type QueryResult (Ap f q) = Ap f (QueryResult q)
+  crop = liftA2 crop
+#endif
+
 -- | QueryMorphism's must be group homomorphisms when acting on the query type
 -- and compatible with the query relationship when acting on the query result.
 data QueryMorphism q q' = QueryMorphism
@@ -116,3 +152,7 @@
 queryDyn q = do
   tellQueryDyn q
   zipDynWith crop q <$> askQueryResult
+
+-- | Use a query morphism to operate on a smaller version of a query.
+subQuery :: (Reflex t, MonadQuery t q2 m, Monad m) => QueryMorphism q1 q2 -> Dynamic t q1 -> m (Dynamic t (QueryResult q1))
+subQuery (QueryMorphism f g) x = fmap g <$> queryDyn (fmap f x)
diff --git a/src/Reflex/Spider/Internal.hs b/src/Reflex/Spider/Internal.hs
--- a/src/Reflex/Spider/Internal.hs
+++ b/src/Reflex/Spider/Internal.hs
@@ -38,11 +38,12 @@
 import Control.Monad.Exception
 import Control.Monad.Identity hiding (forM, forM_, mapM, mapM_)
 import Control.Monad.Primitive
---import Control.Monad.Reader hiding (forM, forM_, mapM, mapM_)
 import Control.Monad.Reader.Class
 import Control.Monad.IO.Class
 import Control.Monad.ReaderIO
 import Control.Monad.Ref
+import Control.Monad.Fail (MonadFail)
+import qualified Control.Monad.Fail as MonadFail
 import Data.Align
 import Data.Coerce
 import Data.Dependent.Map (DMap, DSum (..))
@@ -59,12 +60,13 @@
 import Data.IORef
 import Data.Kind (Type)
 import Data.Maybe hiding (mapMaybe)
-import Data.Monoid ((<>))
+import Data.Monoid (mempty, (<>))
 import Data.Proxy
 import Data.These
 import Data.Traversable
+import Data.Type.Equality ((:~:)(Refl))
 import Data.Witherable (Filterable, mapMaybe)
-import GHC.Exts
+import GHC.Exts hiding (toList)
 import GHC.IORef (IORef (..))
 import GHC.Stack
 import Reflex.FastWeak
@@ -83,14 +85,16 @@
 
 #ifdef DEBUG_CYCLES
 import Control.Monad.State hiding (forM, forM_, mapM, mapM_, sequence)
+#endif
+
 import Data.List.NonEmpty (NonEmpty (..), nonEmpty)
 import qualified Data.List.NonEmpty as NonEmpty
-import Data.Monoid (mempty)
 import Data.Tree (Forest, Tree (..), drawForest)
-#endif
+import Data.List (isPrefixOf)
 
-import Data.FastWeakBag (FastWeakBag)
+import Data.FastWeakBag (FastWeakBag, FastWeakBagTicket)
 import qualified Data.FastWeakBag as FastWeakBag
+
 import Data.Reflection
 import Data.Some (Some(Some))
 import Data.Type.Coercion
@@ -101,21 +105,26 @@
 import qualified Reflex.Class as R
 import qualified Reflex.Host.Class
 import Reflex.NotReady.Class
-import Reflex.Patch
-import qualified Reflex.Patch.DMapWithMove as PatchDMapWithMove
+import Data.Patch
+import qualified Data.Patch.DMapWithMove as PatchDMapWithMove
 import Reflex.PerformEvent.Base (PerformEventT)
 
 #ifdef DEBUG_TRACE_EVENTS
 import qualified Data.ByteString.Char8 as BS8
 import System.IO (stderr)
+import Data.List (isPrefixOf)
 #endif
 
-#ifdef DEBUG_TRACE_EVENTS
+-- TODO stdout might not be the best channel for debug output
+debugStrLn :: String -> IO ()
+debugStrLn = putStrLn
 
+#ifdef DEBUG_TRACE_EVENTS
 withStackOneLine :: (BS8.ByteString -> a) -> a
 withStackOneLine expr = unsafePerformIO $ do
   stack <- currentCallStack
-  return (expr (BS8.pack (unwords (reverse stack))))
+  return (expr . BS8.pack  . unwords . dropInternal . reverse $ stack)
+    where dropInternal = filterStack "Reflex.Spider.Internal"
 
 #endif
 
@@ -126,28 +135,42 @@
 debugInvalidate :: Bool
 
 #ifdef DEBUG
-
 #define DEBUG_NODEIDS
 
+#ifdef DEBUG_TRACE_PROPAGATION
 debugPropagate = True
+#else
+debugPropagate = False
+#endif
 
+#ifdef DEBUG_TRACE_HEIGHT
+debugInvalidateHeight = True
+#else
 debugInvalidateHeight = False
+#endif
 
+#ifdef DEBUG_TRACE_INVALIDATION
 debugInvalidate = True
+#else
+debugInvalidate = False
+#endif
 
 class HasNodeId a where
   getNodeId :: a -> Int
 
-instance HasNodeId (Hold x p a) where
-  getNodeId = holdNodeId
+instance HasNodeId (CacheSubscribed x a) where
+  getNodeId = _cacheSubscribed_nodeId
 
-instance HasNodeId (PushSubscribed x a b) where
-  getNodeId = pushSubscribedNodeId
+instance HasNodeId (FanInt x a) where
+  getNodeId = _fanInt_nodeId
 
+instance HasNodeId (Hold x p) where
+  getNodeId = holdNodeId
+
 instance HasNodeId (SwitchSubscribed x a) where
   getNodeId = switchSubscribedNodeId
 
-instance HasNodeId (FanSubscribed x a) where
+instance HasNodeId (FanSubscribed x v a) where
   getNodeId = fanSubscribedNodeId
 
 instance HasNodeId (CoincidenceSubscribed x a) where
@@ -161,41 +184,16 @@
 
 {-# INLINE showNodeId #-}
 showNodeId :: HasNodeId a => a -> String
-showNodeId = ("#"<>) . show . getNodeId
+showNodeId = showNodeId' . getNodeId
 
-showSubscriberType :: Subscriber x a -> String
-showSubscriberType = \case
-  SubscriberPush _ _ -> "SubscriberPush"
-  SubscriberMerge _ _ -> "SubscriberMerge"
-  SubscriberFan _ -> "SubscriberFan"
-  SubscriberMergeChange _ -> "SubscriberMergeChange"
-  SubscriberHold _ -> "SubscriberHold"
-  SubscriberHoldIdentity _ -> "SubscriberHoldIdentity"
-  SubscriberSwitch _ -> "SubscriberSwitch"
-  SubscriberCoincidenceOuter _ -> "SubscriberCoincidenceOuter"
-  SubscriberCoincidenceInner _ -> "SubscriberCoincidenceInner"
-  SubscriberHandle -> "SubscriberHandle"
+showNodeId' :: Int -> String
+showNodeId' = ("#"<>) . show
 
-showEventType :: Event x a -> String
-showEventType = \case
-  EventRoot _ _ -> "EventRoot"
-  EventNever -> "EventNever"
-  EventPush _ -> "EventPush"
-  EventMerge _ -> "EventMerge"
-  EventFan _ _ -> "EventFan"
-  EventSwitch _ -> "EventSwitch"
-  EventCoincidence _ -> "EventCoincidence"
-  EventHold _ -> "EventHold"
-  EventDyn _ -> "EventDyn"
-  EventHoldIdentity _ -> "EventHoldIdentity"
-  EventDynIdentity _ -> "EventDynIdentity"
 
 #else
 
 debugPropagate = False
-
 debugInvalidateHeight = False
-
 debugInvalidate = False
 
 -- This must be inline, or error messages will cause memory leaks due to retaining the node in question
@@ -203,6 +201,10 @@
 showNodeId :: a -> String
 showNodeId _ = ""
 
+{-# INLINE showNodeId' #-}
+showNodeId' :: Int -> String
+showNodeId' _ = ""
+
 #endif
 
 #ifdef DEBUG_NODEIDS
@@ -248,9 +250,9 @@
 -- caching; if the computation function is very cheap, this is (much) more
 -- efficient than 'push'
 {-# INLINE [1] pushCheap #-}
-pushCheap :: (a -> ComputeM x (Maybe b)) -> Event x a -> Event x b
+pushCheap :: HasSpiderTimeline x => (a -> ComputeM x (Maybe b)) -> Event x a -> Event x b
 pushCheap !f e = Event $ \sub -> do
-  (subscription, occ) <- subscribeAndRead e $ sub
+  (subscription, occ) <- subscribeAndRead e $ debugSubscriber' "push" $ sub
     { subscriberPropagate = \a -> do
         mb <- f a
         mapM_ (subscriberPropagate sub) mb
@@ -269,10 +271,10 @@
 
 -- | Subscribe to an Event only for the duration of one occurrence
 {-# INLINE subscribeAndReadHead #-}
-subscribeAndReadHead :: Event x a -> Subscriber x a -> EventM x (EventSubscription x, Maybe a)
+subscribeAndReadHead :: HasSpiderTimeline x => Event x a -> Subscriber x a -> EventM x (EventSubscription x, Maybe a)
 subscribeAndReadHead e sub = do
   subscriptionRef <- liftIO $ newIORef $ error "subscribeAndReadHead: not initialized"
-  (subscription, occ) <- subscribeAndRead e $ sub
+  (subscription, occ) <- subscribeAndRead e $ debugSubscriber' "head" $ sub
     { subscriberPropagate = \a -> do
         liftIO $ unsubscribe =<< readIORef subscriptionRef
         subscriberPropagate sub a
@@ -283,24 +285,29 @@
   return (subscription, occ)
 
 --TODO: Make this lazy in its input event
-headE :: (MonadIO m, Defer (SomeMergeInit x) m) => Event x a -> m (Event x a)
+headE :: (MonadIO m, Defer (SomeMergeInit x) m, HasSpiderTimeline x) => Event x a -> m (Event x a)
 headE originalE = do
   parent <- liftIO $ newIORef $ Just originalE
   defer $ SomeMergeInit $ do --TODO: Rename SomeMergeInit appropriately
     let clearParent = liftIO $ writeIORef parent Nothing
-    (_, occ) <- subscribeAndReadHead originalE $ terminalSubscriber $ \_ -> clearParent
+    (_, occ) <- subscribeAndReadHead originalE $ terminalSubscriber $ const clearParent
     when (isJust occ) clearParent
-  return $ Event $ \sub -> do
+  return $ Event $ \sub ->
     liftIO (readIORef parent) >>= \case
-      Nothing -> return (EventSubscription (return ()) $ EventSubscribed zeroRef $ toAny (), Nothing)
+      Nothing -> subscribeAndReadNever
       Just e -> subscribeAndReadHead e sub
 
 data CacheSubscribed x a
    = CacheSubscribed { _cacheSubscribed_subscribers :: {-# UNPACK #-} !(FastWeakBag (Subscriber x a))
                      , _cacheSubscribed_parent :: {-# UNPACK #-} !(EventSubscription x)
                      , _cacheSubscribed_occurrence :: {-# UNPACK #-} !(IORef (Maybe a))
+#ifdef DEBUG_NODEIDS
+                     , _cacheSubscribed_nodeId :: {-# UNPACK #-} !Int
+#endif
                      }
 
+
+
 -- | Construct an 'Event' whose value is guaranteed not to be recomputed
 -- repeatedly
 --
@@ -325,18 +332,23 @@
           subscribedTicket <- liftIO (readIORef mSubscribedRef >>= getFastWeakTicket) >>= \case
             Just subscribedTicket -> return subscribedTicket
             Nothing -> do
+#ifdef DEBUG_NODEIDS
+              nodeId <- liftIO newNodeId
+#endif
               subscribers <- liftIO FastWeakBag.empty
               occRef <- liftIO $ newIORef Nothing -- This should never be read prior to being set below
+#ifdef DEBUG_NODEIDS
+              (parentSub, occ) <- subscribeAndRead e $ debugSubscriber' ("cacheEvent" <> showNodeId' nodeId) $ Subscriber
+#else
               (parentSub, occ) <- subscribeAndRead e $ Subscriber
-                { subscriberPropagate = \a -> do
-                    liftIO $ writeIORef occRef $ Just a
-                    scheduleClear occRef
-                    propagateFast a subscribers
-                , subscriberInvalidateHeight = \old -> do
-                    FastWeakBag.traverse_ subscribers $ invalidateSubscriberHeight old
-                , subscriberRecalculateHeight = \new -> do
-                    FastWeakBag.traverse_ subscribers $ recalculateSubscriberHeight new
-                }
+#endif
+                  { subscriberPropagate = \a -> do
+                      liftIO $ writeIORef occRef (Just a)
+                      scheduleClear occRef
+                      propagateFast a subscribers
+                  , subscriberInvalidateHeight = FastWeakBag.traverse_ subscribers . invalidateSubscriberHeight
+                  , subscriberRecalculateHeight = FastWeakBag.traverse_ subscribers . recalculateSubscriberHeight
+                  }
               when (isJust occ) $ do
                 liftIO $ writeIORef occRef occ -- Set the initial value of occRef; we don't need to do this if occ is Nothing
                 scheduleClear occRef
@@ -344,30 +356,46 @@
                     { _cacheSubscribed_subscribers = subscribers
                     , _cacheSubscribed_parent = parentSub
                     , _cacheSubscribed_occurrence = occRef
+#ifdef DEBUG_NODEIDS
+                    , _cacheSubscribed_nodeId = nodeId
+#endif
                     }
               subscribedTicket <- liftIO $ mkFastWeakTicket subscribed
               liftIO $ writeIORef mSubscribedRef =<< getFastWeakTicketWeak subscribedTicket
               return subscribedTicket
-          liftIO $ do
-            subscribed <- getFastWeakTicketValue subscribedTicket
-            ticket <- FastWeakBag.insert sub $ _cacheSubscribed_subscribers subscribed
-            occ <- readIORef $ _cacheSubscribed_occurrence subscribed
-            let es = EventSubscription
-                  { _eventSubscription_unsubscribe = do
-                      FastWeakBag.remove ticket
-                      isEmpty <- FastWeakBag.isEmpty $ _cacheSubscribed_subscribers subscribed
-                      when isEmpty $ do
-                        writeIORef mSubscribedRef emptyFastWeak
-                        unsubscribe $ _cacheSubscribed_parent subscribed
-                      touch ticket
-                      touch subscribedTicket
-                  , _eventSubscription_subscribed = EventSubscribed
-                      { eventSubscribedHeightRef = eventSubscribedHeightRef $ _eventSubscription_subscribed $ _cacheSubscribed_parent subscribed
-                      , eventSubscribedRetained = toAny subscribedTicket
-                      }
-                  }
-            return (es, occ)
+          liftIO $ cacheSubscription sub mSubscribedRef subscribedTicket
 
+cacheSubscription :: Subscriber x a -> IORef (FastWeak (CacheSubscribed x a))
+                  -> FastWeakTicket (CacheSubscribed x a) -> IO (EventSubscription x, Maybe a)
+cacheSubscription sub mSubscribedRef subscribedTicket = do
+  subscribed <- getFastWeakTicketValue subscribedTicket
+  ticket <- FastWeakBag.insert sub $ _cacheSubscribed_subscribers subscribed
+  occ <- readIORef $ _cacheSubscribed_occurrence subscribed
+
+  let parentSub = _cacheSubscribed_parent subscribed
+      es = EventSubscription
+        { _eventSubscription_unsubscribe = do
+          FastWeakBag.remove ticket
+
+          isEmpty <- FastWeakBag.isEmpty $ _cacheSubscribed_subscribers subscribed
+          when isEmpty $ do
+            writeIORef mSubscribedRef emptyFastWeak
+            unsubscribe parentSub
+          touch ticket
+          touch subscribedTicket
+        , _eventSubscription_subscribed = EventSubscribed
+          { eventSubscribedHeightRef = eventSubscribedHeightRef $ _eventSubscription_subscribed parentSub
+          , eventSubscribedRetained = toAny subscribedTicket
+#ifdef DEBUG_CYCLES
+          , eventSubscribedGetParents = return [_eventSubscription_subscribed parentSub]
+          , eventSubscribedHasOwnHeightRef = False
+          , eventSubscribedWhoCreated = whoCreatedIORef mSubscribedRef
+#endif
+          }
+        }
+  return (es, occ)
+
+
 subscribe :: Event x a -> Subscriber x a -> EventM x (EventSubscription x)
 subscribe e s = fst <$> subscribeAndRead e s
 
@@ -378,11 +406,14 @@
   let es = tag subd
   return (EventSubscription (WeakBag.remove sln >> touch sln) es, occ)
 
-eventRoot :: GCompare k => k a -> Root x k -> Event x a
+eventRoot :: (GCompare k, HasSpiderTimeline x) => k a -> Root x k -> Event x a
 eventRoot !k !r = Event $ wrap eventSubscribedRoot $ liftIO . getRootSubscribed k r
 
+subscribeAndReadNever :: EventM x (EventSubscription x, Maybe a)
+subscribeAndReadNever = return (EventSubscription (return ()) eventSubscribedNever, Nothing)
+
 eventNever :: Event x a
-eventNever = Event $ \_ -> return (EventSubscription (return ()) eventSubscribedNever, Nothing)
+eventNever = Event $ const subscribeAndReadNever
 
 eventFan :: (GCompare k, HasSpiderTimeline x) => k a -> Fan x k v -> Event x (v a)
 eventFan !k !f = Event $ wrap eventSubscribedFan $ getFanSubscribed k f
@@ -437,10 +468,10 @@
   }
 
 newSubscriberFan :: forall x k v. (HasSpiderTimeline x, GCompare k) => FanSubscribed x k v -> IO (Subscriber x (DMap k v))
-newSubscriberFan subscribed = return $ Subscriber
+newSubscriberFan subscribed = debugSubscriber ("SubscriberFan " <> showNodeId subscribed)  $ Subscriber
   { subscriberPropagate = \a -> {-# SCC "traverseFan" #-} do
       subs <- liftIO $ readIORef $ fanSubscribedSubscribers subscribed
-      tracePropagate (Proxy :: Proxy x) $ "SubscriberFan" <> showNodeId subscribed <> ": " ++ show (DMap.size subs) ++ " keys subscribed, " ++ show (DMap.size a) ++ " keys firing"
+      tracePropagate (Proxy :: Proxy x) $ show (DMap.size subs) <> " keys subscribed, " <> show (DMap.size a) <> " keys firing"
       liftIO $ writeIORef (fanSubscribedOccurrence subscribed) $ Just a
       scheduleClear $ fanSubscribedOccurrence subscribed
       let f _ (Pair v subsubs) = do
@@ -449,50 +480,40 @@
       _ <- DMap.traverseWithKey f $ DMap.intersectionWithKey (\_ -> Pair) a subs --TODO: Would be nice to have DMap.traverse_
       return ()
   , subscriberInvalidateHeight = \old -> do
-      when debugInvalidateHeight $ putStrLn $ "invalidateSubscriberHeight: SubscriberFan" <> showNodeId subscribed
       subscribers <- readIORef $ fanSubscribedSubscribers subscribed
       forM_ (DMap.toList subscribers) $ \(_ :=> v) -> WeakBag.traverse_ (_fanSubscribedChildren_list v) $ invalidateSubscriberHeight old
-      when debugInvalidateHeight $ putStrLn $ "invalidateSubscriberHeight: SubscriberFan" <> showNodeId subscribed <> " done"
   , subscriberRecalculateHeight = \new -> do
-      when debugInvalidateHeight $ putStrLn $ "recalculateSubscriberHeight: SubscriberFan" <> showNodeId subscribed
       subscribers <- readIORef $ fanSubscribedSubscribers subscribed
       forM_ (DMap.toList subscribers) $ \(_ :=> v) -> WeakBag.traverse_ (_fanSubscribedChildren_list v) $ recalculateSubscriberHeight new
-      when debugInvalidateHeight $ putStrLn $ "recalculateSubscriberHeight: SubscriberFan" <> showNodeId subscribed <> " done"
   }
 
 newSubscriberSwitch :: forall x a. HasSpiderTimeline x => SwitchSubscribed x a -> IO (Subscriber x a)
-newSubscriberSwitch subscribed = return $ Subscriber
+newSubscriberSwitch subscribed = debugSubscriber ("SubscriberCoincidenceOuter" <> showNodeId subscribed) $ Subscriber
   { subscriberPropagate = \a -> {-# SCC "traverseSwitch" #-} do
-      tracePropagate (Proxy :: Proxy x) $ "SubscriberSwitch" <> showNodeId subscribed
       liftIO $ writeIORef (switchSubscribedOccurrence subscribed) $ Just a
       scheduleClear $ switchSubscribedOccurrence subscribed
       propagate a $ switchSubscribedSubscribers subscribed
   , subscriberInvalidateHeight = \_ -> do
-      when debugInvalidateHeight $ putStrLn $ "invalidateSubscriberHeight: SubscriberSwitch" <> showNodeId subscribed
       oldHeight <- readIORef $ switchSubscribedHeight subscribed
       when (oldHeight /= invalidHeight) $ do
         writeIORef (switchSubscribedHeight subscribed) $! invalidHeight
         WeakBag.traverse_ (switchSubscribedSubscribers subscribed) $ invalidateSubscriberHeight oldHeight
-      when debugInvalidateHeight $ putStrLn $ "invalidateSubscriberHeight: SubscriberSwitch" <> showNodeId subscribed <> " done"
-  , subscriberRecalculateHeight = \new -> do
-      when debugInvalidateHeight $ putStrLn $ "recalculateSubscriberHeight: SubscriberSwitch" <> showNodeId subscribed
-      updateSwitchHeight new subscribed
-      when debugInvalidateHeight $ putStrLn $ "recalculateSubscriberHeight: SubscriberSwitch" <> showNodeId subscribed <> " done"
-  }
+  , subscriberRecalculateHeight = (`updateSwitchHeight` subscribed)
+    }
 
 newSubscriberCoincidenceOuter :: forall x b. HasSpiderTimeline x => CoincidenceSubscribed x b -> IO (Subscriber x (Event x b))
-newSubscriberCoincidenceOuter subscribed = return $ Subscriber
+newSubscriberCoincidenceOuter subscribed = debugSubscriber ("SubscriberCoincidenceOuter" <> showNodeId subscribed) $ Subscriber
   { subscriberPropagate = \a -> {-# SCC "traverseCoincidenceOuter" #-} do
-      tracePropagate (Proxy :: Proxy x) $ "SubscriberCoincidenceOuter" <> showNodeId subscribed
       outerHeight <- liftIO $ readIORef $ coincidenceSubscribedHeight subscribed
       tracePropagate (Proxy :: Proxy x) $ "  outerHeight = " <> show outerHeight
       (occ, innerHeight, innerSubd) <- subscribeCoincidenceInner a outerHeight subscribed
       tracePropagate (Proxy :: Proxy x) $ "  isJust occ = " <> show (isJust occ)
       tracePropagate (Proxy :: Proxy x) $ "  innerHeight = " <> show innerHeight
+
       liftIO $ writeIORef (coincidenceSubscribedInnerParent subscribed) $ Just innerSubd
       scheduleClear $ coincidenceSubscribedInnerParent subscribed
       case occ of
-        Nothing -> do
+        Nothing ->
           when (innerHeight > outerHeight) $ liftIO $ do -- If the event fires, it will fire at a later height
             writeIORef (coincidenceSubscribedHeight subscribed) $! innerHeight
             WeakBag.traverse_ (coincidenceSubscribedSubscribers subscribed) $ invalidateSubscriberHeight outerHeight
@@ -501,20 +522,13 @@
           liftIO $ writeIORef (coincidenceSubscribedOccurrence subscribed) occ
           scheduleClear $ coincidenceSubscribedOccurrence subscribed
           propagate o $ coincidenceSubscribedSubscribers subscribed
-  , subscriberInvalidateHeight = \_ -> do
-      when debugInvalidateHeight $ putStrLn $ "invalidateSubscriberHeight: SubscriberCoincidenceOuter" <> showNodeId subscribed
-      invalidateCoincidenceHeight subscribed
-      when debugInvalidateHeight $ putStrLn $ "invalidateSubscriberHeight: SubscriberCoincidenceOuter" <> showNodeId subscribed <> " done"
-  , subscriberRecalculateHeight = \_ -> do
-      when debugInvalidateHeight $ putStrLn $ "recalculateSubscriberHeight: SubscriberCoincidenceOuter" <> showNodeId subscribed
-      recalculateCoincidenceHeight subscribed
-      when debugInvalidateHeight $ putStrLn $ "recalculateSubscriberHeight: SubscriberCoincidenceOuter" <> showNodeId subscribed <> " done"
+  , subscriberInvalidateHeight  = \_ -> invalidateCoincidenceHeight subscribed
+  , subscriberRecalculateHeight = \_ -> recalculateCoincidenceHeight subscribed
   }
 
 newSubscriberCoincidenceInner :: forall x a. HasSpiderTimeline x => CoincidenceSubscribed x a -> IO (Subscriber x a)
-newSubscriberCoincidenceInner subscribed = return $ Subscriber
+newSubscriberCoincidenceInner subscribed = debugSubscriber ("SubscriberCoincidenceInner" <> showNodeId subscribed) $ Subscriber
   { subscriberPropagate = \a -> {-# SCC "traverseCoincidenceInner" #-} do
-      tracePropagate (Proxy :: Proxy x) $ "SubscriberCoincidenceInner" <> showNodeId subscribed
       occ <- liftIO $ readIORef $ coincidenceSubscribedOccurrence subscribed
       case occ of
         Just _ -> return () -- SubscriberCoincidenceOuter must have already propagated this event
@@ -522,14 +536,8 @@
           liftIO $ writeIORef (coincidenceSubscribedOccurrence subscribed) $ Just a
           scheduleClear $ coincidenceSubscribedOccurrence subscribed
           propagate a $ coincidenceSubscribedSubscribers subscribed
-  , subscriberInvalidateHeight = \_ -> do
-      when debugInvalidateHeight $ putStrLn $ "invalidateSubscriberHeight: SubscriberCoincidenceInner" <> showNodeId subscribed
-      invalidateCoincidenceHeight subscribed
-      when debugInvalidateHeight $ putStrLn $ "invalidateSubscriberHeight: SubscriberCoincidenceInner" <> showNodeId subscribed <> " done"
-  , subscriberRecalculateHeight = \_ -> do
-      when debugInvalidateHeight $ putStrLn $ "recalculateSubscriberHeight: SubscriberCoincidenceInner" <> showNodeId subscribed
-      recalculateCoincidenceHeight subscribed
-      when debugInvalidateHeight $ putStrLn $ "recalculateSubscriberHeight: SubscriberCoincidenceInner" <> showNodeId subscribed <> " done"
+  , subscriberInvalidateHeight  = \_ -> invalidateCoincidenceHeight subscribed
+  , subscriberRecalculateHeight = \_ -> recalculateCoincidenceHeight subscribed
   }
 
 invalidateSubscriberHeight :: Height -> Subscriber x a -> IO ()
@@ -539,15 +547,15 @@
 recalculateSubscriberHeight = flip subscriberRecalculateHeight
 
 -- | Propagate everything at the current height
-propagate :: a -> WeakBag (Subscriber x a) -> EventM x ()
-propagate a subscribers = withIncreasedDepth $ do
+propagate :: forall x a. HasSpiderTimeline x => a -> WeakBag (Subscriber x a) -> EventM x ()
+propagate a subscribers = withIncreasedDepth (Proxy::Proxy x) $
   -- Note: in the following traversal, we do not visit nodes that are added to the list during our traversal; they are new events, which will necessarily have full information already, so there is no need to traverse them
   --TODO: Should we check if nodes already have their values before propagating?  Maybe we're re-doing work
   WeakBag.traverse_ subscribers $ \s -> subscriberPropagate s a
 
 -- | Propagate everything at the current height
-propagateFast :: a -> FastWeakBag (Subscriber x a) -> EventM x ()
-propagateFast a subscribers = withIncreasedDepth $ do
+propagateFast :: forall x a. HasSpiderTimeline x => a -> FastWeakBag (Subscriber x a) -> EventM x ()
+propagateFast a subscribers = withIncreasedDepth (Proxy::Proxy x) $
   -- Note: in the following traversal, we do not visit nodes that are added to the list during our traversal; they are new events, which will necessarily have full information already, so there is no need to traverse them
   --TODO: Should we check if nodes already have their values before propagating?  Maybe we're re-doing work
   FastWeakBag.traverse_ subscribers $ \s -> subscriberPropagate s a
@@ -568,7 +576,7 @@
   { eventSubscribedHeightRef :: {-# UNPACK #-} !(IORef Height)
   , eventSubscribedRetained :: {-# NOUNPACK #-} !Any
 #ifdef DEBUG_CYCLES
-  , eventSubscribedGetParents :: !(IO [Some (EventSubscribed x)]) -- For debugging loops
+  , eventSubscribedGetParents :: !(IO [EventSubscribed x]) -- For debugging loops
   , eventSubscribedHasOwnHeightRef :: !Bool
   , eventSubscribedWhoCreated :: !(IO [String])
 #endif
@@ -601,7 +609,7 @@
   { eventSubscribedHeightRef = eventSubscribedHeightRef $ _eventSubscription_subscribed $ fanSubscribedParent subscribed
   , eventSubscribedRetained = toAny subscribed
 #ifdef DEBUG_CYCLES
-  , eventSubscribedGetParents = return [Some $ _eventSubscription_subscribed $ fanSubscribedParent subscribed]
+  , eventSubscribedGetParents = return [_eventSubscription_subscribed $ fanSubscribedParent subscribed]
   , eventSubscribedHasOwnHeightRef = False
   , eventSubscribedWhoCreated = whoCreatedIORef $ fanSubscribedCachedSubscribed subscribed
 #endif
@@ -614,7 +622,7 @@
 #ifdef DEBUG_CYCLES
   , eventSubscribedGetParents = do
       s <- readIORef $ switchSubscribedCurrentParent subscribed
-      return [Some $ _eventSubscription_subscribed s]
+      return [_eventSubscription_subscribed s]
   , eventSubscribedHasOwnHeightRef = True
   , eventSubscribedWhoCreated = whoCreatedIORef $ switchSubscribedCachedSubscribed subscribed
 #endif
@@ -627,8 +635,8 @@
 #ifdef DEBUG_CYCLES
   , eventSubscribedGetParents = do
       innerSubscription <- readIORef $ coincidenceSubscribedInnerParent subscribed
-      let outerParent = Some $ _eventSubscription_subscribed $ coincidenceSubscribedOuterParent subscribed
-          innerParents = maybeToList $ fmap Some innerSubscription
+      let outerParent = _eventSubscription_subscribed $ coincidenceSubscribedOuterParent subscribed
+          innerParents = maybeToList $ innerSubscription
       return $ outerParent : innerParents
   , eventSubscribedHasOwnHeightRef = True
   , eventSubscribedWhoCreated = whoCreatedIORef $ coincidenceSubscribedCachedSubscribed subscribed
@@ -642,15 +650,15 @@
 whoCreatedEventSubscribed :: EventSubscribed x -> IO [String]
 whoCreatedEventSubscribed = eventSubscribedWhoCreated
 
-walkInvalidHeightParents :: EventSubscribed x -> IO [Some (EventSubscribed x)]
+walkInvalidHeightParents :: EventSubscribed x -> IO [EventSubscribed x]
 walkInvalidHeightParents s0 = do
-  subscribers <- flip execStateT mempty $ ($ Some s0) $ fix $ \loop (Some s) -> do
+  subscribers <- flip execStateT mempty $ ($ s0) $ fix $ \loop s -> do
     h <- liftIO $ readIORef $ eventSubscribedHeightRef s
     when (h == invalidHeight) $ do
       when (eventSubscribedHasOwnHeightRef s) $ liftIO $ writeIORef (eventSubscribedHeightRef s) $! invalidHeightBeingTraversed
-      modify (Some s :)
+      modify (s :)
       mapM_ loop =<< liftIO (eventSubscribedGetParents s)
-  forM_ subscribers $ \(Some s) -> writeIORef (eventSubscribedHeightRef s) $! invalidHeight
+  forM_ subscribers $ \s -> writeIORef (eventSubscribedHeightRef s) $! invalidHeight
   return subscribers
 #endif
 
@@ -972,8 +980,10 @@
   BehaviorM x >> BehaviorM y = BehaviorM $ x >> y
   {-# INLINE return #-}
   return x = BehaviorM $ return x
+#if !MIN_VERSION_base(4,13,0)
   {-# INLINE fail #-}
   fail s = BehaviorM $ fail s
+#endif
 
 data BehaviorSubscribed x a
    = forall p. BehaviorSubscribedHold (Hold x p)
@@ -1033,7 +1043,7 @@
 newtype SomeMergeInit x = SomeMergeInit { unSomeMergeInit :: EventM x () }
 
 -- EventM can do everything BehaviorM can, plus create holds
-newtype EventM x a = EventM { unEventM :: IO a } deriving (Functor, Applicative, Monad, MonadIO, MonadFix, MonadException, MonadAsyncException) -- The environment should be Nothing if we are not in a frame, and Just if we are - in which case it is a list of assignments to be done after the frame is over
+newtype EventM x a = EventM { unEventM :: IO a } deriving (Functor, Applicative, Monad, MonadIO, MonadFix, MonadException, MonadAsyncException)
 
 newtype MergeSubscribedParent x a = MergeSubscribedParent { unMergeSubscribedParent :: EventSubscription x }
 
@@ -1058,7 +1068,8 @@
 heightBagFromList heights = heightBagVerify $ foldl' (flip heightBagAdd) heightBagEmpty heights
 
 heightBagAdd :: Height -> HeightBag -> HeightBag
-heightBagAdd (Height h) (HeightBag s c) = heightBagVerify $ HeightBag (succ s) $ IntMap.insertWithKey (\_ _ old -> succ old) h 0 c
+heightBagAdd (Height h) (HeightBag s c) = heightBagVerify $ HeightBag (succ s) $
+  IntMap.insertWithKey (\_ _ old -> succ old) h 0 c
 
 heightBagRemove :: Height -> HeightBag -> HeightBag
 heightBagRemove (Height h) b@(HeightBag s c) = heightBagVerify $ case IntMap.lookup h c of
@@ -1067,6 +1078,13 @@
     0 -> IntMap.delete h c
     _ -> IntMap.insert h (pred old) c
 
+heightBagRemoveMaybe :: Height -> HeightBag -> Maybe HeightBag
+heightBagRemoveMaybe (Height h) b@(HeightBag s c) = heightBagVerify . removed <$> IntMap.lookup h c where
+  removed old = HeightBag (pred s) $ case old of
+    0 -> IntMap.delete h c
+    _ -> IntMap.insert h (pred old) c
+
+
 heightBagMax :: HeightBag -> Height
 heightBagMax (HeightBag _ c) = case IntMap.maxViewWithKey c of
   Just ((h, _), _) -> Height h
@@ -1314,55 +1332,110 @@
   x' <- evaluate x
   mkWeakPtr x' $
     if debugFinalize
-    then Just $ putStrLn $ "finalizing: " ++ debugNote
+    then Just $ debugStrLn $ "finalizing: " ++ debugNote
     else Nothing
 
 type WeakList a = [Weak a]
 
-{-# INLINE withIncreasedDepth #-}
+type CanTrace x m = (HasSpiderTimeline x, MonadIO m)
+
+
+
+
 #ifdef DEBUG
-withIncreasedDepth :: CanTrace x m => m a -> m a
-withIncreasedDepth a = do
-  spiderTimeline <- askSpiderTimelineEnv
-  liftIO $ modifyIORef' (_spiderTimeline_depth (unSTE spiderTimeline)) succ
+
+debugSubscriber :: forall x a. HasSpiderTimeline x => String -> Subscriber x a -> IO (Subscriber x a)
+debugSubscriber description = return . debugSubscriber' description
+
+debugSubscriber' :: forall x a. HasSpiderTimeline x => String -> Subscriber x a -> Subscriber x a
+debugSubscriber' description subscribed = Subscriber
+  {
+    subscriberPropagate = \m -> do
+      tracePropagate (Proxy :: Proxy x) ("subscriberPropagate: " <> description)
+      subscriberPropagate subscribed m
+  , subscriberInvalidateHeight = \old -> do
+      traceInvalidateHeight $ "invalidateSubscriberHeight: " <> description <> ", old = " <> show (unHeight old)
+      subscriberInvalidateHeight subscribed old
+      traceInvalidateHeight $ "invalidateSubscriberHeight: " <> description <> ", done"
+  , subscriberRecalculateHeight = \new -> do
+      traceInvalidateHeight $ "subscriberRecalculateHeight: " <> description <> ", new = " <> show (unHeight new)
+      subscriberRecalculateHeight subscribed new
+      traceInvalidateHeight $ "subscriberRecalculateHeight: " <> description <> ", done"
+  }
+
+
+{-# INLINE withIncreasedDepth #-}
+withIncreasedDepth :: forall proxy x m a. CanTrace x m => proxy x -> m a -> m a
+withIncreasedDepth _ a = do
+  liftIO $ modifyIORef' (_spiderTimeline_depth $ unSTE (spiderTimeline :: SpiderTimelineEnv x)) succ
   result <- a
-  liftIO $ modifyIORef' (_spiderTimeline_depth (unSTE spiderTimeline)) pred
+  liftIO $ modifyIORef' (_spiderTimeline_depth $ unSTE (spiderTimeline :: SpiderTimelineEnv x)) pred
   return result
-#else
-withIncreasedDepth :: m a -> m a
-withIncreasedDepth = id
-#endif
 
-type CanTrace x m = (HasSpiderTimeline x, MonadIO m)
-
 {-# INLINE tracePropagate #-}
 tracePropagate :: (CanTrace x m) => proxy x -> String -> m ()
-tracePropagate p = traceWhen p debugPropagate
+tracePropagate p = when debugPropagate . trace p
 
 {-# INLINE traceInvalidate #-}
 traceInvalidate :: String -> IO ()
-traceInvalidate = when debugInvalidate . liftIO . putStrLn
+traceInvalidate = when debugInvalidate . liftIO . debugStrLn
 
-{-# INLINE traceWhen #-}
-traceWhen :: (CanTrace x m) => proxy x -> Bool -> String -> m ()
-traceWhen p b message = traceMWhen p b $ return message
+{-# INLINE traceInvalidateHeight #-}
+traceInvalidateHeight :: String -> IO ()
+traceInvalidateHeight = when debugInvalidateHeight . liftIO . debugStrLn
 
-{-# INLINE traceMWhen #-}
-traceMWhen :: (CanTrace x m) => proxy x -> Bool -> m String -> m ()
-traceMWhen _ b getMessage = when b $ do
+{-# INLINE trace #-}
+trace :: (CanTrace x m) => proxy x ->  String -> m ()
+trace p message = traceM p $ return message
+
+{-# INLINE traceM #-}
+traceM :: forall x proxy m. (CanTrace x m) => proxy x -> m String -> m ()
+traceM _ getMessage = do
   message <- getMessage
-#ifdef DEBUG
-  spiderTimeline <- askSpiderTimelineEnv
-  d <- liftIO $ readIORef $ _spiderTimeline_depth $ unSTE spiderTimeline
+  d <- liftIO $ readIORef $ _spiderTimeline_depth $ unSTE (spiderTimeline :: SpiderTimelineEnv x)
+  liftIO $ debugStrLn $ replicate d ' ' <> message
+
 #else
-  let d = 0
+
+{-# INLINE withIncreasedDepth #-}
+withIncreasedDepth ::  proxy x -> m a -> m a
+withIncreasedDepth _ = id
+
+{-# INLINE tracePropagate #-}
+tracePropagate :: (CanTrace x m) => proxy x -> String -> m ()
+tracePropagate _ _ = return ()
+
+{-# INLINE traceInvalidate #-}
+traceInvalidate :: String -> IO ()
+traceInvalidate _ = return ()
+
+{-# INLINE traceInvalidateHeight #-}
+traceInvalidateHeight :: String -> IO ()
+traceInvalidateHeight _ = return ()
+
+{-# INLINE debugSubscriber #-}
+debugSubscriber :: String -> Subscriber x a -> IO (Subscriber x a)
+debugSubscriber _ = return
+
+{-# INLINE debugSubscriber' #-}
+debugSubscriber' :: String -> Subscriber x a -> Subscriber x a
+debugSubscriber' _ = id
+
+
+
+{-# INLINE trace #-}
+trace :: (CanTrace x m) => proxy x ->  String -> m ()
+trace _ _ = return ()
+
+{-# INLINE traceM #-}
+traceM :: (CanTrace x m) => proxy x -> m String -> m ()
+traceM _ _ = return ()
+
 #endif
-  liftIO $ putStrLn $ replicate d ' ' <> message
 
 whoCreatedIORef :: IORef a -> IO [String]
 whoCreatedIORef (IORef a) = whoCreated $! a
 
-#ifdef DEBUG_CYCLES
 groupByHead :: Eq a => [NonEmpty a] -> [(a, NonEmpty [a])]
 groupByHead = \case
   [] -> []
@@ -1373,20 +1446,54 @@
       | otherwise -> (x, xs :| []) : l
 
 listsToForest :: Eq a => [[a]] -> Forest a
-listsToForest l = fmap (\(a, l') -> Node a $ listsToForest $ toList l') $ groupByHead $ catMaybes $ fmap nonEmpty l
+listsToForest lists = buildForest <$> groupByHead (mapMaybe nonEmpty lists)
+    where buildForest (a, lists') = Node a $ listsToForest $ toList lists'
+
+showStacks :: [[String]] -> String
+showStacks = drawForest . listsToForest . fmap (filterStack "Reflex.Spider.Internal")
+
+filterStack :: String -> [String] -> [String]
+#ifdef DEBUG_HIDE_INTERNALS
+filterStack prefix = filter (not . (prefix `isPrefixOf`))
+#else
+filterStack prefix = id
 #endif
 
+#ifdef DEBUG_CYCLES
+
+data EventLoopException = EventLoopException [[String]]
+instance Exception EventLoopException
+
+instance Show EventLoopException where
+  show (EventLoopException stacks) = "causality loop detected:\n" <> if null stacks
+    then "no location information, compile with profiling enabled for stack tree"
+    else showStacks stacks
+
+#else
+
+data EventLoopException = EventLoopException
+instance Exception EventLoopException
+
+instance Show EventLoopException where
+  show EventLoopException = "causality loop detected: \n" <>
+    "compile reflex with flag 'debug-cycles' and compile with profiling enabled for stack tree"
+
+#endif
+
+
 {-# INLINE propagateSubscriberHold #-}
 propagateSubscriberHold :: forall x p. (HasSpiderTimeline x, Patch p) => Hold x p -> p -> EventM x ()
 propagateSubscriberHold h a = do
-  {-# SCC "trace" #-} traceMWhen (Proxy :: Proxy x) debugPropagate $ liftIO $ do
+  {-# SCC "trace" #-} when debugPropagate $ traceM (Proxy :: Proxy x) $ liftIO $ do
     invalidators <- liftIO $ readIORef $ holdInvalidators h
     return $ "SubscriberHold" <> showNodeId h <> ": " ++ show (length invalidators)
+
   v <- {-# SCC "read" #-} liftIO $ readIORef $ holdValue h
   case {-# SCC "apply" #-} apply a v of
     Nothing -> return ()
     Just v' -> do
-      {-# SCC "trace2" #-} withIncreasedDepth $ tracePropagate (Proxy :: Proxy x) $ "propagateSubscriberHold: assigning Hold" <> showNodeId h
+      {-# SCC "trace2" #-} withIncreasedDepth (Proxy :: Proxy x) $
+        tracePropagate (Proxy :: Proxy x) ("propagateSubscriberHold: assigning Hold" <> showNodeId h)
       vRef <- {-# SCC "vRef" #-} liftIO $ evaluate $ holdValue h
       iRef <- {-# SCC "iRef" #-} liftIO $ evaluate $ holdInvalidators h
       defer $ {-# SCC "assignment" #-} SomeAssignment vRef iRef v'
@@ -1440,7 +1547,7 @@
 zeroRef :: IORef Height
 zeroRef = unsafePerformIO $ newIORef zeroHeight
 
-getRootSubscribed :: GCompare k => k a -> Root x k -> Subscriber x a -> IO (WeakBagTicket, RootSubscribed x a, Maybe a)
+getRootSubscribed :: forall k x a. (GCompare k, HasSpiderTimeline x) => k a -> Root x k -> Subscriber x a -> IO (WeakBagTicket, RootSubscribed x a, Maybe a)
 getRootSubscribed k r sub = do
   mSubscribed <- readIORef $ rootSubscribed r
   let getOcc = fmap (coerce . DMap.lookup k) $ readIORef $ rootOccurrence r
@@ -1454,7 +1561,9 @@
       let !cached = rootSubscribed r
       uninitRef <- newIORef $ error "getRootsubscribed: uninitRef not initialized"
       (subs, sln) <- WeakBag.singleton sub weakSelf cleanupRootSubscribed
-      when debugPropagate $ putStrLn $ "getRootSubscribed: calling rootInit"
+
+      tracePropagate (Proxy::Proxy x) $  "getRootSubscribed: calling rootInit"
+
       uninit <- rootInit r k $ RootTrigger (subs, rootOccurrence r, k)
       writeIORef uninitRef $! uninit
 #ifdef DEBUG_NODEIDS
@@ -1504,6 +1613,9 @@
   { _fanInt_subscribers :: {-# UNPACK #-} !(FastMutableIntMap (FastWeakBag (Subscriber x a))) --TODO: Clean up the keys in here when their child weak bags get empty --TODO: Remove our own subscription when the subscribers list is completely empty
   , _fanInt_subscriptionRef :: {-# UNPACK #-} !(IORef (EventSubscription x)) -- This should have a valid subscription iff subscribers is non-empty
   , _fanInt_occRef :: {-# UNPACK #-} !(IORef (IntMap a))
+#ifdef DEBUG_NODEIDS
+  , _fanInt_nodeId :: {-# UNPACK #-} !Int
+#endif
   }
 
 newFanInt :: IO (FanInt x a)
@@ -1511,10 +1623,16 @@
   subscribers <- FastMutableIntMap.newEmpty --TODO: Clean up the keys in here when their child weak bags get empty --TODO: Remove our own subscription when the subscribers list is completely empty
   subscriptionRef <- newIORef $ error "fanInt: no subscription"
   occRef <- newIORef $ error "fanInt: no occurrence"
+#ifdef DEBUG_NODEIDS
+  nodeId <- newNodeId
+#endif
   return $ FanInt
     { _fanInt_subscribers = subscribers
     , _fanInt_subscriptionRef = subscriptionRef
     , _fanInt_occRef = occRef
+#ifdef DEBUG_NODEIDS
+    , _fanInt_nodeId = nodeId
+#endif
     }
 
 fanInt :: HasSpiderTimeline x => Event x (IntMap a) -> EventSelectorInt x a
@@ -1523,20 +1641,21 @@
   pure $ EventSelectorInt $ \k -> Event $ \sub -> do
     isEmpty <- liftIO $ FastMutableIntMap.isEmpty (_fanInt_subscribers self)
     when isEmpty $ do -- This is the first subscriber, so we need to subscribe to our input
-      (subscription, parentOcc) <- subscribeAndRead p $ Subscriber
+      let desc = "fanInt" <> showNodeId self <> ", k = "  <> show k
+      (subscription, parentOcc) <- subscribeAndRead p $ debugSubscriber' desc $ Subscriber
         { subscriberPropagate = \m -> do
             liftIO $ writeIORef (_fanInt_occRef self) m
             scheduleIntClear $ _fanInt_occRef self
-            FastMutableIntMap.forIntersectionWithImmutable_ (_fanInt_subscribers self) m $ \b v -> do --TODO: Do we need to know that no subscribers are being added as we traverse?
-              FastWeakBag.traverse_ b $ \s -> do
+            FastMutableIntMap.forIntersectionWithImmutable_ (_fanInt_subscribers self) m $ \b v ->  --TODO: Do we need to know that no subscribers are being added as we traverse?
+              FastWeakBag.traverse_ b $ \s ->
                 subscriberPropagate s v
-        , subscriberInvalidateHeight = \old -> do
-            FastMutableIntMap.for_ (_fanInt_subscribers self) $ \b -> do
-              FastWeakBag.traverse_ b $ \s -> do
+        , subscriberInvalidateHeight = \old ->
+            FastMutableIntMap.for_ (_fanInt_subscribers self) $ \b ->
+              FastWeakBag.traverse_ b $ \s ->
                 subscriberInvalidateHeight s old
-        , subscriberRecalculateHeight = \new -> do
-            FastMutableIntMap.for_ (_fanInt_subscribers self) $ \b -> do
-              FastWeakBag.traverse_ b $ \s -> do
+        , subscriberRecalculateHeight = \new ->
+            FastMutableIntMap.for_ (_fanInt_subscribers self) $ \b ->
+              FastWeakBag.traverse_ b $ \s ->
                 subscriberRecalculateHeight s new
         }
       liftIO $ do
@@ -1550,11 +1669,26 @@
           FastMutableIntMap.insert (_fanInt_subscribers self) k b
           return b
         Just b -> return b
-      t <- liftIO $ FastWeakBag.insert sub b
+      ticket <- liftIO $ FastWeakBag.insert sub b
       currentOcc <- readIORef (_fanInt_occRef self)
-      (EventSubscription _ (EventSubscribed !heightRef _)) <- readIORef (_fanInt_subscriptionRef self)
-      return (EventSubscription (FastWeakBag.remove t) $! EventSubscribed heightRef $! toAny (_fanInt_subscriptionRef self, t), IntMap.lookup k currentOcc)
 
+      subscribed <- fanIntSubscribed ticket self
+      return (EventSubscription (FastWeakBag.remove ticket) subscribed, IntMap.lookup k currentOcc)
+
+fanIntSubscribed :: FastWeakBagTicket k -> FanInt x a -> IO (EventSubscribed x)
+fanIntSubscribed ticket self = do
+  subscribedParent <- _eventSubscription_subscribed <$> readIORef (_fanInt_subscriptionRef self)
+  return $ EventSubscribed
+    { eventSubscribedHeightRef = eventSubscribedHeightRef subscribedParent
+    , eventSubscribedRetained = toAny (_fanInt_subscriptionRef self, ticket)
+#ifdef DEBUG_CYCLES
+    , eventSubscribedGetParents = return [subscribedParent]
+    , eventSubscribedHasOwnHeightRef = False
+    , eventSubscribedWhoCreated = whoCreatedIORef $ _fanInt_subscriptionRef self
+#endif
+    }
+
+
 {-# INLINABLE getFanSubscribed #-}
 getFanSubscribed :: (HasSpiderTimeline x, GCompare k) => k a -> Fan x k v -> Subscriber x (v a) -> EventM x (WeakBagTicket, FanSubscribed x k v, Maybe (v a))
 getFanSubscribed k f sub = do
@@ -1751,7 +1885,7 @@
   => (forall a. q a -> Event x (v a))
   -> DynamicS x (PatchDMap k q)
   -> Event x (DMap k v)
-mergeCheap nt = mergeGCheap' getInitialSubscribers updateMe destroy
+mergeCheap nt = mergeGCheap' unMergeSubscribedParent getInitialSubscribers updateMe destroy
   where
       updateMe :: MergeUpdateFunc k v x (PatchDMap k q) (MergeSubscribedParent x)
       updateMe subscriber heightBagRef oldParents (PatchDMap p) = do
@@ -1766,7 +1900,9 @@
                   liftIO $ modifyIORef' heightBagRef $ heightBagAdd newParentHeight
                   return $ DMap.insertLookupWithKey' (\_ new _ -> new) k newParent ps
               forM_ mOldSubd $ \oldSubd -> do
-                oldHeight <- liftIO $ getEventSubscribedHeight $ _eventSubscription_subscribed $ unMergeSubscribedParent oldSubd
+                oldHeight <- liftIO $ getEventSubscribedHeight $
+                  _eventSubscription_subscribed $ unMergeSubscribedParent oldSubd
+
                 liftIO $ modifyIORef heightBagRef $ heightBagRemove oldHeight
               return (maybeToList (unMergeSubscribedParent <$> mOldSubd) ++ subscriptionsToKill, newPs)
         foldM f ([], oldParents) $ DMap.toList p
@@ -1791,7 +1927,7 @@
   => (forall a. q a -> Event x (v a))
   -> DynamicS x (PatchDMapWithMove k q)
   -> Event x (DMap k v)
-mergeCheapWithMove nt = mergeGCheap' getInitialSubscribers updateMe destroy
+mergeCheapWithMove nt = mergeGCheap' _mergeSubscribedParentWithMove_subscription getInitialSubscribers updateMe destroy
   where
       updateMe :: MergeUpdateFunc k v x (PatchDMapWithMove k q) (MergeSubscribedParentWithMove x k)
       updateMe subscriber heightBagRef oldParents p = do
@@ -1810,13 +1946,17 @@
         let moveOrDelete :: forall a. k a -> PatchDMapWithMove.NodeInfo k q a -> MergeSubscribedParentWithMove x k a -> Constant (EventM x (Maybe (EventSubscription x))) a
             moveOrDelete _ ni parent = Constant $ case getComposeMaybe $ PatchDMapWithMove._nodeInfo_to ni of
               Nothing -> do
-                oldHeight <- liftIO $ getEventSubscribedHeight $ _eventSubscription_subscribed $ _mergeSubscribedParentWithMove_subscription parent
+                oldHeight <- liftIO $ getEventSubscribedHeight $ _eventSubscription_subscribed $
+                  _mergeSubscribedParentWithMove_subscription parent
+
                 liftIO $ modifyIORef heightBagRef $ heightBagRemove oldHeight
                 return $ Just $ _mergeSubscribedParentWithMove_subscription parent
               Just toKey -> do
                 liftIO $ writeIORef (_mergeSubscribedParentWithMove_key parent) $! toKey
                 return Nothing
-        toDelete <- fmap catMaybes $ mapM (\(_ :=> v) -> getConstant v) $ DMap.toList $ DMap.intersectionWithKey moveOrDelete (unPatchDMapWithMove p) oldParents
+        toDelete <- fmap catMaybes $ mapM (\(_ :=> v) -> getConstant v) $ DMap.toList $
+          DMap.intersectionWithKey moveOrDelete (unPatchDMapWithMove p) oldParents
+
         return (toDelete, applyAlways p' oldParents)
       getInitialSubscribers :: MergeInitFunc k v q x (MergeSubscribedParentWithMove x k)
       getInitialSubscribers initialParents subscriber = do
@@ -1841,6 +1981,8 @@
   -> p
   -> EventM x ([EventSubscription x], DMap k s)
 
+type MergeGetSubscription x s = forall a. s a -> EventSubscription x
+
 type MergeInitFunc k v q x s
    = DMap k q
   -> (forall a. EventM x (k a) -> Subscriber x (v a))
@@ -1864,14 +2006,17 @@
 invalidateMergeHeight' :: IORef Height -> Subscriber x a -> IO ()
 invalidateMergeHeight' heightRef sub = do
   oldHeight <- readIORef heightRef
-  when (oldHeight /= invalidHeight) $ do -- If the height used to be valid, it must be invalid now; we should never have *more* heights than we have parents
+  -- If the height used to be valid, it must be invalid now; we should never have *more* heights than we have parents
+  when (oldHeight /= invalidHeight) $ do
     writeIORef heightRef $! invalidHeight
     subscriberInvalidateHeight sub oldHeight
 
 revalidateMergeHeight :: Merge x k v s -> IO ()
 revalidateMergeHeight m = do
   currentHeight <- readIORef $ _merge_heightRef m
-  when (currentHeight == invalidHeight) $ do -- revalidateMergeHeight may be called multiple times; perhaps the's a way to finesse it to avoid this check
+
+  -- revalidateMergeHeight may be called multiple times; perhaps the's a way to finesse it to avoid this check
+  when (currentHeight == invalidHeight) $ do
     heights <- readIORef $ _merge_heightBagRef m
     parents <- readIORef $ _merge_parentsRef m
     -- When the number of heights in the bag reaches the number of parents, we should have a valid height
@@ -1879,7 +2024,7 @@
       LT -> return ()
       EQ -> do
         let height = succHeight $ heightBagMax heights
-        when debugInvalidateHeight $ putStrLn $ "recalculateSubscriberHeight: height: " <> show height
+        traceInvalidateHeight $ "recalculateSubscriberHeight: height: " <> show height
         writeIORef (_merge_heightRef m) $! height
         subscriberRecalculateHeight (_merge_sub m) height
       GT -> error $ "revalidateMergeHeight: more heights (" <> show (heightBagSize heights) <> ") than parents (" <> show (DMap.size parents) <> ") for Merge"
@@ -1887,36 +2032,45 @@
 scheduleMergeSelf :: HasSpiderTimeline x => Merge x k v s -> Height -> EventM x ()
 scheduleMergeSelf m height = scheduleMerge' height (_merge_heightRef m) $ do
   vals <- liftIO $ readIORef $ _merge_accumRef m
-  liftIO $ writeIORef (_merge_accumRef m) $! DMap.empty -- Once we're done with this, we can clear it immediately, because if there's a cacheEvent in front of us, it'll handle subsequent subscribers, and if not, we won't get subsequent subscribers
+  -- Once we're done with this, we can clear it immediately, because if there's a cacheEvent in front of us,
+  -- it'll handle subsequent subscribers, and if not, we won't get subsequent subscribers
+  liftIO $ writeIORef (_merge_accumRef m) $! DMap.empty
   --TODO: Assert that m is not empty
   subscriberPropagate (_merge_sub m) vals
 
-mergeSubscriber :: forall x k v s a. (HasSpiderTimeline x, GCompare k) => Merge x k v s -> EventM x (k a) -> Subscriber x (v a)
-mergeSubscriber m getKey = Subscriber
+checkCycle :: HasSpiderTimeline x => EventSubscribed x -> EventM x ()
+checkCycle subscribed = liftIO $ do
+    height <- readIORef (eventSubscribedHeightRef subscribed)
+
+    -- currentHeight <- getCurrentHeight
+    -- when (height <= currentHeight) $ if height /= invalidHeight
+    --     then do
+    --       myStack <- liftIO $ whoCreatedIORef undefined --TODO
+    --       error $ "Height (" ++ show height ++ ") is not greater than current height (" ++ show currentHeight ++ ")\n" ++ unlines (reverse myStack)
+    --     else liftIO $
+    when (height == invalidHeight) $
+#ifdef DEBUG_CYCLES
+          do
+            nodesInvolvedInCycle <- walkInvalidHeightParents subscribed
+            stacks <- forM nodesInvolvedInCycle whoCreatedEventSubscribed
+            throwIO (EventLoopException stacks)
+#else
+          throwIO EventLoopException
+#endif
+
+
+mergeSubscriber :: forall x k v s a. (HasSpiderTimeline x, GCompare k) => EventSubscribed x -> Merge x k v s -> EventM x (k a) -> Subscriber x (v a)
+mergeSubscriber subscribed m getKey = Subscriber
   { subscriberPropagate = \a -> do
       oldM <- liftIO $ readIORef $ _merge_accumRef m
       k <- getKey
-      let newM = DMap.insertWith (error $ "Same key fired multiple times for Merge") k a oldM
+      let newM = DMap.insertWith (error "Same key fired multiple times for Merge") k a oldM
       tracePropagate (Proxy :: Proxy x) $ "  DMap.size oldM = " <> show (DMap.size oldM) <> "; DMap.size newM = " <> show (DMap.size newM)
       liftIO $ writeIORef (_merge_accumRef m) $! newM
       when (DMap.null oldM) $ do -- Only schedule the firing once
         height <- liftIO $ readIORef $ _merge_heightRef m
-        --TODO: assertions about height
-        currentHeight <- getCurrentHeight
-        when (height <= currentHeight) $ do
-          if height /= invalidHeight
-            then do
-            myStack <- liftIO $ whoCreatedIORef undefined --TODO
-            error $ "Height (" ++ show height ++ ") is not greater than current height (" ++ show currentHeight ++ ")\n" ++ unlines (reverse myStack)
-            else liftIO $ do
-#ifdef DEBUG_CYCLES
-            nodesInvolvedInCycle <- walkInvalidHeightParents $ eventSubscribedMerge subscribed
-            stacks <- forM nodesInvolvedInCycle $ \(Some es) -> whoCreatedEventSubscribed es
-            let cycleInfo = ":\n" <> drawForest (listsToForest stacks)
-#else
-            let cycleInfo = ""
-#endif
-            error $ "Causality loop found" <> cycleInfo
+        checkCycle subscribed
+
         scheduleMergeSelf m height
   , subscriberInvalidateHeight = \old -> do --TODO: When removing a parent doesn't actually change the height, maybe we can avoid invalidating
       modifyIORef' (_merge_heightBagRef m) $ heightBagRemove old
@@ -1927,31 +2081,45 @@
   }
 
 --TODO: Be able to run as much of this as possible promptly
-updateMerge :: (HasSpiderTimeline x, GCompare k) => Merge x k v s -> MergeUpdateFunc k v x p s -> p -> SomeMergeUpdate x
-updateMerge m updateFunc p = SomeMergeUpdate updateMe (invalidateMergeHeight m) (revalidateMergeHeight m)
+updateMerge :: (HasSpiderTimeline x, GCompare k) => EventSubscribed x -> Merge x k v s -> MergeUpdateFunc k v x p s -> p -> SomeMergeUpdate x
+updateMerge subscribed m updateFunc p = SomeMergeUpdate updateMe (invalidateMergeHeight m) (revalidateMergeHeight m)
   where updateMe = do
           oldParents <- liftIO $ readIORef $ _merge_parentsRef m
-          (subscriptionsToKill, newParents) <- updateFunc (mergeSubscriber m) (_merge_heightBagRef m) oldParents p
+          (subscriptionsToKill, newParents) <- updateFunc (mergeSubscriber subscribed m) (_merge_heightBagRef m) oldParents p
           liftIO $ writeIORef (_merge_parentsRef m) $! newParents
           return subscriptionsToKill
 
 {-# INLINE mergeGCheap' #-}
 mergeGCheap' :: forall k v x p s q. (HasSpiderTimeline x, GCompare k, PatchTarget p ~ DMap k q)
-  => MergeInitFunc k v q x s -> MergeUpdateFunc k v x p s -> MergeDestroyFunc k s -> DynamicS x p -> Event x (DMap k v)
-mergeGCheap' getInitialSubscribers updateFunc destroy d = Event $ \sub -> do
+  => MergeGetSubscription x s -> MergeInitFunc k v q x s -> MergeUpdateFunc k v x p s -> MergeDestroyFunc k s -> DynamicS x p -> Event x (DMap k v)
+mergeGCheap' getParent getInitialSubscribers updateFunc destroy d = Event $ \sub -> do
   initialParents <- readBehaviorUntracked $ dynamicCurrent d
   accumRef <- liftIO $ newIORef $ error "merge: accumRef not yet initialized"
   heightRef <- liftIO $ newIORef $ error "merge: heightRef not yet initialized"
   heightBagRef <- liftIO $ newIORef $ error "merge: heightBagRef not yet initialized"
   parentsRef :: IORef (DMap k s) <- liftIO $ newIORef $ error "merge: parentsRef not yet initialized"
-  let m = Merge
+  changeSubdRef <- liftIO $ newIORef $ error "getMergeSubscribed: changeSubdRef not yet initialized"
+
+  let subscribed = EventSubscribed
+        { eventSubscribedHeightRef = heightRef
+        , eventSubscribedRetained = toAny (parentsRef, changeSubdRef)
+#ifdef DEBUG_CYCLES
+      , eventSubscribedGetParents = do
+          let getParent' (_ :=> v) = _eventSubscription_subscribed (getParent v)
+          fmap getParent' . DMap.toList  <$> readIORef parentsRef
+      , eventSubscribedHasOwnHeightRef = False
+      , eventSubscribedWhoCreated = whoCreatedIORef heightRef
+#endif
+      }
+
+      m = Merge
         { _merge_parentsRef = parentsRef
         , _merge_heightBagRef = heightBagRef
         , _merge_heightRef = heightRef
         , _merge_sub = sub
         , _merge_accumRef = accumRef
         }
-  (dm, heights, initialParentState) <- getInitialSubscribers initialParents $ mergeSubscriber m
+  (dm, heights, initialParentState) <- getInitialSubscribers initialParents $ mergeSubscriber subscribed m
   let myHeightBag = heightBagFromList $ filter (/= invalidHeight) heights
       myHeight = if invalidHeight `elem` heights
                  then invalidHeight
@@ -1960,32 +2128,30 @@
   let (occ, accum) = if currentHeight >= myHeight -- If we should have fired by now
                      then (if DMap.null dm then Nothing else Just dm, DMap.empty)
                      else (Nothing, dm)
-  unless (DMap.null accum) $ do
-    scheduleMergeSelf m myHeight
+  unless (DMap.null accum) $ scheduleMergeSelf m myHeight
   liftIO $ writeIORef accumRef $! accum
   liftIO $ writeIORef heightRef $! myHeight
   liftIO $ writeIORef heightBagRef $! myHeightBag
-  changeSubdRef <- liftIO $ newIORef $ error "getMergeSubscribed: changeSubdRef not yet initialized"
   liftIO $ writeIORef parentsRef $! initialParentState
   defer $ SomeMergeInit $ do
-    let s = Subscriber
+    let changeSubscriber = Subscriber
           { subscriberPropagate = \a -> {-# SCC "traverseMergeChange" #-} do
-              tracePropagate (Proxy :: Proxy x) $ "SubscriberMerge/Change"
-              defer $ updateMerge m updateFunc a
+              tracePropagate (Proxy :: Proxy x) "SubscriberMerge/Change"
+              defer $ updateMerge subscribed m updateFunc a
           , subscriberInvalidateHeight = \_ -> return ()
           , subscriberRecalculateHeight = \_ -> return ()
           }
-    (changeSubscription, change) <- subscribeAndRead (dynamicUpdated d) s
-    forM_ change $ \c -> defer $ updateMerge m updateFunc c
+    (changeSubscription, change) <- subscribeAndRead (dynamicUpdated d) changeSubscriber
+    forM_ change $ \c -> defer $ updateMerge subscribed m updateFunc c
     -- We explicitly hold on to the unsubscribe function from subscribing to the update event.
     -- If we don't do this, there are certain cases where mergeCheap will fail to properly retain
     -- its subscription.
-    liftIO $ writeIORef changeSubdRef (s, changeSubscription)
+    liftIO $ writeIORef changeSubdRef (changeSubscriber, changeSubscription)
   let unsubscribeAll = destroy =<< readIORef parentsRef
-  return ( EventSubscription unsubscribeAll $ EventSubscribed heightRef $ toAny (parentsRef, changeSubdRef)
-         , occ
-         )
 
+  return (EventSubscription unsubscribeAll subscribed, occ)
+
+
 mergeInt :: forall x a. (HasSpiderTimeline x) => DynamicS x (PatchIntMap (Event x a)) -> Event x (IntMap a)
 mergeInt = cacheEvent . mergeIntCheap
 
@@ -1997,13 +2163,22 @@
   heightRef <- liftIO $ newIORef zeroHeight
   heightBagRef <- liftIO $ newIORef heightBagEmpty
   parents <- liftIO $ FastMutableIntMap.newEmpty
+  changeSubdRef <- liftIO $ newIORef $ error "getMergeSubscribed: changeSubdRef not yet initialized"
+  let subscribed = EventSubscribed
+        { eventSubscribedHeightRef = heightRef
+        , eventSubscribedRetained = toAny (parents, changeSubdRef)
+#ifdef DEBUG_CYCLES
+        , eventSubscribedGetParents = fmap (_eventSubscription_subscribed . snd) <$> FastMutableIntMap.toList parents
+        , eventSubscribedHasOwnHeightRef = False
+        , eventSubscribedWhoCreated = whoCreatedIORef heightRef
+#endif
+        }
   let scheduleSelf = do
         height <- liftIO $ readIORef $ heightRef
         scheduleMerge' height heightRef $ do
           vals <- liftIO $ FastMutableIntMap.getFrozenAndClear accum
           subscriberPropagate sub vals
-      invalidateMyHeight = do
-        invalidateMergeHeight' heightRef sub
+      invalidateMyHeight = invalidateMergeHeight' heightRef sub
       recalculateMyHeight = do
         currentHeight <- readIORef heightRef
         when (currentHeight == invalidHeight) $ do --TODO: This will almost always be true; can we get rid of this check and just proceed to the next one always?
@@ -2013,12 +2188,14 @@
             LT -> return ()
             EQ -> do
               let height = succHeight $ heightBagMax heights
-              when debugInvalidateHeight $ putStrLn $ "recalculateSubscriberHeight: height: " <> show height
+              traceInvalidateHeight $ "recalculateSubscriberHeight: height: " <> show height
               writeIORef heightRef $! height
               subscriberRecalculateHeight sub height
             GT -> error $ "revalidateMergeHeight: more heights (" <> show (heightBagSize heights) <> ") than parents (" <> show numParents <> ") for Merge"
       mySubscriber k = Subscriber
         { subscriberPropagate = \a -> do
+            checkCycle subscribed
+
             wasEmpty <- liftIO $ FastMutableIntMap.isEmpty accum
             liftIO $ FastMutableIntMap.insert accum k a
             when wasEmpty scheduleSelf
@@ -2052,7 +2229,6 @@
          else liftIO $ Just <$> FastMutableIntMap.getFrozenAndClear accum
     else do when (not isEmpty) scheduleSelf -- We have things accumulated, but we shouldn't have fired them yet
             return Nothing
-  changeSubdRef <- liftIO $ newIORef $ error "getMergeSubscribed: changeSubdRef not yet initialized"
   defer $ SomeMergeInit $ do
     let updateMe a = SomeMergeUpdate u invalidateMyHeight recalculateMyHeight
           where
@@ -2066,26 +2242,28 @@
               oldParents <- liftIO $ FastMutableIntMap.applyPatch parents newSubscriptions
               liftIO $ for_ oldParents $ \oldParent -> do
                 oldParentHeight <- getEventSubscribedHeight $ _eventSubscription_subscribed oldParent
+
+                print ("updateMe", oldParentHeight)
                 modifyIORef' heightBagRef $ heightBagRemove oldParentHeight
               return $ IntMap.elems oldParents
-    let s = Subscriber
+    let changeSubscriber = Subscriber
           { subscriberPropagate = \a -> {-# SCC "traverseMergeChange" #-} do
               tracePropagate (Proxy :: Proxy x) $ "SubscriberMergeInt/Change"
               defer $ updateMe a
           , subscriberInvalidateHeight = \_ -> return ()
           , subscriberRecalculateHeight = \_ -> return ()
           }
-    (changeSubscription, change) <- subscribeAndRead (dynamicUpdated d) s
+    (changeSubscription, change) <- subscribeAndRead (dynamicUpdated d) changeSubscriber
     forM_ change $ \c -> defer $ updateMe c
     -- We explicitly hold on to the unsubscribe function from subscribing to the update event.
     -- If we don't do this, there are certain cases where mergeCheap will fail to properly retain
     -- its subscription.
-    liftIO $ writeIORef changeSubdRef (s, changeSubscription)
+    liftIO $ writeIORef changeSubdRef (changeSubscriber, changeSubscription)
   let unsubscribeAll = traverse_ unsubscribe =<< FastMutableIntMap.getFrozenAndClear parents
-  return ( EventSubscription unsubscribeAll $ EventSubscribed heightRef $ toAny (parents, changeSubdRef)
-         , occ
-         )
 
+
+  return (EventSubscription unsubscribeAll subscribed, occ)
+
 newtype EventSelector x k = EventSelector { select :: forall a. k a -> Event x a }
 newtype EventSelectorG x k v = EventSelectorG { selectG :: forall a. k a -> Event x (v a) }
 
@@ -2167,19 +2345,19 @@
   coincidenceInfos <- readIORef $ eventEnvResetCoincidences env
   forM_ toAssign $ \(SomeAssignment vRef iRef v) -> {-# SCC "assignment" #-} do
     writeIORef vRef v
-    when debugInvalidate $ putStrLn $ "Invalidating Hold"
+    traceInvalidate $ "Invalidating Hold"
     writeIORef iRef =<< evaluate =<< invalidate toReconnectRef =<< readIORef iRef
   mergeUpdates <- readIORef $ eventEnvMergeUpdates env
   writeIORef (eventEnvMergeUpdates env) []
-  when debugPropagate $ putStrLn "Updating merges"
+  tracePropagate (Proxy::Proxy x) $ "Updating merges"
   mergeSubscriptionsToKill <- runEventM $ concat <$> mapM _someMergeUpdate_update mergeUpdates
-  when debugPropagate $ putStrLn "Updating merges done"
+  tracePropagate (Proxy::Proxy x) $ "Updating merges done"
   toReconnect <- readIORef toReconnectRef
   clearEventEnv env
   switchSubscriptionsToKill <- forM toReconnect $ \(SomeSwitchSubscribed subscribed) -> {-# SCC "switchSubscribed" #-} do
     oldSubscription <- readIORef $ switchSubscribedCurrentParent subscribed
     wi <- readIORef $ switchSubscribedOwnWeakInvalidator subscribed
-    when debugInvalidate $ putStrLn $ "Finalizing invalidator for Switch" <> showNodeId subscribed
+    traceInvalidate $ "Finalizing invalidator for Switch" <> showNodeId subscribed
     finalize wi
     i <- evaluate $ switchSubscribedOwnInvalidator subscribed
     wi' <- mkWeakPtrWithDebug i "wi'"
@@ -2193,7 +2371,7 @@
     subscription <- unSpiderHost $ runFrame $ {-# SCC "subscribeSwitch" #-} subscribe e sub --TODO: Assert that the event isn't firing --TODO: This should not loop because none of the events should be firing, but still, it is inefficient
     {-
     stackTrace <- liftIO $ fmap renderStack $ ccsToStrings =<< (getCCSOf $! switchSubscribedParent subscribed)
-    liftIO $ putStrLn $ (++stackTrace) $ "subd' subscribed to " ++ case e of
+    liftIO $ debugStrLn $ (++stackTrace) $ "subd' subscribed to " ++ case e of
       EventRoot _ -> "EventRoot"
       EventNever -> "EventNever"
       _ -> "something else"
@@ -2357,8 +2535,10 @@
   x >>= f = SpiderDynamic $ dynamicDynIdentity $ newJoinDyn $ newMapDyn (unSpiderDynamic . f) $ unSpiderDynamic x
   {-# INLINE (>>) #-}
   (>>) = (*>)
+#if !MIN_VERSION_base(4,13,0)
   {-# INLINE fail #-}
   fail _ = error "Dynamic does not support 'fail'"
+#endif
 
 {-# INLINABLE newJoinDyn #-}
 newJoinDyn :: HasSpiderTimeline x => DynamicS x (Identity (DynamicS x (Identity a))) -> Reflex.Spider.Internal.Dyn x (Identity a)
@@ -2483,13 +2663,13 @@
     touch h
     return result
 
-instance Reflex.Host.Class.MonadReflexCreateTrigger (SpiderTimeline x) (SpiderHost x) where
+instance HasSpiderTimeline x => Reflex.Host.Class.MonadReflexCreateTrigger (SpiderTimeline x) (SpiderHost x) where
   newEventWithTrigger = SpiderHost . fmap SpiderEvent . newEventWithTriggerIO
   newFanEventWithTrigger f = SpiderHost $ do
     es <- newFanEventWithTriggerIO f
     return $ Reflex.Class.EventSelector $ SpiderEvent . Reflex.Spider.Internal.select es
 
-instance Reflex.Host.Class.MonadReflexCreateTrigger (SpiderTimeline x) (SpiderHostFrame x) where
+instance HasSpiderTimeline x => Reflex.Host.Class.MonadReflexCreateTrigger (SpiderTimeline x) (SpiderHostFrame x) where
   newEventWithTrigger = SpiderHostFrame . EventM . liftIO . fmap SpiderEvent . newEventWithTriggerIO
   newFanEventWithTrigger f = SpiderHostFrame $ EventM $ liftIO $ do
     es <- newFanEventWithTriggerIO f
@@ -2637,9 +2817,15 @@
   SpiderHost x >> SpiderHost y = SpiderHost $ x >> y
   {-# INLINABLE return #-}
   return x = SpiderHost $ return x
+#if !MIN_VERSION_base(4,13,0)
   {-# INLINABLE fail #-}
-  fail s = SpiderHost $ fail s
+  fail = MonadFail.fail
+#endif
 
+instance MonadFail (SpiderHost x) where
+  {-# INLINABLE fail #-}
+  fail s = SpiderHost $ MonadFail.fail s
+
 -- | Run an action affecting the global Spider timeline; this will be guarded by
 -- a mutex for that timeline
 runSpiderHost :: SpiderHost Global a -> IO a
@@ -2660,19 +2846,21 @@
   SpiderHostFrame x >> SpiderHostFrame y = SpiderHostFrame $ x >> y
   {-# INLINABLE return #-}
   return x = SpiderHostFrame $ return x
+#if !MIN_VERSION_base(4,13,0)
   {-# INLINABLE fail #-}
   fail s = SpiderHostFrame $ fail s
+#endif
 
 instance NotReady (SpiderTimeline x) (SpiderHostFrame x) where
   notReadyUntil _ = pure ()
   notReady = pure ()
 
-newEventWithTriggerIO :: (RootTrigger x a -> IO (IO ())) -> IO (Event x a)
+newEventWithTriggerIO :: forall x a. HasSpiderTimeline x => (RootTrigger x a -> IO (IO ())) -> IO (Event x a)
 newEventWithTriggerIO f = do
   es <- newFanEventWithTriggerIO $ \Refl -> f
   return $ select es Refl
 
-newFanEventWithTriggerIO :: GCompare k => (forall a. k a -> RootTrigger x a -> IO (IO ())) -> IO (EventSelector x k)
+newFanEventWithTriggerIO :: (HasSpiderTimeline x, GCompare k) => (forall a. k a -> RootTrigger x a -> IO (IO ())) -> IO (EventSelector x k)
 newFanEventWithTriggerIO f = do
   occRef <- newIORef DMap.empty
   subscribedRef <- newIORef DMap.empty
diff --git a/src/Reflex/Widget/Basic.hs b/src/Reflex/Widget/Basic.hs
--- a/src/Reflex/Widget/Basic.hs
+++ b/src/Reflex/Widget/Basic.hs
@@ -13,7 +13,7 @@
 
 import Reflex.Class
 import Reflex.Adjustable.Class
-import Reflex.Patch.MapWithMove
+import Data.Patch.MapWithMove
 
 
 -- | Build sortable content in such a way that re-sorting it can cause minimal
diff --git a/test/Adjustable.hs b/test/Adjustable.hs
new file mode 100644
--- /dev/null
+++ b/test/Adjustable.hs
@@ -0,0 +1,62 @@
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE RecursiveDo #-}
+
+module Main where
+
+import Control.Monad.Fix
+import Data.Maybe
+import qualified Data.Map as Map
+
+import Reflex
+import Reflex.EventWriter.Base
+import Reflex.Network
+import Reflex.Patch.MapWithMove
+import Test.Run
+
+main :: IO ()
+main = do
+  let actions =  [ Increment, Update0th, Increment, Swap, Increment, Increment ]
+  os <- runAppB testPatchMapWithMove $ map Just actions
+  -- If the final counter value in the adjusted widgets corresponds to the number of times it has
+  -- been incremented, we know that the networks haven't broken.
+  let expectedCount = length $ ffilter (== Increment) actions
+  -- let !True = last (last os) == [expectedCount,expectedCount] -- TODO re-enable this test after issue #369 has been resolved
+  return ()
+
+data PatchMapTestAction
+  = Increment
+  | Swap
+  | Update0th
+  deriving Eq
+
+-- See https://github.com/reflex-frp/reflex/issues/369 for the bug that this is testing.
+testPatchMapWithMove
+  :: forall t m
+  .  ( Reflex t
+     , Adjustable t m
+     , MonadHold t m
+     , MonadFix m
+     )
+  => Event t PatchMapTestAction
+  -> m (Behavior t [Int])
+testPatchMapWithMove pulse = do
+  let pulseAction = ffor pulse $ \case
+        Increment -> Nothing
+        Swap -> patchMapWithMove $ Map.fromList
+          [ (0, NodeInfo (From_Move 1) (Just 1))
+          , (1, NodeInfo (From_Move 0) (Just 0))
+          ]
+        Update0th -> patchMapWithMove $ Map.fromList
+          [ (0, NodeInfo (From_Insert 'z') Nothing) ]
+  (_, result) <- runBehaviorWriterT $ mdo
+    counter <- foldDyn (+) 1 $ fmapMaybe (\e -> if isNothing e then Just 1 else Nothing) pulseAction
+    _ <- mapMapWithAdjustWithMove
+      (\_ _ -> networkHold
+        (tellBehavior $ constant [])
+        ((\t -> tellBehavior $ constant [t]) <$> updated counter))
+      (Map.fromList $ zip [0..] "ab")
+      (fmapMaybe id pulseAction)
+    return ()
+  return result
diff --git a/test/DebugCycles.hs b/test/DebugCycles.hs
new file mode 100644
--- /dev/null
+++ b/test/DebugCycles.hs
@@ -0,0 +1,171 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE RecursiveDo #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE RankNTypes #-}
+
+module Main where
+
+import Data.Foldable
+import Control.Lens
+import Control.Applicative
+import Control.Monad
+import Control.Monad.Fix
+import Control.Exception
+import System.Timeout
+import Data.Maybe (isJust)
+import Data.Functor.Misc
+import qualified Data.Map as Map
+import Data.Map (Map)
+import qualified Data.IntMap as IntMap
+import Data.IntMap (IntMap)
+import Data.These
+import Data.Align
+import Reflex
+import Reflex.EventWriter.Base
+import Test.Run
+import Test.Hspec
+import Reflex.Spider.Internal (EventLoopException)
+import Data.Witherable (Filterable)
+
+#if defined(MIN_VERSION_these_lens) || (MIN_VERSION_these(0,8,0) && !MIN_VERSION_these(0,9,0))
+import Data.These.Lens
+#endif
+
+type Widget t m = (MonadHold t m, Reflex t, MonadFix m)
+
+connectDyn :: Widget t m => Event t () -> (Dynamic t a, Dynamic t a) -> m (Dynamic t a)
+connectDyn e (d, d') = do
+  dd <- holdDyn d (d' <$ e)
+  return $ join dd
+
+dynLoop :: Widget t m => (Event t Int, Event t ()) -> m (Event t Int)
+dynLoop (e1, e2) = do
+  -- "heightBagRemove: Height 2 not present in bag HeightBag {_heightBag_size = 2, _heightBag_contents = fromList [(0,1)]}"
+  rec
+    d <- count e1
+    d' <- connectDyn e2 (d, liftA2 (+) d d')
+  return $ updated d'
+
+connectOnCoincidence :: Widget t m => Event t () -> Event t a -> m (Event t a)
+connectOnCoincidence click e = do
+  d <- holdDyn never (e <$ click)
+  return $ coincidence (updated d)
+
+coincidenceLoop :: Widget t m => (Event t Int, Event t ()) -> m (Event t Int)
+coincidenceLoop (e1, e2) = do
+-- "heightBagRemove: Height 1 not present in bag HeightBag {_heightBag_size = 1, _heightBag_contents = fromList [(0,0)]}"
+-- (simpler version of dynLoop)
+  rec
+    e' <- connectOnCoincidence e2 (updated d)
+    d <- count (align e' e1)
+  return $ updated d
+
+addHeight :: Reflex t =>  Event t a -> Event t a
+addHeight e = leftmost [e4, e4] where
+  e1 = leftmost [e, e]
+  e2 = leftmost [e1, e1]
+  e3 = leftmost [e2, e2]
+  e4 = leftmost [e3, e3]
+
+-- Take an existing test and build it inside a
+buildLoop :: Widget t m => (forall t m. Widget t m => (Event t Int, Event t ()) -> m (Event t Int)) -> (Event t Int, Event t ()) -> m (Event t Int)
+buildLoop test (e1, e2) = switchHold never buildLoop
+  where buildLoop = pushAlways (const $ test (e1, e2)) e2
+
+connectButtonPromptly :: Widget t m => Event t () -> Event t a -> m (Event t a)
+connectButtonPromptly click e = do
+  d <- holdDyn never (e <$ click)
+  return (switchDyn d)
+
+connectButton :: Widget t m => Event t () -> Event t a -> m (Event t a)
+connectButton click e = do
+  d <- hold never (e <$ click)
+  return (switch d)
+
+switchLoop01 :: Widget t m => (Event t Int, Event t ()) -> m (Event t Int)
+switchLoop01 (e1, e2) = do
+  rec
+    e' <- connectButton e2 (updated d)
+    d <- count (align e' e1)
+  return $ updated d
+
+mergeLoop :: forall t m. (Adjustable t m, Widget t m) => (Event t Int, Event t ()) -> m (Event t Int)
+mergeLoop (e1, e2) = do
+  rec
+    (_, e) <- runEventWriterT $
+      runWithReplace w (leftmost [w <$ e1])
+  return (sum <$> e)
+  where
+    w = do
+      c <- count e1
+      tellEvent (updated ((pure <$> c) :: Dynamic t [Int]))
+
+switchLoop02 :: Widget t m => (Event t Int, Event t ()) -> m (Event t Int)
+switchLoop02 (e1, e2) = do
+  rec
+    e' <- connectButton e2 (updated d)
+    d <- count (leftmost [e', e1])
+  return $ updated d
+
+switchLoop03 :: Widget t m => (Event t Int, Event t ()) -> m (Event t Int)
+switchLoop03 (e1, e2) = do
+  rec
+    e' <- connectButton e2 (addHeight $ updated d)
+    d <- count (align e' e1)
+  return $ updated d
+
+staticLoop01 :: Widget t m => (Event t Int, Event t ()) -> m (Event t Int)
+staticLoop01 (e1, e2) = do
+  rec
+    d <- foldDyn (+) (0 :: Int) (1 <$ align e1 (updated d))
+  return $ updated d
+
+staticLoop02 :: Widget t m => (Event t Int, Event t ()) -> m (Event t Int)
+staticLoop02 (e1, e2) = do
+  rec
+    d <- foldDyn (+) (0 :: Int) (leftmost [e1, updated d])
+  return $ updated d
+
+buildStaticLoop :: Widget t m => (Event t Int, Event t ()) -> m (Event t Int)
+buildStaticLoop (e1, e2) = switchHold never buildLoop
+  where buildLoop = pushAlways (const $ staticLoop01 (e1, e2)) e2
+
+splitThese :: Filterable f => f (These a b) -> (f a, f b)
+splitThese f = (mapMaybe (preview here) f,  mapMaybe (preview there) f)
+
+main :: IO ()
+main = hspec $ do
+  describe "DebugCycles" $ do
+    it "throws EventLoopException on switchLoop01" $ do
+      check switchLoop01
+    it "throws EventLoopException on switchLoop02" $ do
+      check switchLoop02
+    it "throws EventLoopException on switchLoop03" $ do
+      check switchLoop03
+    it "throws EventLoopException on buildSwitchLoop" $ do
+      check $ buildLoop switchLoop01
+    xit "throws EventLoopException on mergeLoop" $ do
+      check mergeLoop
+    xit "throws EventLoopException on staticLoop01" $ do
+      check staticLoop01
+    xit "throws EventLoopException on staticLoop02" $ do
+      check staticLoop02
+    xit "throws EventLoopException on buildStaticLoop" $ do
+      check buildStaticLoop
+    xit "throws EventLoopException on coincidenceLoop" $ do
+      check coincidenceLoop
+    xit "throws EventLoopException on dynLoop" $ do
+      check dynLoop
+    xit "throws EventLoopException on buildCoincidenceLoop" $ do
+      check $ buildLoop coincidenceLoop
+ where
+   milliseconds = (*1000)
+   occs = [  This 1, This 2, That (), This 3, That (), This 1 ]
+   check test = do
+     let action = timeout (milliseconds 50) $ do
+                    runApp' (test . splitThese) (Just <$> occs)
+     action `shouldThrow` (const True :: Selector EventLoopException)
diff --git a/test/GC.hs b/test/GC.hs
--- a/test/GC.hs
+++ b/test/GC.hs
@@ -20,7 +20,7 @@
 import Data.These
 
 import Data.Functor.Misc
-import Reflex.Patch
+import Data.Patch
 
 import qualified Reflex.Host.Class as Host
 import qualified Reflex.Spider.Internal as S
@@ -83,7 +83,6 @@
               Nothing -> []
         Host.fireEventsAndRead followupEventTriggers $ return ()
         return ()
-  return ()
 
 data Tell a where
   Action :: Tell ()
diff --git a/test/QueryT.hs b/test/QueryT.hs
--- a/test/QueryT.hs
+++ b/test/QueryT.hs
@@ -24,7 +24,7 @@
 #endif
 
 import Reflex
-import Reflex.Patch.MapWithMove
+import Data.Patch.MapWithMove
 import Test.Run
 
 newtype MyQuery = MyQuery SelectedCount
diff --git a/test/RequesterT.hs b/test/RequesterT.hs
--- a/test/RequesterT.hs
+++ b/test/RequesterT.hs
@@ -1,20 +1,36 @@
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
-{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE RecursiveDo #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
 module Main where
 
-import Control.Lens
+import Control.Lens hiding (has)
 import Control.Monad
 import Control.Monad.Fix
+import Control.Monad.IO.Class (MonadIO)
+import Data.Constraint.Extras
+import Data.Constraint.Extras.TH
+import Data.Constraint.Forall
 import qualified Data.Dependent.Map as DMap
 import Data.Dependent.Sum
 import Data.Functor.Misc
+import Data.List (words)
+import Data.Map (Map)
 import qualified Data.Map as M
+#if !MIN_VERSION_these(4,11,0)
+import Data.Semigroup ((<>))
+#endif
+import Data.Text (Text)
 import Data.These
+import Text.Read (readMaybe)
 
 #if defined(MIN_VERSION_these_lens) || (MIN_VERSION_these(0,8,0) && !MIN_VERSION_these(0,9,0))
 import Data.These.Lens
@@ -49,12 +65,19 @@
   print os5
   os6 <- runApp' (unwrapApp delayedPulse) [Just ()]
   print os6
+  os7 <- runApp' testMatchRequestsWithResponses [ Just $ TestRequest_Increment 1 ]
+  print os7
+  os8 <- runApp' testMatchRequestsWithResponses [ Just $ TestRequest_Reverse "yoyo" ]
+  print os8
   let ![[Just [1,2,3,4,5,6,7,8,9,10]]] = os1 -- The order is reversed here: see the documentation for 'runRequesterT'
   let ![[Just [9,7,5,3,1]],[Nothing,Nothing],[Just [10,8,6,4,2]],[Just [10,8,6,4,2],Nothing]] = os2
   let ![[Nothing, Just [2]]] = os3
   let ![[Nothing, Just [2]]] = os4
   let ![[Nothing, Just [1, 2]]] = os5
   -- let ![[Nothing, Nothing]] = os6 -- TODO re-enable this test after issue #233 has been resolved
+  let !(Just [(1,"2")]) = M.toList <$> head (head os7)
+  let !(Just [(1,"oyoy")]) = M.toList <$> head (head os8)
+
   return ()
 
 unwrapRequest :: DSum tag RequestInt -> Int
@@ -172,3 +195,41 @@
     -- This has the effect of delaying pulse' from pulse
     (_, pulse') <- runWithReplace (pure ()) $ pure (RequestInt 1) <$ pulse
     requestingIdentity pulse'
+
+data TestRequest a where
+  TestRequest_Reverse :: String -> TestRequest String
+  TestRequest_Increment :: Int -> TestRequest Int
+
+testMatchRequestsWithResponses
+  :: forall m t req a
+   . ( MonadFix m
+     , MonadHold t m
+     , Reflex t
+     , PerformEvent t m
+     , MonadIO (Performable m)
+     , ForallF Show req
+     , Has Read req
+     )
+  => Event t (req a) -> m (Event t (Map Int String))
+testMatchRequestsWithResponses pulse = mdo
+  (_, requests) <- runRequesterT (requesting pulse) responses
+  let rawResponses = M.map (\v ->
+        case words v of
+          ["reverse", str] -> reverse str
+          ["increment", i] -> show $ succ $ (read i :: Int)
+        ) <$> rawRequestMap
+  (rawRequestMap, responses) <- matchResponsesWithRequests reqEncoder requests (head . M.toList <$> rawResponses)
+  pure rawResponses
+  where
+    reqEncoder :: forall a. req a -> (String, String -> Maybe a)
+    reqEncoder r =
+      ( whichever @Show @req @a $ show r
+      , \x -> has @Read r $ readMaybe x
+      )
+
+deriveArgDict ''TestRequest
+
+instance Show (TestRequest a) where
+  show = \case
+    TestRequest_Reverse str -> "reverse " <> str
+    TestRequest_Increment i -> "increment " <> show i